From 496a3849d1d6ba880bbd1e86c8ef5e2257bb702a Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 13 Dec 2023 10:55:57 +0100 Subject: Add the num_fwd_inputs_no_fuel_no_state field in Pure.fun_sig --- compiler/Pure.ml | 8 +++++--- compiler/PureMicroPasses.ml | 5 +++++ compiler/SymbolicToPure.ml | 5 +++-- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 0ae83007..d7aea0f7 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -860,8 +860,8 @@ type fun_effect_info = { the set [{ forward function } U { backward functions }]. We need this because of the option {!val:Config.backward_no_state_update}: - if it is [true], then in case of a backward function {!stateful} is [false], - but we might need to know whether the corresponding forward function + if it is [true], then in case of a backward function {!stateful} might be + [false], but we might need to know whether the corresponding forward function is stateful or not. *) stateful : bool; (** [true] if the function is stateful (updates a state) *) @@ -876,7 +876,9 @@ type fun_effect_info = { (** Meta information about a function signature *) type fun_sig_info = { has_fuel : bool; - (* TODO: add [num_fwd_inputs_no_fuel_no_state] *) + num_fwd_inputs_no_fuel_no_state : int; + (** The number of input types for forward computation, ignoring the fuel (if used) + and ignoring the state (if used) *) num_fwd_inputs_with_fuel_no_state : int; (** The number of input types for forward computation, with the fuel (if used) and ignoring the state (if used) *) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 959ec1c8..34578750 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -1340,6 +1340,7 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = let loop_sig_info = let fuel = if !Config.use_fuel then 1 else 0 in let num_inputs = List.length loop.inputs in + let num_fwd_inputs_no_fuel_no_state = num_inputs in let num_fwd_inputs_with_fuel_no_state = fuel + num_inputs in let fwd_state = fun_sig_info.num_fwd_inputs_with_fuel_with_state @@ -1350,6 +1351,7 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = in { has_fuel = !Config.use_fuel; + num_fwd_inputs_no_fuel_no_state; num_fwd_inputs_with_fuel_no_state; num_fwd_inputs_with_fuel_with_state; num_back_inputs_no_state = fun_sig_info.num_back_inputs_no_state; @@ -2168,6 +2170,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) : in let { has_fuel; + num_fwd_inputs_no_fuel_no_state; num_fwd_inputs_with_fuel_no_state; num_fwd_inputs_with_fuel_with_state; num_back_inputs_no_state; @@ -2182,6 +2185,8 @@ let filter_loop_inputs (transl : pure_fun_translation list) : let info = { has_fuel; + num_fwd_inputs_no_fuel_no_state = + num_fwd_inputs_no_fuel_no_state - num_filtered; num_fwd_inputs_with_fuel_no_state = num_fwd_inputs_with_fuel_no_state - num_filtered; num_fwd_inputs_with_fuel_with_state = diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index bf4d26f2..2ef313e6 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1035,10 +1035,10 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) let generics = translate_generic_params sg.generics in (* Return *) let has_fuel = fuel <> [] in - let num_fwd_inputs_no_state = List.length fwd_inputs in + let num_fwd_inputs_no_fuel_no_state = List.length fwd_inputs in let num_fwd_inputs_with_fuel_no_state = (* We use the fact that [fuel] has length 1 if we use some fuel, 0 otherwise *) - List.length fuel + num_fwd_inputs_no_state + List.length fuel + num_fwd_inputs_no_fuel_no_state in let num_back_inputs_no_state = if bid = None then None else Some (List.length back_inputs) @@ -1046,6 +1046,7 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) let info = { has_fuel; + num_fwd_inputs_no_fuel_no_state; num_fwd_inputs_with_fuel_no_state; num_fwd_inputs_with_fuel_with_state = (* We use the fact that [fwd_state_ty] has length 1 if there is a state, -- cgit v1.2.3 From 0c814c97dd8e5167f24b0dbb14186d674e4d097b Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 13 Dec 2023 11:44:58 +0100 Subject: Update Pure.fun_sig_info --- compiler/Config.ml | 4 ++ compiler/Extract.ml | 8 +++- compiler/Pure.ml | 30 +++++++------- compiler/PureMicroPasses.ml | 96 +++++++++++++++++++++++++++------------------ compiler/PureUtils.ml | 19 +++++++++ compiler/SymbolicToPure.ml | 32 +++++++++------ compiler/Translate.ml | 8 +++- 7 files changed, 129 insertions(+), 68 deletions(-) diff --git a/compiler/Config.ml b/compiler/Config.ml index b09544ba..9cd1ebc2 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -92,6 +92,10 @@ let loop_fixed_point_max_num_iters = 2 (** {1 Translation} *) +(** If true, do not define separate forward/backward functions, but make the + forward functions return the backward function. *) +let return_back_funs = ref false + (** Forbids using field projectors for structures. If we don't use field projectors, whenever we symbolically expand a structure diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 20cdb20b..93fcf416 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -1469,8 +1469,10 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) *) let inputs_lvs = let all_inputs = (Option.get def.body).inputs_lvs in + (* TODO: *) + assert (not !Config.return_back_funs); let num_fwd_inputs = - def.signature.info.num_fwd_inputs_with_fuel_with_state + def.signature.info.fwd_info.num_inputs_with_fuel_with_state in Collections.List.prefix num_fwd_inputs all_inputs in @@ -1515,8 +1517,10 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) if has_decreases_clause && !backend = Lean then ( let def_body = Option.get def.body in let all_vars = List.map (fun (v : var) -> v.id) def_body.inputs in + (* TODO: *) + assert (not !Config.return_back_funs); let num_fwd_inputs = - def.signature.info.num_fwd_inputs_with_fuel_with_state + def.signature.info.fwd_info.num_inputs_with_fuel_with_state in let vars = Collections.List.prefix num_fwd_inputs all_vars in diff --git a/compiler/Pure.ml b/compiler/Pure.ml index d7aea0f7..80d8782b 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -873,23 +873,25 @@ type fun_effect_info = { } [@@deriving show] -(** Meta information about a function signature *) -type fun_sig_info = { +type inputs_info = { has_fuel : bool; - num_fwd_inputs_no_fuel_no_state : int; - (** The number of input types for forward computation, ignoring the fuel (if used) + num_inputs_no_fuel_no_state : int; + (** The number of input types ignoring the fuel (if used) and ignoring the state (if used) *) - num_fwd_inputs_with_fuel_no_state : int; - (** The number of input types for forward computation, with the fuel (if used) + num_inputs_with_fuel_no_state : int; + (** The number of input types, with the fuel (if used) and ignoring the state (if used) *) - num_fwd_inputs_with_fuel_with_state : int; - (** The number of input types for forward computation, with fuel and state (if used) *) - num_back_inputs_no_state : int option; - (** The number of additional inputs for the backward computation (if pertinent), - ignoring the state (if there is one) *) - num_back_inputs_with_state : int option; - (** The number of additional inputs for the backward computation (if pertinent), - with the state (if there is one) *) + num_inputs_with_fuel_with_state : int; + (** The number of input types, with fuel and state (if used) *) +} +[@@deriving show] + +(** Meta information about a function signature *) +type fun_sig_info = { + fwd_info : inputs_info; + (** Information about the inputs of the forward function *) + back_info : inputs_info option; + (** Information about the inputs of the backward function, if pertinent *) effect_info : fun_effect_info; } [@@deriving show] diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 34578750..7f122f15 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -1326,6 +1326,9 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = let fun_sig_info = fun_sig.info in let fun_effect_info = fun_sig_info.effect_info in + (* TODO: *) + assert (not !Config.return_back_funs); + (* Generate the loop definition *) let loop_effect_info = { @@ -1340,38 +1343,44 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = let loop_sig_info = let fuel = if !Config.use_fuel then 1 else 0 in let num_inputs = List.length loop.inputs in - let num_fwd_inputs_no_fuel_no_state = num_inputs in - let num_fwd_inputs_with_fuel_no_state = fuel + num_inputs in - let fwd_state = - fun_sig_info.num_fwd_inputs_with_fuel_with_state - - fun_sig_info.num_fwd_inputs_with_fuel_no_state - in - let num_fwd_inputs_with_fuel_with_state = - num_fwd_inputs_with_fuel_no_state + fwd_state + let fwd_info : inputs_info = + let info = fun_sig_info.fwd_info in + let fwd_state = + info.num_inputs_with_fuel_with_state + - info.num_inputs_with_fuel_no_state + in + { + has_fuel = !Config.use_fuel; + num_inputs_no_fuel_no_state = num_inputs; + num_inputs_with_fuel_no_state = num_inputs + fuel; + num_inputs_with_fuel_with_state = + num_inputs + fuel + fwd_state; + } in + { - has_fuel = !Config.use_fuel; - num_fwd_inputs_no_fuel_no_state; - num_fwd_inputs_with_fuel_no_state; - num_fwd_inputs_with_fuel_with_state; - num_back_inputs_no_state = fun_sig_info.num_back_inputs_no_state; - num_back_inputs_with_state = - fun_sig_info.num_back_inputs_with_state; + fwd_info; + back_info = fun_sig_info.back_info; effect_info = loop_effect_info; } in + assert (fun_sig_info_is_wf loop_sig_info); let inputs_tys = + (* TODO: *) + assert (not !Config.return_back_funs); + let fuel = if !Config.use_fuel then [ mk_fuel_ty ] else [] in let fwd_inputs = List.map (fun (v : var) -> v.ty) loop.inputs in + let info = fun_sig_info.fwd_info in let state = Collections.List.subslice fun_sig.inputs - fun_sig_info.num_fwd_inputs_with_fuel_no_state - fun_sig_info.num_fwd_inputs_with_fuel_with_state + info.num_inputs_with_fuel_no_state + info.num_inputs_with_fuel_with_state in let _, back_inputs = Collections.List.split_at fun_sig.inputs - fun_sig_info.num_fwd_inputs_with_fuel_with_state + info.num_inputs_with_fuel_with_state in List.concat [ fuel; fwd_inputs; state; back_inputs ] in @@ -1432,14 +1441,17 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = in (* Introduce the additional backward inputs *) + (* TODO: *) + assert (not !Config.return_back_funs); let fun_body = Option.get def.body in + let info = fun_sig_info.fwd_info in let _, back_inputs = Collections.List.split_at fun_body.inputs - fun_sig_info.num_fwd_inputs_with_fuel_with_state + info.num_inputs_with_fuel_with_state in let _, back_inputs_lvs = Collections.List.split_at fun_body.inputs_lvs - fun_sig_info.num_fwd_inputs_with_fuel_with_state + info.num_inputs_with_fuel_with_state in let inputs = @@ -2055,12 +2067,14 @@ let filter_loop_inputs (transl : pure_fun_translation list) : (* We start by computing the filtering information, for each function *) let compute_one_filter_info (decl : fun_decl) = + (* TODO: *) + assert (not !Config.return_back_funs); (* There should be a body *) let body = Option.get decl.body in (* We only look at the forward inputs, without the state *) let inputs_prefix, _ = Collections.List.split_at body.inputs - decl.signature.info.num_fwd_inputs_with_fuel_no_state + decl.signature.info.fwd_info.num_inputs_with_fuel_no_state in let used = ref (List.map (fun v -> (var_get_id v, false)) inputs_prefix) in let inputs_prefix_length = List.length inputs_prefix in @@ -2080,7 +2094,10 @@ let filter_loop_inputs (transl : pure_fun_translation list) : (* Set the fuel as used *) let sg_info = decl.signature.info in - if sg_info.has_fuel then set_used (fst (Collections.List.nth inputs 0)); + (* TODO: *) + assert (not !Config.return_back_funs); + if sg_info.fwd_info.has_fuel then + set_used (fst (Collections.List.nth inputs 0)); let visitor = object (self : 'self) @@ -2168,34 +2185,35 @@ let filter_loop_inputs (transl : pure_fun_translation list) : = decl.signature in + (* TODO: *) + assert (not !Config.return_back_funs); + let { fwd_info; back_info; effect_info } = info in + let { has_fuel; - num_fwd_inputs_no_fuel_no_state; - num_fwd_inputs_with_fuel_no_state; - num_fwd_inputs_with_fuel_with_state; - num_back_inputs_no_state; - num_back_inputs_with_state; - effect_info; + num_inputs_no_fuel_no_state; + num_inputs_with_fuel_no_state; + num_inputs_with_fuel_with_state; } = - info + fwd_info in let inputs = filter_prefix used_info inputs in - let info = + let fwd_info = { has_fuel; - num_fwd_inputs_no_fuel_no_state = - num_fwd_inputs_no_fuel_no_state - num_filtered; - num_fwd_inputs_with_fuel_no_state = - num_fwd_inputs_with_fuel_no_state - num_filtered; - num_fwd_inputs_with_fuel_with_state = - num_fwd_inputs_with_fuel_with_state - num_filtered; - num_back_inputs_no_state; - num_back_inputs_with_state; - effect_info; + num_inputs_no_fuel_no_state = + num_inputs_no_fuel_no_state - num_filtered; + num_inputs_with_fuel_no_state = + num_inputs_with_fuel_no_state - num_filtered; + num_inputs_with_fuel_with_state = + num_inputs_with_fuel_with_state - num_filtered; } in + + let info = { fwd_info; back_info; effect_info } in + assert (fun_sig_info_is_wf info); let signature = { generics; llbc_generics; preds; inputs; output; doutputs; info } in diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 39dcd52d..23a41f0e 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -57,6 +57,25 @@ end module FunLoopIdMap = Collections.MakeMap (FunLoopIdOrderedType) module FunLoopIdSet = Collections.MakeSet (FunLoopIdOrderedType) +let inputs_info_is_wf (info : inputs_info) : bool = + let { + has_fuel; + num_inputs_no_fuel_no_state; + num_inputs_with_fuel_no_state; + num_inputs_with_fuel_with_state; + } = + info + in + let fuel = if has_fuel then 1 else 0 in + num_inputs_no_fuel_no_state >= 0 + && num_inputs_with_fuel_no_state = num_inputs_no_fuel_no_state + fuel + && num_inputs_with_fuel_with_state >= num_inputs_with_fuel_no_state + +let fun_sig_info_is_wf (info : fun_sig_info) : bool = + inputs_info_is_wf info.fwd_info + && + match info.back_info with None -> true | Some info -> inputs_info_is_wf info + let dest_arrow_ty (ty : ty) : ty * ty = match ty with | TArrow (arg_ty, ret_ty) -> (arg_ty, ret_ty) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 2ef313e6..971a8cbd 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1034,6 +1034,8 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) (* Generic parameters *) let generics = translate_generic_params sg.generics in (* Return *) + (* TODO: *) + assert (not !Config.return_back_funs); let has_fuel = fuel <> [] in let num_fwd_inputs_no_fuel_no_state = List.length fwd_inputs in let num_fwd_inputs_with_fuel_no_state = @@ -1043,24 +1045,32 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) let num_back_inputs_no_state = if bid = None then None else Some (List.length back_inputs) in - let info = + let fwd_info : inputs_info = { has_fuel; - num_fwd_inputs_no_fuel_no_state; - num_fwd_inputs_with_fuel_no_state; - num_fwd_inputs_with_fuel_with_state = + num_inputs_no_fuel_no_state = num_fwd_inputs_no_fuel_no_state; + num_inputs_with_fuel_no_state = num_fwd_inputs_with_fuel_no_state; + num_inputs_with_fuel_with_state = (* We use the fact that [fwd_state_ty] has length 1 if there is a state, and 0 otherwise *) num_fwd_inputs_with_fuel_no_state + List.length fwd_state_ty; - num_back_inputs_no_state; - num_back_inputs_with_state = - (* Length of [back_state_ty]: similar trick as for [fwd_state_ty] *) - Option.map - (fun n -> n + List.length back_state_ty) - num_back_inputs_no_state; - effect_info; } in + let back_info : inputs_info option = + Option.map + (fun n -> + (* Note that backward functions never use fuel *) + { + has_fuel = false; + num_inputs_no_fuel_no_state = n; + num_inputs_with_fuel_no_state = n; + (* Length of [back_state_ty]: similar trick as for [fwd_state_ty] *) + num_inputs_with_fuel_with_state = n + List.length back_state_ty; + }) + num_back_inputs_no_state + in + let info = { fwd_info; back_info; effect_info } in + assert (fun_sig_info_is_wf info); let preds = translate_predicates sg.preds in let sg = { diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 221d4e73..54e24066 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -216,11 +216,15 @@ let translate_function_to_pure (trans_ctx : trans_ctx) (* We need to ignore the forward inputs, and the state input (if there is) *) let backward_inputs = let sg = backward_sg.sg in + (* TODO: *) + assert (not !Config.return_back_funs); (* We need to ignore the forward state and the backward state *) let num_forward_inputs = - sg.info.num_fwd_inputs_with_fuel_with_state + sg.info.fwd_info.num_inputs_with_fuel_with_state + in + let num_back_inputs = + (Option.get sg.info.back_info).num_inputs_no_fuel_no_state in - let num_back_inputs = Option.get sg.info.num_back_inputs_no_state in Collections.List.subslice sg.inputs num_forward_inputs (num_forward_inputs + num_back_inputs) in -- cgit v1.2.3 From 7630c45b7990d0df1db022f827e7de676ad4499a Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 13 Dec 2023 11:48:53 +0100 Subject: Make a minor modification in a comment --- compiler/InterpreterExpressions.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/InterpreterExpressions.mli b/compiler/InterpreterExpressions.mli index f8d979f4..b975371c 100644 --- a/compiler/InterpreterExpressions.mli +++ b/compiler/InterpreterExpressions.mli @@ -52,7 +52,7 @@ val eval_operands : Transmits the computed rvalue to the received continuation. - Note that this function fails on {!constructor:Aeneas.Expressions.rvalue.Discriminant}: discriminant + Note that this function fails on {!Aeneas.Expressions.rvalue.Discriminant}: discriminant reads should have been eliminated from the AST. *) val eval_rvalue_not_global : -- cgit v1.2.3 From f69ac6a4a244c99a41a90ed57f74ea83b3835882 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 14 Dec 2023 17:11:01 +0100 Subject: Start updating Pure.fun_sig_info to handle merged forward and backward functions --- compiler/Config.ml | 63 ++++++++++++++++++++++++++++++++++++++++++++-- compiler/Pure.ml | 24 +++++++++++++++--- compiler/PureUtils.ml | 6 ++++- compiler/SymbolicToPure.ml | 62 ++++++++++++++++++++++++++++++--------------- 4 files changed, 128 insertions(+), 27 deletions(-) diff --git a/compiler/Config.ml b/compiler/Config.ml index 9cd1ebc2..b8af6c6d 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -93,8 +93,67 @@ let loop_fixed_point_max_num_iters = 2 (** {1 Translation} *) (** If true, do not define separate forward/backward functions, but make the - forward functions return the backward function. *) -let return_back_funs = ref false + forward functions return the backward function. + + Example: + {[ + (* Rust *) + pub fn list_nth<'a, T>(l: &'a mut List, i: u32) -> &'a mut T { + match l { + List::Nil => { + panic!() + } + List::Cons(x, tl) => { + if i == 0 { + x + } else { + list_nth(tl, i - 1) + } + } + } + } + + (* Translation, if return_back_funs = false *) + def list_nth (T : Type) (l : List T) (i : U32) : Result T := + match l with + | List.Cons x tl => + if i = 0#u32 + then Result.ret x + else do + let i0 ← i - 1#u32 + list_nth T tl i0 + | List.Nil => Result.fail .panic + + def list_nth_back + (T : Type) (l : List T) (i : U32) (ret : T) : Result (List T) := + match l with + | List.Cons x tl => + if i = 0#u32 + then Result.ret (List.Cons ret tl) + else + do + let i0 ← i - 1#u32 + let tl0 ← list_nth_back T tl i0 ret + Result.ret (List.Cons x tl0) + | List.Nil => Result.fail .panic + + (* Translation, if return_back_funs = true *) + def list_nth (T: Type) (ls : List T) (i : U32) : + Result (T × (T → Result (List T))) := + match ls with + | List.Cons x tl => + if i = 0#u32 + then Result.ret (x, (λ ret => return (ret :: ls))) + else do + let i0 ← i - 1#u32 + let (x, back) ← list_nth ls i0 + Return.ret (x, + (λ ret => do + let ls ← back ret + return (x :: ls))) + ]} + *) +let return_back_funs = ref true (** Forbids using field projectors for structures. diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 80d8782b..bb522623 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -561,7 +561,7 @@ type fun_id_or_trait_method_ref = (** A function id for a non-assumed function *) type regular_fun_id = - fun_id_or_trait_method_ref * LoopId.id option * T.RegionGroupId.id option + fun_id_or_trait_method_ref * LoopId.id option * RegionGroupId.id option [@@deriving show, ord] (** A function identifier *) @@ -886,12 +886,28 @@ type inputs_info = { } [@@deriving show] +type 'a back_info = + | SingleBack of 'a option + (** Information about a single backward function, if pertinent. + + We use this variant if we split the forward and the backward functions. + *) + | AllBacks of 'a RegionGroupId.Map.t + (** Information about the various backward functions. + + We use this if we *do not* split the forward and the backward functions. + All the information is then carried by the forward function. + *) +[@@deriving show] + +type back_inputs_info = inputs_info back_info [@@deriving show] + (** Meta information about a function signature *) type fun_sig_info = { fwd_info : inputs_info; (** Information about the inputs of the forward function *) - back_info : inputs_info option; - (** Information about the inputs of the backward function, if pertinent *) + back_info : back_inputs_info; + (** Information about the inputs of the backward functions. *) effect_info : fun_effect_info; } [@@deriving show] @@ -1024,7 +1040,7 @@ type fun_decl = { *) loop_id : LoopId.id option; (** [Some] if this definition was generated for a loop *) - back_id : T.RegionGroupId.id option; + back_id : RegionGroupId.id option; llbc_name : llbc_name; (** The original LLBC name. *) name : string; (** We use the name only for printing purposes (for debugging): diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 23a41f0e..3c038149 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -74,7 +74,11 @@ let inputs_info_is_wf (info : inputs_info) : bool = let fun_sig_info_is_wf (info : fun_sig_info) : bool = inputs_info_is_wf info.fwd_info && - match info.back_info with None -> true | Some info -> inputs_info_is_wf info + match info.back_info with + | SingleBack None -> true + | SingleBack (Some info) -> inputs_info_is_wf info + | AllBacks infos -> + List.for_all inputs_info_is_wf (RegionGroupId.Map.values infos) let dest_arrow_ty (ty : ty) : ty * ty = match ty with diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 971a8cbd..59205f08 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -855,10 +855,14 @@ let get_fun_effect_info (fun_infos : fun_info A.FunDeclId.Map.t) name (outputs for backward functions come from borrows in the inputs of the forward function) which we use as hints to generate pretty names in the extracted code. + + We use [bid] ("backward function id") only if we split the forward + and the backward functions. *) let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) (sg : A.fun_sig) (input_names : string option list) (bid : T.RegionGroupId.id option) : fun_sig_named_outputs = + assert (Option.is_none bid || not !Config.return_back_funs); let fun_infos = decls_ctx.fun_ctx.fun_infos in let type_infos = decls_ctx.type_ctx.type_infos in (* Retrieve the list of parent backward functions *) @@ -939,6 +943,18 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) let inside_mut = false in translate_back_ty type_infos keep_region inside_mut ty in + let translate_back_inputs_for_gid gid : ty list = + (* For now, we don't allow nested borrows, so the additional inputs to the + backward function can only come from borrows that were returned like + in (for the backward function we introduce for 'a): + {[ + fn f<'a>(...) -> &'a mut u32; + ]} + Upon ending the abstraction for 'a, we need to get back the borrow + the function returned. + *) + List.filter_map (translate_back_ty_for_gid gid) [ sg.output ] + in (* Compute the additinal inputs for the current function, if it is a backward * function *) let back_inputs = @@ -1056,18 +1072,22 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) num_fwd_inputs_with_fuel_no_state + List.length fwd_state_ty; } in - let back_info : inputs_info option = - Option.map - (fun n -> - (* Note that backward functions never use fuel *) - { - has_fuel = false; - num_inputs_no_fuel_no_state = n; - num_inputs_with_fuel_no_state = n; - (* Length of [back_state_ty]: similar trick as for [fwd_state_ty] *) - num_inputs_with_fuel_with_state = n + List.length back_state_ty; - }) - num_back_inputs_no_state + let back_info : back_inputs_info = + if !Config.return_back_funs then + SingleBack + (Option.map + (fun n -> + (* Note that backward functions never use fuel *) + { + has_fuel = false; + num_inputs_no_fuel_no_state = n; + num_inputs_with_fuel_no_state = n; + (* Length of [back_state_ty]: similar trick as for [fwd_state_ty] *) + num_inputs_with_fuel_with_state = n + List.length back_state_ty; + }) + num_back_inputs_no_state) + else (* Create the map *) + failwith "TODO" in let info = { fwd_info; back_info; effect_info } in assert (fun_sig_info_is_wf info); @@ -3162,14 +3182,16 @@ let translate_fun_signatures (decls_ctx : C.decls_ctx) let fwd_id = (fun_id, None) in (* The backward functions *) let back_sgs = - List.map - (fun (rg : T.region_var_group) -> - let tsg = - translate_fun_sig decls_ctx fun_id sg input_names (Some rg.id) - in - let id = (fun_id, Some rg.id) in - (id, tsg)) - regions_hierarchy + if !Config.return_back_funs then [] + else + List.map + (fun (rg : T.region_var_group) -> + let tsg = + translate_fun_sig decls_ctx fun_id sg input_names (Some rg.id) + in + let id = (fun_id, Some rg.id) in + (id, tsg)) + regions_hierarchy in (* Return *) (fwd_id, fwd_sg) :: back_sgs -- cgit v1.2.3 From f1f41818fb14a6c46442ca42a49a3aab0a5b1aaf Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 14 Dec 2023 17:48:44 +0100 Subject: Make progress on generated merged fwd/back functions --- compiler/SymbolicToPure.ml | 56 ++++++++++++++++++++++++---------------------- compiler/Translate.ml | 4 +++- 2 files changed, 32 insertions(+), 28 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 1fd4896e..86c80f87 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -958,19 +958,7 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) (* Compute the additinal inputs for the current function, if it is a backward * function *) let back_inputs = - match gid with - | None -> [] - | Some gid -> - (* For now, we don't allow nested borrows, so the additional inputs to the - backward function can only come from borrows that were returned like - in (for the backward function we introduce for 'a): - {[ - fn f<'a>(...) -> &'a mut u32; - ]} - Upon ending the abstraction for 'a, we need to get back the borrow - the function returned. - *) - List.filter_map (translate_back_ty_for_gid gid) [ sg.output ] + match gid with None -> [] | Some gid -> translate_back_inputs_for_gid gid in (* If the function is stateful, the inputs are: - forward: [fwd_ty0, ..., fwd_tyn, state] @@ -989,11 +977,12 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) See {!effect_info}. *) if effect_info.stateful_group then [ mk_state_ty ] else [] in - let back_state_ty = + let mk_back_state_ty_for_gid (gid : RegionGroupId.id option) : ty list = (* For the backward state, we check if the function is a backward function, and it is stateful *) if effect_info.stateful && Option.is_some gid then [ mk_state_ty ] else [] in + let back_state_ty = mk_back_state_ty_for_gid gid in (* Concatenate the inputs, in the following order: * - forward inputs @@ -1072,22 +1061,35 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) num_fwd_inputs_with_fuel_no_state + List.length fwd_state_ty; } in + let compute_back_info (back_state_ty : ty list) + (num_back_inputs_no_state : int) : inputs_info = + let n = num_back_inputs_no_state in + (* Note that backward functions never use fuel *) + { + has_fuel = false; + num_inputs_no_fuel_no_state = n; + num_inputs_with_fuel_no_state = n; + (* Length of [back_state_ty]: similar trick as for [fwd_state_ty] *) + num_inputs_with_fuel_with_state = n + List.length back_state_ty; + } + in let back_info : back_inputs_info = if !Config.return_back_funs then + (* Create the map *) + AllBacks + (RegionGroupId.Map.of_list + (List.map + (fun (rg : T.region_var_group) -> + ( rg.id, + let back_inputs = translate_back_inputs_for_gid rg.id in + let num_back_inputs = List.length back_inputs in + (* TODO: slightly overkill *) + let back_state_ty = mk_back_state_ty_for_gid (Some rg.id) in + compute_back_info back_state_ty num_back_inputs )) + regions_hierarchy)) + else SingleBack - (Option.map - (fun n -> - (* Note that backward functions never use fuel *) - { - has_fuel = false; - num_inputs_no_fuel_no_state = n; - num_inputs_with_fuel_no_state = n; - (* Length of [back_state_ty]: similar trick as for [fwd_state_ty] *) - num_inputs_with_fuel_with_state = n + List.length back_state_ty; - }) - num_back_inputs_no_state) - else (* Create the map *) - failwith "TODO" + (Option.map (compute_back_info back_state_ty) num_back_inputs_no_state) in let info = { fwd_info; back_info; effect_info } in assert (fun_sig_info_is_wf info); diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 54e24066..06d4bd6d 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -223,7 +223,9 @@ let translate_function_to_pure (trans_ctx : trans_ctx) sg.info.fwd_info.num_inputs_with_fuel_with_state in let num_back_inputs = - (Option.get sg.info.back_info).num_inputs_no_fuel_no_state + match sg.info.back_info with + | SingleBack (Some info) -> info.num_inputs_no_fuel_no_state + | _ -> raise (Failure "Unexpected") in Collections.List.subslice sg.inputs num_forward_inputs (num_forward_inputs + num_back_inputs) -- cgit v1.2.3 From cf984f958da94154d0550060eb290a276ab52f23 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 15 Dec 2023 10:17:06 +0100 Subject: Make minor modifications --- compiler/Pure.ml | 9 ++-- compiler/SymbolicToPure.ml | 108 ++++++++++++++------------------------------- 2 files changed, 38 insertions(+), 79 deletions(-) diff --git a/compiler/Pure.ml b/compiler/Pure.ml index c3716001..34f3ef72 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -886,13 +886,13 @@ type inputs_info = { } [@@deriving show] -type 'a back_info = - | SingleBack of 'a option +type ('a, 'b) back_info = + | SingleBack of 'a (** Information about a single backward function, if pertinent. We use this variant if we split the forward and the backward functions. *) - | AllBacks of 'a RegionGroupId.Map.t + | AllBacks of 'b RegionGroupId.Map.t (** Information about the various backward functions. We use this if we *do not* split the forward and the backward functions. @@ -900,7 +900,8 @@ type 'a back_info = *) [@@deriving show] -type back_inputs_info = inputs_info back_info [@@deriving show] +type back_inputs_info = (inputs_info option, inputs_info) back_info +[@@deriving show] (** Meta information about a function signature *) type fun_sig_info = { diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 86c80f87..eba44e3e 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -308,20 +308,6 @@ let abs_to_string (ctx : bs_ctx) (abs : V.abs) : string = let indent_incr = " " in Print.Values.abs_to_string env verbose indent indent_incr abs -let get_instantiated_fun_sig (fun_id : A.fun_id) - (back_id : T.RegionGroupId.id option) (generics : generic_args) - (ctx : bs_ctx) : inst_fun_sig = - (* Lookup the non-instantiated function signature *) - let sg = - (RegularFunIdNotLoopMap.find (fun_id, back_id) ctx.fun_context.fun_sigs).sg - in - (* Create the substitution *) - (* There shouldn't be any reference to Self *) - let tr_self = UnknownTrait __FUNCTION__ in - let subst = make_subst_from_generics sg.generics generics tr_self in - (* Apply *) - fun_sig_substitute subst sg - let bs_ctx_lookup_llbc_type_decl (id : TypeDeclId.id) (ctx : bs_ctx) : T.type_decl = TypeDeclId.Map.find id ctx.type_context.llbc_type_decls @@ -330,12 +316,6 @@ let bs_ctx_lookup_llbc_fun_decl (id : A.FunDeclId.id) (ctx : bs_ctx) : A.fun_decl = A.FunDeclId.Map.find id ctx.fun_context.llbc_fun_decls -(* TODO: move *) -let bs_ctx_lookup_local_function_sig (def_id : A.FunDeclId.id) - (back_id : T.RegionGroupId.id option) (ctx : bs_ctx) : fun_sig = - let id = (E.FRegular def_id, back_id) in - (RegularFunIdNotLoopMap.find id ctx.fun_context.fun_sigs).sg - (* Some generic translation functions (we need to translate different "flavours" of types: forward types, backward types, etc.) *) let rec translate_generic_args (translate_ty : T.ty -> ty) @@ -994,35 +974,44 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) List.concat [ fuel; fwd_inputs; fwd_state_ty; back_inputs; back_state_ty ] in (* Outputs *) + let compute_back_outputs_for_gid (gid : RegionGroupId.id) : + string option list * ty list = + (* The outputs are the borrows inside the regions of the abstractions + and which are present in the input values. For instance, see: + {[ + fn f<'a>(x : &'a mut u32) -> ...; + ]} + Upon ending the abstraction for 'a, we give back the borrow which + was consumed through the [x] parameter. + *) + let outputs = + List.map + (fun (name, input_ty) -> (name, translate_back_ty_for_gid gid input_ty)) + (List.combine input_names sg.inputs) + in + (* Filter *) + let outputs = + List.filter (fun (_, opt_ty) -> Option.is_some opt_ty) outputs + in + let outputs = + List.map (fun (name, opt_ty) -> (name, Option.get opt_ty)) outputs + in + List.split outputs + in let output_names, doutputs = match gid with | None -> - (* This is a forward function: there is one (unnamed) output *) + (* This is a forward function: there is one (unnamed) output. + + If we merge the fwd/back functions we might need to compute + the information about the back outputs. + *) + (* TODO: *) + assert (not !Config.return_back_funs); ([ None ], [ translate_fwd_ty type_infos sg.output ]) | Some gid -> - (* This is a backward function: there might be several outputs. - The outputs are the borrows inside the regions of the abstractions - and which are present in the input values. For instance, see: - {[ - fn f<'a>(x : &'a mut u32) -> ...; - ]} - Upon ending the abstraction for 'a, we give back the borrow which - was consumed through the [x] parameter. - *) - let outputs = - List.map - (fun (name, input_ty) -> - (name, translate_back_ty_for_gid gid input_ty)) - (List.combine input_names sg.inputs) - in - (* Filter *) - let outputs = - List.filter (fun (_, opt_ty) -> Option.is_some opt_ty) outputs - in - let outputs = - List.map (fun (name, opt_ty) -> (name, Option.get opt_ty)) outputs - in - List.split outputs + (* This is a backward function: there might be several outputs. *) + compute_back_outputs_for_gid gid in (* Create the return type *) let output = @@ -2016,37 +2005,6 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) | None -> output | Some nstate -> mk_simpl_tuple_pattern [ nstate; output ] in - (* Sanity check: there is the proper number of inputs and outputs, and they have the proper type *) - (if (* TODO: normalize the types *) !Config.type_check_pure_code then - match fun_id with - | FunId fun_id -> - let inst_sg = - get_instantiated_fun_sig fun_id (Some rg_id) generics ctx - in - log#ldebug - (lazy - ("\n- fun_id: " ^ A.show_fun_id fun_id ^ "\n- inputs (" - ^ string_of_int (List.length inputs) - ^ "): " - ^ String.concat ", " (List.map (texpression_to_string ctx) inputs) - ^ "\n- inst_sg.inputs (" - ^ string_of_int (List.length inst_sg.inputs) - ^ "): " - ^ String.concat ", " - (List.map (pure_ty_to_string ctx) inst_sg.inputs))); - List.iter - (fun (x, ty) -> assert ((x : texpression).ty = ty)) - (List.combine inputs inst_sg.inputs); - log#ldebug - (lazy - ("\n- outputs: " - ^ string_of_int (List.length outputs) - ^ "\n- expected outputs: " - ^ string_of_int (List.length inst_sg.doutputs))); - List.iter - (fun (x, ty) -> assert ((x : typed_pattern).ty = ty)) - (List.combine outputs inst_sg.doutputs) - | _ -> (* TODO: trait methods *) ()); (* Retrieve the function id, and register the function call in the context * if necessary *) let ctx, func = -- cgit v1.2.3 From 83c5be42e1750d329ad31bc9151d7b0446af5a0f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 15 Dec 2023 12:14:01 +0100 Subject: Make progress on generalizing the signature information --- compiler/Extract.ml | 8 +- compiler/Pure.ml | 130 ++++++++++++------ compiler/PureMicroPasses.ml | 10 +- compiler/PureUtils.ml | 10 +- compiler/SymbolicToPure.ml | 313 ++++++++++++++++++++++---------------------- 5 files changed, 253 insertions(+), 218 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 93fcf416..1ea26d79 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -1472,7 +1472,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (* TODO: *) assert (not !Config.return_back_funs); let num_fwd_inputs = - def.signature.info.fwd_info.num_inputs_with_fuel_with_state + def.signature.fwd_info.fwd_info.num_inputs_with_fuel_with_state in Collections.List.prefix num_fwd_inputs all_inputs in @@ -1520,7 +1520,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (* TODO: *) assert (not !Config.return_back_funs); let num_fwd_inputs = - def.signature.info.fwd_info.num_inputs_with_fuel_with_state + def.signature.fwd_info.fwd_info.num_inputs_with_fuel_with_state in let vars = Collections.List.prefix num_fwd_inputs all_vars in @@ -1798,7 +1798,6 @@ let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter) assert body.is_global_decl_body; assert (Option.is_none body.back_id); assert (body.signature.inputs = []); - assert (List.length body.signature.doutputs = 1); assert (body.signature.generics = empty_generic_params); (* Add a break then the name of the corresponding LLBC declaration *) @@ -1817,7 +1816,8 @@ let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter) let decl_ty, body_ty = let ty = body.signature.output in - if body.signature.info.effect_info.can_fail then (unwrap_result_ty ty, ty) + if body.signature.fwd_info.effect_info.can_fail then + (unwrap_result_ty ty, ty) else (ty, mk_result_ty ty) in match body.body with diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 34f3ef72..fb0509f4 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -907,12 +907,88 @@ type back_inputs_info = (inputs_info option, inputs_info) back_info type fun_sig_info = { fwd_info : inputs_info; (** Information about the inputs of the forward function *) - back_info : back_inputs_info; - (** Information about the inputs of the backward functions. *) effect_info : fun_effect_info; } [@@deriving show] +type back_sg_info = { + inputs : ty list; (** The additional inputs of the backward function *) + input_names : string option list; + (** The optional names for the additional inputs *) + outputs : ty list; + (** The "decomposed" list of outputs. + + The list contains all the types of + all the given back values (there is at most one type per forward + input argument). + + Ex.: + {[ + fn choose<'a, T>(b : bool, x : &'a mut T, y : &'a mut T) -> &'a mut T; + ]} + Decomposed outputs: + - forward function: [[T]] + - backward function: [[T; T]] (for "x" and "y") + + Non-decomposed ouputs (if the function can fail, but is not stateful): + - [result T] + - [[result (T * T)]] + *) + output_names : string option list; + (** The optional names for the backward outputs. + We derive those from the names of the inputs of the original LLBC + function. *) + effect_info : fun_effect_info; +} +[@@deriving show] + +(** A *decomposed* function signature. *) +type decomposed_fun_sig = { + generics : generic_params; + (** TODO: we should analyse the signature to make the type parameters implicit whenever possible *) + llbc_generics : Types.generic_params; + (** We use the LLBC generics to generate "pretty" names, for instance + for the variables we introduce for the trait clauses: we derive + those names from the types, and when doing so it is more meaningful + to derive them from the original LLBC types from before the + simplification of types like boxes and references. *) + preds : predicates; + fwd_inputs : ty list; + (** The types of the inputs of the forward function. + + Note that those input types take include the [fuel] parameter, + if the function uses fuel for termination, and the [state] parameter, + if the function is stateful. + + For instance, if we have the following Rust function: + {[ + fn f(x : int); + ]} + + If we translate it to a stateful function which uses fuel we get: + {[ + val f : nat -> int -> state -> result (state * unit); + ]} + + In particular, the list of input types is: [[nat; int; state]]. + *) + fwd_output : ty; + (** The "pure" output type of the forward function. + + Note that this type doesn't contain the "effect" of the function (i.e., + we haven't added the [state] if it is a stateful function and haven't + wrapped the type in a [result]). Also, this output type is only about + the forward function (it doesn't contain the type of the closures we + return for the backward functions, in case we merge the forward and + backward functions). + *) + back_sg : back_sg_info RegionGroupId.Map.t; + (** Information about the backward functions *) + fwd_info : fun_sig_info; + (** Additional information about the forward function *) +} +[@@deriving show] + (** A function signature. We have the following cases: @@ -927,15 +1003,15 @@ type fun_sig_info = { [in_ty0 -> ... -> in_tyn -> state -> back_in0 -> ... back_inm -> state -> result (state & (back_out0 & ... & back_outp))] (* state-error *) - Note that a stateful backward function may take two states as inputs: the - state received by the associated forward function, and the state at which - the backward is called. This leads to code of the following shape: + Note that a stateful backward function may take two states as inputs: the + state received by the associated forward function, and the state at which + the backward is called. This leads to code of the following shape: - {[ - (st1, y) <-- f_fwd x st0; // st0 is the state upon calling f_fwd - ... // the state may be updated - (st3, x') <-- f_back x st0 y' st2; // st2 is the state upon calling f_back - ]} + {[ + (st1, y) <-- f_fwd x st0; // st0 is the state upon calling f_fwd + ... // the state may be updated + (st3, x') <-- f_back x st0 y' st2; // st2 is the state upon calling f_back + ]} The function's type should be given by [mk_arrows sig.inputs sig.output]. We provide additional meta-information with {!fun_sig.info}: @@ -983,40 +1059,14 @@ type fun_sig = { be a tuple with a [state] if the function is stateful, and will be wrapped in a [result] if the function can fail. *) - doutputs : ty list; - (** The "decomposed" list of outputs. - - In case of a forward function, the list has length = 1, for the - type of the returned value. - - In case of backward function, the list contains all the types of - all the given back values (there is at most one type per forward - input argument). - - Ex.: - {[ - fn choose<'a, T>(b : bool, x : &'a mut T, y : &'a mut T) -> &'a mut T; - ]} - Decomposed outputs: - - forward function: [[T]] - - backward function: [[T; T]] (for "x" and "y") - - Non-decomposed ouputs (if the function can fail, but is not stateful): - - [result T] - - [[result (T * T)]] - *) - info : fun_sig_info; (** Additional information *) + fwd_info : fun_sig_info; + (** Additional information about the forward function. *) + back_effect_info : fun_effect_info RegionGroupId.Map.t; } [@@deriving show] (** An instantiated function signature. See {!fun_sig} *) -type inst_fun_sig = { - inputs : ty list; - output : ty; - doutputs : ty list; - info : fun_sig_info; -} -[@@deriving show] +type inst_fun_sig = { inputs : ty list; output : ty } [@@deriving show] type fun_body = { inputs : var list; diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 7f122f15..d92b3de0 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -1358,11 +1358,7 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = } in - { - fwd_info; - back_info = fun_sig_info.back_info; - effect_info = loop_effect_info; - } + { fwd_info; effect_info = loop_effect_info } in assert (fun_sig_info_is_wf loop_sig_info); @@ -2187,7 +2183,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) : in (* TODO: *) assert (not !Config.return_back_funs); - let { fwd_info; back_info; effect_info } = info in + let { fwd_info; effect_info } = info in let { has_fuel; @@ -2212,7 +2208,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) : } in - let info = { fwd_info; back_info; effect_info } in + let info = { fwd_info; effect_info } in assert (fun_sig_info_is_wf info); let signature = { generics; llbc_generics; preds; inputs; output; doutputs; info } diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 3c038149..dfea255a 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -73,12 +73,6 @@ let inputs_info_is_wf (info : inputs_info) : bool = let fun_sig_info_is_wf (info : fun_sig_info) : bool = inputs_info_is_wf info.fwd_info - && - match info.back_info with - | SingleBack None -> true - | SingleBack (Some info) -> inputs_info_is_wf info - | AllBacks infos -> - List.for_all inputs_info_is_wf (RegionGroupId.Map.values infos) let dest_arrow_ty (ty : ty) : ty * ty = match ty with @@ -210,9 +204,7 @@ let fun_sig_substitute (subst : subst) (sg : fun_sig) : inst_fun_sig = let subst = ty_substitute subst in let inputs = List.map subst sg.inputs in let output = subst sg.output in - let doutputs = List.map subst sg.doutputs in - let info = sg.info in - { inputs; output; doutputs; info } + { inputs; output } (** We use this to check whether we need to add parentheses around expressions. We only look for outer monadic let-bindings. diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index eba44e3e..456ec0f6 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -128,9 +128,9 @@ type bs_ctx = { trait_impls_ctx : trait_impls_context; fun_decl : A.fun_decl; bid : T.RegionGroupId.id option; (** TODO: rename *) - sg : fun_sig; - (** The function signature - useful in particular to translate [Panic] *) - fwd_sg : fun_sig; (** The signature of the forward function *) + sg : decomposed_fun_sig; + (** Information about the function signature - useful in particular to + translate [Panic] *) sv_to_var : var V.SymbolicValueId.Map.t; (** Whenever we encounter a new symbolic value (introduced because of a symbolic expansion or upon ending an abstraction, for instance) @@ -828,7 +828,7 @@ let get_fun_effect_info (fun_infos : fun_info A.FunDeclId.Map.t) is_rec = false; } -(** Translate a function signature. +(** Translate a function signature to a decomposed function signature. Note that the function also takes a list of names for the inputs, and computes, for every output for the backward functions, a corresponding @@ -839,26 +839,15 @@ let get_fun_effect_info (fun_infos : fun_info A.FunDeclId.Map.t) We use [bid] ("backward function id") only if we split the forward and the backward functions. *) -let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) - (sg : A.fun_sig) (input_names : string option list) - (bid : T.RegionGroupId.id option) : fun_sig_named_outputs = - assert (Option.is_none bid || not !Config.return_back_funs); +let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) + (fun_id : A.fun_id) (sg : A.fun_sig) (input_names : string option list) : + decomposed_fun_sig = let fun_infos = decls_ctx.fun_ctx.fun_infos in let type_infos = decls_ctx.type_ctx.type_infos in (* Retrieve the list of parent backward functions *) let regions_hierarchy = FunIdMap.find fun_id decls_ctx.fun_ctx.regions_hierarchies in - let gid, parents = - match bid with - | None -> (None, T.RegionGroupId.Set.empty) - | Some bid -> - let parents = list_ancestor_region_groups regions_hierarchy bid in - (Some bid, parents) - in - (* Is the function stateful, and can it fail? *) - let lid = None in - let effect_info = get_fun_effect_info fun_infos (FunId fun_id) lid bid in (* We need an evaluation context to normalize the types (to normalize the associated types, etc. - for instance it may happen that the types refer to the types associated to a trait ref, but where the trait ref @@ -886,17 +875,52 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) { sg with A.inputs; output } in - (* List the inputs for: - * - the fuel - * - the forward function - * - the parent backward functions, in proper order - * - the current backward function (if it is a backward function) - *) - let fuel = mk_fuel_input_ty_as_list effect_info in - let fwd_inputs = List.map (translate_fwd_ty type_infos) sg.inputs in - (* For the backward functions: for now we don't supported nested borrows, - * so just check that there aren't parent regions *) - assert (T.RegionGroupId.Set.is_empty parents); + (* Is the forward function stateful, and can it fail? *) + let fwd_effect_info = + get_fun_effect_info fun_infos (FunId fun_id) None None + in + (* Compute the forward inputs *) + let fwd_fuel = mk_fuel_input_ty_as_list fwd_effect_info in + let fwd_inputs_no_fuel_no_state = + List.map (translate_fwd_ty type_infos) sg.inputs + in + (* State input for the forward function *) + let fwd_state_ty = + (* For the forward state, we check if the *whole group* is stateful. + See {!effect_info}. *) + if fwd_effect_info.stateful_group then [ mk_state_ty ] else [] + in + let fwd_inputs = + List.concat [ fwd_fuel; fwd_inputs_no_fuel_no_state; fwd_state_ty ] + in + (* Compute the backward output, without the effect information *) + let fwd_output = translate_fwd_ty type_infos sg.output in + (* The additinoal information *) + let fwd_info = + (* *) + let has_fuel = fwd_fuel <> [] in + let num_inputs_no_fuel_no_state = List.length fwd_inputs in + let num_inputs_with_fuel_no_state = + (* We use the fact that [fuel] has length 1 if we use some fuel, 0 otherwise *) + List.length fwd_fuel + num_inputs_no_fuel_no_state + in + let fwd_info : inputs_info = + { + has_fuel; + num_inputs_no_fuel_no_state; + num_inputs_with_fuel_no_state; + num_inputs_with_fuel_with_state = + (* We use the fact that [fwd_state_ty] has length 1 if there is a state, + and 0 otherwise *) + num_inputs_with_fuel_no_state + List.length fwd_state_ty; + } + in + let info = { fwd_info; effect_info = fwd_effect_info } in + assert (fun_sig_info_is_wf info); + info + in + + (* Compute the type information for the backward function *) (* Small helper to translate types for backward functions *) let translate_back_ty_for_gid (gid : T.RegionGroupId.id) (ty : T.ty) : ty option = @@ -923,7 +947,11 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) let inside_mut = false in translate_back_ty type_infos keep_region inside_mut ty in - let translate_back_inputs_for_gid gid : ty list = + let translate_back_inputs_for_gid (gid : T.RegionGroupId.id) : ty list = + (* For now we don't supported nested borrows, so we check that there + aren't parent regions *) + let parents = list_ancestor_region_groups regions_hierarchy gid in + assert (T.RegionGroupId.Set.is_empty parents); (* For now, we don't allow nested borrows, so the additional inputs to the backward function can only come from borrows that were returned like in (for the backward function we introduce for 'a): @@ -935,45 +963,6 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) *) List.filter_map (translate_back_ty_for_gid gid) [ sg.output ] in - (* Compute the additinal inputs for the current function, if it is a backward - * function *) - let back_inputs = - match gid with None -> [] | Some gid -> translate_back_inputs_for_gid gid - in - (* If the function is stateful, the inputs are: - - forward: [fwd_ty0, ..., fwd_tyn, state] - - backward: - - if {!Config.backward_no_state_update}: [fwd_ty0, ..., fwd_tyn, state, back_ty, state] - - otherwise: [fwd_ty0, ..., fwd_tyn, state, back_ty] - - The backward takes the same state as input as the forward function, - together with the state at the point where it gets called, if it is - stateful. - - See the comments for {!Config.backward_no_state_update} - *) - let fwd_state_ty = - (* For the forward state, we check if the *whole group* is stateful. - See {!effect_info}. *) - if effect_info.stateful_group then [ mk_state_ty ] else [] - in - let mk_back_state_ty_for_gid (gid : RegionGroupId.id option) : ty list = - (* For the backward state, we check if the function is a backward function, - and it is stateful *) - if effect_info.stateful && Option.is_some gid then [ mk_state_ty ] else [] - in - let back_state_ty = mk_back_state_ty_for_gid gid in - - (* Concatenate the inputs, in the following order: - * - forward inputs - * - forward state input - * - backward inputs - * - backward state input - *) - let inputs = - List.concat [ fuel; fwd_inputs; fwd_state_ty; back_inputs; back_state_ty ] - in - (* Outputs *) let compute_back_outputs_for_gid (gid : RegionGroupId.id) : string option list * ty list = (* The outputs are the borrows inside the regions of the abstractions @@ -998,103 +987,111 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id) in List.split outputs in - let output_names, doutputs = - match gid with - | None -> - (* This is a forward function: there is one (unnamed) output. - - If we merge the fwd/back functions we might need to compute - the information about the back outputs. - *) - (* TODO: *) - assert (not !Config.return_back_funs); - ([ None ], [ translate_fwd_ty type_infos sg.output ]) - | Some gid -> - (* This is a backward function: there might be several outputs. *) - compute_back_outputs_for_gid gid - in - (* Create the return type *) - let output = - (* Group the outputs together *) - let output = mk_simpl_tuple_ty doutputs in - (* Add the output state *) - let output = - if effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; output ] - else output + let compute_back_info_for_group (rg : T.region_var_group) : + RegionGroupId.id * back_sg_info = + let gid = rg.id in + let back_effect_info = + get_fun_effect_info fun_infos (FunId fun_id) None (Some gid) in - (* Wrap in a result type *) - if effect_info.can_fail then mk_result_ty output else output + let inputs_no_state = translate_back_inputs_for_gid gid in + let inputs_no_state_names = + List.map (fun _ -> Some "ret") inputs_no_state + in + let state_ty, state_name = + if back_effect_info.stateful then ([ mk_state_ty ], [ None ]) else ([], []) + in + let inputs = inputs_no_state @ state_ty in + let input_names = inputs_no_state_names @ state_name in + let output_names, outputs = compute_back_outputs_for_gid gid in + let info = + { + inputs; + input_names; + outputs; + output_names; + effect_info = back_effect_info; + } + in + (gid, info) in + let back_sg = + RegionGroupId.Map.of_list + (List.map compute_back_info_for_group regions_hierarchy) + in + (* Generic parameters *) let generics = translate_generic_params sg.generics in + (* Return *) - (* TODO: *) - assert (not !Config.return_back_funs); - let has_fuel = fuel <> [] in - let num_fwd_inputs_no_fuel_no_state = List.length fwd_inputs in - let num_fwd_inputs_with_fuel_no_state = - (* We use the fact that [fuel] has length 1 if we use some fuel, 0 otherwise *) - List.length fuel + num_fwd_inputs_no_fuel_no_state - in - let num_back_inputs_no_state = - if bid = None then None else Some (List.length back_inputs) - in - let fwd_info : inputs_info = - { - has_fuel; - num_inputs_no_fuel_no_state = num_fwd_inputs_no_fuel_no_state; - num_inputs_with_fuel_no_state = num_fwd_inputs_with_fuel_no_state; - num_inputs_with_fuel_with_state = - (* We use the fact that [fwd_state_ty] has length 1 if there is a state, - and 0 otherwise *) - num_fwd_inputs_with_fuel_no_state + List.length fwd_state_ty; - } + let preds = translate_predicates sg.preds in + { + generics; + llbc_generics = sg.generics; + preds; + fwd_inputs; + fwd_output; + back_sg; + fwd_info; + } + +let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) + (gid : RegionGroupId.id option) : fun_sig = + let generics = dsg.generics in + let llbc_generics = dsg.llbc_generics in + let preds = dsg.preds in + (* Compute the effects info *) + let fwd_info = dsg.fwd_info in + let back_effect_info = + RegionGroupId.Map.of_list + (List.map + (fun ((gid, info) : RegionGroupId.id * back_sg_info) -> + (gid, info.effect_info)) + (RegionGroupId.Map.bindings dsg.back_sg)) in - let compute_back_info (back_state_ty : ty list) - (num_back_inputs_no_state : int) : inputs_info = - let n = num_back_inputs_no_state in - (* Note that backward functions never use fuel *) - { - has_fuel = false; - num_inputs_no_fuel_no_state = n; - num_inputs_with_fuel_no_state = n; - (* Length of [back_state_ty]: similar trick as for [fwd_state_ty] *) - num_inputs_with_fuel_with_state = n + List.length back_state_ty; - } + (* Two cases depending on whether we split the forward/backward functions + or not *) + let mk_output_ty (effect_info : fun_effect_info) output = + let output = + if effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; output ] + else output + in + if effect_info.can_fail then mk_result_ty output else output in - let back_info : back_inputs_info = - if !Config.return_back_funs then - (* Create the map *) - AllBacks - (RegionGroupId.Map.of_list - (List.map - (fun (rg : T.region_var_group) -> - ( rg.id, - let back_inputs = translate_back_inputs_for_gid rg.id in - let num_back_inputs = List.length back_inputs in - (* TODO: slightly overkill *) - let back_state_ty = mk_back_state_ty_for_gid (Some rg.id) in - compute_back_info back_state_ty num_back_inputs )) - regions_hierarchy)) + let inputs, output = + if !Config.return_back_funs then ( + assert (gid = None); + (* Compute the arrow types for all the backward functions *) + let back_tys = + List.map + (fun (back_sg : back_sg_info) -> + let effect_info = back_sg.effect_info in + let inputs = dsg.fwd_inputs @ back_sg.inputs in + let output = mk_simpl_tuple_ty back_sg.outputs in + let output = mk_output_ty effect_info output in + mk_arrows inputs output) + (RegionGroupId.Map.values dsg.back_sg) + in + (* Group the forward output and the types of the backward functions *) + let effect_info = dsg.fwd_info.effect_info in + let output = mk_simpl_tuple_ty (dsg.fwd_output :: back_tys) in + let output = mk_output_ty effect_info output in + let inputs = dsg.fwd_inputs in + (inputs, output)) else - SingleBack - (Option.map (compute_back_info back_state_ty) num_back_inputs_no_state) - in - let info = { fwd_info; back_info; effect_info } in - assert (fun_sig_info_is_wf info); - let preds = translate_predicates sg.preds in - let sg = - { - generics; - llbc_generics = sg.generics; - preds; - inputs; - output; - doutputs; - info; - } - in - { sg; output_names } + match gid with + | None -> + let effect_info = dsg.fwd_info.effect_info in + let output = mk_output_ty effect_info dsg.fwd_output in + (dsg.fwd_inputs, output) + | Some gid -> + let back_sg = RegionGroupId.Map.find gid dsg.back_sg in + let effect_info = back_sg.effect_info in + let inputs = dsg.fwd_inputs @ back_sg.inputs in + let output = mk_simpl_tuple_ty back_sg.outputs in + let output = mk_output_ty effect_info output in + (inputs, output) + in + { generics; llbc_generics; preds; inputs; output; fwd_info; back_effect_info } let bs_ctx_fresh_state_var (ctx : bs_ctx) : bs_ctx * typed_pattern = (* Generate the fresh variable *) -- cgit v1.2.3 From 62cb926e76ef0c9fb048b0e340bdae5b9dd76a84 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 15 Dec 2023 14:06:16 +0100 Subject: Make progress on updating SymbolicToPure --- compiler/SymbolicToPure.ml | 169 ++++++++++++++++++++++++++++++--------------- 1 file changed, 112 insertions(+), 57 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 456ec0f6..d62cc829 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -127,7 +127,15 @@ type bs_ctx = { trait_decls_ctx : trait_decls_context; trait_impls_ctx : trait_impls_context; fun_decl : A.fun_decl; - bid : T.RegionGroupId.id option; (** TODO: rename *) + bid : RegionGroupId.id option; + (** TODO: rename + + The id of the group region we are currently translating. + If we split the forward/backward functions, we set this id at the + very beginning of the translation. + If we don't split, we set it to `None`, then update it when we enter + an expression which is specific to a backward function. + *) sg : decomposed_fun_sig; (** Information about the function signature - useful in particular to translate [Panic] *) @@ -139,7 +147,7 @@ type bs_ctx = { var_counter : VarId.generator; state_var : VarId.id; (** The current state variable, in case the function is stateful *) - back_state_var : VarId.id; + back_state_vars : VarId.id RegionGroupId.Map.t; (** The additional input state variable received by a stateful backward function. When generating stateful functions, we generate code of the following form: @@ -163,16 +171,16 @@ type bs_ctx = { (** The input parameters for the forward function corresponding to the translated Rust inputs (no fuel, no state). *) - backward_inputs : var list T.RegionGroupId.Map.t; + backward_inputs : var list RegionGroupId.Map.t; (** The additional input parameters for the backward functions coming from the borrows consumed upon ending the lifetime (as a consequence those don't include the backward state, if there is one). *) - backward_outputs : var list T.RegionGroupId.Map.t; + backward_outputs : var list RegionGroupId.Map.t; (** The variables that the backward functions will output, corresponding to the borrows they give back (don't include the backward state) *) - loop_backward_outputs : var list T.RegionGroupId.Map.t option; + loop_backward_outputs : var list RegionGroupId.Map.t option; (** Same as {!backward_outputs}, but for loops (if we entered a loop). [None] if we are not inside a loop, [Some] otherwise (and whatever @@ -300,6 +308,13 @@ let typed_pattern_to_string (ctx : bs_ctx) (p : Pure.typed_pattern) : string = let env = bs_ctx_to_pure_fmt_env ctx in PrintPure.typed_pattern_to_string env p +let ctx_get_effect_info (ctx : bs_ctx) : fun_effect_info = + match ctx.bid with + | None -> ctx.sg.fwd_info.effect_info + | Some bid -> + let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in + back_sg.effect_info + (* TODO: move *) let abs_to_string (ctx : bs_ctx) (abs : V.abs) : string = let env = bs_ctx_to_fmt_env ctx in @@ -1034,6 +1049,24 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) fwd_info; } +let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty + = + let output = + if effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; ty ] else ty + in + if effect_info.can_fail then mk_result_ty output else output + +(** Compute the arrow types for all the backward functions *) +let compute_back_tys (dsg : Pure.decomposed_fun_sig) : ty list = + List.map + (fun (back_sg : back_sg_info) -> + let effect_info = back_sg.effect_info in + let inputs = dsg.fwd_inputs @ back_sg.inputs in + let output = mk_simpl_tuple_ty back_sg.outputs in + let output = mk_output_ty_from_effect_info effect_info output in + mk_arrows inputs output) + (RegionGroupId.Map.values dsg.back_sg) + let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) (gid : RegionGroupId.id option) : fun_sig = let generics = dsg.generics in @@ -1050,27 +1083,13 @@ let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) in (* Two cases depending on whether we split the forward/backward functions or not *) - let mk_output_ty (effect_info : fun_effect_info) output = - let output = - if effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; output ] - else output - in - if effect_info.can_fail then mk_result_ty output else output - in + let mk_output_ty = mk_output_ty_from_effect_info in + let inputs, output = if !Config.return_back_funs then ( assert (gid = None); (* Compute the arrow types for all the backward functions *) - let back_tys = - List.map - (fun (back_sg : back_sg_info) -> - let effect_info = back_sg.effect_info in - let inputs = dsg.fwd_inputs @ back_sg.inputs in - let output = mk_simpl_tuple_ty back_sg.outputs in - let output = mk_output_ty effect_info output in - mk_arrows inputs output) - (RegionGroupId.Map.values dsg.back_sg) - in + let back_tys = compute_back_tys dsg in (* Group the forward output and the types of the backward functions *) let effect_info = dsg.fwd_info.effect_info in let output = mk_simpl_tuple_ty (dsg.fwd_output :: back_tys) in @@ -1584,30 +1603,43 @@ and translate_panic (ctx : bs_ctx) : texpression = * but it won't be true anymore once we translate individual blocks *) (* If we use a state monad, we need to add a lambda for the state variable *) (* Note that only forward functions return a state *) - let output_ty = - if ctx.inside_loop && Option.is_some ctx.bid then - (* We are synthesizing the backward function of a loop body *) - let bid = Option.get ctx.bid in - let back_vars = - T.RegionGroupId.Map.find bid (Option.get ctx.loop_backward_outputs) - in - let tys = List.map (fun (v : var) -> v.ty) back_vars in - mk_simpl_tuple_ty tys - else - (* Regular function, or forward function (the forward translation for - a loop has the same return type as the parent function) - *) - mk_simpl_tuple_ty ctx.sg.doutputs - in + let effect_info = ctx_get_effect_info ctx in (* TODO: we should use a [Fail] function *) - if ctx.sg.info.effect_info.stateful then - (* Create the [Fail] value *) - let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in - let ret_v = - mk_result_fail_texpression_with_error_id error_failure_id ret_ty + let mk_output output_ty = + if effect_info.stateful then + (* Create the [Fail] value *) + let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in + let ret_v = + mk_result_fail_texpression_with_error_id error_failure_id ret_ty + in + ret_v + else mk_result_fail_texpression_with_error_id error_failure_id output_ty + in + if ctx.inside_loop && Option.is_some ctx.bid then + (* We are synthesizing the backward function of a loop body *) + let bid = Option.get ctx.bid in + let back_vars = + T.RegionGroupId.Map.find bid (Option.get ctx.loop_backward_outputs) in - ret_v - else mk_result_fail_texpression_with_error_id error_failure_id output_ty + let tys = List.map (fun (v : var) -> v.ty) back_vars in + let output = mk_simpl_tuple_ty tys in + mk_output output + else + (* Regular function, or forward function (the forward translation for + a loop has the same return type as the parent function) + *) + match ctx.bid with + | None -> + if !Config.return_back_funs then + let back_tys = compute_back_tys ctx.sg in + let output = mk_simpl_tuple_ty (ctx.sg.fwd_output :: back_tys) in + mk_output output + else mk_output ctx.sg.fwd_output + | Some bid -> + let output = + mk_simpl_tuple_ty (RegionGroupId.Map.find bid ctx.sg.back_sg).outputs + in + mk_output output (** [opt_v]: the value to return, in case we translate a forward body *) and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) @@ -1641,7 +1673,7 @@ and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) * - error-monad: Return x * - state-error: Return (state, x) * *) - let effect_info = ctx.sg.info.effect_info in + let effect_info = ctx_get_effect_info ctx in let output = if effect_info.stateful then let state_rvalue = mk_state_texpression ctx.state_var in @@ -1695,7 +1727,7 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) * effect - in particular, one manipulates a state iff the other does * the same. * *) - let effect_info = ctx.sg.info.effect_info in + let effect_info = ctx_get_effect_info ctx in let output = if effect_info.stateful then let state_rvalue = mk_state_texpression ctx.state_var in @@ -2550,24 +2582,50 @@ and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option) and translate_forward_end (ectx : C.eval_ctx) (loop_input_values : V.typed_value S.symbolic_value_id_map option) - (e : S.expression) (back_e : S.expression S.region_group_id_map) + (fwd_e : S.expression) (back_e : S.expression S.region_group_id_map) (ctx : bs_ctx) : texpression = - (* Update the current state with the additional state received by the backward - function, if needs be, and lookup the proper expression *) - let translate_end ctx = + (* TODO: *) + assert (not !Config.return_back_funs); + + let translate_one_end ctx (bid : RegionGroupId.id option) = (* Update the current state with the additional state received by the backward function, if needs be, and lookup the proper expression *) let ctx, e = match ctx.bid with - | None -> (ctx, e) + | None -> + (* We are translating the forward function - nothing to do *) + (ctx, fwd_e) | Some bid -> - let ctx = { ctx with state_var = ctx.back_state_var } in + (* There are two cases here: + - if we split the fwd/backward functions, we simply need to update + the state + - if we don't split, we also need to wrap the expression in a + lambda, which introduces the additional inputs of the backward + function + *) + let back_state_var = RegionGroupId.Map.find bid ctx.back_state_vars in + let ctx = { ctx with state_var = back_state_var } in let e = T.RegionGroupId.Map.find bid back_e in (ctx, e) in translate_expression e ctx in + (* There are two cases, depending on whether we are splitting the forward/backward + functions or not. + + - if we split, then we simply need to translate the proper "end" expression, + that is the end of the forward function, or of the backward function we + are currently translating. + - if we don't split, then we need to translate the end of the forward + function (this is the value we will return) and generate the bodies + of the backward functions (which we will also return). + + Update the current state with the additional state received by the backward + function, if needs be, and lookup the proper expression. + *) + let translate_end ctx = failwith "TODO" in + (* If we are (re-)entering a loop, we need to introduce a call to the forward translation of the loop. *) match loop_input_values with @@ -2617,10 +2675,7 @@ and translate_forward_end (ectx : C.eval_ctx) in (* Introduce a fresh output value for the forward function *) - let ctx, output_var = - let output_ty = mk_simpl_tuple_ty ctx.fwd_sg.doutputs in - fresh_var None output_ty ctx - in + let ctx, output_var = fresh_var None ctx.sg.fwd_output ctx in let args, ctx, out_pats = let output_pat = mk_typed_pattern_from_var output_var None in @@ -2832,7 +2887,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (* Add the input state *) let input_state = - if ctx.sg.info.effect_info.stateful then Some ctx.state_var else None + if (ctx_get_effect_info ctx).stateful then Some ctx.state_var else None in (* Translate the loop body *) -- cgit v1.2.3 From ea583d9f0f5e4a1a687b70f0e04e875969462157 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 15 Dec 2023 17:20:30 +0100 Subject: Make good progress on updating SymbolicToPure --- compiler/PrintPure.ml | 8 ++ compiler/Pure.ml | 7 +- compiler/PureTypeCheck.ml | 6 ++ compiler/PureUtils.ml | 23 +++++ compiler/SymbolicToPure.ml | 224 +++++++++++++++++++++++++++++++++++++-------- 5 files changed, 226 insertions(+), 42 deletions(-) diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index 2fe5843e..3a5ce513 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -592,6 +592,14 @@ let rec texpression_to_string (env : fmt_env) (inside : bool) (indent : string) in "[ " ^ String.concat ", " fields ^ " ]" | _ -> raise (Failure "Unexpected")) + | Lambda _ -> + let pats, e = destruct_lambdas e in + let vars = + String.concat " " (List.map (typed_pattern_to_string env) pats) + in + let e = texpression_to_string env false indent indent_incr e in + let s = "λ " ^ vars ^ " => " ^ e in + if inside then "(" ^ s ^ ")" else s | Meta (meta, e) -> ( let meta_s = emeta_to_string env meta in let e = texpression_to_string env inside indent indent_incr e in diff --git a/compiler/Pure.ml b/compiler/Pure.ml index fb0509f4..eb6b00c8 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -728,6 +728,7 @@ type expression = | Switch of texpression * switch_body | Loop of loop (** See the comments for {!loop} *) | StructUpdate of struct_update (** See the comments for {!struct_update} *) + | Lambda of typed_pattern * texpression (** [λ x => e] *) | Meta of (emeta[@opaque]) * texpression (** Meta-information *) and switch_body = If of texpression * texpression | Match of match_branch list @@ -912,9 +913,9 @@ type fun_sig_info = { [@@deriving show] type back_sg_info = { - inputs : ty list; (** The additional inputs of the backward function *) - input_names : string option list; - (** The optional names for the additional inputs *) + inputs : (string option * ty) list; + (** The additional inputs of the backward function *) + inputs_no_state : (string option * ty) list; outputs : ty list; (** The "decomposed" list of outputs. diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml index a62a2361..3c1800a8 100644 --- a/compiler/PureTypeCheck.ml +++ b/compiler/PureTypeCheck.ml @@ -229,6 +229,12 @@ let rec check_texpression (ctx : tc_ctx) (e : texpression) : unit = check_texpression ctx fe) supd.updates | _ -> raise (Failure "Unexpected")) + | Lambda (pat, e_next) -> + assert (e.ty = e_next.ty); + (* Check the pattern and register the introduced variables at the same time *) + let ctx = check_typed_pattern ctx pat in + (* Check the next expression *) + check_texpression ctx e_next | Meta (_, e_next) -> assert (e_next.ty = e.ty); check_texpression ctx e_next diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index dfea255a..80b25641 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -221,6 +221,9 @@ let rec let_group_requires_parentheses (e : texpression) : bool = if monadic then true else let_group_requires_parentheses next_e | Switch (_, _) -> false | Meta (_, next_e) -> let_group_requires_parentheses next_e + | Lambda (_, _) -> + (* Being conservative here *) + true | Loop _ -> (* Should have been eliminated *) raise (Failure "Unreachable") @@ -713,3 +716,23 @@ let type_decl_from_type_id_is_tuple_struct (ctx : TypesAnalysis.type_infos) let info = TypeDeclId.Map.find id ctx in info.is_tuple_struct | TAssumed _ -> false + +let mk_lambda_from_var (var : var) (mp : mplace option) (e : texpression) : + texpression = + let ty = TArrow (var.ty, e.ty) in + let pat = PatVar (var, mp) in + let pat = { value = pat; ty = var.ty } in + let e = Lambda (pat, e) in + { e; ty } + +let mk_lambdas_from_vars (vars : var list) (mps : mplace option list) + (e : texpression) : texpression = + let vars = List.combine vars mps in + List.fold_left (fun e (v, mp) -> mk_lambda_from_var v mp e) e vars + +let rec destruct_lambdas (e : texpression) : typed_pattern list * texpression = + match e.e with + | Lambda (pat, e) -> + let pats, e = destruct_lambdas e in + (pat :: pats, e) + | _ -> ([], e) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index d62cc829..8e06db7c 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -121,9 +121,9 @@ type loop_info = { (** Body synthesis context *) type bs_ctx = { - type_context : type_context; - fun_context : fun_context; - global_context : global_context; + type_context : type_context; (* TODO: rename *) + fun_context : fun_context; (* TODO: rename *) + global_context : global_context; (* TODO: rename *) trait_decls_ctx : trait_decls_context; trait_impls_ctx : trait_impls_context; fun_decl : A.fun_decl; @@ -148,7 +148,9 @@ type bs_ctx = { state_var : VarId.id; (** The current state variable, in case the function is stateful *) back_state_vars : VarId.id RegionGroupId.Map.t; - (** The additional input state variable received by a stateful backward function. + (** The additional input state variable received by a stateful backward function, + **in case we are splitting the forward/backward functions**. + When generating stateful functions, we generate code of the following form: @@ -161,7 +163,9 @@ type bs_ctx = { When translating a backward function, we need at some point to update [state_var] with [back_state_var], to account for the fact that the state may have been updated by the caller between the call to the - forward function and the call to the backward function. + forward function and the call to the backward function. We also need + to make sure we use the same variable in all the branches (because + this variable is quantified at the definition level). *) fuel0 : VarId.id; (** The original fuel taken as input by the function (if we use fuel) *) @@ -171,10 +175,20 @@ type bs_ctx = { (** The input parameters for the forward function corresponding to the translated Rust inputs (no fuel, no state). *) - backward_inputs : var list RegionGroupId.Map.t; + backward_inputs_no_state : var list RegionGroupId.Map.t; (** The additional input parameters for the backward functions coming from the borrows consumed upon ending the lifetime (as a consequence those don't include the backward state, if there is one). + + If we split the forward/backward functions: we initialize this map + when initializing the bs_ctx, because those variables are quantified + at the definition level. Otherwise, we initialize it upon diving + into the expressions which are specific to the backward functions. + *) + backward_inputs_with_state : var list RegionGroupId.Map.t; + (** All the additional input parameters for the backward functions. + + Same remarks as for {!backward_inputs_no_state}. *) backward_outputs : var list RegionGroupId.Map.t; (** The variables that the backward functions will output, corresponding @@ -308,13 +322,17 @@ let typed_pattern_to_string (ctx : bs_ctx) (p : Pure.typed_pattern) : string = let env = bs_ctx_to_pure_fmt_env ctx in PrintPure.typed_pattern_to_string env p -let ctx_get_effect_info (ctx : bs_ctx) : fun_effect_info = - match ctx.bid with +let ctx_get_effect_info_for_bid (ctx : bs_ctx) (bid : RegionGroupId.id option) : + fun_effect_info = + match bid with | None -> ctx.sg.fwd_info.effect_info | Some bid -> let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in back_sg.effect_info +let ctx_get_effect_info (ctx : bs_ctx) : fun_effect_info = + ctx_get_effect_info_for_bid ctx ctx.bid + (* TODO: move *) let abs_to_string (ctx : bs_ctx) (abs : V.abs) : string = let env = bs_ctx_to_fmt_env ctx in @@ -1009,19 +1027,18 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) get_fun_effect_info fun_infos (FunId fun_id) None (Some gid) in let inputs_no_state = translate_back_inputs_for_gid gid in - let inputs_no_state_names = - List.map (fun _ -> Some "ret") inputs_no_state + let inputs_no_state = + List.map (fun ty -> (Some "ret", ty)) inputs_no_state in - let state_ty, state_name = - if back_effect_info.stateful then ([ mk_state_ty ], [ None ]) else ([], []) + let state = + if back_effect_info.stateful then [ (None, mk_state_ty) ] else [] in - let inputs = inputs_no_state @ state_ty in - let input_names = inputs_no_state_names @ state_name in + let inputs = inputs_no_state @ state in let output_names, outputs = compute_back_outputs_for_gid gid in let info = { inputs; - input_names; + inputs_no_state; outputs; output_names; effect_info = back_effect_info; @@ -1061,7 +1078,7 @@ let compute_back_tys (dsg : Pure.decomposed_fun_sig) : ty list = List.map (fun (back_sg : back_sg_info) -> let effect_info = back_sg.effect_info in - let inputs = dsg.fwd_inputs @ back_sg.inputs in + let inputs = dsg.fwd_inputs @ List.map snd back_sg.inputs in let output = mk_simpl_tuple_ty back_sg.outputs in let output = mk_output_ty_from_effect_info effect_info output in mk_arrows inputs output) @@ -1105,14 +1122,14 @@ let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) | Some gid -> let back_sg = RegionGroupId.Map.find gid dsg.back_sg in let effect_info = back_sg.effect_info in - let inputs = dsg.fwd_inputs @ back_sg.inputs in + let inputs = dsg.fwd_inputs @ List.map snd back_sg.inputs in let output = mk_simpl_tuple_ty back_sg.outputs in let output = mk_output_ty effect_info output in (inputs, output) in { generics; llbc_generics; preds; inputs; output; fwd_info; back_effect_info } -let bs_ctx_fresh_state_var (ctx : bs_ctx) : bs_ctx * typed_pattern = +let bs_ctx_fresh_state_var (ctx : bs_ctx) : bs_ctx * var * typed_pattern = (* Generate the fresh variable *) let id, var_counter = VarId.fresh ctx.var_counter in let state_var = @@ -1122,7 +1139,7 @@ let bs_ctx_fresh_state_var (ctx : bs_ctx) : bs_ctx * typed_pattern = (* Update the context *) let ctx = { ctx with var_counter; state_var = id } in (* Return *) - (ctx, state_pat) + (ctx, state_var, state_pat) (** WARNING: do not call this function directly. Call [fresh_named_var_for_symbolic_value] instead. *) @@ -1776,7 +1793,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let fuel = mk_fuel_input_as_list ctx effect_info in if effect_info.stateful then let state_var = mk_state_texpression ctx.state_var in - let ctx, nstate_var = bs_ctx_fresh_state_var ctx in + let ctx, _, nstate_var = bs_ctx_fresh_state_var ctx in (List.concat [ fuel; args; [ state_var ] ], ctx, Some nstate_var) else (List.concat [ fuel; args ], ctx, None) in @@ -2010,7 +2027,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) let back_state, ctx, nstate = if effect_info.stateful then let back_state = mk_state_texpression ctx.state_var in - let ctx, nstate = bs_ctx_fresh_state_var ctx in + let ctx, _, nstate = bs_ctx_fresh_state_var ctx in ([ back_state ], ctx, Some nstate) else ([], ctx, None) in @@ -2115,15 +2132,15 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) let-binding: {[ let id_back x nx = - let s = nx in // the name [s] is not important (only collision matters) - ... + let s = nx in // the name [s] is not important (only collision matters) + ... ]} This let-binding later gets inlined, during a micro-pass. *) (* First, retrieve the list of variables used for the inputs for the * backward function *) - let inputs = T.RegionGroupId.Map.find rg_id ctx.backward_inputs in + let inputs = T.RegionGroupId.Map.find rg_id ctx.backward_inputs_no_state in (* Retrieve the values consumed upon ending the loans inside this * abstraction: as there are no nested borrows, there should be none. *) let consumed = abs_to_consumed ctx ectx abs in @@ -2185,7 +2202,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) values consumed upon ending the abstraction (i.e., we don't use [abs_to_consumed]) *) let back_inputs_vars = - T.RegionGroupId.Map.find rg_id ctx.backward_inputs + T.RegionGroupId.Map.find rg_id ctx.backward_inputs_no_state in let back_inputs = List.map mk_texpression_from_var back_inputs_vars in (* If the function is stateful: @@ -2195,7 +2212,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) let back_state, ctx, nstate = if effect_info.stateful then let back_state = mk_state_texpression ctx.state_var in - let ctx, nstate = bs_ctx_fresh_state_var ctx in + let ctx, _, nstate = bs_ctx_fresh_state_var ctx in ([ back_state ], ctx, Some nstate) else ([], ctx, None) in @@ -2590,25 +2607,69 @@ and translate_forward_end (ectx : C.eval_ctx) let translate_one_end ctx (bid : RegionGroupId.id option) = (* Update the current state with the additional state received by the backward function, if needs be, and lookup the proper expression *) - let ctx, e = + let ctx, e, finish = match ctx.bid with | None -> (* We are translating the forward function - nothing to do *) - (ctx, fwd_e) + (ctx, fwd_e, fun e -> e) | Some bid -> (* There are two cases here: - if we split the fwd/backward functions, we simply need to update - the state + the state. - if we don't split, we also need to wrap the expression in a lambda, which introduces the additional inputs of the backward function *) - let back_state_var = RegionGroupId.Map.find bid ctx.back_state_vars in - let ctx = { ctx with state_var = back_state_var } in + let ctx = + (* Introduce variables for the inputs and the state variable + and update the context. *) + if !Config.return_back_funs then + (* If the forward/backward functions are not split, we need + to introduce fresh variables for the additional inputs, + because they are locally introduced in a lambda *) + let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in + let ctx = { ctx with bid = Some bid } in + let ctx, backward_inputs_no_state = + fresh_vars back_sg.inputs_no_state ctx + in + let ctx, backward_inputs_with_state = + if (ctx_get_effect_info ctx).stateful then + let ctx, var, _ = bs_ctx_fresh_state_var ctx in + (ctx, backward_inputs_no_state @ [ var ]) + else (ctx, backward_inputs_no_state) + in + { + ctx with + backward_inputs_no_state = + RegionGroupId.Map.add bid backward_inputs_no_state + ctx.backward_inputs_no_state; + backward_inputs_with_state = + RegionGroupId.Map.add bid backward_inputs_with_state + ctx.backward_inputs_with_state; + } + else + (* Update the state variable *) + let back_state_var = + RegionGroupId.Map.find bid ctx.back_state_vars + in + { ctx with state_var = back_state_var } + in + let e = T.RegionGroupId.Map.find bid back_e in - (ctx, e) + let finish e = + (* Wrap in lambdas if necessary *) + if !Config.return_back_funs then + let inputs = + RegionGroupId.Map.find bid ctx.backward_inputs_with_state + in + let places = List.map (fun _ -> None) inputs in + mk_lambdas_from_vars inputs places e + else e + in + (ctx, e, finish) in - translate_expression e ctx + let e = translate_expression e ctx in + finish e in (* There are two cases, depending on whether we are splitting the forward/backward @@ -2624,7 +2685,87 @@ and translate_forward_end (ectx : C.eval_ctx) Update the current state with the additional state received by the backward function, if needs be, and lookup the proper expression. *) - let translate_end ctx = failwith "TODO" in + let translate_end ctx = + if !Config.return_back_funs then + (* Compute the output of the forward function *) + let fwd_effect_info = ctx.sg.fwd_info.effect_info in + let output_ty = + let ty = ctx.sg.fwd_output in + if fwd_effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; ty ] + else ty + in + let ctx, fwd_var = fresh_var None output_ty ctx in + let ctx, state_var, state_pat = + if fwd_effect_info.stateful then + let ctx, var, pat = bs_ctx_fresh_state_var ctx in + (ctx, [ var ], [ pat ]) + else (ctx, [], []) + in + let fwd_e = translate_one_end ctx None in + + (* Introduce the backward functions *) + let back_el = + List.map + (fun ((gid, _) : RegionGroupId.id * back_sg_info) -> + translate_one_end ctx (Some gid)) + (RegionGroupId.Map.bindings ctx.sg.back_sg) + in + (* Introduce variables for the backward functions. + We lookup the LLBC definition in an attempt to derive pretty names + for those functions. *) + let back_var_names = + let def_id = ctx.fun_decl.def_id in + let sg = ctx.fun_decl.signature in + let regions_hierarchy = + LlbcAstUtils.FunIdMap.find (FRegular def_id) + ctx.fun_context.regions_hierarchies + in + List.map + (fun (gid, _) -> + let rg = RegionGroupId.nth regions_hierarchy gid in + let region_names = + List.map + (fun rid -> (T.RegionVarId.nth sg.generics.regions rid).name) + rg.regions + in + let name = + match region_names with + | [] -> "back" + | [ Some r ] -> "back" ^ r + | _ -> + (* Concatenate all the region names *) + "back" + ^ String.concat "" (List.filter_map (fun x -> x) region_names) + in + Some name) + (RegionGroupId.Map.bindings ctx.sg.back_sg) + in + let back_vars = List.combine back_var_names (compute_back_tys ctx.sg) in + let _, back_vars = fresh_vars back_vars ctx in + + (* Create the return expressions *) + let vars = fwd_var :: back_vars in + let vars = List.map mk_texpression_from_var vars in + let ret = mk_simpl_tuple_texpression vars in + let state_var = List.map mk_texpression_from_var state_var in + let ret = mk_simpl_tuple_texpression (state_var @ [ ret ]) in + let ret = mk_result_return_texpression ret in + + (* Bind the expressions for the backward function and the expression + for the computation of the forward output *) + let e = + List.fold_right + (fun (var, back_e) e -> + mk_let false (mk_typed_pattern_from_var var None) back_e e) + (List.combine back_vars back_el) + ret + in + (* Bind the expression for the forward output *) + let fwd_var = mk_typed_pattern_from_var fwd_var None in + let pat = mk_simpl_tuple_pattern (state_pat @ [ fwd_var ]) in + mk_let fwd_effect_info.can_fail pat fwd_e e + else translate_one_end ctx ctx.bid + in (* If we are (re-)entering a loop, we need to introduce a call to the forward translation of the loop. *) @@ -2687,7 +2828,7 @@ and translate_forward_end (ectx : C.eval_ctx) let fuel = mk_fuel_input_as_list ctx effect_info in if effect_info.stateful then let state_var = mk_state_texpression ctx.state_var in - let ctx, nstate_pat = bs_ctx_fresh_state_var ctx in + let ctx, _, nstate_pat = bs_ctx_fresh_state_var ctx in ( List.concat [ fuel; args; [ state_var ] ], ctx, [ nstate_pat; output_pat ] ) @@ -3025,8 +3166,8 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = let def_id = def.def_id in let llbc_name = def.name in let name = name_to_string ctx llbc_name in - (* Retrieve the signature *) - let signature = ctx.sg in + (* Translate the signature *) + let signature = translate_fun_sig_from_decomposed ctx.sg ctx.bid in let regions_hierarchy = FunIdMap.find (FRegular def_id) ctx.fun_context.regions_hierarchies in @@ -3070,20 +3211,25 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = match bid with | None -> [] | Some back_id -> + assert (not !Config.return_back_funs); let parents_ids = list_ordered_ancestor_region_groups regions_hierarchy back_id in let backward_ids = List.append parents_ids [ back_id ] in List.concat (List.map - (fun id -> T.RegionGroupId.Map.find id ctx.backward_inputs) + (fun id -> + T.RegionGroupId.Map.find id ctx.backward_inputs_no_state) backward_ids) in (* Introduce the backward input state (the state at call site of the * *backward* function), if necessary *) let back_state = if effect_info.stateful && Option.is_some bid then - [ mk_state_var ctx.back_state_var ] + let state_var = + RegionGroupId.Map.find (Option.get bid) ctx.back_state_vars + in + [ mk_state_var state_var ] else [] in (* Group the inputs together *) -- cgit v1.2.3 From 5fa83883b4d573cfd252478f7937c8bde0ec01f6 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 15 Dec 2023 17:22:01 +0100 Subject: Minor fix --- compiler/SymbolicToPure.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 8e06db7c..08f9e950 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -2605,10 +2605,11 @@ and translate_forward_end (ectx : C.eval_ctx) assert (not !Config.return_back_funs); let translate_one_end ctx (bid : RegionGroupId.id option) = + let ctx = { ctx with bid } in (* Update the current state with the additional state received by the backward function, if needs be, and lookup the proper expression *) let ctx, e, finish = - match ctx.bid with + match bid with | None -> (* We are translating the forward function - nothing to do *) (ctx, fwd_e, fun e -> e) @@ -2628,7 +2629,6 @@ and translate_forward_end (ectx : C.eval_ctx) to introduce fresh variables for the additional inputs, because they are locally introduced in a lambda *) let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in - let ctx = { ctx with bid = Some bid } in let ctx, backward_inputs_no_state = fresh_vars back_sg.inputs_no_state ctx in -- cgit v1.2.3 From 955fdab55304979ba2d61432ea654241f20abaa4 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 15 Dec 2023 18:14:12 +0100 Subject: Make progress on propagating the changes --- compiler/Extract.ml | 8 ++-- compiler/PrintPure.ml | 16 ++----- compiler/Pure.ml | 3 +- compiler/PureMicroPasses.ml | 110 ++++++++++++++++++++++---------------------- compiler/PureTypeCheck.ml | 8 +--- compiler/PureUtils.ml | 24 +++------- 6 files changed, 72 insertions(+), 97 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 1ea26d79..7e2efd8a 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -285,9 +285,9 @@ let rec extract_texpression (ctx : extraction_ctx) (fmt : F.formatter) | App _ -> let app, args = destruct_apps e in extract_App ctx fmt inside app args - | Abs _ -> - let xl, e = destruct_abs_list e in - extract_Abs ctx fmt inside xl e + | Lambda _ -> + let xl, e = destruct_lambdas e in + extract_Lambda ctx fmt inside xl e | Qualif _ -> (* We use the app case *) extract_App ctx fmt inside e [] @@ -574,7 +574,7 @@ and extract_field_projector (ctx : extraction_ctx) (fmt : F.formatter) (* No argument: shouldn't happen *) raise (Failure "Unreachable") -and extract_Abs (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) +and extract_Lambda (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (xl : typed_pattern list) (e : texpression) : unit = (* Open a box for the abs expression *) F.pp_open_hovbox fmt ctx.indent_incr; diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index 3a5ce513..79506c04 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -543,9 +543,9 @@ let rec texpression_to_string (env : fmt_env) (inside : bool) (indent : string) let app, args = destruct_apps e in (* Convert to string *) app_to_string env inside indent indent_incr app args - | Abs _ -> - let xl, e = destruct_abs_list e in - let e = abs_to_string env indent indent_incr xl e in + | Lambda _ -> + let xl, e = destruct_lambdas e in + let e = lambda_to_string env indent indent_incr xl e in if inside then "(" ^ e ^ ")" else e | Qualif _ -> (* Qualifier without arguments *) @@ -592,14 +592,6 @@ let rec texpression_to_string (env : fmt_env) (inside : bool) (indent : string) in "[ " ^ String.concat ", " fields ^ " ]" | _ -> raise (Failure "Unexpected")) - | Lambda _ -> - let pats, e = destruct_lambdas e in - let vars = - String.concat " " (List.map (typed_pattern_to_string env) pats) - in - let e = texpression_to_string env false indent indent_incr e in - let s = "λ " ^ vars ^ " => " ^ e in - if inside then "(" ^ s ^ ")" else s | Meta (meta, e) -> ( let meta_s = emeta_to_string env meta in let e = texpression_to_string env inside indent indent_incr e in @@ -668,7 +660,7 @@ and app_to_string (env : fmt_env) (inside : bool) (indent : string) (* Add parentheses *) if all_args <> [] && inside then "(" ^ e ^ ")" else e -and abs_to_string (env : fmt_env) (indent : string) (indent_incr : string) +and lambda_to_string (env : fmt_env) (indent : string) (indent_incr : string) (xl : typed_pattern list) (e : texpression) : string = let xl = List.map (typed_pattern_to_string env) xl in let e = texpression_to_string env false indent indent_incr e in diff --git a/compiler/Pure.ml b/compiler/Pure.ml index eb6b00c8..ddacf0c4 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -684,7 +684,7 @@ type expression = field accesses with calls to projectors over fields (when there are clashes of field names, some provers like F* get pretty bad...) *) - | Abs of typed_pattern * texpression (** Lambda abstraction: [fun x -> e] *) + | Lambda of typed_pattern * texpression (** Lambda abstraction: [λ x => e] *) | Qualif of qualif (** A top-level qualifier *) | Let of bool * typed_pattern * texpression * texpression (** Let binding. @@ -728,7 +728,6 @@ type expression = | Switch of texpression * switch_body | Loop of loop (** See the comments for {!loop} *) | StructUpdate of struct_update (** See the comments for {!struct_update} *) - | Lambda of typed_pattern * texpression (** [λ x => e] *) | Meta of (emeta[@opaque]) * texpression (** Meta-information *) and switch_body = If of texpression * texpression | Match of match_branch list diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index d92b3de0..0102b13e 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -385,17 +385,17 @@ let compute_pretty_names (def : fun_decl) : fun_decl = let ctx, arg = update_texpression arg ctx in let e = App (app, arg) in (ctx, e) - | Abs (x, e) -> update_abs x e ctx | Qualif _ -> (* nothing to do *) (ctx, e.e) | Let (monadic, lb, re, e) -> update_let monadic lb re e ctx | Switch (scrut, body) -> update_switch_body scrut body ctx | Loop loop -> update_loop loop ctx | StructUpdate supd -> update_struct_update supd ctx + | Lambda (lb, e) -> update_lambda lb e ctx | Meta (meta, e) -> update_emeta meta e ctx in (ctx, { e; ty }) (* *) - and update_abs (x : typed_pattern) (e : texpression) (ctx : pn_ctx) : + and update_lambda (x : typed_pattern) (e : texpression) (ctx : pn_ctx) : pn_ctx * expression = (* We first add the left-constraint *) let ctx = add_left_constraint x ctx in @@ -404,7 +404,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = (* Update the abstracted value *) let x = update_typed_pattern ctx x in (* Put together *) - (ctx, Abs (x, e)) + (ctx, Lambda (x, e)) (* *) and update_let (monadic : bool) (lv : typed_pattern) (re : texpression) (e : texpression) (ctx : pn_ctx) : pn_ctx * expression = @@ -890,12 +890,12 @@ let expression_contains_child_call_in_all_paths (ctx : trans_ctx) let call_is_child = check_call func1 generics1 args1 in if call_is_child then fun () -> true else fun () -> self#visit_texpression env e ()) + | Lambda (_, e) -> self#visit_texpression env e | App _ -> ( fun () -> match opt_destruct_function_call e with | Some (func1, tys1, args1) -> check_call func1 tys1 args1 | None -> false) - | Abs (_, e) -> self#visit_texpression env e | Qualif _ -> (* Note that this case includes functions without arguments *) fun () -> false @@ -975,7 +975,7 @@ let filter_useless (filter_monadic_calls : bool) (ctx : trans_ctx) | Var _ | CVar _ | Const _ | App _ | Qualif _ | Switch (_, _) | Meta (_, _) - | StructUpdate _ | Abs _ -> + | StructUpdate _ | Lambda _ -> super#visit_expression env e | Let (monadic, lv, re, e) -> (* Compute the set of values used in the next expression *) @@ -1323,28 +1323,20 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = method! visit_Loop env loop = let fun_sig = def.signature in - let fun_sig_info = fun_sig.info in - let fun_effect_info = fun_sig_info.effect_info in + let fwd_info = fun_sig.fwd_info in + let fwd_effect_info = fwd_info.effect_info in (* TODO: *) assert (not !Config.return_back_funs); (* Generate the loop definition *) - let loop_effect_info = - { - stateful_group = fun_effect_info.stateful_group; - stateful = fun_effect_info.stateful; - can_fail = fun_effect_info.can_fail; - can_diverge = fun_effect_info.can_diverge; - is_rec = fun_effect_info.is_rec; - } - in + let loop_fwd_effect_info = fwd_effect_info in - let loop_sig_info = + let loop_fwd_sig_info : fun_sig_info = let fuel = if !Config.use_fuel then 1 else 0 in let num_inputs = List.length loop.inputs in let fwd_info : inputs_info = - let info = fun_sig_info.fwd_info in + let info = fwd_info.fwd_info in let fwd_state = info.num_inputs_with_fuel_with_state - info.num_inputs_with_fuel_no_state @@ -1358,48 +1350,48 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = } in - { fwd_info; effect_info = loop_effect_info } + { fwd_info; effect_info = loop_fwd_effect_info } in - assert (fun_sig_info_is_wf loop_sig_info); + assert (fun_sig_info_is_wf loop_fwd_sig_info); let inputs_tys = - (* TODO: *) - assert (not !Config.return_back_funs); - let fuel = if !Config.use_fuel then [ mk_fuel_ty ] else [] in let fwd_inputs = List.map (fun (v : var) -> v.ty) loop.inputs in - let info = fun_sig_info.fwd_info in - let state = + let info = fwd_info.fwd_info in + let fwd_state = Collections.List.subslice fun_sig.inputs info.num_inputs_with_fuel_no_state info.num_inputs_with_fuel_with_state in - let _, back_inputs = - Collections.List.split_at fun_sig.inputs - info.num_inputs_with_fuel_with_state + let back_inputs = + if !Config.return_back_funs then [] + else + snd + (Collections.List.split_at fun_sig.inputs + info.num_inputs_with_fuel_with_state) in - List.concat [ fuel; fwd_inputs; state; back_inputs ] + List.concat [ fuel; fwd_inputs; fwd_state; back_inputs ] in - let output, doutputs = + let output = match loop.back_output_tys with | None -> (* Forward function: the return type is the same as the parent function *) - (fun_sig.output, fun_sig.doutputs) + fun_sig.output | Some doutputs -> (* Backward function: custom return type *) let output = mk_simpl_tuple_ty doutputs in let output = - if loop_effect_info.stateful then + if loop_fwd_effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; output ] else output in let output = - if loop_effect_info.can_fail then mk_result_ty output + if loop_fwd_effect_info.can_fail then mk_result_ty output else output in - (output, doutputs) + output in let loop_sig = @@ -1409,8 +1401,8 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = preds = fun_sig.preds; inputs = inputs_tys; output; - doutputs; - info = loop_sig_info; + fwd_info = loop_fwd_sig_info; + back_effect_info = fun_sig.back_effect_info; } in @@ -1427,7 +1419,8 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = (* Introduce the forward input state *) let fwd_state_var, fwd_state_lvs = assert ( - loop_effect_info.stateful = Option.is_some loop.input_state); + loop_fwd_effect_info.stateful + = Option.is_some loop.input_state); match loop.input_state with | None -> ([], []) | Some input_state -> @@ -1436,11 +1429,9 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = ([ state_var ], [ state_lvs ]) in - (* Introduce the additional backward inputs *) - (* TODO: *) - assert (not !Config.return_back_funs); + (* Introduce the additional backward inputs, if necessary *) let fun_body = Option.get def.body in - let info = fun_sig_info.fwd_info in + let info = fwd_info.fwd_info in let _, back_inputs = Collections.List.split_at fun_body.inputs info.num_inputs_with_fuel_with_state @@ -2063,14 +2054,12 @@ let filter_loop_inputs (transl : pure_fun_translation list) : (* We start by computing the filtering information, for each function *) let compute_one_filter_info (decl : fun_decl) = - (* TODO: *) - assert (not !Config.return_back_funs); (* There should be a body *) let body = Option.get decl.body in (* We only look at the forward inputs, without the state *) let inputs_prefix, _ = Collections.List.split_at body.inputs - decl.signature.info.fwd_info.num_inputs_with_fuel_no_state + decl.signature.fwd_info.fwd_info.num_inputs_with_fuel_no_state in let used = ref (List.map (fun v -> (var_get_id v, false)) inputs_prefix) in let inputs_prefix_length = List.length inputs_prefix in @@ -2089,9 +2078,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) : in (* Set the fuel as used *) - let sg_info = decl.signature.info in - (* TODO: *) - assert (not !Config.return_back_funs); + let sg_info = decl.signature.fwd_info in if sg_info.fwd_info.has_fuel then set_used (fst (Collections.List.nth inputs 0)); @@ -2177,13 +2164,18 @@ let filter_loop_inputs (transl : pure_fun_translation list) : let num_filtered = List.length (List.filter (fun b -> not b) used_info) in - let { generics; llbc_generics; preds; inputs; output; doutputs; info } - = + let { + generics; + llbc_generics; + preds; + inputs; + output; + fwd_info; + back_effect_info; + } = decl.signature in - (* TODO: *) - assert (not !Config.return_back_funs); - let { fwd_info; effect_info } = info in + let { fwd_info; effect_info } = fwd_info in let { has_fuel; @@ -2208,10 +2200,18 @@ let filter_loop_inputs (transl : pure_fun_translation list) : } in - let info = { fwd_info; effect_info } in - assert (fun_sig_info_is_wf info); + let fwd_info = { fwd_info; effect_info } in + assert (fun_sig_info_is_wf fwd_info); let signature = - { generics; llbc_generics; preds; inputs; output; doutputs; info } + { + generics; + llbc_generics; + preds; + inputs; + output; + fwd_info; + back_effect_info; + } in { decl with signature } diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml index 3c1800a8..d60d6a05 100644 --- a/compiler/PureTypeCheck.ml +++ b/compiler/PureTypeCheck.ml @@ -120,7 +120,7 @@ let rec check_texpression (ctx : tc_ctx) (e : texpression) : unit = assert (output_ty = e.ty); check_texpression ctx app; check_texpression ctx arg - | Abs (pat, body) -> + | Lambda (pat, body) -> let pat_ty, body_ty = destruct_arrow e.ty in assert (pat.ty = pat_ty); assert (body.ty = body_ty); @@ -229,12 +229,6 @@ let rec check_texpression (ctx : tc_ctx) (e : texpression) : unit = check_texpression ctx fe) supd.updates | _ -> raise (Failure "Unexpected")) - | Lambda (pat, e_next) -> - assert (e.ty = e_next.ty); - (* Check the pattern and register the introduced variables at the same time *) - let ctx = check_typed_pattern ctx pat in - (* Check the next expression *) - check_texpression ctx e_next | Meta (_, e_next) -> assert (e_next.ty = e.ty); check_texpression ctx e_next diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 80b25641..6e86578c 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -215,8 +215,7 @@ let fun_sig_substitute (subst : subst) (sg : fun_sig) : inst_fun_sig = *) let rec let_group_requires_parentheses (e : texpression) : bool = match e.e with - | Var _ | CVar _ | Const _ | App _ | Abs _ | Qualif _ | StructUpdate _ -> - false + | Var _ | CVar _ | Const _ | App _ | Qualif _ | StructUpdate _ -> false | Let (monadic, _, _, next_e) -> if monadic then true else let_group_requires_parentheses next_e | Switch (_, _) -> false @@ -374,18 +373,6 @@ let opt_destruct_tuple (ty : ty) : ty list option = Some generics.types | _ -> None -let mk_abs (x : typed_pattern) (e : texpression) : texpression = - let ty = TArrow (x.ty, e.ty) in - let e = Abs (x, e) in - { e; ty } - -let rec destruct_abs_list (e : texpression) : typed_pattern list * texpression = - match e.e with - | Abs (x, e') -> - let xl, e'' = destruct_abs_list e' in - (x :: xl, e'') - | _ -> ([], e) - let destruct_arrow (ty : ty) : ty * ty = match ty with | TArrow (ty0, ty1) -> (ty0, ty1) @@ -717,13 +704,16 @@ let type_decl_from_type_id_is_tuple_struct (ctx : TypesAnalysis.type_infos) info.is_tuple_struct | TAssumed _ -> false +let mk_lambda (x : typed_pattern) (e : texpression) : texpression = + let ty = TArrow (x.ty, e.ty) in + let e = Lambda (x, e) in + { e; ty } + let mk_lambda_from_var (var : var) (mp : mplace option) (e : texpression) : texpression = - let ty = TArrow (var.ty, e.ty) in let pat = PatVar (var, mp) in let pat = { value = pat; ty = var.ty } in - let e = Lambda (pat, e) in - { e; ty } + mk_lambda pat e let mk_lambdas_from_vars (vars : var list) (mps : mplace option list) (e : texpression) : texpression = -- cgit v1.2.3 From 884edaa3ee975626f184249d491f343fc02a66e2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 15 Dec 2023 18:54:06 +0100 Subject: Make progress on updating the code --- compiler/PureMicroPasses.ml | 48 ++++++---- compiler/SymbolicToPure.ml | 79 +++-------------- compiler/Translate.ml | 207 ++++++++++++++++++++------------------------ 3 files changed, 134 insertions(+), 200 deletions(-) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 0102b13e..a7c2f154 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -776,9 +776,11 @@ let inline_useless_var_reassignments (ctx : trans_ctx) (inline_named : bool) in { def with body = Some body } -(** Given a forward or backward function call, is there, for every execution +(** For the cases where we split the forward/backward functions. + + Given a forward or backward function call, is there, for every execution path, a child backward function called later with exactly the same input - list prefix? We use this to filter useless function calls: if there are + list prefix. We use this to filter useless function calls: if there are such child calls, we can remove this one (in case its outputs are not used). We do this check because we can't simply remove function calls whose @@ -1008,17 +1010,21 @@ let filter_useless (filter_monadic_calls : bool) (ctx : trans_ctx) * under some conditions. *) match (filter_monadic_calls, opt_destruct_function_call re) with | true, Some (Fun (FromLlbc (fid, lp_id, rg_id)), tys, args) -> - (* We need to check if there is a child call - see - * the comments for: - * [expression_contains_child_call_in_all_paths] *) - let has_child_call = - expression_contains_child_call_in_all_paths ctx fid lp_id - rg_id tys args e - in - if has_child_call then (* Filter *) - (e.e, fun _ -> used) - else (* No child call: don't filter *) - dont_filter () + (* If we split the forward/backward functions. + + We need to check if there is a child call - see + the comments for: + [expression_contains_child_call_in_all_paths] *) + if not !Config.return_back_funs then + let has_child_call = + expression_contains_child_call_in_all_paths ctx fid + lp_id rg_id tys args e + in + if has_child_call then (* Filter *) + (e.e, fun _ -> used) + else (* No child call: don't filter *) + dont_filter () + else dont_filter () | _ -> (* Not an LLBC function call or not allowed to filter: we can't filter *) dont_filter () @@ -1509,9 +1515,12 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = altogether. *) let keep_forward (fwd : fun_and_loops) (backs : fun_and_loops list) : bool = - (* Note that at this point, the output types are no longer seen as tuples: - * they should be lists of length 1. *) - if + (* The question of filtering the forward functions arises only if we split + the forward/backward functions *) + if !Config.return_back_funs then true + else if + (* Note that at this point, the output types are no longer seen as tuples: + * they should be lists of length 1. *) !Config.filter_useless_functions && fwd.f.signature.output = mk_result_ty mk_unit_ty && backs <> [] @@ -1957,9 +1966,10 @@ let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) : log#ldebug (lazy ("remove_meta:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* Remove the backward functions with no outputs. - * Note that the calls to those functions should already have been removed, - * when translating from symbolic to pure. Here, we remove the definitions - * altogether, because they are now useless *) + + Note that the *calls* to those functions should already have been removed, + when translating from symbolic to pure. Here, we remove the definitions + altogether, because they are now useless *) let name = def.name ^ PrintPure.fun_suffix def.loop_id def.back_id in let opt_def = filter_if_backward_with_no_outputs def in diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 08f9e950..204fc399 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -45,7 +45,6 @@ type fun_sig_named_outputs = { type fun_context = { llbc_fun_decls : A.fun_decl A.FunDeclId.Map.t; - fun_sigs : fun_sig_named_outputs RegularFunIdNotLoopMap.t; (** *) fun_infos : fun_info A.FunDeclId.Map.t; regions_hierarchies : T.region_var_groups FunIdMap.t; } @@ -144,7 +143,11 @@ type bs_ctx = { a symbolic expansion or upon ending an abstraction, for instance) we introduce a new variable (with a let-binding). *) - var_counter : VarId.generator; + var_counter : VarId.generator ref; + (** Using a ref to make sure all the variables identifiers are unique. + TODO: this is not very clean, and the code was initially written without + a reference (and it's shape hasn't changed). We should use DeBruijn indices. + *) state_var : VarId.id; (** The current state variable, in case the function is stateful *) back_state_vars : VarId.id RegionGroupId.Map.t; @@ -1131,13 +1134,14 @@ let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) let bs_ctx_fresh_state_var (ctx : bs_ctx) : bs_ctx * var * typed_pattern = (* Generate the fresh variable *) - let id, var_counter = VarId.fresh ctx.var_counter in + let id, var_counter = VarId.fresh !(ctx.var_counter) in let state_var = { id; basename = Some ConstStrings.state_basename; ty = mk_state_ty } in let state_pat = mk_typed_pattern_from_var state_var None in (* Update the context *) - let ctx = { ctx with var_counter; state_var = id } in + ctx.var_counter := var_counter; + let ctx = { ctx with state_var = id } in (* Return *) (ctx, state_var, state_pat) @@ -1146,11 +1150,11 @@ let bs_ctx_fresh_state_var (ctx : bs_ctx) : bs_ctx * var * typed_pattern = let fresh_var_llbc_ty (basename : string option) (ty : T.ty) (ctx : bs_ctx) : bs_ctx * var = (* Generate the fresh variable *) - let id, var_counter = VarId.fresh ctx.var_counter in + let id, var_counter = VarId.fresh !(ctx.var_counter) in let ty = ctx_translate_fwd_ty ctx ty in let var = { id; basename; ty } in (* Update the context *) - let ctx = { ctx with var_counter } in + ctx.var_counter := var_counter; (* Return *) (ctx, var) @@ -1184,10 +1188,10 @@ let fresh_named_vars_for_symbolic_values let fresh_var (basename : string option) (ty : ty) (ctx : bs_ctx) : bs_ctx * var = (* Generate the fresh variable *) - let id, var_counter = VarId.fresh ctx.var_counter in + let id, var_counter = VarId.fresh !(ctx.var_counter) in let var = { id; basename; ty } in (* Update the context *) - let ctx = { ctx with var_counter } in + ctx.var_counter := var_counter; (* Return *) (ctx, var) @@ -3303,65 +3307,6 @@ let translate_type_decls (ctx : Contexts.decls_ctx) : type_decl list = List.map (translate_type_decl ctx) (TypeDeclId.Map.values ctx.type_ctx.type_decls) -(** Translates function signatures. - - Takes as input a list of function information containing: - - the function id - - a list of optional names for the inputs - - the function signature - - Returns a map from forward/backward functions identifiers to: - - translated function signatures - - optional names for the outputs values (we derive them for the backward - functions) - *) -let translate_fun_signatures (decls_ctx : C.decls_ctx) - (functions : (A.fun_id * string option list * A.fun_sig) list) : - fun_sig_named_outputs RegularFunIdNotLoopMap.t = - (* For every function, translate the signatures of: - - the forward function - - the backward functions - *) - let translate_one (fun_id : A.fun_id) (input_names : string option list) - (sg : A.fun_sig) : (regular_fun_id_not_loop * fun_sig_named_outputs) list - = - log#ldebug - (lazy - ("Translating signature of function: " - ^ Print.Expressions.fun_id_to_string - (Print.Contexts.decls_ctx_to_fmt_env decls_ctx) - fun_id)); - (* Retrieve the regions hierarchy *) - let regions_hierarchy = - FunIdMap.find fun_id decls_ctx.fun_ctx.regions_hierarchies - in - (* The forward function *) - let fwd_sg = translate_fun_sig decls_ctx fun_id sg input_names None in - let fwd_id = (fun_id, None) in - (* The backward functions *) - let back_sgs = - if !Config.return_back_funs then [] - else - List.map - (fun (rg : T.region_var_group) -> - let tsg = - translate_fun_sig decls_ctx fun_id sg input_names (Some rg.id) - in - let id = (fun_id, Some rg.id) in - (id, tsg)) - regions_hierarchy - in - (* Return *) - (fwd_id, fwd_sg) :: back_sgs - in - let translated = - List.concat - (List.map (fun (id, names, sg) -> translate_one id names sg) functions) - in - List.fold_left - (fun m (id, sg) -> RegularFunIdNotLoopMap.add id sg m) - RegularFunIdNotLoopMap.empty translated - let translate_trait_decl (ctx : Contexts.decls_ctx) (trait_decl : A.trait_decl) : trait_decl = let { diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 06d4bd6d..8b221c93 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -6,7 +6,6 @@ open LlbcAst open Contexts module SA = SymbolicAst module Micro = PureMicroPasses -open PureUtils open TranslateCore (** The local logger *) @@ -43,7 +42,6 @@ let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : fun_decl) : TODO: maybe we should introduce a record for this. *) let translate_function_to_pure (trans_ctx : trans_ctx) - (fun_sigs : SymbolicToPure.fun_sig_named_outputs RegularFunIdNotLoopMap.t) (pure_type_decls : Pure.type_decl Pure.TypeDeclId.Map.t) (fdef : fun_decl) : pure_fun_translation_no_loops = (* Debug *) @@ -58,13 +56,9 @@ let translate_function_to_pure (trans_ctx : trans_ctx) (* Convert the symbolic ASTs to pure ASTs: *) (* Initialize the context *) - let forward_sig = - RegularFunIdNotLoopMap.find (FRegular def_id, None) fun_sigs - in let sv_to_var = SymbolicValueId.Map.empty in let var_counter = Pure.VarId.generator_zero in let state_var, var_counter = Pure.VarId.fresh var_counter in - let back_state_var, var_counter = Pure.VarId.fresh var_counter in let fuel0, var_counter = Pure.VarId.fresh var_counter in let fuel, var_counter = Pure.VarId.fresh var_counter in let calls = FunCallId.Map.empty in @@ -89,7 +83,6 @@ let translate_function_to_pure (trans_ctx : trans_ctx) let fun_context = { SymbolicToPure.llbc_fun_decls = trans_ctx.fun_ctx.fun_decls; - fun_sigs; fun_infos = trans_ctx.fun_ctx.fun_infos; regions_hierarchies = trans_ctx.fun_ctx.regions_hierarchies; } @@ -126,17 +119,45 @@ let translate_function_to_pure (trans_ctx : trans_ctx) !m in + let input_names = + match fdef.body with + | None -> List.map (fun _ -> None) fdef.signature.inputs + | Some body -> + List.map + (fun (v : var) -> v.name) + (LlbcAstUtils.fun_body_get_input_vars body) + in + + let sg = + SymbolicToPure.translate_fun_sig_to_decomposed trans_ctx (FRegular def_id) + fdef.signature input_names + in + + let regions_hierarchy = + LlbcAstUtils.FunIdMap.find (FRegular def_id) fun_context.regions_hierarchies + in + + let var_counter, back_state_vars = + if !Config.return_back_funs then (var_counter, []) + else + List.fold_left_map + (fun var_counter (region_vars : region_var_group) -> + let gid = region_vars.id in + let var, var_counter = Pure.VarId.fresh var_counter in + (var_counter, (gid, var))) + var_counter regions_hierarchy + in + let back_state_vars = RegionGroupId.Map.of_list back_state_vars in + let ctx = { SymbolicToPure.bid = None; - (* Dummy for now *) - sg = forward_sig.sg; - fwd_sg = forward_sig.sg; + sg; (* Will need to be updated for the backward functions *) sv_to_var; - var_counter; + var_counter = ref var_counter; state_var; - back_state_var; + back_state_vars; fuel0; fuel; type_context; @@ -146,9 +167,11 @@ let translate_function_to_pure (trans_ctx : trans_ctx) trait_impls_ctx = trans_ctx.trait_impls_ctx.trait_impls; fun_decl = fdef; forward_inputs = []; - (* Empty for now *) - backward_inputs = RegionGroupId.Map.empty; - (* Empty for now *) + (* Initialized just below *) + backward_inputs_no_state = RegionGroupId.Map.empty; + (* Initialized just below *) + backward_inputs_with_state = RegionGroupId.Map.empty; + (* Initialized just below *) backward_outputs = RegionGroupId.Map.empty; loop_backward_outputs = None; (* Empty for now *) @@ -180,6 +203,51 @@ let translate_function_to_pure (trans_ctx : trans_ctx) | _ -> raise (Failure "Unreachable") in + (* Add the backward inputs *) + let ctx, backward_inputs_no_state, backward_inputs_with_state = + if !Config.return_back_funs then (ctx, [], []) + else + let ctx, inputs_no_with_state = + List.fold_left_map + (fun ctx (region_vars : region_var_group) -> + let gid = region_vars.id in + let back_sg = RegionGroupId.Map.find gid sg.back_sg in + let ctx, no_state = + SymbolicToPure.fresh_vars back_sg.inputs_no_state ctx + in + let ctx, with_state = + SymbolicToPure.fresh_vars back_sg.inputs ctx + in + (ctx, ((gid, no_state), (gid, with_state)))) + ctx regions_hierarchy + in + let inputs_no_state, inputs_with_state = + List.split inputs_no_with_state + in + (ctx, inputs_no_state, inputs_with_state) + in + let backward_inputs_no_state = + RegionGroupId.Map.of_list backward_inputs_no_state + in + let backward_inputs_with_state = + RegionGroupId.Map.of_list backward_inputs_with_state + in + let ctx = { ctx with backward_inputs_no_state; backward_inputs_with_state } in + + (* Add the backward outputs *) + let ctx, backward_outputs = + List.fold_left_map + (fun ctx (region_vars : region_var_group) -> + let gid = region_vars.id in + let back_sg = RegionGroupId.Map.find gid sg.back_sg in + let outputs = List.combine back_sg.output_names back_sg.outputs in + let ctx, vars = SymbolicToPure.fresh_vars outputs ctx in + (ctx, (gid, vars))) + ctx regions_hierarchy + in + let backward_outputs = RegionGroupId.Map.of_list backward_outputs in + let ctx = { ctx with backward_outputs } in + (* Translate the forward function *) let pure_forward = match symbolic_trans with @@ -187,7 +255,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx) | Some (_, ast) -> SymbolicToPure.translate_fun_decl ctx (Some ast) in - (* Translate the backward functions *) + (* Translate the backward functions, if we split the forward and backward functions *) let translate_backward (rg : region_var_group) : Pure.fun_decl = (* For the backward inputs/outputs initialization: we use the fact that * there are no nested borrows for now, and so that the region groups @@ -197,83 +265,20 @@ let translate_function_to_pure (trans_ctx : trans_ctx) match symbolic_trans with | None -> - (* Initialize the context - note that the ret_ty is not really - * useful as we don't translate a body *) - let backward_sg = - RegularFunIdNotLoopMap.find (FRegular def_id, Some back_id) fun_sigs - in - let ctx = { ctx with bid = Some back_id; sg = backward_sg.sg } in - + (* Initialize the context *) + let ctx = { ctx with bid = Some back_id } in (* Translate *) SymbolicToPure.translate_fun_decl ctx None | Some (_, symbolic) -> - (* Finish initializing the context by adding the additional input - variables required by the backward function. - *) - let backward_sg = - RegularFunIdNotLoopMap.find (FRegular def_id, Some back_id) fun_sigs - in - (* We need to ignore the forward inputs, and the state input (if there is) *) - let backward_inputs = - let sg = backward_sg.sg in - (* TODO: *) - assert (not !Config.return_back_funs); - (* We need to ignore the forward state and the backward state *) - let num_forward_inputs = - sg.info.fwd_info.num_inputs_with_fuel_with_state - in - let num_back_inputs = - match sg.info.back_info with - | SingleBack (Some info) -> info.num_inputs_no_fuel_no_state - | _ -> raise (Failure "Unexpected") - in - Collections.List.subslice sg.inputs num_forward_inputs - (num_forward_inputs + num_back_inputs) - in - (* As we forbid nested borrows, the additional inputs for the backward - * functions come from the borrows in the return value of the rust function: - * we thus use the name "ret" for those inputs *) - let backward_inputs = - List.map (fun ty -> (Some "ret", ty)) backward_inputs - in - let ctx, backward_inputs = - SymbolicToPure.fresh_vars backward_inputs ctx - in - (* The outputs for the backward functions, however, come from borrows - * present in the input values of the rust function: for those we reuse - * the names of the input values. *) - let backward_outputs = - List.combine backward_sg.output_names backward_sg.sg.doutputs - in - let ctx, backward_outputs = - SymbolicToPure.fresh_vars backward_outputs ctx - in - let backward_inputs = - RegionGroupId.Map.singleton back_id backward_inputs - in - let backward_outputs = - RegionGroupId.Map.singleton back_id backward_outputs - in - - (* Put everything in the context *) - let ctx = - { - ctx with - bid = Some back_id; - sg = backward_sg.sg; - backward_inputs; - backward_outputs; - } - in - + (* Initialize the context *) + let ctx = { ctx with bid = Some back_id } in (* Translate *) SymbolicToPure.translate_fun_decl ctx (Some symbolic) in - let regions_hierarchy = - LlbcAstUtils.FunIdMap.find (FRegular fdef.def_id) - fun_context.regions_hierarchies + let pure_backwards = + if !Config.return_back_funs then [] + else List.map translate_backward regions_hierarchy in - let pure_backwards = List.map translate_backward regions_hierarchy in (* Return *) (pure_forward, pure_backwards) @@ -300,36 +305,10 @@ let translate_crate_to_pure (crate : crate) : (List.map (fun (def : Pure.type_decl) -> (def.def_id, def)) type_decls) in - (* Translate all the function *signatures* *) - let assumed_sigs = - List.map - (fun (info : Assumed.assumed_fun_info) -> - ( FAssumed info.fun_id, - List.map (fun _ -> None) info.fun_sig.inputs, - info.fun_sig )) - Assumed.assumed_fun_infos - in - let local_sigs = - List.map - (fun (fdef : fun_decl) -> - let input_names = - match fdef.body with - | None -> List.map (fun _ -> None) fdef.signature.inputs - | Some body -> - List.map - (fun (v : var) -> v.name) - (LlbcAstUtils.fun_body_get_input_vars body) - in - (FRegular fdef.def_id, input_names, fdef.signature)) - (FunDeclId.Map.values crate.fun_decls) - in - let sigs = List.append assumed_sigs local_sigs in - let fun_sigs = SymbolicToPure.translate_fun_signatures trans_ctx sigs in - (* Translate all the *transparent* functions *) let pure_translations = List.map - (translate_function_to_pure trans_ctx fun_sigs type_decls_map) + (translate_function_to_pure trans_ctx type_decls_map) (FunDeclId.Map.values crate.fun_decls) in @@ -1036,7 +1015,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) : List.map (fun { fwd; _ } -> let fwd_f = - if fwd.f.Pure.signature.info.effect_info.is_rec then + if fwd.f.Pure.signature.fwd_info.effect_info.is_rec then [ (fwd.f.def_id, None) ] else [] in -- cgit v1.2.3 From 58b838594777b1489b31db40bba27b5fca355a73 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 18 Dec 2023 10:06:11 +0100 Subject: Update the README --- README.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index c0a09ebe..64100410 100644 --- a/README.md +++ b/README.md @@ -48,7 +48,8 @@ Moreover, Aeneas requires the Charon ML library, defined in the [Charon](https://github.com/AeneasVerif/charon) project. The simplest way is to clone Charon, then go to [`compiler`](./compiler) and create a symbolic link to the Charon library: -`ln -s PATH_TO_CHARON_REPO/charon-ml charon` +`cd AENEAS_REPO/compiler && ln -s PATH_TO_CHARON_REPO/charon-ml charon` +(the symbolic link should be placed inside the `aeneas/compiler/` folder). **Remark:** if you want to test if the symbolic link is valid, copy-paste the following script in your terminal (from the `compiler` directory): -- cgit v1.2.3 From 2fb4ca72b112f6181d74d1ca37ed6d54c65f43cd Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 18 Dec 2023 10:11:44 +0100 Subject: Do not register the names of the back funs if they are merged with the fwd funs --- compiler/Extract.ml | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 7e2efd8a..3429cd11 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -43,8 +43,12 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) } | _ -> ctx in - let backs = List.map (fun f -> f.f) def.backs in - let funs = if def.keep_fwd then def.fwd.f :: backs else backs in + let funs = + if !Config.return_back_funs then [ def.fwd.f ] + else + let backs = List.map (fun f -> f.f) def.backs in + if def.keep_fwd then def.fwd.f :: backs else backs + in List.fold_left (fun ctx (f : fun_decl) -> let open ExtractBuiltin in @@ -1988,7 +1992,8 @@ let extract_trait_decl_method_names (ctx : extraction_ctx) (* We add one field per required forward/backward function *) let get_funs_for_id (id : fun_decl_id) : fun_decl list = let trans : pure_fun_translation = FunDeclId.Map.find id ctx.trans_funs in - List.map (fun f -> f.f) (trans.fwd :: trans.backs) + if !Config.return_back_funs then [ trans.fwd.f ] + else List.map (fun f -> f.f) (trans.fwd :: trans.backs) in match builtin_info with | None -> -- cgit v1.2.3 From a49754a5b11e4de8793dc7e13c2962d139eb03b1 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 18 Dec 2023 10:21:08 +0100 Subject: Rename some definitions --- compiler/AssociatedTypes.ml | 10 ++--- compiler/Contexts.ml | 42 +++++++++--------- compiler/Interpreter.ml | 8 ++-- compiler/InterpreterBorrows.ml | 12 +++--- compiler/InterpreterExpansion.ml | 2 +- compiler/InterpreterExpressions.ml | 5 +-- compiler/InterpreterLoopsFixedPoint.ml | 18 ++++---- compiler/InterpreterLoopsJoinCtxs.ml | 36 ++++++++-------- compiler/InterpreterLoopsMatchCtxs.ml | 4 +- compiler/InterpreterStatements.ml | 12 +++--- compiler/InterpreterUtils.ml | 26 ++++++------ compiler/Invariants.ml | 2 +- compiler/Print.ml | 10 ++--- compiler/SymbolicToPure.ml | 78 +++++++++++++++++----------------- compiler/Translate.ml | 14 +++--- 15 files changed, 139 insertions(+), 140 deletions(-) diff --git a/compiler/AssociatedTypes.ml b/compiler/AssociatedTypes.ml index e2f687e8..054c8169 100644 --- a/compiler/AssociatedTypes.ml +++ b/compiler/AssociatedTypes.ml @@ -493,11 +493,11 @@ let norm_ctx_normalize_trait_type_constraint (ctx : norm_ctx) let mk_norm_ctx (ctx : eval_ctx) : norm_ctx = { norm_trait_types = ctx.norm_trait_types; - type_decls = ctx.type_context.type_decls; - fun_decls = ctx.fun_context.fun_decls; - global_decls = ctx.global_context.global_decls; - trait_decls = ctx.trait_decls_context.trait_decls; - trait_impls = ctx.trait_impls_context.trait_impls; + type_decls = ctx.type_ctx.type_decls; + fun_decls = ctx.fun_ctx.fun_decls; + global_decls = ctx.global_ctx.global_decls; + trait_decls = ctx.trait_decls_ctx.trait_decls; + trait_impls = ctx.trait_impls_ctx.trait_impls; type_vars = ctx.type_vars; const_generic_vars = ctx.const_generic_vars; } diff --git a/compiler/Contexts.ml b/compiler/Contexts.ml index a30ed0f1..5d646a61 100644 --- a/compiler/Contexts.ml +++ b/compiler/Contexts.ml @@ -180,35 +180,35 @@ type config = { let mk_config (mode : interpreter_mode) : config = { mode } -type type_context = { +type type_ctx = { type_decls_groups : type_declaration_group TypeDeclId.Map.t; type_decls : type_decl TypeDeclId.Map.t; type_infos : TypesAnalysis.type_infos; } [@@deriving show] -type fun_context = { +type fun_ctx = { fun_decls : fun_decl FunDeclId.Map.t; fun_infos : FunsAnalysis.fun_info FunDeclId.Map.t; regions_hierarchies : region_var_groups FunIdMap.t; } [@@deriving show] -type global_context = { global_decls : global_decl GlobalDeclId.Map.t } +type global_ctx = { global_decls : global_decl GlobalDeclId.Map.t } [@@deriving show] -type trait_decls_context = { trait_decls : trait_decl TraitDeclId.Map.t } +type trait_decls_ctx = { trait_decls : trait_decl TraitDeclId.Map.t } [@@deriving show] -type trait_impls_context = { trait_impls : trait_impl TraitImplId.Map.t } +type trait_impls_ctx = { trait_impls : trait_impl TraitImplId.Map.t } [@@deriving show] type decls_ctx = { - type_ctx : type_context; - fun_ctx : fun_context; - global_ctx : global_context; - trait_decls_ctx : trait_decls_context; - trait_impls_ctx : trait_impls_context; + type_ctx : type_ctx; + fun_ctx : fun_ctx; + global_ctx : global_ctx; + trait_decls_ctx : trait_decls_ctx; + trait_impls_ctx : trait_impls_ctx; } [@@deriving show] @@ -230,11 +230,11 @@ module TraitTypeRefMap = Collections.MakeMap (TraitTypeRefOrd) (** Evaluation context *) type eval_ctx = { - type_context : type_context; - fun_context : fun_context; - global_context : global_context; - trait_decls_context : trait_decls_context; - trait_impls_context : trait_impls_context; + type_ctx : type_ctx; + fun_ctx : fun_ctx; + global_ctx : global_ctx; + trait_decls_ctx : trait_decls_ctx; + trait_impls_ctx : trait_impls_ctx; region_groups : RegionGroupId.id list; type_vars : type_var list; const_generic_vars : const_generic_var list; @@ -290,20 +290,20 @@ let ctx_lookup_var_binder (ctx : eval_ctx) (vid : VarId.id) : var_binder = fst (env_lookup_var ctx.env vid) let ctx_lookup_type_decl (ctx : eval_ctx) (tid : TypeDeclId.id) : type_decl = - TypeDeclId.Map.find tid ctx.type_context.type_decls + TypeDeclId.Map.find tid ctx.type_ctx.type_decls let ctx_lookup_fun_decl (ctx : eval_ctx) (fid : FunDeclId.id) : fun_decl = - FunDeclId.Map.find fid ctx.fun_context.fun_decls + FunDeclId.Map.find fid ctx.fun_ctx.fun_decls let ctx_lookup_global_decl (ctx : eval_ctx) (gid : GlobalDeclId.id) : global_decl = - GlobalDeclId.Map.find gid ctx.global_context.global_decls + GlobalDeclId.Map.find gid ctx.global_ctx.global_decls let ctx_lookup_trait_decl (ctx : eval_ctx) (id : TraitDeclId.id) : trait_decl = - TraitDeclId.Map.find id ctx.trait_decls_context.trait_decls + TraitDeclId.Map.find id ctx.trait_decls_ctx.trait_decls let ctx_lookup_trait_impl (ctx : eval_ctx) (id : TraitImplId.id) : trait_impl = - TraitImplId.Map.find id ctx.trait_impls_context.trait_impls + TraitImplId.Map.find id ctx.trait_impls_ctx.trait_impls (** Retrieve a variable's value in the current frame *) let env_lookup_var_value (env : env) (vid : VarId.id) : typed_value = @@ -528,7 +528,7 @@ let ctx_set_abs_can_end (ctx : eval_ctx) (abs_id : AbstractionId.id) fst (ctx_subst_abs ctx abs_id abs) let ctx_type_decl_is_rec (ctx : eval_ctx) (id : TypeDeclId.id) : bool = - let decl_group = TypeDeclId.Map.find id ctx.type_context.type_decls_groups in + let decl_group = TypeDeclId.Map.find id ctx.type_ctx.type_decls_groups in match decl_group with RecGroup _ -> true | NonRecGroup _ -> false (** Visitor to iterate over the values in the *current* frame *) diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml index 76432faa..22d176c9 100644 --- a/compiler/Interpreter.ml +++ b/compiler/Interpreter.ml @@ -195,7 +195,7 @@ let initialize_symbolic_context_for_fun (ctx : decls_ctx) (fdef : fun_decl) : List.map (fun (g : region_var_group) -> g.id) regions_hierarchy in let ctx = - initialize_eval_context ctx region_groups sg.generics.types + initialize_eval_ctx ctx region_groups sg.generics.types sg.generics.const_generics in (* Instantiate the signature. This updates the context because we compute @@ -277,7 +277,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) * an instantiation of the signature, so that we use fresh * region ids for the return abstractions. *) let regions_hierarchy = - FunIdMap.find (FRegular fdef.def_id) ctx.fun_context.regions_hierarchies + FunIdMap.find (FRegular fdef.def_id) ctx.fun_ctx.regions_hierarchies in let _, ret_inst_sg = symbolic_instantiate_fun_sig ctx fdef.signature regions_hierarchy fdef.kind @@ -466,7 +466,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) let ctx, input_svs, inst_sg = initialize_symbolic_context_for_fun ctx fdef in let regions_hierarchy = - FunIdMap.find (FRegular fdef.def_id) ctx.fun_context.regions_hierarchies + FunIdMap.find (FRegular fdef.def_id) ctx.fun_ctx.regions_hierarchies in (* Create the continuation to finish the evaluation *) @@ -615,7 +615,7 @@ module Test = struct assert (body.arg_count = 0); (* Create the evaluation context *) - let ctx = initialize_eval_context decls_ctx [] [] [] in + let ctx = initialize_eval_ctx decls_ctx [] [] [] in (* Insert the (uninitialized) local variables *) let ctx = ctx_push_uninitialized_vars ctx body.locals in diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml index e56919fa..a2eb2545 100644 --- a/compiler/InterpreterBorrows.ml +++ b/compiler/InterpreterBorrows.ml @@ -1628,7 +1628,7 @@ let destructure_abs (abs_kind : abs_kind) (can_end : bool) push { value; ty } | AIgnoredMutLoan (opt_bid, child_av) -> (* We don't support nested borrows for now *) - assert (not (ty_has_borrows ctx.type_context.type_infos child_av.ty)); + assert (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)); assert (opt_bid = None); (* Simply explore the child *) list_avalues false push_fail child_av @@ -1639,7 +1639,7 @@ let destructure_abs (abs_kind : abs_kind) (can_end : bool) { child = child_av; given_back = _; given_back_meta = _ } | AIgnoredSharedLoan child_av -> (* We don't support nested borrows for now *) - assert (not (ty_has_borrows ctx.type_context.type_infos child_av.ty)); + assert (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)); (* Simply explore the child *) list_avalues false push_fail child_av) | ABorrow bc -> ( @@ -1659,14 +1659,14 @@ let destructure_abs (abs_kind : abs_kind) (can_end : bool) push av | AIgnoredMutBorrow (opt_bid, child_av) -> (* We don't support nested borrows for now *) - assert (not (ty_has_borrows ctx.type_context.type_infos child_av.ty)); + assert (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)); assert (opt_bid = None); (* Just explore the child *) list_avalues false push_fail child_av | AEndedIgnoredMutBorrow { child = child_av; given_back = _; given_back_meta = _ } -> (* We don't support nested borrows for now *) - assert (not (ty_has_borrows ctx.type_context.type_infos child_av.ty)); + assert (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)); (* Just explore the child *) list_avalues false push_fail child_av | AProjSharedBorrow asb -> @@ -1683,7 +1683,7 @@ let destructure_abs (abs_kind : abs_kind) (can_end : bool) | ASymbolic _ -> (* For now, we fore all symbolic values containing borrows to be eagerly expanded *) - assert (not (ty_has_borrows ctx.type_context.type_infos ty)) + assert (not (ty_has_borrows ctx.type_ctx.type_infos ty)) and list_values (v : typed_value) : typed_avalue list * typed_value = let ty = v.ty in match v.value with @@ -1732,7 +1732,7 @@ let destructure_abs (abs_kind : abs_kind) (can_end : bool) | VSymbolic _ -> (* For now, we fore all symbolic values containing borrows to be eagerly expanded *) - assert (not (ty_has_borrows ctx.type_context.type_infos ty)); + assert (not (ty_has_borrows ctx.type_ctx.type_infos ty)); ([], v) in diff --git a/compiler/InterpreterExpansion.ml b/compiler/InterpreterExpansion.ml index bbf4d9d5..e489ddc3 100644 --- a/compiler/InterpreterExpansion.ml +++ b/compiler/InterpreterExpansion.ml @@ -627,7 +627,7 @@ let greedy_expand_symbolics_with_borrows (config : config) : cm_fun = inherit [_] iter_eval_ctx method! visit_VSymbolic _ sv = - if ty_has_borrows ctx.type_context.type_infos sv.sv_ty then + if ty_has_borrows ctx.type_ctx.type_infos sv.sv_ty then raise (FoundSymbolicValue sv) else () diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml index 1b5b79dd..8536b4ab 100644 --- a/compiler/InterpreterExpressions.ml +++ b/compiler/InterpreterExpressions.ml @@ -32,8 +32,7 @@ let expand_primitively_copyable_at_place (config : config) fun cf ctx -> let v = read_place access p ctx in match - find_first_primitively_copyable_sv_with_borrows - ctx.type_context.type_infos v + find_first_primitively_copyable_sv_with_borrows ctx.type_ctx.type_infos v with | None -> cf ctx | Some sv -> @@ -351,7 +350,7 @@ let eval_operand_no_reorganize (config : config) (op : operand) assert ( Option.is_none (find_first_primitively_copyable_sv_with_borrows - ctx.type_context.type_infos v)); + ctx.type_ctx.type_infos v)); (* Actually perform the copy *) let allow_adt_copy = false in let ctx, v = copy_value allow_adt_copy config ctx v in diff --git a/compiler/InterpreterLoopsFixedPoint.ml b/compiler/InterpreterLoopsFixedPoint.ml index c4e180fa..4dabe974 100644 --- a/compiler/InterpreterLoopsFixedPoint.ml +++ b/compiler/InterpreterLoopsFixedPoint.ml @@ -300,7 +300,7 @@ let prepare_ashared_loans (loop_id : LoopId.id option) : cm_fun = let env = List.append fresh_absl env in let ctx = { ctx with env } in - let _, new_ctx_ids_map = compute_context_ids ctx in + let _, new_ctx_ids_map = compute_ctx_ids ctx in (* Synthesize *) match cf ctx with @@ -385,8 +385,8 @@ let compute_loop_entry_fixed_point (config : config) (loop_id : LoopId.id) match !fixed_ids with | Some _ -> ctx1 | None -> - let old_ids, _ = compute_context_ids ctx1 in - let new_ids, _ = compute_contexts_ids !ctxs in + let old_ids, _ = compute_ctx_ids ctx1 in + let new_ids, _ = compute_ctxs_ids !ctxs in let blids = BorrowId.Set.diff old_ids.blids new_ids.blids in let aids = AbstractionId.Set.diff old_ids.aids new_ids.aids in (* End those borrows and abstractions *) @@ -409,7 +409,7 @@ let compute_loop_entry_fixed_point (config : config) (loop_id : LoopId.id) ctxs := List.map (end_borrows_abs blids aids) !ctxs; (* Note that the fixed ids are given by the original context, from *before* we introduce fresh abstractions/reborrows for the shared values *) - fixed_ids := Some (fst (compute_context_ids ctx0)); + fixed_ids := Some (fst (compute_ctx_ids ctx0)); ctx1 in @@ -424,12 +424,12 @@ let compute_loop_entry_fixed_point (config : config) (loop_id : LoopId.id) intersection of ids between the original environment and the list of new environments *) let compute_fixed_ids (ctxl : eval_ctx list) : ids_sets = - let fixed_ids, _ = compute_context_ids ctx0 in + let fixed_ids, _ = compute_ctx_ids ctx0 in let { aids; blids; borrow_ids; loan_ids; dids; rids; sids } = fixed_ids in let sids = ref sids in List.iter (fun ctx -> - let fixed_ids, _ = compute_context_ids ctx in + let fixed_ids, _ = compute_ctx_ids ctx in sids := SymbolicValueId.Set.inter !sids fixed_ids.sids) ctxl; let sids = !sids in @@ -568,7 +568,7 @@ let compute_loop_entry_fixed_point (config : config) (loop_id : LoopId.id) InterpreterBorrows.end_abstraction_no_synth config abs_id ctx in (* Explore the context, and check which abstractions are not there anymore *) - let ids, _ = compute_context_ids ctx in + let ids, _ = compute_ctx_ids ctx in let ended_ids = AbstractionId.Set.diff !fp_aids ids.aids in add_ended_aids rg_id ended_ids) ctx.region_groups @@ -840,8 +840,8 @@ let compute_fixed_point_id_correspondance (fixed_ids : ids_sets) let compute_fp_ctx_symbolic_values (ctx : eval_ctx) (fp_ctx : eval_ctx) : SymbolicValueId.Set.t * symbolic_value list = - let old_ids, _ = compute_context_ids ctx in - let fp_ids, fp_ids_maps = compute_context_ids fp_ctx in + let old_ids, _ = compute_ctx_ids ctx in + let fp_ids, fp_ids_maps = compute_ctx_ids fp_ctx in let fresh_sids = SymbolicValueId.Set.diff fp_ids.sids old_ids.sids in (* Compute the set of symbolic values which appear in shared values inside diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml index 8d485483..445e5abf 100644 --- a/compiler/InterpreterLoopsJoinCtxs.ml +++ b/compiler/InterpreterLoopsJoinCtxs.ml @@ -326,8 +326,8 @@ let mk_collapse_ctx_merge_duplicate_funs (loop_id : LoopId.id) (ctx : eval_ctx) let _ = let _, ty0, _ = ty_as_ref ty0 in let _, ty1, _ = ty_as_ref ty1 in - assert (not (ty_has_borrows ctx.type_context.type_infos ty0)); - assert (not (ty_has_borrows ctx.type_context.type_infos ty1)) + assert (not (ty_has_borrows ctx.type_ctx.type_infos ty0)); + assert (not (ty_has_borrows ctx.type_ctx.type_infos ty1)) in (* Same remarks as for [merge_amut_borrows] *) @@ -543,11 +543,11 @@ let join_ctxs (loop_id : LoopId.id) (fixed_ids : ids_sets) (ctx0 : eval_ctx) (* Construct the joined context - of course, the type, fun, etc. contexts * should be the same in the two contexts *) let { - type_context; - fun_context; - global_context; - trait_decls_context; - trait_impls_context; + type_ctx; + fun_ctx; + global_ctx; + trait_decls_ctx; + trait_impls_ctx; region_groups; type_vars; const_generic_vars; @@ -559,11 +559,11 @@ let join_ctxs (loop_id : LoopId.id) (fixed_ids : ids_sets) (ctx0 : eval_ctx) ctx0 in let { - type_context = _; - fun_context = _; - global_context = _; - trait_decls_context = _; - trait_impls_context = _; + type_ctx = _; + fun_ctx = _; + global_ctx = _; + trait_decls_ctx = _; + trait_impls_ctx = _; region_groups = _; type_vars = _; const_generic_vars = _; @@ -577,11 +577,11 @@ let join_ctxs (loop_id : LoopId.id) (fixed_ids : ids_sets) (ctx0 : eval_ctx) let ended_regions = RegionId.Set.union ended_regions0 ended_regions1 in Ok { - type_context; - fun_context; - global_context; - trait_decls_context; - trait_impls_context; + type_ctx; + fun_ctx; + global_ctx; + trait_decls_ctx; + trait_impls_ctx; region_groups; type_vars; const_generic_vars; @@ -621,7 +621,7 @@ let destructure_new_abs (loop_id : LoopId.id) contexts we join don't have non-fixed abstractions with the same ids. *) let refresh_abs (old_abs : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx = - let ids, _ = compute_context_ids ctx in + let ids, _ = compute_ctx_ids ctx in let abs_to_refresh = AbstractionId.Set.diff ids.aids old_abs in let aids_subst = List.map diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml index 90559c29..2a688fa7 100644 --- a/compiler/InterpreterLoopsMatchCtxs.ml +++ b/compiler/InterpreterLoopsMatchCtxs.ml @@ -658,7 +658,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct else ( (* The caller should have checked that the symbolic values don't contain borrows *) - assert (not (ty_has_borrows S.ctx.type_context.type_infos sv0.sv_ty)); + assert (not (ty_has_borrows S.ctx.type_ctx.type_infos sv0.sv_ty)); (* We simply introduce a fresh symbolic value *) mk_fresh_symbolic_value sv0.sv_ty) @@ -669,7 +669,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct - there are no borrows in the "regular" value If there are loans in the regular value, raise an exception. *) - assert (not (ty_has_borrows S.ctx.type_context.type_infos sv.sv_ty)); + assert (not (ty_has_borrows S.ctx.type_ctx.type_infos sv.sv_ty)); assert (not (value_has_borrows S.ctx v.value)); let value_is_left = not left in (match InterpreterBorrowsCore.get_first_loan_in_value v with diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml index 30b7b333..da617c64 100644 --- a/compiler/InterpreterStatements.ml +++ b/compiler/InterpreterStatements.ml @@ -747,7 +747,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) let tr_self = UnknownTrait __FUNCTION__ in let regions_hierarchy = LlbcAstUtils.FunIdMap.find (FRegular fid) - ctx.fun_context.regions_hierarchies + ctx.fun_ctx.regions_hierarchies in let inst_sg = instantiate_fun_sig ctx func.generics tr_self def.signature @@ -793,7 +793,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) let fid : fun_id = FRegular id in let regions_hierarchy = LlbcAstUtils.FunIdMap.find fid - ctx.fun_context.regions_hierarchies + ctx.fun_ctx.regions_hierarchies in let inst_sg = instantiate_fun_sig ctx generics tr_self @@ -853,7 +853,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) method_def.signature.parent_params_info)); let regions_hierarchy = LlbcAstUtils.FunIdMap.find (FRegular method_id) - ctx.fun_context.regions_hierarchies + ctx.fun_ctx.regions_hierarchies in let tr_self = TraitRef trait_ref in let inst_sg = @@ -884,7 +884,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) (* Instantiate *) let regions_hierarchy = LlbcAstUtils.FunIdMap.find (FRegular method_id) - ctx.fun_context.regions_hierarchies + ctx.fun_ctx.regions_hierarchies in let tr_self = TraitRef trait_ref in let inst_sg = @@ -1450,7 +1450,7 @@ and eval_assumed_function_call_symbolic (config : config) (fid : assumed_fun_id) * this is a current limitation of our synthesis *) assert ( List.for_all - (fun ty -> not (ty_has_borrows ctx.type_context.type_infos ty)) + (fun ty -> not (ty_has_borrows ctx.type_ctx.type_infos ty)) generics.types); (* There are two cases (and this is extremely annoying): @@ -1476,7 +1476,7 @@ and eval_assumed_function_call_symbolic (config : config) (fid : assumed_fun_id) | _ -> let regions_hierarchy = LlbcAstUtils.FunIdMap.find (FAssumed fid) - ctx.fun_context.regions_hierarchies + ctx.fun_ctx.regions_hierarchies in (* There shouldn't be any reference to Self *) let tr_self = UnknownTrait __FUNCTION__ in diff --git a/compiler/InterpreterUtils.ml b/compiler/InterpreterUtils.ml index e04a6b90..a1a06ee5 100644 --- a/compiler/InterpreterUtils.ml +++ b/compiler/InterpreterUtils.ml @@ -265,7 +265,7 @@ let value_has_ret_symbolic_value_with_borrow_under_mut (ctx : eval_ctx) inherit [_] iter_typed_value method! visit_symbolic_value _ s = - if ty_has_borrow_under_mut ctx.type_context.type_infos s.sv_ty then + if ty_has_borrow_under_mut ctx.type_ctx.type_infos s.sv_ty then raise Found else () end @@ -288,15 +288,15 @@ let rvalue_get_place (rv : rvalue) : place option = (** See {!ValuesUtils.symbolic_value_has_borrows} *) let symbolic_value_has_borrows (ctx : eval_ctx) (sv : symbolic_value) : bool = - ValuesUtils.symbolic_value_has_borrows ctx.type_context.type_infos sv + ValuesUtils.symbolic_value_has_borrows ctx.type_ctx.type_infos sv (** See {!ValuesUtils.value_has_borrows}. *) let value_has_borrows (ctx : eval_ctx) (v : value) : bool = - ValuesUtils.value_has_borrows ctx.type_context.type_infos v + ValuesUtils.value_has_borrows ctx.type_ctx.type_infos v (** See {!ValuesUtils.value_has_loans_or_borrows}. *) let value_has_loans_or_borrows (ctx : eval_ctx) (v : value) : bool = - ValuesUtils.value_has_loans_or_borrows ctx.type_context.type_infos v + ValuesUtils.value_has_loans_or_borrows ctx.type_ctx.type_infos v (** See {!ValuesUtils.value_has_loans}. *) let value_has_loans (v : value) : bool = ValuesUtils.value_has_loans v @@ -401,19 +401,19 @@ let compute_env_elem_ids (x : env_elem) : ids_sets * ids_to_values = compute_env_ids [ x ] (** Compute the sets of ids found in a list of contexts. *) -let compute_contexts_ids (ctxl : eval_ctx list) : ids_sets * ids_to_values = +let compute_ctxs_ids (ctxl : eval_ctx list) : ids_sets * ids_to_values = let compute, get_ids, get_ids_to_values = compute_ids () in List.iter (compute#visit_eval_ctx ()) ctxl; (get_ids (), get_ids_to_values ()) (** Compute the sets of ids found in a context. *) -let compute_context_ids (ctx : eval_ctx) : ids_sets * ids_to_values = - compute_contexts_ids [ ctx ] +let compute_ctx_ids (ctx : eval_ctx) : ids_sets * ids_to_values = + compute_ctxs_ids [ ctx ] (** **WARNING**: this function doesn't compute the normalized types (for the trait type aliases). This should be computed afterwards. *) -let initialize_eval_context (ctx : decls_ctx) +let initialize_eval_ctx (ctx : decls_ctx) (region_groups : RegionGroupId.id list) (type_vars : type_var list) (const_generic_vars : const_generic_var list) : eval_ctx = reset_global_counters (); @@ -427,11 +427,11 @@ let initialize_eval_context (ctx : decls_ctx) const_generic_vars) in { - type_context = ctx.type_ctx; - fun_context = ctx.fun_ctx; - global_context = ctx.global_ctx; - trait_decls_context = ctx.trait_decls_ctx; - trait_impls_context = ctx.trait_impls_ctx; + type_ctx = ctx.type_ctx; + fun_ctx = ctx.fun_ctx; + global_ctx = ctx.global_ctx; + trait_decls_ctx = ctx.trait_decls_ctx; + trait_impls_ctx = ctx.trait_impls_ctx; region_groups; type_vars; const_generic_vars; diff --git a/compiler/Invariants.ml b/compiler/Invariants.ml index fa0d7436..b87cdff7 100644 --- a/compiler/Invariants.ml +++ b/compiler/Invariants.ml @@ -768,7 +768,7 @@ let check_symbolic_values (ctx : eval_ctx) : unit = assert (info.env_count = 0 || info.aproj_borrows = []); (* A symbolic value containing borrows can't be duplicated (i.e., copied): * it must be expanded first *) - if ty_has_borrows ctx.type_context.type_infos info.ty then + if ty_has_borrows ctx.type_ctx.type_infos info.ty then assert (info.env_count <= 1); (* A duplicated symbolic value is necessarily primitively copyable *) assert (info.env_count <= 1 || ty_is_primitively_copyable info.ty); diff --git a/compiler/Print.ml b/compiler/Print.ml index 0e2ec1fc..8999c77d 100644 --- a/compiler/Print.ml +++ b/compiler/Print.ml @@ -409,11 +409,11 @@ module Contexts = struct } let eval_ctx_to_fmt_env (ctx : eval_ctx) : fmt_env = - let type_decls = ctx.type_context.type_decls in - let fun_decls = ctx.fun_context.fun_decls in - let global_decls = ctx.global_context.global_decls in - let trait_decls = ctx.trait_decls_context.trait_decls in - let trait_impls = ctx.trait_impls_context.trait_impls in + let type_decls = ctx.type_ctx.type_decls in + let fun_decls = ctx.fun_ctx.fun_decls in + let global_decls = ctx.global_ctx.global_decls in + let trait_decls = ctx.trait_decls_ctx.trait_decls in + let trait_impls = ctx.trait_impls_ctx.trait_impls in (* Below: it is always safe to omit fields - if an id can't be found at printing time, we print the id (in raw form) instead of the name it designates. *) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 204fc399..d8213317 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -15,7 +15,7 @@ module PP = PrintPure (** The local logger *) let log = Logging.symbolic_to_pure_log -type type_context = { +type type_ctx = { llbc_type_decls : T.type_decl TypeDeclId.Map.t; type_decls : type_decl TypeDeclId.Map.t; (** We use this for type-checking (for sanity checks) when translating @@ -43,18 +43,18 @@ type fun_sig_named_outputs = { } [@@deriving show] -type fun_context = { +type fun_ctx = { llbc_fun_decls : A.fun_decl A.FunDeclId.Map.t; fun_infos : fun_info A.FunDeclId.Map.t; regions_hierarchies : T.region_var_groups FunIdMap.t; } [@@deriving show] -type global_context = { llbc_global_decls : A.global_decl A.GlobalDeclId.Map.t } +type global_ctx = { llbc_global_decls : A.global_decl A.GlobalDeclId.Map.t } [@@deriving show] -type trait_decls_context = A.trait_decl A.TraitDeclId.Map.t [@@deriving show] -type trait_impls_context = A.trait_impl A.TraitImplId.Map.t [@@deriving show] +type trait_decls_ctx = A.trait_decl A.TraitDeclId.Map.t [@@deriving show] +type trait_impls_ctx = A.trait_impl A.TraitImplId.Map.t [@@deriving show] (** Whenever we translate a function call or an ended abstraction, we store the related information (this is useful when translating ended @@ -120,11 +120,11 @@ type loop_info = { (** Body synthesis context *) type bs_ctx = { - type_context : type_context; (* TODO: rename *) - fun_context : fun_context; (* TODO: rename *) - global_context : global_context; (* TODO: rename *) - trait_decls_ctx : trait_decls_context; - trait_impls_ctx : trait_impls_context; + type_ctx : type_ctx; + fun_ctx : fun_ctx; + global_ctx : global_ctx; + trait_decls_ctx : trait_decls_ctx; + trait_impls_ctx : trait_impls_ctx; fun_decl : A.fun_decl; bid : RegionGroupId.id option; (** TODO: rename @@ -234,9 +234,9 @@ type bs_ctx = { (* TODO: move *) let bs_ctx_to_fmt_env (ctx : bs_ctx) : Print.fmt_env = - let type_decls = ctx.type_context.llbc_type_decls in - let fun_decls = ctx.fun_context.llbc_fun_decls in - let global_decls = ctx.global_context.llbc_global_decls in + let type_decls = ctx.type_ctx.llbc_type_decls in + let fun_decls = ctx.fun_ctx.llbc_fun_decls in + let global_decls = ctx.global_ctx.llbc_global_decls in let trait_decls = ctx.trait_decls_ctx in let trait_impls = ctx.trait_impls_ctx in let { regions; types; const_generics; trait_clauses } : T.generic_params = @@ -258,9 +258,9 @@ let bs_ctx_to_fmt_env (ctx : bs_ctx) : Print.fmt_env = } let bs_ctx_to_pure_fmt_env (ctx : bs_ctx) : PrintPure.fmt_env = - let type_decls = ctx.type_context.llbc_type_decls in - let fun_decls = ctx.fun_context.llbc_fun_decls in - let global_decls = ctx.global_context.llbc_global_decls in + let type_decls = ctx.type_ctx.llbc_type_decls in + let fun_decls = ctx.fun_ctx.llbc_fun_decls in + let global_decls = ctx.global_ctx.llbc_global_decls in let trait_decls = ctx.trait_decls_ctx in let trait_impls = ctx.trait_impls_ctx in let generics = ctx.sg.generics in @@ -346,11 +346,11 @@ let abs_to_string (ctx : bs_ctx) (abs : V.abs) : string = let bs_ctx_lookup_llbc_type_decl (id : TypeDeclId.id) (ctx : bs_ctx) : T.type_decl = - TypeDeclId.Map.find id ctx.type_context.llbc_type_decls + TypeDeclId.Map.find id ctx.type_ctx.llbc_type_decls let bs_ctx_lookup_llbc_fun_decl (id : A.FunDeclId.id) (ctx : bs_ctx) : A.fun_decl = - A.FunDeclId.Map.find id ctx.fun_context.llbc_fun_decls + A.FunDeclId.Map.find id ctx.fun_ctx.llbc_fun_decls (* Some generic translation functions (we need to translate different "flavours" of types: forward types, backward types, etc.) *) @@ -617,13 +617,13 @@ and translate_fwd_trait_instance_id (type_infos : type_infos) (** Simply calls [translate_fwd_ty] *) let ctx_translate_fwd_ty (ctx : bs_ctx) (ty : T.ty) : ty = - let type_infos = ctx.type_context.type_infos in + let type_infos = ctx.type_ctx.type_infos in translate_fwd_ty type_infos ty (** Simply calls [translate_fwd_generic_args] *) let ctx_translate_fwd_generic_args (ctx : bs_ctx) (generics : T.generic_args) : generic_args = - let type_infos = ctx.type_context.type_infos in + let type_infos = ctx.type_ctx.type_infos in translate_fwd_generic_args type_infos generics (** Translate a type, when some regions may have ended. @@ -708,7 +708,7 @@ let rec translate_back_ty (type_infos : type_infos) (** Simply calls [translate_back_ty] *) let ctx_translate_back_ty (ctx : bs_ctx) (keep_region : 'r -> bool) (inside_mut : bool) (ty : T.ty) : ty option = - let type_infos = ctx.type_context.type_infos in + let type_infos = ctx.type_ctx.type_infos in translate_back_ty type_infos keep_region inside_mut ty let mk_type_check_ctx (ctx : bs_ctx) : PureTypeCheck.tc_ctx = @@ -721,8 +721,8 @@ let mk_type_check_ctx (ctx : bs_ctx) : PureTypeCheck.tc_ctx = in let env = VarId.Map.empty in { - PureTypeCheck.type_decls = ctx.type_context.type_decls; - global_decls = ctx.global_context.llbc_global_decls; + PureTypeCheck.type_decls = ctx.type_ctx.type_decls; + global_decls = ctx.global_ctx.llbc_global_decls; env; const_generics; } @@ -742,7 +742,7 @@ let translate_fun_id_or_trait_method_ref (ctx : bs_ctx) match id with | FunId fun_id -> FunId fun_id | TraitMethod (trait_ref, method_name, fun_decl_id) -> - let type_infos = ctx.type_context.type_infos in + let type_infos = ctx.type_ctx.type_infos in let trait_ref = translate_fwd_trait_ref type_infos trait_ref in TraitMethod (trait_ref, method_name, fun_decl_id) @@ -894,7 +894,7 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) List.map (fun (g : T.region_var_group) -> g.id) regions_hierarchy in let ctx = - InterpreterUtils.initialize_eval_context decls_ctx region_groups + InterpreterUtils.initialize_eval_ctx decls_ctx region_groups sg.generics.types sg.generics.const_generics in (* Compute the normalization map for the *sty* types and add it to the context *) @@ -1786,7 +1786,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (* Retrieve the effect information about this function (can fail, * takes a state as input, etc.) *) let effect_info = - get_fun_effect_info ctx.fun_context.fun_infos fid None None + get_fun_effect_info ctx.fun_ctx.fun_infos fid None None in (* Depending on the function effects: * - add the fuel @@ -2006,7 +2006,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) raise (Failure "Unreachable") in let effect_info = - get_fun_effect_info ctx.fun_context.fun_infos fun_id None (Some rg_id) + get_fun_effect_info ctx.fun_ctx.fun_infos fun_id None (Some rg_id) in let generics = ctx_translate_fwd_generic_args ctx call.generics in (* Retrieve the original call and the parent abstractions *) @@ -2194,8 +2194,8 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) | V.LoopCall -> let fun_id = E.FRegular ctx.fun_decl.def_id in let effect_info = - get_fun_effect_info ctx.fun_context.fun_infos (FunId fun_id) - (Some vloop_id) (Some rg_id) + get_fun_effect_info ctx.fun_ctx.fun_infos (FunId fun_id) (Some vloop_id) + (Some rg_id) in let loop_info = LoopId.Map.find loop_id ctx.loops in let generics = loop_info.generics in @@ -2306,7 +2306,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) and translate_global_eval (gid : A.GlobalDeclId.id) (sval : V.symbolic_value) (e : S.expression) (ctx : bs_ctx) : texpression = let ctx, var = fresh_var_for_symbolic_value sval ctx in - let decl = A.GlobalDeclId.Map.find gid ctx.global_context.llbc_global_decls in + let decl = A.GlobalDeclId.Map.find gid ctx.global_ctx.llbc_global_decls in let global_expr = { id = Global gid; generics = empty_generic_args } in (* We use translate_fwd_ty to translate the global type *) let ty = ctx_translate_fwd_ty ctx decl.ty in @@ -2482,7 +2482,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value) - if we forbid using field projectors. *) let is_rec_def = - T.TypeDeclId.Set.mem adt_id ctx.type_context.recursive_decls + T.TypeDeclId.Set.mem adt_id ctx.type_ctx.recursive_decls in let use_let_with_cons = is_enum @@ -2495,7 +2495,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value) like Coq don't, in which case we have to deconstruct the whole ADT at once (`let (a, b, c) = x in`) *) || TypesUtils.type_decl_from_type_id_is_tuple_struct - ctx.type_context.type_infos type_id + ctx.type_ctx.type_infos type_id && not (Config.backend_has_tuple_projectors ()) in if use_let_with_cons then @@ -2588,7 +2588,7 @@ and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option) { e = StructUpdate su; ty = var.ty } | VaCgValue cg_id -> { e = CVar cg_id; ty = var.ty } | VaTraitConstValue (trait_ref, generics, const_name) -> - let type_infos = ctx.type_context.type_infos in + let type_infos = ctx.type_ctx.type_infos in let trait_ref = translate_fwd_trait_ref type_infos trait_ref in let generics = translate_fwd_generic_args type_infos generics in let qualif_id = TraitConst (trait_ref, generics, const_name) in @@ -2722,7 +2722,7 @@ and translate_forward_end (ectx : C.eval_ctx) let sg = ctx.fun_decl.signature in let regions_hierarchy = LlbcAstUtils.FunIdMap.find (FRegular def_id) - ctx.fun_context.regions_hierarchies + ctx.fun_ctx.regions_hierarchies in List.map (fun (gid, _) -> @@ -2816,7 +2816,7 @@ and translate_forward_end (ectx : C.eval_ctx) (* Lookup the effect info for the loop function *) let fid = E.FRegular ctx.fun_decl.def_id in let effect_info = - get_fun_effect_info ctx.fun_context.fun_infos (FunId fid) None ctx.bid + get_fun_effect_info ctx.fun_ctx.fun_infos (FunId fid) None ctx.bid in (* Introduce a fresh output value for the forward function *) @@ -2949,7 +2949,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = List.map (fun ty -> assert ( - not (TypesUtils.ty_has_borrows !ctx.type_context.type_infos ty)); + not (TypesUtils.ty_has_borrows !ctx.type_ctx.type_infos ty)); (None, ctx_translate_fwd_ty !ctx ty)) tys in @@ -3173,7 +3173,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = (* Translate the signature *) let signature = translate_fun_sig_from_decomposed ctx.sg ctx.bid in let regions_hierarchy = - FunIdMap.find (FRegular def_id) ctx.fun_context.regions_hierarchies + FunIdMap.find (FRegular def_id) ctx.fun_ctx.regions_hierarchies in (* Translate the body, if there is *) let body = @@ -3181,8 +3181,8 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = | None -> None | Some body -> let effect_info = - get_fun_effect_info ctx.fun_context.fun_infos - (FunId (FRegular def_id)) None bid + get_fun_effect_info ctx.fun_ctx.fun_infos (FunId (FRegular def_id)) + None bid in let body = translate_expression body ctx in (* Add a match over the fuel, if necessary *) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 8b221c93..e153f4f4 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -72,7 +72,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx) | RecGroup _ -> Some tid) (TypeDeclId.Map.bindings trans_ctx.type_ctx.type_decls_groups)) in - let type_context = + let type_ctx = { SymbolicToPure.type_infos = trans_ctx.type_ctx.type_infos; llbc_type_decls = trans_ctx.type_ctx.type_decls; @@ -80,14 +80,14 @@ let translate_function_to_pure (trans_ctx : trans_ctx) recursive_decls = recursive_type_decls; } in - let fun_context = + let fun_ctx = { SymbolicToPure.llbc_fun_decls = trans_ctx.fun_ctx.fun_decls; fun_infos = trans_ctx.fun_ctx.fun_infos; regions_hierarchies = trans_ctx.fun_ctx.regions_hierarchies; } in - let global_context = + let global_ctx = { SymbolicToPure.llbc_global_decls = trans_ctx.global_ctx.global_decls } in @@ -134,7 +134,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx) in let regions_hierarchy = - LlbcAstUtils.FunIdMap.find (FRegular def_id) fun_context.regions_hierarchies + LlbcAstUtils.FunIdMap.find (FRegular def_id) fun_ctx.regions_hierarchies in let var_counter, back_state_vars = @@ -160,9 +160,9 @@ let translate_function_to_pure (trans_ctx : trans_ctx) back_state_vars; fuel0; fuel; - type_context; - fun_context; - global_context; + type_ctx; + fun_ctx; + global_ctx; trait_decls_ctx = trans_ctx.trait_decls_ctx.trait_decls; trait_impls_ctx = trans_ctx.trait_impls_ctx.trait_impls; fun_decl = fdef; -- cgit v1.2.3 From 17973e99e4784ff5e31565622d183ad89e3d9cd7 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 18 Dec 2023 11:40:44 +0100 Subject: Add some comments --- compiler/SymbolicToPure.ml | 47 ++++++++++++++++++++++++++++++---------------- 1 file changed, 31 insertions(+), 16 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index d8213317..a79340b6 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -151,8 +151,8 @@ type bs_ctx = { state_var : VarId.id; (** The current state variable, in case the function is stateful *) back_state_vars : VarId.id RegionGroupId.Map.t; - (** The additional input state variable received by a stateful backward function, - **in case we are splitting the forward/backward functions**. + (** The additional input state variable received by a stateful backward + function, **in case we are splitting the forward/backward functions**. When generating stateful functions, we generate code of the following form: @@ -195,7 +195,22 @@ type bs_ctx = { *) backward_outputs : var list RegionGroupId.Map.t; (** The variables that the backward functions will output, corresponding - to the borrows they give back (don't include the backward state) + to the borrows they give back (don't include the backward state). + + The translation is done as follows: + - for a given backward function, we choose a set of variables [v_i] + - when we detect the ended input abstraction which corresponds + to the backward function of the LLBC function we are translating, + and which consumed the values [consumed_i] (that we need to give + back to the caller), we introduce: + {[ + let v_i = consumed_i in + ... + ]} + Then, upon reaching the [Return] node, we introduce: + {[ + (v_i) + ]} *) loop_backward_outputs : var list RegionGroupId.Map.t option; (** Same as {!backward_outputs}, but for loops (if we entered a loop). @@ -1930,19 +1945,19 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) assert (rg_id = bid); (* The translation is done as follows: - * - for a given backward function, we choose a set of variables [v_i] - * - when we detect the ended input abstraction which corresponds - * to the backward function, and which consumed the values [consumed_i], - * we introduce: - * {[ - * let v_i = consumed_i in - * ... - * ]} - * Then, when we reach the [Return] node, we introduce: - * {[ - * (v_i) - * ]} - * *) + - for a given backward function, we choose a set of variables [v_i] + - when we detect the ended input abstraction which corresponds + to the backward function, and which consumed the values [consumed_i], + we introduce: + {[ + let v_i = consumed_i in + ... + ]} + Then, when we reach the [Return] node, we introduce: + {[ + (v_i) + ]} + *) (* First, get the given back variables. We don't use the same given back variables if we translate a loop or -- cgit v1.2.3 From 999f48d032107722aa6ca714da828ab2788ca412 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 18 Dec 2023 12:06:07 +0100 Subject: Fix a minor mistake in SymbolicToPure --- compiler/PrintPure.ml | 12 +++++++----- compiler/PureMicroPasses.ml | 9 +++++++-- compiler/SymbolicToPure.ml | 5 +---- 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index 79506c04..1ce146a4 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -103,10 +103,13 @@ let adt_field_names (env : fmt_env) = Print.Types.adt_field_names (fmt_env_to_llbc_fmt_env env) let option_to_string = Print.option_to_string -let type_var_to_string = Print.Types.type_var_to_string -let const_generic_var_to_string = Print.Types.const_generic_var_to_string -let integer_type_to_string = Print.Values.integer_type_to_string let literal_type_to_string = Print.Values.literal_type_to_string +let type_var_to_string (v : type_var) = "(" ^ v.name ^ ": Type)" + +let const_generic_var_to_string (v : const_generic_var) = + "(" ^ v.name ^ " : " ^ literal_type_to_string v.ty ^ ")" + +let integer_type_to_string = Print.Values.integer_type_to_string let scalar_value_to_string = Print.Values.scalar_value_to_string let literal_to_string = Print.Values.literal_to_string @@ -203,13 +206,12 @@ and trait_instance_id_to_string (env : fmt_env) (inside : bool) | UnknownTrait msg -> "UNKNOWN(" ^ msg ^ ")" let trait_clause_to_string (env : fmt_env) (clause : trait_clause) : string = - let clause_id = trait_clause_id_to_string env clause.clause_id in let trait_id = trait_decl_id_to_string env clause.trait_id in let generics = generic_args_to_strings env true clause.generics in let generics = if generics = [] then "" else " " ^ String.concat " " generics in - "[" ^ clause_id ^ "]: " ^ trait_id ^ generics + trait_id ^ generics let generic_params_to_strings (env : fmt_env) (generics : generic_params) : string list = diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index a7c2f154..34597d32 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -11,6 +11,10 @@ let fun_decl_to_string (ctx : trans_ctx) (def : Pure.fun_decl) : string = let fmt = trans_ctx_to_pure_fmt_env ctx in PrintPure.fun_decl_to_string fmt def +let fun_sig_to_string (ctx : trans_ctx) (sg : Pure.fun_sig) : string = + let fmt = trans_ctx_to_pure_fmt_env ctx in + PrintPure.fun_sig_to_string fmt sg + (** Small utility. We sometimes have to insert new fresh variables in a function body, in which @@ -1303,7 +1307,8 @@ let filter_if_backward_with_no_outputs (def : fun_decl) : fun_decl option = those function bodies into independent definitions while removing occurrences of the {!Pure.Loop} node. *) -let decompose_loops (def : fun_decl) : fun_decl * fun_decl list = +let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : + fun_decl * fun_decl list = match def.body with | None -> (def, []) | Some body -> @@ -1982,7 +1987,7 @@ let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) : (lazy ("not filtered (not backward with no outputs): " ^ name ^ "\n")); (* Extract the loop definitions by removing the {!Loop} node *) - let def, loops = decompose_loops def in + let def, loops = decompose_loops ctx def in (* Apply the remaining passes *) let f = apply_end_passes_to_def ctx def in diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index a79340b6..7359f68a 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -950,7 +950,7 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) let fwd_info = (* *) let has_fuel = fwd_fuel <> [] in - let num_inputs_no_fuel_no_state = List.length fwd_inputs in + let num_inputs_no_fuel_no_state = List.length fwd_inputs_no_fuel_no_state in let num_inputs_with_fuel_no_state = (* We use the fact that [fuel] has length 1 if we use some fuel, 0 otherwise *) List.length fwd_fuel + num_inputs_no_fuel_no_state @@ -2620,9 +2620,6 @@ and translate_forward_end (ectx : C.eval_ctx) (loop_input_values : V.typed_value S.symbolic_value_id_map option) (fwd_e : S.expression) (back_e : S.expression S.region_group_id_map) (ctx : bs_ctx) : texpression = - (* TODO: *) - assert (not !Config.return_back_funs); - let translate_one_end ctx (bid : RegionGroupId.id option) = let ctx = { ctx with bid } in (* Update the current state with the additional state received by the backward -- cgit v1.2.3 From 116b569d1b08a57c3ad66071979a1c966fdad3a2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 18 Dec 2023 12:18:06 +0100 Subject: Remove the backwards field from SymbolicToPure.call_info --- compiler/SymbolicToPure.ml | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 7359f68a..ea2082c7 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -67,12 +67,6 @@ type call_info = { Those inputs include the fuel and the state, if pertinent. *) - backwards : (V.abs * texpression list) T.RegionGroupId.Map.t; - (** A map from region group id (i.e., backward function id) to - pairs (abstraction, additional arguments received by the backward function) - - TODO: remove? it is also in the bs_ctx ("abstractions" field) - *) } [@@deriving show] @@ -224,7 +218,10 @@ type bs_ctx = { calls : call_info V.FunCallId.Map.t; (** The function calls we encountered so far *) abstractions : (V.abs * texpression list) V.AbstractionId.Map.t; - (** The ended abstractions we encountered so far, with their additional input arguments *) + (** The ended abstractions we encountered so far, with their additional + input arguments. We store it here and not in {!call_info} because + we need a map from abstraction id to abstraction (and not + from call id + region group id to abstraction). *) loop_ids_map : LoopId.id V.LoopId.Map.t; (** Ids to use for the loops *) loops : loop_info LoopId.Map.t; (** The loops we encountered so far. @@ -765,9 +762,7 @@ let bs_ctx_register_forward_call (call_id : V.FunCallId.id) (forward : S.call) (args : texpression list) (ctx : bs_ctx) : bs_ctx = let calls = ctx.calls in assert (not (V.FunCallId.Map.mem call_id calls)); - let info = - { forward; forward_inputs = args; backwards = T.RegionGroupId.Map.empty } - in + let info = { forward; forward_inputs = args } in let calls = V.FunCallId.Map.add call_id info calls in { ctx with calls } @@ -777,11 +772,6 @@ let bs_ctx_register_backward_call (abs : V.abs) (call_id : V.FunCallId.id) : bs_ctx * fun_or_op_id = (* Insert the abstraction in the call informations *) let info = V.FunCallId.Map.find call_id ctx.calls in - assert (not (T.RegionGroupId.Map.mem back_id info.backwards)); - let backwards = - T.RegionGroupId.Map.add back_id (abs, back_args) info.backwards - in - let info = { info with backwards } in let calls = V.FunCallId.Map.add call_id info ctx.calls in (* Insert the abstraction in the abstractions map *) let abstractions = ctx.abstractions in -- cgit v1.2.3 From 4f7bc41dcbc6187512111a81f968726452024d25 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 19 Dec 2023 12:54:40 +0100 Subject: Simplify SymbolicToPure.bs_ctx.{backward_outputs, loop_backward_outputs} --- compiler/SymbolicToPure.ml | 153 ++++++++++++++++++++------------------------- compiler/Translate.ml | 17 +---- 2 files changed, 70 insertions(+), 100 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index ea2082c7..93e6cb4e 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -109,6 +109,10 @@ type loop_info = { (** The forward inputs are initialized at [None] *) forward_output_no_state_no_result : var option; (** The forward outputs are initialized at [None] *) + back_outputs : ty list RegionGroupId.Map.t; + (** The map from region group ids to the types of the values given back + by the corresponding loop abstractions. + *) } [@@deriving show] @@ -187,12 +191,11 @@ type bs_ctx = { Same remarks as for {!backward_inputs_no_state}. *) - backward_outputs : var list RegionGroupId.Map.t; + backward_outputs : var list option; (** The variables that the backward functions will output, corresponding to the borrows they give back (don't include the backward state). The translation is done as follows: - - for a given backward function, we choose a set of variables [v_i] - when we detect the ended input abstraction which corresponds to the backward function of the LLBC function we are translating, and which consumed the values [consumed_i] (that we need to give @@ -201,14 +204,20 @@ type bs_ctx = { let v_i = consumed_i in ... ]} - Then, upon reaching the [Return] node, we introduce: + where the [v_i] are fresh, and are stored in the [backward_output]. + - Then, upon reaching the [Return] node, we introduce: {[ - (v_i) + return (v_i) ]} + + The option is [None] before we detect the ended input abstraction, + and [Some] afterwards. *) - loop_backward_outputs : var list RegionGroupId.Map.t option; + loop_backward_outputs : var list option; (** Same as {!backward_outputs}, but for loops (if we entered a loop). + TODO: merge with [backward_outputs]? + [None] if we are not inside a loop, [Some] otherwise (and whatever the kind of function we are translating: it will be [Some] even though we are synthesizing a forward function). @@ -1607,7 +1616,9 @@ let mk_emeta_symbolic_assignments (vars : var list) (values : texpression list) let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = match e with - | S.Return (ectx, opt_v) -> translate_return ectx opt_v ctx + | S.Return (ectx, opt_v) -> + (* Remark: we can't get there if we are inside a loop *) + translate_return ectx opt_v ctx | ReturnWithLoop (loop_id, is_continue) -> translate_return_with_loop loop_id is_continue ctx | Panic -> translate_panic ctx @@ -1644,10 +1655,9 @@ and translate_panic (ctx : bs_ctx) : texpression = if ctx.inside_loop && Option.is_some ctx.bid then (* We are synthesizing the backward function of a loop body *) let bid = Option.get ctx.bid in - let back_vars = - T.RegionGroupId.Map.find bid (Option.get ctx.loop_backward_outputs) - in - let tys = List.map (fun (v : var) -> v.ty) back_vars in + let loop_id = Option.get ctx.loop_id in + let loop = LoopId.Map.find loop_id ctx.loops in + let tys = RegionGroupId.Map.find bid loop.back_outputs in let output = mk_simpl_tuple_ty tys in mk_output output else @@ -1667,7 +1677,11 @@ and translate_panic (ctx : bs_ctx) : texpression = in mk_output output -(** [opt_v]: the value to return, in case we translate a forward body *) +(** [opt_v]: the value to return, in case we translate a forward body. + + Remark: for now, we can't get there if we are inside a loop. + If inside a loop, we use {!translate_return_with_loop}. + *) and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) (ctx : bs_ctx) : texpression = (* There are two cases: @@ -1676,22 +1690,20 @@ and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) - or we are translating a backward function, in which case it should be [None] *) (* Compute the values that we should return *without the state and the result - * wrapper* *) + wrapper* *) let output = match ctx.bid with | None -> (* Forward function *) let v = Option.get opt_v in typed_value_to_texpression ctx ectx v - | Some bid -> + | Some _ -> (* Backward function *) (* Sanity check *) assert (opt_v = None); (* Group the variables in which we stored the values we need to give back. - * See the explanations for the [SynthInput] case in [translate_end_abstraction] *) - let backward_outputs = - T.RegionGroupId.Map.find bid ctx.backward_outputs - in + See the explanations for the [SynthInput] case in [translate_end_abstraction] *) + let backward_outputs = Option.get ctx.backward_outputs in let field_values = List.map mk_texpression_from_var backward_outputs in mk_simpl_tuple_texpression field_values in @@ -1728,19 +1740,16 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) (* Forward *) mk_texpression_from_var (Option.get loop_info.forward_output_no_state_no_result) - | Some bid -> + | Some _ -> (* Backward *) (* Group the variables in which we stored the values we need to give back. * See the explanations for the [SynthInput] case in [translate_end_abstraction] *) let backward_outputs = - let map = - if ctx.inside_loop then - (* We are synthesizing a loop body *) - Option.get ctx.loop_backward_outputs - else (* Regular function *) - ctx.backward_outputs - in - T.RegionGroupId.Map.find bid map + if ctx.inside_loop then + (* We are synthesizing a loop body *) + Option.get ctx.loop_backward_outputs + else (* Regular function *) + Option.get ctx.backward_outputs in let field_values = List.map mk_texpression_from_var backward_outputs in mk_simpl_tuple_texpression field_values @@ -1923,45 +1932,38 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) ^ abs_to_string ctx abs ^ "\n")); (* When we end an input abstraction, this input abstraction gets back - * the borrows which it introduced in the context through the input - * values: by listing those values, we get the values which are given - * back by one of the backward functions we are synthesizing. *) - (* Note that we don't support nested borrows for now: if we find - * an ended synthesized input abstraction, it must be the one corresponding - * to the backward function wer are synthesizing, it can't be the one - * for a parent backward function. - *) + the borrows which it introduced in the context through the input + values: by listing those values, we get the values which are given + back by one of the backward functions we are synthesizing. + + Note that we don't support nested borrows for now: if we find + an ended synthesized input abstraction, it must be the one corresponding + to the backward function wer are synthesizing, it can't be the one + for a parent backward function. + *) let bid = Option.get ctx.bid in assert (rg_id = bid); - (* The translation is done as follows: - - for a given backward function, we choose a set of variables [v_i] - - when we detect the ended input abstraction which corresponds - to the backward function, and which consumed the values [consumed_i], - we introduce: - {[ - let v_i = consumed_i in - ... - ]} - Then, when we reach the [Return] node, we introduce: - {[ - (v_i) - ]} - *) - (* First, get the given back variables. + (* First, introduce the given back variables. We don't use the same given back variables if we translate a loop or the standard body of a function. *) - let given_back_variables = - let map = - if ctx.inside_loop then - (* We are synthesizing a loop body *) - Option.get ctx.loop_backward_outputs - else (* Regular function body *) - ctx.backward_outputs - in - T.RegionGroupId.Map.find bid map + let ctx, given_back_variables = + if ctx.inside_loop then + (* We are synthesizing a loop body *) + let loop_id = Option.get ctx.loop_id in + let loop = LoopId.Map.find loop_id ctx.loops in + let tys = RegionGroupId.Map.find bid loop.back_outputs in + let vars = List.map (fun ty -> (None, ty)) tys in + let ctx, vars = fresh_vars vars ctx in + ({ ctx with loop_backward_outputs = Some vars }, vars) + else + (* Regular function body *) + let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in + let vars = List.combine back_sg.output_names back_sg.outputs in + let ctx, vars = fresh_vars vars ctx in + ({ ctx with backward_outputs = Some vars }, vars) in (* Get the list of values consumed by the abstraction upon ending *) @@ -2943,22 +2945,15 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (* Compute the backward outputs *) let ctx = ref ctx in - let loop_backward_outputs = + let rg_to_given_back_tys = T.RegionGroupId.Map.map (fun (_, tys) -> (* The types shouldn't contain borrows - we can translate them as forward types *) - let vars = - List.map - (fun ty -> - assert ( - not (TypesUtils.ty_has_borrows !ctx.type_ctx.type_infos ty)); - (None, ctx_translate_fwd_ty !ctx ty)) - tys - in - (* Introduce fresh variables *) - let ctx', vars = fresh_vars vars !ctx in - ctx := ctx'; - vars) + List.map + (fun ty -> + assert (not (TypesUtils.ty_has_borrows !ctx.type_ctx.type_infos ty)); + ctx_translate_fwd_ty !ctx ty) + tys) loop.rg_to_given_back_tys in let ctx = !ctx in @@ -2966,12 +2961,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = let back_output_tys = match ctx.bid with | None -> None - | Some rg_id -> - let back_outputs = - T.RegionGroupId.Map.find rg_id loop_backward_outputs - in - let back_output_tys = List.map (fun (v : var) -> v.ty) back_outputs in - Some back_output_tys + | Some rg_id -> Some (T.RegionGroupId.Map.find rg_id rg_to_given_back_tys) in (* Add the loop information in the context *) @@ -3013,6 +3003,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = generics; forward_inputs = None; forward_output_no_state_no_result = None; + back_outputs = rg_to_given_back_tys; } in let loops = LoopId.Map.add loop_id loop_info ctx.loops in @@ -3020,13 +3011,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = in (* Update the context to translate the function end *) - let ctx_end = - { - ctx with - loop_id = Some loop_id; - loop_backward_outputs = Some loop_backward_outputs; - } - in + let ctx_end = { ctx with loop_id = Some loop_id } in let fun_end = translate_expression loop.end_expr ctx_end in (* Update the context for the loop body *) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index e153f4f4..0fa0202b 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -171,8 +171,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx) backward_inputs_no_state = RegionGroupId.Map.empty; (* Initialized just below *) backward_inputs_with_state = RegionGroupId.Map.empty; - (* Initialized just below *) - backward_outputs = RegionGroupId.Map.empty; + backward_outputs = None; loop_backward_outputs = None; (* Empty for now *) calls; @@ -234,20 +233,6 @@ let translate_function_to_pure (trans_ctx : trans_ctx) in let ctx = { ctx with backward_inputs_no_state; backward_inputs_with_state } in - (* Add the backward outputs *) - let ctx, backward_outputs = - List.fold_left_map - (fun ctx (region_vars : region_var_group) -> - let gid = region_vars.id in - let back_sg = RegionGroupId.Map.find gid sg.back_sg in - let outputs = List.combine back_sg.output_names back_sg.outputs in - let ctx, vars = SymbolicToPure.fresh_vars outputs ctx in - (ctx, (gid, vars))) - ctx regions_hierarchy - in - let backward_outputs = RegionGroupId.Map.of_list backward_outputs in - let ctx = { ctx with backward_outputs } in - (* Translate the forward function *) let pure_forward = match symbolic_trans with -- cgit v1.2.3 From 014c0668abf0834342b2b7076cf2f0634460e519 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 19 Dec 2023 13:24:53 +0100 Subject: Remove SymbolicToPure.bs_ctx.loop_backward_outputs --- compiler/SymbolicToPure.ml | 47 +++++++++++++++------------------------------- compiler/Translate.ml | 1 - 2 files changed, 15 insertions(+), 33 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 93e6cb4e..e2787271 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -213,17 +213,6 @@ type bs_ctx = { The option is [None] before we detect the ended input abstraction, and [Some] afterwards. *) - loop_backward_outputs : var list option; - (** Same as {!backward_outputs}, but for loops (if we entered a loop). - - TODO: merge with [backward_outputs]? - - [None] if we are not inside a loop, [Some] otherwise (and whatever - the kind of function we are translating: it will be [Some] even - though we are synthesizing a forward function). - - TODO: move to {!loop_info} - *) calls : call_info V.FunCallId.Map.t; (** The function calls we encountered so far *) abstractions : (V.abs * texpression list) V.AbstractionId.Map.t; @@ -1744,13 +1733,7 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) (* Backward *) (* Group the variables in which we stored the values we need to give back. * See the explanations for the [SynthInput] case in [translate_end_abstraction] *) - let backward_outputs = - if ctx.inside_loop then - (* We are synthesizing a loop body *) - Option.get ctx.loop_backward_outputs - else (* Regular function *) - Option.get ctx.backward_outputs - in + let backward_outputs = Option.get ctx.backward_outputs in let field_values = List.map mk_texpression_from_var backward_outputs in mk_simpl_tuple_texpression field_values in @@ -1950,20 +1933,20 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) the standard body of a function. *) let ctx, given_back_variables = - if ctx.inside_loop then - (* We are synthesizing a loop body *) - let loop_id = Option.get ctx.loop_id in - let loop = LoopId.Map.find loop_id ctx.loops in - let tys = RegionGroupId.Map.find bid loop.back_outputs in - let vars = List.map (fun ty -> (None, ty)) tys in - let ctx, vars = fresh_vars vars ctx in - ({ ctx with loop_backward_outputs = Some vars }, vars) - else - (* Regular function body *) - let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in - let vars = List.combine back_sg.output_names back_sg.outputs in - let ctx, vars = fresh_vars vars ctx in - ({ ctx with backward_outputs = Some vars }, vars) + let vars = + if ctx.inside_loop then + (* We are synthesizing a loop body *) + let loop_id = Option.get ctx.loop_id in + let loop = LoopId.Map.find loop_id ctx.loops in + let tys = RegionGroupId.Map.find bid loop.back_outputs in + List.map (fun ty -> (None, ty)) tys + else + (* Regular function body *) + let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in + List.combine back_sg.output_names back_sg.outputs + in + let ctx, vars = fresh_vars vars ctx in + ({ ctx with backward_outputs = Some vars }, vars) in (* Get the list of values consumed by the abstraction upon ending *) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 0fa0202b..631a5af9 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -172,7 +172,6 @@ let translate_function_to_pure (trans_ctx : trans_ctx) (* Initialized just below *) backward_inputs_with_state = RegionGroupId.Map.empty; backward_outputs = None; - loop_backward_outputs = None; (* Empty for now *) calls; abstractions; -- cgit v1.2.3 From e90b23a0d42e2ea6805c88d6eaa4f9e5370a1dc1 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 19 Dec 2023 13:28:17 +0100 Subject: Reset Config.return_back_funs to false --- compiler/Config.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/Config.ml b/compiler/Config.ml index b8af6c6d..c8f3ed58 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -153,7 +153,7 @@ let loop_fixed_point_max_num_iters = 2 return (x :: ls))) ]} *) -let return_back_funs = ref true +let return_back_funs = ref false (** Forbids using field projectors for structures. -- cgit v1.2.3 From 8835d87df111d09122267fadc9a32f16b52d234a Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 14:37:43 +0100 Subject: Make good progress on merging the fwd/back functions --- compiler/Config.ml | 2 +- compiler/Extract.ml | 4 +- compiler/InterpreterStatements.ml | 47 ++++--- compiler/PureUtils.ml | 19 ++- compiler/SymbolicAst.ml | 4 + compiler/SymbolicToPure.ml | 266 ++++++++++++++++++++++++++++++-------- compiler/SynthesizeSymbolic.ml | 16 ++- compiler/Translate.ml | 3 +- 8 files changed, 274 insertions(+), 87 deletions(-) diff --git a/compiler/Config.ml b/compiler/Config.ml index c8f3ed58..b8af6c6d 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -153,7 +153,7 @@ let loop_fixed_point_max_num_iters = 2 return (x :: ls))) ]} *) -let return_back_funs = ref false +let return_back_funs = ref true (** Forbids using field projectors for structures. diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 3429cd11..46cf8c4a 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -1332,7 +1332,9 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter) in let fwd_back_comment = match def.back_id with - | None -> [ "forward function" ] + | None -> + if !Config.return_back_funs then [ "function definition" ] + else [ "forward function" ] | Some id -> (* Check if there is only one backward function, and no forward function *) if (not keep_fwd) && num_backs = 1 then diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml index da617c64..94c65b5c 100644 --- a/compiler/InterpreterStatements.ml +++ b/compiler/InterpreterStatements.ml @@ -728,7 +728,12 @@ let create_push_abstractions_from_abs_region_groups to a trait clause but directly to the method provided in the trait declaration. *) let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) - : fun_id_or_trait_method_ref * generic_args * fun_decl * inst_fun_sig = + : + fun_id_or_trait_method_ref + * generic_args + * fun_decl + * region_var_groups + * inst_fun_sig = match call.func with | FnOpMove _ -> (* Closure case: TODO *) @@ -753,7 +758,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) instantiate_fun_sig ctx func.generics tr_self def.signature regions_hierarchy in - (func.func, func.generics, def, inst_sg) + (func.func, func.generics, def, regions_hierarchy, inst_sg) | FunId (FAssumed _) -> (* Unreachable: must be a transparent function *) raise (Failure "Unreachable") @@ -806,7 +811,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) we also need to update the generics. *) let func = FunId fid in - (func, generics, method_def, inst_sg) + (func, generics, method_def, regions_hierarchy, inst_sg) | None -> (* If not found, lookup the methods provided by the trait *declaration* (remember: for now, we forbid overriding provided methods) *) @@ -860,7 +865,11 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) instantiate_fun_sig ctx all_generics tr_self method_def.signature regions_hierarchy in - (func.func, func.generics, method_def, inst_sg)) + ( func.func, + func.generics, + method_def, + regions_hierarchy, + inst_sg )) | _ -> (* We are using a local clause - we lookup the trait decl *) let trait_decl = @@ -891,7 +900,8 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) instantiate_fun_sig ctx generics tr_self method_def.signature regions_hierarchy in - (func.func, func.generics, method_def, inst_sg))) + (func.func, func.generics, method_def, regions_hierarchy, inst_sg) + )) (** Evaluate a statement *) let rec eval_statement (config : config) (st : statement) : st_cm_fun = @@ -1277,14 +1287,14 @@ and eval_transparent_function_call_concrete (config : config) and eval_transparent_function_call_symbolic (config : config) (call : call) : st_cm_fun = fun cf ctx -> - let func, generics, def, inst_sg = + let func, generics, def, regions_hierarchy, inst_sg = eval_transparent_function_call_symbolic_inst call ctx in (* Sanity check *) assert (List.length call.args = List.length def.signature.inputs); (* Evaluate the function call *) - eval_function_call_symbolic_from_inst_sig config func inst_sg generics - call.args call.dest cf ctx + eval_function_call_symbolic_from_inst_sig config func def.signature + regions_hierarchy inst_sg generics call.args call.dest cf ctx (** Evaluate a function call in symbolic mode by using the function signature. @@ -1298,7 +1308,8 @@ and eval_transparent_function_call_symbolic (config : config) (call : call) : trait ref as input. *) and eval_function_call_symbolic_from_inst_sig (config : config) - (fid : fun_id_or_trait_method_ref) (inst_sg : inst_fun_sig) + (fid : fun_id_or_trait_method_ref) (sg : fun_sig) + (regions_hierarchy : region_var_groups) (inst_sg : inst_fun_sig) (generics : generic_args) (args : operand list) (dest : place) : st_cm_fun = fun cf ctx -> log#ldebug @@ -1378,8 +1389,8 @@ and eval_function_call_symbolic_from_inst_sig (config : config) let expr = cf ctx in (* Synthesize the symbolic AST *) - S.synthesize_regular_function_call fid call_id ctx abs_ids generics args - args_places ret_spc dest_place expr + S.synthesize_regular_function_call fid call_id ctx sg regions_hierarchy + abs_ids generics args args_places ret_spc dest_place expr in let cc = comp cc cf_call in @@ -1468,7 +1479,7 @@ and eval_assumed_function_call_symbolic (config : config) (fid : assumed_fun_id) (* In symbolic mode, the behaviour of a function call is completely defined * by the signature of the function: we thus simply generate correctly * instantiated signatures, and delegate the work to an auxiliary function *) - let inst_sig = + let sg, regions_hierarchy, inst_sig = match fid with | BoxFree -> (* Should have been treated above *) @@ -1480,14 +1491,16 @@ and eval_assumed_function_call_symbolic (config : config) (fid : assumed_fun_id) in (* There shouldn't be any reference to Self *) let tr_self = UnknownTrait __FUNCTION__ in - instantiate_fun_sig ctx generics tr_self - (Assumed.get_assumed_fun_sig fid) - regions_hierarchy + let sg = Assumed.get_assumed_fun_sig fid in + let inst_sg = + instantiate_fun_sig ctx generics tr_self sg regions_hierarchy + in + (sg, regions_hierarchy, inst_sg) in (* Evaluate the function call *) - eval_function_call_symbolic_from_inst_sig config (FunId (FAssumed fid)) - inst_sig generics args dest cf ctx + eval_function_call_symbolic_from_inst_sig config (FunId (FAssumed fid)) sg + regions_hierarchy inst_sig generics args dest cf ctx (** Evaluate a statement seen as a function body *) and eval_function_body (config : config) (body : statement) : st_cm_fun = diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 6e86578c..6579e84c 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -321,14 +321,23 @@ let destruct_apps (e : texpression) : texpression * texpression list = (** Make an [App (app, arg)] expression *) let mk_app (app : texpression) (arg : texpression) : texpression = + let raise_or_return msg = + if !Config.fail_hard then raise (Failure msg) + else + let e = App (app, arg) in + (* Dummy type - TODO: introduce an error type *) + let ty = app.ty in + { e; ty } + in match app.ty with | TArrow (ty0, ty1) -> (* Sanity check *) - assert (ty0 = arg.ty); - let e = App (app, arg) in - let ty = ty1 in - { e; ty } - | _ -> raise (Failure "Expected an arrow type") + if ty0 <> arg.ty then raise_or_return "App: wrong input type" + else + let e = App (app, arg) in + let ty = ty1 in + { e; ty } + | _ -> raise_or_return "Expected an arrow type" (** The reverse of {!destruct_apps} *) let mk_apps (app : texpression) (args : texpression list) : texpression = diff --git a/compiler/SymbolicAst.ml b/compiler/SymbolicAst.ml index 53f99b7f..54d207d9 100644 --- a/compiler/SymbolicAst.ml +++ b/compiler/SymbolicAst.ml @@ -42,7 +42,11 @@ type call = { evaluated). We need it to compute the translated values for shared borrows (we need to perform lookups). *) + sg : fun_sig option; + (** The uninstantiated function signature, if this is not a unop/binop *) + regions_hierarchy : region_var_groups; abstractions : AbstractionId.id list; + (** The region abstractions introduced upon calling the function *) generics : generic_args; args : typed_value list; args_places : mplace option list; (** Meta information *) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index e2787271..1ce6c698 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -67,6 +67,18 @@ type call_info = { Those inputs include the fuel and the state, if pertinent. *) + back_funs : texpression RegionGroupId.Map.t option; + (** If we do not split between the forward/backward functions: the + variables we introduced for the backward functions. + + Example: + {[ + let x, back = Vec.index_mut n v in + ^^^^ + here + ... + ]} + *) } [@@deriving show] @@ -118,6 +130,8 @@ type loop_info = { (** Body synthesis context *) type bs_ctx = { + (* TODO: there are a lot of duplications with the various decls ctx *) + decls_ctx : C.decls_ctx; type_ctx : type_ctx; fun_ctx : fun_ctx; global_ctx : global_ctx; @@ -757,17 +771,27 @@ let translate_fun_id_or_trait_method_ref (ctx : bs_ctx) TraitMethod (trait_ref, method_name, fun_decl_id) let bs_ctx_register_forward_call (call_id : V.FunCallId.id) (forward : S.call) - (args : texpression list) (ctx : bs_ctx) : bs_ctx = + (args : texpression list) + (back_funs : texpression RegionGroupId.Map.t option) (ctx : bs_ctx) : bs_ctx + = let calls = ctx.calls in assert (not (V.FunCallId.Map.mem call_id calls)); - let info = { forward; forward_inputs = args } in + let info = { forward; forward_inputs = args; back_funs } in let calls = V.FunCallId.Map.add call_id info calls in { ctx with calls } -(** [back_args]: the *additional* list of inputs received by the backward function *) -let bs_ctx_register_backward_call (abs : V.abs) (call_id : V.FunCallId.id) - (back_id : T.RegionGroupId.id) (back_args : texpression list) (ctx : bs_ctx) - : bs_ctx * fun_or_op_id = +(** [inherit_args]: the list of inputs inherited from the forward function and + the ancestors backward functions, if pertinent. + [back_args]: the *additional* list of inputs received by the backward function, + including the state. + + Returns the updated context and the expression corresponding to the function. + *) +let bs_ctx_register_backward_call (abs : V.abs) (effect_info : fun_effect_info) + (call_id : V.FunCallId.id) (back_id : T.RegionGroupId.id) + (inherited_args : texpression list) (back_args : texpression list) + (generics : generic_args) (output_ty : ty) (ctx : bs_ctx) : + bs_ctx * texpression = (* Insert the abstraction in the call informations *) let info = V.FunCallId.Map.find call_id ctx.calls in let calls = V.FunCallId.Map.add call_id info ctx.calls in @@ -777,16 +801,31 @@ let bs_ctx_register_backward_call (abs : V.abs) (call_id : V.FunCallId.id) let abstractions = V.AbstractionId.Map.add abs.abs_id (abs, back_args) abstractions in - (* Retrieve the fun_id *) - let fun_id = - match info.forward.call_id with - | S.Fun (fid, _) -> - let fid = translate_fun_id_or_trait_method_ref ctx fid in - Fun (FromLlbc (fid, None, Some back_id)) - | S.Unop _ | S.Binop _ -> raise (Failure "Unreachable") + (* Compute the expression corresponding to the function *) + let func = + if !Config.return_back_funs then + (* Lookup the variable introduced for the backward function *) + RegionGroupId.Map.find back_id (Option.get info.back_funs) + else + (* Retrieve the fun_id *) + let fun_id = + match info.forward.call_id with + | S.Fun (fid, _) -> + let fid = translate_fun_id_or_trait_method_ref ctx fid in + Fun (FromLlbc (fid, None, Some back_id)) + | S.Unop _ | S.Binop _ -> raise (Failure "Unreachable") + in + let args = List.append inherited_args back_args in + let input_tys = (List.map (fun (x : texpression) -> x.ty)) args in + let ret_ty = + if effect_info.can_fail then mk_result_ty output_ty else output_ty + in + let func_ty = mk_arrows input_tys ret_ty in + let func = { id = FunOrOp fun_id; generics } in + { e = Qualif func; ty = func_ty } in (* Update the context and return *) - ({ ctx with calls; abstractions }, fun_id) + ({ ctx with calls; abstractions }, func) (** List the ancestors of an abstraction *) let list_ancestor_abstractions_ids (ctx : bs_ctx) (abs : V.abs) @@ -878,15 +917,12 @@ let get_fun_effect_info (fun_infos : fun_info A.FunDeclId.Map.t) We use [bid] ("backward function id") only if we split the forward and the backward functions. *) -let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) - (fun_id : A.fun_id) (sg : A.fun_sig) (input_names : string option list) : - decomposed_fun_sig = +let translate_fun_sig_with_regions_hierarchy_to_decomposed + (decls_ctx : C.decls_ctx) (fun_id : A.fun_id_or_trait_method_ref) + (regions_hierarchy : T.region_var_groups) (sg : A.fun_sig) + (input_names : string option list) : decomposed_fun_sig = let fun_infos = decls_ctx.fun_ctx.fun_infos in let type_infos = decls_ctx.type_ctx.type_infos in - (* Retrieve the list of parent backward functions *) - let regions_hierarchy = - FunIdMap.find fun_id decls_ctx.fun_ctx.regions_hierarchies - in (* We need an evaluation context to normalize the types (to normalize the associated types, etc. - for instance it may happen that the types refer to the types associated to a trait ref, but where the trait ref @@ -915,9 +951,7 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) in (* Is the forward function stateful, and can it fail? *) - let fwd_effect_info = - get_fun_effect_info fun_infos (FunId fun_id) None None - in + let fwd_effect_info = get_fun_effect_info fun_infos fun_id None None in (* Compute the forward inputs *) let fwd_fuel = mk_fuel_input_ty_as_list fwd_effect_info in let fwd_inputs_no_fuel_no_state = @@ -1030,7 +1064,7 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) RegionGroupId.id * back_sg_info = let gid = rg.id in let back_effect_info = - get_fun_effect_info fun_infos (FunId fun_id) None (Some gid) + get_fun_effect_info fun_infos fun_id None (Some gid) in let inputs_no_state = translate_back_inputs_for_gid gid in let inputs_no_state = @@ -1072,6 +1106,16 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) fwd_info; } +let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) + (fun_id : FunDeclId.id) (sg : A.fun_sig) (input_names : string option list) + : decomposed_fun_sig = + (* Retrieve the list of parent backward functions *) + let regions_hierarchy = + FunIdMap.find (FRegular fun_id) decls_ctx.fun_ctx.regions_hierarchies + in + translate_fun_sig_with_regions_hierarchy_to_decomposed decls_ctx + (FunId (FRegular fun_id)) regions_hierarchy sg input_names + let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty = let output = @@ -1090,6 +1134,40 @@ let compute_back_tys (dsg : Pure.decomposed_fun_sig) : ty list = mk_arrows inputs output) (RegionGroupId.Map.values dsg.back_sg) +(** Return the pure signature of a backward function, in the case the + forward/backward functions are merged (i.e., the forward functions + return the backward functions). + + TODO: merge with {!translate_fun_sig_from_decomposed} + *) +let translate_ret_back_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) + (gid : RegionGroupId.id) : fun_sig = + assert !Config.return_back_funs; + + let generics = dsg.generics in + let llbc_generics = dsg.llbc_generics in + let preds = dsg.preds in + (* Compute the effects info *) + let fwd_info = dsg.fwd_info in + let back_effect_info = + RegionGroupId.Map.of_list + (List.map + (fun ((gid, info) : RegionGroupId.id * back_sg_info) -> + (gid, info.effect_info)) + (RegionGroupId.Map.bindings dsg.back_sg)) + in + (* Two cases depending on whether we split the forward/backward functions + or not *) + let mk_output_ty = mk_output_ty_from_effect_info in + + let back_sg = RegionGroupId.Map.find gid dsg.back_sg in + let effect_info = back_sg.effect_info in + (* Do not prepend the forward inputs *) + let inputs = List.map snd back_sg.inputs in + let output = mk_simpl_tuple_ty back_sg.outputs in + let output = mk_output_ty effect_info output in + { generics; llbc_generics; preds; inputs; output; fwd_info; back_effect_info } + let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) (gid : RegionGroupId.id option) : fun_sig = let generics = dsg.generics in @@ -1774,7 +1852,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in (* Retrieve the function id, and register the function call in the context * if necessary. *) - let ctx, fun_id, effect_info, args, out_state = + let ctx, fun_id, effect_info, args, back_funs, out_state = match call.call_id with | S.Fun (fid, call_id) -> (* Regular function call *) @@ -1798,9 +1876,80 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (List.concat [ fuel; args; [ state_var ] ], ctx, Some nstate_var) else (List.concat [ fuel; args ], ctx, None) in + (* If we do not split the forward/backward functions: generate the + variables for the backward functions returned by the forward + function. *) + let ctx, back_funs_map, back_funs = + if !Config.return_back_funs then + (* We need to compute the signatures of the backward functions. *) + let sg = Option.get call.sg in + let decls_ctx = ctx.decls_ctx in + let dsg = + translate_fun_sig_with_regions_hierarchy_to_decomposed decls_ctx + fid call.regions_hierarchy sg + (List.map (fun _ -> None) sg.inputs) + in + let gids = + List.map + (fun (g : T.region_var_group) -> g.id) + call.regions_hierarchy + in + let back_sgs = + List.map (translate_ret_back_fun_sig_from_decomposed dsg) gids + in + (* Introduce variables for the backward functions *) + let back_tys = + List.map + (fun (sg : fun_sig) -> mk_arrows sg.inputs sg.output) + back_sgs + in + (* Compute a proper basename for the variables *) + let back_fun_name = + let name = + match fid with + | FunId (FAssumed fid) -> ( + match fid with + | BoxNew -> "box_new" + | BoxFree -> "box_free" + | ArrayRepeat -> "array_repeat" + | ArrayIndexShared -> "index_shared" + | ArrayIndexMut -> "index_mut" + | ArrayToSliceShared -> "to_slice_shared" + | ArrayToSliceMut -> "to_slice_mut" + | SliceIndexShared -> "index_shared" + | SliceIndexMut -> "index_mut") + | FunId (FRegular fid) | TraitMethod (_, _, fid) -> ( + let decl = + FunDeclId.Map.find fid ctx.fun_ctx.llbc_fun_decls + in + match Collections.List.last decl.name with + | PeIdent (s, _) -> s + | PeImpl _ -> + (* We shouldn't get there *) + raise (Failure "Unexpected")) + in + name ^ "_back" + in + let ctx, back_vars = + fresh_vars + (List.map (fun ty -> (Some back_fun_name, ty)) back_tys) + ctx + in + let back_funs = + List.map (fun v -> mk_typed_pattern_from_var v None) back_vars + in + let back_funs_map = + RegionGroupId.Map.of_list + (List.combine gids (List.map mk_texpression_from_var back_vars)) + in + (ctx, Some back_funs_map, back_funs) + else (ctx, None, []) + in (* Register the function call *) - let ctx = bs_ctx_register_forward_call call_id call args ctx in - (ctx, func, effect_info, args, out_state) + let ctx = + bs_ctx_register_forward_call call_id call args back_funs_map ctx + in + (ctx, func, effect_info, args, back_funs, out_state) | S.Unop E.Not -> let effect_info = { @@ -1811,7 +1960,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : is_rec = false; } in - (ctx, Unop Not, effect_info, args, None) + (ctx, Unop Not, effect_info, args, [], None) | S.Unop E.Neg -> ( match args with | [ arg ] -> @@ -1827,7 +1976,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : is_rec = false; } in - (ctx, Unop (Neg int_ty), effect_info, args, None) + (ctx, Unop (Neg int_ty), effect_info, args, [], None) | _ -> raise (Failure "Unreachable")) | S.Unop (E.Cast cast_kind) -> ( match cast_kind with @@ -1842,7 +1991,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : is_rec = false; } in - (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, None) + (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, [], None) | CastFnPtr _ -> raise (Failure "TODO: function casts")) | S.Binop binop -> ( match args with @@ -1862,11 +2011,12 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : is_rec = false; } in - (ctx, Binop (binop, int_ty0), effect_info, args, None) + (ctx, Binop (binop, int_ty0), effect_info, args, [], None) | _ -> raise (Failure "Unreachable")) in let dest_v = let dest = mk_typed_pattern_from_var dest dest_mplace in + let dest = mk_simpl_tuple_pattern (dest :: back_funs) in match out_state with | None -> dest | Some out_state -> mk_simpl_tuple_pattern [ out_state; dest ] @@ -2026,9 +2176,11 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) else ([], ctx, None) in (* Concatenate all the inpus *) - let inputs = - List.concat [ fwd_inputs; back_ancestors_inputs; back_inputs; back_state ] + let inherited_inputs = + if !Config.return_back_funs then [] + else List.concat [ fwd_inputs; back_ancestors_inputs ] in + let back_inputs = List.append back_inputs back_state in (* Retrieve the values given back by this function: those are the output * values. We rely on the fact that there are no nested borrows to use the * meta-place information from the input values given to the forward function @@ -2046,43 +2198,43 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) | Some nstate -> mk_simpl_tuple_pattern [ nstate; output ] in (* Retrieve the function id, and register the function call in the context - * if necessary *) + if necessary.Arith_status *) let ctx, func = - bs_ctx_register_backward_call abs call_id rg_id back_inputs ctx + bs_ctx_register_backward_call abs effect_info call_id rg_id inherited_inputs + back_inputs generics output.ty ctx in (* Translate the next expression *) let next_e = translate_expression e ctx in (* Put everything together *) + let inputs = List.append inherited_inputs back_inputs in let args_mplaces = List.map (fun _ -> None) inputs in let args = List.map (fun (arg, mp) -> mk_opt_mplace_texpression mp arg) (List.combine inputs args_mplaces) in - let input_tys = (List.map (fun (x : texpression) -> x.ty)) args in - let ret_ty = - if effect_info.can_fail then mk_result_ty output.ty else output.ty - in - let func_ty = mk_arrows input_tys ret_ty in - let func = { id = FunOrOp func; generics } in - let func = { e = Qualif func; ty = func_ty } in let call = mk_apps func args in (* **Optimization**: - * ================= - * We do a small optimization here: if the backward function doesn't - * have any output, we don't introduce any function call. - * See the comment in {!Config.filter_useless_monadic_calls}. - * - * TODO: use an option to disallow backward functions from updating the state. - * TODO: a backward function which only gives back shared borrows shouldn't - * update the state (state updates should only be used for mutable borrows, - * with objects like Rc for instance). - *) - if !Config.filter_useless_monadic_calls && outputs = [] && nstate = None then ( + ================= + We do a small optimization here if we split the forward/backward functions. + If the backward function doesn't have any output, we don't introduce any function + call. + See the comment in {!Config.filter_useless_monadic_calls}. + + TODO: use an option to disallow backward functions from updating the state. + TODO: a backward function which only gives back shared borrows shouldn't + update the state (state updates should only be used for mutable borrows, + with objects like Rc for instance). + *) + if + (not !Config.return_back_funs) + && !Config.filter_useless_monadic_calls + && outputs = [] && nstate = None + then ( (* No outputs - we do a small sanity check: the backward function - * should have exactly the same number of inputs as the forward: - * this number can be different only if the forward function returned - * a value containing mutable borrows, which can't be the case... *) + should have exactly the same number of inputs as the forward: + this number can be different only if the forward function returned + a value containing mutable borrows, which can't be the case... *) assert (List.length inputs = List.length fwd_inputs); next_e) else mk_let effect_info.can_fail output call next_e diff --git a/compiler/SynthesizeSymbolic.ml b/compiler/SynthesizeSymbolic.ml index efcf001a..4ec7524b 100644 --- a/compiler/SynthesizeSymbolic.ml +++ b/compiler/SynthesizeSymbolic.ml @@ -2,6 +2,7 @@ open Types open TypesUtils open Expressions open Values +open LlbcAst open SymbolicAst let mk_mplace (p : place) (ctx : Contexts.eval_ctx) : mplace = @@ -92,6 +93,7 @@ let synthesize_symbolic_expansion_no_branching (sv : symbolic_value) synthesize_symbolic_expansion sv place [ Some see ] el let synthesize_function_call (call_id : call_id) (ctx : Contexts.eval_ctx) + (sg : fun_sig option) (regions_hierarchy : region_var_groups) (abstractions : AbstractionId.id list) (generics : generic_args) (args : typed_value list) (args_places : mplace option list) (dest : symbolic_value) (dest_place : mplace option) (e : expression option) @@ -102,6 +104,8 @@ let synthesize_function_call (call_id : call_id) (ctx : Contexts.eval_ctx) { call_id; ctx; + sg; + regions_hierarchy; abstractions; generics; args; @@ -118,28 +122,30 @@ let synthesize_global_eval (gid : GlobalDeclId.id) (dest : symbolic_value) Option.map (fun e -> EvalGlobal (gid, dest, e)) e let synthesize_regular_function_call (fun_id : fun_id_or_trait_method_ref) - (call_id : FunCallId.id) (ctx : Contexts.eval_ctx) + (call_id : FunCallId.id) (ctx : Contexts.eval_ctx) (sg : fun_sig) + (regions_hierarchy : region_var_groups) (abstractions : AbstractionId.id list) (generics : generic_args) (args : typed_value list) (args_places : mplace option list) (dest : symbolic_value) (dest_place : mplace option) (e : expression option) : expression option = synthesize_function_call (Fun (fun_id, call_id)) - ctx abstractions generics args args_places dest dest_place e + ctx (Some sg) regions_hierarchy abstractions generics args args_places dest + dest_place e let synthesize_unary_op (ctx : Contexts.eval_ctx) (unop : unop) (arg : typed_value) (arg_place : mplace option) (dest : symbolic_value) (dest_place : mplace option) (e : expression option) : expression option = let generics = empty_generic_args in - synthesize_function_call (Unop unop) ctx [] generics [ arg ] [ arg_place ] - dest dest_place e + synthesize_function_call (Unop unop) ctx None [] [] generics [ arg ] + [ arg_place ] dest dest_place e let synthesize_binary_op (ctx : Contexts.eval_ctx) (binop : binop) (arg0 : typed_value) (arg0_place : mplace option) (arg1 : typed_value) (arg1_place : mplace option) (dest : symbolic_value) (dest_place : mplace option) (e : expression option) : expression option = let generics = empty_generic_args in - synthesize_function_call (Binop binop) ctx [] generics [ arg0; arg1 ] + synthesize_function_call (Binop binop) ctx None [] [] generics [ arg0; arg1 ] [ arg0_place; arg1_place ] dest dest_place e let synthesize_end_abstraction (ctx : Contexts.eval_ctx) (abs : abs) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 631a5af9..5584fb9a 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -129,7 +129,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx) in let sg = - SymbolicToPure.translate_fun_sig_to_decomposed trans_ctx (FRegular def_id) + SymbolicToPure.translate_fun_sig_to_decomposed trans_ctx def_id fdef.signature input_names in @@ -151,6 +151,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx) let ctx = { + decls_ctx = trans_ctx; SymbolicToPure.bid = None; sg; (* Will need to be updated for the backward functions *) -- cgit v1.2.3 From a630b8a703d8761746f7258b6db54080aa974f53 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 14:49:37 +0100 Subject: Fix a minor issue --- compiler/SymbolicToPure.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 1ce6c698..3d955061 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1123,12 +1123,15 @@ let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty in if effect_info.can_fail then mk_result_ty output else output -(** Compute the arrow types for all the backward functions *) +(** Compute the arrow types for all the backward functions. + + TODO: merge with below? + *) let compute_back_tys (dsg : Pure.decomposed_fun_sig) : ty list = List.map (fun (back_sg : back_sg_info) -> let effect_info = back_sg.effect_info in - let inputs = dsg.fwd_inputs @ List.map snd back_sg.inputs in + let inputs = List.map snd back_sg.inputs in let output = mk_simpl_tuple_ty back_sg.outputs in let output = mk_output_ty_from_effect_info effect_info output in mk_arrows inputs output) -- cgit v1.2.3 From 435fe4cf63869448e2b25486b564ede9efa9a34b Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 15:17:28 +0100 Subject: Fix some issues in SymbolicToPure --- compiler/SymbolicToPure.ml | 51 +++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 3d955061..ef0a0bde 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1137,39 +1137,30 @@ let compute_back_tys (dsg : Pure.decomposed_fun_sig) : ty list = mk_arrows inputs output) (RegionGroupId.Map.values dsg.back_sg) -(** Return the pure signature of a backward function, in the case the - forward/backward functions are merged (i.e., the forward functions +(** Return the instantiated pure signature of a backward function, in the + case the forward/backward functions are merged (i.e., the forward functions return the backward functions). - - TODO: merge with {!translate_fun_sig_from_decomposed} *) -let translate_ret_back_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) - (gid : RegionGroupId.id) : fun_sig = +let translate_ret_back_inst_fun_sig_from_decomposed + (dsg : Pure.decomposed_fun_sig) (generics : generic_args) + (gid : RegionGroupId.id) : inst_fun_sig = assert !Config.return_back_funs; - - let generics = dsg.generics in - let llbc_generics = dsg.llbc_generics in - let preds = dsg.preds in - (* Compute the effects info *) - let fwd_info = dsg.fwd_info in - let back_effect_info = - RegionGroupId.Map.of_list - (List.map - (fun ((gid, info) : RegionGroupId.id * back_sg_info) -> - (gid, info.effect_info)) - (RegionGroupId.Map.bindings dsg.back_sg)) - in - (* Two cases depending on whether we split the forward/backward functions - or not *) let mk_output_ty = mk_output_ty_from_effect_info in - + (* Lookup the signature information *) let back_sg = RegionGroupId.Map.find gid dsg.back_sg in let effect_info = back_sg.effect_info in (* Do not prepend the forward inputs *) let inputs = List.map snd back_sg.inputs in let output = mk_simpl_tuple_ty back_sg.outputs in let output = mk_output_ty effect_info output in - { generics; llbc_generics; preds; inputs; output; fwd_info; back_effect_info } + (* Substitute the types *) + let tr_self = UnknownTrait __FUNCTION__ in + let subst = make_subst_from_generics dsg.generics generics tr_self in + let subst = ty_substitute subst in + let inputs = List.map subst inputs in + let output = subst output in + (* Return *) + { inputs; output } let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) (gid : RegionGroupId.id option) : fun_sig = @@ -1898,12 +1889,14 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : call.regions_hierarchy in let back_sgs = - List.map (translate_ret_back_fun_sig_from_decomposed dsg) gids + List.map + (translate_ret_back_inst_fun_sig_from_decomposed dsg generics) + gids in (* Introduce variables for the backward functions *) let back_tys = List.map - (fun (sg : fun_sig) -> mk_arrows sg.inputs sg.output) + (fun (sg : inst_fun_sig) -> mk_arrows sg.inputs sg.output) back_sgs in (* Compute a proper basename for the variables *) @@ -2216,6 +2209,14 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) (fun (arg, mp) -> mk_opt_mplace_texpression mp arg) (List.combine inputs args_mplaces) in + log#ldebug + (lazy + (let args = List.map (texpression_to_string ctx) args in + "func: " + ^ texpression_to_string ctx func + ^ "\nfunc type: " + ^ pure_ty_to_string ctx func.ty + ^ "\n\nargs:\n" ^ String.concat "\n" args)); let call = mk_apps func args in (* **Optimization**: ================= -- cgit v1.2.3 From d9f91cfcd538525f024c6019d7c8250dda8d76fd Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 15:25:06 +0100 Subject: Remove some asserts which are now useless --- compiler/Extract.ml | 4 ---- compiler/PureMicroPasses.ml | 3 --- compiler/PureUtils.ml | 5 ++++- 3 files changed, 4 insertions(+), 8 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 46cf8c4a..8d35f039 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -1475,8 +1475,6 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) *) let inputs_lvs = let all_inputs = (Option.get def.body).inputs_lvs in - (* TODO: *) - assert (not !Config.return_back_funs); let num_fwd_inputs = def.signature.fwd_info.fwd_info.num_inputs_with_fuel_with_state in @@ -1523,8 +1521,6 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) if has_decreases_clause && !backend = Lean then ( let def_body = Option.get def.body in let all_vars = List.map (fun (v : var) -> v.id) def_body.inputs in - (* TODO: *) - assert (not !Config.return_back_funs); let num_fwd_inputs = def.signature.fwd_info.fwd_info.num_inputs_with_fuel_with_state in diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 34597d32..63436e7d 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -1337,9 +1337,6 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : let fwd_info = fun_sig.fwd_info in let fwd_effect_info = fwd_info.effect_info in - (* TODO: *) - assert (not !Config.return_back_funs); - (* Generate the loop definition *) let loop_fwd_effect_info = fwd_effect_info in diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 6579e84c..d4aaba16 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -332,7 +332,10 @@ let mk_app (app : texpression) (arg : texpression) : texpression = match app.ty with | TArrow (ty0, ty1) -> (* Sanity check *) - if ty0 <> arg.ty then raise_or_return "App: wrong input type" + if + (* TODO: we need to normalize the types *) + !Config.type_check_pure_code && ty0 <> arg.ty + then raise_or_return "App: wrong input type" else let e = App (app, arg) in let ty = ty1 in -- cgit v1.2.3 From cf3eea59ee61f2341daf7248664b8be878f128af Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 16:35:27 +0100 Subject: Update SymbolicToPure.ml for the loops --- compiler/SymbolicToPure.ml | 221 +++++++++++++++++++++++++-------------------- 1 file changed, 125 insertions(+), 96 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index ef0a0bde..d3b0933c 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -125,6 +125,11 @@ type loop_info = { (** The map from region group ids to the types of the values given back by the corresponding loop abstractions. *) + back_funs : texpression RegionGroupId.Map.t option; + (** Same as {!call_info.back_funs}. + Initialized with [None], gets updated to [Some] only if we merge + the fwd/back functions. + *) } [@@deriving show] @@ -1123,45 +1128,25 @@ let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty in if effect_info.can_fail then mk_result_ty output else output -(** Compute the arrow types for all the backward functions. - - TODO: merge with below? - *) -let compute_back_tys (dsg : Pure.decomposed_fun_sig) : ty list = +(** Compute the arrow types for all the backward functions. *) +let compute_back_tys (dsg : Pure.decomposed_fun_sig) + (subst : (generic_args * trait_instance_id) option) : ty list = List.map (fun (back_sg : back_sg_info) -> let effect_info = back_sg.effect_info in + (* Compute *) let inputs = List.map snd back_sg.inputs in let output = mk_simpl_tuple_ty back_sg.outputs in let output = mk_output_ty_from_effect_info effect_info output in - mk_arrows inputs output) + let ty = mk_arrows inputs output in + (* Substitute - TODO: normalize *) + match subst with + | None -> ty + | Some (generics, tr_self) -> + let subst = make_subst_from_generics dsg.generics generics tr_self in + ty_substitute subst ty) (RegionGroupId.Map.values dsg.back_sg) -(** Return the instantiated pure signature of a backward function, in the - case the forward/backward functions are merged (i.e., the forward functions - return the backward functions). - *) -let translate_ret_back_inst_fun_sig_from_decomposed - (dsg : Pure.decomposed_fun_sig) (generics : generic_args) - (gid : RegionGroupId.id) : inst_fun_sig = - assert !Config.return_back_funs; - let mk_output_ty = mk_output_ty_from_effect_info in - (* Lookup the signature information *) - let back_sg = RegionGroupId.Map.find gid dsg.back_sg in - let effect_info = back_sg.effect_info in - (* Do not prepend the forward inputs *) - let inputs = List.map snd back_sg.inputs in - let output = mk_simpl_tuple_ty back_sg.outputs in - let output = mk_output_ty effect_info output in - (* Substitute the types *) - let tr_self = UnknownTrait __FUNCTION__ in - let subst = make_subst_from_generics dsg.generics generics tr_self in - let subst = ty_substitute subst in - let inputs = List.map subst inputs in - let output = subst output in - (* Return *) - { inputs; output } - let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) (gid : RegionGroupId.id option) : fun_sig = let generics = dsg.generics in @@ -1184,7 +1169,7 @@ let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) if !Config.return_back_funs then ( assert (gid = None); (* Compute the arrow types for all the backward functions *) - let back_tys = compute_back_tys dsg in + let back_tys = compute_back_tys dsg None in (* Group the forward output and the types of the backward functions *) let effect_info = dsg.fwd_info.effect_info in let output = mk_simpl_tuple_ty (dsg.fwd_output :: back_tys) in @@ -1274,6 +1259,40 @@ let fresh_vars (vars : (string option * ty) list) (ctx : bs_ctx) : bs_ctx * var list = List.fold_left_map (fun ctx (name, ty) -> fresh_var name ty ctx) ctx vars +(* Introduce variables for the backward functions *) +let fresh_back_vars_for_current_fun (ctx : bs_ctx) : bs_ctx * var list = + (* We lookup the LLBC definition in an attempt to derive pretty names + for the backward functions. *) + let back_var_names = + let def_id = ctx.fun_decl.def_id in + let sg = ctx.fun_decl.signature in + let regions_hierarchy = + LlbcAstUtils.FunIdMap.find (FRegular def_id) + ctx.fun_ctx.regions_hierarchies + in + List.map + (fun (gid, _) -> + let rg = RegionGroupId.nth regions_hierarchy gid in + let region_names = + List.map + (fun rid -> (T.RegionVarId.nth sg.generics.regions rid).name) + rg.regions + in + let name = + match region_names with + | [] -> "back" + | [ Some r ] -> "back" ^ r + | _ -> + (* Concatenate all the region names *) + "back" + ^ String.concat "" (List.filter_map (fun x -> x) region_names) + in + Some name) + (RegionGroupId.Map.bindings ctx.sg.back_sg) + in + let back_vars = List.combine back_var_names (compute_back_tys ctx.sg None) in + fresh_vars back_vars ctx + let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : var = match V.SymbolicValueId.Map.find_opt sv.sv_id ctx.sv_to_var with | Some v -> v @@ -1728,7 +1747,7 @@ and translate_panic (ctx : bs_ctx) : texpression = match ctx.bid with | None -> if !Config.return_back_funs then - let back_tys = compute_back_tys ctx.sg in + let back_tys = compute_back_tys ctx.sg None in let output = mk_simpl_tuple_ty (ctx.sg.fwd_output :: back_tys) in mk_output output else mk_output ctx.sg.fwd_output @@ -1883,22 +1902,9 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : fid call.regions_hierarchy sg (List.map (fun _ -> None) sg.inputs) in - let gids = - List.map - (fun (g : T.region_var_group) -> g.id) - call.regions_hierarchy - in - let back_sgs = - List.map - (translate_ret_back_inst_fun_sig_from_decomposed dsg generics) - gids - in + let tr_self = UnknownTrait __FUNCTION__ in + let back_tys = compute_back_tys dsg (Some (generics, tr_self)) in (* Introduce variables for the backward functions *) - let back_tys = - List.map - (fun (sg : inst_fun_sig) -> mk_arrows sg.inputs sg.output) - back_sgs - in (* Compute a proper basename for the variables *) let back_fun_name = let name = @@ -1934,6 +1940,11 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let back_funs = List.map (fun v -> mk_typed_pattern_from_var v None) back_vars in + let gids = + List.map + (fun (g : T.region_var_group) -> g.id) + call.regions_hierarchy + in let back_funs_map = RegionGroupId.Map.of_list (List.combine gids (List.map mk_texpression_from_var back_vars)) @@ -2338,6 +2349,8 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) (* Actually the same case as [SynthInput] *) translate_end_abstraction_synth_input ectx abs e ctx rg_id | V.LoopCall -> + (* We need to introduce a call to the backward function corresponding + to a forward call which happened earlier *) let fun_id = E.FRegular ctx.fun_decl.def_id in let effect_info = get_fun_effect_info ctx.fun_ctx.fun_infos (FunId fun_id) (Some vloop_id) @@ -2367,7 +2380,10 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) else ([], ctx, None) in (* Concatenate all the inputs *) - let inputs = List.concat [ fwd_inputs; back_inputs; back_state ] in + let inputs = + if !Config.return_back_funs then List.concat [ back_inputs; back_state ] + else List.concat [ fwd_inputs; back_inputs; back_state ] + in (* Retrieve the values given back by this function *) let ctx, outputs = abs_to_given_back None abs ctx in (* Group the output values together: first the updated inputs *) @@ -2391,28 +2407,43 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) let ret_ty = if effect_info.can_fail then mk_result_ty output.ty else output.ty in - let func_ty = mk_arrows input_tys ret_ty in - let func = Fun (FromLlbc (FunId fun_id, Some loop_id, Some rg_id)) in - let func = { id = FunOrOp func; generics } in - let func = { e = Qualif func; ty = func_ty } in + (* Create the expression for the function: + - it is either a call to a top-level function, if we split the + forward/backward functions + - or a call to the variable we introduced for the backward function, + if we merge the forward/backward functions *) + let func = + if !Config.return_back_funs then + RegionGroupId.Map.find rg_id (Option.get loop_info.back_funs) + else + let func_ty = mk_arrows input_tys ret_ty in + let func = Fun (FromLlbc (FunId fun_id, Some loop_id, Some rg_id)) in + let func = { id = FunOrOp func; generics } in + { e = Qualif func; ty = func_ty } + in let call = mk_apps func args in (* **Optimization**: - * ================= - * We do a small optimization here: if the backward function doesn't - * have any output, we don't introduce any function call. - * See the comment in {!Config.filter_useless_monadic_calls}. - * - * TODO: use an option to disallow backward functions from updating the state. - * TODO: a backward function which only gives back shared borrows shouldn't - * update the state (state updates should only be used for mutable borrows, - * with objects like Rc for instance). - *) - if !Config.filter_useless_monadic_calls && outputs = [] && nstate = None + ================= + We do a small optimization here in case we split the forward/backward + functions. + If the backward function doesn't have any output, we don't introduce + any function call. + See the comment in {!Config.filter_useless_monadic_calls}. + + TODO: use an option to disallow backward functions from updating the state. + TODO: a backward function which only gives back shared borrows shouldn't + update the state (state updates should only be used for mutable borrows, + with objects like Rc for instance). + *) + if + (not !Config.return_back_funs) + && !Config.filter_useless_monadic_calls + && outputs = [] && nstate = None then ( (* No outputs - we do a small sanity check: the backward function - * should have exactly the same number of inputs as the forward: - * this number can be different only if the forward function returned - * a value containing mutable borrows, which can't be the case... *) + should have exactly the same number of inputs as the forward: + this number can be different only if the forward function returned + a value containing mutable borrows, which can't be the case... *) assert (List.length inputs = List.length fwd_inputs); next_e) else @@ -2860,35 +2891,7 @@ and translate_forward_end (ectx : C.eval_ctx) (* Introduce variables for the backward functions. We lookup the LLBC definition in an attempt to derive pretty names for those functions. *) - let back_var_names = - let def_id = ctx.fun_decl.def_id in - let sg = ctx.fun_decl.signature in - let regions_hierarchy = - LlbcAstUtils.FunIdMap.find (FRegular def_id) - ctx.fun_ctx.regions_hierarchies - in - List.map - (fun (gid, _) -> - let rg = RegionGroupId.nth regions_hierarchy gid in - let region_names = - List.map - (fun rid -> (T.RegionVarId.nth sg.generics.regions rid).name) - rg.regions - in - let name = - match region_names with - | [] -> "back" - | [ Some r ] -> "back" ^ r - | _ -> - (* Concatenate all the region names *) - "back" - ^ String.concat "" (List.filter_map (fun x -> x) region_names) - in - Some name) - (RegionGroupId.Map.bindings ctx.sg.back_sg) - in - let back_vars = List.combine back_var_names (compute_back_tys ctx.sg) in - let _, back_vars = fresh_vars back_vars ctx in + let _, back_vars = fresh_back_vars_for_current_fun ctx in (* Create the return expressions *) let vars = fwd_var :: back_vars in @@ -2964,8 +2967,32 @@ and translate_forward_end (ectx : C.eval_ctx) (* Introduce a fresh output value for the forward function *) let ctx, output_var = fresh_var None ctx.sg.fwd_output ctx in + (* Introduce fresh variables for the backward functions of the loop. + + For now, the backward functions of the loop are the same as the + backward functions of the outer function. + *) + let ctx, back_funs_map, back_funs = + if !Config.return_back_funs then + let ctx, back_vars = fresh_back_vars_for_current_fun ctx in + let back_funs = + List.map (fun v -> mk_typed_pattern_from_var v None) back_vars + in + let gids = RegionGroupId.Map.keys ctx.sg.back_sg in + let back_funs_map = + RegionGroupId.Map.of_list + (List.combine gids (List.map mk_texpression_from_var back_vars)) + in + (ctx, Some back_funs_map, back_funs) + else (ctx, None, []) + in + + (* Introduce patterns *) let args, ctx, out_pats = + (* Create the pattern for the output value *) let output_pat = mk_typed_pattern_from_var output_var None in + (* Add the returned backward functions (they might be empty) *) + let output_pat = mk_simpl_tuple_pattern (output_pat :: back_funs) in (* Depending on the function effects: * - add the fuel @@ -2988,6 +3015,7 @@ and translate_forward_end (ectx : C.eval_ctx) loop_info with forward_inputs = Some args; forward_output_no_state_no_result = Some output_var; + back_funs = back_funs_map; } in let ctx = @@ -3143,6 +3171,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = forward_inputs = None; forward_output_no_state_no_result = None; back_outputs = rg_to_given_back_tys; + back_funs = None; } in let loops = LoopId.Map.add loop_id loop_info ctx.loops in -- cgit v1.2.3 From d4b3d0e6adae5bb9a2f62872dbcedc29aaa9fa30 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 17:00:52 +0100 Subject: Filter the useless backward functions --- compiler/SymbolicToPure.ml | 220 +++++++++++++++++++++++++++++---------------- 1 file changed, 145 insertions(+), 75 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index d3b0933c..f37ea201 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -67,7 +67,7 @@ type call_info = { Those inputs include the fuel and the state, if pertinent. *) - back_funs : texpression RegionGroupId.Map.t option; + back_funs : texpression option RegionGroupId.Map.t option; (** If we do not split between the forward/backward functions: the variables we introduced for the backward functions. @@ -78,6 +78,10 @@ type call_info = { here ... ]} + + The expression might be [None] in case the backward function + has to be filtered (because it does nothing - the backward + functions for shared borrows for instance). *) } [@@deriving show] @@ -125,7 +129,7 @@ type loop_info = { (** The map from region group ids to the types of the values given back by the corresponding loop abstractions. *) - back_funs : texpression RegionGroupId.Map.t option; + back_funs : texpression option RegionGroupId.Map.t option; (** Same as {!call_info.back_funs}. Initialized with [None], gets updated to [Some] only if we merge the fwd/back functions. @@ -777,8 +781,8 @@ let translate_fun_id_or_trait_method_ref (ctx : bs_ctx) let bs_ctx_register_forward_call (call_id : V.FunCallId.id) (forward : S.call) (args : texpression list) - (back_funs : texpression RegionGroupId.Map.t option) (ctx : bs_ctx) : bs_ctx - = + (back_funs : texpression option RegionGroupId.Map.t option) (ctx : bs_ctx) : + bs_ctx = let calls = ctx.calls in assert (not (V.FunCallId.Map.mem call_id calls)); let info = { forward; forward_inputs = args; back_funs } in @@ -790,13 +794,15 @@ let bs_ctx_register_forward_call (call_id : V.FunCallId.id) (forward : S.call) [back_args]: the *additional* list of inputs received by the backward function, including the state. - Returns the updated context and the expression corresponding to the function. + Returns the updated context and the expression corresponding to the function + that we need to call. This function may be [None] if it has to be ignored + (because it does nothing). *) let bs_ctx_register_backward_call (abs : V.abs) (effect_info : fun_effect_info) (call_id : V.FunCallId.id) (back_id : T.RegionGroupId.id) (inherited_args : texpression list) (back_args : texpression list) (generics : generic_args) (output_ty : ty) (ctx : bs_ctx) : - bs_ctx * texpression = + bs_ctx * texpression option = (* Insert the abstraction in the call informations *) let info = V.FunCallId.Map.find call_id ctx.calls in let calls = V.FunCallId.Map.add call_id info ctx.calls in @@ -827,7 +833,7 @@ let bs_ctx_register_backward_call (abs : V.abs) (effect_info : fun_effect_info) in let func_ty = mk_arrows input_tys ret_ty in let func = { id = FunOrOp fun_id; generics } in - { e = Qualif func; ty = func_ty } + Some { e = Qualif func; ty = func_ty } in (* Update the context and return *) ({ ctx with calls; abstractions }, func) @@ -1128,23 +1134,36 @@ let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty in if effect_info.can_fail then mk_result_ty output else output -(** Compute the arrow types for all the backward functions. *) +(** Compute the arrow types for all the backward functions. + + If a backward function has no inputs/outputs we filter it. + *) let compute_back_tys (dsg : Pure.decomposed_fun_sig) - (subst : (generic_args * trait_instance_id) option) : ty list = + (subst : (generic_args * trait_instance_id) option) : ty option list = List.map (fun (back_sg : back_sg_info) -> let effect_info = back_sg.effect_info in - (* Compute *) + (* Compute the input/output types *) let inputs = List.map snd back_sg.inputs in - let output = mk_simpl_tuple_ty back_sg.outputs in - let output = mk_output_ty_from_effect_info effect_info output in - let ty = mk_arrows inputs output in - (* Substitute - TODO: normalize *) - match subst with - | None -> ty - | Some (generics, tr_self) -> - let subst = make_subst_from_generics dsg.generics generics tr_self in - ty_substitute subst ty) + let outputs = back_sg.outputs in + (* Filter if necessary *) + if !Config.simplify_merged_fwd_backs && inputs = [] && outputs = [] then + None + else + let output = mk_simpl_tuple_ty outputs in + let output = mk_output_ty_from_effect_info effect_info output in + let ty = mk_arrows inputs output in + (* Substitute - TODO: normalize *) + let ty = + match subst with + | None -> ty + | Some (generics, tr_self) -> + let subst = + make_subst_from_generics dsg.generics generics tr_self + in + ty_substitute subst ty + in + Some ty) (RegionGroupId.Map.values dsg.back_sg) let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) @@ -1169,7 +1188,7 @@ let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) if !Config.return_back_funs then ( assert (gid = None); (* Compute the arrow types for all the backward functions *) - let back_tys = compute_back_tys dsg None in + let back_tys = List.filter_map (fun x -> x) (compute_back_tys dsg None) in (* Group the forward output and the types of the backward functions *) let effect_info = dsg.fwd_info.effect_info in let output = mk_simpl_tuple_ty (dsg.fwd_output :: back_tys) in @@ -1259,8 +1278,19 @@ let fresh_vars (vars : (string option * ty) list) (ctx : bs_ctx) : bs_ctx * var list = List.fold_left_map (fun ctx (name, ty) -> fresh_var name ty ctx) ctx vars +let fresh_opt_vars (vars : (string option * ty) option list) (ctx : bs_ctx) : + bs_ctx * var option list = + List.fold_left_map + (fun ctx var -> + match var with + | None -> (ctx, None) + | Some (name, ty) -> + let ctx, var = fresh_var name ty ctx in + (ctx, Some var)) + ctx vars + (* Introduce variables for the backward functions *) -let fresh_back_vars_for_current_fun (ctx : bs_ctx) : bs_ctx * var list = +let fresh_back_vars_for_current_fun (ctx : bs_ctx) : bs_ctx * var option list = (* We lookup the LLBC definition in an attempt to derive pretty names for the backward functions. *) let back_var_names = @@ -1291,7 +1321,13 @@ let fresh_back_vars_for_current_fun (ctx : bs_ctx) : bs_ctx * var list = (RegionGroupId.Map.bindings ctx.sg.back_sg) in let back_vars = List.combine back_var_names (compute_back_tys ctx.sg None) in - fresh_vars back_vars ctx + let back_vars = + List.map + (fun (name, ty) -> + match ty with None -> None | Some ty -> Some (name, ty)) + back_vars + in + fresh_opt_vars back_vars ctx let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : var = match V.SymbolicValueId.Map.find_opt sv.sv_id ctx.sv_to_var with @@ -1748,6 +1784,7 @@ and translate_panic (ctx : bs_ctx) : texpression = | None -> if !Config.return_back_funs then let back_tys = compute_back_tys ctx.sg None in + let back_tys = List.filter_map (fun x -> x) back_tys in let output = mk_simpl_tuple_ty (ctx.sg.fwd_output :: back_tys) in mk_output output else mk_output ctx.sg.fwd_output @@ -1933,21 +1970,33 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : name ^ "_back" in let ctx, back_vars = - fresh_vars - (List.map (fun ty -> (Some back_fun_name, ty)) back_tys) + fresh_opt_vars + (List.map + (fun ty -> + match ty with + | None -> None + | Some ty -> Some (Some back_fun_name, ty)) + back_tys) ctx in let back_funs = - List.map (fun v -> mk_typed_pattern_from_var v None) back_vars + List.filter_map + (fun v -> + match v with + | None -> None + | Some v -> Some (mk_typed_pattern_from_var v None)) + back_vars in let gids = List.map (fun (g : T.region_var_group) -> g.id) call.regions_hierarchy in + let back_vars = + List.map (Option.map mk_texpression_from_var) back_vars + in let back_funs_map = - RegionGroupId.Map.of_list - (List.combine gids (List.map mk_texpression_from_var back_vars)) + RegionGroupId.Map.of_list (List.combine gids back_vars) in (ctx, Some back_funs_map, back_funs) else (ctx, None, []) @@ -2220,15 +2269,6 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) (fun (arg, mp) -> mk_opt_mplace_texpression mp arg) (List.combine inputs args_mplaces) in - log#ldebug - (lazy - (let args = List.map (texpression_to_string ctx) args in - "func: " - ^ texpression_to_string ctx func - ^ "\nfunc type: " - ^ pure_ty_to_string ctx func.ty - ^ "\n\nargs:\n" ^ String.concat "\n" args)); - let call = mk_apps func args in (* **Optimization**: ================= We do a small optimization here if we split the forward/backward functions. @@ -2252,7 +2292,22 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) a value containing mutable borrows, which can't be the case... *) assert (List.length inputs = List.length fwd_inputs); next_e) - else mk_let effect_info.can_fail output call next_e + else + (* The backward function might also have been filtered if we do not + split the forward/backward functions *) + match func with + | None -> next_e + | Some func -> + log#ldebug + (lazy + (let args = List.map (texpression_to_string ctx) args in + "func: " + ^ texpression_to_string ctx func + ^ "\nfunc type: " + ^ pure_ty_to_string ctx func.ty + ^ "\n\nargs:\n" ^ String.concat "\n" args)); + let call = mk_apps func args in + mk_let effect_info.can_fail output call next_e and translate_end_abstraction_identity (ectx : C.eval_ctx) (abs : V.abs) (e : S.expression) (ctx : bs_ctx) : texpression = @@ -2348,7 +2403,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) | V.LoopSynthInput -> (* Actually the same case as [SynthInput] *) translate_end_abstraction_synth_input ectx abs e ctx rg_id - | V.LoopCall -> + | V.LoopCall -> ( (* We need to introduce a call to the backward function corresponding to a forward call which happened earlier *) let fun_id = E.FRegular ctx.fun_decl.def_id in @@ -2419,9 +2474,8 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) let func_ty = mk_arrows input_tys ret_ty in let func = Fun (FromLlbc (FunId fun_id, Some loop_id, Some rg_id)) in let func = { id = FunOrOp func; generics } in - { e = Qualif func; ty = func_ty } + Some { e = Qualif func; ty = func_ty } in - let call = mk_apps func args in (* **Optimization**: ================= We do a small optimization here in case we split the forward/backward @@ -2447,38 +2501,44 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) assert (List.length inputs = List.length fwd_inputs); next_e) else - (* Add meta-information - this is slightly hacky: we look at the - values consumed by the abstraction (note that those come from - *before* we applied the fixed-point context) and use them to - guide the naming of the output vars. - - Also, we need to convert the backward outputs from patterns to - variables. - - Finally, in practice, this works well only for loop bodies: - we do this only in this case. - TODO: improve the heuristics, to give weight to the hints for - instance. - *) - let next_e = - if ctx.inside_loop then - let consumed_values = abs_to_consumed ctx ectx abs in - let var_values = List.combine outputs consumed_values in - let var_values = - List.filter_map - (fun (var, v) -> - match var.Pure.value with - | PatVar (var, _) -> Some (var, v) - | _ -> None) - var_values + (* In case we merge the fwd/back functions we filter the backward + functions elsewhere *) + match func with + | None -> next_e + | Some func -> + let call = mk_apps func args in + (* Add meta-information - this is slightly hacky: we look at the + values consumed by the abstraction (note that those come from + *before* we applied the fixed-point context) and use them to + guide the naming of the output vars. + + Also, we need to convert the backward outputs from patterns to + variables. + + Finally, in practice, this works well only for loop bodies: + we do this only in this case. + TODO: improve the heuristics, to give weight to the hints for + instance. + *) + let next_e = + if ctx.inside_loop then + let consumed_values = abs_to_consumed ctx ectx abs in + let var_values = List.combine outputs consumed_values in + let var_values = + List.filter_map + (fun (var, v) -> + match var.Pure.value with + | PatVar (var, _) -> Some (var, v) + | _ -> None) + var_values + in + let vars, values = List.split var_values in + mk_emeta_symbolic_assignments vars values next_e + else next_e in - let vars, values = List.split var_values in - mk_emeta_symbolic_assignments vars values next_e - else next_e - in - (* Create the let-binding *) - mk_let effect_info.can_fail output call next_e + (* Create the let-binding *) + mk_let effect_info.can_fail output call next_e) and translate_global_eval (gid : A.GlobalDeclId.id) (sval : V.symbolic_value) (e : S.expression) (ctx : bs_ctx) : texpression = @@ -2894,7 +2954,7 @@ and translate_forward_end (ectx : C.eval_ctx) let _, back_vars = fresh_back_vars_for_current_fun ctx in (* Create the return expressions *) - let vars = fwd_var :: back_vars in + let vars = fwd_var :: List.filter_map (fun x -> x) back_vars in let vars = List.map mk_texpression_from_var vars in let ret = mk_simpl_tuple_texpression vars in let state_var = List.map mk_texpression_from_var state_var in @@ -2903,12 +2963,16 @@ and translate_forward_end (ectx : C.eval_ctx) (* Bind the expressions for the backward function and the expression for the computation of the forward output *) + let back_vars_els = + List.filter_map + (fun (v, el) -> match v with None -> None | Some v -> Some (v, el)) + (List.combine back_vars back_el) + in let e = List.fold_right (fun (var, back_e) e -> mk_let false (mk_typed_pattern_from_var var None) back_e e) - (List.combine back_vars back_el) - ret + back_vars_els ret in (* Bind the expression for the forward output *) let fwd_var = mk_typed_pattern_from_var fwd_var None in @@ -2976,12 +3040,18 @@ and translate_forward_end (ectx : C.eval_ctx) if !Config.return_back_funs then let ctx, back_vars = fresh_back_vars_for_current_fun ctx in let back_funs = - List.map (fun v -> mk_typed_pattern_from_var v None) back_vars + List.filter_map + (fun v -> + match v with + | None -> None + | Some v -> Some (mk_typed_pattern_from_var v None)) + back_vars in let gids = RegionGroupId.Map.keys ctx.sg.back_sg in let back_funs_map = RegionGroupId.Map.of_list - (List.combine gids (List.map mk_texpression_from_var back_vars)) + (List.combine gids + (List.map (Option.map mk_texpression_from_var) back_vars)) in (ctx, Some back_funs_map, back_funs) else (ctx, None, []) -- cgit v1.2.3 From ccfcadc3686e69c1b8a8c826ec14f3c0e1dfbd7b Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 17:08:37 +0100 Subject: Update the formatting of comments --- compiler/Extract.ml | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 8d35f039..57360536 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -1323,18 +1323,16 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter) (Pure.FunId (FRegular def.def_id), def.loop_id, def.back_id) ctx.fun_name_info in - let comment_pre = "[" ^ name_to_string ctx def.llbc_name ^ "]: " in + let comment_pre = "[" ^ name_to_string ctx def.llbc_name ^ "]:" in let comment = let loop_comment = match def.loop_id with | None -> "" - | Some id -> "loop " ^ LoopId.to_string id ^ ": " + | Some id -> " loop " ^ LoopId.to_string id ^ ":" in let fwd_back_comment = match def.back_id with - | None -> - if !Config.return_back_funs then [ "function definition" ] - else [ "forward function" ] + | None -> if !Config.return_back_funs then [] else [ "forward function" ] | Some id -> (* Check if there is only one backward function, and no forward function *) if (not keep_fwd) && num_backs = 1 then @@ -1346,9 +1344,9 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter) else [ "backward function " ^ T.RegionGroupId.to_string id ] in match fwd_back_comment with - | [] -> raise (Failure "Unreachable") - | [ s ] -> [ comment_pre ^ loop_comment ^ s ] - | s :: sl -> (comment_pre ^ loop_comment ^ s) :: sl + | [] -> [ comment_pre ^ loop_comment ] + | [ s ] -> [ comment_pre ^ loop_comment ^ " " ^ s ] + | s :: sl -> (comment_pre ^ loop_comment ^ " " ^ s) :: sl in extract_comment_with_span fmt comment def.meta.span -- cgit v1.2.3 From 2f681446b11739e650b1d6050b717da872be9022 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 19:23:29 +0100 Subject: Simplify the type of the merged fwd/back functions --- compiler/Config.ml | 26 ++++++++ compiler/Pure.ml | 6 ++ compiler/PureMicroPasses.ml | 7 +- compiler/PureUtils.ml | 1 + compiler/SymbolicToPure.ml | 159 ++++++++++++++++++++++++++++++++------------ 5 files changed, 153 insertions(+), 46 deletions(-) diff --git a/compiler/Config.ml b/compiler/Config.ml index b8af6c6d..2bb1ca34 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -370,6 +370,32 @@ let filter_useless_monadic_calls = ref true *) let filter_useless_functions = ref true +(** Simplify the forward/backward functions, in case we merge them + (i.e., the forward functions return the backward functions). + + The simplification occurs as follows: + - if a forward function returns the unit type and has non-trivial backward + functions, then we remove the returned output. + - if a backward function doesn't have inputs, we evaluate it inside the + forward function and don't wrap it in a result. + + Example: + {[ + // LLBC: + fn incr(x: &mut u32) { *x += 1 } + + // Translation without simplification: + let incr (x : u32) : result (unit * result u32) = ... + ^^^^ ^^^^^^ + | remove this result + remove the unit + + // Translation with simplification: + let incr (x : u32) : result u32 = ... + ]} + *) +let simplify_merged_fwd_backs = ref true + (** Use short names for the record fields. Some backends can't disambiguate records when their field names have collisions. diff --git a/compiler/Pure.ml b/compiler/Pure.ml index ddacf0c4..05cdbd70 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -908,6 +908,11 @@ type fun_sig_info = { fwd_info : inputs_info; (** Information about the inputs of the forward function *) effect_info : fun_effect_info; + ignore_output : bool; + (** In case we merge the forward/backward functions: should we ignore + the output (happens for forward functions if the output type is + [unit] and there are non-filtered backward functions)? + *) } [@@deriving show] @@ -939,6 +944,7 @@ type back_sg_info = { We derive those from the names of the inputs of the original LLBC function. *) effect_info : fun_effect_info; + filter : bool; (** Should we filter this backward function? *) } [@@deriving show] diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 63436e7d..16bf1c08 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -1336,6 +1336,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : let fun_sig = def.signature in let fwd_info = fun_sig.fwd_info in let fwd_effect_info = fwd_info.effect_info in + let ignore_output = fwd_info.ignore_output in (* Generate the loop definition *) let loop_fwd_effect_info = fwd_effect_info in @@ -1358,7 +1359,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : } in - { fwd_info; effect_info = loop_fwd_effect_info } + { fwd_info; effect_info = loop_fwd_effect_info; ignore_output } in assert (fun_sig_info_is_wf loop_fwd_sig_info); @@ -2187,7 +2188,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) : } = decl.signature in - let { fwd_info; effect_info } = fwd_info in + let { fwd_info; effect_info; ignore_output } = fwd_info in let { has_fuel; @@ -2212,7 +2213,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) : } in - let fwd_info = { fwd_info; effect_info } in + let fwd_info = { fwd_info; effect_info; ignore_output } in assert (fun_sig_info_is_wf fwd_info); let signature = { diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index d4aaba16..78d0b120 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -448,6 +448,7 @@ let mk_simpl_tuple_ty (tys : ty list) : ty = let mk_bool_ty : ty = TLiteral TBool let mk_unit_ty : ty = TAdt (TTuple, empty_generic_args) +let ty_is_unit ty : bool = ty = mk_unit_ty let mk_unit_rvalue : texpression = let id = AdtCons { adt_id = TTuple; variant_id = None } in diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index f37ea201..70a4e18d 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -979,30 +979,6 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed in (* Compute the backward output, without the effect information *) let fwd_output = translate_fwd_ty type_infos sg.output in - (* The additinoal information *) - let fwd_info = - (* *) - let has_fuel = fwd_fuel <> [] in - let num_inputs_no_fuel_no_state = List.length fwd_inputs_no_fuel_no_state in - let num_inputs_with_fuel_no_state = - (* We use the fact that [fuel] has length 1 if we use some fuel, 0 otherwise *) - List.length fwd_fuel + num_inputs_no_fuel_no_state - in - let fwd_info : inputs_info = - { - has_fuel; - num_inputs_no_fuel_no_state; - num_inputs_with_fuel_no_state; - num_inputs_with_fuel_with_state = - (* We use the fact that [fwd_state_ty] has length 1 if there is a state, - and 0 otherwise *) - num_inputs_with_fuel_no_state + List.length fwd_state_ty; - } - in - let info = { fwd_info; effect_info = fwd_effect_info } in - assert (fun_sig_info_is_wf info); - info - in (* Compute the type information for the backward function *) (* Small helper to translate types for backward functions *) @@ -1086,6 +1062,9 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed in let inputs = inputs_no_state @ state in let output_names, outputs = compute_back_outputs_for_gid gid in + let filter = + !Config.simplify_merged_fwd_backs && inputs = [] && outputs = [] + in let info = { inputs; @@ -1093,6 +1072,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed outputs; output_names; effect_info = back_effect_info; + filter; } in (gid, info) @@ -1102,6 +1082,39 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (List.map compute_back_info_for_group regions_hierarchy) in + (* The additional information about the forward function *) + let fwd_info = + (* *) + let has_fuel = fwd_fuel <> [] in + let num_inputs_no_fuel_no_state = List.length fwd_inputs_no_fuel_no_state in + let num_inputs_with_fuel_no_state = + (* We use the fact that [fuel] has length 1 if we use some fuel, 0 otherwise *) + List.length fwd_fuel + num_inputs_no_fuel_no_state + in + let fwd_info : inputs_info = + { + has_fuel; + num_inputs_no_fuel_no_state; + num_inputs_with_fuel_no_state; + num_inputs_with_fuel_with_state = + (* We use the fact that [fwd_state_ty] has length 1 if there is a state, + and 0 otherwise *) + num_inputs_with_fuel_no_state + List.length fwd_state_ty; + } + in + let ignore_output = + if !Config.return_back_funs && !Config.simplify_merged_fwd_backs then + ty_is_unit fwd_output + && List.exists + (fun (info : back_sg_info) -> not info.filter) + (RegionGroupId.Map.values back_sg) + else false + in + let info = { fwd_info; effect_info = fwd_effect_info; ignore_output } in + assert (fun_sig_info_is_wf info); + info + in + (* Generic parameters *) let generics = translate_generic_params sg.generics in @@ -1134,6 +1147,13 @@ let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty in if effect_info.can_fail then mk_result_ty output else output +let mk_back_output_ty_from_effect_info (effect_info : fun_effect_info) + (inputs : ty list) (ty : ty) : ty = + let output = + if effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; ty ] else ty + in + if effect_info.can_fail && inputs <> [] then mk_result_ty output else output + (** Compute the arrow types for all the backward functions. If a backward function has no inputs/outputs we filter it. @@ -1151,7 +1171,9 @@ let compute_back_tys (dsg : Pure.decomposed_fun_sig) None else let output = mk_simpl_tuple_ty outputs in - let output = mk_output_ty_from_effect_info effect_info output in + let output = + mk_back_output_ty_from_effect_info effect_info inputs output + in let ty = mk_arrows inputs output in (* Substitute - TODO: normalize *) let ty = @@ -1166,6 +1188,25 @@ let compute_back_tys (dsg : Pure.decomposed_fun_sig) Some ty) (RegionGroupId.Map.values dsg.back_sg) +(** In case we merge the fwd/back functions: compute the output type of + a function, from a decomposed signature. *) +let compute_output_ty_from_decomposed (dsg : Pure.decomposed_fun_sig) : ty = + assert !Config.return_back_funs; + (* Compute the arrow types for all the backward functions *) + let back_tys = List.filter_map (fun x -> x) (compute_back_tys dsg None) in + (* Group the forward output and the types of the backward functions *) + let effect_info = dsg.fwd_info.effect_info in + let output = + (* We might need to ignore the output of the forward function + (if it is unit for instance) *) + let tys = + if dsg.fwd_info.ignore_output then back_tys + else dsg.fwd_output :: back_tys + in + mk_simpl_tuple_ty tys + in + mk_output_ty_from_effect_info effect_info output + let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) (gid : RegionGroupId.id option) : fun_sig = let generics = dsg.generics in @@ -1180,19 +1221,12 @@ let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) (gid, info.effect_info)) (RegionGroupId.Map.bindings dsg.back_sg)) in - (* Two cases depending on whether we split the forward/backward functions - or not *) let mk_output_ty = mk_output_ty_from_effect_info in - let inputs, output = + (* Two cases depending on whether we split the forward/backward functions or not *) if !Config.return_back_funs then ( assert (gid = None); - (* Compute the arrow types for all the backward functions *) - let back_tys = List.filter_map (fun x -> x) (compute_back_tys dsg None) in - (* Group the forward output and the types of the backward functions *) - let effect_info = dsg.fwd_info.effect_info in - let output = mk_simpl_tuple_ty (dsg.fwd_output :: back_tys) in - let output = mk_output_ty effect_info output in + let output = compute_output_ty_from_decomposed dsg in let inputs = dsg.fwd_inputs in (inputs, output)) else @@ -1785,7 +1819,11 @@ and translate_panic (ctx : bs_ctx) : texpression = if !Config.return_back_funs then let back_tys = compute_back_tys ctx.sg None in let back_tys = List.filter_map (fun x -> x) back_tys in - let output = mk_simpl_tuple_ty (ctx.sg.fwd_output :: back_tys) in + let tys = + if ctx.sg.fwd_info.ignore_output then back_tys + else ctx.sg.fwd_output :: back_tys + in + let output = mk_simpl_tuple_ty tys in mk_output output else mk_output ctx.sg.fwd_output | Some bid -> @@ -1798,6 +1836,9 @@ and translate_panic (ctx : bs_ctx) : texpression = Remark: for now, we can't get there if we are inside a loop. If inside a loop, we use {!translate_return_with_loop}. + + Remark: in case we merge the forward/backward functions, we introduce + those in [translate_forward_end]. *) and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) (ctx : bs_ctx) : texpression = @@ -2648,6 +2689,12 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) If (true_e, false_e) ) in let ty = true_e.ty in + log#ldebug + (lazy + ("true_e.ty: " + ^ pure_ty_to_string ctx true_e.ty + ^ "\n\nfalse_e.ty: " + ^ pure_ty_to_string ctx false_e.ty)); assert (ty = false_e.ty); { e; ty } | ExpandInt (int_ty, branches, otherwise) -> @@ -2941,37 +2988,63 @@ and translate_forward_end (ectx : C.eval_ctx) in let fwd_e = translate_one_end ctx None in - (* Introduce the backward functions *) + (* Introduce the backward functions. *) let back_el = List.map (fun ((gid, _) : RegionGroupId.id * back_sg_info) -> translate_one_end ctx (Some gid)) (RegionGroupId.Map.bindings ctx.sg.back_sg) in + + (* Compute whether the backward expressions should be evaluated straight + away or not (i.e., if we should bind them with monadic let-bindings + or not). We evaluate them straight away if they can fail and have no + inputs *) + let evaluate_backs = + List.map + (fun (sg : back_sg_info) -> + if !Config.simplify_merged_fwd_backs then + sg.inputs = [] && sg.effect_info.can_fail + else false) + (RegionGroupId.Map.values ctx.sg.back_sg) + in + (* Introduce variables for the backward functions. We lookup the LLBC definition in an attempt to derive pretty names for those functions. *) let _, back_vars = fresh_back_vars_for_current_fun ctx in (* Create the return expressions *) - let vars = fwd_var :: List.filter_map (fun x -> x) back_vars in + let vars = + let back_vars = List.filter_map (fun x -> x) back_vars in + if ctx.sg.fwd_info.ignore_output then back_vars + else fwd_var :: back_vars + in let vars = List.map mk_texpression_from_var vars in let ret = mk_simpl_tuple_texpression vars in let state_var = List.map mk_texpression_from_var state_var in let ret = mk_simpl_tuple_texpression (state_var @ [ ret ]) in let ret = mk_result_return_texpression ret in - (* Bind the expressions for the backward function and the expression - for the computation of the forward output *) + (* Introduce all the let-bindings *) + + (* Combine: + - the backward variables + - whether we should evaluate the expression for the backward function + (i.e., should we use a monadic let-binding or not - we do if the + backward functions don't have inputs and can fail) + - the expressions for the backward functions + *) let back_vars_els = List.filter_map - (fun (v, el) -> match v with None -> None | Some v -> Some (v, el)) - (List.combine back_vars back_el) + (fun (v, (eval, el)) -> + match v with None -> None | Some v -> Some (v, eval, el)) + (List.combine back_vars (List.combine evaluate_backs back_el)) in let e = List.fold_right - (fun (var, back_e) e -> - mk_let false (mk_typed_pattern_from_var var None) back_e e) + (fun (var, evaluate, back_e) e -> + mk_let evaluate (mk_typed_pattern_from_var var None) back_e e) back_vars_els ret in (* Bind the expression for the forward output *) -- cgit v1.2.3 From 781638d204f90660caabe23946653437e9480374 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 19:45:36 +0100 Subject: Implement a micro-pass to simplify the let-bindings --- compiler/PureMicroPasses.ml | 78 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 16bf1c08..7babe95b 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -645,6 +645,79 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl = let body = { body with body = obj#visit_texpression () body.body } in { def with body = Some body } +(** Simplify the let-bindings by performing the following rewritings: + + Move inner let-bindings outside. This is especially useful to simplify + the backward expressions, when we merge the forward/backward functions. + Note that the rule is also applied with monadic let-bindings. + {[ + let x := + let y := ... in + e + + ~~> + + let y := ... in + let x := e + ]} + + Simplify panics and returns: + {[ + let x ← fail + ... + ~~> + fail + + let x ← return y + ... + ~~> + let x := y + ... + ]} + *) +let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = + let obj = + object (self) + inherit [_] map_expression as super + + method! visit_Let env monadic lv rv next = + match rv.e with + | Let (rmonadic, rlv, rrv, rnext) -> + (* Case 1: move the inner let outside then re-visit *) + let rnext1 = Let (monadic, lv, rnext, next) in + let rnext1 = { ty = next.ty; e = rnext1 } in + self#visit_Let env rmonadic rlv rrv rnext1 + | App + ( { + e = + Qualif + { + id = + AdtCons + { + adt_id = TAssumed TResult; + variant_id = Some variant_id; + }; + generics = _; + }; + ty = _; + }, + x ) -> + (* return/fail case *) + if variant_id = result_return_id then + (* Return case *) + super#visit_Let env false lv x next + else if variant_id = result_fail_id then (* Fail case *) rv.e + else raise (Failure "Unexpected") + | _ -> super#visit_Let env monadic lv rv next + end + in + match def.body with + | None -> def + | Some body -> + let body = { body with body = obj#visit_texpression () body.body } in + { def with body = Some body } + (** Inline the useless variable (re-)assignments: A lot of intermediate variable assignments are introduced through the @@ -1829,6 +1902,11 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = log#ldebug (lazy ("intro_struct_updates:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + (* Simplify the let-bindings *) + let def = simplify_let_bindings ctx def in + log#ldebug + (lazy ("simplify_let_bindings:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + (* Inline the useless variable reassignments *) let inline_named_vars = true in let inline_pure = true in -- cgit v1.2.3 From 0fb89f21a302210aa284e54a10129c46dbe8b4b5 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 19:51:10 +0100 Subject: Use indices starting at 1 to make variable names unique at code gen --- compiler/ExtractBase.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index eb2a2ec9..0af7a9b4 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -351,7 +351,7 @@ let basename_to_unique (names_set : StringSet.t) let s = append basename i in if StringSet.mem s names_set then gen (i + 1) else s in - if StringSet.mem basename names_set then gen 0 else basename + if StringSet.mem basename names_set then gen 1 else basename type fun_name_info = { keep_fwd : bool; num_backs : int } -- cgit v1.2.3 From 6ee1063d98d82f6a3c0cf017834ec81cf012f0a1 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 20:00:35 +0100 Subject: Improve PureMicroPasses.filter_useless to simplify the matches --- compiler/PureMicroPasses.ml | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 7babe95b..156fba29 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -1052,10 +1052,23 @@ let filter_useless (filter_monadic_calls : bool) (ctx : trans_ctx) method! visit_expression env e = match e with | Var _ | CVar _ | Const _ | App _ | Qualif _ - | Switch (_, _) | Meta (_, _) | StructUpdate _ | Lambda _ -> super#visit_expression env e + | Switch (scrut, switch) -> ( + match switch with + | If (_, _) -> super#visit_expression env e + | Match branches -> + (* Simplify the branches *) + let simplify_branch (br : match_branch) = + (* Compute the set of values used inside the branch *) + let branch, used = self#visit_texpression env br.branch in + (* Simplify the pattern *) + let pat, _ = filter_typed_pattern (used ()) br.pat in + { pat; branch } + in + super#visit_expression env + (Switch (scrut, Match (List.map simplify_branch branches)))) | Let (monadic, lv, re, e) -> (* Compute the set of values used in the next expression *) let e, used = self#visit_texpression env e in -- cgit v1.2.3 From 266db04e97778911c93cfd1aac251de04bb25f53 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 22:17:11 +0100 Subject: Fix several issues --- compiler/Pure.ml | 17 ----- compiler/SymbolicToPure.ml | 186 ++++++++++++++++++++++++++++++++------------- compiler/Translate.ml | 29 +++---- 3 files changed, 151 insertions(+), 81 deletions(-) diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 05cdbd70..71531688 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -886,23 +886,6 @@ type inputs_info = { } [@@deriving show] -type ('a, 'b) back_info = - | SingleBack of 'a - (** Information about a single backward function, if pertinent. - - We use this variant if we split the forward and the backward functions. - *) - | AllBacks of 'b RegionGroupId.Map.t - (** Information about the various backward functions. - - We use this if we *do not* split the forward and the backward functions. - All the information is then carried by the forward function. - *) -[@@deriving show] - -type back_inputs_info = (inputs_info option, inputs_info) back_info -[@@deriving show] - (** Meta information about a function signature *) type fun_sig_info = { fwd_info : inputs_info; diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 70a4e18d..37f621e4 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -146,6 +146,7 @@ type bs_ctx = { global_ctx : global_ctx; trait_decls_ctx : trait_decls_ctx; trait_impls_ctx : trait_impls_ctx; + fun_dsigs : decomposed_fun_sig FunDeclId.Map.t; fun_decl : A.fun_decl; bid : RegionGroupId.id option; (** TODO: rename @@ -890,7 +891,7 @@ let mk_fuel_input_as_list (ctx : bs_ctx) (info : fun_effect_info) : if function_uses_fuel info then [ mk_fuel_texpression ctx.fuel ] else [] (** Small utility. *) -let get_fun_effect_info (fun_infos : fun_info A.FunDeclId.Map.t) +let compute_raw_fun_effect_info (fun_infos : fun_info A.FunDeclId.Map.t) (fun_id : A.fun_id_or_trait_method_ref) (lid : V.LoopId.id option) (gid : T.RegionGroupId.id option) : fun_effect_info = match fun_id with @@ -917,6 +918,22 @@ let get_fun_effect_info (fun_infos : fun_info A.FunDeclId.Map.t) is_rec = false; } +(** TODO: not very clean. *) +let get_fun_effect_info (ctx : bs_ctx) (fun_id : A.fun_id_or_trait_method_ref) + (lid : V.LoopId.id option) (gid : T.RegionGroupId.id option) : + fun_effect_info = + match fun_id with + | TraitMethod (_, _, fid) | FunId (FRegular fid) -> + let dsg = A.FunDeclId.Map.find fid ctx.fun_dsigs in + let info = + match gid with + | None -> dsg.fwd_info.effect_info + | Some gid -> (RegionGroupId.Map.find gid dsg.back_sg).effect_info + in + { info with is_rec = info.is_rec || Option.is_some lid } + | FunId (FAssumed _) -> + compute_raw_fun_effect_info ctx.fun_ctx.fun_infos fun_id lid gid + (** Translate a function signature to a decomposed function signature. Note that the function also takes a list of names for the inputs, and @@ -962,7 +979,9 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed in (* Is the forward function stateful, and can it fail? *) - let fwd_effect_info = get_fun_effect_info fun_infos fun_id None None in + let fwd_effect_info = + compute_raw_fun_effect_info fun_infos fun_id None None + in (* Compute the forward inputs *) let fwd_fuel = mk_fuel_input_ty_as_list fwd_effect_info in let fwd_inputs_no_fuel_no_state = @@ -1051,12 +1070,23 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed RegionGroupId.id * back_sg_info = let gid = rg.id in let back_effect_info = - get_fun_effect_info fun_infos fun_id None (Some gid) + compute_raw_fun_effect_info fun_infos fun_id None (Some gid) in let inputs_no_state = translate_back_inputs_for_gid gid in let inputs_no_state = List.map (fun ty -> (Some "ret", ty)) inputs_no_state in + (* We consider the backward function as stateful and potentially failing + **only if it has inputs** (for the "potentially failing": if it has + not inputs, we directly evaluate it in the body of the forward function). + *) + let back_effect_info = + { + back_effect_info with + stateful = back_effect_info.stateful && inputs_no_state <> []; + can_fail = back_effect_info.can_fail && inputs_no_state <> []; + } + in let state = if back_effect_info.stateful then [ (None, mk_state_ty) ] else [] in @@ -1140,6 +1170,19 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) translate_fun_sig_with_regions_hierarchy_to_decomposed decls_ctx (FunId (FRegular fun_id)) regions_hierarchy sg input_names +let translate_fun_sig_from_decl_to_decomposed (decls_ctx : C.decls_ctx) + (fdef : LlbcAst.fun_decl) : decomposed_fun_sig = + let input_names = + match fdef.body with + | None -> List.map (fun _ -> None) fdef.signature.inputs + | Some body -> + List.map + (fun (v : LlbcAst.var) -> v.name) + (LlbcAstUtils.fun_body_get_input_vars body) + in + translate_fun_sig_to_decomposed decls_ctx fdef.def_id fdef.signature + input_names + let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty = let output = @@ -1158,8 +1201,9 @@ let mk_back_output_ty_from_effect_info (effect_info : fun_effect_info) If a backward function has no inputs/outputs we filter it. *) -let compute_back_tys (dsg : Pure.decomposed_fun_sig) - (subst : (generic_args * trait_instance_id) option) : ty option list = +let compute_back_tys_with_info (dsg : Pure.decomposed_fun_sig) + (subst : (generic_args * trait_instance_id) option) : + (back_sg_info * ty) option list = List.map (fun (back_sg : back_sg_info) -> let effect_info = back_sg.effect_info in @@ -1185,9 +1229,13 @@ let compute_back_tys (dsg : Pure.decomposed_fun_sig) in ty_substitute subst ty in - Some ty) + Some (back_sg, ty)) (RegionGroupId.Map.values dsg.back_sg) +let compute_back_tys (dsg : Pure.decomposed_fun_sig) + (subst : (generic_args * trait_instance_id) option) : ty option list = + List.map (Option.map snd) (compute_back_tys_with_info dsg subst) + (** In case we merge the fwd/back functions: compute the output type of a function, from a decomposed signature. *) let compute_output_ty_from_decomposed (dsg : Pure.decomposed_fun_sig) : ty = @@ -1363,6 +1411,7 @@ let fresh_back_vars_for_current_fun (ctx : bs_ctx) : bs_ctx * var option list = in fresh_opt_vars back_vars ctx +(** IMPORTANT: do not use this one directly, but rather {!symbolic_value_to_texpression} *) let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : var = match V.SymbolicValueId.Map.find_opt sv.sv_id ctx.sv_to_var with | Some v -> v @@ -1381,12 +1430,22 @@ let rec unbox_typed_value (v : V.typed_value) : V.typed_value = | _ -> raise (Failure "Unreachable")) | _ -> v -(** Translate a symbolic value *) +(** Translate a symbolic value. + + Because we do not necessarily introduce variables for the symbolic values + of (translated) type unit, it is important that we do not lookup variables + in case the symbolic value has type unit. + *) let symbolic_value_to_texpression (ctx : bs_ctx) (sv : V.symbolic_value) : texpression = (* Translate the type *) - let var = lookup_var_for_symbolic_value sv ctx in - mk_texpression_from_var var + let ty = ctx_translate_fwd_ty ctx sv.sv_ty in + (* If the type is unit, directly return unit *) + if ty_is_unit ty then mk_unit_rvalue + else + (* Otherwise lookup the variable *) + let var = lookup_var_for_symbolic_value sv ctx in + mk_texpression_from_var var (** Translate a typed value. @@ -1565,13 +1624,11 @@ and aproj_to_consumed (ctx : bs_ctx) (aproj : V.aproj) : texpression option = match aproj with | V.AEndedProjLoans (msv, []) -> (* The symbolic value was left unchanged *) - let var = lookup_var_for_symbolic_value msv ctx in - Some (mk_texpression_from_var var) + Some (symbolic_value_to_texpression ctx msv) | V.AEndedProjLoans (_, [ (mnv, child_aproj) ]) -> assert (child_aproj = AIgnoredProjBorrows); (* The symbolic value was updated *) - let var = lookup_var_for_symbolic_value mnv ctx in - Some (mk_texpression_from_var var) + Some (symbolic_value_to_texpression ctx mnv) | V.AEndedProjLoans (_, _) -> (* The symbolic value was updated, and the given back values come from sevearl * abstractions *) @@ -1940,10 +1997,9 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (List.combine args args_mplaces) in let dest_mplace = translate_opt_mplace call.dest_place in - let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in (* Retrieve the function id, and register the function call in the context * if necessary. *) - let ctx, fun_id, effect_info, args, back_funs, out_state = + let ctx, fun_id, effect_info, args, dest_v = match call.call_id with | S.Fun (fid, call_id) -> (* Regular function call *) @@ -1951,13 +2007,11 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let func = Fun (FromLlbc (fid_t, None, None)) in (* Retrieve the effect information about this function (can fail, * takes a state as input, etc.) *) - let effect_info = - get_fun_effect_info ctx.fun_ctx.fun_infos fid None None - in + let effect_info = get_fun_effect_info ctx fid None None in (* Depending on the function effects: - * - add the fuel - * - add the state input argument - * - generate a fresh state variable for the returned state + - add the fuel + - add the state input argument + - generate a fresh state variable for the returned state *) let args, ctx, out_state = let fuel = mk_fuel_input_as_list ctx effect_info in @@ -1970,7 +2024,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (* If we do not split the forward/backward functions: generate the variables for the backward functions returned by the forward function. *) - let ctx, back_funs_map, back_funs = + let ctx, ignore_fwd_output, back_funs_map, back_funs = if !Config.return_back_funs then (* We need to compute the signatures of the backward functions. *) let sg = Option.get call.sg in @@ -1981,7 +2035,9 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (List.map (fun _ -> None) sg.inputs) in let tr_self = UnknownTrait __FUNCTION__ in - let back_tys = compute_back_tys dsg (Some (generics, tr_self)) in + let back_tys = + compute_back_tys_with_info dsg (Some (generics, tr_self)) + in (* Introduce variables for the backward functions *) (* Compute a proper basename for the variables *) let back_fun_name = @@ -2016,7 +2072,18 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (fun ty -> match ty with | None -> None - | Some ty -> Some (Some back_fun_name, ty)) + | Some (back_sg, ty) -> + (* We insert a name for the variable only if the function + can fail: if it can fail, it means the call returns a backward + function. Otherwise, we it directly returns the value given + back by the backward function, which means we shouldn't + give it a name like "back..." (it doesn't make sense) *) + let name = + if back_sg.effect_info.can_fail then + Some back_fun_name + else None + in + Some (name, ty)) back_tys) ctx in @@ -2039,14 +2106,37 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let back_funs_map = RegionGroupId.Map.of_list (List.combine gids back_vars) in - (ctx, Some back_funs_map, back_funs) - else (ctx, None, []) + (ctx, dsg.fwd_info.ignore_output, Some back_funs_map, back_funs) + else (ctx, false, None, []) + in + (* Compute the pattern for the destination *) + let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in + let dest = mk_typed_pattern_from_var dest dest_mplace in + let dest = + (* Here there is something subtle: as we might ignore the output + of the forward function (because it translates to unit) we doNOT + necessarily introduce in the let-binding the variable to which we + map the symbolic value which was introduced for the output of the + function call. This would be problematic if later we need to + translate this symbolic value, but we implemented + {!symbolic_value_to_texpression} so that it doesn't perform any + lookups if the symbolic value has type unit. + *) + let vars = + if ignore_fwd_output then back_funs else dest :: back_funs + in + mk_simpl_tuple_pattern vars + in + let dest = + match out_state with + | None -> dest + | Some out_state -> mk_simpl_tuple_pattern [ out_state; dest ] in (* Register the function call *) let ctx = bs_ctx_register_forward_call call_id call args back_funs_map ctx in - (ctx, func, effect_info, args, back_funs, out_state) + (ctx, func, effect_info, args, dest) | S.Unop E.Not -> let effect_info = { @@ -2057,7 +2147,9 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : is_rec = false; } in - (ctx, Unop Not, effect_info, args, [], None) + let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in + let dest = mk_typed_pattern_from_var dest dest_mplace in + (ctx, Unop Not, effect_info, args, dest) | S.Unop E.Neg -> ( match args with | [ arg ] -> @@ -2073,7 +2165,9 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : is_rec = false; } in - (ctx, Unop (Neg int_ty), effect_info, args, [], None) + let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in + let dest = mk_typed_pattern_from_var dest dest_mplace in + (ctx, Unop (Neg int_ty), effect_info, args, dest) | _ -> raise (Failure "Unreachable")) | S.Unop (E.Cast cast_kind) -> ( match cast_kind with @@ -2088,7 +2182,9 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : is_rec = false; } in - (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, [], None) + let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in + let dest = mk_typed_pattern_from_var dest dest_mplace in + (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, dest) | CastFnPtr _ -> raise (Failure "TODO: function casts")) | S.Binop binop -> ( match args with @@ -2108,16 +2204,11 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : is_rec = false; } in - (ctx, Binop (binop, int_ty0), effect_info, args, [], None) + let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in + let dest = mk_typed_pattern_from_var dest dest_mplace in + (ctx, Binop (binop, int_ty0), effect_info, args, dest) | _ -> raise (Failure "Unreachable")) in - let dest_v = - let dest = mk_typed_pattern_from_var dest dest_mplace in - let dest = mk_simpl_tuple_pattern (dest :: back_funs) in - match out_state with - | None -> dest - | Some out_state -> mk_simpl_tuple_pattern [ out_state; dest ] - in let func = { id = FunOrOp fun_id; generics } in let input_tys = (List.map (fun (x : texpression) -> x.ty)) args in let ret_ty = @@ -2242,9 +2333,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) (* Those don't have backward functions *) raise (Failure "Unreachable") in - let effect_info = - get_fun_effect_info ctx.fun_ctx.fun_infos fun_id None (Some rg_id) - in + let effect_info = get_fun_effect_info ctx fun_id None (Some rg_id) in let generics = ctx_translate_fwd_generic_args ctx call.generics in (* Retrieve the original call and the parent abstractions *) let _forward, backwards = get_abs_ancestors ctx abs call_id in @@ -2449,8 +2538,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) to a forward call which happened earlier *) let fun_id = E.FRegular ctx.fun_decl.def_id in let effect_info = - get_fun_effect_info ctx.fun_ctx.fun_infos (FunId fun_id) (Some vloop_id) - (Some rg_id) + get_fun_effect_info ctx (FunId fun_id) (Some vloop_id) (Some rg_id) in let loop_info = LoopId.Map.find loop_id ctx.loops in let generics = loop_info.generics in @@ -2609,8 +2697,7 @@ and translate_assertion (ectx : C.eval_ctx) (v : V.typed_value) and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) (exp : S.expansion) (ctx : bs_ctx) : texpression = (* Translate the scrutinee *) - let scrutinee_var = lookup_var_for_symbolic_value sv ctx in - let scrutinee = mk_texpression_from_var scrutinee_var in + let scrutinee = symbolic_value_to_texpression ctx sv in let scrutinee_mplace = translate_opt_mplace p in (* Translate the branches *) match exp with @@ -2999,7 +3086,7 @@ and translate_forward_end (ectx : C.eval_ctx) (* Compute whether the backward expressions should be evaluated straight away or not (i.e., if we should bind them with monadic let-bindings or not). We evaluate them straight away if they can fail and have no - inputs *) + inputs. *) let evaluate_backs = List.map (fun (sg : back_sg_info) -> @@ -3098,9 +3185,7 @@ and translate_forward_end (ectx : C.eval_ctx) (* Lookup the effect info for the loop function *) let fid = E.FRegular ctx.fun_decl.def_id in - let effect_info = - get_fun_effect_info ctx.fun_ctx.fun_infos (FunId fid) None ctx.bid - in + let effect_info = get_fun_effect_info ctx (FunId fid) None ctx.bid in (* Introduce a fresh output value for the forward function *) let ctx, output_var = fresh_var None ctx.sg.fwd_output ctx in @@ -3479,8 +3564,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = | None -> None | Some body -> let effect_info = - get_fun_effect_info ctx.fun_ctx.fun_infos (FunId (FRegular def_id)) - None bid + get_fun_effect_info ctx (FunId (FRegular def_id)) None bid in let body = translate_expression body ctx in (* Add a match over the fuel, if necessary *) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 5584fb9a..ccc46420 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -42,7 +42,8 @@ let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : fun_decl) : TODO: maybe we should introduce a record for this. *) let translate_function_to_pure (trans_ctx : trans_ctx) - (pure_type_decls : Pure.type_decl Pure.TypeDeclId.Map.t) (fdef : fun_decl) : + (pure_type_decls : Pure.type_decl Pure.TypeDeclId.Map.t) + (fun_dsigs : Pure.decomposed_fun_sig FunDeclId.Map.t) (fdef : fun_decl) : pure_fun_translation_no_loops = (* Debug *) log#ldebug @@ -119,18 +120,8 @@ let translate_function_to_pure (trans_ctx : trans_ctx) !m in - let input_names = - match fdef.body with - | None -> List.map (fun _ -> None) fdef.signature.inputs - | Some body -> - List.map - (fun (v : var) -> v.name) - (LlbcAstUtils.fun_body_get_input_vars body) - in - let sg = - SymbolicToPure.translate_fun_sig_to_decomposed trans_ctx def_id - fdef.signature input_names + SymbolicToPure.translate_fun_sig_from_decl_to_decomposed trans_ctx fdef in let regions_hierarchy = @@ -154,6 +145,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx) decls_ctx = trans_ctx; SymbolicToPure.bid = None; sg; + fun_dsigs; (* Will need to be updated for the backward functions *) sv_to_var; var_counter = ref var_counter; @@ -290,10 +282,21 @@ let translate_crate_to_pure (crate : crate) : (List.map (fun (def : Pure.type_decl) -> (def.def_id, def)) type_decls) in + (* Compute the decomposed fun sigs for the whole crate *) + let fun_dsigs = + FunDeclId.Map.of_list + (List.map + (fun (fdef : LlbcAst.fun_decl) -> + ( fdef.def_id, + SymbolicToPure.translate_fun_sig_from_decl_to_decomposed trans_ctx + fdef )) + (FunDeclId.Map.values crate.fun_decls)) + in + (* Translate all the *transparent* functions *) let pure_translations = List.map - (translate_function_to_pure trans_ctx type_decls_map) + (translate_function_to_pure trans_ctx type_decls_map fun_dsigs) (FunDeclId.Map.values crate.fun_decls) in -- cgit v1.2.3 From eae740d644f5ccd1ad2a7e853a9cdf303c8df61e Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 22:45:47 +0100 Subject: Fix issues when extracting stateful functions --- compiler/PrintPure.ml | 51 +++++++++++++++++++++++----------------------- compiler/SymbolicToPure.ml | 30 +++++++++++++-------------- 2 files changed, 40 insertions(+), 41 deletions(-) diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index 1ce146a4..315dd512 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -611,35 +611,36 @@ and app_to_string (env : fmt_env) (inside : bool) (indent : string) * expression *) let app, generics = match app.e with - | Qualif qualif -> + | Qualif qualif -> ( (* Qualifier case *) - (* Convert the qualifier identifier *) - let qualif_s = - match qualif.id with - | FunOrOp fun_id -> fun_or_op_id_to_string env fun_id - | Global global_id -> global_decl_id_to_string env global_id - | AdtCons adt_cons_id -> - let variant_s = - adt_variant_to_string env adt_cons_id.adt_id - adt_cons_id.variant_id - in - ConstStrings.constructor_prefix ^ variant_s - | Proj { adt_id; field_id } -> - let adt_s = adt_variant_to_string env adt_id None in - let field_s = adt_field_to_string env adt_id field_id in - (* Adopting an F*-like syntax *) - ConstStrings.constructor_prefix ^ adt_s ^ "?." ^ field_s - | TraitConst (trait_ref, generics, const_name) -> - let trait_ref = trait_ref_to_string env true trait_ref in - let generics_s = generic_args_to_string env generics in + match qualif.id with + | FunOrOp fun_id -> + let generics = generic_args_to_strings env true qualif.generics in + let qualif_s = fun_or_op_id_to_string env fun_id in + (qualif_s, generics) + | Global global_id -> + let generics = generic_args_to_strings env true qualif.generics in + (global_decl_id_to_string env global_id, generics) + | AdtCons adt_cons_id -> + let variant_s = + adt_variant_to_string env adt_cons_id.adt_id + adt_cons_id.variant_id + in + (ConstStrings.constructor_prefix ^ variant_s, []) + | Proj { adt_id; field_id } -> + let adt_s = adt_variant_to_string env adt_id None in + let field_s = adt_field_to_string env adt_id field_id in + (* Adopting an F*-like syntax *) + (ConstStrings.constructor_prefix ^ adt_s ^ "?." ^ field_s, []) + | TraitConst (trait_ref, generics, const_name) -> + let trait_ref = trait_ref_to_string env true trait_ref in + let generics_s = generic_args_to_string env generics in + let qualif = if generics <> empty_generic_args then "(" ^ trait_ref ^ generics_s ^ ")." ^ const_name else trait_ref ^ "." ^ const_name - in - (* Convert the type instantiation *) - let generics = generic_args_to_strings env true qualif.generics in - (* *) - (qualif_s, generics) + in + (qualif, [])) | _ -> (* "Regular" expression case *) let inside = args <> [] || (args = [] && inside) in diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 37f621e4..7eb75584 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -2782,7 +2782,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) ^ pure_ty_to_string ctx true_e.ty ^ "\n\nfalse_e.ty: " ^ pure_ty_to_string ctx false_e.ty)); - assert (ty = false_e.ty); + if !Config.fail_hard then assert (ty = false_e.ty); { e; ty } | ExpandInt (int_ty, branches, otherwise) -> let translate_branch ((v, branch_e) : V.scalar_value * S.expression) : @@ -3005,7 +3005,7 @@ and translate_forward_end (ectx : C.eval_ctx) fresh_vars back_sg.inputs_no_state ctx in let ctx, backward_inputs_with_state = - if (ctx_get_effect_info ctx).stateful then + if back_sg.effect_info.stateful then let ctx, var, _ = bs_ctx_fresh_state_var ctx in (ctx, backward_inputs_no_state @ [ var ]) else (ctx, backward_inputs_no_state) @@ -3061,18 +3061,7 @@ and translate_forward_end (ectx : C.eval_ctx) if !Config.return_back_funs then (* Compute the output of the forward function *) let fwd_effect_info = ctx.sg.fwd_info.effect_info in - let output_ty = - let ty = ctx.sg.fwd_output in - if fwd_effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; ty ] - else ty - in - let ctx, fwd_var = fresh_var None output_ty ctx in - let ctx, state_var, state_pat = - if fwd_effect_info.stateful then - let ctx, var, pat = bs_ctx_fresh_state_var ctx in - (ctx, [ var ], [ pat ]) - else (ctx, [], []) - in + let ctx, pure_fwd_var = fresh_var None ctx.sg.fwd_output ctx in let fwd_e = translate_one_end ctx None in (* Introduce the backward functions. *) @@ -3105,10 +3094,19 @@ and translate_forward_end (ectx : C.eval_ctx) let vars = let back_vars = List.filter_map (fun x -> x) back_vars in if ctx.sg.fwd_info.ignore_output then back_vars - else fwd_var :: back_vars + else pure_fwd_var :: back_vars in let vars = List.map mk_texpression_from_var vars in let ret = mk_simpl_tuple_texpression vars in + + (* Introduce a fresh input state variable for the forward expression *) + let _ctx, state_var, state_pat = + if fwd_effect_info.stateful then + let ctx, var, pat = bs_ctx_fresh_state_var ctx in + (ctx, [ var ], [ pat ]) + else (ctx, [], []) + in + let state_var = List.map mk_texpression_from_var state_var in let ret = mk_simpl_tuple_texpression (state_var @ [ ret ]) in let ret = mk_result_return_texpression ret in @@ -3135,7 +3133,7 @@ and translate_forward_end (ectx : C.eval_ctx) back_vars_els ret in (* Bind the expression for the forward output *) - let fwd_var = mk_typed_pattern_from_var fwd_var None in + let fwd_var = mk_typed_pattern_from_var pure_fwd_var None in let pat = mk_simpl_tuple_pattern (state_pat @ [ fwd_var ]) in mk_let fwd_effect_info.can_fail pat fwd_e e else translate_one_end ctx ctx.bid -- cgit v1.2.3 From 6dc2b0f0906adc5d6f8f2f48404cf21d3595c957 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 21 Dec 2023 23:02:51 +0100 Subject: Improve the pure micro passes --- compiler/PureMicroPasses.ml | 36 +++++++++++++++++++++++++++++++++--- compiler/PureUtils.ml | 13 +++++++++++++ 2 files changed, 46 insertions(+), 3 deletions(-) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 156fba29..67495ab5 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -674,6 +674,16 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl = let x := y ... ]} + + Simplify tuples: + {[ + let (y0, y1) := (x0, x1) in + ... + ~~> + let y0 = x0 in + let y1 = x1 in + ... + ]} *) let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = let obj = @@ -705,10 +715,30 @@ let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = x ) -> (* return/fail case *) if variant_id = result_return_id then - (* Return case *) - super#visit_Let env false lv x next - else if variant_id = result_fail_id then (* Fail case *) rv.e + (* Return case - note that the simplification we just perform + might have unlocked the tuple simplification below *) + self#visit_Let env false lv x next + else if variant_id = result_fail_id then + (* Fail case *) + self#visit_expression env rv.e else raise (Failure "Unexpected") + | App _ -> + (* This might be the tuple case *) + if not monadic then + match + (opt_dest_struct_pattern lv, opt_dest_tuple_texpression rv) + with + | Some pats, Some vals -> + (* Tuple case *) + let pat_vals = List.combine pats vals in + let e = + List.fold_right + (fun (pat, v) next -> mk_let false pat v next) + pat_vals next + in + super#visit_expression env e.e + | _ -> super#visit_Let env monadic lv rv next + else super#visit_Let env monadic lv rv next | _ -> super#visit_Let env monadic lv rv next end in diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 78d0b120..cc439e64 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -739,3 +739,16 @@ let rec destruct_lambdas (e : texpression) : typed_pattern list * texpression = let pats, e = destruct_lambdas e in (pat :: pats, e) | _ -> ([], e) + +let opt_dest_tuple_texpression (e : texpression) : texpression list option = + let app, args = destruct_apps e in + match app.e with + | Qualif { id = AdtCons { adt_id = TTuple; variant_id = None }; generics = _ } + -> + Some args + | _ -> None + +let opt_dest_struct_pattern (pat : typed_pattern) : typed_pattern list option = + match pat.value with + | PatAdt { variant_id = None; field_values } -> Some field_values + | _ -> None -- cgit v1.2.3 From 774eb319e514a0ba02473f9c82ee9d3355de8a3d Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 11:09:10 +0100 Subject: Fix an issue when merging the fwd/back functions of trait methods --- compiler/InterpreterStatements.ml | 33 ++++++++++++++++++++++++--------- compiler/SymbolicAst.ml | 4 ++++ compiler/SymbolicToPure.ml | 26 +++++++++++++++++++++----- compiler/SynthesizeSymbolic.ml | 13 ++++++++----- 4 files changed, 57 insertions(+), 19 deletions(-) diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml index 94c65b5c..97c8bcd6 100644 --- a/compiler/InterpreterStatements.ml +++ b/compiler/InterpreterStatements.ml @@ -731,6 +731,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) : fun_id_or_trait_method_ref * generic_args + * (generic_args * trait_instance_id) option * fun_decl * region_var_groups * inst_fun_sig = @@ -758,7 +759,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) instantiate_fun_sig ctx func.generics tr_self def.signature regions_hierarchy in - (func.func, func.generics, def, regions_hierarchy, inst_sg) + (func.func, func.generics, None, def, regions_hierarchy, inst_sg) | FunId (FAssumed _) -> (* Unreachable: must be a transparent function *) raise (Failure "Unreachable") @@ -811,7 +812,12 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) we also need to update the generics. *) let func = FunId fid in - (func, generics, method_def, regions_hierarchy, inst_sg) + ( func, + generics, + Some (generics, tr_self), + method_def, + regions_hierarchy, + inst_sg ) | None -> (* If not found, lookup the methods provided by the trait *declaration* (remember: for now, we forbid overriding provided methods) *) @@ -867,6 +873,7 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) in ( func.func, func.generics, + Some (all_generics, tr_self), method_def, regions_hierarchy, inst_sg )) @@ -900,8 +907,12 @@ let eval_transparent_function_call_symbolic_inst (call : call) (ctx : eval_ctx) instantiate_fun_sig ctx generics tr_self method_def.signature regions_hierarchy in - (func.func, func.generics, method_def, regions_hierarchy, inst_sg) - )) + ( func.func, + func.generics, + Some (generics, tr_self), + method_def, + regions_hierarchy, + inst_sg ))) (** Evaluate a statement *) let rec eval_statement (config : config) (st : statement) : st_cm_fun = @@ -1287,14 +1298,15 @@ and eval_transparent_function_call_concrete (config : config) and eval_transparent_function_call_symbolic (config : config) (call : call) : st_cm_fun = fun cf ctx -> - let func, generics, def, regions_hierarchy, inst_sg = + let func, generics, trait_method_generics, def, regions_hierarchy, inst_sg = eval_transparent_function_call_symbolic_inst call ctx in (* Sanity check *) assert (List.length call.args = List.length def.signature.inputs); (* Evaluate the function call *) eval_function_call_symbolic_from_inst_sig config func def.signature - regions_hierarchy inst_sg generics call.args call.dest cf ctx + regions_hierarchy inst_sg generics trait_method_generics call.args call.dest + cf ctx (** Evaluate a function call in symbolic mode by using the function signature. @@ -1310,7 +1322,9 @@ and eval_transparent_function_call_symbolic (config : config) (call : call) : and eval_function_call_symbolic_from_inst_sig (config : config) (fid : fun_id_or_trait_method_ref) (sg : fun_sig) (regions_hierarchy : region_var_groups) (inst_sg : inst_fun_sig) - (generics : generic_args) (args : operand list) (dest : place) : st_cm_fun = + (generics : generic_args) + (trait_method_generics : (generic_args * trait_instance_id) option) + (args : operand list) (dest : place) : st_cm_fun = fun cf ctx -> log#ldebug (lazy @@ -1390,7 +1404,8 @@ and eval_function_call_symbolic_from_inst_sig (config : config) (* Synthesize the symbolic AST *) S.synthesize_regular_function_call fid call_id ctx sg regions_hierarchy - abs_ids generics args args_places ret_spc dest_place expr + abs_ids generics trait_method_generics args args_places ret_spc dest_place + expr in let cc = comp cc cf_call in @@ -1500,7 +1515,7 @@ and eval_assumed_function_call_symbolic (config : config) (fid : assumed_fun_id) (* Evaluate the function call *) eval_function_call_symbolic_from_inst_sig config (FunId (FAssumed fid)) sg - regions_hierarchy inst_sig generics args dest cf ctx + regions_hierarchy inst_sig generics None args dest cf ctx (** Evaluate a statement seen as a function body *) and eval_function_body (config : config) (body : statement) : st_cm_fun = diff --git a/compiler/SymbolicAst.ml b/compiler/SymbolicAst.ml index 54d207d9..8e8cdec3 100644 --- a/compiler/SymbolicAst.ml +++ b/compiler/SymbolicAst.ml @@ -48,6 +48,10 @@ type call = { abstractions : AbstractionId.id list; (** The region abstractions introduced upon calling the function *) generics : generic_args; + trait_method_generics : (generic_args * trait_instance_id) option; + (** In case the call is to a trait method, we may need an additional type + parameter ([Self]) and the self trait clause to instantiate the + function signature. *) args : typed_value list; args_places : mplace option list; (** Meta information *) dest : symbolic_value; diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 7eb75584..41922cb5 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1985,7 +1985,9 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : texpression = log#ldebug (lazy - ("translate_function_call:\n" + ("translate_function_call:\n" ^ "\n- call.call_id:" + ^ S.show_call_id call.call_id + ^ "\n\n- call.generics:\n" ^ ctx_generic_args_to_string ctx call.generics)); (* Translate the function call *) let generics = ctx_translate_fwd_generic_args ctx call.generics in @@ -2025,7 +2027,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : variables for the backward functions returned by the forward function. *) let ctx, ignore_fwd_output, back_funs_map, back_funs = - if !Config.return_back_funs then + if !Config.return_back_funs then ( (* We need to compute the signatures of the backward functions. *) let sg = Option.get call.sg in let decls_ctx = ctx.decls_ctx in @@ -2034,9 +2036,23 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : fid call.regions_hierarchy sg (List.map (fun _ -> None) sg.inputs) in - let tr_self = UnknownTrait __FUNCTION__ in + log#ldebug + (lazy ("dsg.generics:\n" ^ show_generic_params dsg.generics)); + let tr_self, all_generics = + match call.trait_method_generics with + | None -> (UnknownTrait __FUNCTION__, generics) + | Some (all_generics, tr_self) -> + let all_generics = + ctx_translate_fwd_generic_args ctx all_generics + in + let tr_self = + translate_fwd_trait_instance_id ctx.type_ctx.type_infos + tr_self + in + (tr_self, all_generics) + in let back_tys = - compute_back_tys_with_info dsg (Some (generics, tr_self)) + compute_back_tys_with_info dsg (Some (all_generics, tr_self)) in (* Introduce variables for the backward functions *) (* Compute a proper basename for the variables *) @@ -2106,7 +2122,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let back_funs_map = RegionGroupId.Map.of_list (List.combine gids back_vars) in - (ctx, dsg.fwd_info.ignore_output, Some back_funs_map, back_funs) + (ctx, dsg.fwd_info.ignore_output, Some back_funs_map, back_funs)) else (ctx, false, None, []) in (* Compute the pattern for the destination *) diff --git a/compiler/SynthesizeSymbolic.ml b/compiler/SynthesizeSymbolic.ml index 4ec7524b..865185a8 100644 --- a/compiler/SynthesizeSymbolic.ml +++ b/compiler/SynthesizeSymbolic.ml @@ -95,6 +95,7 @@ let synthesize_symbolic_expansion_no_branching (sv : symbolic_value) let synthesize_function_call (call_id : call_id) (ctx : Contexts.eval_ctx) (sg : fun_sig option) (regions_hierarchy : region_var_groups) (abstractions : AbstractionId.id list) (generics : generic_args) + (trait_method_generics : (generic_args * trait_instance_id) option) (args : typed_value list) (args_places : mplace option list) (dest : symbolic_value) (dest_place : mplace option) (e : expression option) : expression option = @@ -108,6 +109,7 @@ let synthesize_function_call (call_id : call_id) (ctx : Contexts.eval_ctx) regions_hierarchy; abstractions; generics; + trait_method_generics; args; dest; args_places; @@ -125,19 +127,20 @@ let synthesize_regular_function_call (fun_id : fun_id_or_trait_method_ref) (call_id : FunCallId.id) (ctx : Contexts.eval_ctx) (sg : fun_sig) (regions_hierarchy : region_var_groups) (abstractions : AbstractionId.id list) (generics : generic_args) + (trait_method_generics : (generic_args * trait_instance_id) option) (args : typed_value list) (args_places : mplace option list) (dest : symbolic_value) (dest_place : mplace option) (e : expression option) : expression option = synthesize_function_call (Fun (fun_id, call_id)) - ctx (Some sg) regions_hierarchy abstractions generics args args_places dest - dest_place e + ctx (Some sg) regions_hierarchy abstractions generics trait_method_generics + args args_places dest dest_place e let synthesize_unary_op (ctx : Contexts.eval_ctx) (unop : unop) (arg : typed_value) (arg_place : mplace option) (dest : symbolic_value) (dest_place : mplace option) (e : expression option) : expression option = let generics = empty_generic_args in - synthesize_function_call (Unop unop) ctx None [] [] generics [ arg ] + synthesize_function_call (Unop unop) ctx None [] [] generics None [ arg ] [ arg_place ] dest dest_place e let synthesize_binary_op (ctx : Contexts.eval_ctx) (binop : binop) @@ -145,8 +148,8 @@ let synthesize_binary_op (ctx : Contexts.eval_ctx) (binop : binop) (arg1_place : mplace option) (dest : symbolic_value) (dest_place : mplace option) (e : expression option) : expression option = let generics = empty_generic_args in - synthesize_function_call (Binop binop) ctx None [] [] generics [ arg0; arg1 ] - [ arg0_place; arg1_place ] dest dest_place e + synthesize_function_call (Binop binop) ctx None [] [] generics None + [ arg0; arg1 ] [ arg0_place; arg1_place ] dest dest_place e let synthesize_end_abstraction (ctx : Contexts.eval_ctx) (abs : abs) (e : expression option) : expression option = -- cgit v1.2.3 From a504199331e1b406d24067837a725085fb8f09e9 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 18:08:26 +0100 Subject: Slightly update the formatting of the do blocks --- compiler/Extract.ml | 50 ++++++++++++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 57360536..04ad3b75 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -266,6 +266,21 @@ let rec extract_typed_pattern (ctx : extraction_ctx) (fmt : F.formatter) extract_adt_g_value extract_value fmt ctx is_let inside av.variant_id av.field_values v.ty +(** Return true if we need to wrap a succession of let-bindings in a [do ...] + block (because some of them are monadic) *) +let lets_require_wrap_in_do (lets : (bool * typed_pattern * texpression) list) : + bool = + match !backend with + | Lean -> + (* For Lean, we wrap in a block iff at least one of the let-bindings is monadic *) + List.exists (fun (m, _, _) -> m) lets + | HOL4 -> + (* HOL4 is similar to HOL4, but we add a sanity check *) + let wrap_in_do = List.exists (fun (m, _, _) -> m) lets in + if wrap_in_do then assert (List.for_all (fun (m, _, _) -> m) lets); + wrap_in_do + | FStar | Coq -> false + (** [inside]: controls the introduction of parentheses. See [extract_ty] TODO: replace the formatting boolean [inside] with something more general? @@ -634,15 +649,6 @@ and extract_lets (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) | HOL4 -> destruct_lets_no_interleave e | FStar | Coq | Lean -> destruct_lets e in - (* Open a box for the whole expression. - - In the case of Lean, we use a vbox so that line breaks are inserted - at the end of every let-binding: let-bindings are indeed not ended - with an "in" keyword. - *) - if !Config.backend = Lean then F.pp_open_vbox fmt 0 else F.pp_open_hvbox fmt 0; - (* Open parentheses *) - if inside && !backend <> Lean then F.pp_print_string fmt "("; (* Extract the let-bindings *) let extract_let (ctx : extraction_ctx) (monadic : bool) (lv : typed_pattern) (re : texpression) : extraction_ctx = @@ -715,22 +721,19 @@ and extract_lets (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (* Return *) ctx in + (* Open a box for the whole expression. + + In the case of Lean, we use a vbox so that line breaks are inserted + at the end of every let-binding: let-bindings are indeed not ended + with an "in" keyword. + *) + if !Config.backend = Lean then F.pp_open_vbox fmt 0 else F.pp_open_hvbox fmt 0; + (* Open parentheses *) + if inside && !backend <> Lean then F.pp_print_string fmt "("; (* If Lean and HOL4, we rely on monadic blocks, so we insert a do and open a new box immediately *) - let wrap_in_do_od = - match !backend with - | Lean -> - (* For Lean, we wrap in a block iff at least one of the let-bindings is monadic *) - List.exists (fun (m, _, _) -> m) lets - | HOL4 -> - (* HOL4 is similar to HOL4, but we add a sanity check *) - let wrap_in_do = List.exists (fun (m, _, _) -> m) lets in - if wrap_in_do then assert (List.for_all (fun (m, _, _) -> m) lets); - wrap_in_do - | FStar | Coq -> false - in + let wrap_in_do_od = lets_require_wrap_in_do lets in if wrap_in_do_od then ( - F.pp_open_vbox fmt (if !backend = Lean then ctx.indent_incr else 0); F.pp_print_string fmt "do"; F.pp_print_space fmt ()); let ctx = @@ -746,11 +749,10 @@ and extract_lets (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) F.pp_close_box fmt (); (* do-box (Lean and HOL4 only) *) - if wrap_in_do_od then ( + if wrap_in_do_od then if !backend = HOL4 then ( F.pp_print_space fmt (); F.pp_print_string fmt "od"); - F.pp_close_box fmt ()); (* Close parentheses *) if inside && !backend <> Lean then F.pp_print_string fmt ")"; (* Close the box for the whole expression *) -- cgit v1.2.3 From e799ef503dda30b6dcbecb042ecb0fae1a71fa81 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 18:30:29 +0100 Subject: Update the Lean standard library --- backends/lean/Base/Primitives/Alloc.lean | 4 +- backends/lean/Base/Primitives/ArraySlice.lean | 68 +++++---------------------- backends/lean/Base/Primitives/Base.lean | 3 +- backends/lean/Base/Primitives/CoreOps.lean | 6 +-- backends/lean/Base/Primitives/Vec.lean | 38 +++++++++------ 5 files changed, 38 insertions(+), 81 deletions(-) diff --git a/backends/lean/Base/Primitives/Alloc.lean b/backends/lean/Base/Primitives/Alloc.lean index 6c89c6bb..1f470fe1 100644 --- a/backends/lean/Base/Primitives/Alloc.lean +++ b/backends/lean/Base/Primitives/Alloc.lean @@ -12,8 +12,7 @@ namespace boxed -- alloc.boxed namespace Box -- alloc.boxed.Box def deref (T : Type) (x : T) : Result T := ret x -def deref_mut (T : Type) (x : T) : Result T := ret x -def deref_mut_back (T : Type) (_ : T) (x : T) : Result T := ret x +def deref_mut (T : Type) (x : T) : Result (T × (T → Result T)) := ret (x, λ x => ret x) /-- Trait instance -/ def coreopsDerefInst (Self : Type) : @@ -27,7 +26,6 @@ def coreopsDerefMutInst (Self : Type) : core.ops.deref.DerefMut Self := { derefInst := coreopsDerefInst Self deref_mut := deref_mut Self - deref_mut_back := deref_mut_back Self } end Box -- alloc.boxed.Box diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index f68c0846..59432a0b 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -149,13 +149,6 @@ theorem Slice.index_usize_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Us have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) simp [*] --- This shouldn't be used -def Slice.index_shared_back (α : Type u) (v: Slice α) (i: Usize) (_: α) : Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - def Slice.update_usize (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds @@ -243,7 +236,7 @@ def Array.update_subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range -- but: some symbols like `+` are already overloaded to be notations for monadic -- operations/ -- We should introduce special symbols for the monadic arithmetic operations --- (the use will never write those symbols directly). +-- (the user will never write those symbols directly). @[pspec] theorem Array.update_subslice_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α) (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : s.length = r.end_.val - r.start.val) : @@ -345,13 +338,11 @@ structure core.slice.index.SliceIndex (Self T : Type) where sealedInst : core.slice.index.private_slice_index.Sealed Self Output : Type get : Self → T → Result (Option Output) - get_mut : Self → T → Result (Option Output) - get_mut_back : Self → T → Option Output → Result T + get_mut : Self → T → Result (Option Output × (Option Output → Result T)) get_unchecked : Self → ConstRawPtr T → Result (ConstRawPtr Output) get_unchecked_mut : Self → MutRawPtr T → Result (MutRawPtr Output) index : Self → T → Result Output - index_mut : Self → T → Result Output - index_mut_back : Self → T → Output → Result T + index_mut : Self → T → Result (Output × (Output → Result T)) /- [core::slice::index::[T]::index]: forward function -/ def core.slice.index.Slice.index @@ -369,13 +360,7 @@ def core.slice.index.RangeUsize.get (T : Type) (i : Range Usize) (slice : Slice /- [core::slice::index::Range::get_mut]: forward function -/ def core.slice.index.RangeUsize.get_mut - (T : Type) : Range Usize → Slice T → Result (Option (Slice T)) := - sorry -- TODO - -/- [core::slice::index::Range::get_mut]: backward function 0 -/ -def core.slice.index.RangeUsize.get_mut_back - (T : Type) : - Range Usize → Slice T → Option (Slice T) → Result (Slice T) := + (T : Type) : Range Usize → Slice T → Result (Option (Slice T) × (Option (Slice T) → Result (Slice T))) := sorry -- TODO /- [core::slice::index::Range::get_unchecked]: forward function -/ @@ -401,24 +386,13 @@ def core.slice.index.RangeUsize.index /- [core::slice::index::Range::index_mut]: forward function -/ def core.slice.index.RangeUsize.index_mut - (T : Type) : Range Usize → Slice T → Result (Slice T) := - sorry -- TODO - -/- [core::slice::index::Range::index_mut]: backward function 0 -/ -def core.slice.index.RangeUsize.index_mut_back - (T : Type) : Range Usize → Slice T → Slice T → Result (Slice T) := + (T : Type) : Range Usize → Slice T → Result (Slice T × (Slice T → Result (Slice T))) := sorry -- TODO /- [core::slice::index::[T]::index_mut]: forward function -/ def core.slice.index.Slice.index_mut (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) : - Slice T → I → Result inst.Output := - sorry -- TODO - -/- [core::slice::index::[T]::index_mut]: backward function 0 -/ -def core.slice.index.Slice.index_mut_back - (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) : - Slice T → I → inst.Output → Result (Slice T) := + Slice T → I → Result (inst.Output × (inst.Output → Result (Slice T))) := sorry -- TODO /- [core::array::[T; N]::index]: forward function -/ @@ -430,13 +404,8 @@ def core.array.Array.index /- [core::array::[T; N]::index_mut]: forward function -/ def core.array.Array.index_mut (T I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T) I) - (a : Array T N) (i : I) : Result inst.indexInst.Output := - sorry -- TODO - -/- [core::array::[T; N]::index_mut]: backward function 0 -/ -def core.array.Array.index_mut_back - (T I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T) I) - (a : Array T N) (i : I) (x : inst.indexInst.Output) : Result (Array T N) := + (a : Array T N) (i : I) : + Result (inst.indexInst.Output × (inst.indexInst.Output → Result (Array T N))) := sorry -- TODO /- Trait implementation: [core::slice::index::private_slice_index::Range] -/ @@ -450,12 +419,10 @@ def core.slice.index.SliceIndexRangeUsizeSliceTInst (T : Type) : Output := Slice T get := core.slice.index.RangeUsize.get T get_mut := core.slice.index.RangeUsize.get_mut T - get_mut_back := core.slice.index.RangeUsize.get_mut_back T get_unchecked := core.slice.index.RangeUsize.get_unchecked T get_unchecked_mut := core.slice.index.RangeUsize.get_unchecked_mut T index := core.slice.index.RangeUsize.index T index_mut := core.slice.index.RangeUsize.index_mut T - index_mut_back := core.slice.index.RangeUsize.index_mut_back T } /- Trait implementation: [core::slice::index::[T]] -/ @@ -472,7 +439,6 @@ def core.ops.index.IndexMutSliceTIInst (T I : Type) core.ops.index.IndexMut (Slice T) I := { indexInst := core.ops.index.IndexSliceTIInst T I inst index_mut := core.slice.index.Slice.index_mut T I inst - index_mut_back := core.slice.index.Slice.index_mut_back T I inst } /- Trait implementation: [core::array::[T; N]] -/ @@ -489,7 +455,6 @@ def core.ops.index.IndexMutArrayIInst (T I : Type) (N : Usize) core.ops.index.IndexMut (Array T N) I := { indexInst := core.ops.index.IndexArrayIInst T I N inst.indexInst index_mut := core.array.Array.index_mut T I N inst - index_mut_back := core.array.Array.index_mut_back T I N inst } /- [core::slice::index::usize::get]: forward function -/ @@ -499,12 +464,7 @@ def core.slice.index.Usize.get /- [core::slice::index::usize::get_mut]: forward function -/ def core.slice.index.Usize.get_mut - (T : Type) : Usize → Slice T → Result (Option T) := - sorry -- TODO - -/- [core::slice::index::usize::get_mut]: backward function 0 -/ -def core.slice.index.Usize.get_mut_back - (T : Type) : Usize → Slice T → Option T → Result (Slice T) := + (T : Type) : Usize → Slice T → Result (Option T × (Option T → Result (Slice T))) := sorry -- TODO /- [core::slice::index::usize::get_unchecked]: forward function -/ @@ -522,12 +482,8 @@ def core.slice.index.Usize.index (T : Type) : Usize → Slice T → Result T := sorry -- TODO /- [core::slice::index::usize::index_mut]: forward function -/ -def core.slice.index.Usize.index_mut (T : Type) : Usize → Slice T → Result T := - sorry -- TODO - -/- [core::slice::index::usize::index_mut]: backward function 0 -/ -def core.slice.index.Usize.index_mut_back - (T : Type) : Usize → Slice T → T → Result (Slice T) := +def core.slice.index.Usize.index_mut (T : Type) : + Usize → Slice T → Result (T × (T → Result (Slice T))) := sorry -- TODO /- Trait implementation: [core::slice::index::private_slice_index::usize] -/ @@ -541,12 +497,10 @@ def core.slice.index.SliceIndexUsizeSliceTInst (T : Type) : Output := T get := core.slice.index.Usize.get T get_mut := core.slice.index.Usize.get_mut T - get_mut_back := core.slice.index.Usize.get_mut_back T get_unchecked := core.slice.index.Usize.get_unchecked T get_unchecked_mut := core.slice.index.Usize.get_unchecked_mut T index := core.slice.index.Usize.index T index_mut := core.slice.index.Usize.index_mut T - index_mut_back := core.slice.index.Usize.index_mut_back T } end Primitives diff --git a/backends/lean/Base/Primitives/Base.lean b/backends/lean/Base/Primitives/Base.lean index 7fc33251..321c39a8 100644 --- a/backends/lean/Base/Primitives/Base.lean +++ b/backends/lean/Base/Primitives/Base.lean @@ -120,8 +120,7 @@ def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := -- MISC -- ---------- -@[simp] def core.mem.replace (a : Type) (x : a) (_ : a) : a := x -@[simp] def core.mem.replace_back (a : Type) (_ : a) (y : a) : a := y +@[simp] def core.mem.replace (a : Type) (x : a) (_ : a) : a × (a → a) := (x, λ x => x) /-- Aeneas-translated function -- useful to reduce non-recursive definitions. Use with `simp [ aeneas ]` -/ diff --git a/backends/lean/Base/Primitives/CoreOps.lean b/backends/lean/Base/Primitives/CoreOps.lean index da458f66..1736bfa6 100644 --- a/backends/lean/Base/Primitives/CoreOps.lean +++ b/backends/lean/Base/Primitives/CoreOps.lean @@ -16,8 +16,7 @@ structure Index (Self Idx : Type) where /- Trait declaration: [core::ops::index::IndexMut] -/ structure IndexMut (Self Idx : Type) where indexInst : Index Self Idx - index_mut : Self → Idx → Result indexInst.Output - index_mut_back : Self → Idx → indexInst.Output → Result Self + index_mut : Self → Idx → Result (indexInst.Output × (indexInst.Output → Result Self)) end index -- core.ops.index @@ -29,8 +28,7 @@ structure Deref (Self : Type) where structure DerefMut (Self : Type) where derefInst : Deref Self - deref_mut : Self → Result derefInst.Target - deref_mut_back : Self → derefInst.Target → Result Self + deref_mut : Self → Result (derefInst.Target × (Self → Result Self)) end deref -- core.ops.deref diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean index 2c3fce91..12733a34 100644 --- a/backends/lean/Base/Primitives/Vec.lean +++ b/backends/lean/Base/Primitives/Vec.lean @@ -122,6 +122,26 @@ theorem Vec.update_usize_spec {α : Type u} (v: Vec α) (i: Usize) (x : α) . simp_all [length]; cases h <;> scalar_tac . simp_all +def Vec.index_mut_usize {α : Type u} (v: Vec α) (i: Usize) : + Result (α × (α → Result (Vec α))) := + match Vec.index_usize v i with + | ret x => + ret (x, Vec.update_usize v i) + | fail e => fail e + | div => div + +@[pspec] +theorem Vec.index_mut_usize_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize) + (hbound : i.val < v.length) : + ∃ x back, v.index_mut_usize i = ret (x, back) ∧ + x = v.val.index i.val ∧ + -- Backward function + back = v.update_usize i + := by + simp only [index_mut_usize] + have ⟨ x, h ⟩ := index_usize_spec v i hbound + simp [h] + /- [alloc::vec::Vec::index]: forward function -/ def Vec.index (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) (self : Vec T) (i : I) : Result inst.Output := @@ -129,13 +149,8 @@ def Vec.index (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) /- [alloc::vec::Vec::index_mut]: forward function -/ def Vec.index_mut (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) - (self : Vec T) (i : I) : Result inst.Output := - sorry -- TODO - -/- [alloc::vec::Vec::index_mut]: backward function 0 -/ -def Vec.index_mut_back - (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) - (self : Vec T) (i : I) (x : inst.Output) : Result (alloc.vec.Vec T) := + (self : Vec T) (i : I) : + Result (inst.Output × (inst.Output → Result (Vec T))) := sorry -- TODO /- Trait implementation: [alloc::vec::Vec] -/ @@ -152,7 +167,6 @@ def Vec.coreopsindexIndexMutInst (T I : Type) core.ops.index.IndexMut (alloc.vec.Vec T) I := { indexInst := Vec.coreopsindexIndexInst T I inst index_mut := Vec.index_mut T I inst - index_mut_back := Vec.index_mut_back T I inst } @[simp] @@ -164,13 +178,7 @@ theorem Vec.index_slice_index {α : Type} (v : Vec α) (i : Usize) : @[simp] theorem Vec.index_mut_slice_index {α : Type} (v : Vec α) (i : Usize) : Vec.index_mut α Usize (core.slice.index.SliceIndexUsizeSliceTInst α) v i = - Vec.index_usize v i := - sorry - -@[simp] -theorem Vec.index_mut_back_slice_index {α : Type} (v : Vec α) (i : Usize) (x : α) : - Vec.index_mut_back α Usize (core.slice.index.SliceIndexUsizeSliceTInst α) v i x = - Vec.update_usize v i x := + index_mut_usize v i := sorry end alloc.vec -- cgit v1.2.3 From 455ba366f9c8d07a1f1848ec0960b1f2d161e7cf Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 18:47:50 +0100 Subject: Update the library for F* --- Makefile | 6 +- backends/fstar/Makefile | 47 -- backends/fstar/Primitives.fst | 884 ------------------------------------ backends/fstar/merge/Makefile | 47 ++ backends/fstar/merge/Primitives.fst | 829 +++++++++++++++++++++++++++++++++ backends/fstar/split/Makefile | 47 ++ backends/fstar/split/Primitives.fst | 884 ++++++++++++++++++++++++++++++++++++ compiler/ExtractBuiltin.ml | 8 + compiler/Translate.ml | 8 +- 9 files changed, 1826 insertions(+), 934 deletions(-) delete mode 100644 backends/fstar/Makefile delete mode 100644 backends/fstar/Primitives.fst create mode 100644 backends/fstar/merge/Makefile create mode 100644 backends/fstar/merge/Primitives.fst create mode 100644 backends/fstar/split/Makefile create mode 100644 backends/fstar/split/Primitives.fst diff --git a/Makefile b/Makefile index 2cce30d9..37408554 100644 --- a/Makefile +++ b/Makefile @@ -70,9 +70,11 @@ build-bin-dir: build-bin build-lib mkdir -p bin cp -f compiler/_build/default/main.exe bin/aeneas cp -f compiler/_build/default/main.exe bin/aeneas.cmxs - mkdir -p bin/backends/fstar + mkdir -p bin/backends/fstar/split + mkdir -p bin/backends/fstar/merge mkdir -p bin/backends/coq - cp -rf backends/fstar/*.fst* bin/backends/fstar/ + cp -rf backends/fstar/split/*.fst* bin/backends/fstar/split/ + cp -rf backends/fstar/merge/*.fst* bin/backends/fstar/merge/ cp -rf backends/coq/*.v bin/backends/coq/ .PHONY: doc diff --git a/backends/fstar/Makefile b/backends/fstar/Makefile deleted file mode 100644 index a16b0edb..00000000 --- a/backends/fstar/Makefile +++ /dev/null @@ -1,47 +0,0 @@ -INCLUDE_DIRS = . - -FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) - -FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints - -FSTAR_OPTIONS = $(FSTAR_HINTS) \ - --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ - --warn_error '+241@247+285-274' \ - -FSTAR_NO_FLAGS = fstar.exe --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj - -FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) - -# The F* roots are used to compute the dependency graph, and generate the .depend file -FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) - -# Build all the files -all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) - -# This is the right way to ensure the .depend file always gets re-built. -ifeq (,$(filter %-in,$(MAKECMDGOALS))) -ifndef NODEPEND -ifndef MAKE_RESTARTS -.depend: .FORCE - $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ - -.PHONY: .FORCE -.FORCE: -endif -endif - -include .depend -endif - -# For the interactive mode -%.fst-in %.fsti-in: - @echo $(FSTAR_OPTIONS) - -# Generete the .checked files in batch mode -%.checked: - $(FSTAR) $(FSTAR_OPTIONS) $< && \ - touch -c $@ - -.PHONY: clean -clean: - rm -f obj/* diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst deleted file mode 100644 index a3ffbde4..00000000 --- a/backends/fstar/Primitives.fst +++ /dev/null @@ -1,884 +0,0 @@ -/// This file lists primitive and assumed functions and types -module Primitives -open FStar.Mul -open FStar.List.Tot - -#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" - -(*** Utilities *) -val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : - ls':list a{ - length ls' = length ls /\ - index ls' i == x - } -#push-options "--fuel 1" -let rec list_update #a ls i x = - match ls with - | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x -#pop-options - -(*** Result *) -type error : Type0 = -| Failure -| OutOfFuel - -type result (a : Type0) : Type0 = -| Return : v:a -> result a -| Fail : e:error -> result a - -// Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x - -// Monadic bind operator. -// Allows to use the notation: -// ``` -// let* x = y in -// ... -// ``` -unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : - result b = - match m with - | Return x -> f x - | Fail e -> Fail e - -// Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure - -// Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x - -(*** Misc *) -type char = FStar.Char.char -type string = string - -let is_zero (n: nat) : bool = n = 0 -let decrease (n: nat{n > 0}) : nat = n - 1 - -let core_mem_replace (a : Type0) (x : a) (y : a) : a = x -let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y - -// We don't really use raw pointers for now -type mut_raw_ptr (t : Type0) = { v : t } -type const_raw_ptr (t : Type0) = { v : t } - -(*** Scalars *) -/// Rem.: most of the following code was partially generated - -assume val size_numbits : pos - -// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t - -let isize_min : int = -9223372036854775808 // TODO: should be opaque -let isize_max : int = 9223372036854775807 // TODO: should be opaque -let i8_min : int = -128 -let i8_max : int = 127 -let i16_min : int = -32768 -let i16_max : int = 32767 -let i32_min : int = -2147483648 -let i32_max : int = 2147483647 -let i64_min : int = -9223372036854775808 -let i64_max : int = 9223372036854775807 -let i128_min : int = -170141183460469231731687303715884105728 -let i128_max : int = 170141183460469231731687303715884105727 -let usize_min : int = 0 -let usize_max : int = 4294967295 // TODO: should be opaque -let u8_min : int = 0 -let u8_max : int = 255 -let u16_min : int = 0 -let u16_max : int = 65535 -let u32_min : int = 0 -let u32_max : int = 4294967295 -let u64_min : int = 0 -let u64_max : int = 18446744073709551615 -let u128_min : int = 0 -let u128_max : int = 340282366920938463463374607431768211455 - -type scalar_ty = -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -let is_unsigned = function - | Isize | I8 | I16 | I32 | I64 | I128 -> false - | Usize | U8 | U16 | U32 | U64 | U128 -> true - -let scalar_min (ty : scalar_ty) : int = - match ty with - | Isize -> isize_min - | I8 -> i8_min - | I16 -> i16_min - | I32 -> i32_min - | I64 -> i64_min - | I128 -> i128_min - | Usize -> usize_min - | U8 -> u8_min - | U16 -> u16_min - | U32 -> u32_min - | U64 -> u64_min - | U128 -> u128_min - -let scalar_max (ty : scalar_ty) : int = - match ty with - | Isize -> isize_max - | I8 -> i8_max - | I16 -> i16_max - | I32 -> i32_max - | I64 -> i64_max - | I128 -> i128_max - | Usize -> usize_max - | U8 -> u8_max - | U16 -> u16_max - | U32 -> u32_max - | U64 -> u64_max - | U128 -> u128_max - -type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} - -let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure - -let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) - -let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - if y <> 0 then mk_scalar ty (x / y) else Fail Failure - -/// The remainder operation -let int_rem (x : int) (y : int{y <> 0}) : int = - if x >= 0 then (x % y) else -(x % y) - -(* Checking consistency with Rust *) -let _ = assert_norm(int_rem 1 2 = 1) -let _ = assert_norm(int_rem (-1) 2 = -1) -let _ = assert_norm(int_rem 1 (-2) = 1) -let _ = assert_norm(int_rem (-1) (-2) = -1) - -let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure - -let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - mk_scalar ty (x + y) - -let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - mk_scalar ty (x - y) - -let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - mk_scalar ty (x * y) - -let scalar_xor (#ty : scalar_ty) - (x : scalar ty) (y : scalar ty) : scalar ty = - match ty with - | U8 -> FStar.UInt.logxor #8 x y - | U16 -> FStar.UInt.logxor #16 x y - | U32 -> FStar.UInt.logxor #32 x y - | U64 -> FStar.UInt.logxor #64 x y - | U128 -> FStar.UInt.logxor #128 x y - | Usize -> admit() // TODO - | I8 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 8); - normalize_spec (scalar I8); - FStar.Int.logxor #8 x y - | I16 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 16); - normalize_spec (scalar I16); - FStar.Int.logxor #16 x y - | I32 -> FStar.Int.logxor #32 x y - | I64 -> FStar.Int.logxor #64 x y - | I128 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 128); - normalize_spec (scalar I128); - FStar.Int.logxor #128 x y - | Isize -> admit() // TODO - -let scalar_or (#ty : scalar_ty) - (x : scalar ty) (y : scalar ty) : scalar ty = - match ty with - | U8 -> FStar.UInt.logor #8 x y - | U16 -> FStar.UInt.logor #16 x y - | U32 -> FStar.UInt.logor #32 x y - | U64 -> FStar.UInt.logor #64 x y - | U128 -> FStar.UInt.logor #128 x y - | Usize -> admit() // TODO - | I8 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 8); - normalize_spec (scalar I8); - FStar.Int.logor #8 x y - | I16 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 16); - normalize_spec (scalar I16); - FStar.Int.logor #16 x y - | I32 -> FStar.Int.logor #32 x y - | I64 -> FStar.Int.logor #64 x y - | I128 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 128); - normalize_spec (scalar I128); - FStar.Int.logor #128 x y - | Isize -> admit() // TODO - -let scalar_and (#ty : scalar_ty) - (x : scalar ty) (y : scalar ty) : scalar ty = - match ty with - | U8 -> FStar.UInt.logand #8 x y - | U16 -> FStar.UInt.logand #16 x y - | U32 -> FStar.UInt.logand #32 x y - | U64 -> FStar.UInt.logand #64 x y - | U128 -> FStar.UInt.logand #128 x y - | Usize -> admit() // TODO - | I8 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 8); - normalize_spec (scalar I8); - FStar.Int.logand #8 x y - | I16 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 16); - normalize_spec (scalar I16); - FStar.Int.logand #16 x y - | I32 -> FStar.Int.logand #32 x y - | I64 -> FStar.Int.logand #64 x y - | I128 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 128); - normalize_spec (scalar I128); - FStar.Int.logand #128 x y - | Isize -> admit() // TODO - -// Shift left -let scalar_shl (#ty0 #ty1 : scalar_ty) - (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = - admit() - -// Shift right -let scalar_shr (#ty0 #ty1 : scalar_ty) - (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = - admit() - -(** Cast an integer from a [src_ty] to a [tgt_ty] *) -// TODO: check the semantics of casts in Rust -let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = - mk_scalar tgt_ty x - -// This can't fail, but for now we make all casts faillible (easier for the translation) -let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = - mk_scalar tgt_ty (if x then 1 else 0) - -/// The scalar types -type isize : eqtype = scalar Isize -type i8 : eqtype = scalar I8 -type i16 : eqtype = scalar I16 -type i32 : eqtype = scalar I32 -type i64 : eqtype = scalar I64 -type i128 : eqtype = scalar I128 -type usize : eqtype = scalar Usize -type u8 : eqtype = scalar U8 -type u16 : eqtype = scalar U16 -type u32 : eqtype = scalar U32 -type u64 : eqtype = scalar U64 -type u128 : eqtype = scalar U128 - - -let core_isize_min : isize = isize_min -let core_isize_max : isize = isize_max -let core_i8_min : i8 = i8_min -let core_i8_max : i8 = i8_max -let core_i16_min : i16 = i16_min -let core_i16_max : i16 = i16_max -let core_i32_min : i32 = i32_min -let core_i32_max : i32 = i32_max -let core_i64_min : i64 = i64_min -let core_i64_max : i64 = i64_max -let core_i128_min : i128 = i128_min -let core_i128_max : i128 = i128_max - -let core_usize_min : usize = usize_min -let core_usize_max : usize = usize_max -let core_u8_min : u8 = u8_min -let core_u8_max : u8 = u8_max -let core_u16_min : u16 = u16_min -let core_u16_max : u16 = u16_max -let core_u32_min : u32 = u32_min -let core_u32_max : u32 = u32_max -let core_u64_min : u64 = u64_min -let core_u64_max : u64 = u64_max -let core_u128_min : u128 = u128_min -let core_u128_max : u128 = u128_max - -/// Negation -let isize_neg = scalar_neg #Isize -let i8_neg = scalar_neg #I8 -let i16_neg = scalar_neg #I16 -let i32_neg = scalar_neg #I32 -let i64_neg = scalar_neg #I64 -let i128_neg = scalar_neg #I128 - -/// Division -let isize_div = scalar_div #Isize -let i8_div = scalar_div #I8 -let i16_div = scalar_div #I16 -let i32_div = scalar_div #I32 -let i64_div = scalar_div #I64 -let i128_div = scalar_div #I128 -let usize_div = scalar_div #Usize -let u8_div = scalar_div #U8 -let u16_div = scalar_div #U16 -let u32_div = scalar_div #U32 -let u64_div = scalar_div #U64 -let u128_div = scalar_div #U128 - -/// Remainder -let isize_rem = scalar_rem #Isize -let i8_rem = scalar_rem #I8 -let i16_rem = scalar_rem #I16 -let i32_rem = scalar_rem #I32 -let i64_rem = scalar_rem #I64 -let i128_rem = scalar_rem #I128 -let usize_rem = scalar_rem #Usize -let u8_rem = scalar_rem #U8 -let u16_rem = scalar_rem #U16 -let u32_rem = scalar_rem #U32 -let u64_rem = scalar_rem #U64 -let u128_rem = scalar_rem #U128 - -/// Addition -let isize_add = scalar_add #Isize -let i8_add = scalar_add #I8 -let i16_add = scalar_add #I16 -let i32_add = scalar_add #I32 -let i64_add = scalar_add #I64 -let i128_add = scalar_add #I128 -let usize_add = scalar_add #Usize -let u8_add = scalar_add #U8 -let u16_add = scalar_add #U16 -let u32_add = scalar_add #U32 -let u64_add = scalar_add #U64 -let u128_add = scalar_add #U128 - -/// Subtraction -let isize_sub = scalar_sub #Isize -let i8_sub = scalar_sub #I8 -let i16_sub = scalar_sub #I16 -let i32_sub = scalar_sub #I32 -let i64_sub = scalar_sub #I64 -let i128_sub = scalar_sub #I128 -let usize_sub = scalar_sub #Usize -let u8_sub = scalar_sub #U8 -let u16_sub = scalar_sub #U16 -let u32_sub = scalar_sub #U32 -let u64_sub = scalar_sub #U64 -let u128_sub = scalar_sub #U128 - -/// Multiplication -let isize_mul = scalar_mul #Isize -let i8_mul = scalar_mul #I8 -let i16_mul = scalar_mul #I16 -let i32_mul = scalar_mul #I32 -let i64_mul = scalar_mul #I64 -let i128_mul = scalar_mul #I128 -let usize_mul = scalar_mul #Usize -let u8_mul = scalar_mul #U8 -let u16_mul = scalar_mul #U16 -let u32_mul = scalar_mul #U32 -let u64_mul = scalar_mul #U64 -let u128_mul = scalar_mul #U128 - -/// Xor -let u8_xor = scalar_xor #U8 -let u16_xor = scalar_xor #U16 -let u32_xor = scalar_xor #U32 -let u64_xor = scalar_xor #U64 -let u128_xor = scalar_xor #U128 -let usize_xor = scalar_xor #Usize -let i8_xor = scalar_xor #I8 -let i16_xor = scalar_xor #I16 -let i32_xor = scalar_xor #I32 -let i64_xor = scalar_xor #I64 -let i128_xor = scalar_xor #I128 -let isize_xor = scalar_xor #Isize - -/// Or -let u8_or = scalar_or #U8 -let u16_or = scalar_or #U16 -let u32_or = scalar_or #U32 -let u64_or = scalar_or #U64 -let u128_or = scalar_or #U128 -let usize_or = scalar_or #Usize -let i8_or = scalar_or #I8 -let i16_or = scalar_or #I16 -let i32_or = scalar_or #I32 -let i64_or = scalar_or #I64 -let i128_or = scalar_or #I128 -let isize_or = scalar_or #Isize - -/// And -let u8_and = scalar_and #U8 -let u16_and = scalar_and #U16 -let u32_and = scalar_and #U32 -let u64_and = scalar_and #U64 -let u128_and = scalar_and #U128 -let usize_and = scalar_and #Usize -let i8_and = scalar_and #I8 -let i16_and = scalar_and #I16 -let i32_and = scalar_and #I32 -let i64_and = scalar_and #I64 -let i128_and = scalar_and #I128 -let isize_and = scalar_and #Isize - -/// Shift left -let u8_shl #ty = scalar_shl #U8 #ty -let u16_shl #ty = scalar_shl #U16 #ty -let u32_shl #ty = scalar_shl #U32 #ty -let u64_shl #ty = scalar_shl #U64 #ty -let u128_shl #ty = scalar_shl #U128 #ty -let usize_shl #ty = scalar_shl #Usize #ty -let i8_shl #ty = scalar_shl #I8 #ty -let i16_shl #ty = scalar_shl #I16 #ty -let i32_shl #ty = scalar_shl #I32 #ty -let i64_shl #ty = scalar_shl #I64 #ty -let i128_shl #ty = scalar_shl #I128 #ty -let isize_shl #ty = scalar_shl #Isize #ty - -/// Shift right -let u8_shr #ty = scalar_shr #U8 #ty -let u16_shr #ty = scalar_shr #U16 #ty -let u32_shr #ty = scalar_shr #U32 #ty -let u64_shr #ty = scalar_shr #U64 #ty -let u128_shr #ty = scalar_shr #U128 #ty -let usize_shr #ty = scalar_shr #Usize #ty -let i8_shr #ty = scalar_shr #I8 #ty -let i16_shr #ty = scalar_shr #I16 #ty -let i32_shr #ty = scalar_shr #I32 #ty -let i64_shr #ty = scalar_shr #I64 #ty -let i128_shr #ty = scalar_shr #I128 #ty -let isize_shr #ty = scalar_shr #Isize #ty - -(*** core::ops *) - -// Trait declaration: [core::ops::index::Index] -noeq type core_ops_index_Index (self idx : Type0) = { - output : Type0; - index : self → idx → result output -} - -// Trait declaration: [core::ops::index::IndexMut] -noeq type core_ops_index_IndexMut (self idx : Type0) = { - indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result indexInst.output; - index_mut_back : self → idx → indexInst.output → result self; -} - -// Trait declaration [core::ops::deref::Deref] -noeq type core_ops_deref_Deref (self : Type0) = { - target : Type0; - deref : self → result target; -} - -// Trait declaration [core::ops::deref::DerefMut] -noeq type core_ops_deref_DerefMut (self : Type0) = { - derefInst : core_ops_deref_Deref self; - deref_mut : self → result derefInst.target; - deref_mut_back : self → derefInst.target → result self; -} - -type core_ops_range_Range (a : Type0) = { - start : a; - end_ : a; -} - -(*** [alloc] *) - -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x - -// Trait instance -let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { - target = self; - deref = alloc_boxed_Box_deref self; -} - -// Trait instance -let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { - derefInst = alloc_boxed_Box_coreopsDerefInst self; - deref_mut = alloc_boxed_Box_deref_mut self; - deref_mut_back = alloc_boxed_Box_deref_mut_back self; -} - -(*** Array *) -type array (a : Type0) (n : usize) = s:list a{length s = n} - -// We tried putting the normalize_term condition as a refinement on the list -// but it didn't work. It works with the requires clause. -let mk_array (a : Type0) (n : usize) - (l : list a) : - Pure (array a n) - (requires (normalize_term(FStar.List.Tot.length l) = n)) - (ensures (fun _ -> True)) = - normalize_term_spec (FStar.List.Tot.length l); - l - -let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) - else Fail Failure - -(*** Slice *) -type slice (a : Type0) = s:list a{length s <= usize_max} - -let slice_len (a : Type0) (s : slice a) : usize = length s - -let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) - else Fail Failure - -(*** Subslices *) - -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s - else Fail Failure - -// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = - admit() - -let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = - admit() - -let array_repeat (a : Type0) (n : usize) (x : a) : array a n = - admit() - -let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = - admit() - -let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = - admit() - -(*** Vector *) -type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} - -let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] -let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v - -// Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -// Helper -let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure - -// The **forward** function shouldn't be used -let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () -let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : - Pure (result (alloc_vec_Vec a)) - (requires True) - (ensures (fun res -> - match res with - | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = - if length v < usize_max then begin - (**) assert_norm(length [x] == 1); - (**) append_length v [x]; - (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) - end - else Fail Failure - -// The **forward** function shouldn't be used -let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure -let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure - -// Trait declaration: [core::slice::index::private_slice_index::Sealed] -type core_slice_index_private_slice_index_Sealed (self : Type0) = unit - -// Trait declaration: [core::slice::index::SliceIndex] -noeq type core_slice_index_SliceIndex (self t : Type0) = { - sealedInst : core_slice_index_private_slice_index_Sealed self; - output : Type0; - get : self → t → result (option output); - get_mut : self → t → result (option output); - get_mut_back : self → t → option output → result t; - get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); - get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); - index : self → t → result output; - index_mut : self → t → result output; - index_mut_back : self → t → output → result t; -} - -// [core::slice::index::[T]::index]: forward function -let core_slice_index_Slice_index - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (s : slice t) (i : idx) : result inst.output = - let* x = inst.get i s in - match x with - | None -> Fail Failure - | Some x -> Return x - -// [core::slice::index::Range:::get]: forward function -let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : - result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_RangeUsize_get_mut_back - (t : Type0) : - core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::get_unchecked]: forward function -let core_slice_index_RangeUsize_get_unchecked - (t : Type0) : - core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = - // Don't know what the model should be - for now we always fail to make - // sure code which uses it fails - fun _ _ -> Fail Failure - -// [core::slice::index::Range::get_unchecked_mut]: forward function -let core_slice_index_RangeUsize_get_unchecked_mut - (t : Type0) : - core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = - // Don't know what the model should be - for now we always fail to make - // sure code which uses it fails - fun _ _ -> Fail Failure - -// [core::slice::index::Range::index]: forward function -let core_slice_index_RangeUsize_index - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_RangeUsize_index_mut_back - (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::[T]::index_mut]: forward function -let core_slice_index_Slice_index_mut - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result inst.output = - admit () // - -// [core::slice::index::[T]::index_mut]: backward function 0 -let core_slice_index_Slice_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → inst.output → result (slice t) = - admit () // TODO - -// [core::array::[T; N]::index]: forward function -let core_array_Array_index - (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) - (a : array t n) (i : idx) : result inst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: forward function -let core_array_Array_index_mut - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : result inst.indexInst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: backward function 0 -let core_array_Array_index_mut_back - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = - admit () // TODO - -// Trait implementation: [core::slice::index::private_slice_index::Range] -let core_slice_index_private_slice_index_SealedRangeUsizeInst - : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () - -// Trait implementation: [core::slice::index::Range] -let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : - core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { - sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; - output = slice t; - get = core_slice_index_RangeUsize_get t; - get_mut = core_slice_index_RangeUsize_get_mut t; - get_mut_back = core_slice_index_RangeUsize_get_mut_back t; - get_unchecked = core_slice_index_RangeUsize_get_unchecked t; - get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; - index = core_slice_index_RangeUsize_index t; - index_mut = core_slice_index_RangeUsize_index_mut t; - index_mut_back = core_slice_index_RangeUsize_index_mut_back t; -} - -// Trait implementation: [core::slice::index::[T]] -let core_ops_index_IndexSliceTIInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_Index (slice t) idx = { - output = inst.output; - index = core_slice_index_Slice_index t idx inst; -} - -// Trait implementation: [core::slice::index::[T]] -let core_ops_index_IndexMutSliceTIInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_IndexMut (slice t) idx = { - indexInst = core_ops_index_IndexSliceTIInst t idx inst; - index_mut = core_slice_index_Slice_index_mut t idx inst; - index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; -} - -// Trait implementation: [core::array::[T; N]] -let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) - (inst : core_ops_index_Index (slice t) idx) : - core_ops_index_Index (array t n) idx = { - output = inst.output; - index = core_array_Array_index t idx n inst; -} - -// Trait implementation: [core::array::[T; N]] -let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) - (inst : core_ops_index_IndexMut (slice t) idx) : - core_ops_index_IndexMut (array t n) idx = { - indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; - index_mut = core_array_Array_index_mut t idx n inst; - index_mut_back = core_array_Array_index_mut_back t idx n inst; -} - -// [core::slice::index::usize::get]: forward function -let core_slice_index_usize_get - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: backward function 0 -let core_slice_index_usize_get_mut_back - (t : Type0) : usize → slice t → option t → result (slice t) = - admit () // TODO - -// [core::slice::index::usize::get_unchecked]: forward function -let core_slice_index_usize_get_unchecked - (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = - admit () // TODO - -// [core::slice::index::usize::get_unchecked_mut]: forward function -let core_slice_index_usize_get_unchecked_mut - (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = - admit () // TODO - -// [core::slice::index::usize::index]: forward function -let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: backward function 0 -let core_slice_index_usize_index_mut_back - (t : Type0) : usize → slice t → t → result (slice t) = - admit () // TODO - -// Trait implementation: [core::slice::index::private_slice_index::usize] -let core_slice_index_private_slice_index_SealedUsizeInst - : core_slice_index_private_slice_index_Sealed usize = () - -// Trait implementation: [core::slice::index::usize] -let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : - core_slice_index_SliceIndex usize (slice t) = { - sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; - output = t; - get = core_slice_index_usize_get t; - get_mut = core_slice_index_usize_get_mut t; - get_mut_back = core_slice_index_usize_get_mut_back t; - get_unchecked = core_slice_index_usize_get_unchecked t; - get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; - index = core_slice_index_usize_index t; - index_mut = core_slice_index_usize_index_mut t; - index_mut_back = core_slice_index_usize_index_mut_back t; -} - -// [alloc::vec::Vec::index]: forward function -let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: forward function -let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: backward function 0 -let alloc_vec_Vec_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = - admit () // TODO - -// Trait implementation: [alloc::vec::Vec] -let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_Index (alloc_vec_Vec t) idx = { - output = inst.output; - index = alloc_vec_Vec_index t idx inst; -} - -// Trait implementation: [alloc::vec::Vec] -let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_IndexMut (alloc_vec_Vec t) idx = { - indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; - index_mut = alloc_vec_Vec_index_mut t idx inst; - index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; -} - -(*** Theorems *) - -let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : - Lemma ( - alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) - [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] - = - admit() - -let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : - Lemma ( - alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) - [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] - = - admit() - -let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : - Lemma ( - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == - alloc_vec_Vec_update_usize v i x) - [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] - = - admit() diff --git a/backends/fstar/merge/Makefile b/backends/fstar/merge/Makefile new file mode 100644 index 00000000..a16b0edb --- /dev/null +++ b/backends/fstar/merge/Makefile @@ -0,0 +1,47 @@ +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_NO_FLAGS = fstar.exe --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/backends/fstar/merge/Primitives.fst b/backends/fstar/merge/Primitives.fst new file mode 100644 index 00000000..6b8dbeb7 --- /dev/null +++ b/backends/fstar/merge/Primitives.fst @@ -0,0 +1,829 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a & (a -> a) = (x, (fun x -> x)) + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = + Return (x, (fun x -> Return x)) + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v + +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : + result (a & (a → result (alloc_vec_Vec a))) = + match alloc_vec_Vec_index_usize v i with + | Return x -> + Return (x, alloc_vec_Vec_update_usize v i) + | Fail e -> Fail e + +let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output & (option output -> result t)); + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result (output & (output -> result t)); +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = + admit () // + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_mut_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() diff --git a/backends/fstar/split/Makefile b/backends/fstar/split/Makefile new file mode 100644 index 00000000..a16b0edb --- /dev/null +++ b/backends/fstar/split/Makefile @@ -0,0 +1,47 @@ +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_NO_FLAGS = fstar.exe --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/backends/fstar/split/Primitives.fst b/backends/fstar/split/Primitives.fst new file mode 100644 index 00000000..a3ffbde4 --- /dev/null +++ b/backends/fstar/split/Primitives.fst @@ -0,0 +1,884 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v + +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure +let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_RangeUsize_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_RangeUsize_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_mut_back = core_slice_index_RangeUsize_get_mut_back t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; + index_mut_back = core_slice_index_RangeUsize_index_mut_back t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] + = + admit() diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index 24d16dca..ee8d4831 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -232,6 +232,14 @@ let builtin_funs () : (pattern * bool list option * builtin_fun_info list) list let mk_fun (rust_name : string) (extract_name : string option) (filter : bool list option) (with_back : bool) (back_no_suffix : bool) : pattern * bool list option * builtin_fun_info list = + (* [back_no_suffix] is used to control whether the backward function should + have the suffix "_back" or not (if not, then the forward function has the + prefix "_fwd", and is filtered anyway). This is pertinent only if we split + the fwd/back functions. *) + let back_no_suffix = back_no_suffix && not !Config.return_back_funs in + (* Same for the [with_back] option: this is pertinent only if we split + the fwd/back functions *) + let with_back = with_back && not !Config.return_back_funs in let rust_name = try parse_pattern rust_name with Failure _ -> diff --git a/compiler/Translate.ml b/compiler/Translate.ml index ccc46420..55a94302 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -1171,7 +1171,13 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) : let exe_dir = Filename.dirname Sys.argv.(0) in let primitives_src_dest = match !Config.backend with - | FStar -> Some ("/backends/fstar/Primitives.fst", "Primitives.fst") + | FStar -> + let src = + if !Config.return_back_funs then + "/backends/fstar/merge/Primitives.fst" + else "/backends/fstar/split/Primitives.fst" + in + Some (src, "Primitives.fst") | Coq -> Some ("/backends/coq/Primitives.v", "Primitives.v") | Lean -> None | HOL4 -> None -- cgit v1.2.3 From 632e2ddc0c5ed0c785b37fdc41394336e467f623 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 18:56:49 +0100 Subject: Update the library for Coq --- backends/coq/Primitives.v | 116 +++++++++++++++++----------------------------- 1 file changed, 42 insertions(+), 74 deletions(-) diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index 84280b96..c0056073 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -67,8 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . -Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * (a -> a) := (x, fun x => x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. @@ -504,13 +503,15 @@ Arguments core_ops_index_Index_index {_ _}. (* Trait declaration: [core::ops::index::IndexMut] *) Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; - core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); - core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; + core_ops_index_IndexMut_index_mut : + Self -> + Idx -> + result (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) * + (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self)); }. Arguments mk_core_ops_index_IndexMut {_ _}. Arguments core_ops_index_IndexMut_indexInst {_ _}. Arguments core_ops_index_IndexMut_index_mut {_ _}. -Arguments core_ops_index_IndexMut_index_mut_back {_ _}. (* Trait declaration [core::ops::deref::Deref] *) Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { @@ -524,13 +525,14 @@ Arguments core_ops_deref_Deref_deref {_}. (* Trait declaration [core::ops::deref::DerefMut] *) Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; - core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); - core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; + core_ops_deref_DerefMut_deref_mut : + Self -> + result (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) * + (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self)); }. Arguments mk_core_ops_deref_DerefMut {_}. Arguments core_ops_deref_DerefMut_derefInst {_}. Arguments core_ops_deref_DerefMut_deref_mut {_}. -Arguments core_ops_deref_DerefMut_deref_mut_back {_}. Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { core_ops_range_Range_start : T; @@ -543,8 +545,8 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := + Return (x, fun x => Return x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -556,7 +558,6 @@ Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; - core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; |}. @@ -639,16 +640,9 @@ Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (l | right _ => Fail_ Failure end. -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. - Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_insert_fwd (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result unit := - if to_Z i if to_Z i result (alloc_vec_Vec T))) := + match alloc_vec_Vec_index_usize v i with + | Return x => + Return (x, alloc_vec_Vec_update_usize v i) + | Fail_ e => Fail_ e + end. + (* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. @@ -669,25 +671,23 @@ Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceI core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; core_slice_index_SliceIndex_Output : Type; core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_mut : + Self -> T -> result (option core_slice_index_SliceIndex_Output * (option core_slice_index_SliceIndex_Output -> result T)); core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_index_mut : + Self -> T -> result (core_slice_index_SliceIndex_Output * (core_slice_index_SliceIndex_Output -> result T)); }. Arguments mk_core_slice_index_SliceIndex {_ _}. Arguments core_slice_index_SliceIndex_sealedInst {_ _}. Arguments core_slice_index_SliceIndex_Output {_ _}. Arguments core_slice_index_SliceIndex_get {_ _}. Arguments core_slice_index_SliceIndex_get_mut {_ _}. -Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. Arguments core_slice_index_SliceIndex_index {_ _}. Arguments core_slice_index_SliceIndex_index_mut {_ _}. -Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. (* [core::slice::index::[T]::index]: forward function *) Definition core_slice_index_Slice_index @@ -704,11 +704,9 @@ Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Ra (* [core::slice::index::Range::get_mut]: forward function *) Axiom core_slice_index_RangeUsize_get_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (option (slice T)). - -(* [core::slice::index::Range::get_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_get_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + forall (T : Type), + core_ops_range_Range usize -> slice T -> + result (option (slice T) * (option (slice T) -> result (slice T))). (* [core::slice::index::Range::get_unchecked]: forward function *) Definition core_slice_index_RangeUsize_get_unchecked @@ -732,21 +730,14 @@ Axiom core_slice_index_RangeUsize_index : (* [core::slice::index::Range::index_mut]: forward function *) Axiom core_slice_index_RangeUsize_index_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). - -(* [core::slice::index::Range::index_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_index_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T * (slice T -> result (slice T))). (* [core::slice::index::[T]::index_mut]: forward function *) Axiom core_slice_index_Slice_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). - -(* [core::slice::index::[T]::index_mut]: backward function 0 *) -Axiom core_slice_index_Slice_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + slice T -> Idx -> + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (slice T))). (* [core::array::[T; N]::index]: forward function *) Axiom core_array_Array_index : @@ -756,12 +747,9 @@ Axiom core_array_Array_index : (* [core::array::[T; N]::index_mut]: forward function *) Axiom core_array_Array_index_mut : forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). - -(* [core::array::[T; N]::index_mut]: backward function 0 *) -Axiom core_array_Array_index_mut_back : - forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + (a : array T N) (i : Idx), + result (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) * + (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) -> result (array T N))). (* Trait implementation: [core::slice::index::private_slice_index::Range] *) Definition core_slice_index_private_slice_index_SealedRangeUsizeInst @@ -774,12 +762,10 @@ Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := slice T; core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_RangeUsize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_RangeUsize_index_mut_back T; |}. (* Trait implementation: [core::slice::index::[T]] *) @@ -796,7 +782,6 @@ Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) core_ops_index_IndexMut (slice T) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; |}. (* Trait implementation: [core::array::[T; N]] *) @@ -813,18 +798,14 @@ Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) core_ops_index_IndexMut (array T N) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; - core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; |}. (* [core::slice::index::usize::get]: forward function *) Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). (* [core::slice::index::usize::get_mut]: forward function *) -Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). - -(* [core::slice::index::usize::get_mut]: backward function 0 *) -Axiom core_slice_index_usize_get_mut_back : - forall (T : Type), usize -> slice T -> option T -> result (slice T). +Axiom core_slice_index_usize_get_mut : + forall (T : Type), usize -> slice T -> result (option T * (option T -> result (slice T))). (* [core::slice::index::usize::get_unchecked]: forward function *) Axiom core_slice_index_usize_get_unchecked : @@ -838,11 +819,8 @@ Axiom core_slice_index_usize_get_unchecked_mut : Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. (* [core::slice::index::usize::index_mut]: forward function *) -Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. - -(* [core::slice::index::usize::index_mut]: backward function 0 *) -Axiom core_slice_index_usize_index_mut_back : - forall (T : Type), usize -> slice T -> T -> result (slice T). +Axiom core_slice_index_usize_index_mut : + forall (T : Type), usize -> slice T -> result (T * (T -> result (slice T))). (* Trait implementation: [core::slice::index::private_slice_index::usize] *) Definition core_slice_index_private_slice_index_SealedUsizeInst @@ -855,12 +833,10 @@ Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := T; core_slice_index_SliceIndex_get := core_slice_index_usize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_usize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; |}. (* [alloc::vec::Vec::index]: forward function *) @@ -869,12 +845,9 @@ Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_Slice (* [alloc::vec::Vec::index_mut]: forward function *) Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). - -(* [alloc::vec::Vec::index_mut]: backward function 0 *) -Axiom alloc_vec_Vec_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + (Self : alloc_vec_Vec T) (i : Idx), + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (alloc_vec_Vec T))). (* Trait implementation: [alloc::vec::Vec] *) Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) @@ -890,7 +863,6 @@ Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; |}. (*** Theorems *) @@ -901,10 +873,6 @@ Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usiz Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = - alloc_vec_Vec_index_usize v i. - -Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x = - alloc_vec_Vec_update_usize v i x. + alloc_vec_Vec_index_mut_usize v i. End Primitives. -- cgit v1.2.3 From 3688596f27a1ba461f48e88446b8812ec73f1a2f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 19:09:16 +0100 Subject: Add an option to split the fwd/back functions and fix a minor issue --- Makefile | 19 +++++++++++++++++-- compiler/Main.ml | 3 +++ compiler/SymbolicToPure.ml | 19 ++++++++++++------- tests/Makefile | 2 +- 4 files changed, 33 insertions(+), 10 deletions(-) diff --git a/Makefile b/Makefile index 37408554..3ea8cda3 100644 --- a/Makefile +++ b/Makefile @@ -256,14 +256,29 @@ testp-%: gen-llbcp-% tfstarp-% tcoqp-% tleanp-% thol4p-% .PHONY: tfstar-% tfstar-%: OPTIONS += -backend fstar tfstar-%: BACKEND_SUBDIR := fstar -tfstar-%: +tfstar-%: tsplit-fstar-% $(AENEAS_CMD) # "p" stands for "Polonius" .PHONY: tfstarp-% tfstarp-%: OPTIONS += -backend fstar tfstarp-%: BACKEND_SUBDIR := fstar -tfstarp-%: +tfstarp-%: tsplit-fstarp-% + $(AENEAS_CMD) + +# Test where we split the forward/backward functions +.PHONY: tsplit-fstar-% +tsplit-fstar-%: OPTIONS += -backend fstar -split-fwd-back +tsplit-fstar-%: BACKEND_SUBDIR := fstar-split +tsplit-fstar-%: + $(AENEAS_CMD) + +# Test where we split the forward/backward functions +# "p" stands for "Polonius" +.PHONY: tsplit-fstarp-% +tsplit-fstarp-%: OPTIONS += -backend fstar -split-fwd-back +tsplit-fstarp-%: BACKEND_SUBDIR := fstar-split +tsplit-fstarp-%: $(AENEAS_CMD) .PHONY: tcoq-% diff --git a/compiler/Main.ml b/compiler/Main.ml index 835b9088..abc27b46 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -120,6 +120,9 @@ let () = " Generate a default lakefile.lean (Lean only)" ); ("-print-llbc", Arg.Set print_llbc, " Print the imported LLBC"); ("-k", Arg.Clear fail_hard, " Do not fail hard in case of error"); + ( "-split-fwd-back", + Arg.Clear return_back_funs, + " Split the forward and backward functions." ); ] in diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 41922cb5..4674b61c 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1076,16 +1076,20 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed let inputs_no_state = List.map (fun ty -> (Some "ret", ty)) inputs_no_state in - (* We consider the backward function as stateful and potentially failing + (* In case we merge the forward/backward functions: + we consider the backward function as stateful and potentially failing **only if it has inputs** (for the "potentially failing": if it has not inputs, we directly evaluate it in the body of the forward function). *) let back_effect_info = - { - back_effect_info with - stateful = back_effect_info.stateful && inputs_no_state <> []; - can_fail = back_effect_info.can_fail && inputs_no_state <> []; - } + if !Config.return_back_funs then + let b = inputs_no_state <> [] in + { + back_effect_info with + stateful = back_effect_info.stateful && b; + can_fail = back_effect_info.can_fail && b; + } + else back_effect_info in let state = if back_effect_info.stateful then [ (None, mk_state_ty) ] else [] @@ -1093,7 +1097,8 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed let inputs = inputs_no_state @ state in let output_names, outputs = compute_back_outputs_for_gid gid in let filter = - !Config.simplify_merged_fwd_backs && inputs = [] && outputs = [] + !Config.simplify_merged_fwd_backs + && !Config.return_back_funs && inputs = [] && outputs = [] in let info = { diff --git a/tests/Makefile b/tests/Makefile index 8d40e8da..ccdbf652 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,4 +1,4 @@ -all: test-fstar test-coq test-lean test-hol4 +all: test-fstar test-fstar-split test-coq test-lean test-hol4 test-%: cd $* && $(MAKE) all -- cgit v1.2.3 From 20f743016400fadc5726203e3631d32b6244bd1b Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 19:16:55 +0100 Subject: Regenerate some of the NoNestedBorrows tests --- tests/fstar/misc/NoNestedBorrows.fst | 377 ++++++++++++------------- tests/fstar/misc/Primitives.fst | 111 ++------ tests/lean/NoNestedBorrows.lean | 532 +++++++++++++++++------------------ 3 files changed, 474 insertions(+), 546 deletions(-) diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index 1386b02c..0fd0c1dc 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -37,96 +37,96 @@ type sum_t (t1 t2 : Type0) = | Sum_Left : t1 -> sum_t t1 t2 | Sum_Right : t2 -> sum_t t1 t2 -(** [no_nested_borrows::neg_test]: forward function +(** [no_nested_borrows::neg_test]: Source: 'src/no_nested_borrows.rs', lines 48:0-48:30 *) let neg_test (x : i32) : result i32 = i32_neg x -(** [no_nested_borrows::add_u32]: forward function +(** [no_nested_borrows::add_u32]: Source: 'src/no_nested_borrows.rs', lines 54:0-54:37 *) let add_u32 (x : u32) (y : u32) : result u32 = u32_add x y -(** [no_nested_borrows::subs_u32]: forward function +(** [no_nested_borrows::subs_u32]: Source: 'src/no_nested_borrows.rs', lines 60:0-60:38 *) let subs_u32 (x : u32) (y : u32) : result u32 = u32_sub x y -(** [no_nested_borrows::div_u32]: forward function +(** [no_nested_borrows::div_u32]: Source: 'src/no_nested_borrows.rs', lines 66:0-66:37 *) let div_u32 (x : u32) (y : u32) : result u32 = u32_div x y -(** [no_nested_borrows::div_u32_const]: forward function +(** [no_nested_borrows::div_u32_const]: Source: 'src/no_nested_borrows.rs', lines 73:0-73:35 *) let div_u32_const (x : u32) : result u32 = u32_div x 2 -(** [no_nested_borrows::rem_u32]: forward function +(** [no_nested_borrows::rem_u32]: Source: 'src/no_nested_borrows.rs', lines 78:0-78:37 *) let rem_u32 (x : u32) (y : u32) : result u32 = u32_rem x y -(** [no_nested_borrows::mul_u32]: forward function +(** [no_nested_borrows::mul_u32]: Source: 'src/no_nested_borrows.rs', lines 82:0-82:37 *) let mul_u32 (x : u32) (y : u32) : result u32 = u32_mul x y -(** [no_nested_borrows::add_i32]: forward function +(** [no_nested_borrows::add_i32]: Source: 'src/no_nested_borrows.rs', lines 88:0-88:37 *) let add_i32 (x : i32) (y : i32) : result i32 = i32_add x y -(** [no_nested_borrows::subs_i32]: forward function +(** [no_nested_borrows::subs_i32]: Source: 'src/no_nested_borrows.rs', lines 92:0-92:38 *) let subs_i32 (x : i32) (y : i32) : result i32 = i32_sub x y -(** [no_nested_borrows::div_i32]: forward function +(** [no_nested_borrows::div_i32]: Source: 'src/no_nested_borrows.rs', lines 96:0-96:37 *) let div_i32 (x : i32) (y : i32) : result i32 = i32_div x y -(** [no_nested_borrows::div_i32_const]: forward function +(** [no_nested_borrows::div_i32_const]: Source: 'src/no_nested_borrows.rs', lines 100:0-100:35 *) let div_i32_const (x : i32) : result i32 = i32_div x 2 -(** [no_nested_borrows::rem_i32]: forward function +(** [no_nested_borrows::rem_i32]: Source: 'src/no_nested_borrows.rs', lines 104:0-104:37 *) let rem_i32 (x : i32) (y : i32) : result i32 = i32_rem x y -(** [no_nested_borrows::mul_i32]: forward function +(** [no_nested_borrows::mul_i32]: Source: 'src/no_nested_borrows.rs', lines 108:0-108:37 *) let mul_i32 (x : i32) (y : i32) : result i32 = i32_mul x y -(** [no_nested_borrows::mix_arith_u32]: forward function +(** [no_nested_borrows::mix_arith_u32]: Source: 'src/no_nested_borrows.rs', lines 112:0-112:51 *) let mix_arith_u32 (x : u32) (y : u32) (z : u32) : result u32 = let* i = u32_add x y in - let* i0 = u32_div x y in - let* i1 = u32_mul i i0 in - let* i2 = u32_rem z y in - let* i3 = u32_sub x i2 in - let* i4 = u32_add i1 i3 in - let* i5 = u32_add x y in - let* i6 = u32_add i5 z in - u32_rem i4 i6 - -(** [no_nested_borrows::mix_arith_i32]: forward function + let* i1 = u32_div x y in + let* i2 = u32_mul i i1 in + let* i3 = u32_rem z y in + let* i4 = u32_sub x i3 in + let* i5 = u32_add i2 i4 in + let* i6 = u32_add x y in + let* i7 = u32_add i6 z in + u32_rem i5 i7 + +(** [no_nested_borrows::mix_arith_i32]: Source: 'src/no_nested_borrows.rs', lines 116:0-116:51 *) let mix_arith_i32 (x : i32) (y : i32) (z : i32) : result i32 = let* i = i32_add x y in - let* i0 = i32_div x y in - let* i1 = i32_mul i i0 in - let* i2 = i32_rem z y in - let* i3 = i32_sub x i2 in - let* i4 = i32_add i1 i3 in - let* i5 = i32_add x y in - let* i6 = i32_add i5 z in - i32_rem i4 i6 + let* i1 = i32_div x y in + let* i2 = i32_mul i i1 in + let* i3 = i32_rem z y in + let* i4 = i32_sub x i3 in + let* i5 = i32_add i2 i4 in + let* i6 = i32_add x y in + let* i7 = i32_add i6 z in + i32_rem i5 i7 (** [no_nested_borrows::CONST0] Source: 'src/no_nested_borrows.rs', lines 125:0-125:23 *) @@ -138,22 +138,22 @@ let const0_c : usize = eval_global const0_body let const1_body : result usize = usize_mul 2 2 let const1_c : usize = eval_global const1_body -(** [no_nested_borrows::cast_u32_to_i32]: forward function +(** [no_nested_borrows::cast_u32_to_i32]: Source: 'src/no_nested_borrows.rs', lines 128:0-128:37 *) let cast_u32_to_i32 (x : u32) : result i32 = scalar_cast U32 I32 x -(** [no_nested_borrows::cast_bool_to_i32]: forward function +(** [no_nested_borrows::cast_bool_to_i32]: Source: 'src/no_nested_borrows.rs', lines 132:0-132:39 *) let cast_bool_to_i32 (x : bool) : result i32 = scalar_cast_bool I32 x -(** [no_nested_borrows::cast_bool_to_bool]: forward function +(** [no_nested_borrows::cast_bool_to_bool]: Source: 'src/no_nested_borrows.rs', lines 137:0-137:41 *) let cast_bool_to_bool (x : bool) : result bool = Return x -(** [no_nested_borrows::test2]: forward function +(** [no_nested_borrows::test2]: Source: 'src/no_nested_borrows.rs', lines 142:0-142:14 *) let test2 : result unit = let* _ = u32_add 23 44 in Return () @@ -161,12 +161,12 @@ let test2 : result unit = (** Unit test for [no_nested_borrows::test2] *) let _ = assert_norm (test2 = Return ()) -(** [no_nested_borrows::get_max]: forward function +(** [no_nested_borrows::get_max]: Source: 'src/no_nested_borrows.rs', lines 154:0-154:37 *) let get_max (x : u32) (y : u32) : result u32 = if x >= y then Return x else Return y -(** [no_nested_borrows::test3]: forward function +(** [no_nested_borrows::test3]: Source: 'src/no_nested_borrows.rs', lines 162:0-162:14 *) let test3 : result unit = let* x = get_max 4 3 in @@ -177,7 +177,7 @@ let test3 : result unit = (** Unit test for [no_nested_borrows::test3] *) let _ = assert_norm (test3 = Return ()) -(** [no_nested_borrows::test_neg1]: forward function +(** [no_nested_borrows::test_neg1]: Source: 'src/no_nested_borrows.rs', lines 169:0-169:18 *) let test_neg1 : result unit = let* y = i32_neg 3 in if not (y = -3) then Fail Failure else Return () @@ -185,7 +185,7 @@ let test_neg1 : result unit = (** Unit test for [no_nested_borrows::test_neg1] *) let _ = assert_norm (test_neg1 = Return ()) -(** [no_nested_borrows::refs_test1]: forward function +(** [no_nested_borrows::refs_test1]: Source: 'src/no_nested_borrows.rs', lines 176:0-176:19 *) let refs_test1 : result unit = if not (1 = 1) then Fail Failure else Return () @@ -193,7 +193,7 @@ let refs_test1 : result unit = (** Unit test for [no_nested_borrows::refs_test1] *) let _ = assert_norm (refs_test1 = Return ()) -(** [no_nested_borrows::refs_test2]: forward function +(** [no_nested_borrows::refs_test2]: Source: 'src/no_nested_borrows.rs', lines 187:0-187:19 *) let refs_test2 : result unit = if not (2 = 2) @@ -209,7 +209,7 @@ let refs_test2 : result unit = (** Unit test for [no_nested_borrows::refs_test2] *) let _ = assert_norm (refs_test2 = Return ()) -(** [no_nested_borrows::test_list1]: forward function +(** [no_nested_borrows::test_list1]: Source: 'src/no_nested_borrows.rs', lines 203:0-203:19 *) let test_list1 : result unit = Return () @@ -217,33 +217,34 @@ let test_list1 : result unit = (** Unit test for [no_nested_borrows::test_list1] *) let _ = assert_norm (test_list1 = Return ()) -(** [no_nested_borrows::test_box1]: forward function +(** [no_nested_borrows::test_box1]: Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 *) let test_box1 : result unit = let b = 0 in - let* b0 = alloc_boxed_Box_deref_mut_back i32 b 1 in - let* x = alloc_boxed_Box_deref i32 b0 in + let* (_, deref_mut_back) = alloc_boxed_Box_deref_mut i32 b in + let* b1 = deref_mut_back 1 in + let* x = alloc_boxed_Box_deref i32 b1 in if not (x = 1) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_box1] *) let _ = assert_norm (test_box1 = Return ()) -(** [no_nested_borrows::copy_int]: forward function +(** [no_nested_borrows::copy_int]: Source: 'src/no_nested_borrows.rs', lines 218:0-218:30 *) let copy_int (x : i32) : result i32 = Return x -(** [no_nested_borrows::test_unreachable]: forward function +(** [no_nested_borrows::test_unreachable]: Source: 'src/no_nested_borrows.rs', lines 224:0-224:32 *) let test_unreachable (b : bool) : result unit = if b then Fail Failure else Return () -(** [no_nested_borrows::test_panic]: forward function +(** [no_nested_borrows::test_panic]: Source: 'src/no_nested_borrows.rs', lines 232:0-232:26 *) let test_panic (b : bool) : result unit = if b then Fail Failure else Return () -(** [no_nested_borrows::test_copy_int]: forward function +(** [no_nested_borrows::test_copy_int]: Source: 'src/no_nested_borrows.rs', lines 239:0-239:22 *) let test_copy_int : result unit = let* y = copy_int 0 in if not (0 = y) then Fail Failure else Return () @@ -251,15 +252,15 @@ let test_copy_int : result unit = (** Unit test for [no_nested_borrows::test_copy_int] *) let _ = assert_norm (test_copy_int = Return ()) -(** [no_nested_borrows::is_cons]: forward function +(** [no_nested_borrows::is_cons]: Source: 'src/no_nested_borrows.rs', lines 246:0-246:38 *) let is_cons (t : Type0) (l : list_t t) : result bool = begin match l with - | List_Cons x l0 -> Return true + | List_Cons _ _ -> Return true | List_Nil -> Return false end -(** [no_nested_borrows::test_is_cons]: forward function +(** [no_nested_borrows::test_is_cons]: Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 *) let test_is_cons : result unit = let l = List_Nil in @@ -269,7 +270,7 @@ let test_is_cons : result unit = (** Unit test for [no_nested_borrows::test_is_cons] *) let _ = assert_norm (test_is_cons = Return ()) -(** [no_nested_borrows::split_list]: forward function +(** [no_nested_borrows::split_list]: Source: 'src/no_nested_borrows.rs', lines 259:0-259:48 *) let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = begin match l with @@ -277,7 +278,7 @@ let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = | List_Nil -> Fail Failure end -(** [no_nested_borrows::test_split_list]: forward function +(** [no_nested_borrows::test_split_list]: Source: 'src/no_nested_borrows.rs', lines 267:0-267:24 *) let test_split_list : result unit = let l = List_Nil in @@ -288,26 +289,23 @@ let test_split_list : result unit = (** Unit test for [no_nested_borrows::test_split_list] *) let _ = assert_norm (test_split_list = Return ()) -(** [no_nested_borrows::choose]: forward function +(** [no_nested_borrows::choose]: Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 *) -let choose (t : Type0) (b : bool) (x : t) (y : t) : result t = - if b then Return x else Return y +let choose + (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = + if b + then let back_'a = fun ret -> Return (ret, y) in Return (x, back_'a) + else let back_'a = fun ret -> Return (x, ret) in Return (y, back_'a) -(** [no_nested_borrows::choose]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 *) -let choose_back - (t : Type0) (b : bool) (x : t) (y : t) (ret : t) : result (t & t) = - if b then Return (ret, y) else Return (x, ret) - -(** [no_nested_borrows::choose_test]: forward function +(** [no_nested_borrows::choose_test]: Source: 'src/no_nested_borrows.rs', lines 282:0-282:20 *) let choose_test : result unit = - let* z = choose i32 true 0 0 in - let* z0 = i32_add z 1 in - if not (z0 = 1) + let* (z, choose_back) = choose i32 true 0 0 in + let* z1 = i32_add z 1 in + if not (z1 = 1) then Fail Failure else - let* (x, y) = choose_back i32 true 0 0 z0 in + let* (x, y) = choose_back z1 in if not (x = 1) then Fail Failure else if not (y = 0) then Fail Failure else Return () @@ -315,7 +313,7 @@ let choose_test : result unit = (** Unit test for [no_nested_borrows::choose_test] *) let _ = assert_norm (choose_test = Return ()) -(** [no_nested_borrows::test_char]: forward function +(** [no_nested_borrows::test_char]: Source: 'src/no_nested_borrows.rs', lines 294:0-294:26 *) let test_char : result char = Return 'a' @@ -332,50 +330,47 @@ and nodeElem_t (t : Type0) = | NodeElem_Cons : tree_t t -> nodeElem_t t -> nodeElem_t t | NodeElem_Nil : nodeElem_t t -(** [no_nested_borrows::list_length]: forward function +(** [no_nested_borrows::list_length]: Source: 'src/no_nested_borrows.rs', lines 339:0-339:48 *) let rec list_length (t : Type0) (l : list_t t) : result u32 = begin match l with - | List_Cons x l1 -> let* i = list_length t l1 in u32_add 1 i + | List_Cons _ l1 -> let* i = list_length t l1 in u32_add 1 i | List_Nil -> Return 0 end -(** [no_nested_borrows::list_nth_shared]: forward function +(** [no_nested_borrows::list_nth_shared]: Source: 'src/no_nested_borrows.rs', lines 347:0-347:62 *) let rec list_nth_shared (t : Type0) (l : list_t t) (i : u32) : result t = begin match l with | List_Cons x tl -> if i = 0 then Return x - else let* i0 = u32_sub i 1 in list_nth_shared t tl i0 - | List_Nil -> Fail Failure - end - -(** [no_nested_borrows::list_nth_mut]: forward function - Source: 'src/no_nested_borrows.rs', lines 363:0-363:67 *) -let rec list_nth_mut (t : Type0) (l : list_t t) (i : u32) : result t = - begin match l with - | List_Cons x tl -> - if i = 0 then Return x else let* i0 = u32_sub i 1 in list_nth_mut t tl i0 + else let* i1 = u32_sub i 1 in list_nth_shared t tl i1 | List_Nil -> Fail Failure end -(** [no_nested_borrows::list_nth_mut]: backward function 0 +(** [no_nested_borrows::list_nth_mut]: Source: 'src/no_nested_borrows.rs', lines 363:0-363:67 *) -let rec list_nth_mut_back - (t : Type0) (l : list_t t) (i : u32) (ret : t) : result (list_t t) = +let rec list_nth_mut + (t : Type0) (l : list_t t) (i : u32) : + result (t & (t -> result (list_t t))) + = begin match l with | List_Cons x tl -> if i = 0 - then Return (List_Cons ret tl) + then + let back_'a = fun ret -> Return (List_Cons ret tl) in Return (x, back_'a) else - let* i0 = u32_sub i 1 in - let* tl0 = list_nth_mut_back t tl i0 ret in - Return (List_Cons x tl0) + let* i1 = u32_sub i 1 in + let* (x1, list_nth_mut_back) = list_nth_mut t tl i1 in + let back_'a = + fun ret -> let* tl1 = list_nth_mut_back ret in Return (List_Cons x tl1) + in + Return (x1, back_'a) | List_Nil -> Fail Failure end -(** [no_nested_borrows::list_rev_aux]: forward function +(** [no_nested_borrows::list_rev_aux]: Source: 'src/no_nested_borrows.rs', lines 379:0-379:63 *) let rec list_rev_aux (t : Type0) (li : list_t t) (lo : list_t t) : result (list_t t) = @@ -384,120 +379,105 @@ let rec list_rev_aux | List_Nil -> Return lo end -(** [no_nested_borrows::list_rev]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [no_nested_borrows::list_rev]: Source: 'src/no_nested_borrows.rs', lines 393:0-393:42 *) let list_rev (t : Type0) (l : list_t t) : result (list_t t) = - let li = core_mem_replace (list_t t) l List_Nil in list_rev_aux t li List_Nil + let (li, _) = core_mem_replace (list_t t) l List_Nil in + list_rev_aux t li List_Nil -(** [no_nested_borrows::test_list_functions]: forward function +(** [no_nested_borrows::test_list_functions]: Source: 'src/no_nested_borrows.rs', lines 398:0-398:28 *) let test_list_functions : result unit = let l = List_Nil in - let l0 = List_Cons 2 l in - let l1 = List_Cons 1 l0 in - let* i = list_length i32 (List_Cons 0 l1) in + let l1 = List_Cons 2 l in + let l2 = List_Cons 1 l1 in + let* i = list_length i32 (List_Cons 0 l2) in if not (i = 3) then Fail Failure else - let* i0 = list_nth_shared i32 (List_Cons 0 l1) 0 in - if not (i0 = 0) + let* i1 = list_nth_shared i32 (List_Cons 0 l2) 0 in + if not (i1 = 0) then Fail Failure else - let* i1 = list_nth_shared i32 (List_Cons 0 l1) 1 in - if not (i1 = 1) + let* i2 = list_nth_shared i32 (List_Cons 0 l2) 1 in + if not (i2 = 1) then Fail Failure else - let* i2 = list_nth_shared i32 (List_Cons 0 l1) 2 in - if not (i2 = 2) + let* i3 = list_nth_shared i32 (List_Cons 0 l2) 2 in + if not (i3 = 2) then Fail Failure else - let* ls = list_nth_mut_back i32 (List_Cons 0 l1) 1 3 in - let* i3 = list_nth_shared i32 ls 0 in - if not (i3 = 0) + let* (_, list_nth_mut_back) = list_nth_mut i32 (List_Cons 0 l2) 1 in + let* ls = list_nth_mut_back 3 in + let* i4 = list_nth_shared i32 ls 0 in + if not (i4 = 0) then Fail Failure else - let* i4 = list_nth_shared i32 ls 1 in - if not (i4 = 3) + let* i5 = list_nth_shared i32 ls 1 in + if not (i5 = 3) then Fail Failure else - let* i5 = list_nth_shared i32 ls 2 in - if not (i5 = 2) then Fail Failure else Return () + let* i6 = list_nth_shared i32 ls 2 in + if not (i6 = 2) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_list_functions] *) let _ = assert_norm (test_list_functions = Return ()) -(** [no_nested_borrows::id_mut_pair1]: forward function +(** [no_nested_borrows::id_mut_pair1]: Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 *) -let id_mut_pair1 (t1 t2 : Type0) (x : t1) (y : t2) : result (t1 & t2) = - Return (x, y) - -(** [no_nested_borrows::id_mut_pair1]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 *) -let id_mut_pair1_back - (t1 t2 : Type0) (x : t1) (y : t2) (ret : (t1 & t2)) : result (t1 & t2) = - let (x0, x1) = ret in Return (x0, x1) - -(** [no_nested_borrows::id_mut_pair2]: forward function +let id_mut_pair1 + (t1 t2 : Type0) (x : t1) (y : t2) : + result ((t1 & t2) & ((t1 & t2) -> result (t1 & t2))) + = + let back_'a = fun ret -> let (x1, x2) = ret in Return (x1, x2) in + Return ((x, y), back_'a) + +(** [no_nested_borrows::id_mut_pair2]: Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 *) -let id_mut_pair2 (t1 t2 : Type0) (p : (t1 & t2)) : result (t1 & t2) = - let (x, x0) = p in Return (x, x0) - -(** [no_nested_borrows::id_mut_pair2]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 *) -let id_mut_pair2_back - (t1 t2 : Type0) (p : (t1 & t2)) (ret : (t1 & t2)) : result (t1 & t2) = - let (x, x0) = ret in Return (x, x0) - -(** [no_nested_borrows::id_mut_pair3]: forward function +let id_mut_pair2 + (t1 t2 : Type0) (p : (t1 & t2)) : + result ((t1 & t2) & ((t1 & t2) -> result (t1 & t2))) + = + let (x, x1) = p in + let back_'a = fun ret -> let (x2, x3) = ret in Return (x2, x3) in + Return ((x, x1), back_'a) + +(** [no_nested_borrows::id_mut_pair3]: Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) -let id_mut_pair3 (t1 t2 : Type0) (x : t1) (y : t2) : result (t1 & t2) = - Return (x, y) - -(** [no_nested_borrows::id_mut_pair3]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) -let id_mut_pair3_back'a - (t1 t2 : Type0) (x : t1) (y : t2) (ret : t1) : result t1 = - Return ret - -(** [no_nested_borrows::id_mut_pair3]: backward function 1 - Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) -let id_mut_pair3_back'b - (t1 t2 : Type0) (x : t1) (y : t2) (ret : t2) : result t2 = - Return ret - -(** [no_nested_borrows::id_mut_pair4]: forward function - Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) -let id_mut_pair4 (t1 t2 : Type0) (p : (t1 & t2)) : result (t1 & t2) = - let (x, x0) = p in Return (x, x0) - -(** [no_nested_borrows::id_mut_pair4]: backward function 0 +let id_mut_pair3 + (t1 t2 : Type0) (x : t1) (y : t2) : + result ((t1 & t2) & (t1 -> result t1) & (t2 -> result t2)) + = + let back_'a = fun ret -> Return ret in + let back_'b = fun ret -> Return ret in + Return ((x, y), back_'a, back_'b) + +(** [no_nested_borrows::id_mut_pair4]: Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) -let id_mut_pair4_back'a - (t1 t2 : Type0) (p : (t1 & t2)) (ret : t1) : result t1 = - Return ret - -(** [no_nested_borrows::id_mut_pair4]: backward function 1 - Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) -let id_mut_pair4_back'b - (t1 t2 : Type0) (p : (t1 & t2)) (ret : t2) : result t2 = - Return ret +let id_mut_pair4 + (t1 t2 : Type0) (p : (t1 & t2)) : + result ((t1 & t2) & (t1 -> result t1) & (t2 -> result t2)) + = + let (x, x1) = p in + let back_'a = fun ret -> Return ret in + let back_'b = fun ret -> Return ret in + Return ((x, x1), back_'a, back_'b) (** [no_nested_borrows::StructWithTuple] Source: 'src/no_nested_borrows.rs', lines 433:0-433:34 *) type structWithTuple_t (t1 t2 : Type0) = { p : (t1 & t2); } -(** [no_nested_borrows::new_tuple1]: forward function +(** [no_nested_borrows::new_tuple1]: Source: 'src/no_nested_borrows.rs', lines 437:0-437:48 *) let new_tuple1 : result (structWithTuple_t u32 u32) = Return { p = (1, 2) } -(** [no_nested_borrows::new_tuple2]: forward function +(** [no_nested_borrows::new_tuple2]: Source: 'src/no_nested_borrows.rs', lines 441:0-441:48 *) let new_tuple2 : result (structWithTuple_t i16 i16) = Return { p = (1, 2) } -(** [no_nested_borrows::new_tuple3]: forward function +(** [no_nested_borrows::new_tuple3]: Source: 'src/no_nested_borrows.rs', lines 445:0-445:48 *) let new_tuple3 : result (structWithTuple_t u64 i64) = Return { p = (1, 2) } @@ -506,12 +486,12 @@ let new_tuple3 : result (structWithTuple_t u64 i64) = Source: 'src/no_nested_borrows.rs', lines 450:0-450:33 *) type structWithPair_t (t1 t2 : Type0) = { p : pair_t t1 t2; } -(** [no_nested_borrows::new_pair1]: forward function +(** [no_nested_borrows::new_pair1]: Source: 'src/no_nested_borrows.rs', lines 454:0-454:46 *) let new_pair1 : result (structWithPair_t u32 u32) = Return { p = { x = 1; y = 2 } } -(** [no_nested_borrows::test_constants]: forward function +(** [no_nested_borrows::test_constants]: Source: 'src/no_nested_borrows.rs', lines 462:0-462:23 *) let test_constants : result unit = let* swt = new_tuple1 in @@ -519,14 +499,14 @@ let test_constants : result unit = if not (i = 1) then Fail Failure else - let* swt0 = new_tuple2 in - let (i0, _) = swt0.p in - if not (i0 = 1) + let* swt1 = new_tuple2 in + let (i1, _) = swt1.p in + if not (i1 = 1) then Fail Failure else - let* swt1 = new_tuple3 in - let (i1, _) = swt1.p in - if not (i1 = 1) + let* swt2 = new_tuple3 in + let (i2, _) = swt2.p in + if not (i2 = 1) then Fail Failure else let* swp = new_pair1 in @@ -535,7 +515,7 @@ let test_constants : result unit = (** Unit test for [no_nested_borrows::test_constants] *) let _ = assert_norm (test_constants = Return ()) -(** [no_nested_borrows::test_weird_borrows1]: forward function +(** [no_nested_borrows::test_weird_borrows1]: Source: 'src/no_nested_borrows.rs', lines 471:0-471:28 *) let test_weird_borrows1 : result unit = Return () @@ -543,59 +523,72 @@ let test_weird_borrows1 : result unit = (** Unit test for [no_nested_borrows::test_weird_borrows1] *) let _ = assert_norm (test_weird_borrows1 = Return ()) -(** [no_nested_borrows::test_mem_replace]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [no_nested_borrows::test_mem_replace]: Source: 'src/no_nested_borrows.rs', lines 481:0-481:37 *) let test_mem_replace (px : u32) : result u32 = - let y = core_mem_replace u32 px 1 in + let (y, _) = core_mem_replace u32 px 1 in if not (y = 0) then Fail Failure else Return 2 -(** [no_nested_borrows::test_shared_borrow_bool1]: forward function +(** [no_nested_borrows::test_shared_borrow_bool1]: Source: 'src/no_nested_borrows.rs', lines 488:0-488:47 *) let test_shared_borrow_bool1 (b : bool) : result u32 = if b then Return 0 else Return 1 -(** [no_nested_borrows::test_shared_borrow_bool2]: forward function +(** [no_nested_borrows::test_shared_borrow_bool2]: Source: 'src/no_nested_borrows.rs', lines 501:0-501:40 *) let test_shared_borrow_bool2 : result u32 = Return 0 -(** [no_nested_borrows::test_shared_borrow_enum1]: forward function +(** [no_nested_borrows::test_shared_borrow_enum1]: Source: 'src/no_nested_borrows.rs', lines 516:0-516:52 *) let test_shared_borrow_enum1 (l : list_t u32) : result u32 = - begin match l with | List_Cons i l0 -> Return 1 | List_Nil -> Return 0 end + begin match l with | List_Cons _ _ -> Return 1 | List_Nil -> Return 0 end -(** [no_nested_borrows::test_shared_borrow_enum2]: forward function +(** [no_nested_borrows::test_shared_borrow_enum2]: Source: 'src/no_nested_borrows.rs', lines 528:0-528:40 *) let test_shared_borrow_enum2 : result u32 = Return 0 -(** [no_nested_borrows::Tuple] +(** [no_nested_borrows::incr]: Source: 'src/no_nested_borrows.rs', lines 539:0-539:24 *) +let incr (x : u32) : result u32 = + u32_add x 1 + +(** [no_nested_borrows::call_incr]: + Source: 'src/no_nested_borrows.rs', lines 543:0-543:35 *) +let call_incr (x : u32) : result u32 = + incr x + +(** [no_nested_borrows::read_then_incr]: + Source: 'src/no_nested_borrows.rs', lines 548:0-548:41 *) +let read_then_incr (x : u32) : result (u32 & u32) = + let* x1 = u32_add x 1 in Return (x, x1) + +(** [no_nested_borrows::Tuple] + Source: 'src/no_nested_borrows.rs', lines 554:0-554:24 *) type tuple_t (t1 t2 : Type0) = t1 * t2 -(** [no_nested_borrows::use_tuple_struct]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) - Source: 'src/no_nested_borrows.rs', lines 541:0-541:48 *) +(** [no_nested_borrows::use_tuple_struct]: + Source: 'src/no_nested_borrows.rs', lines 556:0-556:48 *) let use_tuple_struct (x : tuple_t u32 u32) : result (tuple_t u32 u32) = let (_, i) = x in Return (1, i) -(** [no_nested_borrows::create_tuple_struct]: forward function - Source: 'src/no_nested_borrows.rs', lines 545:0-545:61 *) +(** [no_nested_borrows::create_tuple_struct]: + Source: 'src/no_nested_borrows.rs', lines 560:0-560:61 *) let create_tuple_struct (x : u32) (y : u64) : result (tuple_t u32 u64) = Return (x, y) (** [no_nested_borrows::IdType] - Source: 'src/no_nested_borrows.rs', lines 550:0-550:20 *) + Source: 'src/no_nested_borrows.rs', lines 565:0-565:20 *) type idType_t (t : Type0) = t -(** [no_nested_borrows::use_id_type]: forward function - Source: 'src/no_nested_borrows.rs', lines 552:0-552:40 *) +(** [no_nested_borrows::use_id_type]: + Source: 'src/no_nested_borrows.rs', lines 567:0-567:40 *) let use_id_type (t : Type0) (x : idType_t t) : result t = Return x -(** [no_nested_borrows::create_id_type]: forward function - Source: 'src/no_nested_borrows.rs', lines 556:0-556:43 *) +(** [no_nested_borrows::create_id_type]: + Source: 'src/no_nested_borrows.rs', lines 571:0-571:43 *) let create_id_type (t : Type0) (x : t) : result (idType_t t) = Return x diff --git a/tests/fstar/misc/Primitives.fst b/tests/fstar/misc/Primitives.fst index a3ffbde4..6b8dbeb7 100644 --- a/tests/fstar/misc/Primitives.fst +++ b/tests/fstar/misc/Primitives.fst @@ -55,8 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a = x -let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a & (a -> a) = (x, (fun x -> x)) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -477,8 +476,7 @@ noeq type core_ops_index_Index (self idx : Type0) = { // Trait declaration: [core::ops::index::IndexMut] noeq type core_ops_index_IndexMut (self idx : Type0) = { indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result indexInst.output; - index_mut_back : self → idx → indexInst.output → result self; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); } // Trait declaration [core::ops::deref::Deref] @@ -490,8 +488,7 @@ noeq type core_ops_deref_Deref (self : Type0) = { // Trait declaration [core::ops::deref::DerefMut] noeq type core_ops_deref_DerefMut (self : Type0) = { derefInst : core_ops_deref_Deref self; - deref_mut : self → result derefInst.target; - deref_mut_back : self → derefInst.target → result self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); } type core_ops_range_Range (a : Type0) = { @@ -502,8 +499,8 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = + Return (x, (fun x -> Return x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -515,7 +512,6 @@ let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { derefInst = alloc_boxed_Box_coreopsDerefInst self; deref_mut = alloc_boxed_Box_deref_mut self; - deref_mut_back = alloc_boxed_Box_deref_mut_back self; } (*** Array *) @@ -588,8 +584,13 @@ let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : r let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : + result (a & (a → result (alloc_vec_Vec a))) = + match alloc_vec_Vec_index_usize v i with + | Return x -> + Return (x, alloc_vec_Vec_update_usize v i) + | Fail e -> Fail e + let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : Pure (result (alloc_vec_Vec a)) (requires True) @@ -605,9 +606,6 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : end else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure @@ -619,13 +617,11 @@ noeq type core_slice_index_SliceIndex (self t : Type0) = { sealedInst : core_slice_index_private_slice_index_Sealed self; output : Type0; get : self → t → result (option output); - get_mut : self → t → result (option output); - get_mut_back : self → t → option output → result t; + get_mut : self → t → result (option output & (option output -> result t)); get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); index : self → t → result output; - index_mut : self → t → result output; - index_mut_back : self → t → output → result t; + index_mut : self → t → result (output & (output -> result t)); } // [core::slice::index::[T]::index]: forward function @@ -643,14 +639,8 @@ let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) admit () // TODO // [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_RangeUsize_get_mut_back - (t : Type0) : - core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = admit () // TODO // [core::slice::index::Range::get_unchecked]: forward function @@ -675,27 +665,16 @@ let core_slice_index_RangeUsize_index admit () // TODO // [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_RangeUsize_index_mut_back - (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = admit () // TODO // [core::slice::index::[T]::index_mut]: forward function let core_slice_index_Slice_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result inst.output = + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = admit () // -// [core::slice::index::[T]::index_mut]: backward function 0 -let core_slice_index_Slice_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → inst.output → result (slice t) = - admit () // TODO - // [core::array::[T; N]::index]: forward function let core_array_Array_index (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) @@ -705,13 +684,8 @@ let core_array_Array_index // [core::array::[T; N]::index_mut]: forward function let core_array_Array_index_mut (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : result inst.indexInst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: backward function 0 -let core_array_Array_index_mut_back - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::Range] @@ -725,12 +699,10 @@ let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : output = slice t; get = core_slice_index_RangeUsize_get t; get_mut = core_slice_index_RangeUsize_get_mut t; - get_mut_back = core_slice_index_RangeUsize_get_mut_back t; get_unchecked = core_slice_index_RangeUsize_get_unchecked t; get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; index = core_slice_index_RangeUsize_index t; index_mut = core_slice_index_RangeUsize_index_mut t; - index_mut_back = core_slice_index_RangeUsize_index_mut_back t; } // Trait implementation: [core::slice::index::[T]] @@ -747,7 +719,6 @@ let core_ops_index_IndexMutSliceTIInst (t idx : Type0) core_ops_index_IndexMut (slice t) idx = { indexInst = core_ops_index_IndexSliceTIInst t idx inst; index_mut = core_slice_index_Slice_index_mut t idx inst; - index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; } // Trait implementation: [core::array::[T; N]] @@ -764,7 +735,6 @@ let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) core_ops_index_IndexMut (array t n) idx = { indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; index_mut = core_array_Array_index_mut t idx n inst; - index_mut_back = core_array_Array_index_mut_back t idx n inst; } // [core::slice::index::usize::get]: forward function @@ -773,13 +743,8 @@ let core_slice_index_usize_get admit () // TODO // [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: backward function 0 -let core_slice_index_usize_get_mut_back - (t : Type0) : usize → slice t → option t → result (slice t) = +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = admit () // TODO // [core::slice::index::usize::get_unchecked]: forward function @@ -797,12 +762,8 @@ let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = admit () // TODO // [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: backward function 0 -let core_slice_index_usize_index_mut_back - (t : Type0) : usize → slice t → t → result (slice t) = +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::usize] @@ -816,12 +777,10 @@ let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : output = t; get = core_slice_index_usize_get t; get_mut = core_slice_index_usize_get_mut t; - get_mut_back = core_slice_index_usize_get_mut_back t; get_unchecked = core_slice_index_usize_get_unchecked t; get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; index = core_slice_index_usize_index t; index_mut = core_slice_index_usize_index_mut t; - index_mut_back = core_slice_index_usize_index_mut_back t; } // [alloc::vec::Vec::index]: forward function @@ -831,13 +790,8 @@ let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx // [alloc::vec::Vec::index_mut]: forward function let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: backward function 0 -let alloc_vec_Vec_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = admit () // TODO // Trait implementation: [alloc::vec::Vec] @@ -854,7 +808,6 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) core_ops_index_IndexMut (alloc_vec_Vec t) idx = { indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; index_mut = alloc_vec_Vec_index_mut t idx inst; - index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } (*** Theorems *) @@ -870,15 +823,7 @@ let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : Lemma ( alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) + alloc_vec_Vec_index_mut_usize v i) [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] = admit() - -let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : - Lemma ( - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == - alloc_vec_Vec_update_usize v i x) - [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] - = - admit() diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index 0bce3a64..cb0aac10 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -43,98 +43,98 @@ inductive Sum (T1 T2 : Type) := | Left : T1 → Sum T1 T2 | Right : T2 → Sum T1 T2 -/- [no_nested_borrows::neg_test]: forward function +/- [no_nested_borrows::neg_test]: Source: 'src/no_nested_borrows.rs', lines 48:0-48:30 -/ def neg_test (x : I32) : Result I32 := - x -/- [no_nested_borrows::add_u32]: forward function +/- [no_nested_borrows::add_u32]: Source: 'src/no_nested_borrows.rs', lines 54:0-54:37 -/ def add_u32 (x : U32) (y : U32) : Result U32 := x + y -/- [no_nested_borrows::subs_u32]: forward function +/- [no_nested_borrows::subs_u32]: Source: 'src/no_nested_borrows.rs', lines 60:0-60:38 -/ def subs_u32 (x : U32) (y : U32) : Result U32 := x - y -/- [no_nested_borrows::div_u32]: forward function +/- [no_nested_borrows::div_u32]: Source: 'src/no_nested_borrows.rs', lines 66:0-66:37 -/ def div_u32 (x : U32) (y : U32) : Result U32 := x / y -/- [no_nested_borrows::div_u32_const]: forward function +/- [no_nested_borrows::div_u32_const]: Source: 'src/no_nested_borrows.rs', lines 73:0-73:35 -/ def div_u32_const (x : U32) : Result U32 := x / 2#u32 -/- [no_nested_borrows::rem_u32]: forward function +/- [no_nested_borrows::rem_u32]: Source: 'src/no_nested_borrows.rs', lines 78:0-78:37 -/ def rem_u32 (x : U32) (y : U32) : Result U32 := x % y -/- [no_nested_borrows::mul_u32]: forward function +/- [no_nested_borrows::mul_u32]: Source: 'src/no_nested_borrows.rs', lines 82:0-82:37 -/ def mul_u32 (x : U32) (y : U32) : Result U32 := x * y -/- [no_nested_borrows::add_i32]: forward function +/- [no_nested_borrows::add_i32]: Source: 'src/no_nested_borrows.rs', lines 88:0-88:37 -/ def add_i32 (x : I32) (y : I32) : Result I32 := x + y -/- [no_nested_borrows::subs_i32]: forward function +/- [no_nested_borrows::subs_i32]: Source: 'src/no_nested_borrows.rs', lines 92:0-92:38 -/ def subs_i32 (x : I32) (y : I32) : Result I32 := x - y -/- [no_nested_borrows::div_i32]: forward function +/- [no_nested_borrows::div_i32]: Source: 'src/no_nested_borrows.rs', lines 96:0-96:37 -/ def div_i32 (x : I32) (y : I32) : Result I32 := x / y -/- [no_nested_borrows::div_i32_const]: forward function +/- [no_nested_borrows::div_i32_const]: Source: 'src/no_nested_borrows.rs', lines 100:0-100:35 -/ def div_i32_const (x : I32) : Result I32 := x / 2#i32 -/- [no_nested_borrows::rem_i32]: forward function +/- [no_nested_borrows::rem_i32]: Source: 'src/no_nested_borrows.rs', lines 104:0-104:37 -/ def rem_i32 (x : I32) (y : I32) : Result I32 := x % y -/- [no_nested_borrows::mul_i32]: forward function +/- [no_nested_borrows::mul_i32]: Source: 'src/no_nested_borrows.rs', lines 108:0-108:37 -/ def mul_i32 (x : I32) (y : I32) : Result I32 := x * y -/- [no_nested_borrows::mix_arith_u32]: forward function +/- [no_nested_borrows::mix_arith_u32]: Source: 'src/no_nested_borrows.rs', lines 112:0-112:51 -/ def mix_arith_u32 (x : U32) (y : U32) (z : U32) : Result U32 := do - let i ← x + y - let i0 ← x / y - let i1 ← i * i0 - let i2 ← z % y - let i3 ← x - i2 - let i4 ← i1 + i3 - let i5 ← x + y - let i6 ← i5 + z - i4 % i6 - -/- [no_nested_borrows::mix_arith_i32]: forward function + let i ← x + y + let i1 ← x / y + let i2 ← i * i1 + let i3 ← z % y + let i4 ← x - i3 + let i5 ← i2 + i4 + let i6 ← x + y + let i7 ← i6 + z + i5 % i7 + +/- [no_nested_borrows::mix_arith_i32]: Source: 'src/no_nested_borrows.rs', lines 116:0-116:51 -/ def mix_arith_i32 (x : I32) (y : I32) (z : I32) : Result I32 := do - let i ← x + y - let i0 ← x / y - let i1 ← i * i0 - let i2 ← z % y - let i3 ← x - i2 - let i4 ← i1 + i3 - let i5 ← x + y - let i6 ← i5 + z - i4 % i6 + let i ← x + y + let i1 ← x / y + let i2 ← i * i1 + let i3 ← z % y + let i4 ← x - i3 + let i5 ← i2 + i4 + let i6 ← x + y + let i7 ← i6 + z + i5 % i7 /- [no_nested_borrows::CONST0] Source: 'src/no_nested_borrows.rs', lines 125:0-125:23 -/ @@ -146,65 +146,65 @@ def const0_c : Usize := eval_global const0_body (by simp) def const1_body : Result Usize := 2#usize * 2#usize def const1_c : Usize := eval_global const1_body (by simp) -/- [no_nested_borrows::cast_u32_to_i32]: forward function +/- [no_nested_borrows::cast_u32_to_i32]: Source: 'src/no_nested_borrows.rs', lines 128:0-128:37 -/ def cast_u32_to_i32 (x : U32) : Result I32 := Scalar.cast .I32 x -/- [no_nested_borrows::cast_bool_to_i32]: forward function +/- [no_nested_borrows::cast_bool_to_i32]: Source: 'src/no_nested_borrows.rs', lines 132:0-132:39 -/ def cast_bool_to_i32 (x : Bool) : Result I32 := Scalar.cast_bool .I32 x -/- [no_nested_borrows::cast_bool_to_bool]: forward function +/- [no_nested_borrows::cast_bool_to_bool]: Source: 'src/no_nested_borrows.rs', lines 137:0-137:41 -/ def cast_bool_to_bool (x : Bool) : Result Bool := Result.ret x -/- [no_nested_borrows::test2]: forward function +/- [no_nested_borrows::test2]: Source: 'src/no_nested_borrows.rs', lines 142:0-142:14 -/ def test2 : Result Unit := do - let _ ← 23#u32 + 44#u32 - Result.ret () + let _ ← 23#u32 + 44#u32 + Result.ret () /- Unit test for [no_nested_borrows::test2] -/ #assert (test2 == Result.ret ()) -/- [no_nested_borrows::get_max]: forward function +/- [no_nested_borrows::get_max]: Source: 'src/no_nested_borrows.rs', lines 154:0-154:37 -/ def get_max (x : U32) (y : U32) : Result U32 := if x >= y then Result.ret x else Result.ret y -/- [no_nested_borrows::test3]: forward function +/- [no_nested_borrows::test3]: Source: 'src/no_nested_borrows.rs', lines 162:0-162:14 -/ def test3 : Result Unit := do - let x ← get_max 4#u32 3#u32 - let y ← get_max 10#u32 11#u32 - let z ← x + y - if not (z = 15#u32) - then Result.fail .panic - else Result.ret () + let x ← get_max 4#u32 3#u32 + let y ← get_max 10#u32 11#u32 + let z ← x + y + if not (z = 15#u32) + then Result.fail .panic + else Result.ret () /- Unit test for [no_nested_borrows::test3] -/ #assert (test3 == Result.ret ()) -/- [no_nested_borrows::test_neg1]: forward function +/- [no_nested_borrows::test_neg1]: Source: 'src/no_nested_borrows.rs', lines 169:0-169:18 -/ def test_neg1 : Result Unit := do - let y ← - 3#i32 - if not (y = (-(3:Int))#i32) - then Result.fail .panic - else Result.ret () + let y ← - 3#i32 + if not (y = (-(3:Int))#i32) + then Result.fail .panic + else Result.ret () /- Unit test for [no_nested_borrows::test_neg1] -/ #assert (test_neg1 == Result.ret ()) -/- [no_nested_borrows::refs_test1]: forward function +/- [no_nested_borrows::refs_test1]: Source: 'src/no_nested_borrows.rs', lines 176:0-176:19 -/ def refs_test1 : Result Unit := if not (1#i32 = 1#i32) @@ -214,7 +214,7 @@ def refs_test1 : Result Unit := /- Unit test for [no_nested_borrows::refs_test1] -/ #assert (refs_test1 == Result.ret ()) -/- [no_nested_borrows::refs_test2]: forward function +/- [no_nested_borrows::refs_test2]: Source: 'src/no_nested_borrows.rs', lines 187:0-187:19 -/ def refs_test2 : Result Unit := if not (2#i32 = 2#i32) @@ -232,7 +232,7 @@ def refs_test2 : Result Unit := /- Unit test for [no_nested_borrows::refs_test2] -/ #assert (refs_test2 == Result.ret ()) -/- [no_nested_borrows::test_list1]: forward function +/- [no_nested_borrows::test_list1]: Source: 'src/no_nested_borrows.rs', lines 203:0-203:19 -/ def test_list1 : Result Unit := Result.ret () @@ -240,128 +240,126 @@ def test_list1 : Result Unit := /- Unit test for [no_nested_borrows::test_list1] -/ #assert (test_list1 == Result.ret ()) -/- [no_nested_borrows::test_box1]: forward function +/- [no_nested_borrows::test_box1]: Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 -/ def test_box1 : Result Unit := do - let b := 0#i32 - let b0 ← alloc.boxed.Box.deref_mut_back I32 b 1#i32 - let x ← alloc.boxed.Box.deref I32 b0 - if not (x = 1#i32) - then Result.fail .panic - else Result.ret () + let b := 0#i32 + let (_, deref_mut_back) ← alloc.boxed.Box.deref_mut I32 b + let b1 ← deref_mut_back 1#i32 + let x ← alloc.boxed.Box.deref I32 b1 + if not (x = 1#i32) + then Result.fail .panic + else Result.ret () /- Unit test for [no_nested_borrows::test_box1] -/ #assert (test_box1 == Result.ret ()) -/- [no_nested_borrows::copy_int]: forward function +/- [no_nested_borrows::copy_int]: Source: 'src/no_nested_borrows.rs', lines 218:0-218:30 -/ def copy_int (x : I32) : Result I32 := Result.ret x -/- [no_nested_borrows::test_unreachable]: forward function +/- [no_nested_borrows::test_unreachable]: Source: 'src/no_nested_borrows.rs', lines 224:0-224:32 -/ def test_unreachable (b : Bool) : Result Unit := if b then Result.fail .panic else Result.ret () -/- [no_nested_borrows::test_panic]: forward function +/- [no_nested_borrows::test_panic]: Source: 'src/no_nested_borrows.rs', lines 232:0-232:26 -/ def test_panic (b : Bool) : Result Unit := if b then Result.fail .panic else Result.ret () -/- [no_nested_borrows::test_copy_int]: forward function +/- [no_nested_borrows::test_copy_int]: Source: 'src/no_nested_borrows.rs', lines 239:0-239:22 -/ def test_copy_int : Result Unit := do - let y ← copy_int 0#i32 - if not (0#i32 = y) - then Result.fail .panic - else Result.ret () + let y ← copy_int 0#i32 + if not (0#i32 = y) + then Result.fail .panic + else Result.ret () /- Unit test for [no_nested_borrows::test_copy_int] -/ #assert (test_copy_int == Result.ret ()) -/- [no_nested_borrows::is_cons]: forward function +/- [no_nested_borrows::is_cons]: Source: 'src/no_nested_borrows.rs', lines 246:0-246:38 -/ def is_cons (T : Type) (l : List T) : Result Bool := match l with - | List.Cons t l0 => Result.ret true + | List.Cons _ _ => Result.ret true | List.Nil => Result.ret false -/- [no_nested_borrows::test_is_cons]: forward function +/- [no_nested_borrows::test_is_cons]: Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 -/ def test_is_cons : Result Unit := do - let l := List.Nil - let b ← is_cons I32 (List.Cons 0#i32 l) - if not b - then Result.fail .panic - else Result.ret () + let l := List.Nil + let b ← is_cons I32 (List.Cons 0#i32 l) + if not b + then Result.fail .panic + else Result.ret () /- Unit test for [no_nested_borrows::test_is_cons] -/ #assert (test_is_cons == Result.ret ()) -/- [no_nested_borrows::split_list]: forward function +/- [no_nested_borrows::split_list]: Source: 'src/no_nested_borrows.rs', lines 259:0-259:48 -/ def split_list (T : Type) (l : List T) : Result (T × (List T)) := match l with | List.Cons hd tl => Result.ret (hd, tl) | List.Nil => Result.fail .panic -/- [no_nested_borrows::test_split_list]: forward function +/- [no_nested_borrows::test_split_list]: Source: 'src/no_nested_borrows.rs', lines 267:0-267:24 -/ def test_split_list : Result Unit := do - let l := List.Nil - let p ← split_list I32 (List.Cons 0#i32 l) - let (hd, _) := p - if not (hd = 0#i32) - then Result.fail .panic - else Result.ret () + let l := List.Nil + let p ← split_list I32 (List.Cons 0#i32 l) + let (hd, _) := p + if not (hd = 0#i32) + then Result.fail .panic + else Result.ret () /- Unit test for [no_nested_borrows::test_split_list] -/ #assert (test_split_list == Result.ret ()) -/- [no_nested_borrows::choose]: forward function +/- [no_nested_borrows::choose]: Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 -/ -def choose (T : Type) (b : Bool) (x : T) (y : T) : Result T := +def choose + (T : Type) (b : Bool) (x : T) (y : T) : + Result (T × (T → Result (T × T))) + := if b - then Result.ret x - else Result.ret y + then let back_'a := fun ret => Result.ret (ret, y) + Result.ret (x, back_'a) + else let back_'a := fun ret => Result.ret (x, ret) + Result.ret (y, back_'a) -/- [no_nested_borrows::choose]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 -/ -def choose_back - (T : Type) (b : Bool) (x : T) (y : T) (ret : T) : Result (T × T) := - if b - then Result.ret (ret, y) - else Result.ret (x, ret) - -/- [no_nested_borrows::choose_test]: forward function +/- [no_nested_borrows::choose_test]: Source: 'src/no_nested_borrows.rs', lines 282:0-282:20 -/ def choose_test : Result Unit := do - let z ← choose I32 true 0#i32 0#i32 - let z0 ← z + 1#i32 - if not (z0 = 1#i32) + let (z, choose_back) ← choose I32 true 0#i32 0#i32 + let z1 ← z + 1#i32 + if not (z1 = 1#i32) + then Result.fail .panic + else + do + let (x, y) ← choose_back z1 + if not (x = 1#i32) then Result.fail .panic - else - do - let (x, y) ← choose_back I32 true 0#i32 0#i32 z0 - if not (x = 1#i32) - then Result.fail .panic - else if not (y = 0#i32) - then Result.fail .panic - else Result.ret () + else if not (y = 0#i32) + then Result.fail .panic + else Result.ret () /- Unit test for [no_nested_borrows::choose_test] -/ #assert (choose_test == Result.ret ()) -/- [no_nested_borrows::test_char]: forward function +/- [no_nested_borrows::test_char]: Source: 'src/no_nested_borrows.rs', lines 294:0-294:26 -/ def test_char : Result Char := Result.ret 'a' @@ -382,16 +380,16 @@ inductive NodeElem (T : Type) := end -/- [no_nested_borrows::list_length]: forward function +/- [no_nested_borrows::list_length]: Source: 'src/no_nested_borrows.rs', lines 339:0-339:48 -/ divergent def list_length (T : Type) (l : List T) : Result U32 := match l with - | List.Cons t l1 => do - let i ← list_length T l1 - 1#u32 + i + | List.Cons _ l1 => do + let i ← list_length T l1 + 1#u32 + i | List.Nil => Result.ret 0#u32 -/- [no_nested_borrows::list_nth_shared]: forward function +/- [no_nested_borrows::list_nth_shared]: Source: 'src/no_nested_borrows.rs', lines 347:0-347:62 -/ divergent def list_nth_shared (T : Type) (l : List T) (i : U32) : Result T := match l with @@ -399,38 +397,33 @@ divergent def list_nth_shared (T : Type) (l : List T) (i : U32) : Result T := if i = 0#u32 then Result.ret x else do - let i0 ← i - 1#u32 - list_nth_shared T tl i0 - | List.Nil => Result.fail .panic - -/- [no_nested_borrows::list_nth_mut]: forward function - Source: 'src/no_nested_borrows.rs', lines 363:0-363:67 -/ -divergent def list_nth_mut (T : Type) (l : List T) (i : U32) : Result T := - match l with - | List.Cons x tl => - if i = 0#u32 - then Result.ret x - else do - let i0 ← i - 1#u32 - list_nth_mut T tl i0 + let i1 ← i - 1#u32 + list_nth_shared T tl i1 | List.Nil => Result.fail .panic -/- [no_nested_borrows::list_nth_mut]: backward function 0 +/- [no_nested_borrows::list_nth_mut]: Source: 'src/no_nested_borrows.rs', lines 363:0-363:67 -/ -divergent def list_nth_mut_back - (T : Type) (l : List T) (i : U32) (ret : T) : Result (List T) := +divergent def list_nth_mut + (T : Type) (l : List T) (i : U32) : Result (T × (T → Result (List T))) := match l with | List.Cons x tl => if i = 0#u32 - then Result.ret (List.Cons ret tl) + then + let back_'a := fun ret => Result.ret (List.Cons ret tl) + Result.ret (x, back_'a) else do - let i0 ← i - 1#u32 - let tl0 ← list_nth_mut_back T tl i0 ret - Result.ret (List.Cons x tl0) + let i1 ← i - 1#u32 + let (t, list_nth_mut_back) ← list_nth_mut T tl i1 + let back_'a := + fun ret => + do + let tl1 ← list_nth_mut_back ret + Result.ret (List.Cons x tl1) + Result.ret (t, back_'a) | List.Nil => Result.fail .panic -/- [no_nested_borrows::list_rev_aux]: forward function +/- [no_nested_borrows::list_rev_aux]: Source: 'src/no_nested_borrows.rs', lines 379:0-379:63 -/ divergent def list_rev_aux (T : Type) (li : List T) (lo : List T) : Result (List T) := @@ -438,136 +431,118 @@ divergent def list_rev_aux | List.Cons hd tl => list_rev_aux T tl (List.Cons hd lo) | List.Nil => Result.ret lo -/- [no_nested_borrows::list_rev]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [no_nested_borrows::list_rev]: Source: 'src/no_nested_borrows.rs', lines 393:0-393:42 -/ def list_rev (T : Type) (l : List T) : Result (List T) := - let li := core.mem.replace (List T) l List.Nil + let (li, _) := core.mem.replace (List T) l List.Nil list_rev_aux T li List.Nil -/- [no_nested_borrows::test_list_functions]: forward function +/- [no_nested_borrows::test_list_functions]: Source: 'src/no_nested_borrows.rs', lines 398:0-398:28 -/ def test_list_functions : Result Unit := do - let l := List.Nil - let l0 := List.Cons 2#i32 l - let l1 := List.Cons 1#i32 l0 - let i ← list_length I32 (List.Cons 0#i32 l1) - if not (i = 3#u32) + let l := List.Nil + let l1 := List.Cons 2#i32 l + let l2 := List.Cons 1#i32 l1 + let i ← list_length I32 (List.Cons 0#i32 l2) + if not (i = 3#u32) + then Result.fail .panic + else + do + let i1 ← list_nth_shared I32 (List.Cons 0#i32 l2) 0#u32 + if not (i1 = 0#i32) then Result.fail .panic else do - let i0 ← list_nth_shared I32 (List.Cons 0#i32 l1) 0#u32 - if not (i0 = 0#i32) + let i2 ← list_nth_shared I32 (List.Cons 0#i32 l2) 1#u32 + if not (i2 = 1#i32) + then Result.fail .panic + else + do + let i3 ← list_nth_shared I32 (List.Cons 0#i32 l2) 2#u32 + if not (i3 = 2#i32) then Result.fail .panic else do - let i1 ← list_nth_shared I32 (List.Cons 0#i32 l1) 1#u32 - if not (i1 = 1#i32) + let (_, list_nth_mut_back) ← + list_nth_mut I32 (List.Cons 0#i32 l2) 1#u32 + let ls ← list_nth_mut_back 3#i32 + let i4 ← list_nth_shared I32 ls 0#u32 + if not (i4 = 0#i32) + then Result.fail .panic + else + do + let i5 ← list_nth_shared I32 ls 1#u32 + if not (i5 = 3#i32) then Result.fail .panic else do - let i2 ← list_nth_shared I32 (List.Cons 0#i32 l1) 2#u32 - if not (i2 = 2#i32) - then Result.fail .panic - else - do - let ls ← - list_nth_mut_back I32 (List.Cons 0#i32 l1) 1#u32 3#i32 - let i3 ← list_nth_shared I32 ls 0#u32 - if not (i3 = 0#i32) - then Result.fail .panic - else - do - let i4 ← list_nth_shared I32 ls 1#u32 - if not (i4 = 3#i32) - then Result.fail .panic - else - do - let i5 ← list_nth_shared I32 ls 2#u32 - if not (i5 = 2#i32) - then Result.fail .panic - else Result.ret () + let i6 ← list_nth_shared I32 ls 2#u32 + if not (i6 = 2#i32) + then Result.fail .panic + else Result.ret () /- Unit test for [no_nested_borrows::test_list_functions] -/ #assert (test_list_functions == Result.ret ()) -/- [no_nested_borrows::id_mut_pair1]: forward function +/- [no_nested_borrows::id_mut_pair1]: Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 -/ -def id_mut_pair1 (T1 T2 : Type) (x : T1) (y : T2) : Result (T1 × T2) := - Result.ret (x, y) - -/- [no_nested_borrows::id_mut_pair1]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 -/ -def id_mut_pair1_back - (T1 T2 : Type) (x : T1) (y : T2) (ret : (T1 × T2)) : Result (T1 × T2) := - let (t, t0) := ret - Result.ret (t, t0) - -/- [no_nested_borrows::id_mut_pair2]: forward function +def id_mut_pair1 + (T1 T2 : Type) (x : T1) (y : T2) : + Result ((T1 × T2) × ((T1 × T2) → Result (T1 × T2))) + := + let back_'a := fun ret => let (t, t1) := ret + Result.ret (t, t1) + Result.ret ((x, y), back_'a) + +/- [no_nested_borrows::id_mut_pair2]: Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 -/ -def id_mut_pair2 (T1 T2 : Type) (p : (T1 × T2)) : Result (T1 × T2) := - let (t, t0) := p - Result.ret (t, t0) - -/- [no_nested_borrows::id_mut_pair2]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 -/ -def id_mut_pair2_back - (T1 T2 : Type) (p : (T1 × T2)) (ret : (T1 × T2)) : Result (T1 × T2) := - let (t, t0) := ret - Result.ret (t, t0) - -/- [no_nested_borrows::id_mut_pair3]: forward function +def id_mut_pair2 + (T1 T2 : Type) (p : (T1 × T2)) : + Result ((T1 × T2) × ((T1 × T2) → Result (T1 × T2))) + := + let (t, t1) := p + let back_'a := fun ret => let (t2, t3) := ret + Result.ret (t2, t3) + Result.ret ((t, t1), back_'a) + +/- [no_nested_borrows::id_mut_pair3]: Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 -/ -def id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : Result (T1 × T2) := - Result.ret (x, y) - -/- [no_nested_borrows::id_mut_pair3]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 -/ -def id_mut_pair3_back'a - (T1 T2 : Type) (x : T1) (y : T2) (ret : T1) : Result T1 := - Result.ret ret - -/- [no_nested_borrows::id_mut_pair3]: backward function 1 - Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 -/ -def id_mut_pair3_back'b - (T1 T2 : Type) (x : T1) (y : T2) (ret : T2) : Result T2 := - Result.ret ret - -/- [no_nested_borrows::id_mut_pair4]: forward function +def id_mut_pair3 + (T1 T2 : Type) (x : T1) (y : T2) : + Result ((T1 × T2) × (T1 → Result T1) × (T2 → Result T2)) + := + let back_'a := fun ret => Result.ret ret + let back_'b := fun ret => Result.ret ret + Result.ret ((x, y), back_'a, back_'b) + +/- [no_nested_borrows::id_mut_pair4]: Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 -/ -def id_mut_pair4 (T1 T2 : Type) (p : (T1 × T2)) : Result (T1 × T2) := - let (t, t0) := p - Result.ret (t, t0) - -/- [no_nested_borrows::id_mut_pair4]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 -/ -def id_mut_pair4_back'a - (T1 T2 : Type) (p : (T1 × T2)) (ret : T1) : Result T1 := - Result.ret ret - -/- [no_nested_borrows::id_mut_pair4]: backward function 1 - Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 -/ -def id_mut_pair4_back'b - (T1 T2 : Type) (p : (T1 × T2)) (ret : T2) : Result T2 := - Result.ret ret +def id_mut_pair4 + (T1 T2 : Type) (p : (T1 × T2)) : + Result ((T1 × T2) × (T1 → Result T1) × (T2 → Result T2)) + := + let (t, t1) := p + let back_'a := fun ret => Result.ret ret + let back_'b := fun ret => Result.ret ret + Result.ret ((t, t1), back_'a, back_'b) /- [no_nested_borrows::StructWithTuple] Source: 'src/no_nested_borrows.rs', lines 433:0-433:34 -/ structure StructWithTuple (T1 T2 : Type) where p : (T1 × T2) -/- [no_nested_borrows::new_tuple1]: forward function +/- [no_nested_borrows::new_tuple1]: Source: 'src/no_nested_borrows.rs', lines 437:0-437:48 -/ def new_tuple1 : Result (StructWithTuple U32 U32) := Result.ret { p := (1#u32, 2#u32) } -/- [no_nested_borrows::new_tuple2]: forward function +/- [no_nested_borrows::new_tuple2]: Source: 'src/no_nested_borrows.rs', lines 441:0-441:48 -/ def new_tuple2 : Result (StructWithTuple I16 I16) := Result.ret { p := (1#i16, 2#i16) } -/- [no_nested_borrows::new_tuple3]: forward function +/- [no_nested_borrows::new_tuple3]: Source: 'src/no_nested_borrows.rs', lines 445:0-445:48 -/ def new_tuple3 : Result (StructWithTuple U64 I64) := Result.ret { p := (1#u64, 2#i64) } @@ -577,42 +552,42 @@ def new_tuple3 : Result (StructWithTuple U64 I64) := structure StructWithPair (T1 T2 : Type) where p : Pair T1 T2 -/- [no_nested_borrows::new_pair1]: forward function +/- [no_nested_borrows::new_pair1]: Source: 'src/no_nested_borrows.rs', lines 454:0-454:46 -/ def new_pair1 : Result (StructWithPair U32 U32) := Result.ret { p := { x := 1#u32, y := 2#u32 } } -/- [no_nested_borrows::test_constants]: forward function +/- [no_nested_borrows::test_constants]: Source: 'src/no_nested_borrows.rs', lines 462:0-462:23 -/ def test_constants : Result Unit := do - let swt ← new_tuple1 - let (i, _) := swt.p - if not (i = 1#u32) + let swt ← new_tuple1 + let (i, _) := swt.p + if not (i = 1#u32) + then Result.fail .panic + else + do + let swt1 ← new_tuple2 + let (i1, _) := swt1.p + if not (i1 = 1#i16) then Result.fail .panic else do - let swt0 ← new_tuple2 - let (i0, _) := swt0.p - if not (i0 = 1#i16) + let swt2 ← new_tuple3 + let (i2, _) := swt2.p + if not (i2 = 1#u64) + then Result.fail .panic + else + do + let swp ← new_pair1 + if not (swp.p.x = 1#u32) then Result.fail .panic - else - do - let swt1 ← new_tuple3 - let (i1, _) := swt1.p - if not (i1 = 1#u64) - then Result.fail .panic - else - do - let swp ← new_pair1 - if not (swp.p.x = 1#u32) - then Result.fail .panic - else Result.ret () + else Result.ret () /- Unit test for [no_nested_borrows::test_constants] -/ #assert (test_constants == Result.ret ()) -/- [no_nested_borrows::test_weird_borrows1]: forward function +/- [no_nested_borrows::test_weird_borrows1]: Source: 'src/no_nested_borrows.rs', lines 471:0-471:28 -/ def test_weird_borrows1 : Result Unit := Result.ret () @@ -620,65 +595,80 @@ def test_weird_borrows1 : Result Unit := /- Unit test for [no_nested_borrows::test_weird_borrows1] -/ #assert (test_weird_borrows1 == Result.ret ()) -/- [no_nested_borrows::test_mem_replace]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [no_nested_borrows::test_mem_replace]: Source: 'src/no_nested_borrows.rs', lines 481:0-481:37 -/ def test_mem_replace (px : U32) : Result U32 := - let y := core.mem.replace U32 px 1#u32 + let (y, _) := core.mem.replace U32 px 1#u32 if not (y = 0#u32) then Result.fail .panic else Result.ret 2#u32 -/- [no_nested_borrows::test_shared_borrow_bool1]: forward function +/- [no_nested_borrows::test_shared_borrow_bool1]: Source: 'src/no_nested_borrows.rs', lines 488:0-488:47 -/ def test_shared_borrow_bool1 (b : Bool) : Result U32 := if b then Result.ret 0#u32 else Result.ret 1#u32 -/- [no_nested_borrows::test_shared_borrow_bool2]: forward function +/- [no_nested_borrows::test_shared_borrow_bool2]: Source: 'src/no_nested_borrows.rs', lines 501:0-501:40 -/ def test_shared_borrow_bool2 : Result U32 := Result.ret 0#u32 -/- [no_nested_borrows::test_shared_borrow_enum1]: forward function +/- [no_nested_borrows::test_shared_borrow_enum1]: Source: 'src/no_nested_borrows.rs', lines 516:0-516:52 -/ def test_shared_borrow_enum1 (l : List U32) : Result U32 := match l with - | List.Cons i l0 => Result.ret 1#u32 + | List.Cons _ _ => Result.ret 1#u32 | List.Nil => Result.ret 0#u32 -/- [no_nested_borrows::test_shared_borrow_enum2]: forward function +/- [no_nested_borrows::test_shared_borrow_enum2]: Source: 'src/no_nested_borrows.rs', lines 528:0-528:40 -/ def test_shared_borrow_enum2 : Result U32 := Result.ret 0#u32 -/- [no_nested_borrows::Tuple] +/- [no_nested_borrows::incr]: Source: 'src/no_nested_borrows.rs', lines 539:0-539:24 -/ +def incr (x : U32) : Result U32 := + x + 1#u32 + +/- [no_nested_borrows::call_incr]: + Source: 'src/no_nested_borrows.rs', lines 543:0-543:35 -/ +def call_incr (x : U32) : Result U32 := + incr x + +/- [no_nested_borrows::read_then_incr]: + Source: 'src/no_nested_borrows.rs', lines 548:0-548:41 -/ +def read_then_incr (x : U32) : Result (U32 × U32) := + do + let x1 ← x + 1#u32 + Result.ret (x, x1) + +/- [no_nested_borrows::Tuple] + Source: 'src/no_nested_borrows.rs', lines 554:0-554:24 -/ def Tuple (T1 T2 : Type) := T1 × T2 -/- [no_nested_borrows::use_tuple_struct]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) - Source: 'src/no_nested_borrows.rs', lines 541:0-541:48 -/ +/- [no_nested_borrows::use_tuple_struct]: + Source: 'src/no_nested_borrows.rs', lines 556:0-556:48 -/ def use_tuple_struct (x : Tuple U32 U32) : Result (Tuple U32 U32) := Result.ret (1#u32, x.1) -/- [no_nested_borrows::create_tuple_struct]: forward function - Source: 'src/no_nested_borrows.rs', lines 545:0-545:61 -/ +/- [no_nested_borrows::create_tuple_struct]: + Source: 'src/no_nested_borrows.rs', lines 560:0-560:61 -/ def create_tuple_struct (x : U32) (y : U64) : Result (Tuple U32 U64) := Result.ret (x, y) /- [no_nested_borrows::IdType] - Source: 'src/no_nested_borrows.rs', lines 550:0-550:20 -/ + Source: 'src/no_nested_borrows.rs', lines 565:0-565:20 -/ @[reducible] def IdType (T : Type) := T -/- [no_nested_borrows::use_id_type]: forward function - Source: 'src/no_nested_borrows.rs', lines 552:0-552:40 -/ +/- [no_nested_borrows::use_id_type]: + Source: 'src/no_nested_borrows.rs', lines 567:0-567:40 -/ def use_id_type (T : Type) (x : IdType T) : Result T := Result.ret x -/- [no_nested_borrows::create_id_type]: forward function - Source: 'src/no_nested_borrows.rs', lines 556:0-556:43 -/ +/- [no_nested_borrows::create_id_type]: + Source: 'src/no_nested_borrows.rs', lines 571:0-571:43 -/ def create_id_type (T : Type) (x : T) : Result (IdType T) := Result.ret x -- cgit v1.2.3 From 29f358f4072ee4c6530b4c523a1754d4c0723893 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 19:17:09 +0100 Subject: Fix a minor extraction issue --- compiler/Extract.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 04ad3b75..3d9f0c22 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -610,7 +610,7 @@ and extract_Lambda (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) ctx xl in F.pp_print_space fmt (); - if !backend = Lean then F.pp_print_string fmt "=>" + if !backend = Lean || !backend = Coq then F.pp_print_string fmt "=>" else F.pp_print_string fmt "->"; F.pp_print_space fmt (); (* Print the body *) -- cgit v1.2.3 From 2171c01c6101958d3d12734ad970132b78d500d7 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 19:17:44 +0100 Subject: Start pushing files from the fstar-split test folder --- tests/fstar-split/.gitignore | 1 + tests/fstar-split/Makefile | 33 ++ tests/fstar-split/Makefile.template | 48 ++ tests/fstar-split/misc/Makefile | 49 ++ tests/fstar-split/misc/NoNestedBorrows.fst | 622 ++++++++++++++++++++ tests/fstar-split/misc/Primitives.fst | 884 +++++++++++++++++++++++++++++ 6 files changed, 1637 insertions(+) create mode 100644 tests/fstar-split/.gitignore create mode 100644 tests/fstar-split/Makefile create mode 100644 tests/fstar-split/Makefile.template create mode 100644 tests/fstar-split/misc/Makefile create mode 100644 tests/fstar-split/misc/NoNestedBorrows.fst create mode 100644 tests/fstar-split/misc/Primitives.fst diff --git a/tests/fstar-split/.gitignore b/tests/fstar-split/.gitignore new file mode 100644 index 00000000..28a11147 --- /dev/null +++ b/tests/fstar-split/.gitignore @@ -0,0 +1 @@ +*/obj \ No newline at end of file diff --git a/tests/fstar-split/Makefile b/tests/fstar-split/Makefile new file mode 100644 index 00000000..6cf03386 --- /dev/null +++ b/tests/fstar-split/Makefile @@ -0,0 +1,33 @@ +ALL_DIRS ?= $(filter-out Makefile%, $(wildcard *)) + +VERIFY_DIRS = $(addprefix verif-,$(ALL_DIRS)) + +CLEAN_DIRS = $(addprefix clean-,$(ALL_DIRS)) + +COPY_MAKEFILES = $(addprefix copy-makefile-,$(ALL_DIRS)) + +.PHONY: all +all: prepare-projects verify + +.PHONY: prepare-projects +prepare-projects: $(COPY_MAKEFILES) + +.PHONY: verify +verify: $(VERIFY_DIRS) + +.PHONY: verif-% +verif-%: + cd $* && make all + +.PHONY: copy-makefile-% +copy-makefile-%: + rm -f $*/Makefile + echo "# This file was automatically generated - modify ../Makefile.template instead" >> $*/Makefile + cat Makefile.template >> $*/Makefile + +.PHONY: clean +clean: $(CLEAN_DIRS) + +.PHONY: clean-% +clean-%: + cd $* && make clean diff --git a/tests/fstar-split/Makefile.template b/tests/fstar-split/Makefile.template new file mode 100644 index 00000000..14790d6d --- /dev/null +++ b/tests/fstar-split/Makefile.template @@ -0,0 +1,48 @@ +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_EXE ?= fstar.exe +FSTAR_NO_FLAGS = $(FSTAR_EXE) --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/tests/fstar-split/misc/Makefile b/tests/fstar-split/misc/Makefile new file mode 100644 index 00000000..fa7d1f36 --- /dev/null +++ b/tests/fstar-split/misc/Makefile @@ -0,0 +1,49 @@ +# This file was automatically generated - modify ../Makefile.template instead +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_EXE ?= fstar.exe +FSTAR_NO_FLAGS = $(FSTAR_EXE) --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/tests/fstar-split/misc/NoNestedBorrows.fst b/tests/fstar-split/misc/NoNestedBorrows.fst new file mode 100644 index 00000000..41bb7a06 --- /dev/null +++ b/tests/fstar-split/misc/NoNestedBorrows.fst @@ -0,0 +1,622 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [no_nested_borrows] *) +module NoNestedBorrows +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [no_nested_borrows::Pair] + Source: 'src/no_nested_borrows.rs', lines 4:0-4:23 *) +type pair_t (t1 t2 : Type0) = { x : t1; y : t2; } + +(** [no_nested_borrows::List] + Source: 'src/no_nested_borrows.rs', lines 9:0-9:16 *) +type list_t (t : Type0) = +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t + +(** [no_nested_borrows::One] + Source: 'src/no_nested_borrows.rs', lines 20:0-20:16 *) +type one_t (t1 : Type0) = | One_One : t1 -> one_t t1 + +(** [no_nested_borrows::EmptyEnum] + Source: 'src/no_nested_borrows.rs', lines 26:0-26:18 *) +type emptyEnum_t = | EmptyEnum_Empty : emptyEnum_t + +(** [no_nested_borrows::Enum] + Source: 'src/no_nested_borrows.rs', lines 32:0-32:13 *) +type enum_t = | Enum_Variant1 : enum_t | Enum_Variant2 : enum_t + +(** [no_nested_borrows::EmptyStruct] + Source: 'src/no_nested_borrows.rs', lines 39:0-39:22 *) +type emptyStruct_t = unit + +(** [no_nested_borrows::Sum] + Source: 'src/no_nested_borrows.rs', lines 41:0-41:20 *) +type sum_t (t1 t2 : Type0) = +| Sum_Left : t1 -> sum_t t1 t2 +| Sum_Right : t2 -> sum_t t1 t2 + +(** [no_nested_borrows::neg_test]: forward function + Source: 'src/no_nested_borrows.rs', lines 48:0-48:30 *) +let neg_test (x : i32) : result i32 = + i32_neg x + +(** [no_nested_borrows::add_u32]: forward function + Source: 'src/no_nested_borrows.rs', lines 54:0-54:37 *) +let add_u32 (x : u32) (y : u32) : result u32 = + u32_add x y + +(** [no_nested_borrows::subs_u32]: forward function + Source: 'src/no_nested_borrows.rs', lines 60:0-60:38 *) +let subs_u32 (x : u32) (y : u32) : result u32 = + u32_sub x y + +(** [no_nested_borrows::div_u32]: forward function + Source: 'src/no_nested_borrows.rs', lines 66:0-66:37 *) +let div_u32 (x : u32) (y : u32) : result u32 = + u32_div x y + +(** [no_nested_borrows::div_u32_const]: forward function + Source: 'src/no_nested_borrows.rs', lines 73:0-73:35 *) +let div_u32_const (x : u32) : result u32 = + u32_div x 2 + +(** [no_nested_borrows::rem_u32]: forward function + Source: 'src/no_nested_borrows.rs', lines 78:0-78:37 *) +let rem_u32 (x : u32) (y : u32) : result u32 = + u32_rem x y + +(** [no_nested_borrows::mul_u32]: forward function + Source: 'src/no_nested_borrows.rs', lines 82:0-82:37 *) +let mul_u32 (x : u32) (y : u32) : result u32 = + u32_mul x y + +(** [no_nested_borrows::add_i32]: forward function + Source: 'src/no_nested_borrows.rs', lines 88:0-88:37 *) +let add_i32 (x : i32) (y : i32) : result i32 = + i32_add x y + +(** [no_nested_borrows::subs_i32]: forward function + Source: 'src/no_nested_borrows.rs', lines 92:0-92:38 *) +let subs_i32 (x : i32) (y : i32) : result i32 = + i32_sub x y + +(** [no_nested_borrows::div_i32]: forward function + Source: 'src/no_nested_borrows.rs', lines 96:0-96:37 *) +let div_i32 (x : i32) (y : i32) : result i32 = + i32_div x y + +(** [no_nested_borrows::div_i32_const]: forward function + Source: 'src/no_nested_borrows.rs', lines 100:0-100:35 *) +let div_i32_const (x : i32) : result i32 = + i32_div x 2 + +(** [no_nested_borrows::rem_i32]: forward function + Source: 'src/no_nested_borrows.rs', lines 104:0-104:37 *) +let rem_i32 (x : i32) (y : i32) : result i32 = + i32_rem x y + +(** [no_nested_borrows::mul_i32]: forward function + Source: 'src/no_nested_borrows.rs', lines 108:0-108:37 *) +let mul_i32 (x : i32) (y : i32) : result i32 = + i32_mul x y + +(** [no_nested_borrows::mix_arith_u32]: forward function + Source: 'src/no_nested_borrows.rs', lines 112:0-112:51 *) +let mix_arith_u32 (x : u32) (y : u32) (z : u32) : result u32 = + let* i = u32_add x y in + let* i1 = u32_div x y in + let* i2 = u32_mul i i1 in + let* i3 = u32_rem z y in + let* i4 = u32_sub x i3 in + let* i5 = u32_add i2 i4 in + let* i6 = u32_add x y in + let* i7 = u32_add i6 z in + u32_rem i5 i7 + +(** [no_nested_borrows::mix_arith_i32]: forward function + Source: 'src/no_nested_borrows.rs', lines 116:0-116:51 *) +let mix_arith_i32 (x : i32) (y : i32) (z : i32) : result i32 = + let* i = i32_add x y in + let* i1 = i32_div x y in + let* i2 = i32_mul i i1 in + let* i3 = i32_rem z y in + let* i4 = i32_sub x i3 in + let* i5 = i32_add i2 i4 in + let* i6 = i32_add x y in + let* i7 = i32_add i6 z in + i32_rem i5 i7 + +(** [no_nested_borrows::CONST0] + Source: 'src/no_nested_borrows.rs', lines 125:0-125:23 *) +let const0_body : result usize = usize_add 1 1 +let const0_c : usize = eval_global const0_body + +(** [no_nested_borrows::CONST1] + Source: 'src/no_nested_borrows.rs', lines 126:0-126:23 *) +let const1_body : result usize = usize_mul 2 2 +let const1_c : usize = eval_global const1_body + +(** [no_nested_borrows::cast_u32_to_i32]: forward function + Source: 'src/no_nested_borrows.rs', lines 128:0-128:37 *) +let cast_u32_to_i32 (x : u32) : result i32 = + scalar_cast U32 I32 x + +(** [no_nested_borrows::cast_bool_to_i32]: forward function + Source: 'src/no_nested_borrows.rs', lines 132:0-132:39 *) +let cast_bool_to_i32 (x : bool) : result i32 = + scalar_cast_bool I32 x + +(** [no_nested_borrows::cast_bool_to_bool]: forward function + Source: 'src/no_nested_borrows.rs', lines 137:0-137:41 *) +let cast_bool_to_bool (x : bool) : result bool = + Return x + +(** [no_nested_borrows::test2]: forward function + Source: 'src/no_nested_borrows.rs', lines 142:0-142:14 *) +let test2 : result unit = + let* _ = u32_add 23 44 in Return () + +(** Unit test for [no_nested_borrows::test2] *) +let _ = assert_norm (test2 = Return ()) + +(** [no_nested_borrows::get_max]: forward function + Source: 'src/no_nested_borrows.rs', lines 154:0-154:37 *) +let get_max (x : u32) (y : u32) : result u32 = + if x >= y then Return x else Return y + +(** [no_nested_borrows::test3]: forward function + Source: 'src/no_nested_borrows.rs', lines 162:0-162:14 *) +let test3 : result unit = + let* x = get_max 4 3 in + let* y = get_max 10 11 in + let* z = u32_add x y in + if not (z = 15) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::test3] *) +let _ = assert_norm (test3 = Return ()) + +(** [no_nested_borrows::test_neg1]: forward function + Source: 'src/no_nested_borrows.rs', lines 169:0-169:18 *) +let test_neg1 : result unit = + let* y = i32_neg 3 in if not (y = -3) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::test_neg1] *) +let _ = assert_norm (test_neg1 = Return ()) + +(** [no_nested_borrows::refs_test1]: forward function + Source: 'src/no_nested_borrows.rs', lines 176:0-176:19 *) +let refs_test1 : result unit = + if not (1 = 1) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::refs_test1] *) +let _ = assert_norm (refs_test1 = Return ()) + +(** [no_nested_borrows::refs_test2]: forward function + Source: 'src/no_nested_borrows.rs', lines 187:0-187:19 *) +let refs_test2 : result unit = + if not (2 = 2) + then Fail Failure + else + if not (0 = 0) + then Fail Failure + else + if not (2 = 2) + then Fail Failure + else if not (2 = 2) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::refs_test2] *) +let _ = assert_norm (refs_test2 = Return ()) + +(** [no_nested_borrows::test_list1]: forward function + Source: 'src/no_nested_borrows.rs', lines 203:0-203:19 *) +let test_list1 : result unit = + Return () + +(** Unit test for [no_nested_borrows::test_list1] *) +let _ = assert_norm (test_list1 = Return ()) + +(** [no_nested_borrows::test_box1]: forward function + Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 *) +let test_box1 : result unit = + let b = 0 in + let* b1 = alloc_boxed_Box_deref_mut_back i32 b 1 in + let* x = alloc_boxed_Box_deref i32 b1 in + if not (x = 1) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::test_box1] *) +let _ = assert_norm (test_box1 = Return ()) + +(** [no_nested_borrows::copy_int]: forward function + Source: 'src/no_nested_borrows.rs', lines 218:0-218:30 *) +let copy_int (x : i32) : result i32 = + Return x + +(** [no_nested_borrows::test_unreachable]: forward function + Source: 'src/no_nested_borrows.rs', lines 224:0-224:32 *) +let test_unreachable (b : bool) : result unit = + if b then Fail Failure else Return () + +(** [no_nested_borrows::test_panic]: forward function + Source: 'src/no_nested_borrows.rs', lines 232:0-232:26 *) +let test_panic (b : bool) : result unit = + if b then Fail Failure else Return () + +(** [no_nested_borrows::test_copy_int]: forward function + Source: 'src/no_nested_borrows.rs', lines 239:0-239:22 *) +let test_copy_int : result unit = + let* y = copy_int 0 in if not (0 = y) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::test_copy_int] *) +let _ = assert_norm (test_copy_int = Return ()) + +(** [no_nested_borrows::is_cons]: forward function + Source: 'src/no_nested_borrows.rs', lines 246:0-246:38 *) +let is_cons (t : Type0) (l : list_t t) : result bool = + begin match l with + | List_Cons _ _ -> Return true + | List_Nil -> Return false + end + +(** [no_nested_borrows::test_is_cons]: forward function + Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 *) +let test_is_cons : result unit = + let l = List_Nil in + let* b = is_cons i32 (List_Cons 0 l) in + if not b then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::test_is_cons] *) +let _ = assert_norm (test_is_cons = Return ()) + +(** [no_nested_borrows::split_list]: forward function + Source: 'src/no_nested_borrows.rs', lines 259:0-259:48 *) +let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = + begin match l with + | List_Cons hd tl -> Return (hd, tl) + | List_Nil -> Fail Failure + end + +(** [no_nested_borrows::test_split_list]: forward function + Source: 'src/no_nested_borrows.rs', lines 267:0-267:24 *) +let test_split_list : result unit = + let l = List_Nil in + let* p = split_list i32 (List_Cons 0 l) in + let (hd, _) = p in + if not (hd = 0) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::test_split_list] *) +let _ = assert_norm (test_split_list = Return ()) + +(** [no_nested_borrows::choose]: forward function + Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 *) +let choose (t : Type0) (b : bool) (x : t) (y : t) : result t = + if b then Return x else Return y + +(** [no_nested_borrows::choose]: backward function 0 + Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 *) +let choose_back + (t : Type0) (b : bool) (x : t) (y : t) (ret : t) : result (t & t) = + if b then Return (ret, y) else Return (x, ret) + +(** [no_nested_borrows::choose_test]: forward function + Source: 'src/no_nested_borrows.rs', lines 282:0-282:20 *) +let choose_test : result unit = + let* z = choose i32 true 0 0 in + let* z1 = i32_add z 1 in + if not (z1 = 1) + then Fail Failure + else + let* (x, y) = choose_back i32 true 0 0 z1 in + if not (x = 1) + then Fail Failure + else if not (y = 0) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::choose_test] *) +let _ = assert_norm (choose_test = Return ()) + +(** [no_nested_borrows::test_char]: forward function + Source: 'src/no_nested_borrows.rs', lines 294:0-294:26 *) +let test_char : result char = + Return 'a' + +(** [no_nested_borrows::Tree] + Source: 'src/no_nested_borrows.rs', lines 299:0-299:16 *) +type tree_t (t : Type0) = +| Tree_Leaf : t -> tree_t t +| Tree_Node : t -> nodeElem_t t -> tree_t t -> tree_t t + +(** [no_nested_borrows::NodeElem] + Source: 'src/no_nested_borrows.rs', lines 304:0-304:20 *) +and nodeElem_t (t : Type0) = +| NodeElem_Cons : tree_t t -> nodeElem_t t -> nodeElem_t t +| NodeElem_Nil : nodeElem_t t + +(** [no_nested_borrows::list_length]: forward function + Source: 'src/no_nested_borrows.rs', lines 339:0-339:48 *) +let rec list_length (t : Type0) (l : list_t t) : result u32 = + begin match l with + | List_Cons _ l1 -> let* i = list_length t l1 in u32_add 1 i + | List_Nil -> Return 0 + end + +(** [no_nested_borrows::list_nth_shared]: forward function + Source: 'src/no_nested_borrows.rs', lines 347:0-347:62 *) +let rec list_nth_shared (t : Type0) (l : list_t t) (i : u32) : result t = + begin match l with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i1 = u32_sub i 1 in list_nth_shared t tl i1 + | List_Nil -> Fail Failure + end + +(** [no_nested_borrows::list_nth_mut]: forward function + Source: 'src/no_nested_borrows.rs', lines 363:0-363:67 *) +let rec list_nth_mut (t : Type0) (l : list_t t) (i : u32) : result t = + begin match l with + | List_Cons x tl -> + if i = 0 then Return x else let* i1 = u32_sub i 1 in list_nth_mut t tl i1 + | List_Nil -> Fail Failure + end + +(** [no_nested_borrows::list_nth_mut]: backward function 0 + Source: 'src/no_nested_borrows.rs', lines 363:0-363:67 *) +let rec list_nth_mut_back + (t : Type0) (l : list_t t) (i : u32) (ret : t) : result (list_t t) = + begin match l with + | List_Cons x tl -> + if i = 0 + then Return (List_Cons ret tl) + else + let* i1 = u32_sub i 1 in + let* tl1 = list_nth_mut_back t tl i1 ret in + Return (List_Cons x tl1) + | List_Nil -> Fail Failure + end + +(** [no_nested_borrows::list_rev_aux]: forward function + Source: 'src/no_nested_borrows.rs', lines 379:0-379:63 *) +let rec list_rev_aux + (t : Type0) (li : list_t t) (lo : list_t t) : result (list_t t) = + begin match li with + | List_Cons hd tl -> list_rev_aux t tl (List_Cons hd lo) + | List_Nil -> Return lo + end + +(** [no_nested_borrows::list_rev]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/no_nested_borrows.rs', lines 393:0-393:42 *) +let list_rev (t : Type0) (l : list_t t) : result (list_t t) = + let li = core_mem_replace (list_t t) l List_Nil in list_rev_aux t li List_Nil + +(** [no_nested_borrows::test_list_functions]: forward function + Source: 'src/no_nested_borrows.rs', lines 398:0-398:28 *) +let test_list_functions : result unit = + let l = List_Nil in + let l1 = List_Cons 2 l in + let l2 = List_Cons 1 l1 in + let* i = list_length i32 (List_Cons 0 l2) in + if not (i = 3) + then Fail Failure + else + let* i1 = list_nth_shared i32 (List_Cons 0 l2) 0 in + if not (i1 = 0) + then Fail Failure + else + let* i2 = list_nth_shared i32 (List_Cons 0 l2) 1 in + if not (i2 = 1) + then Fail Failure + else + let* i3 = list_nth_shared i32 (List_Cons 0 l2) 2 in + if not (i3 = 2) + then Fail Failure + else + let* ls = list_nth_mut_back i32 (List_Cons 0 l2) 1 3 in + let* i4 = list_nth_shared i32 ls 0 in + if not (i4 = 0) + then Fail Failure + else + let* i5 = list_nth_shared i32 ls 1 in + if not (i5 = 3) + then Fail Failure + else + let* i6 = list_nth_shared i32 ls 2 in + if not (i6 = 2) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::test_list_functions] *) +let _ = assert_norm (test_list_functions = Return ()) + +(** [no_nested_borrows::id_mut_pair1]: forward function + Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 *) +let id_mut_pair1 (t1 t2 : Type0) (x : t1) (y : t2) : result (t1 & t2) = + Return (x, y) + +(** [no_nested_borrows::id_mut_pair1]: backward function 0 + Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 *) +let id_mut_pair1_back + (t1 t2 : Type0) (x : t1) (y : t2) (ret : (t1 & t2)) : result (t1 & t2) = + let (x1, x2) = ret in Return (x1, x2) + +(** [no_nested_borrows::id_mut_pair2]: forward function + Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 *) +let id_mut_pair2 (t1 t2 : Type0) (p : (t1 & t2)) : result (t1 & t2) = + let (x, x1) = p in Return (x, x1) + +(** [no_nested_borrows::id_mut_pair2]: backward function 0 + Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 *) +let id_mut_pair2_back + (t1 t2 : Type0) (p : (t1 & t2)) (ret : (t1 & t2)) : result (t1 & t2) = + let (x, x1) = ret in Return (x, x1) + +(** [no_nested_borrows::id_mut_pair3]: forward function + Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) +let id_mut_pair3 (t1 t2 : Type0) (x : t1) (y : t2) : result (t1 & t2) = + Return (x, y) + +(** [no_nested_borrows::id_mut_pair3]: backward function 0 + Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) +let id_mut_pair3_back'a + (t1 t2 : Type0) (x : t1) (y : t2) (ret : t1) : result t1 = + Return ret + +(** [no_nested_borrows::id_mut_pair3]: backward function 1 + Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) +let id_mut_pair3_back'b + (t1 t2 : Type0) (x : t1) (y : t2) (ret : t2) : result t2 = + Return ret + +(** [no_nested_borrows::id_mut_pair4]: forward function + Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) +let id_mut_pair4 (t1 t2 : Type0) (p : (t1 & t2)) : result (t1 & t2) = + let (x, x1) = p in Return (x, x1) + +(** [no_nested_borrows::id_mut_pair4]: backward function 0 + Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) +let id_mut_pair4_back'a + (t1 t2 : Type0) (p : (t1 & t2)) (ret : t1) : result t1 = + Return ret + +(** [no_nested_borrows::id_mut_pair4]: backward function 1 + Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) +let id_mut_pair4_back'b + (t1 t2 : Type0) (p : (t1 & t2)) (ret : t2) : result t2 = + Return ret + +(** [no_nested_borrows::StructWithTuple] + Source: 'src/no_nested_borrows.rs', lines 433:0-433:34 *) +type structWithTuple_t (t1 t2 : Type0) = { p : (t1 & t2); } + +(** [no_nested_borrows::new_tuple1]: forward function + Source: 'src/no_nested_borrows.rs', lines 437:0-437:48 *) +let new_tuple1 : result (structWithTuple_t u32 u32) = + Return { p = (1, 2) } + +(** [no_nested_borrows::new_tuple2]: forward function + Source: 'src/no_nested_borrows.rs', lines 441:0-441:48 *) +let new_tuple2 : result (structWithTuple_t i16 i16) = + Return { p = (1, 2) } + +(** [no_nested_borrows::new_tuple3]: forward function + Source: 'src/no_nested_borrows.rs', lines 445:0-445:48 *) +let new_tuple3 : result (structWithTuple_t u64 i64) = + Return { p = (1, 2) } + +(** [no_nested_borrows::StructWithPair] + Source: 'src/no_nested_borrows.rs', lines 450:0-450:33 *) +type structWithPair_t (t1 t2 : Type0) = { p : pair_t t1 t2; } + +(** [no_nested_borrows::new_pair1]: forward function + Source: 'src/no_nested_borrows.rs', lines 454:0-454:46 *) +let new_pair1 : result (structWithPair_t u32 u32) = + Return { p = { x = 1; y = 2 } } + +(** [no_nested_borrows::test_constants]: forward function + Source: 'src/no_nested_borrows.rs', lines 462:0-462:23 *) +let test_constants : result unit = + let* swt = new_tuple1 in + let (i, _) = swt.p in + if not (i = 1) + then Fail Failure + else + let* swt1 = new_tuple2 in + let (i1, _) = swt1.p in + if not (i1 = 1) + then Fail Failure + else + let* swt2 = new_tuple3 in + let (i2, _) = swt2.p in + if not (i2 = 1) + then Fail Failure + else + let* swp = new_pair1 in + if not (swp.p.x = 1) then Fail Failure else Return () + +(** Unit test for [no_nested_borrows::test_constants] *) +let _ = assert_norm (test_constants = Return ()) + +(** [no_nested_borrows::test_weird_borrows1]: forward function + Source: 'src/no_nested_borrows.rs', lines 471:0-471:28 *) +let test_weird_borrows1 : result unit = + Return () + +(** Unit test for [no_nested_borrows::test_weird_borrows1] *) +let _ = assert_norm (test_weird_borrows1 = Return ()) + +(** [no_nested_borrows::test_mem_replace]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/no_nested_borrows.rs', lines 481:0-481:37 *) +let test_mem_replace (px : u32) : result u32 = + let y = core_mem_replace u32 px 1 in + if not (y = 0) then Fail Failure else Return 2 + +(** [no_nested_borrows::test_shared_borrow_bool1]: forward function + Source: 'src/no_nested_borrows.rs', lines 488:0-488:47 *) +let test_shared_borrow_bool1 (b : bool) : result u32 = + if b then Return 0 else Return 1 + +(** [no_nested_borrows::test_shared_borrow_bool2]: forward function + Source: 'src/no_nested_borrows.rs', lines 501:0-501:40 *) +let test_shared_borrow_bool2 : result u32 = + Return 0 + +(** [no_nested_borrows::test_shared_borrow_enum1]: forward function + Source: 'src/no_nested_borrows.rs', lines 516:0-516:52 *) +let test_shared_borrow_enum1 (l : list_t u32) : result u32 = + begin match l with | List_Cons _ _ -> Return 1 | List_Nil -> Return 0 end + +(** [no_nested_borrows::test_shared_borrow_enum2]: forward function + Source: 'src/no_nested_borrows.rs', lines 528:0-528:40 *) +let test_shared_borrow_enum2 : result u32 = + Return 0 + +(** [no_nested_borrows::incr]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/no_nested_borrows.rs', lines 539:0-539:24 *) +let incr (x : u32) : result u32 = + u32_add x 1 + +(** [no_nested_borrows::call_incr]: forward function + Source: 'src/no_nested_borrows.rs', lines 543:0-543:35 *) +let call_incr (x : u32) : result u32 = + incr x + +(** [no_nested_borrows::read_then_incr]: forward function + Source: 'src/no_nested_borrows.rs', lines 548:0-548:41 *) +let read_then_incr (x : u32) : result u32 = + let* _ = u32_add x 1 in Return x + +(** [no_nested_borrows::read_then_incr]: backward function 0 + Source: 'src/no_nested_borrows.rs', lines 548:0-548:41 *) +let read_then_incr_back (x : u32) : result u32 = + u32_add x 1 + +(** [no_nested_borrows::Tuple] + Source: 'src/no_nested_borrows.rs', lines 554:0-554:24 *) +type tuple_t (t1 t2 : Type0) = t1 * t2 + +(** [no_nested_borrows::use_tuple_struct]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/no_nested_borrows.rs', lines 556:0-556:48 *) +let use_tuple_struct (x : tuple_t u32 u32) : result (tuple_t u32 u32) = + let (_, i) = x in Return (1, i) + +(** [no_nested_borrows::create_tuple_struct]: forward function + Source: 'src/no_nested_borrows.rs', lines 560:0-560:61 *) +let create_tuple_struct (x : u32) (y : u64) : result (tuple_t u32 u64) = + Return (x, y) + +(** [no_nested_borrows::IdType] + Source: 'src/no_nested_borrows.rs', lines 565:0-565:20 *) +type idType_t (t : Type0) = t + +(** [no_nested_borrows::use_id_type]: forward function + Source: 'src/no_nested_borrows.rs', lines 567:0-567:40 *) +let use_id_type (t : Type0) (x : idType_t t) : result t = + Return x + +(** [no_nested_borrows::create_id_type]: forward function + Source: 'src/no_nested_borrows.rs', lines 571:0-571:43 *) +let create_id_type (t : Type0) (x : t) : result (idType_t t) = + Return x + diff --git a/tests/fstar-split/misc/Primitives.fst b/tests/fstar-split/misc/Primitives.fst new file mode 100644 index 00000000..a3ffbde4 --- /dev/null +++ b/tests/fstar-split/misc/Primitives.fst @@ -0,0 +1,884 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v + +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure +let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_RangeUsize_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_RangeUsize_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_mut_back = core_slice_index_RangeUsize_get_mut_back t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; + index_mut_back = core_slice_index_RangeUsize_index_mut_back t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] + = + admit() -- cgit v1.2.3 From 719263b7bb727bdb432f66709b8c1eadc47ba922 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 19:23:39 +0100 Subject: Annotate the bound vars in the lambdas for Coq --- compiler/Extract.ml | 56 ++++-- tests/coq/misc/NoNestedBorrows.v | 388 +++++++++++++++++++-------------------- tests/coq/misc/Primitives.v | 116 +++++------- 3 files changed, 267 insertions(+), 293 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 3d9f0c22..30b76ceb 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -241,30 +241,45 @@ let fun_builtin_filter_types (id : FunDeclId.id) (types : 'a list) Result.Ok types (** [inside]: see {!extract_ty}. + [with_type]: do we also generate a type annotation? This is necessary for + backends like Coq when we write lambdas (Coq is not powerful enough to + infer the type). As a pattern can introduce new variables, we return an extraction context updated with new bindings. *) let rec extract_typed_pattern (ctx : extraction_ctx) (fmt : F.formatter) - (is_let : bool) (inside : bool) (v : typed_pattern) : extraction_ctx = - match v.value with - | PatConstant cv -> - extract_literal fmt inside cv; - ctx - | PatVar (v, _) -> - let vname = ctx_compute_var_basename ctx v.basename v.ty in - let ctx, vname = ctx_add_var vname v.id ctx in - F.pp_print_string fmt vname; - ctx - | PatDummy -> - F.pp_print_string fmt "_"; - ctx - | PatAdt av -> - let extract_value ctx inside v = - extract_typed_pattern ctx fmt is_let inside v - in - extract_adt_g_value extract_value fmt ctx is_let inside av.variant_id - av.field_values v.ty + (is_let : bool) (inside : bool) ?(with_type = false) (v : typed_pattern) : + extraction_ctx = + if with_type then F.pp_print_string fmt "("; + let inside = inside && not with_type in + let ctx = + match v.value with + | PatConstant cv -> + extract_literal fmt inside cv; + ctx + | PatVar (v, _) -> + let vname = ctx_compute_var_basename ctx v.basename v.ty in + let ctx, vname = ctx_add_var vname v.id ctx in + F.pp_print_string fmt vname; + ctx + | PatDummy -> + F.pp_print_string fmt "_"; + ctx + | PatAdt av -> + let extract_value ctx inside v = + extract_typed_pattern ctx fmt is_let inside v + in + extract_adt_g_value extract_value fmt ctx is_let inside av.variant_id + av.field_values v.ty + in + if with_type then ( + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + extract_ty ctx fmt TypeDeclId.Set.empty false v.ty; + F.pp_print_string fmt ")"); + ctx (** Return true if we need to wrap a succession of let-bindings in a [do ...] block (because some of them are monadic) *) @@ -602,11 +617,12 @@ and extract_Lambda (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (* Print the lambda - note that there should always be at least one variable *) assert (xl <> []); F.pp_print_string fmt "fun"; + let with_type = !backend = Coq in let ctx = List.fold_left (fun ctx x -> F.pp_print_space fmt (); - extract_typed_pattern ctx fmt true true x) + extract_typed_pattern ctx fmt true true ~with_type x) ctx xl in F.pp_print_space fmt (); diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v index 65164ac5..081c65c3 100644 --- a/tests/coq/misc/NoNestedBorrows.v +++ b/tests/coq/misc/NoNestedBorrows.v @@ -54,97 +54,97 @@ Inductive Sum_t (T1 T2 : Type) := Arguments Sum_Left { _ _ }. Arguments Sum_Right { _ _ }. -(** [no_nested_borrows::neg_test]: forward function +(** [no_nested_borrows::neg_test]: Source: 'src/no_nested_borrows.rs', lines 48:0-48:30 *) Definition neg_test (x : i32) : result i32 := i32_neg x. -(** [no_nested_borrows::add_u32]: forward function +(** [no_nested_borrows::add_u32]: Source: 'src/no_nested_borrows.rs', lines 54:0-54:37 *) Definition add_u32 (x : u32) (y : u32) : result u32 := u32_add x y. -(** [no_nested_borrows::subs_u32]: forward function +(** [no_nested_borrows::subs_u32]: Source: 'src/no_nested_borrows.rs', lines 60:0-60:38 *) Definition subs_u32 (x : u32) (y : u32) : result u32 := u32_sub x y. -(** [no_nested_borrows::div_u32]: forward function +(** [no_nested_borrows::div_u32]: Source: 'src/no_nested_borrows.rs', lines 66:0-66:37 *) Definition div_u32 (x : u32) (y : u32) : result u32 := u32_div x y. -(** [no_nested_borrows::div_u32_const]: forward function +(** [no_nested_borrows::div_u32_const]: Source: 'src/no_nested_borrows.rs', lines 73:0-73:35 *) Definition div_u32_const (x : u32) : result u32 := u32_div x 2%u32. -(** [no_nested_borrows::rem_u32]: forward function +(** [no_nested_borrows::rem_u32]: Source: 'src/no_nested_borrows.rs', lines 78:0-78:37 *) Definition rem_u32 (x : u32) (y : u32) : result u32 := u32_rem x y. -(** [no_nested_borrows::mul_u32]: forward function +(** [no_nested_borrows::mul_u32]: Source: 'src/no_nested_borrows.rs', lines 82:0-82:37 *) Definition mul_u32 (x : u32) (y : u32) : result u32 := u32_mul x y. -(** [no_nested_borrows::add_i32]: forward function +(** [no_nested_borrows::add_i32]: Source: 'src/no_nested_borrows.rs', lines 88:0-88:37 *) Definition add_i32 (x : i32) (y : i32) : result i32 := i32_add x y. -(** [no_nested_borrows::subs_i32]: forward function +(** [no_nested_borrows::subs_i32]: Source: 'src/no_nested_borrows.rs', lines 92:0-92:38 *) Definition subs_i32 (x : i32) (y : i32) : result i32 := i32_sub x y. -(** [no_nested_borrows::div_i32]: forward function +(** [no_nested_borrows::div_i32]: Source: 'src/no_nested_borrows.rs', lines 96:0-96:37 *) Definition div_i32 (x : i32) (y : i32) : result i32 := i32_div x y. -(** [no_nested_borrows::div_i32_const]: forward function +(** [no_nested_borrows::div_i32_const]: Source: 'src/no_nested_borrows.rs', lines 100:0-100:35 *) Definition div_i32_const (x : i32) : result i32 := i32_div x 2%i32. -(** [no_nested_borrows::rem_i32]: forward function +(** [no_nested_borrows::rem_i32]: Source: 'src/no_nested_borrows.rs', lines 104:0-104:37 *) Definition rem_i32 (x : i32) (y : i32) : result i32 := i32_rem x y. -(** [no_nested_borrows::mul_i32]: forward function +(** [no_nested_borrows::mul_i32]: Source: 'src/no_nested_borrows.rs', lines 108:0-108:37 *) Definition mul_i32 (x : i32) (y : i32) : result i32 := i32_mul x y. -(** [no_nested_borrows::mix_arith_u32]: forward function +(** [no_nested_borrows::mix_arith_u32]: Source: 'src/no_nested_borrows.rs', lines 112:0-112:51 *) Definition mix_arith_u32 (x : u32) (y : u32) (z : u32) : result u32 := i <- u32_add x y; - i0 <- u32_div x y; - i1 <- u32_mul i i0; - i2 <- u32_rem z y; - i3 <- u32_sub x i2; - i4 <- u32_add i1 i3; - i5 <- u32_add x y; - i6 <- u32_add i5 z; - u32_rem i4 i6 + i1 <- u32_div x y; + i2 <- u32_mul i i1; + i3 <- u32_rem z y; + i4 <- u32_sub x i3; + i5 <- u32_add i2 i4; + i6 <- u32_add x y; + i7 <- u32_add i6 z; + u32_rem i5 i7 . -(** [no_nested_borrows::mix_arith_i32]: forward function +(** [no_nested_borrows::mix_arith_i32]: Source: 'src/no_nested_borrows.rs', lines 116:0-116:51 *) Definition mix_arith_i32 (x : i32) (y : i32) (z : i32) : result i32 := i <- i32_add x y; - i0 <- i32_div x y; - i1 <- i32_mul i i0; - i2 <- i32_rem z y; - i3 <- i32_sub x i2; - i4 <- i32_add i1 i3; - i5 <- i32_add x y; - i6 <- i32_add i5 z; - i32_rem i4 i6 + i1 <- i32_div x y; + i2 <- i32_mul i i1; + i3 <- i32_rem z y; + i4 <- i32_sub x i3; + i5 <- i32_add i2 i4; + i6 <- i32_add x y; + i7 <- i32_add i6 z; + i32_rem i5 i7 . (** [no_nested_borrows::CONST0] @@ -157,22 +157,22 @@ Definition const0_c : usize := const0_body%global. Definition const1_body : result usize := usize_mul 2%usize 2%usize. Definition const1_c : usize := const1_body%global. -(** [no_nested_borrows::cast_u32_to_i32]: forward function +(** [no_nested_borrows::cast_u32_to_i32]: Source: 'src/no_nested_borrows.rs', lines 128:0-128:37 *) Definition cast_u32_to_i32 (x : u32) : result i32 := scalar_cast U32 I32 x. -(** [no_nested_borrows::cast_bool_to_i32]: forward function +(** [no_nested_borrows::cast_bool_to_i32]: Source: 'src/no_nested_borrows.rs', lines 132:0-132:39 *) Definition cast_bool_to_i32 (x : bool) : result i32 := scalar_cast_bool I32 x. -(** [no_nested_borrows::cast_bool_to_bool]: forward function +(** [no_nested_borrows::cast_bool_to_bool]: Source: 'src/no_nested_borrows.rs', lines 137:0-137:41 *) Definition cast_bool_to_bool (x : bool) : result bool := Return x. -(** [no_nested_borrows::test2]: forward function +(** [no_nested_borrows::test2]: Source: 'src/no_nested_borrows.rs', lines 142:0-142:14 *) Definition test2 : result unit := _ <- u32_add 23%u32 44%u32; Return tt. @@ -180,13 +180,13 @@ Definition test2 : result unit := (** Unit test for [no_nested_borrows::test2] *) Check (test2 )%return. -(** [no_nested_borrows::get_max]: forward function +(** [no_nested_borrows::get_max]: Source: 'src/no_nested_borrows.rs', lines 154:0-154:37 *) Definition get_max (x : u32) (y : u32) : result u32 := if x s>= y then Return x else Return y . -(** [no_nested_borrows::test3]: forward function +(** [no_nested_borrows::test3]: Source: 'src/no_nested_borrows.rs', lines 162:0-162:14 *) Definition test3 : result unit := x <- get_max 4%u32 3%u32; @@ -198,7 +198,7 @@ Definition test3 : result unit := (** Unit test for [no_nested_borrows::test3] *) Check (test3 )%return. -(** [no_nested_borrows::test_neg1]: forward function +(** [no_nested_borrows::test_neg1]: Source: 'src/no_nested_borrows.rs', lines 169:0-169:18 *) Definition test_neg1 : result unit := y <- i32_neg 3%i32; if negb (y s= (-3)%i32) then Fail_ Failure else Return tt @@ -207,7 +207,7 @@ Definition test_neg1 : result unit := (** Unit test for [no_nested_borrows::test_neg1] *) Check (test_neg1 )%return. -(** [no_nested_borrows::refs_test1]: forward function +(** [no_nested_borrows::refs_test1]: Source: 'src/no_nested_borrows.rs', lines 176:0-176:19 *) Definition refs_test1 : result unit := if negb (1%i32 s= 1%i32) then Fail_ Failure else Return tt @@ -216,7 +216,7 @@ Definition refs_test1 : result unit := (** Unit test for [no_nested_borrows::refs_test1] *) Check (refs_test1 )%return. -(** [no_nested_borrows::refs_test2]: forward function +(** [no_nested_borrows::refs_test2]: Source: 'src/no_nested_borrows.rs', lines 187:0-187:19 *) Definition refs_test2 : result unit := if negb (2%i32 s= 2%i32) @@ -233,7 +233,7 @@ Definition refs_test2 : result unit := (** Unit test for [no_nested_borrows::refs_test2] *) Check (refs_test2 )%return. -(** [no_nested_borrows::test_list1]: forward function +(** [no_nested_borrows::test_list1]: Source: 'src/no_nested_borrows.rs', lines 203:0-203:19 *) Definition test_list1 : result unit := Return tt. @@ -241,36 +241,38 @@ Definition test_list1 : result unit := (** Unit test for [no_nested_borrows::test_list1] *) Check (test_list1 )%return. -(** [no_nested_borrows::test_box1]: forward function +(** [no_nested_borrows::test_box1]: Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 *) Definition test_box1 : result unit := let b := 0%i32 in - b0 <- alloc_boxed_Box_deref_mut_back i32 b 1%i32; - x <- alloc_boxed_Box_deref i32 b0; + p <- alloc_boxed_Box_deref_mut i32 b; + let (_, deref_mut_back) := p in + b1 <- deref_mut_back 1%i32; + x <- alloc_boxed_Box_deref i32 b1; if negb (x s= 1%i32) then Fail_ Failure else Return tt . (** Unit test for [no_nested_borrows::test_box1] *) Check (test_box1 )%return. -(** [no_nested_borrows::copy_int]: forward function +(** [no_nested_borrows::copy_int]: Source: 'src/no_nested_borrows.rs', lines 218:0-218:30 *) Definition copy_int (x : i32) : result i32 := Return x. -(** [no_nested_borrows::test_unreachable]: forward function +(** [no_nested_borrows::test_unreachable]: Source: 'src/no_nested_borrows.rs', lines 224:0-224:32 *) Definition test_unreachable (b : bool) : result unit := if b then Fail_ Failure else Return tt . -(** [no_nested_borrows::test_panic]: forward function +(** [no_nested_borrows::test_panic]: Source: 'src/no_nested_borrows.rs', lines 232:0-232:26 *) Definition test_panic (b : bool) : result unit := if b then Fail_ Failure else Return tt . -(** [no_nested_borrows::test_copy_int]: forward function +(** [no_nested_borrows::test_copy_int]: Source: 'src/no_nested_borrows.rs', lines 239:0-239:22 *) Definition test_copy_int : result unit := y <- copy_int 0%i32; if negb (0%i32 s= y) then Fail_ Failure else Return tt @@ -279,13 +281,13 @@ Definition test_copy_int : result unit := (** Unit test for [no_nested_borrows::test_copy_int] *) Check (test_copy_int )%return. -(** [no_nested_borrows::is_cons]: forward function +(** [no_nested_borrows::is_cons]: Source: 'src/no_nested_borrows.rs', lines 246:0-246:38 *) Definition is_cons (T : Type) (l : List_t T) : result bool := - match l with | List_Cons t l0 => Return true | List_Nil => Return false end + match l with | List_Cons _ _ => Return true | List_Nil => Return false end . -(** [no_nested_borrows::test_is_cons]: forward function +(** [no_nested_borrows::test_is_cons]: Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 *) Definition test_is_cons : result unit := let l := List_Nil in @@ -296,7 +298,7 @@ Definition test_is_cons : result unit := (** Unit test for [no_nested_borrows::test_is_cons] *) Check (test_is_cons )%return. -(** [no_nested_borrows::split_list]: forward function +(** [no_nested_borrows::split_list]: Source: 'src/no_nested_borrows.rs', lines 259:0-259:48 *) Definition split_list (T : Type) (l : List_t T) : result (T * (List_t T)) := match l with @@ -305,7 +307,7 @@ Definition split_list (T : Type) (l : List_t T) : result (T * (List_t T)) := end . -(** [no_nested_borrows::test_split_list]: forward function +(** [no_nested_borrows::test_split_list]: Source: 'src/no_nested_borrows.rs', lines 267:0-267:24 *) Definition test_split_list : result unit := let l := List_Nil in @@ -317,29 +319,26 @@ Definition test_split_list : result unit := (** Unit test for [no_nested_borrows::test_split_list] *) Check (test_split_list )%return. -(** [no_nested_borrows::choose]: forward function +(** [no_nested_borrows::choose]: Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 *) -Definition choose (T : Type) (b : bool) (x : T) (y : T) : result T := - if b then Return x else Return y +Definition choose + (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := + if b + then let back_'a := fun (ret : T) => Return (ret, y) in Return (x, back_'a) + else let back_'a := fun (ret : T) => Return (x, ret) in Return (y, back_'a) . -(** [no_nested_borrows::choose]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 *) -Definition choose_back - (T : Type) (b : bool) (x : T) (y : T) (ret : T) : result (T * T) := - if b then Return (ret, y) else Return (x, ret) -. - -(** [no_nested_borrows::choose_test]: forward function +(** [no_nested_borrows::choose_test]: Source: 'src/no_nested_borrows.rs', lines 282:0-282:20 *) Definition choose_test : result unit := - z <- choose i32 true 0%i32 0%i32; - z0 <- i32_add z 1%i32; - if negb (z0 s= 1%i32) + p <- choose i32 true 0%i32 0%i32; + let (z, choose_back) := p in + z1 <- i32_add z 1%i32; + if negb (z1 s= 1%i32) then Fail_ Failure else ( - p <- choose_back i32 true 0%i32 0%i32 z0; - let (x, y) := p in + p1 <- choose_back z1; + let (x, y) := p1 in if negb (x s= 1%i32) then Fail_ Failure else if negb (y s= 0%i32) then Fail_ Failure else Return tt) @@ -348,7 +347,7 @@ Definition choose_test : result unit := (** Unit test for [no_nested_borrows::choose_test] *) Check (choose_test )%return. -(** [no_nested_borrows::test_char]: forward function +(** [no_nested_borrows::test_char]: Source: 'src/no_nested_borrows.rs', lines 294:0-294:26 *) Definition test_char : result char := Return (char_of_byte Coq.Init.Byte.x61). @@ -372,56 +371,52 @@ Arguments Tree_Node { _ }. Arguments NodeElem_Cons { _ }. Arguments NodeElem_Nil { _ }. -(** [no_nested_borrows::list_length]: forward function +(** [no_nested_borrows::list_length]: Source: 'src/no_nested_borrows.rs', lines 339:0-339:48 *) Fixpoint list_length (T : Type) (l : List_t T) : result u32 := match l with - | List_Cons t l1 => i <- list_length T l1; u32_add 1%u32 i + | List_Cons _ l1 => i <- list_length T l1; u32_add 1%u32 i | List_Nil => Return 0%u32 end . -(** [no_nested_borrows::list_nth_shared]: forward function +(** [no_nested_borrows::list_nth_shared]: Source: 'src/no_nested_borrows.rs', lines 347:0-347:62 *) Fixpoint list_nth_shared (T : Type) (l : List_t T) (i : u32) : result T := match l with | List_Cons x tl => if i s= 0%u32 then Return x - else (i0 <- u32_sub i 1%u32; list_nth_shared T tl i0) + else (i1 <- u32_sub i 1%u32; list_nth_shared T tl i1) | List_Nil => Fail_ Failure end . -(** [no_nested_borrows::list_nth_mut]: forward function +(** [no_nested_borrows::list_nth_mut]: Source: 'src/no_nested_borrows.rs', lines 363:0-363:67 *) -Fixpoint list_nth_mut (T : Type) (l : List_t T) (i : u32) : result T := +Fixpoint list_nth_mut + (T : Type) (l : List_t T) (i : u32) : + result (T * (T -> result (List_t T))) + := match l with | List_Cons x tl => if i s= 0%u32 - then Return x - else (i0 <- u32_sub i 1%u32; list_nth_mut T tl i0) - | List_Nil => Fail_ Failure - end -. - -(** [no_nested_borrows::list_nth_mut]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 363:0-363:67 *) -Fixpoint list_nth_mut_back - (T : Type) (l : List_t T) (i : u32) (ret : T) : result (List_t T) := - match l with - | List_Cons x tl => - if i s= 0%u32 - then Return (List_Cons ret tl) + then + let back_'a := fun (ret : T) => Return (List_Cons ret tl) in + Return (x, back_'a) else ( - i0 <- u32_sub i 1%u32; - tl0 <- list_nth_mut_back T tl i0 ret; - Return (List_Cons x tl0)) + i1 <- u32_sub i 1%u32; + p <- list_nth_mut T tl i1; + let (t, list_nth_mut_back) := p in + let back_'a := + fun (ret : T) => tl1 <- list_nth_mut_back ret; Return (List_Cons x tl1) + in + Return (t, back_'a)) | List_Nil => Fail_ Failure end . -(** [no_nested_borrows::list_rev_aux]: forward function +(** [no_nested_borrows::list_rev_aux]: Source: 'src/no_nested_borrows.rs', lines 379:0-379:63 *) Fixpoint list_rev_aux (T : Type) (li : List_t T) (lo : List_t T) : result (List_t T) := @@ -431,116 +426,97 @@ Fixpoint list_rev_aux end . -(** [no_nested_borrows::list_rev]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [no_nested_borrows::list_rev]: Source: 'src/no_nested_borrows.rs', lines 393:0-393:42 *) Definition list_rev (T : Type) (l : List_t T) : result (List_t T) := - let li := core_mem_replace (List_t T) l List_Nil in + let (li, _) := core_mem_replace (List_t T) l List_Nil in list_rev_aux T li List_Nil . -(** [no_nested_borrows::test_list_functions]: forward function +(** [no_nested_borrows::test_list_functions]: Source: 'src/no_nested_borrows.rs', lines 398:0-398:28 *) Definition test_list_functions : result unit := let l := List_Nil in - let l0 := List_Cons 2%i32 l in - let l1 := List_Cons 1%i32 l0 in - i <- list_length i32 (List_Cons 0%i32 l1); + let l1 := List_Cons 2%i32 l in + let l2 := List_Cons 1%i32 l1 in + i <- list_length i32 (List_Cons 0%i32 l2); if negb (i s= 3%u32) then Fail_ Failure else ( - i0 <- list_nth_shared i32 (List_Cons 0%i32 l1) 0%u32; - if negb (i0 s= 0%i32) + i1 <- list_nth_shared i32 (List_Cons 0%i32 l2) 0%u32; + if negb (i1 s= 0%i32) then Fail_ Failure else ( - i1 <- list_nth_shared i32 (List_Cons 0%i32 l1) 1%u32; - if negb (i1 s= 1%i32) + i2 <- list_nth_shared i32 (List_Cons 0%i32 l2) 1%u32; + if negb (i2 s= 1%i32) then Fail_ Failure else ( - i2 <- list_nth_shared i32 (List_Cons 0%i32 l1) 2%u32; - if negb (i2 s= 2%i32) + i3 <- list_nth_shared i32 (List_Cons 0%i32 l2) 2%u32; + if negb (i3 s= 2%i32) then Fail_ Failure else ( - ls <- list_nth_mut_back i32 (List_Cons 0%i32 l1) 1%u32 3%i32; - i3 <- list_nth_shared i32 ls 0%u32; - if negb (i3 s= 0%i32) + p <- list_nth_mut i32 (List_Cons 0%i32 l2) 1%u32; + let (_, list_nth_mut_back) := p in + ls <- list_nth_mut_back 3%i32; + i4 <- list_nth_shared i32 ls 0%u32; + if negb (i4 s= 0%i32) then Fail_ Failure else ( - i4 <- list_nth_shared i32 ls 1%u32; - if negb (i4 s= 3%i32) + i5 <- list_nth_shared i32 ls 1%u32; + if negb (i5 s= 3%i32) then Fail_ Failure else ( - i5 <- list_nth_shared i32 ls 2%u32; - if negb (i5 s= 2%i32) then Fail_ Failure else Return tt)))))) + i6 <- list_nth_shared i32 ls 2%u32; + if negb (i6 s= 2%i32) then Fail_ Failure else Return tt)))))) . (** Unit test for [no_nested_borrows::test_list_functions] *) Check (test_list_functions )%return. -(** [no_nested_borrows::id_mut_pair1]: forward function +(** [no_nested_borrows::id_mut_pair1]: Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 *) -Definition id_mut_pair1 (T1 T2 : Type) (x : T1) (y : T2) : result (T1 * T2) := - Return (x, y) -. - -(** [no_nested_borrows::id_mut_pair1]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 *) -Definition id_mut_pair1_back - (T1 T2 : Type) (x : T1) (y : T2) (ret : (T1 * T2)) : result (T1 * T2) := - let (t, t0) := ret in Return (t, t0) -. - -(** [no_nested_borrows::id_mut_pair2]: forward function - Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 *) -Definition id_mut_pair2 (T1 T2 : Type) (p : (T1 * T2)) : result (T1 * T2) := - let (t, t0) := p in Return (t, t0) +Definition id_mut_pair1 + (T1 T2 : Type) (x : T1) (y : T2) : + result ((T1 * T2) * ((T1 * T2) -> result (T1 * T2))) + := + let back_'a := fun (ret : (T1 * T2)) => let (t, t1) := ret in Return (t, t1) + in + Return ((x, y), back_'a) . -(** [no_nested_borrows::id_mut_pair2]: backward function 0 +(** [no_nested_borrows::id_mut_pair2]: Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 *) -Definition id_mut_pair2_back - (T1 T2 : Type) (p : (T1 * T2)) (ret : (T1 * T2)) : result (T1 * T2) := - let (t, t0) := ret in Return (t, t0) +Definition id_mut_pair2 + (T1 T2 : Type) (p : (T1 * T2)) : + result ((T1 * T2) * ((T1 * T2) -> result (T1 * T2))) + := + let (t, t1) := p in + let back_'a := + fun (ret : (T1 * T2)) => let (t2, t3) := ret in Return (t2, t3) in + Return ((t, t1), back_'a) . -(** [no_nested_borrows::id_mut_pair3]: forward function +(** [no_nested_borrows::id_mut_pair3]: Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) -Definition id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : result (T1 * T2) := - Return (x, y) -. - -(** [no_nested_borrows::id_mut_pair3]: backward function 0 - Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) -Definition id_mut_pair3_back'a - (T1 T2 : Type) (x : T1) (y : T2) (ret : T1) : result T1 := - Return ret -. - -(** [no_nested_borrows::id_mut_pair3]: backward function 1 - Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) -Definition id_mut_pair3_back'b - (T1 T2 : Type) (x : T1) (y : T2) (ret : T2) : result T2 := - Return ret -. - -(** [no_nested_borrows::id_mut_pair4]: forward function - Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) -Definition id_mut_pair4 (T1 T2 : Type) (p : (T1 * T2)) : result (T1 * T2) := - let (t, t0) := p in Return (t, t0) +Definition id_mut_pair3 + (T1 T2 : Type) (x : T1) (y : T2) : + result ((T1 * T2) * (T1 -> result T1) * (T2 -> result T2)) + := + let back_'a := fun (ret : T1) => Return ret in + let back_'b := fun (ret : T2) => Return ret in + Return ((x, y), back_'a, back_'b) . -(** [no_nested_borrows::id_mut_pair4]: backward function 0 +(** [no_nested_borrows::id_mut_pair4]: Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) -Definition id_mut_pair4_back'a - (T1 T2 : Type) (p : (T1 * T2)) (ret : T1) : result T1 := - Return ret -. - -(** [no_nested_borrows::id_mut_pair4]: backward function 1 - Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) -Definition id_mut_pair4_back'b - (T1 T2 : Type) (p : (T1 * T2)) (ret : T2) : result T2 := - Return ret +Definition id_mut_pair4 + (T1 T2 : Type) (p : (T1 * T2)) : + result ((T1 * T2) * (T1 -> result T1) * (T2 -> result T2)) + := + let (t, t1) := p in + let back_'a := fun (ret : T1) => Return ret in + let back_'b := fun (ret : T2) => Return ret in + Return ((t, t1), back_'a, back_'b) . (** [no_nested_borrows::StructWithTuple] @@ -554,19 +530,19 @@ mkStructWithTuple_t { Arguments mkStructWithTuple_t { _ _ }. Arguments structWithTuple_p { _ _ }. -(** [no_nested_borrows::new_tuple1]: forward function +(** [no_nested_borrows::new_tuple1]: Source: 'src/no_nested_borrows.rs', lines 437:0-437:48 *) Definition new_tuple1 : result (StructWithTuple_t u32 u32) := Return {| structWithTuple_p := (1%u32, 2%u32) |} . -(** [no_nested_borrows::new_tuple2]: forward function +(** [no_nested_borrows::new_tuple2]: Source: 'src/no_nested_borrows.rs', lines 441:0-441:48 *) Definition new_tuple2 : result (StructWithTuple_t i16 i16) := Return {| structWithTuple_p := (1%i16, 2%i16) |} . -(** [no_nested_borrows::new_tuple3]: forward function +(** [no_nested_borrows::new_tuple3]: Source: 'src/no_nested_borrows.rs', lines 445:0-445:48 *) Definition new_tuple3 : result (StructWithTuple_t u64 i64) := Return {| structWithTuple_p := (1%u64, 2%i64) |} @@ -583,13 +559,13 @@ mkStructWithPair_t { Arguments mkStructWithPair_t { _ _ }. Arguments structWithPair_p { _ _ }. -(** [no_nested_borrows::new_pair1]: forward function +(** [no_nested_borrows::new_pair1]: Source: 'src/no_nested_borrows.rs', lines 454:0-454:46 *) Definition new_pair1 : result (StructWithPair_t u32 u32) := Return {| structWithPair_p := {| pair_x := 1%u32; pair_y := 2%u32 |} |} . -(** [no_nested_borrows::test_constants]: forward function +(** [no_nested_borrows::test_constants]: Source: 'src/no_nested_borrows.rs', lines 462:0-462:23 *) Definition test_constants : result unit := swt <- new_tuple1; @@ -597,14 +573,14 @@ Definition test_constants : result unit := if negb (i s= 1%u32) then Fail_ Failure else ( - swt0 <- new_tuple2; - let (i0, _) := swt0.(structWithTuple_p) in - if negb (i0 s= 1%i16) + swt1 <- new_tuple2; + let (i1, _) := swt1.(structWithTuple_p) in + if negb (i1 s= 1%i16) then Fail_ Failure else ( - swt1 <- new_tuple3; - let (i1, _) := swt1.(structWithTuple_p) in - if negb (i1 s= 1%u64) + swt2 <- new_tuple3; + let (i2, _) := swt2.(structWithTuple_p) in + if negb (i2 s= 1%u64) then Fail_ Failure else ( swp <- new_pair1; @@ -616,7 +592,7 @@ Definition test_constants : result unit := (** Unit test for [no_nested_borrows::test_constants] *) Check (test_constants )%return. -(** [no_nested_borrows::test_weird_borrows1]: forward function +(** [no_nested_borrows::test_weird_borrows1]: Source: 'src/no_nested_borrows.rs', lines 471:0-471:28 *) Definition test_weird_borrows1 : result unit := Return tt. @@ -624,65 +600,79 @@ Definition test_weird_borrows1 : result unit := (** Unit test for [no_nested_borrows::test_weird_borrows1] *) Check (test_weird_borrows1 )%return. -(** [no_nested_borrows::test_mem_replace]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [no_nested_borrows::test_mem_replace]: Source: 'src/no_nested_borrows.rs', lines 481:0-481:37 *) Definition test_mem_replace (px : u32) : result u32 := - let y := core_mem_replace u32 px 1%u32 in + let (y, _) := core_mem_replace u32 px 1%u32 in if negb (y s= 0%u32) then Fail_ Failure else Return 2%u32 . -(** [no_nested_borrows::test_shared_borrow_bool1]: forward function +(** [no_nested_borrows::test_shared_borrow_bool1]: Source: 'src/no_nested_borrows.rs', lines 488:0-488:47 *) Definition test_shared_borrow_bool1 (b : bool) : result u32 := if b then Return 0%u32 else Return 1%u32 . -(** [no_nested_borrows::test_shared_borrow_bool2]: forward function +(** [no_nested_borrows::test_shared_borrow_bool2]: Source: 'src/no_nested_borrows.rs', lines 501:0-501:40 *) Definition test_shared_borrow_bool2 : result u32 := Return 0%u32. -(** [no_nested_borrows::test_shared_borrow_enum1]: forward function +(** [no_nested_borrows::test_shared_borrow_enum1]: Source: 'src/no_nested_borrows.rs', lines 516:0-516:52 *) Definition test_shared_borrow_enum1 (l : List_t u32) : result u32 := - match l with | List_Cons i l0 => Return 1%u32 | List_Nil => Return 0%u32 end + match l with | List_Cons _ _ => Return 1%u32 | List_Nil => Return 0%u32 end . -(** [no_nested_borrows::test_shared_borrow_enum2]: forward function +(** [no_nested_borrows::test_shared_borrow_enum2]: Source: 'src/no_nested_borrows.rs', lines 528:0-528:40 *) Definition test_shared_borrow_enum2 : result u32 := Return 0%u32. -(** [no_nested_borrows::Tuple] +(** [no_nested_borrows::incr]: Source: 'src/no_nested_borrows.rs', lines 539:0-539:24 *) +Definition incr (x : u32) : result u32 := + u32_add x 1%u32. + +(** [no_nested_borrows::call_incr]: + Source: 'src/no_nested_borrows.rs', lines 543:0-543:35 *) +Definition call_incr (x : u32) : result u32 := + incr x. + +(** [no_nested_borrows::read_then_incr]: + Source: 'src/no_nested_borrows.rs', lines 548:0-548:41 *) +Definition read_then_incr (x : u32) : result (u32 * u32) := + x1 <- u32_add x 1%u32; Return (x, x1) +. + +(** [no_nested_borrows::Tuple] + Source: 'src/no_nested_borrows.rs', lines 554:0-554:24 *) Definition Tuple_t (T1 T2 : Type) : Type := T1 * T2. -(** [no_nested_borrows::use_tuple_struct]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) - Source: 'src/no_nested_borrows.rs', lines 541:0-541:48 *) +(** [no_nested_borrows::use_tuple_struct]: + Source: 'src/no_nested_borrows.rs', lines 556:0-556:48 *) Definition use_tuple_struct (x : Tuple_t u32 u32) : result (Tuple_t u32 u32) := let (_, i) := x in Return (1%u32, i) . -(** [no_nested_borrows::create_tuple_struct]: forward function - Source: 'src/no_nested_borrows.rs', lines 545:0-545:61 *) +(** [no_nested_borrows::create_tuple_struct]: + Source: 'src/no_nested_borrows.rs', lines 560:0-560:61 *) Definition create_tuple_struct (x : u32) (y : u64) : result (Tuple_t u32 u64) := Return (x, y) . (** [no_nested_borrows::IdType] - Source: 'src/no_nested_borrows.rs', lines 550:0-550:20 *) + Source: 'src/no_nested_borrows.rs', lines 565:0-565:20 *) Definition IdType_t (T : Type) : Type := T. -(** [no_nested_borrows::use_id_type]: forward function - Source: 'src/no_nested_borrows.rs', lines 552:0-552:40 *) +(** [no_nested_borrows::use_id_type]: + Source: 'src/no_nested_borrows.rs', lines 567:0-567:40 *) Definition use_id_type (T : Type) (x : IdType_t T) : result T := Return x. -(** [no_nested_borrows::create_id_type]: forward function - Source: 'src/no_nested_borrows.rs', lines 556:0-556:43 *) +(** [no_nested_borrows::create_id_type]: + Source: 'src/no_nested_borrows.rs', lines 571:0-571:43 *) Definition create_id_type (T : Type) (x : T) : result (IdType_t T) := Return x. diff --git a/tests/coq/misc/Primitives.v b/tests/coq/misc/Primitives.v index 84280b96..c0056073 100644 --- a/tests/coq/misc/Primitives.v +++ b/tests/coq/misc/Primitives.v @@ -67,8 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . -Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * (a -> a) := (x, fun x => x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. @@ -504,13 +503,15 @@ Arguments core_ops_index_Index_index {_ _}. (* Trait declaration: [core::ops::index::IndexMut] *) Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; - core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); - core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; + core_ops_index_IndexMut_index_mut : + Self -> + Idx -> + result (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) * + (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self)); }. Arguments mk_core_ops_index_IndexMut {_ _}. Arguments core_ops_index_IndexMut_indexInst {_ _}. Arguments core_ops_index_IndexMut_index_mut {_ _}. -Arguments core_ops_index_IndexMut_index_mut_back {_ _}. (* Trait declaration [core::ops::deref::Deref] *) Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { @@ -524,13 +525,14 @@ Arguments core_ops_deref_Deref_deref {_}. (* Trait declaration [core::ops::deref::DerefMut] *) Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; - core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); - core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; + core_ops_deref_DerefMut_deref_mut : + Self -> + result (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) * + (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self)); }. Arguments mk_core_ops_deref_DerefMut {_}. Arguments core_ops_deref_DerefMut_derefInst {_}. Arguments core_ops_deref_DerefMut_deref_mut {_}. -Arguments core_ops_deref_DerefMut_deref_mut_back {_}. Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { core_ops_range_Range_start : T; @@ -543,8 +545,8 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := + Return (x, fun x => Return x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -556,7 +558,6 @@ Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; - core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; |}. @@ -639,16 +640,9 @@ Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (l | right _ => Fail_ Failure end. -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. - Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_insert_fwd (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result unit := - if to_Z i if to_Z i result (alloc_vec_Vec T))) := + match alloc_vec_Vec_index_usize v i with + | Return x => + Return (x, alloc_vec_Vec_update_usize v i) + | Fail_ e => Fail_ e + end. + (* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. @@ -669,25 +671,23 @@ Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceI core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; core_slice_index_SliceIndex_Output : Type; core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_mut : + Self -> T -> result (option core_slice_index_SliceIndex_Output * (option core_slice_index_SliceIndex_Output -> result T)); core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_index_mut : + Self -> T -> result (core_slice_index_SliceIndex_Output * (core_slice_index_SliceIndex_Output -> result T)); }. Arguments mk_core_slice_index_SliceIndex {_ _}. Arguments core_slice_index_SliceIndex_sealedInst {_ _}. Arguments core_slice_index_SliceIndex_Output {_ _}. Arguments core_slice_index_SliceIndex_get {_ _}. Arguments core_slice_index_SliceIndex_get_mut {_ _}. -Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. Arguments core_slice_index_SliceIndex_index {_ _}. Arguments core_slice_index_SliceIndex_index_mut {_ _}. -Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. (* [core::slice::index::[T]::index]: forward function *) Definition core_slice_index_Slice_index @@ -704,11 +704,9 @@ Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Ra (* [core::slice::index::Range::get_mut]: forward function *) Axiom core_slice_index_RangeUsize_get_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (option (slice T)). - -(* [core::slice::index::Range::get_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_get_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + forall (T : Type), + core_ops_range_Range usize -> slice T -> + result (option (slice T) * (option (slice T) -> result (slice T))). (* [core::slice::index::Range::get_unchecked]: forward function *) Definition core_slice_index_RangeUsize_get_unchecked @@ -732,21 +730,14 @@ Axiom core_slice_index_RangeUsize_index : (* [core::slice::index::Range::index_mut]: forward function *) Axiom core_slice_index_RangeUsize_index_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). - -(* [core::slice::index::Range::index_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_index_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T * (slice T -> result (slice T))). (* [core::slice::index::[T]::index_mut]: forward function *) Axiom core_slice_index_Slice_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). - -(* [core::slice::index::[T]::index_mut]: backward function 0 *) -Axiom core_slice_index_Slice_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + slice T -> Idx -> + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (slice T))). (* [core::array::[T; N]::index]: forward function *) Axiom core_array_Array_index : @@ -756,12 +747,9 @@ Axiom core_array_Array_index : (* [core::array::[T; N]::index_mut]: forward function *) Axiom core_array_Array_index_mut : forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). - -(* [core::array::[T; N]::index_mut]: backward function 0 *) -Axiom core_array_Array_index_mut_back : - forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + (a : array T N) (i : Idx), + result (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) * + (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) -> result (array T N))). (* Trait implementation: [core::slice::index::private_slice_index::Range] *) Definition core_slice_index_private_slice_index_SealedRangeUsizeInst @@ -774,12 +762,10 @@ Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := slice T; core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_RangeUsize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_RangeUsize_index_mut_back T; |}. (* Trait implementation: [core::slice::index::[T]] *) @@ -796,7 +782,6 @@ Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) core_ops_index_IndexMut (slice T) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; |}. (* Trait implementation: [core::array::[T; N]] *) @@ -813,18 +798,14 @@ Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) core_ops_index_IndexMut (array T N) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; - core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; |}. (* [core::slice::index::usize::get]: forward function *) Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). (* [core::slice::index::usize::get_mut]: forward function *) -Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). - -(* [core::slice::index::usize::get_mut]: backward function 0 *) -Axiom core_slice_index_usize_get_mut_back : - forall (T : Type), usize -> slice T -> option T -> result (slice T). +Axiom core_slice_index_usize_get_mut : + forall (T : Type), usize -> slice T -> result (option T * (option T -> result (slice T))). (* [core::slice::index::usize::get_unchecked]: forward function *) Axiom core_slice_index_usize_get_unchecked : @@ -838,11 +819,8 @@ Axiom core_slice_index_usize_get_unchecked_mut : Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. (* [core::slice::index::usize::index_mut]: forward function *) -Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. - -(* [core::slice::index::usize::index_mut]: backward function 0 *) -Axiom core_slice_index_usize_index_mut_back : - forall (T : Type), usize -> slice T -> T -> result (slice T). +Axiom core_slice_index_usize_index_mut : + forall (T : Type), usize -> slice T -> result (T * (T -> result (slice T))). (* Trait implementation: [core::slice::index::private_slice_index::usize] *) Definition core_slice_index_private_slice_index_SealedUsizeInst @@ -855,12 +833,10 @@ Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := T; core_slice_index_SliceIndex_get := core_slice_index_usize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_usize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; |}. (* [alloc::vec::Vec::index]: forward function *) @@ -869,12 +845,9 @@ Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_Slice (* [alloc::vec::Vec::index_mut]: forward function *) Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). - -(* [alloc::vec::Vec::index_mut]: backward function 0 *) -Axiom alloc_vec_Vec_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + (Self : alloc_vec_Vec T) (i : Idx), + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (alloc_vec_Vec T))). (* Trait implementation: [alloc::vec::Vec] *) Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) @@ -890,7 +863,6 @@ Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; |}. (*** Theorems *) @@ -901,10 +873,6 @@ Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usiz Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = - alloc_vec_Vec_index_usize v i. - -Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x = - alloc_vec_Vec_update_usize v i x. + alloc_vec_Vec_index_mut_usize v i. End Primitives. -- cgit v1.2.3 From b230ddacd44a1ca1804940bf89253bde8de7ffe1 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 20:12:00 +0100 Subject: Fix a minor issue with the extraction of loops when merging the fwd/back functions --- compiler/SymbolicToPure.ml | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 4674b61c..cd367d83 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -123,7 +123,7 @@ type loop_info = { generics : generic_args; forward_inputs : texpression list option; (** The forward inputs are initialized at [None] *) - forward_output_no_state_no_result : var option; + forward_output_no_state_no_result : texpression option; (** The forward outputs are initialized at [None] *) back_outputs : ty list RegionGroupId.Map.t; (** The map from region group ids to the types of the values given back @@ -1956,10 +1956,7 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) *) let output = match ctx.bid with - | None -> - (* Forward *) - mk_texpression_from_var - (Option.get loop_info.forward_output_no_state_no_result) + | None -> Option.get loop_info.forward_output_no_state_no_result | Some _ -> (* Backward *) (* Group the variables in which we stored the values we need to give back. @@ -1984,7 +1981,7 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) else output in (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) - mk_result_return_texpression output + mk_emeta (Tag "return_with_loop") (mk_result_return_texpression output) and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : texpression = @@ -3207,7 +3204,20 @@ and translate_forward_end (ectx : C.eval_ctx) let effect_info = get_fun_effect_info ctx (FunId fid) None ctx.bid in (* Introduce a fresh output value for the forward function *) - let ctx, output_var = fresh_var None ctx.sg.fwd_output ctx in + let ctx, fwd_output, output_pat = + if ctx.sg.fwd_info.ignore_output then + (* Note that we still need the forward output (which is unit), + because even though the loop function will ignore the forward output, + the forward expression will still compute an output (which + will have type unit - otherwise we can't ignore it). *) + (ctx, mk_unit_rvalue, []) + else + let ctx, output_var = fresh_var None ctx.sg.fwd_output ctx in + ( ctx, + mk_texpression_from_var output_var, + [ mk_typed_pattern_from_var output_var None ] ) + in + (* Introduce fresh variables for the backward functions of the loop. For now, the backward functions of the loop are the same as the @@ -3236,10 +3246,8 @@ and translate_forward_end (ectx : C.eval_ctx) (* Introduce patterns *) let args, ctx, out_pats = - (* Create the pattern for the output value *) - let output_pat = mk_typed_pattern_from_var output_var None in (* Add the returned backward functions (they might be empty) *) - let output_pat = mk_simpl_tuple_pattern (output_pat :: back_funs) in + let output_pat = mk_simpl_tuple_pattern (output_pat @ back_funs) in (* Depending on the function effects: * - add the fuel @@ -3261,7 +3269,7 @@ and translate_forward_end (ectx : C.eval_ctx) { loop_info with forward_inputs = Some args; - forward_output_no_state_no_result = Some output_var; + forward_output_no_state_no_result = Some fwd_output; back_funs = back_funs_map; } in -- cgit v1.2.3 From 70d506d148e5ae1a3e4115034161f449aff666ed Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 21:03:17 +0100 Subject: Fix the output type of the loops backward functions --- compiler/PrintPure.ml | 11 ++------ compiler/Pure.ml | 4 +-- compiler/PureMicroPasses.ml | 25 +++-------------- compiler/PureTypeCheck.ml | 6 ----- compiler/SymbolicToPure.ml | 65 ++++++++++++++++++++++++++++++++++++++++----- 5 files changed, 65 insertions(+), 46 deletions(-) diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index 315dd512..66475d02 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -711,21 +711,14 @@ and loop_to_string (env : fmt_env) (indent : string) (indent_incr : string) ^ String.concat "; " (List.map (var_to_string env) loop.inputs) ^ "]" in - let back_output_tys = - let tys = - match loop.back_output_tys with - | None -> "" - | Some tys -> String.concat "; " (List.map (ty_to_string env false) tys) - in - "back_output_tys: [" ^ tys ^ "]" - in + let output_ty = "output_ty: " ^ ty_to_string env false loop.output_ty in let fun_end = texpression_to_string env false indent2 indent_incr loop.fun_end in let loop_body = texpression_to_string env false indent2 indent_incr loop.loop_body in - "loop {\n" ^ indent1 ^ loop_inputs ^ "\n" ^ indent1 ^ back_output_tys ^ "\n" + "loop {\n" ^ indent1 ^ loop_inputs ^ "\n" ^ indent1 ^ output_ty ^ "\n" ^ indent1 ^ "fun_end: {\n" ^ indent2 ^ fun_end ^ "\n" ^ indent1 ^ "}\n" ^ indent1 ^ "loop_body: {\n" ^ indent2 ^ loop_body ^ "\n" ^ indent1 ^ "}\n" ^ indent ^ "}" diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 71531688..a879ba37 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -754,9 +754,7 @@ and loop = { inputs : var list; inputs_lvs : typed_pattern list; (** The inputs seen as patterns. See {!fun_body}. *) - back_output_tys : ty list option; - (** The types of the given back values, if we ar esynthesizing a backward - function *) + output_ty : ty; (** The output type of the loop *) loop_body : texpression; } diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 67495ab5..e7e9d5e1 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -459,7 +459,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = input_state; inputs; inputs_lvs; - back_output_tys; + output_ty; loop_body; } = loop @@ -478,7 +478,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = input_state; inputs; inputs_lvs; - back_output_tys; + output_ty; loop_body; } in @@ -1498,26 +1498,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : List.concat [ fuel; fwd_inputs; fwd_state; back_inputs ] in - let output = - match loop.back_output_tys with - | None -> - (* Forward function: the return type is the same as the - parent function *) - fun_sig.output - | Some doutputs -> - (* Backward function: custom return type *) - let output = mk_simpl_tuple_ty doutputs in - let output = - if loop_fwd_effect_info.stateful then - mk_simpl_tuple_ty [ mk_state_ty; output ] - else output - in - let output = - if loop_fwd_effect_info.can_fail then mk_result_ty output - else output - in - output - in + let output = loop.output_ty in let loop_sig = { diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml index d60d6a05..a989fd3b 100644 --- a/compiler/PureTypeCheck.ml +++ b/compiler/PureTypeCheck.ml @@ -188,12 +188,6 @@ let rec check_texpression (ctx : tc_ctx) (e : texpression) : unit = List.iter check_branch branches) | Loop loop -> assert (loop.fun_end.ty = e.ty); - (* If we translate forward functions, the type of the loop is the same - as the type of the parent expression - in case of backward functions, - the loop doesn't necessarily give back the same values as the parent - function - *) - assert (Option.is_some loop.back_output_tys || loop.loop_body.ty = e.ty); check_texpression ctx loop.fun_end; check_texpression ctx loop.loop_body | StructUpdate supd -> ( diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index cd367d83..bf92482a 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -3368,7 +3368,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (* Compute the backward outputs *) let ctx = ref ctx in let rg_to_given_back_tys = - T.RegionGroupId.Map.map + RegionGroupId.Map.map (fun (_, tys) -> (* The types shouldn't contain borrows - we can translate them as forward types *) List.map @@ -3380,10 +3380,63 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = in let ctx = !ctx in - let back_output_tys = - match ctx.bid with - | None -> None - | Some rg_id -> Some (T.RegionGroupId.Map.find rg_id rg_to_given_back_tys) + (* The output type of the loop function *) + let output_ty = + if !Config.return_back_funs then + (* The loop backward functions consume the same additional inputs as the parent + function, but have custom outputs *) + let back_sgs = RegionGroupId.Map.values ctx.sg.back_sg in + let given_back_tys = RegionGroupId.Map.values rg_to_given_back_tys in + let back_tys = + List.filter_map + (fun ((back_sg, given_back) : back_sg_info * ty list) -> + let effect_info = back_sg.effect_info in + (* Compute the input/output types *) + let inputs = List.map snd back_sg.inputs in + let outputs = given_back in + (* Filter if necessary *) + if !Config.simplify_merged_fwd_backs && inputs = [] && outputs = [] + then None + else + let output = mk_simpl_tuple_ty outputs in + let output = + mk_back_output_ty_from_effect_info effect_info inputs output + in + let ty = mk_arrows inputs output in + Some ty) + (List.combine back_sgs given_back_tys) + in + let output = + if ctx.sg.fwd_info.ignore_output then back_tys + else ctx.sg.fwd_output :: back_tys + in + let output = mk_simpl_tuple_ty output in + let effect_info = ctx.sg.fwd_info.effect_info in + let output = + if effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; output ] + else output + in + if effect_info.can_fail && inputs <> [] then mk_result_ty output + else output + else + match ctx.bid with + | None -> + (* Forward function: same type as the parent function *) + (translate_fun_sig_from_decomposed ctx.sg None).output + | Some rg_id -> + (* Backward function: custom return type *) + let doutputs = T.RegionGroupId.Map.find rg_id rg_to_given_back_tys in + let output = mk_simpl_tuple_ty doutputs in + let fwd_effect_info = ctx.sg.fwd_info.effect_info in + let output = + if fwd_effect_info.stateful then + mk_simpl_tuple_ty [ mk_state_ty; output ] + else output + in + let output = + if fwd_effect_info.can_fail then mk_result_ty output else output + in + output in (* Add the loop information in the context *) @@ -3460,7 +3513,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = input_state; inputs; inputs_lvs; - back_output_tys; + output_ty; loop_body; } in -- cgit v1.2.3 From dd7552bec1be1695682801fca6ba6dfcfa990fbb Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 21:03:59 +0100 Subject: Update the computation of the effect info for the loops --- compiler/SymbolicToPure.ml | 141 ++++++++++++++++++++++++++++++--------------- 1 file changed, 95 insertions(+), 46 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index bf92482a..f0d1ca62 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -134,6 +134,8 @@ type loop_info = { Initialized with [None], gets updated to [Some] only if we merge the fwd/back functions. *) + fwd_effect_info : fun_effect_info; + back_effect_infos : fun_effect_info RegionGroupId.Map.t; } [@@deriving show] @@ -922,17 +924,31 @@ let compute_raw_fun_effect_info (fun_infos : fun_info A.FunDeclId.Map.t) let get_fun_effect_info (ctx : bs_ctx) (fun_id : A.fun_id_or_trait_method_ref) (lid : V.LoopId.id option) (gid : T.RegionGroupId.id option) : fun_effect_info = - match fun_id with - | TraitMethod (_, _, fid) | FunId (FRegular fid) -> - let dsg = A.FunDeclId.Map.find fid ctx.fun_dsigs in - let info = - match gid with - | None -> dsg.fwd_info.effect_info - | Some gid -> (RegionGroupId.Map.find gid dsg.back_sg).effect_info - in - { info with is_rec = info.is_rec || Option.is_some lid } - | FunId (FAssumed _) -> - compute_raw_fun_effect_info ctx.fun_ctx.fun_infos fun_id lid gid + match lid with + | None -> ( + match fun_id with + | TraitMethod (_, _, fid) | FunId (FRegular fid) -> + let dsg = A.FunDeclId.Map.find fid ctx.fun_dsigs in + let info = + match gid with + | None -> dsg.fwd_info.effect_info + | Some gid -> (RegionGroupId.Map.find gid dsg.back_sg).effect_info + in + { info with is_rec = info.is_rec || Option.is_some lid } + | FunId (FAssumed _) -> + compute_raw_fun_effect_info ctx.fun_ctx.fun_infos fun_id lid gid) + | Some lid -> ( + (* This is necessarily for the current function *) + match fun_id with + | FunId (FRegular fid) -> ( + assert (fid = ctx.fun_decl.def_id); + (* Lookup the loop *) + let lid = V.LoopId.Map.find lid ctx.loop_ids_map in + let loop_info = LoopId.Map.find lid ctx.loops in + match gid with + | None -> loop_info.fwd_effect_info + | Some gid -> RegionGroupId.Map.find gid loop_info.back_effect_infos) + | _ -> raise (Failure "Unreachable")) (** Translate a function signature to a decomposed function signature. @@ -1901,7 +1917,7 @@ and translate_panic (ctx : bs_ctx) : texpression = Remark: in case we merge the forward/backward functions, we introduce those in [translate_forward_end]. - *) +*) and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) (ctx : bs_ctx) : texpression = (* There are two cases: @@ -3381,31 +3397,47 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = let ctx = !ctx in (* The output type of the loop function *) - let output_ty = + let fwd_effect_info = { ctx.sg.fwd_info.effect_info with is_rec = true } in + let back_effect_infos, output_ty = if !Config.return_back_funs then (* The loop backward functions consume the same additional inputs as the parent function, but have custom outputs *) - let back_sgs = RegionGroupId.Map.values ctx.sg.back_sg in + let back_sgs = RegionGroupId.Map.bindings ctx.sg.back_sg in let given_back_tys = RegionGroupId.Map.values rg_to_given_back_tys in - let back_tys = - List.filter_map - (fun ((back_sg, given_back) : back_sg_info * ty list) -> + let back_info_tys = + List.map + (fun (((id, back_sg), given_back) : (_ * back_sg_info) * ty list) -> + (* Remark: the effect info of the backward function for the loop + is almost the same as for the backward function of the parent function. + Quite importantly, the fact that the function is stateful and/or can fail + mostly depends on whether it has inputs or not, and the backward functions + for the loops have the same inputs as the backward functions for the parent + function. + *) let effect_info = back_sg.effect_info in + let effect_info = { effect_info with is_rec = true } in (* Compute the input/output types *) let inputs = List.map snd back_sg.inputs in let outputs = given_back in (* Filter if necessary *) - if !Config.simplify_merged_fwd_backs && inputs = [] && outputs = [] - then None - else - let output = mk_simpl_tuple_ty outputs in - let output = - mk_back_output_ty_from_effect_info effect_info inputs output - in - let ty = mk_arrows inputs output in - Some ty) + let ty = + if + !Config.simplify_merged_fwd_backs && inputs = [] && outputs = [] + then None + else + let output = mk_simpl_tuple_ty outputs in + let output = + mk_back_output_ty_from_effect_info effect_info inputs output + in + let ty = mk_arrows inputs output in + Some ty + in + ((id, effect_info), ty)) (List.combine back_sgs given_back_tys) in + let back_info = List.map fst back_info_tys in + let back_info = RegionGroupId.Map.of_list back_info in + let back_tys = List.filter_map snd back_info_tys in let output = if ctx.sg.fwd_info.ignore_output then back_tys else ctx.sg.fwd_output :: back_tys @@ -3416,27 +3448,42 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = if effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; output ] else output in - if effect_info.can_fail && inputs <> [] then mk_result_ty output - else output + let output = + if effect_info.can_fail && inputs <> [] then mk_result_ty output + else output + in + (back_info, output) else - match ctx.bid with - | None -> - (* Forward function: same type as the parent function *) - (translate_fun_sig_from_decomposed ctx.sg None).output - | Some rg_id -> - (* Backward function: custom return type *) - let doutputs = T.RegionGroupId.Map.find rg_id rg_to_given_back_tys in - let output = mk_simpl_tuple_ty doutputs in - let fwd_effect_info = ctx.sg.fwd_info.effect_info in - let output = - if fwd_effect_info.stateful then - mk_simpl_tuple_ty [ mk_state_ty; output ] - else output - in - let output = - if fwd_effect_info.can_fail then mk_result_ty output else output - in - output + let back_info = + RegionGroupId.Map.of_list + (List.map + (fun ((id, back_sg) : _ * back_sg_info) -> + (id, { back_sg.effect_info with is_rec = true })) + (RegionGroupId.Map.bindings ctx.sg.back_sg)) + in + let output = + match ctx.bid with + | None -> + (* Forward function: same type as the parent function *) + (translate_fun_sig_from_decomposed ctx.sg None).output + | Some rg_id -> + (* Backward function: custom return type *) + let doutputs = + T.RegionGroupId.Map.find rg_id rg_to_given_back_tys + in + let output = mk_simpl_tuple_ty doutputs in + let fwd_effect_info = ctx.sg.fwd_info.effect_info in + let output = + if fwd_effect_info.stateful then + mk_simpl_tuple_ty [ mk_state_ty; output ] + else output + in + let output = + if fwd_effect_info.can_fail then mk_result_ty output else output + in + output + in + (back_info, output) in (* Add the loop information in the context *) @@ -3480,6 +3527,8 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = forward_output_no_state_no_result = None; back_outputs = rg_to_given_back_tys; back_funs = None; + fwd_effect_info; + back_effect_infos; } in let loops = LoopId.Map.add loop_id loop_info ctx.loops in -- cgit v1.2.3 From d9ace7d5f1968f26b586fb712c725b2ce51086f8 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 21:50:11 +0100 Subject: Fix the models for core::mem::replace --- backends/coq/Primitives.v | 2 +- backends/fstar/merge/Primitives.fst | 2 +- backends/lean/Base/Primitives/Base.lean | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index c0056073..e6d3118f 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -67,7 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a * (a -> a) := (x, fun x => x) . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * a := (x, x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. diff --git a/backends/fstar/merge/Primitives.fst b/backends/fstar/merge/Primitives.fst index 6b8dbeb7..8011efa1 100644 --- a/backends/fstar/merge/Primitives.fst +++ b/backends/fstar/merge/Primitives.fst @@ -55,7 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a & (a -> a) = (x, (fun x -> x)) +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } diff --git a/backends/lean/Base/Primitives/Base.lean b/backends/lean/Base/Primitives/Base.lean index 321c39a8..3d70c84a 100644 --- a/backends/lean/Base/Primitives/Base.lean +++ b/backends/lean/Base/Primitives/Base.lean @@ -120,7 +120,7 @@ def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := -- MISC -- ---------- -@[simp] def core.mem.replace (a : Type) (x : a) (_ : a) : a × (a → a) := (x, λ x => x) +@[simp] def core.mem.replace (a : Type) (x : a) (_ : a) : a × a := (x, x) /-- Aeneas-translated function -- useful to reduce non-recursive definitions. Use with `simp [ aeneas ]` -/ -- cgit v1.2.3 From 9a8e43df626400aacdfcb9d2cf2eec38d71d2d73 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 23:04:31 +0100 Subject: Fix minor issues --- backends/coq/Primitives.v | 21 +++++++ backends/fstar/merge/Primitives.fst | 21 ++++++- backends/lean/Base/Primitives/ArraySlice.lean | 42 ++++++++++++++ compiler/ExtractBase.ml | 81 ++++++++++++++++++--------- compiler/PureUtils.ml | 2 +- compiler/SymbolicToPure.ml | 57 ++++++++++++++++--- 6 files changed, 186 insertions(+), 38 deletions(-) diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index e6d3118f..990e27e4 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -585,6 +585,13 @@ Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usize) : + result (T * (T -> result (array T n))) := + match array_index_usize T n a i with + | Fail_ e => Fail_ e + | Return x => Return (x, array_update_usize T n a i) + end. + (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. @@ -592,11 +599,25 @@ Axiom slice_len : forall (T : Type) (s : slice T), usize. Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : + result (T * (T -> result (slice T))) := + match slice_index_usize T s i with + | Fail_ e => Fail_ e + | Return x => Return (x, slice_update_usize T s i) + end. + (*** Subslices *) Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : + result (slice T * (slice T -> result (array T n))) := + match array_to_slice T n a with + | Fail_ e => Fail_ e + | Return x => Return (x, array_from_slice T n a) + end. + Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). diff --git a/backends/fstar/merge/Primitives.fst b/backends/fstar/merge/Primitives.fst index 8011efa1..fca80829 100644 --- a/backends/fstar/merge/Primitives.fst +++ b/backends/fstar/merge/Primitives.fst @@ -531,10 +531,18 @@ let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : resu if i < length x then Return (index x i) else Fail Failure -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : + result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure +let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : + result (a & (a -> result (array a n))) = + match array_index_usize a n x i with + | Fail e -> Fail e + | Return v -> + Return (v, array_update_usize a n x i) + (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -548,6 +556,13 @@ let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result ( if i < length x then Return (list_update x i nx) else Fail Failure +let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : + result (a & (a -> result (slice a))) = + match slice_index_usize a s i with + | Fail e -> Fail e + | Return x -> + Return (x, slice_update_usize a s i) + (*** Subslices *) let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x @@ -555,6 +570,10 @@ let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : res if length s = n then Return s else Fail Failure +let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : + result (slice a & (slice a -> result (array a n))) = + Return (x, array_from_slice a n x) + // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index 59432a0b..5057fb01 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -93,6 +93,21 @@ theorem Array.update_usize_spec {α : Type u} {n : Usize} (v: Array α n) (i: Us . simp_all [length]; cases h <;> scalar_tac . simp_all +def Array.index_mut_usize (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : + Result (α × (α -> Result (Array α n))) := do + let x ← index_usize α n v i + ret (x, update_usize α n v i) + +@[pspec] +theorem Array.index_mut_usize_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) + (hbound : i.val < v.length) : + ∃ x back, v.index_mut_usize α n i = ret (x, back) ∧ + x = v.val.index i.val ∧ + back = update_usize α n v i := by + simp only [index_mut_usize, Bind.bind, bind] + have ⟨ x, h ⟩ := index_usize_spec v i hbound + simp [h] + def Slice (α : Type u) := { l : List α // l.length ≤ Usize.max } instance (a : Type u) : Arith.HasIntProp (Slice a) where @@ -167,6 +182,21 @@ theorem Slice.update_usize_spec {α : Type u} (v: Slice α) (i: Usize) (x : α) . simp_all [length]; cases h <;> scalar_tac . simp_all +def Slice.index_mut_usize (α : Type u) (v: Slice α) (i: Usize) : + Result (α × (α → Result (Slice α))) := do + let x ← Slice.index_usize α v i + ret (x, Slice.update_usize α v i) + +@[pspec] +theorem Slice.index_mut_usize_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) + (hbound : i.val < v.length) : + ∃ x back, v.index_mut_usize α i = ret (x, back) ∧ + x = v.val.index i.val ∧ + back = Slice.update_usize α v i := by + simp only [index_mut_usize, Bind.bind, bind] + have ⟨ x, h ⟩ := Slice.index_usize_spec v i hbound + simp [h] + /- Array to slice/subslices -/ /- We could make this function not use the `Result` type. By making it monadic, we @@ -190,6 +220,18 @@ theorem Array.from_slice_spec {α : Type u} {n : Usize} (a : Array α n) (ns : S ∃ na, from_slice α n a ns = ret na ∧ na.val = ns.val := by simp [from_slice, *] +def Array.to_slice_mut (α : Type u) (n : Usize) (a : Array α n) : + Result (Slice α × (Slice α → Result (Array α n))) := do + let s ← Array.to_slice α n a + ret (s, Array.from_slice α n a) + +@[pspec] +theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) : + ∃ s back, to_slice_mut α n v = ret (s, back) ∧ + v.val = s.val ∧ + back = Array.from_slice α n v + := by simp [to_slice_mut, to_slice] + def Array.subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := -- TODO: not completely sure here if r.start.val < r.end_.val ∧ r.end_.val ≤ a.val.len then diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 0af7a9b4..db887539 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -1051,33 +1051,60 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list = let assumed_llbc_functions () : (A.assumed_fun_id * T.RegionGroupId.id option * string) list = let rg0 = Some T.RegionGroupId.zero in - match !backend with - | FStar | Coq | HOL4 -> - [ - (ArrayIndexShared, None, "array_index_usize"); - (ArrayIndexMut, None, "array_index_usize"); - (ArrayIndexMut, rg0, "array_update_usize"); - (ArrayToSliceShared, None, "array_to_slice"); - (ArrayToSliceMut, None, "array_to_slice"); - (ArrayToSliceMut, rg0, "array_from_slice"); - (ArrayRepeat, None, "array_repeat"); - (SliceIndexShared, None, "slice_index_usize"); - (SliceIndexMut, None, "slice_index_usize"); - (SliceIndexMut, rg0, "slice_update_usize"); - ] - | Lean -> - [ - (ArrayIndexShared, None, "Array.index_usize"); - (ArrayIndexMut, None, "Array.index_usize"); - (ArrayIndexMut, rg0, "Array.update_usize"); - (ArrayToSliceShared, None, "Array.to_slice"); - (ArrayToSliceMut, None, "Array.to_slice"); - (ArrayToSliceMut, rg0, "Array.from_slice"); - (ArrayRepeat, None, "Array.repeat"); - (SliceIndexShared, None, "Slice.index_usize"); - (SliceIndexMut, None, "Slice.index_usize"); - (SliceIndexMut, rg0, "Slice.update_usize"); - ] + let regular : (A.assumed_fun_id * T.RegionGroupId.id option * string) list = + match !backend with + | FStar | Coq | HOL4 -> + [ + (ArrayIndexShared, None, "array_index_usize"); + (ArrayToSliceShared, None, "array_to_slice"); + (ArrayRepeat, None, "array_repeat"); + (SliceIndexShared, None, "slice_index_usize"); + ] + | Lean -> + [ + (ArrayIndexShared, None, "Array.index_usize"); + (ArrayToSliceShared, None, "Array.to_slice"); + (ArrayRepeat, None, "Array.repeat"); + (SliceIndexShared, None, "Slice.index_usize"); + ] + in + let mut_funs : (A.assumed_fun_id * T.RegionGroupId.id option * string) list = + if !Config.return_back_funs then + match !backend with + | FStar | Coq | HOL4 -> + [ + (ArrayIndexMut, None, "array_index_mut_usize"); + (ArrayToSliceMut, None, "array_to_slice_mut"); + (SliceIndexMut, None, "slice_index_mut_usize"); + ] + | Lean -> + [ + (ArrayIndexMut, None, "Array.index_mut_usize"); + (ArrayToSliceMut, None, "Array.to_slice_mut"); + (SliceIndexMut, None, "Slice.index_mut_usize"); + ] + else + match !backend with + | FStar | Coq | HOL4 -> + [ + (ArrayIndexMut, None, "array_index_usize"); + (ArrayIndexMut, rg0, "array_update_usize"); + (ArrayToSliceMut, None, "array_to_slice"); + (ArrayToSliceMut, rg0, "array_from_slice"); + (SliceIndexMut, None, "slice_index_usize"); + (SliceIndexMut, rg0, "slice_update_usize"); + ] + | Lean -> + [ + (ArrayIndexMut, None, "Array.index_usize"); + (ArrayIndexMut, rg0, "Array.update_usize"); + (ArrayToSliceMut, None, "Array.to_slice"); + (ArrayToSliceMut, rg0, "Array.from_slice"); + (SliceIndexMut, None, "Slice.index_usize"); + (SliceIndexMut, rg0, "Slice.update_usize"); + ] + in + regular @ mut_funs let assumed_pure_functions () : (pure_assumed_fun_id * string) list = match !backend with diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index cc439e64..80bf3c42 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -731,7 +731,7 @@ let mk_lambda_from_var (var : var) (mp : mplace option) (e : texpression) : let mk_lambdas_from_vars (vars : var list) (mps : mplace option list) (e : texpression) : texpression = let vars = List.combine vars mps in - List.fold_left (fun e (v, mp) -> mk_lambda_from_var v mp e) e vars + List.fold_right (fun (v, mp) e -> mk_lambda_from_var v mp e) vars e let rec destruct_lambdas (e : texpression) : typed_pattern list * texpression = match e.e with diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index f0d1ca62..3a50e495 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -734,11 +734,15 @@ let rec translate_back_ty (type_infos : type_infos) None | TTraitType (trait_ref, generics, type_name) -> assert (generics.regions = []); - (* Translate the trait ref and the generics as "forward" generics - - we do not want to filter any type *) - let trait_ref = translate_fwd_trait_ref type_infos trait_ref in - let generics = translate_fwd_generic_args type_infos generics in - Some (TTraitType (trait_ref, generics, type_name)) + assert ( + AssociatedTypes.trait_instance_id_is_local_clause trait_ref.trait_id); + if inside_mut then + (* Translate the trait ref and the generics as "forward" generics - + we do not want to filter any type *) + let trait_ref = translate_fwd_trait_ref type_infos trait_ref in + let generics = translate_fwd_generic_args type_infos generics in + Some (TTraitType (trait_ref, generics, type_name)) + else None | TArrow _ -> raise (Failure "TODO") (** Simply calls [translate_back_ty] *) @@ -1056,7 +1060,21 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed Upon ending the abstraction for 'a, we need to get back the borrow the function returned. *) - List.filter_map (translate_back_ty_for_gid gid) [ sg.output ] + let inputs = + List.filter_map (translate_back_ty_for_gid gid) [ sg.output ] + in + log#ldebug + (lazy + (let ctx = Print.Contexts.decls_ctx_to_fmt_env decls_ctx in + let pctx = PrintPure.decls_ctx_to_fmt_env decls_ctx in + let output = Print.Types.ty_to_string ctx sg.output in + let inputs = + Print.list_to_string (PrintPure.ty_to_string pctx false) inputs + in + "translate_back_inputs_for_gid:" ^ "\n- gid: " + ^ RegionGroupId.to_string gid + ^ "\n- output: " ^ output ^ "\n- back inputs: " ^ inputs ^ "\n")); + inputs in let compute_back_outputs_for_gid (gid : RegionGroupId.id) : string option list * ty list = @@ -1080,7 +1098,21 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed let outputs = List.map (fun (name, opt_ty) -> (name, Option.get opt_ty)) outputs in - List.split outputs + let names, outputs = List.split outputs in + log#ldebug + (lazy + (let ctx = Print.Contexts.decls_ctx_to_fmt_env decls_ctx in + let pctx = PrintPure.decls_ctx_to_fmt_env decls_ctx in + let inputs = + Print.list_to_string (Print.Types.ty_to_string ctx) sg.inputs + in + let outputs = + Print.list_to_string (PrintPure.ty_to_string pctx false) outputs + in + "compute_back_outputs_for_gid:" ^ "\n- gid: " + ^ RegionGroupId.to_string gid + ^ "\n- inputs: " ^ inputs ^ "\n- back outputs: " ^ outputs ^ "\n")); + (names, outputs) in let compute_back_info_for_group (rg : T.region_var_group) : RegionGroupId.id * back_sg_info = @@ -1201,8 +1233,15 @@ let translate_fun_sig_from_decl_to_decomposed (decls_ctx : C.decls_ctx) (fun (v : LlbcAst.var) -> v.name) (LlbcAstUtils.fun_body_get_input_vars body) in - translate_fun_sig_to_decomposed decls_ctx fdef.def_id fdef.signature - input_names + let sg = + translate_fun_sig_to_decomposed decls_ctx fdef.def_id fdef.signature + input_names + in + log#ldebug + (lazy + ("translate_fun_sig_from_decl_to_decomposed:" ^ "\n- name: " + ^ T.show_name fdef.name ^ "\n- sg:\n" ^ show_decomposed_fun_sig sg ^ "\n")); + sg let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty = -- cgit v1.2.3 From a0c58326c43a7a8026b3d4c158017bf126180e90 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 22 Dec 2023 23:23:30 +0100 Subject: Regenerate the test files and add the fstar-split tests --- tests/coq/array/Array.v | 421 ++- tests/coq/array/Primitives.v | 137 +- tests/coq/betree/BetreeMain_Funs.v | 1052 +++---- .../coq/betree/BetreeMain_FunsExternal_Template.v | 10 +- tests/coq/betree/BetreeMain_Types.v | 16 +- tests/coq/betree/Primitives.v | 137 +- tests/coq/hashmap/Hashmap_Funs.v | 503 ++- tests/coq/hashmap/Primitives.v | 137 +- tests/coq/hashmap_on_disk/HashmapMain_Funs.v | 522 ++-- .../HashmapMain_FunsExternal_Template.v | 4 +- tests/coq/hashmap_on_disk/Primitives.v | 137 +- tests/coq/misc/Bitwise.v | 10 +- tests/coq/misc/Constants.v | 18 +- tests/coq/misc/External_Funs.v | 95 +- tests/coq/misc/External_FunsExternal_Template.v | 20 +- tests/coq/misc/Loops.v | 729 ++--- tests/coq/misc/Paper.v | 100 +- tests/coq/misc/PoloniusList.v | 34 +- tests/coq/misc/Primitives.v | 23 +- tests/coq/misc/_CoqProject | 2 +- tests/coq/traits/Primitives.v | 137 +- tests/coq/traits/Traits.v | 153 +- tests/fstar-split/array/Array.Clauses.Template.fst | 21 + tests/fstar-split/array/Array.Clauses.fst | 19 + tests/fstar-split/array/Array.Funs.fst | 445 +++ tests/fstar-split/array/Array.Types.fst | 11 + tests/fstar-split/array/Makefile | 49 + tests/fstar-split/array/Primitives.fst | 884 ++++++ .../betree/BetreeMain.Clauses.Template.fst | 117 + tests/fstar-split/betree/BetreeMain.Clauses.fst | 210 ++ tests/fstar-split/betree/BetreeMain.Funs.fst | 1011 +++++++ .../betree/BetreeMain.FunsExternal.fsti | 35 + tests/fstar-split/betree/BetreeMain.Types.fst | 61 + .../betree/BetreeMain.TypesExternal.fsti | 10 + tests/fstar-split/betree/Makefile | 49 + tests/fstar-split/betree/Primitives.fst | 884 ++++++ .../hashmap/Hashmap.Clauses.Template.fst | 71 + tests/fstar-split/hashmap/Hashmap.Clauses.fst | 61 + tests/fstar-split/hashmap/Hashmap.Funs.fst | 529 ++++ tests/fstar-split/hashmap/Hashmap.Properties.fst | 3186 ++++++++++++++++++++ tests/fstar-split/hashmap/Hashmap.Properties.fsti | 267 ++ tests/fstar-split/hashmap/Hashmap.Types.fst | 23 + tests/fstar-split/hashmap/Makefile | 49 + tests/fstar-split/hashmap/Primitives.fst | 884 ++++++ .../HashmapMain.Clauses.Template.fst | 72 + .../hashmap_on_disk/HashmapMain.Clauses.fst | 61 + .../hashmap_on_disk/HashmapMain.Funs.fst | 576 ++++ .../hashmap_on_disk/HashmapMain.FunsExternal.fsti | 18 + .../hashmap_on_disk/HashmapMain.Properties.fst | 48 + .../hashmap_on_disk/HashmapMain.Types.fst | 24 + .../hashmap_on_disk/HashmapMain.TypesExternal.fsti | 10 + tests/fstar-split/hashmap_on_disk/Makefile | 49 + tests/fstar-split/hashmap_on_disk/Primitives.fst | 884 ++++++ tests/fstar-split/misc/Bitwise.fst | 32 + tests/fstar-split/misc/Constants.fst | 145 + tests/fstar-split/misc/External.Funs.fst | 84 + tests/fstar-split/misc/External.FunsExternal.fsti | 32 + tests/fstar-split/misc/External.Types.fst | 8 + tests/fstar-split/misc/External.TypesExternal.fsti | 14 + tests/fstar-split/misc/Loops.Clauses.Template.fst | 131 + tests/fstar-split/misc/Loops.Clauses.fst | 107 + tests/fstar-split/misc/Loops.Funs.fst | 734 +++++ tests/fstar-split/misc/Loops.Types.fst | 13 + tests/fstar-split/misc/Paper.fst | 110 + tests/fstar-split/misc/PoloniusList.fst | 34 + tests/fstar-split/traits/Makefile | 49 + tests/fstar-split/traits/Primitives.fst | 884 ++++++ tests/fstar-split/traits/Traits.fst | 476 +++ tests/fstar/array/Array.Clauses.Template.fst | 4 +- tests/fstar/array/Array.Funs.fst | 389 ++- tests/fstar/array/Primitives.fst | 132 +- tests/fstar/betree/BetreeMain.Funs.fst | 845 ++---- tests/fstar/betree/BetreeMain.FunsExternal.fsti | 10 +- tests/fstar/betree/Primitives.fst | 132 +- .../fstar/betree_back_stateful/BetreeMain.Funs.fst | 1043 ++----- .../BetreeMain.FunsExternal.fsti | 10 +- tests/fstar/betree_back_stateful/Primitives.fst | 132 +- tests/fstar/hashmap/Hashmap.Funs.fst | 411 +-- tests/fstar/hashmap/Hashmap.Properties.fst | 3186 -------------------- tests/fstar/hashmap/Hashmap.Properties.fsti | 267 -- tests/fstar/hashmap/Primitives.fst | 132 +- tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst | 432 +-- .../hashmap_on_disk/HashmapMain.FunsExternal.fsti | 4 +- tests/fstar/hashmap_on_disk/Primitives.fst | 132 +- tests/fstar/misc/Bitwise.fst | 10 +- tests/fstar/misc/Constants.fst | 18 +- tests/fstar/misc/External.Funs.fst | 76 +- tests/fstar/misc/External.FunsExternal.fsti | 18 +- tests/fstar/misc/Loops.Funs.fst | 602 ++-- tests/fstar/misc/Paper.fst | 87 +- tests/fstar/misc/PoloniusList.fst | 30 +- tests/fstar/misc/Primitives.fst | 23 +- tests/fstar/traits/Primitives.fst | 132 +- tests/fstar/traits/Traits.fst | 142 +- tests/lean/Array.lean | 503 ++- tests/lean/BetreeMain/Funs.lean | 1158 +++---- tests/lean/BetreeMain/FunsExternal_Template.lean | 10 +- tests/lean/Bitwise.lean | 18 +- tests/lean/Constants.lean | 22 +- tests/lean/External/Funs.lean | 89 +- tests/lean/External/FunsExternal_Template.lean | 19 +- tests/lean/Hashmap/Funs.lean | 582 ++-- tests/lean/HashmapMain/Funs.lean | 603 ++-- tests/lean/HashmapMain/FunsExternal_Template.lean | 4 +- tests/lean/Loops.lean | 661 ++-- tests/lean/Paper.lean | 131 +- tests/lean/PoloniusList.lean | 35 +- tests/lean/Traits.lean | 161 +- 108 files changed, 18545 insertions(+), 11718 deletions(-) create mode 100644 tests/fstar-split/array/Array.Clauses.Template.fst create mode 100644 tests/fstar-split/array/Array.Clauses.fst create mode 100644 tests/fstar-split/array/Array.Funs.fst create mode 100644 tests/fstar-split/array/Array.Types.fst create mode 100644 tests/fstar-split/array/Makefile create mode 100644 tests/fstar-split/array/Primitives.fst create mode 100644 tests/fstar-split/betree/BetreeMain.Clauses.Template.fst create mode 100644 tests/fstar-split/betree/BetreeMain.Clauses.fst create mode 100644 tests/fstar-split/betree/BetreeMain.Funs.fst create mode 100644 tests/fstar-split/betree/BetreeMain.FunsExternal.fsti create mode 100644 tests/fstar-split/betree/BetreeMain.Types.fst create mode 100644 tests/fstar-split/betree/BetreeMain.TypesExternal.fsti create mode 100644 tests/fstar-split/betree/Makefile create mode 100644 tests/fstar-split/betree/Primitives.fst create mode 100644 tests/fstar-split/hashmap/Hashmap.Clauses.Template.fst create mode 100644 tests/fstar-split/hashmap/Hashmap.Clauses.fst create mode 100644 tests/fstar-split/hashmap/Hashmap.Funs.fst create mode 100644 tests/fstar-split/hashmap/Hashmap.Properties.fst create mode 100644 tests/fstar-split/hashmap/Hashmap.Properties.fsti create mode 100644 tests/fstar-split/hashmap/Hashmap.Types.fst create mode 100644 tests/fstar-split/hashmap/Makefile create mode 100644 tests/fstar-split/hashmap/Primitives.fst create mode 100644 tests/fstar-split/hashmap_on_disk/HashmapMain.Clauses.Template.fst create mode 100644 tests/fstar-split/hashmap_on_disk/HashmapMain.Clauses.fst create mode 100644 tests/fstar-split/hashmap_on_disk/HashmapMain.Funs.fst create mode 100644 tests/fstar-split/hashmap_on_disk/HashmapMain.FunsExternal.fsti create mode 100644 tests/fstar-split/hashmap_on_disk/HashmapMain.Properties.fst create mode 100644 tests/fstar-split/hashmap_on_disk/HashmapMain.Types.fst create mode 100644 tests/fstar-split/hashmap_on_disk/HashmapMain.TypesExternal.fsti create mode 100644 tests/fstar-split/hashmap_on_disk/Makefile create mode 100644 tests/fstar-split/hashmap_on_disk/Primitives.fst create mode 100644 tests/fstar-split/misc/Bitwise.fst create mode 100644 tests/fstar-split/misc/Constants.fst create mode 100644 tests/fstar-split/misc/External.Funs.fst create mode 100644 tests/fstar-split/misc/External.FunsExternal.fsti create mode 100644 tests/fstar-split/misc/External.Types.fst create mode 100644 tests/fstar-split/misc/External.TypesExternal.fsti create mode 100644 tests/fstar-split/misc/Loops.Clauses.Template.fst create mode 100644 tests/fstar-split/misc/Loops.Clauses.fst create mode 100644 tests/fstar-split/misc/Loops.Funs.fst create mode 100644 tests/fstar-split/misc/Loops.Types.fst create mode 100644 tests/fstar-split/misc/Paper.fst create mode 100644 tests/fstar-split/misc/PoloniusList.fst create mode 100644 tests/fstar-split/traits/Makefile create mode 100644 tests/fstar-split/traits/Primitives.fst create mode 100644 tests/fstar-split/traits/Traits.fst delete mode 100644 tests/fstar/hashmap/Hashmap.Properties.fst delete mode 100644 tests/fstar/hashmap/Hashmap.Properties.fsti diff --git a/tests/coq/array/Array.v b/tests/coq/array/Array.v index 1f2cc0e0..faa0e92c 100644 --- a/tests/coq/array/Array.v +++ b/tests/coq/array/Array.v @@ -12,108 +12,98 @@ Module Array. Source: 'src/array.rs', lines 3:0-3:11 *) Inductive AB_t := | AB_A : AB_t | AB_B : AB_t. -(** [array::incr]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [array::incr]: Source: 'src/array.rs', lines 8:0-8:24 *) Definition incr (x : u32) : result u32 := u32_add x 1%u32. -(** [array::array_to_shared_slice_]: forward function +(** [array::array_to_shared_slice_]: Source: 'src/array.rs', lines 16:0-16:53 *) Definition array_to_shared_slice_ (T : Type) (s : array T 32%usize) : result (slice T) := array_to_slice T 32%usize s . -(** [array::array_to_mut_slice_]: forward function +(** [array::array_to_mut_slice_]: Source: 'src/array.rs', lines 21:0-21:58 *) Definition array_to_mut_slice_ - (T : Type) (s : array T 32%usize) : result (slice T) := - array_to_slice T 32%usize s -. - -(** [array::array_to_mut_slice_]: backward function 0 - Source: 'src/array.rs', lines 21:0-21:58 *) -Definition array_to_mut_slice__back - (T : Type) (s : array T 32%usize) (ret : slice T) : - result (array T 32%usize) + (T : Type) (s : array T 32%usize) : + result ((slice T) * (slice T -> result (array T 32%usize))) := - array_from_slice T 32%usize s ret + p <- array_to_slice_mut T 32%usize s; + let (s1, to_slice_mut_back) := p in + let back := fun (ret : slice T) => to_slice_mut_back ret in + Return (s1, back) . -(** [array::array_len]: forward function +(** [array::array_len]: Source: 'src/array.rs', lines 25:0-25:40 *) Definition array_len (T : Type) (s : array T 32%usize) : result usize := - s0 <- array_to_slice T 32%usize s; let i := slice_len T s0 in Return i + s1 <- array_to_slice T 32%usize s; let i := slice_len T s1 in Return i . -(** [array::shared_array_len]: forward function +(** [array::shared_array_len]: Source: 'src/array.rs', lines 29:0-29:48 *) Definition shared_array_len (T : Type) (s : array T 32%usize) : result usize := - s0 <- array_to_slice T 32%usize s; let i := slice_len T s0 in Return i + s1 <- array_to_slice T 32%usize s; let i := slice_len T s1 in Return i . -(** [array::shared_slice_len]: forward function +(** [array::shared_slice_len]: Source: 'src/array.rs', lines 33:0-33:44 *) Definition shared_slice_len (T : Type) (s : slice T) : result usize := let i := slice_len T s in Return i . -(** [array::index_array_shared]: forward function +(** [array::index_array_shared]: Source: 'src/array.rs', lines 37:0-37:57 *) Definition index_array_shared (T : Type) (s : array T 32%usize) (i : usize) : result T := array_index_usize T 32%usize s i . -(** [array::index_array_u32]: forward function +(** [array::index_array_u32]: Source: 'src/array.rs', lines 44:0-44:53 *) Definition index_array_u32 (s : array u32 32%usize) (i : usize) : result u32 := array_index_usize u32 32%usize s i . -(** [array::index_array_copy]: forward function +(** [array::index_array_copy]: Source: 'src/array.rs', lines 48:0-48:45 *) Definition index_array_copy (x : array u32 32%usize) : result u32 := array_index_usize u32 32%usize x 0%usize . -(** [array::index_mut_array]: forward function +(** [array::index_mut_array]: Source: 'src/array.rs', lines 52:0-52:62 *) Definition index_mut_array - (T : Type) (s : array T 32%usize) (i : usize) : result T := - array_index_usize T 32%usize s i -. - -(** [array::index_mut_array]: backward function 0 - Source: 'src/array.rs', lines 52:0-52:62 *) -Definition index_mut_array_back - (T : Type) (s : array T 32%usize) (i : usize) (ret : T) : - result (array T 32%usize) + (T : Type) (s : array T 32%usize) (i : usize) : + result (T * (T -> result (array T 32%usize))) := - array_update_usize T 32%usize s i ret + p <- array_index_mut_usize T 32%usize s i; + let (t, index_mut_back) := p in + let back := fun (ret : T) => index_mut_back ret in + Return (t, back) . -(** [array::index_slice]: forward function +(** [array::index_slice]: Source: 'src/array.rs', lines 56:0-56:46 *) Definition index_slice (T : Type) (s : slice T) (i : usize) : result T := slice_index_usize T s i . -(** [array::index_mut_slice]: forward function +(** [array::index_mut_slice]: Source: 'src/array.rs', lines 60:0-60:58 *) -Definition index_mut_slice (T : Type) (s : slice T) (i : usize) : result T := - slice_index_usize T s i -. - -(** [array::index_mut_slice]: backward function 0 - Source: 'src/array.rs', lines 60:0-60:58 *) -Definition index_mut_slice_back - (T : Type) (s : slice T) (i : usize) (ret : T) : result (slice T) := - slice_update_usize T s i ret +Definition index_mut_slice + (T : Type) (s : slice T) (i : usize) : + result (T * (T -> result (slice T))) + := + p <- slice_index_mut_usize T s i; + let (t, index_mut_back) := p in + let back := fun (ret : T) => index_mut_back ret in + Return (t, back) . -(** [array::slice_subslice_shared_]: forward function +(** [array::slice_subslice_shared_]: Source: 'src/array.rs', lines 64:0-64:70 *) Definition slice_subslice_shared_ (x : slice u32) (y : usize) (z : usize) : result (slice u32) := @@ -122,47 +112,41 @@ Definition slice_subslice_shared_ {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . -(** [array::slice_subslice_mut_]: forward function +(** [array::slice_subslice_mut_]: Source: 'src/array.rs', lines 68:0-68:75 *) Definition slice_subslice_mut_ - (x : slice u32) (y : usize) (z : usize) : result (slice u32) := - core_slice_index_Slice_index_mut u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x - {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} -. - -(** [array::slice_subslice_mut_]: backward function 0 - Source: 'src/array.rs', lines 68:0-68:75 *) -Definition slice_subslice_mut__back - (x : slice u32) (y : usize) (z : usize) (ret : slice u32) : - result (slice u32) + (x : slice u32) (y : usize) (z : usize) : + result ((slice u32) * (slice u32 -> result (slice u32))) := - core_slice_index_Slice_index_mut_back u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x - {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} ret + p <- + core_slice_index_Slice_index_mut u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |}; + let (s, index_mut_back) := p in + let back := fun (ret : slice u32) => index_mut_back ret in + Return (s, back) . -(** [array::array_to_slice_shared_]: forward function +(** [array::array_to_slice_shared_]: Source: 'src/array.rs', lines 72:0-72:54 *) Definition array_to_slice_shared_ (x : array u32 32%usize) : result (slice u32) := array_to_slice u32 32%usize x . -(** [array::array_to_slice_mut_]: forward function +(** [array::array_to_slice_mut_]: Source: 'src/array.rs', lines 76:0-76:59 *) -Definition array_to_slice_mut_ (x : array u32 32%usize) : result (slice u32) := - array_to_slice u32 32%usize x -. - -(** [array::array_to_slice_mut_]: backward function 0 - Source: 'src/array.rs', lines 76:0-76:59 *) -Definition array_to_slice_mut__back - (x : array u32 32%usize) (ret : slice u32) : result (array u32 32%usize) := - array_from_slice u32 32%usize x ret +Definition array_to_slice_mut_ + (x : array u32 32%usize) : + result ((slice u32) * (slice u32 -> result (array u32 32%usize))) + := + p <- array_to_slice_mut u32 32%usize x; + let (s, to_slice_mut_back) := p in + let back := fun (ret : slice u32) => to_slice_mut_back ret in + Return (s, back) . -(** [array::array_subslice_shared_]: forward function +(** [array::array_subslice_shared_]: Source: 'src/array.rs', lines 80:0-80:74 *) Definition array_subslice_shared_ (x : array u32 32%usize) (y : usize) (z : usize) : result (slice u32) := @@ -172,41 +156,35 @@ Definition array_subslice_shared_ {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . -(** [array::array_subslice_mut_]: forward function +(** [array::array_subslice_mut_]: Source: 'src/array.rs', lines 84:0-84:79 *) Definition array_subslice_mut_ - (x : array u32 32%usize) (y : usize) (z : usize) : result (slice u32) := - core_array_Array_index_mut u32 (core_ops_range_Range usize) 32%usize - (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x - {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} -. - -(** [array::array_subslice_mut_]: backward function 0 - Source: 'src/array.rs', lines 84:0-84:79 *) -Definition array_subslice_mut__back - (x : array u32 32%usize) (y : usize) (z : usize) (ret : slice u32) : - result (array u32 32%usize) + (x : array u32 32%usize) (y : usize) (z : usize) : + result ((slice u32) * (slice u32 -> result (array u32 32%usize))) := - core_array_Array_index_mut_back u32 (core_ops_range_Range usize) 32%usize - (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x - {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} ret + p <- + core_array_Array_index_mut u32 (core_ops_range_Range usize) 32%usize + (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |}; + let (s, index_mut_back) := p in + let back := fun (ret : slice u32) => index_mut_back ret in + Return (s, back) . -(** [array::index_slice_0]: forward function +(** [array::index_slice_0]: Source: 'src/array.rs', lines 88:0-88:38 *) Definition index_slice_0 (T : Type) (s : slice T) : result T := slice_index_usize T s 0%usize . -(** [array::index_array_0]: forward function +(** [array::index_array_0]: Source: 'src/array.rs', lines 92:0-92:42 *) Definition index_array_0 (T : Type) (s : array T 32%usize) : result T := array_index_usize T 32%usize s 0%usize . -(** [array::index_index_array]: forward function +(** [array::index_index_array]: Source: 'src/array.rs', lines 103:0-103:71 *) Definition index_index_array (s : array (array u32 32%usize) 32%usize) (i : usize) (j : usize) : @@ -216,157 +194,164 @@ Definition index_index_array array_index_usize u32 32%usize a j . -(** [array::update_update_array]: forward function +(** [array::update_update_array]: Source: 'src/array.rs', lines 114:0-114:70 *) Definition update_update_array (s : array (array u32 32%usize) 32%usize) (i : usize) (j : usize) : result unit := - a <- array_index_usize (array u32 32%usize) 32%usize s i; - a0 <- array_update_usize u32 32%usize a j 0%u32; - _ <- array_update_usize (array u32 32%usize) 32%usize s i a0; + p <- array_index_mut_usize (array u32 32%usize) 32%usize s i; + let (a, index_mut_back) := p in + p1 <- array_index_mut_usize u32 32%usize a j; + let (_, index_mut_back1) := p1 in + a1 <- index_mut_back1 0%u32; + _ <- index_mut_back a1; Return tt . -(** [array::array_local_deep_copy]: forward function +(** [array::array_local_deep_copy]: Source: 'src/array.rs', lines 118:0-118:43 *) Definition array_local_deep_copy (x : array u32 32%usize) : result unit := Return tt . -(** [array::take_array]: forward function +(** [array::take_array]: Source: 'src/array.rs', lines 122:0-122:30 *) Definition take_array (a : array u32 2%usize) : result unit := Return tt. -(** [array::take_array_borrow]: forward function +(** [array::take_array_borrow]: Source: 'src/array.rs', lines 123:0-123:38 *) Definition take_array_borrow (a : array u32 2%usize) : result unit := Return tt . -(** [array::take_slice]: forward function +(** [array::take_slice]: Source: 'src/array.rs', lines 124:0-124:28 *) Definition take_slice (s : slice u32) : result unit := Return tt. -(** [array::take_mut_slice]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [array::take_mut_slice]: Source: 'src/array.rs', lines 125:0-125:36 *) Definition take_mut_slice (s : slice u32) : result (slice u32) := Return s. -(** [array::const_array]: forward function +(** [array::const_array]: Source: 'src/array.rs', lines 127:0-127:32 *) Definition const_array : result (array u32 2%usize) := Return (mk_array u32 2%usize [ 0%u32; 0%u32 ]) . -(** [array::const_slice]: forward function +(** [array::const_slice]: Source: 'src/array.rs', lines 131:0-131:20 *) Definition const_slice : result unit := _ <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); Return tt . -(** [array::take_all]: forward function +(** [array::take_all]: Source: 'src/array.rs', lines 141:0-141:17 *) Definition take_all : result unit := + _ <- take_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); _ <- take_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); _ <- take_array_borrow (mk_array u32 2%usize [ 0%u32; 0%u32 ]); s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); _ <- take_slice s; - s0 <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - s1 <- take_mut_slice s0; - _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) s1; + p <- array_to_slice_mut u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + let (s1, to_slice_mut_back) := p in + s2 <- take_mut_slice s1; + _ <- to_slice_mut_back s2; Return tt . -(** [array::index_array]: forward function +(** [array::index_array]: Source: 'src/array.rs', lines 155:0-155:38 *) Definition index_array (x : array u32 2%usize) : result u32 := array_index_usize u32 2%usize x 0%usize . -(** [array::index_array_borrow]: forward function +(** [array::index_array_borrow]: Source: 'src/array.rs', lines 158:0-158:46 *) Definition index_array_borrow (x : array u32 2%usize) : result u32 := array_index_usize u32 2%usize x 0%usize . -(** [array::index_slice_u32_0]: forward function +(** [array::index_slice_u32_0]: Source: 'src/array.rs', lines 162:0-162:42 *) Definition index_slice_u32_0 (x : slice u32) : result u32 := slice_index_usize u32 x 0%usize . -(** [array::index_mut_slice_u32_0]: forward function +(** [array::index_mut_slice_u32_0]: Source: 'src/array.rs', lines 166:0-166:50 *) -Definition index_mut_slice_u32_0 (x : slice u32) : result u32 := - slice_index_usize u32 x 0%usize +Definition index_mut_slice_u32_0 + (x : slice u32) : result (u32 * (slice u32)) := + i <- slice_index_usize u32 x 0%usize; Return (i, x) . -(** [array::index_mut_slice_u32_0]: backward function 0 - Source: 'src/array.rs', lines 166:0-166:50 *) -Definition index_mut_slice_u32_0_back (x : slice u32) : result (slice u32) := - _ <- slice_index_usize u32 x 0%usize; Return x -. - -(** [array::index_all]: forward function +(** [array::index_all]: Source: 'src/array.rs', lines 170:0-170:25 *) Definition index_all : result u32 := i <- index_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - i0 <- index_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - i1 <- u32_add i i0; - i2 <- index_array_borrow (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - i3 <- u32_add i1 i2; + i1 <- index_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + i2 <- u32_add i i1; + i3 <- index_array_borrow (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + i4 <- u32_add i2 i3; s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - i4 <- index_slice_u32_0 s; - i5 <- u32_add i3 i4; - s0 <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - i6 <- index_mut_slice_u32_0 s0; - i7 <- u32_add i5 i6; - s1 <- index_mut_slice_u32_0_back s0; - _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) s1; - Return i7 -. - -(** [array::update_array]: forward function + i5 <- index_slice_u32_0 s; + i6 <- u32_add i4 i5; + p <- array_to_slice_mut u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + let (s1, to_slice_mut_back) := p in + p1 <- index_mut_slice_u32_0 s1; + let (i7, s2) := p1 in + i8 <- u32_add i6 i7; + _ <- to_slice_mut_back s2; + Return i8 +. + +(** [array::update_array]: Source: 'src/array.rs', lines 184:0-184:36 *) Definition update_array (x : array u32 2%usize) : result unit := - _ <- array_update_usize u32 2%usize x 0%usize 1%u32; Return tt + p <- array_index_mut_usize u32 2%usize x 0%usize; + let (_, index_mut_back) := p in + _ <- index_mut_back 1%u32; + Return tt . -(** [array::update_array_mut_borrow]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [array::update_array_mut_borrow]: Source: 'src/array.rs', lines 187:0-187:48 *) Definition update_array_mut_borrow (x : array u32 2%usize) : result (array u32 2%usize) := - array_update_usize u32 2%usize x 0%usize 1%u32 + p <- array_index_mut_usize u32 2%usize x 0%usize; + let (_, index_mut_back) := p in + index_mut_back 1%u32 . -(** [array::update_mut_slice]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [array::update_mut_slice]: Source: 'src/array.rs', lines 190:0-190:38 *) Definition update_mut_slice (x : slice u32) : result (slice u32) := - slice_update_usize u32 x 0%usize 1%u32 + p <- slice_index_mut_usize u32 x 0%usize; + let (_, index_mut_back) := p in + index_mut_back 1%u32 . -(** [array::update_all]: forward function +(** [array::update_all]: Source: 'src/array.rs', lines 194:0-194:19 *) Definition update_all : result unit := _ <- update_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - x <- update_array_mut_borrow (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - s <- array_to_slice u32 2%usize x; - s0 <- update_mut_slice s; - _ <- array_from_slice u32 2%usize x s0; + _ <- update_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + a <- update_array_mut_borrow (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + p <- array_to_slice_mut u32 2%usize a; + let (s, to_slice_mut_back) := p in + s1 <- update_mut_slice s; + _ <- to_slice_mut_back s1; Return tt . -(** [array::range_all]: forward function +(** [array::range_all]: Source: 'src/array.rs', lines 205:0-205:18 *) Definition range_all : result unit := - s <- + p <- core_array_Array_index_mut u32 (core_ops_range_Range usize) 4%usize (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) @@ -375,127 +360,119 @@ Definition range_all : result unit := core_ops_range_Range_start := 1%usize; core_ops_range_Range_end_ := 3%usize |}; - s0 <- update_mut_slice s; - _ <- - core_array_Array_index_mut_back u32 (core_ops_range_Range usize) 4%usize - (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) - (mk_array u32 4%usize [ 0%u32; 0%u32; 0%u32; 0%u32 ]) - {| - core_ops_range_Range_start := 1%usize; - core_ops_range_Range_end_ := 3%usize - |} s0; + let (s, index_mut_back) := p in + s1 <- update_mut_slice s; + _ <- index_mut_back s1; Return tt . -(** [array::deref_array_borrow]: forward function +(** [array::deref_array_borrow]: Source: 'src/array.rs', lines 214:0-214:46 *) Definition deref_array_borrow (x : array u32 2%usize) : result u32 := array_index_usize u32 2%usize x 0%usize . -(** [array::deref_array_mut_borrow]: forward function - Source: 'src/array.rs', lines 219:0-219:54 *) -Definition deref_array_mut_borrow (x : array u32 2%usize) : result u32 := - array_index_usize u32 2%usize x 0%usize -. - -(** [array::deref_array_mut_borrow]: backward function 0 +(** [array::deref_array_mut_borrow]: Source: 'src/array.rs', lines 219:0-219:54 *) -Definition deref_array_mut_borrow_back - (x : array u32 2%usize) : result (array u32 2%usize) := - _ <- array_index_usize u32 2%usize x 0%usize; Return x +Definition deref_array_mut_borrow + (x : array u32 2%usize) : result (u32 * (array u32 2%usize)) := + i <- array_index_usize u32 2%usize x 0%usize; Return (i, x) . -(** [array::take_array_t]: forward function +(** [array::take_array_t]: Source: 'src/array.rs', lines 227:0-227:31 *) Definition take_array_t (a : array AB_t 2%usize) : result unit := Return tt. -(** [array::non_copyable_array]: forward function +(** [array::non_copyable_array]: Source: 'src/array.rs', lines 229:0-229:27 *) Definition non_copyable_array : result unit := _ <- take_array_t (mk_array AB_t 2%usize [ AB_A; AB_B ]); Return tt . -(** [array::sum]: loop 0: forward function +(** [array::sum]: loop 0: Source: 'src/array.rs', lines 242:0-250:1 *) Fixpoint sum_loop - (n : nat) (s : slice u32) (sum0 : u32) (i : usize) : result u32 := + (n : nat) (s : slice u32) (sum1 : u32) (i : usize) : result u32 := match n with | O => Fail_ OutOfFuel - | S n0 => - let i0 := slice_len u32 s in - if i s< i0 + | S n1 => + let i1 := slice_len u32 s in + if i s< i1 then ( - i1 <- slice_index_usize u32 s i; - sum1 <- u32_add sum0 i1; - i2 <- usize_add i 1%usize; - sum_loop n0 s sum1 i2) - else Return sum0 + i2 <- slice_index_usize u32 s i; + sum3 <- u32_add sum1 i2; + i3 <- usize_add i 1%usize; + sum_loop n1 s sum3 i3) + else Return sum1 end . -(** [array::sum]: forward function +(** [array::sum]: Source: 'src/array.rs', lines 242:0-242:28 *) Definition sum (n : nat) (s : slice u32) : result u32 := sum_loop n s 0%u32 0%usize . -(** [array::sum2]: loop 0: forward function +(** [array::sum2]: loop 0: Source: 'src/array.rs', lines 252:0-261:1 *) Fixpoint sum2_loop - (n : nat) (s : slice u32) (s2 : slice u32) (sum0 : u32) (i : usize) : + (n : nat) (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) : result u32 := match n with | O => Fail_ OutOfFuel - | S n0 => - let i0 := slice_len u32 s in - if i s< i0 + | S n1 => + let i1 := slice_len u32 s in + if i s< i1 then ( - i1 <- slice_index_usize u32 s i; - i2 <- slice_index_usize u32 s2 i; - i3 <- u32_add i1 i2; - sum1 <- u32_add sum0 i3; - i4 <- usize_add i 1%usize; - sum2_loop n0 s s2 sum1 i4) - else Return sum0 + i2 <- slice_index_usize u32 s i; + i3 <- slice_index_usize u32 s2 i; + i4 <- u32_add i2 i3; + sum3 <- u32_add sum1 i4; + i5 <- usize_add i 1%usize; + sum2_loop n1 s s2 sum3 i5) + else Return sum1 end . -(** [array::sum2]: forward function +(** [array::sum2]: Source: 'src/array.rs', lines 252:0-252:41 *) Definition sum2 (n : nat) (s : slice u32) (s2 : slice u32) : result u32 := let i := slice_len u32 s in - let i0 := slice_len u32 s2 in - if negb (i s= i0) then Fail_ Failure else sum2_loop n s s2 0%u32 0%usize + let i1 := slice_len u32 s2 in + if negb (i s= i1) then Fail_ Failure else sum2_loop n s s2 0%u32 0%usize . -(** [array::f0]: forward function +(** [array::f0]: Source: 'src/array.rs', lines 263:0-263:11 *) Definition f0 : result unit := - s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]); - s0 <- slice_update_usize u32 s 0%usize 1%u32; - _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) s0; + p <- array_to_slice_mut u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]); + let (s, to_slice_mut_back) := p in + p1 <- slice_index_mut_usize u32 s 0%usize; + let (_, index_mut_back) := p1 in + s1 <- index_mut_back 1%u32; + _ <- to_slice_mut_back s1; Return tt . -(** [array::f1]: forward function +(** [array::f1]: Source: 'src/array.rs', lines 268:0-268:11 *) Definition f1 : result unit := - _ <- - array_update_usize u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) - 0%usize 1%u32; + p <- + array_index_mut_usize u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) + 0%usize; + let (_, index_mut_back) := p in + _ <- index_mut_back 1%u32; Return tt . -(** [array::f2]: forward function +(** [array::f2]: Source: 'src/array.rs', lines 273:0-273:17 *) Definition f2 (i : u32) : result unit := Return tt. -(** [array::f4]: forward function +(** [array::f4]: Source: 'src/array.rs', lines 282:0-282:54 *) Definition f4 (x : array u32 32%usize) (y : usize) (z : usize) : result (slice u32) := @@ -505,7 +482,7 @@ Definition f4 {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . -(** [array::f3]: forward function +(** [array::f3]: Source: 'src/array.rs', lines 275:0-275:18 *) Definition f3 (n : nat) : result u32 := i <- @@ -514,8 +491,8 @@ Definition f3 (n : nat) : result u32 := _ <- f2 i; let b := array_repeat u32 32%usize 0%u32 in s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]); - s0 <- f4 b 16%usize 18%usize; - sum2 n s s0 + s1 <- f4 b 16%usize 18%usize; + sum2 n s s1 . (** [array::SZ] @@ -523,21 +500,25 @@ Definition f3 (n : nat) : result u32 := Definition sz_body : result usize := Return 32%usize. Definition sz_c : usize := sz_body%global. -(** [array::f5]: forward function +(** [array::f5]: Source: 'src/array.rs', lines 289:0-289:31 *) Definition f5 (x : array u32 32%usize) : result u32 := array_index_usize u32 32%usize x 0%usize . -(** [array::ite]: forward function +(** [array::ite]: Source: 'src/array.rs', lines 294:0-294:12 *) Definition ite : result unit := - s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - s0 <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - s1 <- index_mut_slice_u32_0_back s0; - _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) s1; - s2 <- index_mut_slice_u32_0_back s; - _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) s2; + p <- array_to_slice_mut u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + let (s, to_slice_mut_back) := p in + p1 <- index_mut_slice_u32_0 s; + let (_, s1) := p1 in + p2 <- array_to_slice_mut u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + let (s2, to_slice_mut_back1) := p2 in + p3 <- index_mut_slice_u32_0 s2; + let (_, s3) := p3 in + _ <- to_slice_mut_back1 s3; + _ <- to_slice_mut_back s1; Return tt . diff --git a/tests/coq/array/Primitives.v b/tests/coq/array/Primitives.v index 84280b96..990e27e4 100644 --- a/tests/coq/array/Primitives.v +++ b/tests/coq/array/Primitives.v @@ -67,8 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . -Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * a := (x, x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. @@ -504,13 +503,15 @@ Arguments core_ops_index_Index_index {_ _}. (* Trait declaration: [core::ops::index::IndexMut] *) Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; - core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); - core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; + core_ops_index_IndexMut_index_mut : + Self -> + Idx -> + result (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) * + (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self)); }. Arguments mk_core_ops_index_IndexMut {_ _}. Arguments core_ops_index_IndexMut_indexInst {_ _}. Arguments core_ops_index_IndexMut_index_mut {_ _}. -Arguments core_ops_index_IndexMut_index_mut_back {_ _}. (* Trait declaration [core::ops::deref::Deref] *) Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { @@ -524,13 +525,14 @@ Arguments core_ops_deref_Deref_deref {_}. (* Trait declaration [core::ops::deref::DerefMut] *) Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; - core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); - core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; + core_ops_deref_DerefMut_deref_mut : + Self -> + result (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) * + (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self)); }. Arguments mk_core_ops_deref_DerefMut {_}. Arguments core_ops_deref_DerefMut_derefInst {_}. Arguments core_ops_deref_DerefMut_deref_mut {_}. -Arguments core_ops_deref_DerefMut_deref_mut_back {_}. Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { core_ops_range_Range_start : T; @@ -543,8 +545,8 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := + Return (x, fun x => Return x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -556,7 +558,6 @@ Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; - core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; |}. @@ -584,6 +585,13 @@ Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usize) : + result (T * (T -> result (array T n))) := + match array_index_usize T n a i with + | Fail_ e => Fail_ e + | Return x => Return (x, array_update_usize T n a i) + end. + (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. @@ -591,11 +599,25 @@ Axiom slice_len : forall (T : Type) (s : slice T), usize. Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : + result (T * (T -> result (slice T))) := + match slice_index_usize T s i with + | Fail_ e => Fail_ e + | Return x => Return (x, slice_update_usize T s i) + end. + (*** Subslices *) Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : + result (slice T * (slice T -> result (array T n))) := + match array_to_slice T n a with + | Fail_ e => Fail_ e + | Return x => Return (x, array_from_slice T n a) + end. + Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). @@ -639,16 +661,9 @@ Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (l | right _ => Fail_ Failure end. -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. - Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_insert_fwd (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result unit := - if to_Z i if to_Z i result (alloc_vec_Vec T))) := + match alloc_vec_Vec_index_usize v i with + | Return x => + Return (x, alloc_vec_Vec_update_usize v i) + | Fail_ e => Fail_ e + end. + (* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. @@ -669,25 +692,23 @@ Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceI core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; core_slice_index_SliceIndex_Output : Type; core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_mut : + Self -> T -> result (option core_slice_index_SliceIndex_Output * (option core_slice_index_SliceIndex_Output -> result T)); core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_index_mut : + Self -> T -> result (core_slice_index_SliceIndex_Output * (core_slice_index_SliceIndex_Output -> result T)); }. Arguments mk_core_slice_index_SliceIndex {_ _}. Arguments core_slice_index_SliceIndex_sealedInst {_ _}. Arguments core_slice_index_SliceIndex_Output {_ _}. Arguments core_slice_index_SliceIndex_get {_ _}. Arguments core_slice_index_SliceIndex_get_mut {_ _}. -Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. Arguments core_slice_index_SliceIndex_index {_ _}. Arguments core_slice_index_SliceIndex_index_mut {_ _}. -Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. (* [core::slice::index::[T]::index]: forward function *) Definition core_slice_index_Slice_index @@ -704,11 +725,9 @@ Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Ra (* [core::slice::index::Range::get_mut]: forward function *) Axiom core_slice_index_RangeUsize_get_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (option (slice T)). - -(* [core::slice::index::Range::get_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_get_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + forall (T : Type), + core_ops_range_Range usize -> slice T -> + result (option (slice T) * (option (slice T) -> result (slice T))). (* [core::slice::index::Range::get_unchecked]: forward function *) Definition core_slice_index_RangeUsize_get_unchecked @@ -732,21 +751,14 @@ Axiom core_slice_index_RangeUsize_index : (* [core::slice::index::Range::index_mut]: forward function *) Axiom core_slice_index_RangeUsize_index_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). - -(* [core::slice::index::Range::index_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_index_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T * (slice T -> result (slice T))). (* [core::slice::index::[T]::index_mut]: forward function *) Axiom core_slice_index_Slice_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). - -(* [core::slice::index::[T]::index_mut]: backward function 0 *) -Axiom core_slice_index_Slice_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + slice T -> Idx -> + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (slice T))). (* [core::array::[T; N]::index]: forward function *) Axiom core_array_Array_index : @@ -756,12 +768,9 @@ Axiom core_array_Array_index : (* [core::array::[T; N]::index_mut]: forward function *) Axiom core_array_Array_index_mut : forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). - -(* [core::array::[T; N]::index_mut]: backward function 0 *) -Axiom core_array_Array_index_mut_back : - forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + (a : array T N) (i : Idx), + result (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) * + (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) -> result (array T N))). (* Trait implementation: [core::slice::index::private_slice_index::Range] *) Definition core_slice_index_private_slice_index_SealedRangeUsizeInst @@ -774,12 +783,10 @@ Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := slice T; core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_RangeUsize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_RangeUsize_index_mut_back T; |}. (* Trait implementation: [core::slice::index::[T]] *) @@ -796,7 +803,6 @@ Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) core_ops_index_IndexMut (slice T) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; |}. (* Trait implementation: [core::array::[T; N]] *) @@ -813,18 +819,14 @@ Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) core_ops_index_IndexMut (array T N) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; - core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; |}. (* [core::slice::index::usize::get]: forward function *) Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). (* [core::slice::index::usize::get_mut]: forward function *) -Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). - -(* [core::slice::index::usize::get_mut]: backward function 0 *) -Axiom core_slice_index_usize_get_mut_back : - forall (T : Type), usize -> slice T -> option T -> result (slice T). +Axiom core_slice_index_usize_get_mut : + forall (T : Type), usize -> slice T -> result (option T * (option T -> result (slice T))). (* [core::slice::index::usize::get_unchecked]: forward function *) Axiom core_slice_index_usize_get_unchecked : @@ -838,11 +840,8 @@ Axiom core_slice_index_usize_get_unchecked_mut : Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. (* [core::slice::index::usize::index_mut]: forward function *) -Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. - -(* [core::slice::index::usize::index_mut]: backward function 0 *) -Axiom core_slice_index_usize_index_mut_back : - forall (T : Type), usize -> slice T -> T -> result (slice T). +Axiom core_slice_index_usize_index_mut : + forall (T : Type), usize -> slice T -> result (T * (T -> result (slice T))). (* Trait implementation: [core::slice::index::private_slice_index::usize] *) Definition core_slice_index_private_slice_index_SealedUsizeInst @@ -855,12 +854,10 @@ Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := T; core_slice_index_SliceIndex_get := core_slice_index_usize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_usize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; |}. (* [alloc::vec::Vec::index]: forward function *) @@ -869,12 +866,9 @@ Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_Slice (* [alloc::vec::Vec::index_mut]: forward function *) Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). - -(* [alloc::vec::Vec::index_mut]: backward function 0 *) -Axiom alloc_vec_Vec_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + (Self : alloc_vec_Vec T) (i : Idx), + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (alloc_vec_Vec T))). (* Trait implementation: [alloc::vec::Vec] *) Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) @@ -890,7 +884,6 @@ Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; |}. (*** Theorems *) @@ -901,10 +894,6 @@ Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usiz Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = - alloc_vec_Vec_index_usize v i. - -Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x = - alloc_vec_Vec_update_usize v i x. + alloc_vec_Vec_index_mut_usize v i. End Primitives. diff --git a/tests/coq/betree/BetreeMain_Funs.v b/tests/coq/betree/BetreeMain_Funs.v index a5dd4230..516bc7b7 100644 --- a/tests/coq/betree/BetreeMain_Funs.v +++ b/tests/coq/betree/BetreeMain_Funs.v @@ -12,7 +12,7 @@ Require Import BetreeMain_FunsExternal. Include BetreeMain_FunsExternal. Module BetreeMain_Funs. -(** [betree_main::betree::load_internal_node]: forward function +(** [betree_main::betree::load_internal_node]: Source: 'src/betree.rs', lines 36:0-36:52 *) Definition betree_load_internal_node (id : u64) (st : state) : @@ -21,70 +21,57 @@ Definition betree_load_internal_node betree_utils_load_internal_node id st . -(** [betree_main::betree::store_internal_node]: forward function +(** [betree_main::betree::store_internal_node]: Source: 'src/betree.rs', lines 41:0-41:60 *) Definition betree_store_internal_node (id : u64) (content : betree_List_t (u64 * betree_Message_t)) (st : state) : result (state * unit) := p <- betree_utils_store_internal_node id content st; - let (st0, _) := p in - Return (st0, tt) + let (st1, _) := p in + Return (st1, tt) . -(** [betree_main::betree::load_leaf_node]: forward function +(** [betree_main::betree::load_leaf_node]: Source: 'src/betree.rs', lines 46:0-46:44 *) Definition 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 +(** [betree_main::betree::store_leaf_node]: Source: 'src/betree.rs', lines 51:0-51:52 *) Definition betree_store_leaf_node (id : u64) (content : betree_List_t (u64 * u64)) (st : state) : result (state * unit) := p <- betree_utils_store_leaf_node id content st; - let (st0, _) := p in - Return (st0, tt) + let (st1, _) := p in + Return (st1, tt) . -(** [betree_main::betree::fresh_node_id]: forward function +(** [betree_main::betree::fresh_node_id]: Source: 'src/betree.rs', lines 55:0-55:48 *) -Definition betree_fresh_node_id (counter : u64) : result u64 := - _ <- u64_add counter 1%u64; Return counter +Definition betree_fresh_node_id (counter : u64) : result (u64 * u64) := + counter1 <- u64_add counter 1%u64; Return (counter, counter1) . -(** [betree_main::betree::fresh_node_id]: backward function 0 - Source: 'src/betree.rs', lines 55:0-55:48 *) -Definition betree_fresh_node_id_back (counter : u64) : result u64 := - u64_add counter 1%u64 -. - -(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: forward function +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: Source: 'src/betree.rs', lines 206:4-206:20 *) Definition betree_NodeIdCounter_new : result betree_NodeIdCounter_t := Return {| betree_NodeIdCounter_next_node_id := 0%u64 |} . -(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: forward function +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: Source: 'src/betree.rs', lines 210:4-210:36 *) Definition betree_NodeIdCounter_fresh_id - (self : betree_NodeIdCounter_t) : result u64 := - _ <- u64_add self.(betree_NodeIdCounter_next_node_id) 1%u64; - Return self.(betree_NodeIdCounter_next_node_id) -. - -(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: backward function 0 - Source: 'src/betree.rs', lines 210:4-210:36 *) -Definition betree_NodeIdCounter_fresh_id_back - (self : betree_NodeIdCounter_t) : result betree_NodeIdCounter_t := + (self : betree_NodeIdCounter_t) : result (u64 * betree_NodeIdCounter_t) := i <- u64_add self.(betree_NodeIdCounter_next_node_id) 1%u64; - Return {| betree_NodeIdCounter_next_node_id := i |} + Return (self.(betree_NodeIdCounter_next_node_id), + {| betree_NodeIdCounter_next_node_id := i |}) . -(** [betree_main::betree::upsert_update]: forward function +(** [betree_main::betree::upsert_update]: Source: 'src/betree.rs', lines 234:0-234:70 *) Definition betree_upsert_update (prev : option u64) (st : betree_UpsertFunState_t) : result u64 := @@ -92,49 +79,49 @@ Definition betree_upsert_update | None => match st with | Betree_UpsertFunState_Add v => Return v - | Betree_UpsertFunState_Sub i => Return 0%u64 + | Betree_UpsertFunState_Sub _ => Return 0%u64 end - | Some prev0 => + | Some prev1 => match st with | Betree_UpsertFunState_Add v => - margin <- u64_sub core_u64_max prev0; - if margin s>= v then u64_add prev0 v else Return core_u64_max + margin <- u64_sub core_u64_max prev1; + if margin s>= v then u64_add prev1 v else Return core_u64_max | Betree_UpsertFunState_Sub v => - if prev0 s>= v then u64_sub prev0 v else Return 0%u64 + if prev1 s>= v then u64_sub prev1 v else Return 0%u64 end end . -(** [betree_main::betree::{betree_main::betree::List#1}::len]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::len]: Source: 'src/betree.rs', lines 276:4-276:24 *) Fixpoint betree_List_len (T : Type) (n : nat) (self : betree_List_t T) : result u64 := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match self with - | Betree_List_Cons t tl => i <- betree_List_len T n0 tl; u64_add 1%u64 i + | Betree_List_Cons _ tl => i <- betree_List_len T n1 tl; u64_add 1%u64 i | Betree_List_Nil => Return 0%u64 end end . -(** [betree_main::betree::{betree_main::betree::List#1}::split_at]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::split_at]: Source: 'src/betree.rs', lines 284:4-284:51 *) Fixpoint betree_List_split_at - (T : Type) (n : nat) (self : betree_List_t T) (n0 : u64) : + (T : Type) (n : nat) (self : betree_List_t T) (n1 : u64) : result ((betree_List_t T) * (betree_List_t T)) := match n with | O => Fail_ OutOfFuel - | S n1 => - if n0 s= 0%u64 + | S n2 => + if n1 s= 0%u64 then Return (Betree_List_Nil, self) else match self with | Betree_List_Cons hd tl => - i <- u64_sub n0 1%u64; - p <- betree_List_split_at T n1 tl i; + i <- u64_sub n1 1%u64; + p <- betree_List_split_at T n2 tl i; let (ls0, ls1) := p in let l := ls0 in Return (Betree_List_Cons hd l, ls1) @@ -143,58 +130,46 @@ Fixpoint betree_List_split_at end . -(** [betree_main::betree::{betree_main::betree::List#1}::push_front]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [betree_main::betree::{betree_main::betree::List#1}::push_front]: Source: 'src/betree.rs', lines 299:4-299:34 *) Definition betree_List_push_front (T : Type) (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 + let (tl, _) := core_mem_replace (betree_List_t T) self Betree_List_Nil in let l := tl in Return (Betree_List_Cons x l) . -(** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: Source: 'src/betree.rs', lines 306:4-306:32 *) Definition betree_List_pop_front - (T : Type) (self : betree_List_t T) : result T := - let ls := core_mem_replace (betree_List_t T) self Betree_List_Nil in + (T : Type) (self : betree_List_t T) : result (T * (betree_List_t T)) := + let (ls, _) := core_mem_replace (betree_List_t T) self Betree_List_Nil in match ls with - | Betree_List_Cons x tl => Return x + | Betree_List_Cons x tl => Return (x, tl) | Betree_List_Nil => Fail_ Failure end . -(** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: backward function 0 - Source: 'src/betree.rs', lines 306:4-306:32 *) -Definition betree_List_pop_front_back - (T : Type) (self : betree_List_t T) : result (betree_List_t T) := - let ls := core_mem_replace (betree_List_t T) self Betree_List_Nil in - match ls with - | Betree_List_Cons x tl => Return tl - | Betree_List_Nil => Fail_ Failure - end -. - -(** [betree_main::betree::{betree_main::betree::List#1}::hd]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::hd]: Source: 'src/betree.rs', lines 318:4-318:22 *) Definition betree_List_hd (T : Type) (self : betree_List_t T) : result T := match self with - | Betree_List_Cons hd l => Return hd + | 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 +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::head_has_key]: Source: 'src/betree.rs', lines 327:4-327:44 *) Definition betree_ListTupleU64T_head_has_key (T : Type) (self : betree_List_t (u64 * T)) (key : u64) : result bool := match self with - | Betree_List_Cons hd l => let (i, _) := hd in Return (i s= key) + | Betree_List_Cons hd _ => let (i, _) := hd in Return (i s= key) | Betree_List_Nil => Return false end . -(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: forward function +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: Source: 'src/betree.rs', lines 339:4-339:73 *) Fixpoint betree_ListTupleU64T_partition_at_pivot (T : Type) (n : nat) (self : betree_List_t (u64 * T)) (pivot : u64) : @@ -202,14 +177,14 @@ Fixpoint betree_ListTupleU64T_partition_at_pivot := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match self with | Betree_List_Cons hd tl => let (i, t) := hd in if i s>= pivot then Return (Betree_List_Nil, Betree_List_Cons (i, t) tl) else ( - p <- betree_ListTupleU64T_partition_at_pivot T n0 tl pivot; + p <- betree_ListTupleU64T_partition_at_pivot T n1 tl pivot; let (ls0, ls1) := p in let l := ls0 in Return (Betree_List_Cons (i, t) l, ls1)) @@ -218,107 +193,76 @@ Fixpoint betree_ListTupleU64T_partition_at_pivot end . -(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: forward function +(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: Source: 'src/betree.rs', lines 359:4-364:17 *) Definition betree_Leaf_split (n : nat) (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) + result (state * (betree_Internal_t * betree_NodeIdCounter_t)) := p <- betree_List_split_at (u64 * u64) n content params.(betree_Params_split_size); let (content0, content1) := p in - p0 <- betree_List_hd (u64 * u64) content1; - let (pivot, _) := p0 in - id0 <- betree_NodeIdCounter_fresh_id node_id_cnt; - node_id_cnt0 <- betree_NodeIdCounter_fresh_id_back node_id_cnt; - id1 <- betree_NodeIdCounter_fresh_id node_id_cnt0; - p1 <- betree_store_leaf_node id0 content0 st; - let (st0, _) := p1 in - p2 <- betree_store_leaf_node id1 content1 st0; - let (st1, _) := p2 in - let n0 := Betree_Node_Leaf + p1 <- betree_List_hd (u64 * u64) content1; + let (pivot, _) := p1 in + p2 <- betree_NodeIdCounter_fresh_id node_id_cnt; + let (id0, nic) := p2 in + p3 <- betree_NodeIdCounter_fresh_id nic; + let (id1, nic1) := p3 in + p4 <- betree_store_leaf_node id0 content0 st; + let (st1, _) := p4 in + p5 <- betree_store_leaf_node id1 content1 st1; + let (st2, _) := p5 in + let n1 := Betree_Node_Leaf {| betree_Leaf_id := id0; betree_Leaf_size := params.(betree_Params_split_size) |} in - let n1 := Betree_Node_Leaf + let n2 := Betree_Node_Leaf {| betree_Leaf_id := id1; betree_Leaf_size := params.(betree_Params_split_size) |} in - Return (st1, mkbetree_Internal_t self.(betree_Leaf_id) pivot n0 n1) + Return (st2, (mkbetree_Internal_t self.(betree_Leaf_id) pivot n1 n2, nic1)) . -(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: backward function 2 - Source: 'src/betree.rs', lines 359:4-364:17 *) -Definition betree_Leaf_split_back - (n : nat) (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 - := - p <- - betree_List_split_at (u64 * u64) n content - params.(betree_Params_split_size); - let (content0, content1) := p in - _ <- betree_List_hd (u64 * u64) content1; - id0 <- betree_NodeIdCounter_fresh_id node_id_cnt; - node_id_cnt0 <- betree_NodeIdCounter_fresh_id_back node_id_cnt; - id1 <- betree_NodeIdCounter_fresh_id node_id_cnt0; - p0 <- betree_store_leaf_node id0 content0 st; - let (st0, _) := p0 in - _ <- betree_store_leaf_node id1 content1 st0; - betree_NodeIdCounter_fresh_id_back node_id_cnt0 -. - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: Source: 'src/betree.rs', lines 789:4-792:34 *) Fixpoint betree_Node_lookup_first_message_for_key (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) : - result (betree_List_t (u64 * betree_Message_t)) + result ((betree_List_t (u64 * betree_Message_t)) * (betree_List_t (u64 * + betree_Message_t) -> result (betree_List_t (u64 * betree_Message_t)))) := match n with | O => Fail_ OutOfFuel - | S n0 => - match msgs with - | Betree_List_Cons x next_msgs => - let (i, m) := x in - if i s>= key - then Return (Betree_List_Cons (i, m) next_msgs) - else betree_Node_lookup_first_message_for_key n0 key next_msgs - | Betree_List_Nil => Return Betree_List_Nil - end - 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 *) -Fixpoint betree_Node_lookup_first_message_for_key_back - (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) - (ret : betree_List_t (u64 * betree_Message_t)) : - result (betree_List_t (u64 * betree_Message_t)) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match msgs with | Betree_List_Cons x next_msgs => let (i, m) := x in if i s>= key - then Return ret + then + let back_'a := + fun (ret : betree_List_t (u64 * betree_Message_t)) => Return ret in + Return (Betree_List_Cons (i, m) next_msgs, back_'a) else ( - next_msgs0 <- - betree_Node_lookup_first_message_for_key_back n0 key next_msgs ret; - Return (Betree_List_Cons (i, m) next_msgs0)) - | Betree_List_Nil => Return ret + p <- betree_Node_lookup_first_message_for_key n1 key next_msgs; + let (l, lookup_first_message_for_key_back) := p in + let back_'a := + fun (ret : betree_List_t (u64 * betree_Message_t)) => + next_msgs1 <- lookup_first_message_for_key_back ret; + Return (Betree_List_Cons (i, m) next_msgs1) in + Return (l, back_'a)) + | Betree_List_Nil => + let back_'a := + fun (ret : betree_List_t (u64 * betree_Message_t)) => Return ret in + Return (Betree_List_Nil, back_'a) end end . -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: Source: 'src/betree.rs', lines 636:4-636:80 *) Fixpoint betree_Node_lookup_in_bindings (n : nat) (key : u64) (bindings : betree_List_t (u64 * u64)) : @@ -326,263 +270,146 @@ Fixpoint betree_Node_lookup_in_bindings := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match bindings with | Betree_List_Cons hd tl => - let (i, i0) := hd in + let (i, i1) := hd in if i s= key - then Return (Some i0) + then Return (Some i1) else if i s> key then Return None - else betree_Node_lookup_in_bindings n0 key tl + else betree_Node_lookup_in_bindings n1 key tl | Betree_List_Nil => Return None end end . -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: Source: 'src/betree.rs', lines 819:4-819:90 *) Fixpoint betree_Node_apply_upserts (n : nat) (msgs : betree_List_t (u64 * betree_Message_t)) (prev : option u64) (key : u64) (st : state) : - result (state * u64) + result (state * (u64 * (betree_List_t (u64 * betree_Message_t)))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => b <- betree_ListTupleU64T_head_has_key betree_Message_t msgs key; if b then ( - msg <- betree_List_pop_front (u64 * betree_Message_t) msgs; + p <- betree_List_pop_front (u64 * betree_Message_t) msgs; + let (msg, l) := p in let (_, m) := msg in match m with - | Betree_Message_Insert i => Fail_ Failure + | Betree_Message_Insert _ => Fail_ Failure | Betree_Message_Delete => Fail_ Failure | Betree_Message_Upsert s => v <- betree_upsert_update prev s; - msgs0 <- betree_List_pop_front_back (u64 * betree_Message_t) msgs; - betree_Node_apply_upserts n0 msgs0 (Some v) key st + betree_Node_apply_upserts n1 l (Some v) key st end) else ( p <- core_option_Option_unwrap u64 prev st; - let (st0, v) := p in - _ <- + let (st1, v) := p in + l <- betree_List_push_front (u64 * betree_Message_t) msgs (key, Betree_Message_Insert v); - Return (st0, v)) - end -. - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: backward function 0 - Source: 'src/betree.rs', lines 819:4-819:90 *) -Fixpoint betree_Node_apply_upserts_back - (n : nat) (msgs : betree_List_t (u64 * betree_Message_t)) (prev : option u64) - (key : u64) (st : state) : - result (betree_List_t (u64 * betree_Message_t)) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - b <- betree_ListTupleU64T_head_has_key betree_Message_t msgs key; - if b - then ( - msg <- betree_List_pop_front (u64 * betree_Message_t) msgs; - let (_, m) := msg in - match m with - | Betree_Message_Insert i => Fail_ Failure - | Betree_Message_Delete => Fail_ Failure - | Betree_Message_Upsert s => - v <- betree_upsert_update prev s; - msgs0 <- betree_List_pop_front_back (u64 * betree_Message_t) msgs; - betree_Node_apply_upserts_back n0 msgs0 (Some v) key st - end) - else ( - p <- core_option_Option_unwrap u64 prev st; - let (_, v) := p in - betree_List_push_front (u64 * betree_Message_t) msgs (key, - Betree_Message_Insert v)) + Return (st1, (v, l))) end . -(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: forward function +(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: Source: 'src/betree.rs', lines 395:4-395:63 *) Fixpoint betree_Internal_lookup_in_children (n : nat) (self : betree_Internal_t) (key : u64) (st : state) : - result (state * (option u64)) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - if key s< self.(betree_Internal_pivot) - then betree_Node_lookup n0 self.(betree_Internal_left) key st - else betree_Node_lookup n0 self.(betree_Internal_right) key st - end - -(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: backward function 0 - Source: 'src/betree.rs', lines 395:4-395:63 *) -with betree_Internal_lookup_in_children_back - (n : nat) (self : betree_Internal_t) (key : u64) (st : state) : - result betree_Internal_t + result (state * ((option u64) * betree_Internal_t)) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => if key s< self.(betree_Internal_pivot) then ( - n1 <- betree_Node_lookup_back n0 self.(betree_Internal_left) key st; - Return (mkbetree_Internal_t self.(betree_Internal_id) - self.(betree_Internal_pivot) n1 self.(betree_Internal_right))) + p <- betree_Node_lookup n1 self.(betree_Internal_left) key st; + let (st1, p1) := p in + let (o, n2) := p1 in + Return (st1, (o, mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) n2 self.(betree_Internal_right)))) else ( - n1 <- betree_Node_lookup_back n0 self.(betree_Internal_right) key st; - Return (mkbetree_Internal_t self.(betree_Internal_id) - self.(betree_Internal_pivot) self.(betree_Internal_left) n1)) + p <- betree_Node_lookup n1 self.(betree_Internal_right) key st; + let (st1, p1) := p in + let (o, n2) := p1 in + Return (st1, (o, mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) self.(betree_Internal_left) n2))) end -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: Source: 'src/betree.rs', lines 709:4-709:58 *) with betree_Node_lookup (n : nat) (self : betree_Node_t) (key : u64) (st : state) : - result (state * (option u64)) + result (state * ((option u64) * betree_Node_t)) := match n with | O => Fail_ OutOfFuel - | S n0 => - match self with - | Betree_Node_Internal node => - p <- betree_load_internal_node node.(betree_Internal_id) st; - let (st0, msgs) := p in - pending <- betree_Node_lookup_first_message_for_key n0 key msgs; - match pending with - | Betree_List_Cons p0 l => - let (k, msg) := p0 in - if k s<> key - then ( - p1 <- betree_Internal_lookup_in_children n0 node key st0; - let (st1, o) := p1 in - _ <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - (Betree_List_Cons (k, msg) l); - Return (st1, o)) - else - match msg with - | Betree_Message_Insert v => - _ <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - (Betree_List_Cons (k, Betree_Message_Insert v) l); - Return (st0, Some v) - | Betree_Message_Delete => - _ <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - (Betree_List_Cons (k, Betree_Message_Delete) l); - Return (st0, None) - | Betree_Message_Upsert ufs => - p1 <- betree_Internal_lookup_in_children n0 node key st0; - let (st1, v) := p1 in - p2 <- - betree_Node_apply_upserts n0 (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1; - let (st2, v0) := p2 in - node0 <- betree_Internal_lookup_in_children_back n0 node key st0; - pending0 <- - betree_Node_apply_upserts_back n0 (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1; - msgs0 <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - pending0; - p3 <- - betree_store_internal_node node0.(betree_Internal_id) msgs0 st2; - let (st3, _) := p3 in - Return (st3, Some v0) - end - | Betree_List_Nil => - p0 <- betree_Internal_lookup_in_children n0 node key st0; - let (st1, o) := p0 in - _ <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - Betree_List_Nil; - Return (st1, o) - end - | Betree_Node_Leaf node => - p <- betree_load_leaf_node node.(betree_Leaf_id) st; - let (st0, bindings) := p in - o <- betree_Node_lookup_in_bindings n0 key bindings; - Return (st0, o) - end - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: backward function 0 - Source: 'src/betree.rs', lines 709:4-709:58 *) -with betree_Node_lookup_back - (n : nat) (self : betree_Node_t) (key : u64) (st : state) : - result betree_Node_t - := - match n with - | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match self with | Betree_Node_Internal node => p <- betree_load_internal_node node.(betree_Internal_id) st; - let (st0, msgs) := p in - pending <- betree_Node_lookup_first_message_for_key n0 key msgs; + let (st1, msgs) := p in + p1 <- betree_Node_lookup_first_message_for_key n1 key msgs; + let (pending, lookup_first_message_for_key_back) := p1 in match pending with - | Betree_List_Cons p0 l => - let (k, msg) := p0 in + | Betree_List_Cons p2 l => + let (k, msg) := p2 in if k s<> key then ( - _ <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - (Betree_List_Cons (k, msg) l); - node0 <- betree_Internal_lookup_in_children_back n0 node key st0; - Return (Betree_Node_Internal node0)) + p3 <- betree_Internal_lookup_in_children n1 node key st1; + let (st2, p4) := p3 in + let (o, i) := p4 in + _ <- lookup_first_message_for_key_back (Betree_List_Cons (k, msg) l); + Return (st2, (o, Betree_Node_Internal i))) else match msg with | Betree_Message_Insert v => _ <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - (Betree_List_Cons (k, Betree_Message_Insert v) l); - Return (Betree_Node_Internal node) + lookup_first_message_for_key_back (Betree_List_Cons (k, + Betree_Message_Insert v) l); + Return (st1, (Some v, Betree_Node_Internal node)) | Betree_Message_Delete => _ <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - (Betree_List_Cons (k, Betree_Message_Delete) l); - Return (Betree_Node_Internal node) + lookup_first_message_for_key_back (Betree_List_Cons (k, + Betree_Message_Delete) l); + Return (st1, (None, Betree_Node_Internal node)) | Betree_Message_Upsert ufs => - p1 <- betree_Internal_lookup_in_children n0 node key st0; - let (st1, v) := p1 in - p2 <- - betree_Node_apply_upserts n0 (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1; - let (st2, _) := p2 in - node0 <- betree_Internal_lookup_in_children_back n0 node key st0; - pending0 <- - betree_Node_apply_upserts_back n0 (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1; - msgs0 <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - pending0; - _ <- - betree_store_internal_node node0.(betree_Internal_id) msgs0 st2; - Return (Betree_Node_Internal node0) + p3 <- betree_Internal_lookup_in_children n1 node key st1; + let (st2, p4) := p3 in + let (v, i) := p4 in + p5 <- + betree_Node_apply_upserts n1 (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st2; + let (st3, p6) := p5 in + let (v1, l1) := p6 in + msgs1 <- lookup_first_message_for_key_back l1; + p7 <- betree_store_internal_node i.(betree_Internal_id) msgs1 st3; + let (st4, _) := p7 in + Return (st4, (Some v1, Betree_Node_Internal i)) end | Betree_List_Nil => - _ <- - betree_Node_lookup_first_message_for_key_back n0 key msgs - Betree_List_Nil; - node0 <- betree_Internal_lookup_in_children_back n0 node key st0; - Return (Betree_Node_Internal node0) + p2 <- betree_Internal_lookup_in_children n1 node key st1; + let (st2, p3) := p2 in + let (o, i) := p3 in + _ <- lookup_first_message_for_key_back Betree_List_Nil; + Return (st2, (o, Betree_Node_Internal i)) end | Betree_Node_Leaf node => p <- betree_load_leaf_node node.(betree_Leaf_id) st; - let (_, bindings) := p in - _ <- betree_Node_lookup_in_bindings n0 key bindings; - Return (Betree_Node_Leaf node) + let (st1, bindings) := p in + o <- betree_Node_lookup_in_bindings n1 key bindings; + Return (st1, (o, Betree_Node_Leaf node)) end 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: Source: 'src/betree.rs', lines 674:4-674:77 *) Fixpoint betree_Node_filter_messages_for_key (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) : @@ -590,127 +417,118 @@ Fixpoint betree_Node_filter_messages_for_key := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match msgs with | Betree_List_Cons p l => let (k, m) := p in if k s= key then ( - msgs0 <- - betree_List_pop_front_back (u64 * betree_Message_t) (Betree_List_Cons - (k, m) l); - betree_Node_filter_messages_for_key n0 key msgs0) + p1 <- + betree_List_pop_front (u64 * betree_Message_t) (Betree_List_Cons (k, + m) l); + let (_, l1) := p1 in + betree_Node_filter_messages_for_key n1 key l1) else Return (Betree_List_Cons (k, m) l) | Betree_List_Nil => Return Betree_List_Nil end end . -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: Source: 'src/betree.rs', lines 689:4-692:34 *) Fixpoint betree_Node_lookup_first_message_after_key (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) : - result (betree_List_t (u64 * betree_Message_t)) + result ((betree_List_t (u64 * betree_Message_t)) * (betree_List_t (u64 * + betree_Message_t) -> result (betree_List_t (u64 * betree_Message_t)))) := match n with | O => Fail_ OutOfFuel - | S n0 => - match msgs with - | Betree_List_Cons p next_msgs => - let (k, m) := p in - if k s= key - then betree_Node_lookup_first_message_after_key n0 key next_msgs - else Return (Betree_List_Cons (k, m) next_msgs) - | Betree_List_Nil => Return Betree_List_Nil - end - 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 *) -Fixpoint betree_Node_lookup_first_message_after_key_back - (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) - (ret : betree_List_t (u64 * betree_Message_t)) : - result (betree_List_t (u64 * betree_Message_t)) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match msgs with | Betree_List_Cons p next_msgs => let (k, m) := p in if k s= key then ( - next_msgs0 <- - betree_Node_lookup_first_message_after_key_back n0 key next_msgs ret; - Return (Betree_List_Cons (k, m) next_msgs0)) - else Return ret - | Betree_List_Nil => Return ret + p1 <- betree_Node_lookup_first_message_after_key n1 key next_msgs; + let (l, lookup_first_message_after_key_back) := p1 in + let back_'a := + fun (ret : betree_List_t (u64 * betree_Message_t)) => + next_msgs1 <- lookup_first_message_after_key_back ret; + Return (Betree_List_Cons (k, m) next_msgs1) in + Return (l, back_'a)) + else + let back_'a := + fun (ret : betree_List_t (u64 * betree_Message_t)) => Return ret in + Return (Betree_List_Cons (k, m) next_msgs, back_'a) + | Betree_List_Nil => + let back_'a := + fun (ret : betree_List_t (u64 * betree_Message_t)) => Return ret in + Return (Betree_List_Nil, back_'a) end 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: Source: 'src/betree.rs', lines 521:4-521:89 *) Definition betree_Node_apply_to_internal (n : nat) (msgs : betree_List_t (u64 * betree_Message_t)) (key : u64) (new_msg : betree_Message_t) : result (betree_List_t (u64 * betree_Message_t)) := - msgs0 <- betree_Node_lookup_first_message_for_key n key msgs; - b <- betree_ListTupleU64T_head_has_key betree_Message_t msgs0 key; + p <- betree_Node_lookup_first_message_for_key n key msgs; + let (msgs1, lookup_first_message_for_key_back) := p in + b <- betree_ListTupleU64T_head_has_key betree_Message_t msgs1 key; if b then match new_msg with | Betree_Message_Insert i => - msgs1 <- betree_Node_filter_messages_for_key n key msgs0; - msgs2 <- - betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + l <- betree_Node_filter_messages_for_key n key msgs1; + l1 <- + betree_List_push_front (u64 * betree_Message_t) l (key, Betree_Message_Insert i); - betree_Node_lookup_first_message_for_key_back n key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Delete => - msgs1 <- betree_Node_filter_messages_for_key n key msgs0; - msgs2 <- - betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + l <- betree_Node_filter_messages_for_key n key msgs1; + l1 <- + betree_List_push_front (u64 * betree_Message_t) l (key, Betree_Message_Delete); - betree_Node_lookup_first_message_for_key_back n key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Upsert s => - p <- betree_List_hd (u64 * betree_Message_t) msgs0; - let (_, m) := p in + p1 <- betree_List_hd (u64 * betree_Message_t) msgs1; + let (_, m) := p1 in match m with | Betree_Message_Insert prev => v <- betree_upsert_update (Some prev) s; - msgs1 <- betree_List_pop_front_back (u64 * betree_Message_t) msgs0; - msgs2 <- - betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + p2 <- betree_List_pop_front (u64 * betree_Message_t) msgs1; + let (_, l) := p2 in + l1 <- + betree_List_push_front (u64 * betree_Message_t) l (key, Betree_Message_Insert v); - betree_Node_lookup_first_message_for_key_back n key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Delete => + p2 <- betree_List_pop_front (u64 * betree_Message_t) msgs1; + let (_, l) := p2 in v <- betree_upsert_update None s; - msgs1 <- betree_List_pop_front_back (u64 * betree_Message_t) msgs0; - msgs2 <- - betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + l1 <- + betree_List_push_front (u64 * betree_Message_t) l (key, Betree_Message_Insert v); - betree_Node_lookup_first_message_for_key_back n key msgs msgs2 - | Betree_Message_Upsert ufs => - msgs1 <- betree_Node_lookup_first_message_after_key n key msgs0; - msgs2 <- - betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + lookup_first_message_for_key_back l1 + | Betree_Message_Upsert _ => + p2 <- betree_Node_lookup_first_message_after_key n key msgs1; + let (msgs2, lookup_first_message_after_key_back) := p2 in + l <- + betree_List_push_front (u64 * betree_Message_t) msgs2 (key, Betree_Message_Upsert s); - msgs3 <- - betree_Node_lookup_first_message_after_key_back n key msgs0 msgs2; - betree_Node_lookup_first_message_for_key_back n key msgs msgs3 + msgs3 <- lookup_first_message_after_key_back l; + lookup_first_message_for_key_back msgs3 end end else ( - msgs1 <- - betree_List_push_front (u64 * betree_Message_t) msgs0 (key, new_msg); - betree_Node_lookup_first_message_for_key_back n key msgs msgs1) + l <- betree_List_push_front (u64 * betree_Message_t) msgs1 (key, new_msg); + lookup_first_message_for_key_back l) . -(** [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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_internal]: Source: 'src/betree.rs', lines 502:4-505:5 *) Fixpoint betree_Node_apply_messages_to_internal (n : nat) (msgs : betree_List_t (u64 * betree_Message_t)) @@ -719,104 +537,88 @@ Fixpoint betree_Node_apply_messages_to_internal := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match new_msgs with | Betree_List_Cons new_msg new_msgs_tl => let (i, m) := new_msg in - msgs0 <- betree_Node_apply_to_internal n0 msgs i m; - betree_Node_apply_messages_to_internal n0 msgs0 new_msgs_tl + l <- betree_Node_apply_to_internal n1 msgs i m; + betree_Node_apply_messages_to_internal n1 l new_msgs_tl | Betree_List_Nil => Return msgs end end . -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: Source: 'src/betree.rs', lines 653:4-656:32 *) Fixpoint betree_Node_lookup_mut_in_bindings (n : nat) (key : u64) (bindings : betree_List_t (u64 * u64)) : - result (betree_List_t (u64 * u64)) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match bindings with - | Betree_List_Cons hd tl => - let (i, i0) := hd in - if i s>= key - then Return (Betree_List_Cons (i, i0) tl) - else betree_Node_lookup_mut_in_bindings n0 key tl - | Betree_List_Nil => Return Betree_List_Nil - end - 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 *) -Fixpoint betree_Node_lookup_mut_in_bindings_back - (n : nat) (key : u64) (bindings : betree_List_t (u64 * u64)) - (ret : betree_List_t (u64 * u64)) : - result (betree_List_t (u64 * u64)) + result ((betree_List_t (u64 * u64)) * (betree_List_t (u64 * u64) -> result + (betree_List_t (u64 * u64)))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match bindings with | Betree_List_Cons hd tl => - let (i, i0) := hd in + let (i, i1) := hd in if i s>= key - then Return ret + then + let back_'a := fun (ret : betree_List_t (u64 * u64)) => Return ret in + Return (Betree_List_Cons (i, i1) tl, back_'a) else ( - tl0 <- betree_Node_lookup_mut_in_bindings_back n0 key tl ret; - Return (Betree_List_Cons (i, i0) tl0)) - | Betree_List_Nil => Return ret + p <- betree_Node_lookup_mut_in_bindings n1 key tl; + let (l, lookup_mut_in_bindings_back) := p in + let back_'a := + fun (ret : betree_List_t (u64 * u64)) => + tl1 <- lookup_mut_in_bindings_back ret; + Return (Betree_List_Cons (i, i1) tl1) in + Return (l, back_'a)) + | Betree_List_Nil => + let back_'a := fun (ret : betree_List_t (u64 * u64)) => Return ret in + Return (Betree_List_Nil, back_'a) end 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: Source: 'src/betree.rs', lines 460:4-460:87 *) Definition betree_Node_apply_to_leaf (n : nat) (bindings : betree_List_t (u64 * u64)) (key : u64) (new_msg : betree_Message_t) : result (betree_List_t (u64 * u64)) := - bindings0 <- betree_Node_lookup_mut_in_bindings n key bindings; - b <- betree_ListTupleU64T_head_has_key u64 bindings0 key; + p <- betree_Node_lookup_mut_in_bindings n key bindings; + let (bindings1, lookup_mut_in_bindings_back) := p in + b <- betree_ListTupleU64T_head_has_key u64 bindings1 key; if b then ( - hd <- betree_List_pop_front (u64 * u64) bindings0; + p1 <- betree_List_pop_front (u64 * u64) bindings1; + let (hd, l) := p1 in match new_msg with | Betree_Message_Insert v => - bindings1 <- betree_List_pop_front_back (u64 * u64) bindings0; - bindings2 <- betree_List_push_front (u64 * u64) bindings1 (key, v); - betree_Node_lookup_mut_in_bindings_back n key bindings bindings2 - | Betree_Message_Delete => - bindings1 <- betree_List_pop_front_back (u64 * u64) bindings0; - betree_Node_lookup_mut_in_bindings_back n key bindings bindings1 + l1 <- betree_List_push_front (u64 * u64) l (key, v); + lookup_mut_in_bindings_back l1 + | Betree_Message_Delete => lookup_mut_in_bindings_back l | Betree_Message_Upsert s => let (_, i) := hd in v <- betree_upsert_update (Some i) s; - bindings1 <- betree_List_pop_front_back (u64 * u64) bindings0; - bindings2 <- betree_List_push_front (u64 * u64) bindings1 (key, v); - betree_Node_lookup_mut_in_bindings_back n key bindings bindings2 + l1 <- betree_List_push_front (u64 * u64) l (key, v); + lookup_mut_in_bindings_back l1 end) else match new_msg with | Betree_Message_Insert v => - bindings1 <- betree_List_push_front (u64 * u64) bindings0 (key, v); - betree_Node_lookup_mut_in_bindings_back n key bindings bindings1 - | Betree_Message_Delete => - betree_Node_lookup_mut_in_bindings_back n key bindings bindings0 + l <- betree_List_push_front (u64 * u64) bindings1 (key, v); + lookup_mut_in_bindings_back l + | Betree_Message_Delete => lookup_mut_in_bindings_back bindings1 | Betree_Message_Upsert s => v <- betree_upsert_update None s; - bindings1 <- betree_List_push_front (u64 * u64) bindings0 (key, v); - betree_Node_lookup_mut_in_bindings_back n key bindings bindings1 + l <- betree_List_push_front (u64 * u64) bindings1 (key, v); + lookup_mut_in_bindings_back l 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_leaf]: Source: 'src/betree.rs', lines 444:4-447:5 *) Fixpoint betree_Node_apply_messages_to_leaf (n : nat) (bindings : betree_List_t (u64 * u64)) @@ -825,404 +627,230 @@ Fixpoint betree_Node_apply_messages_to_leaf := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match new_msgs with | Betree_List_Cons new_msg new_msgs_tl => let (i, m) := new_msg in - bindings0 <- betree_Node_apply_to_leaf n0 bindings i m; - betree_Node_apply_messages_to_leaf n0 bindings0 new_msgs_tl + l <- betree_Node_apply_to_leaf n1 bindings i m; + betree_Node_apply_messages_to_leaf n1 l new_msgs_tl | Betree_List_Nil => Return bindings end end . -(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: forward function +(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: Source: 'src/betree.rs', lines 410:4-415:26 *) Fixpoint betree_Internal_flush (n : nat) (self : betree_Internal_t) (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) (content : betree_List_t (u64 * betree_Message_t)) (st : state) : - result (state * (betree_List_t (u64 * betree_Message_t))) + result (state * ((betree_List_t (u64 * betree_Message_t)) * + (betree_Internal_t * betree_NodeIdCounter_t))) := match n with | O => Fail_ OutOfFuel - | S n0 => - p <- - betree_ListTupleU64T_partition_at_pivot betree_Message_t n0 content - self.(betree_Internal_pivot); - let (msgs_left, msgs_right) := p in - len_left <- betree_List_len (u64 * betree_Message_t) n0 msgs_left; - if len_left s>= params.(betree_Params_min_flush_size) - then ( - p0 <- - betree_Node_apply_messages n0 self.(betree_Internal_left) params - node_id_cnt msgs_left st; - let (st0, _) := p0 in - p1 <- - betree_Node_apply_messages_back n0 self.(betree_Internal_left) params - node_id_cnt msgs_left st; - let (_, node_id_cnt0) := p1 in - len_right <- betree_List_len (u64 * betree_Message_t) n0 msgs_right; - if len_right s>= params.(betree_Params_min_flush_size) - then ( - p2 <- - betree_Node_apply_messages n0 self.(betree_Internal_right) params - node_id_cnt0 msgs_right st0; - let (st1, _) := p2 in - _ <- - betree_Node_apply_messages_back n0 self.(betree_Internal_right) - params node_id_cnt0 msgs_right st0; - Return (st1, Betree_List_Nil)) - else Return (st0, msgs_right)) - else ( - p0 <- - betree_Node_apply_messages n0 self.(betree_Internal_right) params - node_id_cnt msgs_right st; - let (st0, _) := p0 in - _ <- - betree_Node_apply_messages_back n0 self.(betree_Internal_right) params - node_id_cnt msgs_right st; - Return (st0, msgs_left)) - end - -(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: backward function 0 - Source: 'src/betree.rs', lines 410:4-415:26 *) -with betree_Internal_flush_back - (n : nat) (self : betree_Internal_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) - (content : betree_List_t (u64 * betree_Message_t)) (st : state) : - result (betree_Internal_t * betree_NodeIdCounter_t) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => + | S n1 => p <- - betree_ListTupleU64T_partition_at_pivot betree_Message_t n0 content + betree_ListTupleU64T_partition_at_pivot betree_Message_t n1 content self.(betree_Internal_pivot); let (msgs_left, msgs_right) := p in - len_left <- betree_List_len (u64 * betree_Message_t) n0 msgs_left; + len_left <- betree_List_len (u64 * betree_Message_t) n1 msgs_left; if len_left s>= params.(betree_Params_min_flush_size) then ( - p0 <- - betree_Node_apply_messages n0 self.(betree_Internal_left) params - node_id_cnt msgs_left st; - let (st0, _) := p0 in p1 <- - betree_Node_apply_messages_back n0 self.(betree_Internal_left) params + betree_Node_apply_messages n1 self.(betree_Internal_left) params node_id_cnt msgs_left st; - let (n1, node_id_cnt0) := p1 in - len_right <- betree_List_len (u64 * betree_Message_t) n0 msgs_right; + let (st1, p2) := p1 in + let (n2, node_id_cnt1) := p2 in + len_right <- betree_List_len (u64 * betree_Message_t) n1 msgs_right; if len_right s>= params.(betree_Params_min_flush_size) then ( - p2 <- - betree_Node_apply_messages_back n0 self.(betree_Internal_right) - params node_id_cnt0 msgs_right st0; - let (n2, node_id_cnt1) := p2 in - Return (mkbetree_Internal_t self.(betree_Internal_id) - self.(betree_Internal_pivot) n1 n2, node_id_cnt1)) + p3 <- + betree_Node_apply_messages n1 self.(betree_Internal_right) params + node_id_cnt1 msgs_right st1; + let (st2, p4) := p3 in + let (n3, node_id_cnt2) := p4 in + Return (st2, (Betree_List_Nil, (mkbetree_Internal_t + self.(betree_Internal_id) self.(betree_Internal_pivot) n2 n3, + node_id_cnt2)))) else - Return (mkbetree_Internal_t self.(betree_Internal_id) - self.(betree_Internal_pivot) n1 self.(betree_Internal_right), - node_id_cnt0)) + Return (st1, (msgs_right, (mkbetree_Internal_t + self.(betree_Internal_id) self.(betree_Internal_pivot) n2 + self.(betree_Internal_right), node_id_cnt1)))) else ( - p0 <- - betree_Node_apply_messages_back n0 self.(betree_Internal_right) params + p1 <- + betree_Node_apply_messages n1 self.(betree_Internal_right) params node_id_cnt msgs_right st; - let (n1, node_id_cnt0) := p0 in - Return (mkbetree_Internal_t self.(betree_Internal_id) - self.(betree_Internal_pivot) self.(betree_Internal_left) n1, - node_id_cnt0)) + let (st1, p2) := p1 in + let (n2, node_id_cnt1) := p2 in + Return (st1, (msgs_left, (mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) self.(betree_Internal_left) n2, + node_id_cnt1)))) end -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: Source: 'src/betree.rs', lines 588:4-593:5 *) with betree_Node_apply_messages (n : nat) (self : betree_Node_t) (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) (msgs : betree_List_t (u64 * betree_Message_t)) (st : state) : - result (state * unit) + result (state * (betree_Node_t * betree_NodeIdCounter_t)) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match self with | Betree_Node_Internal node => p <- betree_load_internal_node node.(betree_Internal_id) st; - let (st0, content) := p in - content0 <- betree_Node_apply_messages_to_internal n0 content msgs; - num_msgs <- betree_List_len (u64 * betree_Message_t) n0 content0; + let (st1, content) := p in + l <- betree_Node_apply_messages_to_internal n1 content msgs; + num_msgs <- betree_List_len (u64 * betree_Message_t) n1 l; if num_msgs s>= params.(betree_Params_min_flush_size) then ( - p0 <- betree_Internal_flush n0 node params node_id_cnt content0 st0; - let (st1, content1) := p0 in - p1 <- - betree_Internal_flush_back n0 node params node_id_cnt content0 st0; - let (node0, _) := p1 in - p2 <- - betree_store_internal_node node0.(betree_Internal_id) content1 st1; - let (st2, _) := p2 in - Return (st2, tt)) + p1 <- betree_Internal_flush n1 node params node_id_cnt l st1; + let (st2, p2) := p1 in + let (content1, p3) := p2 in + let (node1, node_id_cnt1) := p3 in + p4 <- + betree_store_internal_node node1.(betree_Internal_id) content1 st2; + let (st3, _) := p4 in + Return (st3, (Betree_Node_Internal node1, node_id_cnt1))) else ( - p0 <- - betree_store_internal_node node.(betree_Internal_id) content0 st0; - let (st1, _) := p0 in - Return (st1, tt)) - | Betree_Node_Leaf node => - p <- betree_load_leaf_node node.(betree_Leaf_id) st; - let (st0, content) := p in - content0 <- betree_Node_apply_messages_to_leaf n0 content msgs; - len <- betree_List_len (u64 * u64) n0 content0; - i <- u64_mul 2%u64 params.(betree_Params_split_size); - if len s>= i - then ( - p0 <- betree_Leaf_split n0 node content0 params node_id_cnt st0; - let (st1, _) := p0 in - p1 <- betree_store_leaf_node node.(betree_Leaf_id) Betree_List_Nil st1; + p1 <- betree_store_internal_node node.(betree_Internal_id) l st1; let (st2, _) := p1 in - Return (st2, tt)) - else ( - p0 <- betree_store_leaf_node node.(betree_Leaf_id) content0 st0; - let (st1, _) := p0 in - Return (st1, tt)) - end - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: backward function 0 - Source: 'src/betree.rs', lines 588:4-593:5 *) -with betree_Node_apply_messages_back - (n : nat) (self : betree_Node_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) - (msgs : betree_List_t (u64 * betree_Message_t)) (st : state) : - result (betree_Node_t * betree_NodeIdCounter_t) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match self with - | Betree_Node_Internal node => - p <- betree_load_internal_node node.(betree_Internal_id) st; - let (st0, content) := p in - content0 <- betree_Node_apply_messages_to_internal n0 content msgs; - num_msgs <- betree_List_len (u64 * betree_Message_t) n0 content0; - if num_msgs s>= params.(betree_Params_min_flush_size) - then ( - p0 <- betree_Internal_flush n0 node params node_id_cnt content0 st0; - let (st1, content1) := p0 in - p1 <- - betree_Internal_flush_back n0 node params node_id_cnt content0 st0; - let (node0, node_id_cnt0) := p1 in - _ <- - betree_store_internal_node node0.(betree_Internal_id) content1 st1; - Return (Betree_Node_Internal node0, node_id_cnt0)) - else ( - _ <- betree_store_internal_node node.(betree_Internal_id) content0 st0; - Return (Betree_Node_Internal node, node_id_cnt)) + Return (st2, (Betree_Node_Internal node, node_id_cnt))) | Betree_Node_Leaf node => p <- betree_load_leaf_node node.(betree_Leaf_id) st; - let (st0, content) := p in - content0 <- betree_Node_apply_messages_to_leaf n0 content msgs; - len <- betree_List_len (u64 * u64) n0 content0; + let (st1, content) := p in + l <- betree_Node_apply_messages_to_leaf n1 content msgs; + len <- betree_List_len (u64 * u64) n1 l; i <- u64_mul 2%u64 params.(betree_Params_split_size); if len s>= i then ( - p0 <- betree_Leaf_split n0 node content0 params node_id_cnt st0; - let (st1, new_node) := p0 in - _ <- betree_store_leaf_node node.(betree_Leaf_id) Betree_List_Nil st1; - node_id_cnt0 <- - betree_Leaf_split_back n0 node content0 params node_id_cnt st0; - Return (Betree_Node_Internal new_node, node_id_cnt0)) + p1 <- betree_Leaf_split n1 node l params node_id_cnt st1; + let (st2, p2) := p1 in + let (new_node, nic) := p2 in + p3 <- betree_store_leaf_node node.(betree_Leaf_id) Betree_List_Nil st2; + let (st3, _) := p3 in + Return (st3, (Betree_Node_Internal new_node, nic))) else ( - _ <- betree_store_leaf_node node.(betree_Leaf_id) content0 st0; - Return (Betree_Node_Leaf + p1 <- betree_store_leaf_node node.(betree_Leaf_id) l st1; + let (st2, _) := p1 in + Return (st2, (Betree_Node_Leaf {| betree_Leaf_id := node.(betree_Leaf_id); betree_Leaf_size := len - |}, node_id_cnt)) + |}, node_id_cnt))) end end . -(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: Source: 'src/betree.rs', lines 576:4-582:5 *) Definition betree_Node_apply (n : nat) (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) + result (state * (betree_Node_t * betree_NodeIdCounter_t)) := let l := Betree_List_Nil in p <- betree_Node_apply_messages n self params node_id_cnt (Betree_List_Cons (key, new_msg) l) st; - let (st0, _) := p in - _ <- - betree_Node_apply_messages_back n self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st; - Return (st0, tt) -. - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: backward function 0 - Source: 'src/betree.rs', lines 576:4-582:5 *) -Definition betree_Node_apply_back - (n : nat) (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) - := - let l := Betree_List_Nil in - betree_Node_apply_messages_back n self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st + let (st1, p1) := p in + let (self1, node_id_cnt1) := p1 in + Return (st1, (self1, node_id_cnt1)) . -(** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: Source: 'src/betree.rs', lines 849:4-849:60 *) Definition betree_BeTree_new (min_flush_size : u64) (split_size : u64) (st : state) : result (state * betree_BeTree_t) := node_id_cnt <- betree_NodeIdCounter_new; - id <- betree_NodeIdCounter_fresh_id node_id_cnt; - p <- betree_store_leaf_node id Betree_List_Nil st; - let (st0, _) := p in - node_id_cnt0 <- betree_NodeIdCounter_fresh_id_back node_id_cnt; - Return (st0, + p <- betree_NodeIdCounter_fresh_id node_id_cnt; + let (id, nic) := p in + p1 <- betree_store_leaf_node id Betree_List_Nil st; + let (st1, _) := p1 in + Return (st1, {| betree_BeTree_params := {| betree_Params_min_flush_size := min_flush_size; betree_Params_split_size := split_size |}; - betree_BeTree_node_id_cnt := node_id_cnt0; + betree_BeTree_node_id_cnt := nic; betree_BeTree_root := (Betree_Node_Leaf {| betree_Leaf_id := id; betree_Leaf_size := 0%u64 |}) |}) . -(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: Source: 'src/betree.rs', lines 868:4-868:47 *) Definition betree_BeTree_apply (n : nat) (self : betree_BeTree_t) (key : u64) (msg : betree_Message_t) (st : state) : - result (state * unit) + result (state * betree_BeTree_t) := p <- betree_Node_apply n self.(betree_BeTree_root) self.(betree_BeTree_params) self.(betree_BeTree_node_id_cnt) key msg st; - let (st0, _) := p in - _ <- - betree_Node_apply_back n self.(betree_BeTree_root) - self.(betree_BeTree_params) self.(betree_BeTree_node_id_cnt) key msg st; - Return (st0, tt) -. - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: backward function 0 - Source: 'src/betree.rs', lines 868:4-868:47 *) -Definition betree_BeTree_apply_back - (n : nat) (self : betree_BeTree_t) (key : u64) (msg : betree_Message_t) - (st : state) : - result betree_BeTree_t - := - p <- - betree_Node_apply_back n self.(betree_BeTree_root) - self.(betree_BeTree_params) self.(betree_BeTree_node_id_cnt) key msg st; - let (n0, nic) := p in - Return + let (st1, p1) := p in + let (n1, nic) := p1 in + Return (st1, {| betree_BeTree_params := self.(betree_BeTree_params); betree_BeTree_node_id_cnt := nic; - betree_BeTree_root := n0 - |} + betree_BeTree_root := n1 + |}) . -(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: Source: 'src/betree.rs', lines 874:4-874:52 *) Definition betree_BeTree_insert (n : nat) (self : betree_BeTree_t) (key : u64) (value : u64) (st : state) : - result (state * unit) - := - p <- betree_BeTree_apply n self key (Betree_Message_Insert value) st; - let (st0, _) := p in - _ <- betree_BeTree_apply_back n self key (Betree_Message_Insert value) st; - Return (st0, tt) -. - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: backward function 0 - Source: 'src/betree.rs', lines 874:4-874:52 *) -Definition betree_BeTree_insert_back - (n : nat) (self : betree_BeTree_t) (key : u64) (value : u64) (st : state) : - result betree_BeTree_t + result (state * betree_BeTree_t) := - betree_BeTree_apply_back n self key (Betree_Message_Insert value) st + betree_BeTree_apply n self key (Betree_Message_Insert value) st . -(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: Source: 'src/betree.rs', lines 880:4-880:38 *) Definition betree_BeTree_delete (n : nat) (self : betree_BeTree_t) (key : u64) (st : state) : - result (state * unit) - := - p <- betree_BeTree_apply n self key Betree_Message_Delete st; - let (st0, _) := p in - _ <- betree_BeTree_apply_back n self key Betree_Message_Delete st; - Return (st0, tt) -. - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: backward function 0 - Source: 'src/betree.rs', lines 880:4-880:38 *) -Definition betree_BeTree_delete_back - (n : nat) (self : betree_BeTree_t) (key : u64) (st : state) : - result betree_BeTree_t + result (state * betree_BeTree_t) := - betree_BeTree_apply_back n self key Betree_Message_Delete st + betree_BeTree_apply n self key Betree_Message_Delete st . -(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: Source: 'src/betree.rs', lines 886:4-886:59 *) Definition betree_BeTree_upsert (n : nat) (self : betree_BeTree_t) (key : u64) (upd : betree_UpsertFunState_t) (st : state) : - result (state * unit) - := - p <- betree_BeTree_apply n self key (Betree_Message_Upsert upd) st; - let (st0, _) := p in - _ <- betree_BeTree_apply_back n self key (Betree_Message_Upsert upd) st; - Return (st0, tt) -. - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: backward function 0 - Source: 'src/betree.rs', lines 886:4-886:59 *) -Definition betree_BeTree_upsert_back - (n : nat) (self : betree_BeTree_t) (key : u64) - (upd : betree_UpsertFunState_t) (st : state) : - result betree_BeTree_t + result (state * betree_BeTree_t) := - betree_BeTree_apply_back n self key (Betree_Message_Upsert upd) st + betree_BeTree_apply n self key (Betree_Message_Upsert upd) st . -(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: Source: 'src/betree.rs', lines 895:4-895:62 *) Definition betree_BeTree_lookup (n : nat) (self : betree_BeTree_t) (key : u64) (st : state) : - result (state * (option u64)) - := - betree_Node_lookup n self.(betree_BeTree_root) key st -. - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: backward function 0 - Source: 'src/betree.rs', lines 895:4-895:62 *) -Definition betree_BeTree_lookup_back - (n : nat) (self : betree_BeTree_t) (key : u64) (st : state) : - result betree_BeTree_t + result (state * ((option u64) * betree_BeTree_t)) := - n0 <- betree_Node_lookup_back n self.(betree_BeTree_root) key st; - Return + p <- betree_Node_lookup n self.(betree_BeTree_root) key st; + let (st1, p1) := p in + let (o, n1) := p1 in + Return (st1, (o, {| betree_BeTree_params := self.(betree_BeTree_params); betree_BeTree_node_id_cnt := self.(betree_BeTree_node_id_cnt); - betree_BeTree_root := n0 - |} + betree_BeTree_root := n1 + |})) . -(** [betree_main::main]: forward function +(** [betree_main::main]: Source: 'src/betree_main.rs', lines 5:0-5:9 *) Definition main : result unit := Return tt. diff --git a/tests/coq/betree/BetreeMain_FunsExternal_Template.v b/tests/coq/betree/BetreeMain_FunsExternal_Template.v index 36022a20..a9969448 100644 --- a/tests/coq/betree/BetreeMain_FunsExternal_Template.v +++ b/tests/coq/betree/BetreeMain_FunsExternal_Template.v @@ -11,13 +11,13 @@ Require Import BetreeMain_Types. Include BetreeMain_Types. Module BetreeMain_FunsExternal_Template. -(** [betree_main::betree_utils::load_internal_node]: forward function +(** [betree_main::betree_utils::load_internal_node]: Source: 'src/betree_utils.rs', lines 98:0-98:63 *) Axiom betree_utils_load_internal_node : u64 -> state -> result (state * (betree_List_t (u64 * betree_Message_t))) . -(** [betree_main::betree_utils::store_internal_node]: forward function +(** [betree_main::betree_utils::store_internal_node]: Source: 'src/betree_utils.rs', lines 115:0-115:71 *) Axiom betree_utils_store_internal_node : @@ -25,19 +25,19 @@ Axiom betree_utils_store_internal_node unit) . -(** [betree_main::betree_utils::load_leaf_node]: forward function +(** [betree_main::betree_utils::load_leaf_node]: Source: 'src/betree_utils.rs', lines 132:0-132:55 *) Axiom betree_utils_load_leaf_node : u64 -> state -> result (state * (betree_List_t (u64 * u64))) . -(** [betree_main::betree_utils::store_leaf_node]: forward function +(** [betree_main::betree_utils::store_leaf_node]: Source: 'src/betree_utils.rs', lines 145:0-145:63 *) Axiom betree_utils_store_leaf_node : u64 -> betree_List_t (u64 * u64) -> state -> result (state * unit) . -(** [core::option::{core::option::Option}::unwrap]: forward function +(** [core::option::{core::option::Option}::unwrap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) Axiom core_option_Option_unwrap : forall(T : Type), option T -> state -> result (state * T) diff --git a/tests/coq/betree/BetreeMain_Types.v b/tests/coq/betree/BetreeMain_Types.v index 22989256..acbc2085 100644 --- a/tests/coq/betree/BetreeMain_Types.v +++ b/tests/coq/betree/BetreeMain_Types.v @@ -61,31 +61,31 @@ with betree_Node_t := . Definition betree_Internal_id (x : betree_Internal_t) := - match x with | mkbetree_Internal_t x0 _ _ _ => x0 end + match x with | mkbetree_Internal_t x1 _ _ _ => x1 end . -Notation "x1 .(betree_Internal_id)" := (betree_Internal_id x1) (at level 9). +Notation "x2 .(betree_Internal_id)" := (betree_Internal_id x2) (at level 9). Definition betree_Internal_pivot (x : betree_Internal_t) := - match x with | mkbetree_Internal_t _ x0 _ _ => x0 end + match x with | mkbetree_Internal_t _ x1 _ _ => x1 end . -Notation "x1 .(betree_Internal_pivot)" := (betree_Internal_pivot x1) +Notation "x2 .(betree_Internal_pivot)" := (betree_Internal_pivot x2) (at level 9) . Definition betree_Internal_left (x : betree_Internal_t) := - match x with | mkbetree_Internal_t _ _ x0 _ => x0 end + match x with | mkbetree_Internal_t _ _ x1 _ => x1 end . -Notation "x1 .(betree_Internal_left)" := (betree_Internal_left x1) (at level 9) +Notation "x2 .(betree_Internal_left)" := (betree_Internal_left x2) (at level 9) . Definition betree_Internal_right (x : betree_Internal_t) := - match x with | mkbetree_Internal_t _ _ _ x0 => x0 end + match x with | mkbetree_Internal_t _ _ _ x1 => x1 end . -Notation "x1 .(betree_Internal_right)" := (betree_Internal_right x1) +Notation "x2 .(betree_Internal_right)" := (betree_Internal_right x2) (at level 9) . diff --git a/tests/coq/betree/Primitives.v b/tests/coq/betree/Primitives.v index 84280b96..990e27e4 100644 --- a/tests/coq/betree/Primitives.v +++ b/tests/coq/betree/Primitives.v @@ -67,8 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . -Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * a := (x, x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. @@ -504,13 +503,15 @@ Arguments core_ops_index_Index_index {_ _}. (* Trait declaration: [core::ops::index::IndexMut] *) Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; - core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); - core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; + core_ops_index_IndexMut_index_mut : + Self -> + Idx -> + result (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) * + (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self)); }. Arguments mk_core_ops_index_IndexMut {_ _}. Arguments core_ops_index_IndexMut_indexInst {_ _}. Arguments core_ops_index_IndexMut_index_mut {_ _}. -Arguments core_ops_index_IndexMut_index_mut_back {_ _}. (* Trait declaration [core::ops::deref::Deref] *) Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { @@ -524,13 +525,14 @@ Arguments core_ops_deref_Deref_deref {_}. (* Trait declaration [core::ops::deref::DerefMut] *) Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; - core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); - core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; + core_ops_deref_DerefMut_deref_mut : + Self -> + result (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) * + (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self)); }. Arguments mk_core_ops_deref_DerefMut {_}. Arguments core_ops_deref_DerefMut_derefInst {_}. Arguments core_ops_deref_DerefMut_deref_mut {_}. -Arguments core_ops_deref_DerefMut_deref_mut_back {_}. Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { core_ops_range_Range_start : T; @@ -543,8 +545,8 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := + Return (x, fun x => Return x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -556,7 +558,6 @@ Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; - core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; |}. @@ -584,6 +585,13 @@ Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usize) : + result (T * (T -> result (array T n))) := + match array_index_usize T n a i with + | Fail_ e => Fail_ e + | Return x => Return (x, array_update_usize T n a i) + end. + (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. @@ -591,11 +599,25 @@ Axiom slice_len : forall (T : Type) (s : slice T), usize. Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : + result (T * (T -> result (slice T))) := + match slice_index_usize T s i with + | Fail_ e => Fail_ e + | Return x => Return (x, slice_update_usize T s i) + end. + (*** Subslices *) Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : + result (slice T * (slice T -> result (array T n))) := + match array_to_slice T n a with + | Fail_ e => Fail_ e + | Return x => Return (x, array_from_slice T n a) + end. + Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). @@ -639,16 +661,9 @@ Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (l | right _ => Fail_ Failure end. -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. - Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_insert_fwd (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result unit := - if to_Z i if to_Z i result (alloc_vec_Vec T))) := + match alloc_vec_Vec_index_usize v i with + | Return x => + Return (x, alloc_vec_Vec_update_usize v i) + | Fail_ e => Fail_ e + end. + (* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. @@ -669,25 +692,23 @@ Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceI core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; core_slice_index_SliceIndex_Output : Type; core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_mut : + Self -> T -> result (option core_slice_index_SliceIndex_Output * (option core_slice_index_SliceIndex_Output -> result T)); core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_index_mut : + Self -> T -> result (core_slice_index_SliceIndex_Output * (core_slice_index_SliceIndex_Output -> result T)); }. Arguments mk_core_slice_index_SliceIndex {_ _}. Arguments core_slice_index_SliceIndex_sealedInst {_ _}. Arguments core_slice_index_SliceIndex_Output {_ _}. Arguments core_slice_index_SliceIndex_get {_ _}. Arguments core_slice_index_SliceIndex_get_mut {_ _}. -Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. Arguments core_slice_index_SliceIndex_index {_ _}. Arguments core_slice_index_SliceIndex_index_mut {_ _}. -Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. (* [core::slice::index::[T]::index]: forward function *) Definition core_slice_index_Slice_index @@ -704,11 +725,9 @@ Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Ra (* [core::slice::index::Range::get_mut]: forward function *) Axiom core_slice_index_RangeUsize_get_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (option (slice T)). - -(* [core::slice::index::Range::get_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_get_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + forall (T : Type), + core_ops_range_Range usize -> slice T -> + result (option (slice T) * (option (slice T) -> result (slice T))). (* [core::slice::index::Range::get_unchecked]: forward function *) Definition core_slice_index_RangeUsize_get_unchecked @@ -732,21 +751,14 @@ Axiom core_slice_index_RangeUsize_index : (* [core::slice::index::Range::index_mut]: forward function *) Axiom core_slice_index_RangeUsize_index_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). - -(* [core::slice::index::Range::index_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_index_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T * (slice T -> result (slice T))). (* [core::slice::index::[T]::index_mut]: forward function *) Axiom core_slice_index_Slice_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). - -(* [core::slice::index::[T]::index_mut]: backward function 0 *) -Axiom core_slice_index_Slice_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + slice T -> Idx -> + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (slice T))). (* [core::array::[T; N]::index]: forward function *) Axiom core_array_Array_index : @@ -756,12 +768,9 @@ Axiom core_array_Array_index : (* [core::array::[T; N]::index_mut]: forward function *) Axiom core_array_Array_index_mut : forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). - -(* [core::array::[T; N]::index_mut]: backward function 0 *) -Axiom core_array_Array_index_mut_back : - forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + (a : array T N) (i : Idx), + result (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) * + (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) -> result (array T N))). (* Trait implementation: [core::slice::index::private_slice_index::Range] *) Definition core_slice_index_private_slice_index_SealedRangeUsizeInst @@ -774,12 +783,10 @@ Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := slice T; core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_RangeUsize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_RangeUsize_index_mut_back T; |}. (* Trait implementation: [core::slice::index::[T]] *) @@ -796,7 +803,6 @@ Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) core_ops_index_IndexMut (slice T) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; |}. (* Trait implementation: [core::array::[T; N]] *) @@ -813,18 +819,14 @@ Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) core_ops_index_IndexMut (array T N) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; - core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; |}. (* [core::slice::index::usize::get]: forward function *) Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). (* [core::slice::index::usize::get_mut]: forward function *) -Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). - -(* [core::slice::index::usize::get_mut]: backward function 0 *) -Axiom core_slice_index_usize_get_mut_back : - forall (T : Type), usize -> slice T -> option T -> result (slice T). +Axiom core_slice_index_usize_get_mut : + forall (T : Type), usize -> slice T -> result (option T * (option T -> result (slice T))). (* [core::slice::index::usize::get_unchecked]: forward function *) Axiom core_slice_index_usize_get_unchecked : @@ -838,11 +840,8 @@ Axiom core_slice_index_usize_get_unchecked_mut : Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. (* [core::slice::index::usize::index_mut]: forward function *) -Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. - -(* [core::slice::index::usize::index_mut]: backward function 0 *) -Axiom core_slice_index_usize_index_mut_back : - forall (T : Type), usize -> slice T -> T -> result (slice T). +Axiom core_slice_index_usize_index_mut : + forall (T : Type), usize -> slice T -> result (T * (T -> result (slice T))). (* Trait implementation: [core::slice::index::private_slice_index::usize] *) Definition core_slice_index_private_slice_index_SealedUsizeInst @@ -855,12 +854,10 @@ Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := T; core_slice_index_SliceIndex_get := core_slice_index_usize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_usize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; |}. (* [alloc::vec::Vec::index]: forward function *) @@ -869,12 +866,9 @@ Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_Slice (* [alloc::vec::Vec::index_mut]: forward function *) Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). - -(* [alloc::vec::Vec::index_mut]: backward function 0 *) -Axiom alloc_vec_Vec_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + (Self : alloc_vec_Vec T) (i : Idx), + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (alloc_vec_Vec T))). (* Trait implementation: [alloc::vec::Vec] *) Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) @@ -890,7 +884,6 @@ Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; |}. (*** Theorems *) @@ -901,10 +894,6 @@ Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usiz Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = - alloc_vec_Vec_index_usize v i. - -Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x = - alloc_vec_Vec_update_usize v i x. + alloc_vec_Vec_index_mut_usize v i. End Primitives. diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index 64de44a6..5cd9fe70 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -10,39 +10,39 @@ Require Import Hashmap_Types. Include Hashmap_Types. Module Hashmap_Funs. -(** [hashmap::hash_key]: forward function +(** [hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 *) Definition hash_key (k : usize) : result usize := Return k. -(** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 *) Fixpoint hashMap_allocate_slots_loop - (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (n0 : usize) : + (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (n1 : usize) : result (alloc_vec_Vec (List_t T)) := match n with | O => Fail_ OutOfFuel - | S n1 => - if n0 s> 0%usize + | S n2 => + if n1 s> 0%usize then ( - slots0 <- alloc_vec_Vec_push (List_t T) slots List_Nil; - n2 <- usize_sub n0 1%usize; - hashMap_allocate_slots_loop T n1 slots0 n2) + v <- alloc_vec_Vec_push (List_t T) slots List_Nil; + n3 <- usize_sub n1 1%usize; + hashMap_allocate_slots_loop T n2 v n3) else Return slots end . -(** [hashmap::{hashmap::HashMap}::allocate_slots]: forward function +(** [hashmap::{hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 *) Definition hashMap_allocate_slots - (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (n0 : usize) : + (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (n1 : usize) : result (alloc_vec_Vec (List_t T)) := - hashMap_allocate_slots_loop T n slots n0 + hashMap_allocate_slots_loop T n slots n1 . -(** [hashmap::{hashmap::HashMap}::new_with_capacity]: forward function +(** [hashmap::{hashmap::HashMap}::new_with_capacity]: Source: 'src/hashmap.rs', lines 59:4-63:13 *) Definition hashMap_new_with_capacity (T : Type) (n : nat) (capacity : usize) (max_load_dividend : usize) @@ -52,24 +52,23 @@ Definition hashMap_new_with_capacity let v := alloc_vec_Vec_new (List_t T) in slots <- hashMap_allocate_slots T n v capacity; i <- usize_mul capacity max_load_dividend; - i0 <- usize_div i max_load_divisor; + i1 <- usize_div i max_load_divisor; Return {| hashMap_num_entries := 0%usize; hashMap_max_load_factor := (max_load_dividend, max_load_divisor); - hashMap_max_load := i0; + hashMap_max_load := i1; hashMap_slots := slots |} . -(** [hashmap::{hashmap::HashMap}::new]: forward function +(** [hashmap::{hashmap::HashMap}::new]: Source: 'src/hashmap.rs', lines 75:4-75:24 *) Definition hashMap_new (T : Type) (n : nat) : result (HashMap_t T) := hashMap_new_with_capacity T n 32%usize 4%usize 5%usize . -(** [hashmap::{hashmap::HashMap}::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::clear]: loop 0: Source: 'src/hashmap.rs', lines 80:4-88:5 *) Fixpoint hashMap_clear_loop (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (i : usize) : @@ -77,101 +76,73 @@ Fixpoint hashMap_clear_loop := match n with | O => Fail_ OutOfFuel - | S n0 => - let i0 := alloc_vec_Vec_len (List_t T) slots in - if i s< i0 + | S n1 => + let i1 := alloc_vec_Vec_len (List_t T) slots in + if i s< i1 then ( - i1 <- usize_add i 1%usize; - slots0 <- - alloc_vec_Vec_index_mut_back (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) slots i - List_Nil; - hashMap_clear_loop T n0 slots0 i1) + p <- + alloc_vec_Vec_index_mut (List_t T) usize + (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) slots i; + let (_, index_mut_back) := p in + i2 <- usize_add i 1%usize; + slots1 <- index_mut_back List_Nil; + hashMap_clear_loop T n1 slots1 i2) else Return slots end . -(** [hashmap::{hashmap::HashMap}::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 *) Definition hashMap_clear (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) := - v <- hashMap_clear_loop T n self.(hashMap_slots) 0%usize; + back <- hashMap_clear_loop T n self.(hashMap_slots) 0%usize; Return {| hashMap_num_entries := 0%usize; hashMap_max_load_factor := self.(hashMap_max_load_factor); hashMap_max_load := self.(hashMap_max_load); - hashMap_slots := v + hashMap_slots := back |} . -(** [hashmap::{hashmap::HashMap}::len]: forward function +(** [hashmap::{hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) Definition hashMap_len (T : Type) (self : HashMap_t T) : result usize := Return self.(hashMap_num_entries) . -(** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 *) Fixpoint hashMap_insert_in_list_loop (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : - result bool + result (bool * (List_t T)) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons ckey cvalue tl => if ckey s= key - then Return false - else hashMap_insert_in_list_loop T n0 key value tl - | List_Nil => Return true + then Return (false, List_Cons ckey value tl) + else ( + p <- hashMap_insert_in_list_loop T n1 key value tl; + let (b, back) := p in + Return (b, List_Cons ckey cvalue back)) + | List_Nil => let l := List_Nil in Return (true, List_Cons key value l) end end . -(** [hashmap::{hashmap::HashMap}::insert_in_list]: forward function +(** [hashmap::{hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 *) Definition hashMap_insert_in_list (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : - result bool + result (bool * (List_t T)) := hashMap_insert_in_list_loop T n key value ls . -(** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 97:4-114:5 *) -Fixpoint hashMap_insert_in_list_loop_back - (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : - result (List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls with - | List_Cons ckey cvalue tl => - if ckey s= key - then Return (List_Cons ckey value tl) - else ( - tl0 <- hashMap_insert_in_list_loop_back T n0 key value tl; - Return (List_Cons ckey cvalue tl0)) - | List_Nil => let l := List_Nil in Return (List_Cons key value l) - end - end -. - -(** [hashmap::{hashmap::HashMap}::insert_in_list]: backward function 0 - Source: 'src/hashmap.rs', lines 97:4-97:71 *) -Definition hashMap_insert_in_list_back - (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : - result (List_t T) - := - hashMap_insert_in_list_loop_back T n key value ls -. - -(** [hashmap::{hashmap::HashMap}::insert_no_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::insert_no_resize]: Source: 'src/hashmap.rs', lines 117:4-117:54 *) Definition hashMap_insert_no_resize (T : Type) (n : nat) (self : HashMap_t T) (key : usize) (value : T) : @@ -180,32 +151,26 @@ Definition hashMap_insert_no_resize hash <- hash_key key; let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- + p <- alloc_vec_Vec_index_mut (List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) self.(hashMap_slots) hash_mod; - inserted <- hashMap_insert_in_list T n key value l; + let (l, index_mut_back) := p in + p1 <- hashMap_insert_in_list T n key value l; + let (inserted, l1) := p1 in if inserted then ( - i0 <- usize_add self.(hashMap_num_entries) 1%usize; - l0 <- hashMap_insert_in_list_back T n key value l; - v <- - alloc_vec_Vec_index_mut_back (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) - self.(hashMap_slots) hash_mod l0; + i1 <- usize_add self.(hashMap_num_entries) 1%usize; + v <- index_mut_back l1; Return {| - hashMap_num_entries := i0; + hashMap_num_entries := i1; hashMap_max_load_factor := self.(hashMap_max_load_factor); hashMap_max_load := self.(hashMap_max_load); hashMap_slots := v |}) else ( - l0 <- hashMap_insert_in_list_back T n key value l; - v <- - alloc_vec_Vec_index_mut_back (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) - self.(hashMap_slots) hash_mod l0; + v <- index_mut_back l1; Return {| hashMap_num_entries := self.(hashMap_num_entries); @@ -215,8 +180,7 @@ Definition hashMap_insert_no_resize |}) . -(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 *) Fixpoint hashMap_move_elements_from_list_loop (T : Type) (n : nat) (ntable : HashMap_t T) (ls : List_t T) : @@ -224,18 +188,17 @@ Fixpoint hashMap_move_elements_from_list_loop := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons k v tl => - ntable0 <- hashMap_insert_no_resize T n0 ntable k v; - hashMap_move_elements_from_list_loop T n0 ntable0 tl + hm <- hashMap_insert_no_resize T n1 ntable k v; + hashMap_move_elements_from_list_loop T n1 hm tl | List_Nil => Return ntable end end . -(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: Source: 'src/hashmap.rs', lines 183:4-183:72 *) Definition hashMap_move_elements_from_list (T : Type) (n : nat) (ntable : HashMap_t T) (ls : List_t T) : @@ -244,8 +207,7 @@ Definition hashMap_move_elements_from_list hashMap_move_elements_from_list_loop T n ntable ls . -(** [hashmap::{hashmap::HashMap}::move_elements]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::move_elements]: loop 0: Source: 'src/hashmap.rs', lines 171:4-180:5 *) Fixpoint hashMap_move_elements_loop (T : Type) (n : nat) (ntable : HashMap_t T) @@ -254,108 +216,105 @@ Fixpoint hashMap_move_elements_loop := match n with | O => Fail_ OutOfFuel - | S n0 => - let i0 := alloc_vec_Vec_len (List_t T) slots in - if i s< i0 + | S n1 => + let i1 := alloc_vec_Vec_len (List_t T) slots in + if i s< i1 then ( - l <- + p <- alloc_vec_Vec_index_mut (List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) slots i; - let ls := core_mem_replace (List_t T) l List_Nil in - ntable0 <- hashMap_move_elements_from_list T n0 ntable ls; - i1 <- usize_add i 1%usize; - let l0 := core_mem_replace_back (List_t T) l List_Nil in - slots0 <- - alloc_vec_Vec_index_mut_back (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) slots i l0; - hashMap_move_elements_loop T n0 ntable0 slots0 i1) + let (l, index_mut_back) := p in + let (ls, l1) := core_mem_replace (List_t T) l List_Nil in + hm <- hashMap_move_elements_from_list T n1 ntable ls; + i2 <- usize_add i 1%usize; + slots1 <- index_mut_back l1; + back_'a <- hashMap_move_elements_loop T n1 hm slots1 i2; + let (hm1, v) := back_'a in + Return (hm1, v)) else Return (ntable, slots) end . -(** [hashmap::{hashmap::HashMap}::move_elements]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 *) Definition hashMap_move_elements (T : Type) (n : nat) (ntable : HashMap_t T) (slots : alloc_vec_Vec (List_t T)) (i : usize) : result ((HashMap_t T) * (alloc_vec_Vec (List_t T))) := - hashMap_move_elements_loop T n ntable slots i + back_'a <- hashMap_move_elements_loop T n ntable slots i; + let (hm, v) := back_'a in + Return (hm, v) . -(** [hashmap::{hashmap::HashMap}::try_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::try_resize]: Source: 'src/hashmap.rs', lines 140:4-140:28 *) Definition hashMap_try_resize (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) := max_usize <- scalar_cast U32 Usize core_u32_max; let capacity := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in n1 <- usize_div max_usize 2%usize; - let (i, i0) := self.(hashMap_max_load_factor) in - i1 <- usize_div n1 i; - if capacity s<= i1 + let (i, i1) := self.(hashMap_max_load_factor) in + i2 <- usize_div n1 i; + if capacity s<= i2 then ( - i2 <- usize_mul capacity 2%usize; - ntable <- hashMap_new_with_capacity T n i2 i i0; + i3 <- usize_mul capacity 2%usize; + ntable <- hashMap_new_with_capacity T n i3 i i1; p <- hashMap_move_elements T n ntable self.(hashMap_slots) 0%usize; - let (ntable0, _) := p in + let (ntable1, _) := p in Return {| hashMap_num_entries := self.(hashMap_num_entries); - hashMap_max_load_factor := (i, i0); - hashMap_max_load := ntable0.(hashMap_max_load); - hashMap_slots := ntable0.(hashMap_slots) + hashMap_max_load_factor := (i, i1); + hashMap_max_load := ntable1.(hashMap_max_load); + hashMap_slots := ntable1.(hashMap_slots) |}) else Return {| hashMap_num_entries := self.(hashMap_num_entries); - hashMap_max_load_factor := (i, i0); + hashMap_max_load_factor := (i, i1); hashMap_max_load := self.(hashMap_max_load); hashMap_slots := self.(hashMap_slots) |} . -(** [hashmap::{hashmap::HashMap}::insert]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 *) Definition hashMap_insert (T : Type) (n : nat) (self : HashMap_t T) (key : usize) (value : T) : result (HashMap_t T) := - self0 <- hashMap_insert_no_resize T n self key value; - i <- hashMap_len T self0; - if i s> self0.(hashMap_max_load) - then hashMap_try_resize T n self0 - else Return self0 + hm <- hashMap_insert_no_resize T n self key value; + i <- hashMap_len T hm; + if i s> hm.(hashMap_max_load) then hashMap_try_resize T n hm else Return hm . -(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 *) Fixpoint hashMap_contains_key_in_list_loop (T : Type) (n : nat) (key : usize) (ls : List_t T) : result bool := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with - | List_Cons ckey t tl => + | List_Cons ckey _ tl => if ckey s= key then Return true - else hashMap_contains_key_in_list_loop T n0 key tl + else hashMap_contains_key_in_list_loop T n1 key tl | List_Nil => Return false end end . -(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: forward function +(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: Source: 'src/hashmap.rs', lines 206:4-206:68 *) Definition hashMap_contains_key_in_list (T : Type) (n : nat) (key : usize) (ls : List_t T) : result bool := hashMap_contains_key_in_list_loop T n key ls . -(** [hashmap::{hashmap::HashMap}::contains_key]: forward function +(** [hashmap::{hashmap::HashMap}::contains_key]: Source: 'src/hashmap.rs', lines 199:4-199:49 *) Definition hashMap_contains_key (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result bool := @@ -369,31 +328,31 @@ Definition hashMap_contains_key hashMap_contains_key_in_list T n key l . -(** [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: Source: 'src/hashmap.rs', lines 224:4-237:5 *) Fixpoint hashMap_get_in_list_loop (T : Type) (n : nat) (key : usize) (ls : List_t T) : result T := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons ckey cvalue tl => if ckey s= key then Return cvalue - else hashMap_get_in_list_loop T n0 key tl + else hashMap_get_in_list_loop T n1 key tl | List_Nil => Fail_ Failure end end . -(** [hashmap::{hashmap::HashMap}::get_in_list]: forward function +(** [hashmap::{hashmap::HashMap}::get_in_list]: Source: 'src/hashmap.rs', lines 224:4-224:70 *) Definition hashMap_get_in_list (T : Type) (n : nat) (key : usize) (ls : List_t T) : result T := hashMap_get_in_list_loop T n key ls . -(** [hashmap::{hashmap::HashMap}::get]: forward function +(** [hashmap::{hashmap::HashMap}::get]: Source: 'src/hashmap.rs', lines 239:4-239:55 *) Definition hashMap_get (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result T := @@ -407,264 +366,188 @@ Definition hashMap_get hashMap_get_in_list T n key l . -(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: Source: 'src/hashmap.rs', lines 245:4-254:5 *) Fixpoint hashMap_get_mut_in_list_loop - (T : Type) (n : nat) (ls : List_t T) (key : usize) : result T := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls with - | List_Cons ckey cvalue tl => - if ckey s= key - then Return cvalue - else hashMap_get_mut_in_list_loop T n0 tl key - | List_Nil => Fail_ Failure - end - end -. - -(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: forward function - Source: 'src/hashmap.rs', lines 245:4-245:86 *) -Definition hashMap_get_mut_in_list - (T : Type) (n : nat) (ls : List_t T) (key : usize) : result T := - hashMap_get_mut_in_list_loop T n ls key -. - -(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 245:4-254:5 *) -Fixpoint hashMap_get_mut_in_list_loop_back - (T : Type) (n : nat) (ls : List_t T) (key : usize) (ret : T) : - result (List_t T) + (T : Type) (n : nat) (ls : List_t T) (key : usize) : + result (T * (T -> result (List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons ckey cvalue tl => if ckey s= key - then Return (List_Cons ckey ret tl) + then + let back_'a := fun (ret : T) => Return (List_Cons ckey ret tl) in + Return (cvalue, back_'a) else ( - tl0 <- hashMap_get_mut_in_list_loop_back T n0 tl key ret; - Return (List_Cons ckey cvalue tl0)) + p <- hashMap_get_mut_in_list_loop T n1 tl key; + let (t, back_'a) := p in + let back_'a1 := + fun (ret : T) => + tl1 <- back_'a ret; Return (List_Cons ckey cvalue tl1) in + Return (t, back_'a1)) | List_Nil => Fail_ Failure end end . -(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: backward function 0 +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: Source: 'src/hashmap.rs', lines 245:4-245:86 *) -Definition hashMap_get_mut_in_list_back - (T : Type) (n : nat) (ls : List_t T) (key : usize) (ret : T) : - result (List_t T) +Definition hashMap_get_mut_in_list + (T : Type) (n : nat) (ls : List_t T) (key : usize) : + result (T * (T -> result (List_t T))) := - hashMap_get_mut_in_list_loop_back T n ls key ret + p <- hashMap_get_mut_in_list_loop T n ls key; + let (t, back_'a) := p in + let back_'a1 := fun (ret : T) => back_'a ret in + Return (t, back_'a1) . -(** [hashmap::{hashmap::HashMap}::get_mut]: forward function +(** [hashmap::{hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 *) Definition hashMap_get_mut - (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result T := - hash <- hash_key key; - let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in - hash_mod <- usize_rem hash i; - l <- - alloc_vec_Vec_index_mut (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) - self.(hashMap_slots) hash_mod; - hashMap_get_mut_in_list T n l key -. - -(** [hashmap::{hashmap::HashMap}::get_mut]: backward function 0 - Source: 'src/hashmap.rs', lines 257:4-257:67 *) -Definition hashMap_get_mut_back - (T : Type) (n : nat) (self : HashMap_t T) (key : usize) (ret : T) : - result (HashMap_t T) + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : + result (T * (T -> result (HashMap_t T))) := hash <- hash_key key; let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- + p <- alloc_vec_Vec_index_mut (List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) self.(hashMap_slots) hash_mod; - l0 <- hashMap_get_mut_in_list_back T n l key ret; - v <- - alloc_vec_Vec_index_mut_back (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) - self.(hashMap_slots) hash_mod l0; - Return - {| - hashMap_num_entries := self.(hashMap_num_entries); - hashMap_max_load_factor := self.(hashMap_max_load_factor); - hashMap_max_load := self.(hashMap_max_load); - hashMap_slots := v - |} -. - -(** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: forward function + let (l, index_mut_back) := p in + p1 <- hashMap_get_mut_in_list T n l key; + let (t, get_mut_in_list_back) := p1 in + let back_'a := + fun (ret : T) => + l1 <- get_mut_in_list_back ret; + v <- index_mut_back l1; + Return + {| + hashMap_num_entries := self.(hashMap_num_entries); + hashMap_max_load_factor := self.(hashMap_max_load_factor); + hashMap_max_load := self.(hashMap_max_load); + hashMap_slots := v + |} in + Return (t, back_'a) +. + +(** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 *) Fixpoint hashMap_remove_from_list_loop - (T : Type) (n : nat) (key : usize) (ls : List_t T) : result (option T) := + (T : Type) (n : nat) (key : usize) (ls : List_t T) : + result ((option T) * (List_t T)) + := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons ckey t tl => if ckey s= key then - let mv_ls := core_mem_replace (List_t T) (List_Cons ckey t tl) List_Nil - in + let (mv_ls, _) := + core_mem_replace (List_t T) (List_Cons ckey t tl) List_Nil in match mv_ls with - | List_Cons i cvalue tl0 => Return (Some cvalue) + | List_Cons _ cvalue tl1 => Return (Some cvalue, tl1) | List_Nil => Fail_ Failure end - else hashMap_remove_from_list_loop T n0 key tl - | List_Nil => Return None + else ( + p <- hashMap_remove_from_list_loop T n1 key tl; + let (o, back) := p in + Return (o, List_Cons ckey t back)) + | List_Nil => Return (None, List_Nil) end end . -(** [hashmap::{hashmap::HashMap}::remove_from_list]: forward function +(** [hashmap::{hashmap::HashMap}::remove_from_list]: Source: 'src/hashmap.rs', lines 265:4-265:69 *) Definition hashMap_remove_from_list - (T : Type) (n : nat) (key : usize) (ls : List_t T) : result (option T) := + (T : Type) (n : nat) (key : usize) (ls : List_t T) : + result ((option T) * (List_t T)) + := hashMap_remove_from_list_loop T n key ls . -(** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: backward function 1 - Source: 'src/hashmap.rs', lines 265:4-291:5 *) -Fixpoint hashMap_remove_from_list_loop_back - (T : Type) (n : nat) (key : usize) (ls : List_t T) : result (List_t T) := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls with - | List_Cons ckey t tl => - if ckey s= key - then - let mv_ls := core_mem_replace (List_t T) (List_Cons ckey t tl) List_Nil - in - match mv_ls with - | List_Cons i cvalue tl0 => Return tl0 - | List_Nil => Fail_ Failure - end - else ( - tl0 <- hashMap_remove_from_list_loop_back T n0 key tl; - Return (List_Cons ckey t tl0)) - | List_Nil => Return List_Nil - end - end -. - -(** [hashmap::{hashmap::HashMap}::remove_from_list]: backward function 1 - Source: 'src/hashmap.rs', lines 265:4-265:69 *) -Definition hashMap_remove_from_list_back - (T : Type) (n : nat) (key : usize) (ls : List_t T) : result (List_t T) := - hashMap_remove_from_list_loop_back T n key ls -. - -(** [hashmap::{hashmap::HashMap}::remove]: forward function +(** [hashmap::{hashmap::HashMap}::remove]: Source: 'src/hashmap.rs', lines 294:4-294:52 *) Definition hashMap_remove (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : - result (option T) - := - hash <- hash_key key; - let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in - hash_mod <- usize_rem hash i; - l <- - alloc_vec_Vec_index_mut (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) - self.(hashMap_slots) hash_mod; - x <- hashMap_remove_from_list T n key l; - match x with - | None => Return None - | Some x0 => - _ <- usize_sub self.(hashMap_num_entries) 1%usize; Return (Some x0) - end -. - -(** [hashmap::{hashmap::HashMap}::remove]: backward function 0 - Source: 'src/hashmap.rs', lines 294:4-294:52 *) -Definition hashMap_remove_back - (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : - result (HashMap_t T) + result ((option T) * (HashMap_t T)) := hash <- hash_key key; let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- + p <- alloc_vec_Vec_index_mut (List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) self.(hashMap_slots) hash_mod; - x <- hashMap_remove_from_list T n key l; + let (l, index_mut_back) := p in + p1 <- hashMap_remove_from_list T n key l; + let (x, l1) := p1 in match x with | None => - l0 <- hashMap_remove_from_list_back T n key l; - v <- - alloc_vec_Vec_index_mut_back (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) - self.(hashMap_slots) hash_mod l0; - Return + v <- index_mut_back l1; + Return (None, {| hashMap_num_entries := self.(hashMap_num_entries); hashMap_max_load_factor := self.(hashMap_max_load_factor); hashMap_max_load := self.(hashMap_max_load); hashMap_slots := v - |} - | Some x0 => - i0 <- usize_sub self.(hashMap_num_entries) 1%usize; - l0 <- hashMap_remove_from_list_back T n key l; - v <- - alloc_vec_Vec_index_mut_back (List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) - self.(hashMap_slots) hash_mod l0; - Return + |}) + | Some x1 => + i1 <- usize_sub self.(hashMap_num_entries) 1%usize; + v <- index_mut_back l1; + Return (Some x1, {| - hashMap_num_entries := i0; + hashMap_num_entries := i1; hashMap_max_load_factor := self.(hashMap_max_load_factor); hashMap_max_load := self.(hashMap_max_load); hashMap_slots := v - |} + |}) end . -(** [hashmap::test1]: forward function +(** [hashmap::test1]: Source: 'src/hashmap.rs', lines 315:0-315:10 *) Definition test1 (n : nat) : result unit := hm <- hashMap_new u64 n; - hm0 <- hashMap_insert u64 n hm 0%usize 42%u64; - hm1 <- hashMap_insert u64 n hm0 128%usize 18%u64; - hm2 <- hashMap_insert u64 n hm1 1024%usize 138%u64; - hm3 <- hashMap_insert u64 n hm2 1056%usize 256%u64; - i <- hashMap_get u64 n hm3 128%usize; + hm1 <- hashMap_insert u64 n hm 0%usize 42%u64; + hm2 <- hashMap_insert u64 n hm1 128%usize 18%u64; + hm3 <- hashMap_insert u64 n hm2 1024%usize 138%u64; + hm4 <- hashMap_insert u64 n hm3 1056%usize 256%u64; + i <- hashMap_get u64 n hm4 128%usize; if negb (i s= 18%u64) then Fail_ Failure else ( - hm4 <- hashMap_get_mut_back u64 n hm3 1024%usize 56%u64; - i0 <- hashMap_get u64 n hm4 1024%usize; - if negb (i0 s= 56%u64) + p <- hashMap_get_mut u64 n hm4 1024%usize; + let (_, get_mut_back) := p in + hm5 <- get_mut_back 56%u64; + i1 <- hashMap_get u64 n hm5 1024%usize; + if negb (i1 s= 56%u64) then Fail_ Failure else ( - x <- hashMap_remove u64 n hm4 1024%usize; + p1 <- hashMap_remove u64 n hm5 1024%usize; + let (x, hm6) := p1 in match x with | None => Fail_ Failure - | Some x0 => - if negb (x0 s= 56%u64) + | Some x1 => + if negb (x1 s= 56%u64) then Fail_ Failure else ( - hm5 <- hashMap_remove_back u64 n hm4 1024%usize; - i1 <- hashMap_get u64 n hm5 0%usize; - if negb (i1 s= 42%u64) + i2 <- hashMap_get u64 n hm6 0%usize; + if negb (i2 s= 42%u64) then Fail_ Failure else ( - i2 <- hashMap_get u64 n hm5 128%usize; - if negb (i2 s= 18%u64) + i3 <- hashMap_get u64 n hm6 128%usize; + if negb (i3 s= 18%u64) then Fail_ Failure else ( - i3 <- hashMap_get u64 n hm5 1056%usize; - if negb (i3 s= 256%u64) then Fail_ Failure else Return tt))) + i4 <- hashMap_get u64 n hm6 1056%usize; + if negb (i4 s= 256%u64) then Fail_ Failure else Return tt))) end)) . diff --git a/tests/coq/hashmap/Primitives.v b/tests/coq/hashmap/Primitives.v index 84280b96..990e27e4 100644 --- a/tests/coq/hashmap/Primitives.v +++ b/tests/coq/hashmap/Primitives.v @@ -67,8 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . -Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * a := (x, x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. @@ -504,13 +503,15 @@ Arguments core_ops_index_Index_index {_ _}. (* Trait declaration: [core::ops::index::IndexMut] *) Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; - core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); - core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; + core_ops_index_IndexMut_index_mut : + Self -> + Idx -> + result (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) * + (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self)); }. Arguments mk_core_ops_index_IndexMut {_ _}. Arguments core_ops_index_IndexMut_indexInst {_ _}. Arguments core_ops_index_IndexMut_index_mut {_ _}. -Arguments core_ops_index_IndexMut_index_mut_back {_ _}. (* Trait declaration [core::ops::deref::Deref] *) Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { @@ -524,13 +525,14 @@ Arguments core_ops_deref_Deref_deref {_}. (* Trait declaration [core::ops::deref::DerefMut] *) Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; - core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); - core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; + core_ops_deref_DerefMut_deref_mut : + Self -> + result (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) * + (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self)); }. Arguments mk_core_ops_deref_DerefMut {_}. Arguments core_ops_deref_DerefMut_derefInst {_}. Arguments core_ops_deref_DerefMut_deref_mut {_}. -Arguments core_ops_deref_DerefMut_deref_mut_back {_}. Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { core_ops_range_Range_start : T; @@ -543,8 +545,8 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := + Return (x, fun x => Return x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -556,7 +558,6 @@ Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; - core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; |}. @@ -584,6 +585,13 @@ Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usize) : + result (T * (T -> result (array T n))) := + match array_index_usize T n a i with + | Fail_ e => Fail_ e + | Return x => Return (x, array_update_usize T n a i) + end. + (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. @@ -591,11 +599,25 @@ Axiom slice_len : forall (T : Type) (s : slice T), usize. Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : + result (T * (T -> result (slice T))) := + match slice_index_usize T s i with + | Fail_ e => Fail_ e + | Return x => Return (x, slice_update_usize T s i) + end. + (*** Subslices *) Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : + result (slice T * (slice T -> result (array T n))) := + match array_to_slice T n a with + | Fail_ e => Fail_ e + | Return x => Return (x, array_from_slice T n a) + end. + Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). @@ -639,16 +661,9 @@ Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (l | right _ => Fail_ Failure end. -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. - Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_insert_fwd (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result unit := - if to_Z i if to_Z i result (alloc_vec_Vec T))) := + match alloc_vec_Vec_index_usize v i with + | Return x => + Return (x, alloc_vec_Vec_update_usize v i) + | Fail_ e => Fail_ e + end. + (* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. @@ -669,25 +692,23 @@ Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceI core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; core_slice_index_SliceIndex_Output : Type; core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_mut : + Self -> T -> result (option core_slice_index_SliceIndex_Output * (option core_slice_index_SliceIndex_Output -> result T)); core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_index_mut : + Self -> T -> result (core_slice_index_SliceIndex_Output * (core_slice_index_SliceIndex_Output -> result T)); }. Arguments mk_core_slice_index_SliceIndex {_ _}. Arguments core_slice_index_SliceIndex_sealedInst {_ _}. Arguments core_slice_index_SliceIndex_Output {_ _}. Arguments core_slice_index_SliceIndex_get {_ _}. Arguments core_slice_index_SliceIndex_get_mut {_ _}. -Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. Arguments core_slice_index_SliceIndex_index {_ _}. Arguments core_slice_index_SliceIndex_index_mut {_ _}. -Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. (* [core::slice::index::[T]::index]: forward function *) Definition core_slice_index_Slice_index @@ -704,11 +725,9 @@ Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Ra (* [core::slice::index::Range::get_mut]: forward function *) Axiom core_slice_index_RangeUsize_get_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (option (slice T)). - -(* [core::slice::index::Range::get_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_get_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + forall (T : Type), + core_ops_range_Range usize -> slice T -> + result (option (slice T) * (option (slice T) -> result (slice T))). (* [core::slice::index::Range::get_unchecked]: forward function *) Definition core_slice_index_RangeUsize_get_unchecked @@ -732,21 +751,14 @@ Axiom core_slice_index_RangeUsize_index : (* [core::slice::index::Range::index_mut]: forward function *) Axiom core_slice_index_RangeUsize_index_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). - -(* [core::slice::index::Range::index_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_index_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T * (slice T -> result (slice T))). (* [core::slice::index::[T]::index_mut]: forward function *) Axiom core_slice_index_Slice_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). - -(* [core::slice::index::[T]::index_mut]: backward function 0 *) -Axiom core_slice_index_Slice_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + slice T -> Idx -> + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (slice T))). (* [core::array::[T; N]::index]: forward function *) Axiom core_array_Array_index : @@ -756,12 +768,9 @@ Axiom core_array_Array_index : (* [core::array::[T; N]::index_mut]: forward function *) Axiom core_array_Array_index_mut : forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). - -(* [core::array::[T; N]::index_mut]: backward function 0 *) -Axiom core_array_Array_index_mut_back : - forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + (a : array T N) (i : Idx), + result (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) * + (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) -> result (array T N))). (* Trait implementation: [core::slice::index::private_slice_index::Range] *) Definition core_slice_index_private_slice_index_SealedRangeUsizeInst @@ -774,12 +783,10 @@ Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := slice T; core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_RangeUsize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_RangeUsize_index_mut_back T; |}. (* Trait implementation: [core::slice::index::[T]] *) @@ -796,7 +803,6 @@ Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) core_ops_index_IndexMut (slice T) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; |}. (* Trait implementation: [core::array::[T; N]] *) @@ -813,18 +819,14 @@ Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) core_ops_index_IndexMut (array T N) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; - core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; |}. (* [core::slice::index::usize::get]: forward function *) Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). (* [core::slice::index::usize::get_mut]: forward function *) -Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). - -(* [core::slice::index::usize::get_mut]: backward function 0 *) -Axiom core_slice_index_usize_get_mut_back : - forall (T : Type), usize -> slice T -> option T -> result (slice T). +Axiom core_slice_index_usize_get_mut : + forall (T : Type), usize -> slice T -> result (option T * (option T -> result (slice T))). (* [core::slice::index::usize::get_unchecked]: forward function *) Axiom core_slice_index_usize_get_unchecked : @@ -838,11 +840,8 @@ Axiom core_slice_index_usize_get_unchecked_mut : Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. (* [core::slice::index::usize::index_mut]: forward function *) -Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. - -(* [core::slice::index::usize::index_mut]: backward function 0 *) -Axiom core_slice_index_usize_index_mut_back : - forall (T : Type), usize -> slice T -> T -> result (slice T). +Axiom core_slice_index_usize_index_mut : + forall (T : Type), usize -> slice T -> result (T * (T -> result (slice T))). (* Trait implementation: [core::slice::index::private_slice_index::usize] *) Definition core_slice_index_private_slice_index_SealedUsizeInst @@ -855,12 +854,10 @@ Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := T; core_slice_index_SliceIndex_get := core_slice_index_usize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_usize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; |}. (* [alloc::vec::Vec::index]: forward function *) @@ -869,12 +866,9 @@ Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_Slice (* [alloc::vec::Vec::index_mut]: forward function *) Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). - -(* [alloc::vec::Vec::index_mut]: backward function 0 *) -Axiom alloc_vec_Vec_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + (Self : alloc_vec_Vec T) (i : Idx), + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (alloc_vec_Vec T))). (* Trait implementation: [alloc::vec::Vec] *) Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) @@ -890,7 +884,6 @@ Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; |}. (*** Theorems *) @@ -901,10 +894,6 @@ Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usiz Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = - alloc_vec_Vec_index_usize v i. - -Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x = - alloc_vec_Vec_update_usize v i x. + alloc_vec_Vec_index_mut_usize v i. End Primitives. diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v index faba0afe..b74fa61a 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v @@ -12,41 +12,41 @@ Require Import HashmapMain_FunsExternal. Include HashmapMain_FunsExternal. Module HashmapMain_Funs. -(** [hashmap_main::hashmap::hash_key]: forward function +(** [hashmap_main::hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 *) Definition hashmap_hash_key (k : usize) : result usize := Return k. -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 *) Fixpoint hashmap_HashMap_allocate_slots_loop - (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (n0 : usize) + (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (n1 : usize) : result (alloc_vec_Vec (hashmap_List_t T)) := match n with | O => Fail_ OutOfFuel - | S n1 => - if n0 s> 0%usize + | S n2 => + if n1 s> 0%usize then ( - slots0 <- alloc_vec_Vec_push (hashmap_List_t T) slots Hashmap_List_Nil; - n2 <- usize_sub n0 1%usize; - hashmap_HashMap_allocate_slots_loop T n1 slots0 n2) + v <- alloc_vec_Vec_push (hashmap_List_t T) slots Hashmap_List_Nil; + n3 <- usize_sub n1 1%usize; + hashmap_HashMap_allocate_slots_loop T n2 v n3) else Return slots end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 *) Definition hashmap_HashMap_allocate_slots - (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (n0 : usize) + (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (n1 : usize) : result (alloc_vec_Vec (hashmap_List_t T)) := - hashmap_HashMap_allocate_slots_loop T n slots n0 + hashmap_HashMap_allocate_slots_loop T n slots n1 . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new_with_capacity]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new_with_capacity]: Source: 'src/hashmap.rs', lines 59:4-63:13 *) Definition hashmap_HashMap_new_with_capacity (T : Type) (n : nat) (capacity : usize) (max_load_dividend : usize) @@ -56,25 +56,24 @@ Definition hashmap_HashMap_new_with_capacity let v := alloc_vec_Vec_new (hashmap_List_t T) in slots <- hashmap_HashMap_allocate_slots T n v capacity; i <- usize_mul capacity max_load_dividend; - i0 <- usize_div i max_load_divisor; + i1 <- usize_div i max_load_divisor; Return {| hashmap_HashMap_num_entries := 0%usize; hashmap_HashMap_max_load_factor := (max_load_dividend, max_load_divisor); - hashmap_HashMap_max_load := i0; + hashmap_HashMap_max_load := i1; hashmap_HashMap_slots := slots |} . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new]: Source: 'src/hashmap.rs', lines 75:4-75:24 *) Definition hashmap_HashMap_new (T : Type) (n : nat) : result (hashmap_HashMap_t T) := hashmap_HashMap_new_with_capacity T n 32%usize 4%usize 5%usize . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: loop 0: Source: 'src/hashmap.rs', lines 80:4-88:5 *) Fixpoint hashmap_HashMap_clear_loop (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) : @@ -82,105 +81,78 @@ Fixpoint hashmap_HashMap_clear_loop := match n with | O => Fail_ OutOfFuel - | S n0 => - let i0 := alloc_vec_Vec_len (hashmap_List_t T) slots in - if i s< i0 + | S n1 => + let i1 := alloc_vec_Vec_len (hashmap_List_t T) slots in + if i s< i1 then ( - i1 <- usize_add i 1%usize; - slots0 <- - alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize + p <- + alloc_vec_Vec_index_mut (hashmap_List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) slots - i Hashmap_List_Nil; - hashmap_HashMap_clear_loop T n0 slots0 i1) + i; + let (_, index_mut_back) := p in + i2 <- usize_add i 1%usize; + slots1 <- index_mut_back Hashmap_List_Nil; + hashmap_HashMap_clear_loop T n1 slots1 i2) else Return slots end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 *) Definition hashmap_HashMap_clear (T : Type) (n : nat) (self : hashmap_HashMap_t T) : result (hashmap_HashMap_t T) := - v <- hashmap_HashMap_clear_loop T n self.(hashmap_HashMap_slots) 0%usize; + back <- hashmap_HashMap_clear_loop T n self.(hashmap_HashMap_slots) 0%usize; Return {| hashmap_HashMap_num_entries := 0%usize; hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); - hashmap_HashMap_slots := v + hashmap_HashMap_slots := back |} . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) Definition hashmap_HashMap_len (T : Type) (self : hashmap_HashMap_t T) : result usize := Return self.(hashmap_HashMap_num_entries) . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 *) Fixpoint hashmap_HashMap_insert_in_list_loop (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : - result bool + result (bool * (hashmap_List_t T)) := match n with | O => Fail_ OutOfFuel - | S n0 => - match ls with - | Hashmap_List_Cons ckey cvalue tl => - if ckey s= key - then Return false - else hashmap_HashMap_insert_in_list_loop T n0 key value tl - | Hashmap_List_Nil => Return true - end - end -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: forward function - Source: 'src/hashmap.rs', lines 97:4-97:71 *) -Definition hashmap_HashMap_insert_in_list - (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : - result bool - := - hashmap_HashMap_insert_in_list_loop T n key value ls -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 97:4-114:5 *) -Fixpoint hashmap_HashMap_insert_in_list_loop_back - (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : - result (hashmap_List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | Hashmap_List_Cons ckey cvalue tl => if ckey s= key - then Return (Hashmap_List_Cons ckey value tl) + then Return (false, Hashmap_List_Cons ckey value tl) else ( - tl0 <- hashmap_HashMap_insert_in_list_loop_back T n0 key value tl; - Return (Hashmap_List_Cons ckey cvalue tl0)) + p <- hashmap_HashMap_insert_in_list_loop T n1 key value tl; + let (b, back) := p in + Return (b, Hashmap_List_Cons ckey cvalue back)) | Hashmap_List_Nil => - let l := Hashmap_List_Nil in Return (Hashmap_List_Cons key value l) + let l := Hashmap_List_Nil in Return (true, Hashmap_List_Cons key value l) end end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: backward function 0 +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 *) -Definition hashmap_HashMap_insert_in_list_back +Definition hashmap_HashMap_insert_in_list (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : - result (hashmap_List_t T) + result (bool * (hashmap_List_t T)) := - hashmap_HashMap_insert_in_list_loop_back T n key value ls + hashmap_HashMap_insert_in_list_loop T n key value ls . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_no_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_no_resize]: Source: 'src/hashmap.rs', lines 117:4-117:54 *) Definition hashmap_HashMap_insert_no_resize (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) (value : T) : @@ -189,33 +161,27 @@ Definition hashmap_HashMap_insert_no_resize hash <- hashmap_hash_key key; let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; - l <- + p <- alloc_vec_Vec_index_mut (hashmap_List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) self.(hashmap_HashMap_slots) hash_mod; - inserted <- hashmap_HashMap_insert_in_list T n key value l; + let (l, index_mut_back) := p in + p1 <- hashmap_HashMap_insert_in_list T n key value l; + let (inserted, l1) := p1 in if inserted then ( - i0 <- usize_add self.(hashmap_HashMap_num_entries) 1%usize; - l0 <- hashmap_HashMap_insert_in_list_back T n key value l; - v <- - alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) - self.(hashmap_HashMap_slots) hash_mod l0; + i1 <- usize_add self.(hashmap_HashMap_num_entries) 1%usize; + v <- index_mut_back l1; Return {| - hashmap_HashMap_num_entries := i0; + hashmap_HashMap_num_entries := i1; hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); hashmap_HashMap_slots := v |}) else ( - l0 <- hashmap_HashMap_insert_in_list_back T n key value l; - v <- - alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) - self.(hashmap_HashMap_slots) hash_mod l0; + v <- index_mut_back l1; Return {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); @@ -226,8 +192,7 @@ Definition hashmap_HashMap_insert_no_resize |}) . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 *) Fixpoint hashmap_HashMap_move_elements_from_list_loop (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (ls : hashmap_List_t T) : @@ -235,18 +200,17 @@ Fixpoint hashmap_HashMap_move_elements_from_list_loop := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | Hashmap_List_Cons k v tl => - ntable0 <- hashmap_HashMap_insert_no_resize T n0 ntable k v; - hashmap_HashMap_move_elements_from_list_loop T n0 ntable0 tl + hm <- hashmap_HashMap_insert_no_resize T n1 ntable k v; + hashmap_HashMap_move_elements_from_list_loop T n1 hm tl | Hashmap_List_Nil => Return ntable end end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: Source: 'src/hashmap.rs', lines 183:4-183:72 *) Definition hashmap_HashMap_move_elements_from_list (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (ls : hashmap_List_t T) : @@ -255,8 +219,7 @@ Definition hashmap_HashMap_move_elements_from_list hashmap_HashMap_move_elements_from_list_loop T n ntable ls . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: loop 0: Source: 'src/hashmap.rs', lines 171:4-180:5 *) Fixpoint hashmap_HashMap_move_elements_loop (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) @@ -265,40 +228,39 @@ Fixpoint hashmap_HashMap_move_elements_loop := match n with | O => Fail_ OutOfFuel - | S n0 => - let i0 := alloc_vec_Vec_len (hashmap_List_t T) slots in - if i s< i0 + | S n1 => + let i1 := alloc_vec_Vec_len (hashmap_List_t T) slots in + if i s< i1 then ( - l <- + p <- alloc_vec_Vec_index_mut (hashmap_List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) slots i; - let ls := core_mem_replace (hashmap_List_t T) l Hashmap_List_Nil in - ntable0 <- hashmap_HashMap_move_elements_from_list T n0 ntable ls; - i1 <- usize_add i 1%usize; - let l0 := core_mem_replace_back (hashmap_List_t T) l Hashmap_List_Nil in - slots0 <- - alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) slots - i l0; - hashmap_HashMap_move_elements_loop T n0 ntable0 slots0 i1) + let (l, index_mut_back) := p in + let (ls, l1) := core_mem_replace (hashmap_List_t T) l Hashmap_List_Nil in + hm <- hashmap_HashMap_move_elements_from_list T n1 ntable ls; + i2 <- usize_add i 1%usize; + slots1 <- index_mut_back l1; + back_'a <- hashmap_HashMap_move_elements_loop T n1 hm slots1 i2; + let (hm1, v) := back_'a in + Return (hm1, v)) else Return (ntable, slots) end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 *) Definition hashmap_HashMap_move_elements (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) : result ((hashmap_HashMap_t T) * (alloc_vec_Vec (hashmap_List_t T))) := - hashmap_HashMap_move_elements_loop T n ntable slots i + back_'a <- hashmap_HashMap_move_elements_loop T n ntable slots i; + let (hm, v) := back_'a in + Return (hm, v) . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::try_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::try_resize]: Source: 'src/hashmap.rs', lines 140:4-140:28 *) Definition hashmap_HashMap_try_resize (T : Type) (n : nat) (self : hashmap_HashMap_t T) : @@ -308,72 +270,71 @@ Definition hashmap_HashMap_try_resize let capacity := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in n1 <- usize_div max_usize 2%usize; - let (i, i0) := self.(hashmap_HashMap_max_load_factor) in - i1 <- usize_div n1 i; - if capacity s<= i1 + let (i, i1) := self.(hashmap_HashMap_max_load_factor) in + i2 <- usize_div n1 i; + if capacity s<= i2 then ( - i2 <- usize_mul capacity 2%usize; - ntable <- hashmap_HashMap_new_with_capacity T n i2 i i0; + i3 <- usize_mul capacity 2%usize; + ntable <- hashmap_HashMap_new_with_capacity T n i3 i i1; p <- hashmap_HashMap_move_elements T n ntable self.(hashmap_HashMap_slots) 0%usize; - let (ntable0, _) := p in + let (ntable1, _) := p in Return {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); - hashmap_HashMap_max_load_factor := (i, i0); - hashmap_HashMap_max_load := ntable0.(hashmap_HashMap_max_load); - hashmap_HashMap_slots := ntable0.(hashmap_HashMap_slots) + hashmap_HashMap_max_load_factor := (i, i1); + hashmap_HashMap_max_load := ntable1.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := ntable1.(hashmap_HashMap_slots) |}) else Return {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); - hashmap_HashMap_max_load_factor := (i, i0); + hashmap_HashMap_max_load_factor := (i, i1); hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); hashmap_HashMap_slots := self.(hashmap_HashMap_slots) |} . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 *) Definition hashmap_HashMap_insert (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) (value : T) : result (hashmap_HashMap_t T) := - self0 <- hashmap_HashMap_insert_no_resize T n self key value; - i <- hashmap_HashMap_len T self0; - if i s> self0.(hashmap_HashMap_max_load) - then hashmap_HashMap_try_resize T n self0 - else Return self0 + hm <- hashmap_HashMap_insert_no_resize T n self key value; + i <- hashmap_HashMap_len T hm; + if i s> hm.(hashmap_HashMap_max_load) + then hashmap_HashMap_try_resize T n hm + else Return hm . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 *) Fixpoint hashmap_HashMap_contains_key_in_list_loop (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result bool := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with - | Hashmap_List_Cons ckey t tl => + | Hashmap_List_Cons ckey _ tl => if ckey s= key then Return true - else hashmap_HashMap_contains_key_in_list_loop T n0 key tl + else hashmap_HashMap_contains_key_in_list_loop T n1 key tl | Hashmap_List_Nil => Return false end end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: Source: 'src/hashmap.rs', lines 206:4-206:68 *) Definition hashmap_HashMap_contains_key_in_list (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result bool := hashmap_HashMap_contains_key_in_list_loop T n key ls . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key]: Source: 'src/hashmap.rs', lines 199:4-199:49 *) Definition hashmap_HashMap_contains_key (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : @@ -389,31 +350,31 @@ Definition hashmap_HashMap_contains_key hashmap_HashMap_contains_key_in_list T n key l . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: loop 0: Source: 'src/hashmap.rs', lines 224:4-237:5 *) Fixpoint hashmap_HashMap_get_in_list_loop (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result T := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | Hashmap_List_Cons ckey cvalue tl => if ckey s= key then Return cvalue - else hashmap_HashMap_get_in_list_loop T n0 key tl + else hashmap_HashMap_get_in_list_loop T n1 key tl | Hashmap_List_Nil => Fail_ Failure end end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: Source: 'src/hashmap.rs', lines 224:4-224:70 *) Definition hashmap_HashMap_get_in_list (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result T := hashmap_HashMap_get_in_list_loop T n key ls . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get]: Source: 'src/hashmap.rs', lines 239:4-239:55 *) Definition hashmap_HashMap_get (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result T := @@ -427,292 +388,209 @@ Definition hashmap_HashMap_get hashmap_HashMap_get_in_list T n key l . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: Source: 'src/hashmap.rs', lines 245:4-254:5 *) Fixpoint hashmap_HashMap_get_mut_in_list_loop - (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) : result T := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls with - | Hashmap_List_Cons ckey cvalue tl => - if ckey s= key - then Return cvalue - else hashmap_HashMap_get_mut_in_list_loop T n0 tl key - | Hashmap_List_Nil => Fail_ Failure - end - end -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: forward function - Source: 'src/hashmap.rs', lines 245:4-245:86 *) -Definition hashmap_HashMap_get_mut_in_list - (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) : result T := - hashmap_HashMap_get_mut_in_list_loop T n ls key -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 245:4-254:5 *) -Fixpoint hashmap_HashMap_get_mut_in_list_loop_back - (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) (ret : T) : - result (hashmap_List_t T) + (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) : + result (T * (T -> result (hashmap_List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | Hashmap_List_Cons ckey cvalue tl => if ckey s= key - then Return (Hashmap_List_Cons ckey ret tl) + then + let back_'a := fun (ret : T) => Return (Hashmap_List_Cons ckey ret tl) + in + Return (cvalue, back_'a) else ( - tl0 <- hashmap_HashMap_get_mut_in_list_loop_back T n0 tl key ret; - Return (Hashmap_List_Cons ckey cvalue tl0)) + p <- hashmap_HashMap_get_mut_in_list_loop T n1 tl key; + let (t, back_'a) := p in + let back_'a1 := + fun (ret : T) => + tl1 <- back_'a ret; Return (Hashmap_List_Cons ckey cvalue tl1) in + Return (t, back_'a1)) | Hashmap_List_Nil => Fail_ Failure end end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: backward function 0 +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: Source: 'src/hashmap.rs', lines 245:4-245:86 *) -Definition hashmap_HashMap_get_mut_in_list_back - (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) (ret : T) : - result (hashmap_List_t T) +Definition hashmap_HashMap_get_mut_in_list + (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) : + result (T * (T -> result (hashmap_List_t T))) := - hashmap_HashMap_get_mut_in_list_loop_back T n ls key ret + p <- hashmap_HashMap_get_mut_in_list_loop T n ls key; + let (t, back_'a) := p in + let back_'a1 := fun (ret : T) => back_'a ret in + Return (t, back_'a1) . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 *) Definition hashmap_HashMap_get_mut - (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result T := - hash <- hashmap_hash_key key; - let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in - hash_mod <- usize_rem hash i; - l <- - alloc_vec_Vec_index_mut (hashmap_List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) - self.(hashmap_HashMap_slots) hash_mod; - hashmap_HashMap_get_mut_in_list T n l key -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: backward function 0 - Source: 'src/hashmap.rs', lines 257:4-257:67 *) -Definition hashmap_HashMap_get_mut_back - (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) (ret : T) : - result (hashmap_HashMap_t T) + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : + result (T * (T -> result (hashmap_HashMap_t T))) := hash <- hashmap_hash_key key; let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; - l <- + p <- alloc_vec_Vec_index_mut (hashmap_List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) self.(hashmap_HashMap_slots) hash_mod; - l0 <- hashmap_HashMap_get_mut_in_list_back T n l key ret; - v <- - alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) - self.(hashmap_HashMap_slots) hash_mod l0; - Return - {| - hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); - hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); - hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); - hashmap_HashMap_slots := v - |} -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: forward function + let (l, index_mut_back) := p in + p1 <- hashmap_HashMap_get_mut_in_list T n l key; + let (t, get_mut_in_list_back) := p1 in + let back_'a := + fun (ret : T) => + l1 <- get_mut_in_list_back ret; + v <- index_mut_back l1; + Return + {| + hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); + hashmap_HashMap_max_load_factor := + self.(hashmap_HashMap_max_load_factor); + hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := v + |} in + Return (t, back_'a) +. + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 *) Fixpoint hashmap_HashMap_remove_from_list_loop (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : - result (option T) + result ((option T) * (hashmap_List_t T)) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | Hashmap_List_Cons ckey t tl => if ckey s= key then - let mv_ls := + let (mv_ls, _) := core_mem_replace (hashmap_List_t T) (Hashmap_List_Cons ckey t tl) Hashmap_List_Nil in match mv_ls with - | Hashmap_List_Cons i cvalue tl0 => Return (Some cvalue) + | Hashmap_List_Cons _ cvalue tl1 => Return (Some cvalue, tl1) | Hashmap_List_Nil => Fail_ Failure end - else hashmap_HashMap_remove_from_list_loop T n0 key tl - | Hashmap_List_Nil => Return None + else ( + p <- hashmap_HashMap_remove_from_list_loop T n1 key tl; + let (o, back) := p in + Return (o, Hashmap_List_Cons ckey t back)) + | Hashmap_List_Nil => Return (None, Hashmap_List_Nil) end end . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: Source: 'src/hashmap.rs', lines 265:4-265:69 *) Definition hashmap_HashMap_remove_from_list (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : - result (option T) + result ((option T) * (hashmap_List_t T)) := hashmap_HashMap_remove_from_list_loop T n key ls . -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: backward function 1 - Source: 'src/hashmap.rs', lines 265:4-291:5 *) -Fixpoint hashmap_HashMap_remove_from_list_loop_back - (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : - result (hashmap_List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls with - | Hashmap_List_Cons ckey t tl => - if ckey s= key - then - let mv_ls := - core_mem_replace (hashmap_List_t T) (Hashmap_List_Cons ckey t tl) - Hashmap_List_Nil in - match mv_ls with - | Hashmap_List_Cons i cvalue tl0 => Return tl0 - | Hashmap_List_Nil => Fail_ Failure - end - else ( - tl0 <- hashmap_HashMap_remove_from_list_loop_back T n0 key tl; - Return (Hashmap_List_Cons ckey t tl0)) - | Hashmap_List_Nil => Return Hashmap_List_Nil - end - end -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: backward function 1 - Source: 'src/hashmap.rs', lines 265:4-265:69 *) -Definition hashmap_HashMap_remove_from_list_back - (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : - result (hashmap_List_t T) - := - hashmap_HashMap_remove_from_list_loop_back T n key ls -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: Source: 'src/hashmap.rs', lines 294:4-294:52 *) Definition hashmap_HashMap_remove (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : - result (option T) + result ((option T) * (hashmap_HashMap_t T)) := hash <- hashmap_hash_key key; let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; - l <- + p <- alloc_vec_Vec_index_mut (hashmap_List_t T) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) self.(hashmap_HashMap_slots) hash_mod; - x <- hashmap_HashMap_remove_from_list T n key l; - match x with - | None => Return None - | Some x0 => - _ <- usize_sub self.(hashmap_HashMap_num_entries) 1%usize; Return (Some x0) - end -. - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: backward function 0 - Source: 'src/hashmap.rs', lines 294:4-294:52 *) -Definition hashmap_HashMap_remove_back - (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : - result (hashmap_HashMap_t T) - := - hash <- hashmap_hash_key key; - let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in - hash_mod <- usize_rem hash i; - l <- - alloc_vec_Vec_index_mut (hashmap_List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) - self.(hashmap_HashMap_slots) hash_mod; - x <- hashmap_HashMap_remove_from_list T n key l; + let (l, index_mut_back) := p in + p1 <- hashmap_HashMap_remove_from_list T n key l; + let (x, l1) := p1 in match x with | None => - l0 <- hashmap_HashMap_remove_from_list_back T n key l; - v <- - alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) - self.(hashmap_HashMap_slots) hash_mod l0; - Return + v <- index_mut_back l1; + Return (None, {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); hashmap_HashMap_slots := v - |} - | Some x0 => - i0 <- usize_sub self.(hashmap_HashMap_num_entries) 1%usize; - l0 <- hashmap_HashMap_remove_from_list_back T n key l; - v <- - alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) - self.(hashmap_HashMap_slots) hash_mod l0; - Return + |}) + | Some x1 => + i1 <- usize_sub self.(hashmap_HashMap_num_entries) 1%usize; + v <- index_mut_back l1; + Return (Some x1, {| - hashmap_HashMap_num_entries := i0; + hashmap_HashMap_num_entries := i1; hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); hashmap_HashMap_slots := v - |} + |}) end . -(** [hashmap_main::hashmap::test1]: forward function +(** [hashmap_main::hashmap::test1]: Source: 'src/hashmap.rs', lines 315:0-315:10 *) Definition hashmap_test1 (n : nat) : result unit := hm <- hashmap_HashMap_new u64 n; - hm0 <- hashmap_HashMap_insert u64 n hm 0%usize 42%u64; - hm1 <- hashmap_HashMap_insert u64 n hm0 128%usize 18%u64; - hm2 <- hashmap_HashMap_insert u64 n hm1 1024%usize 138%u64; - hm3 <- hashmap_HashMap_insert u64 n hm2 1056%usize 256%u64; - i <- hashmap_HashMap_get u64 n hm3 128%usize; + hm1 <- hashmap_HashMap_insert u64 n hm 0%usize 42%u64; + hm2 <- hashmap_HashMap_insert u64 n hm1 128%usize 18%u64; + hm3 <- hashmap_HashMap_insert u64 n hm2 1024%usize 138%u64; + hm4 <- hashmap_HashMap_insert u64 n hm3 1056%usize 256%u64; + i <- hashmap_HashMap_get u64 n hm4 128%usize; if negb (i s= 18%u64) then Fail_ Failure else ( - hm4 <- hashmap_HashMap_get_mut_back u64 n hm3 1024%usize 56%u64; - i0 <- hashmap_HashMap_get u64 n hm4 1024%usize; - if negb (i0 s= 56%u64) + p <- hashmap_HashMap_get_mut u64 n hm4 1024%usize; + let (_, get_mut_back) := p in + hm5 <- get_mut_back 56%u64; + i1 <- hashmap_HashMap_get u64 n hm5 1024%usize; + if negb (i1 s= 56%u64) then Fail_ Failure else ( - x <- hashmap_HashMap_remove u64 n hm4 1024%usize; + p1 <- hashmap_HashMap_remove u64 n hm5 1024%usize; + let (x, hm6) := p1 in match x with | None => Fail_ Failure - | Some x0 => - if negb (x0 s= 56%u64) + | Some x1 => + if negb (x1 s= 56%u64) then Fail_ Failure else ( - hm5 <- hashmap_HashMap_remove_back u64 n hm4 1024%usize; - i1 <- hashmap_HashMap_get u64 n hm5 0%usize; - if negb (i1 s= 42%u64) + i2 <- hashmap_HashMap_get u64 n hm6 0%usize; + if negb (i2 s= 42%u64) then Fail_ Failure else ( - i2 <- hashmap_HashMap_get u64 n hm5 128%usize; - if negb (i2 s= 18%u64) + i3 <- hashmap_HashMap_get u64 n hm6 128%usize; + if negb (i3 s= 18%u64) then Fail_ Failure else ( - i3 <- hashmap_HashMap_get u64 n hm5 1056%usize; - if negb (i3 s= 256%u64) then Fail_ Failure else Return tt))) + i4 <- hashmap_HashMap_get u64 n hm6 1056%usize; + if negb (i4 s= 256%u64) then Fail_ Failure else Return tt))) end)) . -(** [hashmap_main::insert_on_disk]: forward function +(** [hashmap_main::insert_on_disk]: Source: 'src/hashmap_main.rs', lines 7:0-7:43 *) Definition insert_on_disk (n : nat) (key : usize) (value : u64) (st : state) : result (state * unit) := p <- hashmap_utils_deserialize st; - let (st0, hm) := p in - hm0 <- hashmap_HashMap_insert u64 n hm key value; - p0 <- hashmap_utils_serialize hm0 st0; - let (st1, _) := p0 in - Return (st1, tt) + let (st1, hm) := p in + hm1 <- hashmap_HashMap_insert u64 n hm key value; + p1 <- hashmap_utils_serialize hm1 st1; + let (st2, _) := p1 in + Return (st2, tt) . -(** [hashmap_main::main]: forward function +(** [hashmap_main::main]: Source: 'src/hashmap_main.rs', lines 16:0-16:13 *) Definition main : result unit := Return tt. diff --git a/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v index e10d02f6..fb2e052a 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v @@ -11,13 +11,13 @@ Require Import HashmapMain_Types. Include HashmapMain_Types. Module HashmapMain_FunsExternal_Template. -(** [hashmap_main::hashmap_utils::deserialize]: forward function +(** [hashmap_main::hashmap_utils::deserialize]: Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *) Axiom hashmap_utils_deserialize : state -> result (state * (hashmap_HashMap_t u64)) . -(** [hashmap_main::hashmap_utils::serialize]: forward function +(** [hashmap_main::hashmap_utils::serialize]: Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *) Axiom hashmap_utils_serialize : hashmap_HashMap_t u64 -> state -> result (state * unit) diff --git a/tests/coq/hashmap_on_disk/Primitives.v b/tests/coq/hashmap_on_disk/Primitives.v index 84280b96..990e27e4 100644 --- a/tests/coq/hashmap_on_disk/Primitives.v +++ b/tests/coq/hashmap_on_disk/Primitives.v @@ -67,8 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . -Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * a := (x, x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. @@ -504,13 +503,15 @@ Arguments core_ops_index_Index_index {_ _}. (* Trait declaration: [core::ops::index::IndexMut] *) Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; - core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); - core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; + core_ops_index_IndexMut_index_mut : + Self -> + Idx -> + result (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) * + (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self)); }. Arguments mk_core_ops_index_IndexMut {_ _}. Arguments core_ops_index_IndexMut_indexInst {_ _}. Arguments core_ops_index_IndexMut_index_mut {_ _}. -Arguments core_ops_index_IndexMut_index_mut_back {_ _}. (* Trait declaration [core::ops::deref::Deref] *) Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { @@ -524,13 +525,14 @@ Arguments core_ops_deref_Deref_deref {_}. (* Trait declaration [core::ops::deref::DerefMut] *) Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; - core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); - core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; + core_ops_deref_DerefMut_deref_mut : + Self -> + result (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) * + (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self)); }. Arguments mk_core_ops_deref_DerefMut {_}. Arguments core_ops_deref_DerefMut_derefInst {_}. Arguments core_ops_deref_DerefMut_deref_mut {_}. -Arguments core_ops_deref_DerefMut_deref_mut_back {_}. Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { core_ops_range_Range_start : T; @@ -543,8 +545,8 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := + Return (x, fun x => Return x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -556,7 +558,6 @@ Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; - core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; |}. @@ -584,6 +585,13 @@ Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usize) : + result (T * (T -> result (array T n))) := + match array_index_usize T n a i with + | Fail_ e => Fail_ e + | Return x => Return (x, array_update_usize T n a i) + end. + (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. @@ -591,11 +599,25 @@ Axiom slice_len : forall (T : Type) (s : slice T), usize. Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : + result (T * (T -> result (slice T))) := + match slice_index_usize T s i with + | Fail_ e => Fail_ e + | Return x => Return (x, slice_update_usize T s i) + end. + (*** Subslices *) Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : + result (slice T * (slice T -> result (array T n))) := + match array_to_slice T n a with + | Fail_ e => Fail_ e + | Return x => Return (x, array_from_slice T n a) + end. + Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). @@ -639,16 +661,9 @@ Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (l | right _ => Fail_ Failure end. -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. - Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_insert_fwd (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result unit := - if to_Z i if to_Z i result (alloc_vec_Vec T))) := + match alloc_vec_Vec_index_usize v i with + | Return x => + Return (x, alloc_vec_Vec_update_usize v i) + | Fail_ e => Fail_ e + end. + (* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. @@ -669,25 +692,23 @@ Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceI core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; core_slice_index_SliceIndex_Output : Type; core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_mut : + Self -> T -> result (option core_slice_index_SliceIndex_Output * (option core_slice_index_SliceIndex_Output -> result T)); core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_index_mut : + Self -> T -> result (core_slice_index_SliceIndex_Output * (core_slice_index_SliceIndex_Output -> result T)); }. Arguments mk_core_slice_index_SliceIndex {_ _}. Arguments core_slice_index_SliceIndex_sealedInst {_ _}. Arguments core_slice_index_SliceIndex_Output {_ _}. Arguments core_slice_index_SliceIndex_get {_ _}. Arguments core_slice_index_SliceIndex_get_mut {_ _}. -Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. Arguments core_slice_index_SliceIndex_index {_ _}. Arguments core_slice_index_SliceIndex_index_mut {_ _}. -Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. (* [core::slice::index::[T]::index]: forward function *) Definition core_slice_index_Slice_index @@ -704,11 +725,9 @@ Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Ra (* [core::slice::index::Range::get_mut]: forward function *) Axiom core_slice_index_RangeUsize_get_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (option (slice T)). - -(* [core::slice::index::Range::get_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_get_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + forall (T : Type), + core_ops_range_Range usize -> slice T -> + result (option (slice T) * (option (slice T) -> result (slice T))). (* [core::slice::index::Range::get_unchecked]: forward function *) Definition core_slice_index_RangeUsize_get_unchecked @@ -732,21 +751,14 @@ Axiom core_slice_index_RangeUsize_index : (* [core::slice::index::Range::index_mut]: forward function *) Axiom core_slice_index_RangeUsize_index_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). - -(* [core::slice::index::Range::index_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_index_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T * (slice T -> result (slice T))). (* [core::slice::index::[T]::index_mut]: forward function *) Axiom core_slice_index_Slice_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). - -(* [core::slice::index::[T]::index_mut]: backward function 0 *) -Axiom core_slice_index_Slice_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + slice T -> Idx -> + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (slice T))). (* [core::array::[T; N]::index]: forward function *) Axiom core_array_Array_index : @@ -756,12 +768,9 @@ Axiom core_array_Array_index : (* [core::array::[T; N]::index_mut]: forward function *) Axiom core_array_Array_index_mut : forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). - -(* [core::array::[T; N]::index_mut]: backward function 0 *) -Axiom core_array_Array_index_mut_back : - forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + (a : array T N) (i : Idx), + result (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) * + (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) -> result (array T N))). (* Trait implementation: [core::slice::index::private_slice_index::Range] *) Definition core_slice_index_private_slice_index_SealedRangeUsizeInst @@ -774,12 +783,10 @@ Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := slice T; core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_RangeUsize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_RangeUsize_index_mut_back T; |}. (* Trait implementation: [core::slice::index::[T]] *) @@ -796,7 +803,6 @@ Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) core_ops_index_IndexMut (slice T) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; |}. (* Trait implementation: [core::array::[T; N]] *) @@ -813,18 +819,14 @@ Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) core_ops_index_IndexMut (array T N) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; - core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; |}. (* [core::slice::index::usize::get]: forward function *) Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). (* [core::slice::index::usize::get_mut]: forward function *) -Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). - -(* [core::slice::index::usize::get_mut]: backward function 0 *) -Axiom core_slice_index_usize_get_mut_back : - forall (T : Type), usize -> slice T -> option T -> result (slice T). +Axiom core_slice_index_usize_get_mut : + forall (T : Type), usize -> slice T -> result (option T * (option T -> result (slice T))). (* [core::slice::index::usize::get_unchecked]: forward function *) Axiom core_slice_index_usize_get_unchecked : @@ -838,11 +840,8 @@ Axiom core_slice_index_usize_get_unchecked_mut : Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. (* [core::slice::index::usize::index_mut]: forward function *) -Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. - -(* [core::slice::index::usize::index_mut]: backward function 0 *) -Axiom core_slice_index_usize_index_mut_back : - forall (T : Type), usize -> slice T -> T -> result (slice T). +Axiom core_slice_index_usize_index_mut : + forall (T : Type), usize -> slice T -> result (T * (T -> result (slice T))). (* Trait implementation: [core::slice::index::private_slice_index::usize] *) Definition core_slice_index_private_slice_index_SealedUsizeInst @@ -855,12 +854,10 @@ Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := T; core_slice_index_SliceIndex_get := core_slice_index_usize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_usize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; |}. (* [alloc::vec::Vec::index]: forward function *) @@ -869,12 +866,9 @@ Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_Slice (* [alloc::vec::Vec::index_mut]: forward function *) Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). - -(* [alloc::vec::Vec::index_mut]: backward function 0 *) -Axiom alloc_vec_Vec_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + (Self : alloc_vec_Vec T) (i : Idx), + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (alloc_vec_Vec T))). (* Trait implementation: [alloc::vec::Vec] *) Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) @@ -890,7 +884,6 @@ Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; |}. (*** Theorems *) @@ -901,10 +894,6 @@ Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usiz Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = - alloc_vec_Vec_index_usize v i. - -Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x = - alloc_vec_Vec_update_usize v i x. + alloc_vec_Vec_index_mut_usize v i. End Primitives. diff --git a/tests/coq/misc/Bitwise.v b/tests/coq/misc/Bitwise.v index 94771b37..b04c95f2 100644 --- a/tests/coq/misc/Bitwise.v +++ b/tests/coq/misc/Bitwise.v @@ -8,29 +8,29 @@ Import ListNotations. Local Open Scope Primitives_scope. Module Bitwise. -(** [bitwise::shift_u32]: forward function +(** [bitwise::shift_u32]: Source: 'src/bitwise.rs', lines 3:0-3:31 *) Definition shift_u32 (a : u32) : result u32 := t <- u32_shr a 16%usize; u32_shl t 16%usize . -(** [bitwise::shift_i32]: forward function +(** [bitwise::shift_i32]: Source: 'src/bitwise.rs', lines 10:0-10:31 *) Definition shift_i32 (a : i32) : result i32 := t <- i32_shr a 16%isize; i32_shl t 16%isize . -(** [bitwise::xor_u32]: forward function +(** [bitwise::xor_u32]: Source: 'src/bitwise.rs', lines 17:0-17:37 *) Definition xor_u32 (a : u32) (b : u32) : result u32 := Return (u32_xor a b). -(** [bitwise::or_u32]: forward function +(** [bitwise::or_u32]: Source: 'src/bitwise.rs', lines 21:0-21:36 *) Definition or_u32 (a : u32) (b : u32) : result u32 := Return (u32_or a b). -(** [bitwise::and_u32]: forward function +(** [bitwise::and_u32]: Source: 'src/bitwise.rs', lines 25:0-25:37 *) Definition and_u32 (a : u32) (b : u32) : result u32 := Return (u32_and a b). diff --git a/tests/coq/misc/Constants.v b/tests/coq/misc/Constants.v index ad899f25..0f33cbd6 100644 --- a/tests/coq/misc/Constants.v +++ b/tests/coq/misc/Constants.v @@ -23,7 +23,7 @@ Definition x1_c : u32 := x1_body%global. Definition x2_body : result u32 := Return 3%u32. Definition x2_c : u32 := x2_body%global. -(** [constants::incr]: forward function +(** [constants::incr]: Source: 'src/constants.rs', lines 17:0-17:32 *) Definition incr (n : u32) : result u32 := u32_add n 1%u32. @@ -33,7 +33,7 @@ Definition incr (n : u32) : result u32 := Definition x3_body : result u32 := incr 32%u32. Definition x3_c : u32 := x3_body%global. -(** [constants::mk_pair0]: forward function +(** [constants::mk_pair0]: Source: 'src/constants.rs', lines 23:0-23:51 *) Definition mk_pair0 (x : u32) (y : u32) : result (u32 * u32) := Return (x, y). @@ -46,7 +46,7 @@ Arguments mkPair_t { _ _ }. Arguments pair_x { _ _ }. Arguments pair_y { _ _ }. -(** [constants::mk_pair1]: forward function +(** [constants::mk_pair1]: Source: 'src/constants.rs', lines 27:0-27:55 *) Definition mk_pair1 (x : u32) (y : u32) : result (Pair_t u32 u32) := Return {| pair_x := x; pair_y := y |} @@ -81,7 +81,7 @@ Record Wrap_t (T : Type) := mkWrap_t { wrap_value : T; }. Arguments mkWrap_t { _ }. Arguments wrap_value { _ }. -(** [constants::{constants::Wrap}::new]: forward function +(** [constants::{constants::Wrap}::new]: Source: 'src/constants.rs', lines 54:4-54:41 *) Definition wrap_new (T : Type) (value : T) : result (Wrap_t T) := Return {| wrap_value := value |} @@ -92,7 +92,7 @@ Definition wrap_new (T : Type) (value : T) : result (Wrap_t T) := Definition y_body : result (Wrap_t i32) := wrap_new i32 2%i32. Definition y_c : Wrap_t i32 := y_body%global. -(** [constants::unwrap_y]: forward function +(** [constants::unwrap_y]: Source: 'src/constants.rs', lines 43:0-43:30 *) Definition unwrap_y : result i32 := Return y_c.(wrap_value). @@ -107,12 +107,12 @@ Definition yval_c : i32 := yval_body%global. Definition get_z1_z1_body : result i32 := Return 3%i32. Definition get_z1_z1_c : i32 := get_z1_z1_body%global. -(** [constants::get_z1]: forward function +(** [constants::get_z1]: Source: 'src/constants.rs', lines 61:0-61:28 *) Definition get_z1 : result i32 := Return get_z1_z1_c. -(** [constants::add]: forward function +(** [constants::add]: Source: 'src/constants.rs', lines 66:0-66:39 *) Definition add (a : i32) (b : i32) : result i32 := i32_add a b. @@ -132,10 +132,10 @@ Definition q2_c : i32 := q2_body%global. Definition q3_body : result i32 := add q2_c 3%i32. Definition q3_c : i32 := q3_body%global. -(** [constants::get_z2]: forward function +(** [constants::get_z2]: Source: 'src/constants.rs', lines 70:0-70:28 *) Definition get_z2 : result i32 := - i <- get_z1; i0 <- add i q3_c; add q1_c i0. + i <- get_z1; i1 <- add i q3_c; add q1_c i1. (** [constants::S1] Source: 'src/constants.rs', lines 80:0-80:18 *) diff --git a/tests/coq/misc/External_Funs.v b/tests/coq/misc/External_Funs.v index e9d39f66..049f5d39 100644 --- a/tests/coq/misc/External_Funs.v +++ b/tests/coq/misc/External_Funs.v @@ -12,44 +12,23 @@ Require Import External_FunsExternal. Include External_FunsExternal. Module External_Funs. -(** [external::swap]: forward function +(** [external::swap]: Source: 'src/external.rs', lines 6:0-6:46 *) Definition swap - (T : Type) (x : T) (y : T) (st : state) : result (state * unit) := - p <- core_mem_swap T x y st; - let (st0, _) := p in - p0 <- core_mem_swap_back0 T x y st st0; - let (st1, _) := p0 in - p1 <- core_mem_swap_back1 T x y st st1; - let (st2, _) := p1 in - Return (st2, tt) + (T : Type) (x : T) (y : T) (st : state) : result (state * (T * T)) := + core_mem_swap T x y st . -(** [external::swap]: backward function 0 - Source: 'src/external.rs', lines 6:0-6:46 *) -Definition swap_back - (T : Type) (x : T) (y : T) (st : state) (st0 : state) : - result (state * (T * T)) - := - p <- core_mem_swap T x y st; - let (st1, _) := p in - p0 <- core_mem_swap_back0 T x y st st1; - let (st2, x0) := p0 in - p1 <- core_mem_swap_back1 T x y st st2; - let (_, y0) := p1 in - Return (st0, (x0, y0)) -. - -(** [external::test_new_non_zero_u32]: forward function +(** [external::test_new_non_zero_u32]: Source: 'src/external.rs', lines 11:0-11:60 *) Definition test_new_non_zero_u32 (x : u32) (st : state) : result (state * core_num_nonzero_NonZeroU32_t) := p <- core_num_nonzero_NonZeroU32_new x st; - let (st0, o) := p in - core_option_Option_unwrap core_num_nonzero_NonZeroU32_t o st0 + let (st1, o) := p in + core_option_Option_unwrap core_num_nonzero_NonZeroU32_t o st1 . -(** [external::test_vec]: forward function +(** [external::test_vec]: Source: 'src/external.rs', lines 17:0-17:17 *) Definition test_vec : result unit := let v := alloc_vec_Vec_new u32 in @@ -60,59 +39,39 @@ Definition test_vec : result unit := (** Unit test for [external::test_vec] *) Check (test_vec )%return. -(** [external::custom_swap]: forward function +(** [external::custom_swap]: Source: 'src/external.rs', lines 24:0-24:66 *) Definition custom_swap - (T : Type) (x : T) (y : T) (st : state) : result (state * T) := - p <- core_mem_swap T x y st; - let (st0, _) := p in - p0 <- core_mem_swap_back0 T x y st st0; - let (st1, x0) := p0 in - p1 <- core_mem_swap_back1 T x y st st1; - let (st2, _) := p1 in - Return (st2, x0) -. - -(** [external::custom_swap]: backward function 0 - Source: 'src/external.rs', lines 24:0-24:66 *) -Definition custom_swap_back - (T : Type) (x : T) (y : T) (st : state) (ret : T) (st0 : state) : - result (state * (T * T)) + (T : Type) (x : T) (y : T) (st : state) : + result (state * (T * (T -> state -> result (state * (T * T))))) := p <- core_mem_swap T x y st; - let (st1, _) := p in - p0 <- core_mem_swap_back0 T x y st st1; - let (st2, _) := p0 in - p1 <- core_mem_swap_back1 T x y st st2; - let (_, y0) := p1 in - Return (st0, (ret, y0)) + let (st1, p1) := p in + let (t, t1) := p1 in + let back_'a := fun (ret : T) (st2 : state) => Return (st2, (ret, t1)) in + Return (st1, (t, back_'a)) . -(** [external::test_custom_swap]: forward function +(** [external::test_custom_swap]: Source: 'src/external.rs', lines 29:0-29:59 *) Definition test_custom_swap - (x : u32) (y : u32) (st : state) : result (state * unit) := - p <- custom_swap u32 x y st; let (st0, _) := p in Return (st0, tt) -. - -(** [external::test_custom_swap]: backward function 0 - Source: 'src/external.rs', lines 29:0-29:59 *) -Definition test_custom_swap_back - (x : u32) (y : u32) (st : state) (st0 : state) : - result (state * (u32 * u32)) - := - custom_swap_back u32 x y st 1%u32 st0 + (x : u32) (y : u32) (st : state) : result (state * (u32 * u32)) := + p <- custom_swap u32 x y st; + let (st1, p1) := p in + let (_, custom_swap_back) := p1 in + p2 <- custom_swap_back 1%u32 st1; + let (_, p3) := p2 in + let (x1, y1) := p3 in + Return (st1, (x1, y1)) . -(** [external::test_swap_non_zero]: forward function +(** [external::test_swap_non_zero]: Source: 'src/external.rs', lines 35:0-35:44 *) Definition test_swap_non_zero (x : u32) (st : state) : result (state * u32) := p <- swap u32 x 0%u32 st; - let (st0, _) := p in - p0 <- swap_back u32 x 0%u32 st st0; - let (st1, p1) := p0 in - let (x0, _) := p1 in - if x0 s= 0%u32 then Fail_ Failure else Return (st1, x0) + let (st1, p1) := p in + let (x1, _) := p1 in + if x1 s= 0%u32 then Fail_ Failure else Return (st1, x1) . End External_Funs. diff --git a/tests/coq/misc/External_FunsExternal_Template.v b/tests/coq/misc/External_FunsExternal_Template.v index 31e69c39..6773ac18 100644 --- a/tests/coq/misc/External_FunsExternal_Template.v +++ b/tests/coq/misc/External_FunsExternal_Template.v @@ -11,31 +11,19 @@ Require Import External_Types. Include External_Types. Module External_FunsExternal_Template. -(** [core::mem::swap]: forward function +(** [core::mem::swap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) Axiom core_mem_swap : - forall(T : Type), T -> T -> state -> result (state * unit) + forall(T : Type), T -> T -> state -> result (state * (T * T)) . -(** [core::mem::swap]: backward function 0 - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) -Axiom core_mem_swap_back0 : - forall(T : Type), T -> T -> state -> state -> result (state * T) -. - -(** [core::mem::swap]: backward function 1 - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) -Axiom core_mem_swap_back1 : - forall(T : Type), T -> T -> state -> state -> result (state * T) -. - -(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function +(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *) Axiom core_num_nonzero_NonZeroU32_new : u32 -> state -> result (state * (option core_num_nonzero_NonZeroU32_t)) . -(** [core::option::{core::option::Option}::unwrap]: forward function +(** [core::option::{core::option::Option}::unwrap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) Axiom core_option_Option_unwrap : forall(T : Type), option T -> state -> result (state * T) diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v index 83c249c1..313c2cfd 100644 --- a/tests/coq/misc/Loops.v +++ b/tests/coq/misc/Loops.v @@ -8,90 +8,90 @@ Import ListNotations. Local Open Scope Primitives_scope. Module Loops. -(** [loops::sum]: loop 0: forward function +(** [loops::sum]: loop 0: Source: 'src/loops.rs', lines 4:0-14:1 *) Fixpoint sum_loop (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => if i s< max - then (s0 <- u32_add s i; i0 <- u32_add i 1%u32; sum_loop n0 max i0 s0) + then (s1 <- u32_add s i; i1 <- u32_add i 1%u32; sum_loop n1 max i1 s1) else u32_mul s 2%u32 end . -(** [loops::sum]: forward function +(** [loops::sum]: Source: 'src/loops.rs', lines 4:0-4:27 *) Definition sum (n : nat) (max : u32) : result u32 := sum_loop n max 0%u32 0%u32 . -(** [loops::sum_with_mut_borrows]: loop 0: forward function +(** [loops::sum_with_mut_borrows]: loop 0: Source: 'src/loops.rs', lines 19:0-31:1 *) Fixpoint sum_with_mut_borrows_loop (n : nat) (max : u32) (mi : u32) (ms : u32) : result u32 := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => if mi s< max then ( - ms0 <- u32_add ms mi; - mi0 <- u32_add mi 1%u32; - sum_with_mut_borrows_loop n0 max mi0 ms0) + ms1 <- u32_add ms mi; + mi1 <- u32_add mi 1%u32; + sum_with_mut_borrows_loop n1 max mi1 ms1) else u32_mul ms 2%u32 end . -(** [loops::sum_with_mut_borrows]: forward function +(** [loops::sum_with_mut_borrows]: Source: 'src/loops.rs', lines 19:0-19:44 *) Definition sum_with_mut_borrows (n : nat) (max : u32) : result u32 := sum_with_mut_borrows_loop n max 0%u32 0%u32 . -(** [loops::sum_with_shared_borrows]: loop 0: forward function +(** [loops::sum_with_shared_borrows]: loop 0: Source: 'src/loops.rs', lines 34:0-48:1 *) Fixpoint sum_with_shared_borrows_loop (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => if i s< max then ( - i0 <- u32_add i 1%u32; - s0 <- u32_add s i0; - sum_with_shared_borrows_loop n0 max i0 s0) + i1 <- u32_add i 1%u32; + s1 <- u32_add s i1; + sum_with_shared_borrows_loop n1 max i1 s1) else u32_mul s 2%u32 end . -(** [loops::sum_with_shared_borrows]: forward function +(** [loops::sum_with_shared_borrows]: Source: 'src/loops.rs', lines 34:0-34:47 *) Definition sum_with_shared_borrows (n : nat) (max : u32) : result u32 := sum_with_shared_borrows_loop n max 0%u32 0%u32 . -(** [loops::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [loops::clear]: loop 0: Source: 'src/loops.rs', lines 52:0-58:1 *) Fixpoint clear_loop (n : nat) (v : alloc_vec_Vec u32) (i : usize) : result (alloc_vec_Vec u32) := match n with | O => Fail_ OutOfFuel - | S n0 => - let i0 := alloc_vec_Vec_len u32 v in - if i s< i0 + | S n1 => + let i1 := alloc_vec_Vec_len u32 v in + if i s< i1 then ( - i1 <- usize_add i 1%usize; - v0 <- - alloc_vec_Vec_index_mut_back u32 usize - (core_slice_index_SliceIndexUsizeSliceTInst u32) v i 0%u32; - clear_loop n0 v0 i1) + p <- + alloc_vec_Vec_index_mut u32 usize + (core_slice_index_SliceIndexUsizeSliceTInst u32) v i; + let (_, index_mut_back) := p in + i2 <- usize_add i 1%usize; + v1 <- index_mut_back 0%u32; + clear_loop n1 v1 i2) else Return v end . -(** [loops::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [loops::clear]: Source: 'src/loops.rs', lines 52:0-52:30 *) Definition clear (n : nat) (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) := @@ -108,181 +108,146 @@ Inductive List_t (T : Type) := Arguments List_Cons { _ }. Arguments List_Nil { _ }. -(** [loops::list_mem]: loop 0: forward function +(** [loops::list_mem]: loop 0: Source: 'src/loops.rs', lines 66:0-75:1 *) Fixpoint list_mem_loop (n : nat) (x : u32) (ls : List_t u32) : result bool := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with - | List_Cons y tl => if y s= x then Return true else list_mem_loop n0 x tl + | List_Cons y tl => if y s= x then Return true else list_mem_loop n1 x tl | List_Nil => Return false end end . -(** [loops::list_mem]: forward function +(** [loops::list_mem]: Source: 'src/loops.rs', lines 66:0-66:52 *) Definition list_mem (n : nat) (x : u32) (ls : List_t u32) : result bool := list_mem_loop n x ls . -(** [loops::list_nth_mut_loop]: loop 0: forward function +(** [loops::list_nth_mut_loop]: loop 0: Source: 'src/loops.rs', lines 78:0-88:1 *) Fixpoint list_nth_mut_loop_loop - (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls with - | List_Cons x tl => - if i s= 0%u32 - then Return x - else (i0 <- u32_sub i 1%u32; list_nth_mut_loop_loop T n0 tl i0) - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::list_nth_mut_loop]: forward function - Source: 'src/loops.rs', lines 78:0-78:71 *) -Definition list_nth_mut_loop - (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := - list_nth_mut_loop_loop T n ls i -. - -(** [loops::list_nth_mut_loop]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 78:0-88:1 *) -Fixpoint list_nth_mut_loop_loop_back - (T : Type) (n : nat) (ls : List_t T) (i : u32) (ret : T) : - result (List_t T) + (T : Type) (n : nat) (ls : List_t T) (i : u32) : + result (T * (T -> result (List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons x tl => if i s= 0%u32 - then Return (List_Cons ret tl) + then + let back := fun (ret : T) => Return (List_Cons ret tl) in + Return (x, back) else ( - i0 <- u32_sub i 1%u32; - tl0 <- list_nth_mut_loop_loop_back T n0 tl i0 ret; - Return (List_Cons x tl0)) + i1 <- u32_sub i 1%u32; + p <- list_nth_mut_loop_loop T n1 tl i1; + let (t, back) := p in + let back1 := fun (ret : T) => tl1 <- back ret; Return (List_Cons x tl1) + in + Return (t, back1)) | List_Nil => Fail_ Failure end end . -(** [loops::list_nth_mut_loop]: backward function 0 +(** [loops::list_nth_mut_loop]: Source: 'src/loops.rs', lines 78:0-78:71 *) -Definition list_nth_mut_loop_back - (T : Type) (n : nat) (ls : List_t T) (i : u32) (ret : T) : - result (List_t T) +Definition list_nth_mut_loop + (T : Type) (n : nat) (ls : List_t T) (i : u32) : + result (T * (T -> result (List_t T))) := - list_nth_mut_loop_loop_back T n ls i ret + p <- list_nth_mut_loop_loop T n ls i; + let (t, back) := p in + let back1 := fun (ret : T) => back ret in + Return (t, back1) . -(** [loops::list_nth_shared_loop]: loop 0: forward function +(** [loops::list_nth_shared_loop]: loop 0: Source: 'src/loops.rs', lines 91:0-101:1 *) Fixpoint list_nth_shared_loop_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons x tl => if i s= 0%u32 then Return x - else (i0 <- u32_sub i 1%u32; list_nth_shared_loop_loop T n0 tl i0) + else (i1 <- u32_sub i 1%u32; list_nth_shared_loop_loop T n1 tl i1) | List_Nil => Fail_ Failure end end . -(** [loops::list_nth_shared_loop]: forward function +(** [loops::list_nth_shared_loop]: Source: 'src/loops.rs', lines 91:0-91:66 *) Definition list_nth_shared_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := list_nth_shared_loop_loop T n ls i . -(** [loops::get_elem_mut]: loop 0: forward function +(** [loops::get_elem_mut]: loop 0: Source: 'src/loops.rs', lines 103:0-117:1 *) Fixpoint get_elem_mut_loop - (n : nat) (x : usize) (ls : List_t usize) : result usize := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls with - | List_Cons y tl => if y s= x then Return y else get_elem_mut_loop n0 x tl - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::get_elem_mut]: forward function - Source: 'src/loops.rs', lines 103:0-103:73 *) -Definition get_elem_mut - (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) : - result usize - := - l <- - alloc_vec_Vec_index_mut (List_t usize) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t usize)) slots 0%usize; - get_elem_mut_loop n x l -. - -(** [loops::get_elem_mut]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 103:0-117:1 *) -Fixpoint get_elem_mut_loop_back - (n : nat) (x : usize) (ls : List_t usize) (ret : usize) : - result (List_t usize) + (n : nat) (x : usize) (ls : List_t usize) : + result (usize * (usize -> result (List_t usize))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons y tl => if y s= x - then Return (List_Cons ret tl) + then + let back := fun (ret : usize) => Return (List_Cons ret tl) in + Return (y, back) else ( - tl0 <- get_elem_mut_loop_back n0 x tl ret; Return (List_Cons y tl0)) + p <- get_elem_mut_loop n1 x tl; + let (i, back) := p in + let back1 := + fun (ret : usize) => tl1 <- back ret; Return (List_Cons y tl1) in + Return (i, back1)) | List_Nil => Fail_ Failure end end . -(** [loops::get_elem_mut]: backward function 0 +(** [loops::get_elem_mut]: Source: 'src/loops.rs', lines 103:0-103:73 *) -Definition get_elem_mut_back - (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) (ret : usize) : - result (alloc_vec_Vec (List_t usize)) +Definition get_elem_mut + (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) : + result (usize * (usize -> result (alloc_vec_Vec (List_t usize)))) := - l <- + p <- alloc_vec_Vec_index_mut (List_t usize) usize (core_slice_index_SliceIndexUsizeSliceTInst (List_t usize)) slots 0%usize; - l0 <- get_elem_mut_loop_back n x l ret; - alloc_vec_Vec_index_mut_back (List_t usize) usize - (core_slice_index_SliceIndexUsizeSliceTInst (List_t usize)) slots 0%usize - l0 + let (l, index_mut_back) := p in + p1 <- get_elem_mut_loop n x l; + let (i, back) := p1 in + let back1 := fun (ret : usize) => l1 <- back ret; index_mut_back l1 in + Return (i, back1) . -(** [loops::get_elem_shared]: loop 0: forward function +(** [loops::get_elem_shared]: loop 0: Source: 'src/loops.rs', lines 119:0-133:1 *) Fixpoint get_elem_shared_loop (n : nat) (x : usize) (ls : List_t usize) : result usize := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons y tl => - if y s= x then Return y else get_elem_shared_loop n0 x tl + if y s= x then Return y else get_elem_shared_loop n1 x tl | List_Nil => Fail_ Failure end end . -(** [loops::get_elem_shared]: forward function +(** [loops::get_elem_shared]: Source: 'src/loops.rs', lines 119:0-119:68 *) Definition get_elem_shared (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) : @@ -294,123 +259,114 @@ Definition get_elem_shared get_elem_shared_loop n x l . -(** [loops::id_mut]: forward function - Source: 'src/loops.rs', lines 135:0-135:50 *) -Definition id_mut (T : Type) (ls : List_t T) : result (List_t T) := - Return ls. - -(** [loops::id_mut]: backward function 0 +(** [loops::id_mut]: Source: 'src/loops.rs', lines 135:0-135:50 *) -Definition id_mut_back - (T : Type) (ls : List_t T) (ret : List_t T) : result (List_t T) := - Return ret +Definition id_mut + (T : Type) (ls : List_t T) : + result ((List_t T) * (List_t T -> result (List_t T))) + := + let back := fun (ret : List_t T) => Return ret in Return (ls, back) . -(** [loops::id_shared]: forward function +(** [loops::id_shared]: Source: 'src/loops.rs', lines 139:0-139:45 *) Definition id_shared (T : Type) (ls : List_t T) : result (List_t T) := Return ls . -(** [loops::list_nth_mut_loop_with_id]: loop 0: forward function +(** [loops::list_nth_mut_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 144:0-155:1 *) Fixpoint list_nth_mut_loop_with_id_loop - (T : Type) (n : nat) (i : u32) (ls : List_t T) : result T := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls with - | List_Cons x tl => - if i s= 0%u32 - then Return x - else (i0 <- u32_sub i 1%u32; list_nth_mut_loop_with_id_loop T n0 i0 tl) - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::list_nth_mut_loop_with_id]: forward function - Source: 'src/loops.rs', lines 144:0-144:75 *) -Definition list_nth_mut_loop_with_id - (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := - ls0 <- id_mut T ls; list_nth_mut_loop_with_id_loop T n i ls0 -. - -(** [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 144:0-155:1 *) -Fixpoint list_nth_mut_loop_with_id_loop_back - (T : Type) (n : nat) (i : u32) (ls : List_t T) (ret : T) : - result (List_t T) + (T : Type) (n : nat) (i : u32) (ls : List_t T) : + result (T * (T -> result (List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons x tl => if i s= 0%u32 - then Return (List_Cons ret tl) + then + let back := fun (ret : T) => Return (List_Cons ret tl) in + Return (x, back) else ( - i0 <- u32_sub i 1%u32; - tl0 <- list_nth_mut_loop_with_id_loop_back T n0 i0 tl ret; - Return (List_Cons x tl0)) + i1 <- u32_sub i 1%u32; + p <- list_nth_mut_loop_with_id_loop T n1 i1 tl; + let (t, back) := p in + let back1 := fun (ret : T) => tl1 <- back ret; Return (List_Cons x tl1) + in + Return (t, back1)) | List_Nil => Fail_ Failure end end . -(** [loops::list_nth_mut_loop_with_id]: backward function 0 +(** [loops::list_nth_mut_loop_with_id]: Source: 'src/loops.rs', lines 144:0-144:75 *) -Definition list_nth_mut_loop_with_id_back - (T : Type) (n : nat) (ls : List_t T) (i : u32) (ret : T) : - result (List_t T) +Definition list_nth_mut_loop_with_id + (T : Type) (n : nat) (ls : List_t T) (i : u32) : + result (T * (T -> result (List_t T))) := - ls0 <- id_mut T ls; - l <- list_nth_mut_loop_with_id_loop_back T n i ls0 ret; - id_mut_back T ls l + p <- id_mut T ls; + let (ls1, id_mut_back) := p in + p1 <- list_nth_mut_loop_with_id_loop T n i ls1; + let (t, back) := p1 in + let back1 := fun (ret : T) => l <- back ret; id_mut_back l in + Return (t, back1) . -(** [loops::list_nth_shared_loop_with_id]: loop 0: forward function +(** [loops::list_nth_shared_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 158:0-169:1 *) Fixpoint list_nth_shared_loop_with_id_loop (T : Type) (n : nat) (i : u32) (ls : List_t T) : result T := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls with | List_Cons x tl => if i s= 0%u32 then Return x else ( - i0 <- u32_sub i 1%u32; list_nth_shared_loop_with_id_loop T n0 i0 tl) + i1 <- u32_sub i 1%u32; list_nth_shared_loop_with_id_loop T n1 i1 tl) | List_Nil => Fail_ Failure end end . -(** [loops::list_nth_shared_loop_with_id]: forward function +(** [loops::list_nth_shared_loop_with_id]: Source: 'src/loops.rs', lines 158:0-158:70 *) Definition list_nth_shared_loop_with_id (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := - ls0 <- id_shared T ls; list_nth_shared_loop_with_id_loop T n i ls0 + ls1 <- id_shared T ls; list_nth_shared_loop_with_id_loop T n i ls1 . -(** [loops::list_nth_mut_loop_pair]: loop 0: forward function +(** [loops::list_nth_mut_loop_pair]: loop 0: Source: 'src/loops.rs', lines 174:0-195:1 *) Fixpoint list_nth_mut_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * (T -> result (List_t T)) * (T -> result (List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls0 with | List_Cons x0 tl0 => match ls1 with | List_Cons x1 tl1 => if i s= 0%u32 - then Return (x0, x1) + then + let back_'a := fun (ret : T) => Return (List_Cons ret tl0) in + let back_'b := fun (ret : T) => Return (List_Cons ret tl1) in + Return ((x0, x1), back_'a, back_'b) else ( - i0 <- u32_sub i 1%u32; list_nth_mut_loop_pair_loop T n0 tl0 tl1 i0) + i1 <- u32_sub i 1%u32; + t <- list_nth_mut_loop_pair_loop T n1 tl0 tl1 i1; + let (p, back_'a, back_'b) := t in + let back_'a1 := + fun (ret : T) => tl01 <- back_'a ret; Return (List_Cons x0 tl01) in + let back_'b1 := + fun (ret : T) => tl11 <- back_'b ret; Return (List_Cons x1 tl11) in + Return (p, back_'a1, back_'b1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -418,86 +374,20 @@ Fixpoint list_nth_mut_loop_pair_loop end . -(** [loops::list_nth_mut_loop_pair]: forward function +(** [loops::list_nth_mut_loop_pair]: Source: 'src/loops.rs', lines 174:0-178:27 *) Definition list_nth_mut_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * (T -> result (List_t T)) * (T -> result (List_t T))) := - list_nth_mut_loop_pair_loop T n ls0 ls1 i + t <- list_nth_mut_loop_pair_loop T n ls0 ls1 i; + let (p, back_'a, back_'b) := t in + let back_'a1 := fun (ret : T) => back_'a ret in + let back_'b1 := fun (ret : T) => back_'b ret in + Return (p, back_'a1, back_'b1) . -(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 174:0-195:1 *) -Fixpoint list_nth_mut_loop_pair_loop_back'a - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls0 with - | List_Cons x0 tl0 => - match ls1 with - | List_Cons x1 tl1 => - if i s= 0%u32 - then Return (List_Cons ret tl0) - else ( - i0 <- u32_sub i 1%u32; - tl00 <- list_nth_mut_loop_pair_loop_back'a T n0 tl0 tl1 i0 ret; - Return (List_Cons x0 tl00)) - | List_Nil => Fail_ Failure - end - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::list_nth_mut_loop_pair]: backward function 0 - Source: 'src/loops.rs', lines 174:0-178:27 *) -Definition list_nth_mut_loop_pair_back'a - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - list_nth_mut_loop_pair_loop_back'a T n ls0 ls1 i ret -. - -(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 1 - Source: 'src/loops.rs', lines 174:0-195:1 *) -Fixpoint list_nth_mut_loop_pair_loop_back'b - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls0 with - | List_Cons x0 tl0 => - match ls1 with - | List_Cons x1 tl1 => - if i s= 0%u32 - then Return (List_Cons ret tl1) - else ( - i0 <- u32_sub i 1%u32; - tl10 <- list_nth_mut_loop_pair_loop_back'b T n0 tl0 tl1 i0 ret; - Return (List_Cons x1 tl10)) - | List_Nil => Fail_ Failure - end - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::list_nth_mut_loop_pair]: backward function 1 - Source: 'src/loops.rs', lines 174:0-178:27 *) -Definition list_nth_mut_loop_pair_back'b - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - list_nth_mut_loop_pair_loop_back'b T n ls0 ls1 i ret -. - -(** [loops::list_nth_shared_loop_pair]: loop 0: forward function +(** [loops::list_nth_shared_loop_pair]: loop 0: Source: 'src/loops.rs', lines 198:0-219:1 *) Fixpoint list_nth_shared_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : @@ -505,7 +395,7 @@ Fixpoint list_nth_shared_loop_pair_loop := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls0 with | List_Cons x0 tl0 => match ls1 with @@ -513,7 +403,7 @@ Fixpoint list_nth_shared_loop_pair_loop if i s= 0%u32 then Return (x0, x1) else ( - i0 <- u32_sub i 1%u32; list_nth_shared_loop_pair_loop T n0 tl0 tl1 i0) + i1 <- u32_sub i 1%u32; list_nth_shared_loop_pair_loop T n1 tl0 tl1 i1) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -521,7 +411,7 @@ Fixpoint list_nth_shared_loop_pair_loop end . -(** [loops::list_nth_shared_loop_pair]: forward function +(** [loops::list_nth_shared_loop_pair]: Source: 'src/loops.rs', lines 198:0-202:19 *) Definition list_nth_shared_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : @@ -530,24 +420,36 @@ Definition list_nth_shared_loop_pair list_nth_shared_loop_pair_loop T n ls0 ls1 i . -(** [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function +(** [loops::list_nth_mut_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 223:0-238:1 *) Fixpoint list_nth_mut_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * ((T * T) -> result ((List_t T) * (List_t T)))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls0 with | List_Cons x0 tl0 => match ls1 with | List_Cons x1 tl1 => if i s= 0%u32 - then Return (x0, x1) + then + let back_'a := + fun (ret : (T * T)) => + let (t, t1) := ret in Return (List_Cons t tl0, List_Cons t1 tl1) + in + Return ((x0, x1), back_'a) else ( - i0 <- u32_sub i 1%u32; - list_nth_mut_loop_pair_merge_loop T n0 tl0 tl1 i0) + i1 <- u32_sub i 1%u32; + p <- list_nth_mut_loop_pair_merge_loop T n1 tl0 tl1 i1; + let (p1, back_'a) := p in + let back_'a1 := + fun (ret : (T * T)) => + p2 <- back_'a ret; + let (tl01, tl11) := p2 in + Return (List_Cons x0 tl01, List_Cons x1 tl11) in + Return (p1, back_'a1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -555,54 +457,19 @@ Fixpoint list_nth_mut_loop_pair_merge_loop end . -(** [loops::list_nth_mut_loop_pair_merge]: forward function +(** [loops::list_nth_mut_loop_pair_merge]: Source: 'src/loops.rs', lines 223:0-227:27 *) Definition list_nth_mut_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * ((T * T) -> result ((List_t T) * (List_t T)))) := - list_nth_mut_loop_pair_merge_loop T n ls0 ls1 i + p <- list_nth_mut_loop_pair_merge_loop T n ls0 ls1 i; + let (p1, back_'a) := p in + let back_'a1 := fun (ret : (T * T)) => back_'a ret in + Return (p1, back_'a1) . -(** [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 223:0-238:1 *) -Fixpoint list_nth_mut_loop_pair_merge_loop_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) - (ret : (T * T)) : - result ((List_t T) * (List_t T)) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls0 with - | List_Cons x0 tl0 => - match ls1 with - | List_Cons x1 tl1 => - if i s= 0%u32 - then let (t, t0) := ret in Return (List_Cons t tl0, List_Cons t0 tl1) - else ( - i0 <- u32_sub i 1%u32; - p <- list_nth_mut_loop_pair_merge_loop_back T n0 tl0 tl1 i0 ret; - let (tl00, tl10) := p in - Return (List_Cons x0 tl00, List_Cons x1 tl10)) - | List_Nil => Fail_ Failure - end - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::list_nth_mut_loop_pair_merge]: backward function 0 - Source: 'src/loops.rs', lines 223:0-227:27 *) -Definition list_nth_mut_loop_pair_merge_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) - (ret : (T * T)) : - result ((List_t T) * (List_t T)) - := - list_nth_mut_loop_pair_merge_loop_back T n ls0 ls1 i ret -. - -(** [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function +(** [loops::list_nth_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 241:0-256:1 *) Fixpoint list_nth_shared_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : @@ -610,7 +477,7 @@ Fixpoint list_nth_shared_loop_pair_merge_loop := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls0 with | List_Cons x0 tl0 => match ls1 with @@ -618,8 +485,8 @@ Fixpoint list_nth_shared_loop_pair_merge_loop if i s= 0%u32 then Return (x0, x1) else ( - i0 <- u32_sub i 1%u32; - list_nth_shared_loop_pair_merge_loop T n0 tl0 tl1 i0) + i1 <- u32_sub i 1%u32; + list_nth_shared_loop_pair_merge_loop T n1 tl0 tl1 i1) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -627,7 +494,7 @@ Fixpoint list_nth_shared_loop_pair_merge_loop end . -(** [loops::list_nth_shared_loop_pair_merge]: forward function +(** [loops::list_nth_shared_loop_pair_merge]: Source: 'src/loops.rs', lines 241:0-245:19 *) Definition list_nth_shared_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : @@ -636,24 +503,30 @@ Definition list_nth_shared_loop_pair_merge list_nth_shared_loop_pair_merge_loop T n ls0 ls1 i . -(** [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function +(** [loops::list_nth_mut_shared_loop_pair]: loop 0: Source: 'src/loops.rs', lines 259:0-274:1 *) Fixpoint list_nth_mut_shared_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * (T -> result (List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls0 with | List_Cons x0 tl0 => match ls1 with | List_Cons x1 tl1 => if i s= 0%u32 - then Return (x0, x1) + then + let back_'a := fun (ret : T) => Return (List_Cons ret tl0) in + Return ((x0, x1), back_'a) else ( - i0 <- u32_sub i 1%u32; - list_nth_mut_shared_loop_pair_loop T n0 tl0 tl1 i0) + i1 <- u32_sub i 1%u32; + p <- list_nth_mut_shared_loop_pair_loop T n1 tl0 tl1 i1; + let (p1, back_'a) := p in + let back_'a1 := + fun (ret : T) => tl01 <- back_'a ret; Return (List_Cons x0 tl01) in + Return (p1, back_'a1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -661,68 +534,42 @@ Fixpoint list_nth_mut_shared_loop_pair_loop end . -(** [loops::list_nth_mut_shared_loop_pair]: forward function +(** [loops::list_nth_mut_shared_loop_pair]: Source: 'src/loops.rs', lines 259:0-263:23 *) Definition list_nth_mut_shared_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * (T -> result (List_t T))) := - list_nth_mut_shared_loop_pair_loop T n ls0 ls1 i + p <- list_nth_mut_shared_loop_pair_loop T n ls0 ls1 i; + let (p1, back_'a) := p in + let back_'a1 := fun (ret : T) => back_'a ret in + Return (p1, back_'a1) . -(** [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 259:0-274:1 *) -Fixpoint list_nth_mut_shared_loop_pair_loop_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls0 with - | List_Cons x0 tl0 => - match ls1 with - | List_Cons x1 tl1 => - if i s= 0%u32 - then Return (List_Cons ret tl0) - else ( - i0 <- u32_sub i 1%u32; - tl00 <- list_nth_mut_shared_loop_pair_loop_back T n0 tl0 tl1 i0 ret; - Return (List_Cons x0 tl00)) - | List_Nil => Fail_ Failure - end - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::list_nth_mut_shared_loop_pair]: backward function 0 - Source: 'src/loops.rs', lines 259:0-263:23 *) -Definition list_nth_mut_shared_loop_pair_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - list_nth_mut_shared_loop_pair_loop_back T n ls0 ls1 i ret -. - -(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function +(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 278:0-293:1 *) Fixpoint list_nth_mut_shared_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * (T -> result (List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls0 with | List_Cons x0 tl0 => match ls1 with | List_Cons x1 tl1 => if i s= 0%u32 - then Return (x0, x1) + then + let back_'a := fun (ret : T) => Return (List_Cons ret tl0) in + Return ((x0, x1), back_'a) else ( - i0 <- u32_sub i 1%u32; - list_nth_mut_shared_loop_pair_merge_loop T n0 tl0 tl1 i0) + i1 <- u32_sub i 1%u32; + p <- list_nth_mut_shared_loop_pair_merge_loop T n1 tl0 tl1 i1; + let (p1, back_'a) := p in + let back_'a1 := + fun (ret : T) => tl01 <- back_'a ret; Return (List_Cons x0 tl01) in + Return (p1, back_'a1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -730,69 +577,42 @@ Fixpoint list_nth_mut_shared_loop_pair_merge_loop end . -(** [loops::list_nth_mut_shared_loop_pair_merge]: forward function +(** [loops::list_nth_mut_shared_loop_pair_merge]: Source: 'src/loops.rs', lines 278:0-282:23 *) Definition list_nth_mut_shared_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) - := - list_nth_mut_shared_loop_pair_merge_loop T n ls0 ls1 i -. - -(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 278:0-293:1 *) -Fixpoint list_nth_mut_shared_loop_pair_merge_loop_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls0 with - | List_Cons x0 tl0 => - match ls1 with - | List_Cons x1 tl1 => - if i s= 0%u32 - then Return (List_Cons ret tl0) - else ( - i0 <- u32_sub i 1%u32; - tl00 <- - list_nth_mut_shared_loop_pair_merge_loop_back T n0 tl0 tl1 i0 ret; - Return (List_Cons x0 tl00)) - | List_Nil => Fail_ Failure - end - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 - Source: 'src/loops.rs', lines 278:0-282:23 *) -Definition list_nth_mut_shared_loop_pair_merge_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) + result ((T * T) * (T -> result (List_t T))) := - list_nth_mut_shared_loop_pair_merge_loop_back T n ls0 ls1 i ret + p <- list_nth_mut_shared_loop_pair_merge_loop T n ls0 ls1 i; + let (p1, back_'a) := p in + let back_'a1 := fun (ret : T) => back_'a ret in + Return (p1, back_'a1) . -(** [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function +(** [loops::list_nth_shared_mut_loop_pair]: loop 0: Source: 'src/loops.rs', lines 297:0-312:1 *) Fixpoint list_nth_shared_mut_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * (T -> result (List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls0 with | List_Cons x0 tl0 => match ls1 with | List_Cons x1 tl1 => if i s= 0%u32 - then Return (x0, x1) + then + let back_'b := fun (ret : T) => Return (List_Cons ret tl1) in + Return ((x0, x1), back_'b) else ( - i0 <- u32_sub i 1%u32; - list_nth_shared_mut_loop_pair_loop T n0 tl0 tl1 i0) + i1 <- u32_sub i 1%u32; + p <- list_nth_shared_mut_loop_pair_loop T n1 tl0 tl1 i1; + let (p1, back_'b) := p in + let back_'b1 := + fun (ret : T) => tl11 <- back_'b ret; Return (List_Cons x1 tl11) in + Return (p1, back_'b1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -800,68 +620,42 @@ Fixpoint list_nth_shared_mut_loop_pair_loop end . -(** [loops::list_nth_shared_mut_loop_pair]: forward function +(** [loops::list_nth_shared_mut_loop_pair]: Source: 'src/loops.rs', lines 297:0-301:23 *) Definition list_nth_shared_mut_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * (T -> result (List_t T))) := - list_nth_shared_mut_loop_pair_loop T n ls0 ls1 i -. - -(** [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 - Source: 'src/loops.rs', lines 297:0-312:1 *) -Fixpoint list_nth_shared_mut_loop_pair_loop_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls0 with - | List_Cons x0 tl0 => - match ls1 with - | List_Cons x1 tl1 => - if i s= 0%u32 - then Return (List_Cons ret tl1) - else ( - i0 <- u32_sub i 1%u32; - tl10 <- list_nth_shared_mut_loop_pair_loop_back T n0 tl0 tl1 i0 ret; - Return (List_Cons x1 tl10)) - | List_Nil => Fail_ Failure - end - | List_Nil => Fail_ Failure - end - end + p <- list_nth_shared_mut_loop_pair_loop T n ls0 ls1 i; + let (p1, back_'b) := p in + let back_'b1 := fun (ret : T) => back_'b ret in + Return (p1, back_'b1) . -(** [loops::list_nth_shared_mut_loop_pair]: backward function 1 - Source: 'src/loops.rs', lines 297:0-301:23 *) -Definition list_nth_shared_mut_loop_pair_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - list_nth_shared_mut_loop_pair_loop_back T n ls0 ls1 i ret -. - -(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function +(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 316:0-331:1 *) Fixpoint list_nth_shared_mut_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) + result ((T * T) * (T -> result (List_t T))) := match n with | O => Fail_ OutOfFuel - | S n0 => + | S n1 => match ls0 with | List_Cons x0 tl0 => match ls1 with | List_Cons x1 tl1 => if i s= 0%u32 - then Return (x0, x1) + then + let back_'a := fun (ret : T) => Return (List_Cons ret tl1) in + Return ((x0, x1), back_'a) else ( - i0 <- u32_sub i 1%u32; - list_nth_shared_mut_loop_pair_merge_loop T n0 tl0 tl1 i0) + i1 <- u32_sub i 1%u32; + p <- list_nth_shared_mut_loop_pair_merge_loop T n1 tl0 tl1 i1; + let (p1, back_'a) := p in + let back_'a1 := + fun (ret : T) => tl11 <- back_'a ret; Return (List_Cons x1 tl11) in + Return (p1, back_'a1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -869,49 +663,16 @@ Fixpoint list_nth_shared_mut_loop_pair_merge_loop end . -(** [loops::list_nth_shared_mut_loop_pair_merge]: forward function +(** [loops::list_nth_shared_mut_loop_pair_merge]: Source: 'src/loops.rs', lines 316:0-320:23 *) Definition list_nth_shared_mut_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : - result (T * T) - := - list_nth_shared_mut_loop_pair_merge_loop T n ls0 ls1 i -. - -(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 316:0-331:1 *) -Fixpoint list_nth_shared_mut_loop_pair_merge_loop_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) - := - match n with - | O => Fail_ OutOfFuel - | S n0 => - match ls0 with - | List_Cons x0 tl0 => - match ls1 with - | List_Cons x1 tl1 => - if i s= 0%u32 - then Return (List_Cons ret tl1) - else ( - i0 <- u32_sub i 1%u32; - tl10 <- - list_nth_shared_mut_loop_pair_merge_loop_back T n0 tl0 tl1 i0 ret; - Return (List_Cons x1 tl10)) - | List_Nil => Fail_ Failure - end - | List_Nil => Fail_ Failure - end - end -. - -(** [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 - Source: 'src/loops.rs', lines 316:0-320:23 *) -Definition list_nth_shared_mut_loop_pair_merge_back - (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) (ret : T) : - result (List_t T) + result ((T * T) * (T -> result (List_t T))) := - list_nth_shared_mut_loop_pair_merge_loop_back T n ls0 ls1 i ret + p <- list_nth_shared_mut_loop_pair_merge_loop T n ls0 ls1 i; + let (p1, back_'a) := p in + let back_'a1 := fun (ret : T) => back_'a ret in + Return (p1, back_'a1) . End Loops. diff --git a/tests/coq/misc/Paper.v b/tests/coq/misc/Paper.v index 6b110193..e46df0ce 100644 --- a/tests/coq/misc/Paper.v +++ b/tests/coq/misc/Paper.v @@ -8,44 +8,40 @@ Import ListNotations. Local Open Scope Primitives_scope. Module Paper. -(** [paper::ref_incr]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [paper::ref_incr]: Source: 'src/paper.rs', lines 4:0-4:28 *) Definition ref_incr (x : i32) : result i32 := i32_add x 1%i32. -(** [paper::test_incr]: forward function +(** [paper::test_incr]: Source: 'src/paper.rs', lines 8:0-8:18 *) Definition test_incr : result unit := - x <- ref_incr 0%i32; if negb (x s= 1%i32) then Fail_ Failure else Return tt + i <- ref_incr 0%i32; if negb (i s= 1%i32) then Fail_ Failure else Return tt . (** Unit test for [paper::test_incr] *) Check (test_incr )%return. -(** [paper::choose]: forward function +(** [paper::choose]: Source: 'src/paper.rs', lines 15:0-15:70 *) -Definition choose (T : Type) (b : bool) (x : T) (y : T) : result T := - if b then Return x else Return y +Definition choose + (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := + if b + then let back_'a := fun (ret : T) => Return (ret, y) in Return (x, back_'a) + else let back_'a := fun (ret : T) => Return (x, ret) in Return (y, back_'a) . -(** [paper::choose]: backward function 0 - Source: 'src/paper.rs', lines 15:0-15:70 *) -Definition choose_back - (T : Type) (b : bool) (x : T) (y : T) (ret : T) : result (T * T) := - if b then Return (ret, y) else Return (x, ret) -. - -(** [paper::test_choose]: forward function +(** [paper::test_choose]: Source: 'src/paper.rs', lines 23:0-23:20 *) Definition test_choose : result unit := - z <- choose i32 true 0%i32 0%i32; - z0 <- i32_add z 1%i32; - if negb (z0 s= 1%i32) + p <- choose i32 true 0%i32 0%i32; + let (z, choose_back) := p in + z1 <- i32_add z 1%i32; + if negb (z1 s= 1%i32) then Fail_ Failure else ( - p <- choose_back i32 true 0%i32 0%i32 z0; - let (x, y) := p in + p1 <- choose_back z1; + let (x, y) := p1 in if negb (x s= 1%i32) then Fail_ Failure else if negb (y s= 0%i32) then Fail_ Failure else Return tt) @@ -64,35 +60,31 @@ Inductive List_t (T : Type) := Arguments List_Cons { _ }. Arguments List_Nil { _ }. -(** [paper::list_nth_mut]: forward function - Source: 'src/paper.rs', lines 42:0-42:67 *) -Fixpoint list_nth_mut (T : Type) (l : List_t T) (i : u32) : result T := - match l with - | List_Cons x tl => - if i s= 0%u32 - then Return x - else (i0 <- u32_sub i 1%u32; list_nth_mut T tl i0) - | List_Nil => Fail_ Failure - end -. - -(** [paper::list_nth_mut]: backward function 0 +(** [paper::list_nth_mut]: Source: 'src/paper.rs', lines 42:0-42:67 *) -Fixpoint list_nth_mut_back - (T : Type) (l : List_t T) (i : u32) (ret : T) : result (List_t T) := +Fixpoint list_nth_mut + (T : Type) (l : List_t T) (i : u32) : + result (T * (T -> result (List_t T))) + := match l with | List_Cons x tl => if i s= 0%u32 - then Return (List_Cons ret tl) + then + let back_'a := fun (ret : T) => Return (List_Cons ret tl) in + Return (x, back_'a) else ( - i0 <- u32_sub i 1%u32; - tl0 <- list_nth_mut_back T tl i0 ret; - Return (List_Cons x tl0)) + i1 <- u32_sub i 1%u32; + p <- list_nth_mut T tl i1; + let (t, list_nth_mut_back) := p in + let back_'a := + fun (ret : T) => tl1 <- list_nth_mut_back ret; Return (List_Cons x tl1) + in + Return (t, back_'a)) | List_Nil => Fail_ Failure end . -(** [paper::sum]: forward function +(** [paper::sum]: Source: 'src/paper.rs', lines 57:0-57:32 *) Fixpoint sum (l : List_t i32) : result i32 := match l with @@ -101,31 +93,33 @@ Fixpoint sum (l : List_t i32) : result i32 := end . -(** [paper::test_nth]: forward function +(** [paper::test_nth]: Source: 'src/paper.rs', lines 68:0-68:17 *) Definition test_nth : result unit := let l := List_Nil in - let l0 := List_Cons 3%i32 l in - let l1 := List_Cons 2%i32 l0 in - x <- list_nth_mut i32 (List_Cons 1%i32 l1) 2%u32; - x0 <- i32_add x 1%i32; - l2 <- list_nth_mut_back i32 (List_Cons 1%i32 l1) 2%u32 x0; - i <- sum l2; + let l1 := List_Cons 3%i32 l in + let l2 := List_Cons 2%i32 l1 in + p <- list_nth_mut i32 (List_Cons 1%i32 l2) 2%u32; + let (x, list_nth_mut_back) := p in + x1 <- i32_add x 1%i32; + l3 <- list_nth_mut_back x1; + i <- sum l3; if negb (i s= 7%i32) then Fail_ Failure else Return tt . (** Unit test for [paper::test_nth] *) Check (test_nth )%return. -(** [paper::call_choose]: forward function +(** [paper::call_choose]: Source: 'src/paper.rs', lines 76:0-76:44 *) Definition call_choose (p : (u32 * u32)) : result u32 := let (px, py) := p in - pz <- choose u32 true px py; - pz0 <- u32_add pz 1%u32; - p0 <- choose_back u32 true px py pz0; - let (px0, _) := p0 in - Return px0 + p1 <- choose u32 true px py; + let (pz, choose_back) := p1 in + pz1 <- u32_add pz 1%u32; + p2 <- choose_back pz1; + let (px1, _) := p2 in + Return px1 . End Paper. diff --git a/tests/coq/misc/PoloniusList.v b/tests/coq/misc/PoloniusList.v index 2371b1cc..7e967855 100644 --- a/tests/coq/misc/PoloniusList.v +++ b/tests/coq/misc/PoloniusList.v @@ -18,26 +18,28 @@ Inductive List_t (T : Type) := Arguments List_Cons { _ }. Arguments List_Nil { _ }. -(** [polonius_list::get_list_at_x]: forward function +(** [polonius_list::get_list_at_x]: Source: 'src/polonius_list.rs', lines 13:0-13:76 *) -Fixpoint get_list_at_x (ls : List_t u32) (x : u32) : result (List_t u32) := - match ls with - | List_Cons hd tl => - if hd s= x then Return (List_Cons hd tl) else get_list_at_x tl x - | List_Nil => Return List_Nil - end -. - -(** [polonius_list::get_list_at_x]: backward function 0 - Source: 'src/polonius_list.rs', lines 13:0-13:76 *) -Fixpoint get_list_at_x_back - (ls : List_t u32) (x : u32) (ret : List_t u32) : result (List_t u32) := +Fixpoint get_list_at_x + (ls : List_t u32) (x : u32) : + result ((List_t u32) * (List_t u32 -> result (List_t u32))) + := match ls with | List_Cons hd tl => if hd s= x - then Return ret - else (tl0 <- get_list_at_x_back tl x ret; Return (List_Cons hd tl0)) - | List_Nil => Return ret + then + let back_'a := fun (ret : List_t u32) => Return ret in + Return (List_Cons hd tl, back_'a) + else ( + p <- get_list_at_x tl x; + let (l, get_list_at_x_back) := p in + let back_'a := + fun (ret : List_t u32) => + tl1 <- get_list_at_x_back ret; Return (List_Cons hd tl1) in + Return (l, back_'a)) + | List_Nil => + let back_'a := fun (ret : List_t u32) => Return ret in + Return (List_Nil, back_'a) end . diff --git a/tests/coq/misc/Primitives.v b/tests/coq/misc/Primitives.v index c0056073..990e27e4 100644 --- a/tests/coq/misc/Primitives.v +++ b/tests/coq/misc/Primitives.v @@ -67,7 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a * (a -> a) := (x, fun x => x) . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * a := (x, x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. @@ -585,6 +585,13 @@ Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usize) : + result (T * (T -> result (array T n))) := + match array_index_usize T n a i with + | Fail_ e => Fail_ e + | Return x => Return (x, array_update_usize T n a i) + end. + (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. @@ -592,11 +599,25 @@ Axiom slice_len : forall (T : Type) (s : slice T), usize. Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : + result (T * (T -> result (slice T))) := + match slice_index_usize T s i with + | Fail_ e => Fail_ e + | Return x => Return (x, slice_update_usize T s i) + end. + (*** Subslices *) Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : + result (slice T * (slice T -> result (array T n))) := + match array_to_slice T n a with + | Fail_ e => Fail_ e + | Return x => Return (x, array_from_slice T n a) + end. + Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). diff --git a/tests/coq/misc/_CoqProject b/tests/coq/misc/_CoqProject index 869cdb4d..64cddedd 100644 --- a/tests/coq/misc/_CoqProject +++ b/tests/coq/misc/_CoqProject @@ -8,9 +8,9 @@ External_Types.v Primitives.v External_Funs.v External_TypesExternal.v +Paper.v Constants.v PoloniusList.v -Paper.v NoNestedBorrows.v External_FunsExternal.v Bitwise.v diff --git a/tests/coq/traits/Primitives.v b/tests/coq/traits/Primitives.v index 84280b96..990e27e4 100644 --- a/tests/coq/traits/Primitives.v +++ b/tests/coq/traits/Primitives.v @@ -67,8 +67,7 @@ Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . -Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * a := (x, x) . Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. @@ -504,13 +503,15 @@ Arguments core_ops_index_Index_index {_ _}. (* Trait declaration: [core::ops::index::IndexMut] *) Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; - core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); - core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; + core_ops_index_IndexMut_index_mut : + Self -> + Idx -> + result (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) * + (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self)); }. Arguments mk_core_ops_index_IndexMut {_ _}. Arguments core_ops_index_IndexMut_indexInst {_ _}. Arguments core_ops_index_IndexMut_index_mut {_ _}. -Arguments core_ops_index_IndexMut_index_mut_back {_ _}. (* Trait declaration [core::ops::deref::Deref] *) Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { @@ -524,13 +525,14 @@ Arguments core_ops_deref_Deref_deref {_}. (* Trait declaration [core::ops::deref::DerefMut] *) Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; - core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); - core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; + core_ops_deref_DerefMut_deref_mut : + Self -> + result (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) * + (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self)); }. Arguments mk_core_ops_deref_DerefMut {_}. Arguments core_ops_deref_DerefMut_derefInst {_}. Arguments core_ops_deref_DerefMut_deref_mut {_}. -Arguments core_ops_deref_DerefMut_deref_mut_back {_}. Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { core_ops_range_Range_start : T; @@ -543,8 +545,8 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. -Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := + Return (x, fun x => Return x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -556,7 +558,6 @@ Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; - core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; |}. @@ -584,6 +585,13 @@ Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usize) : + result (T * (T -> result (array T n))) := + match array_index_usize T n a i with + | Fail_ e => Fail_ e + | Return x => Return (x, array_update_usize T n a i) + end. + (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. @@ -591,11 +599,25 @@ Axiom slice_len : forall (T : Type) (s : slice T), usize. Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : + result (T * (T -> result (slice T))) := + match slice_index_usize T s i with + | Fail_ e => Fail_ e + | Return x => Return (x, slice_update_usize T s i) + end. + (*** Subslices *) Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : + result (slice T * (slice T -> result (array T n))) := + match array_to_slice T n a with + | Fail_ e => Fail_ e + | Return x => Return (x, array_from_slice T n a) + end. + Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). @@ -639,16 +661,9 @@ Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (l | right _ => Fail_ Failure end. -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. - Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). -(* The **forward** function shouldn't be used *) -Definition alloc_vec_Vec_insert_fwd (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result unit := - if to_Z i if to_Z i result (alloc_vec_Vec T))) := + match alloc_vec_Vec_index_usize v i with + | Return x => + Return (x, alloc_vec_Vec_update_usize v i) + | Fail_ e => Fail_ e + end. + (* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. @@ -669,25 +692,23 @@ Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceI core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; core_slice_index_SliceIndex_Output : Type; core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); - core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_mut : + Self -> T -> result (option core_slice_index_SliceIndex_Output * (option core_slice_index_SliceIndex_Output -> result T)); core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; - core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_index_mut : + Self -> T -> result (core_slice_index_SliceIndex_Output * (core_slice_index_SliceIndex_Output -> result T)); }. Arguments mk_core_slice_index_SliceIndex {_ _}. Arguments core_slice_index_SliceIndex_sealedInst {_ _}. Arguments core_slice_index_SliceIndex_Output {_ _}. Arguments core_slice_index_SliceIndex_get {_ _}. Arguments core_slice_index_SliceIndex_get_mut {_ _}. -Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. Arguments core_slice_index_SliceIndex_index {_ _}. Arguments core_slice_index_SliceIndex_index_mut {_ _}. -Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. (* [core::slice::index::[T]::index]: forward function *) Definition core_slice_index_Slice_index @@ -704,11 +725,9 @@ Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Ra (* [core::slice::index::Range::get_mut]: forward function *) Axiom core_slice_index_RangeUsize_get_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (option (slice T)). - -(* [core::slice::index::Range::get_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_get_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + forall (T : Type), + core_ops_range_Range usize -> slice T -> + result (option (slice T) * (option (slice T) -> result (slice T))). (* [core::slice::index::Range::get_unchecked]: forward function *) Definition core_slice_index_RangeUsize_get_unchecked @@ -732,21 +751,14 @@ Axiom core_slice_index_RangeUsize_index : (* [core::slice::index::Range::index_mut]: forward function *) Axiom core_slice_index_RangeUsize_index_mut : - forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). - -(* [core::slice::index::Range::index_mut]: backward function 0 *) -Axiom core_slice_index_RangeUsize_index_mut_back : - forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T * (slice T -> result (slice T))). (* [core::slice::index::[T]::index_mut]: forward function *) Axiom core_slice_index_Slice_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). - -(* [core::slice::index::[T]::index_mut]: backward function 0 *) -Axiom core_slice_index_Slice_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), - slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + slice T -> Idx -> + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (slice T))). (* [core::array::[T; N]::index]: forward function *) Axiom core_array_Array_index : @@ -756,12 +768,9 @@ Axiom core_array_Array_index : (* [core::array::[T; N]::index_mut]: forward function *) Axiom core_array_Array_index_mut : forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). - -(* [core::array::[T; N]::index_mut]: backward function 0 *) -Axiom core_array_Array_index_mut_back : - forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) - (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + (a : array T N) (i : Idx), + result (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) * + (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) -> result (array T N))). (* Trait implementation: [core::slice::index::private_slice_index::Range] *) Definition core_slice_index_private_slice_index_SealedRangeUsizeInst @@ -774,12 +783,10 @@ Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := slice T; core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_RangeUsize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_RangeUsize_index_mut_back T; |}. (* Trait implementation: [core::slice::index::[T]] *) @@ -796,7 +803,6 @@ Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) core_ops_index_IndexMut (slice T) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; |}. (* Trait implementation: [core::array::[T; N]] *) @@ -813,18 +819,14 @@ Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) core_ops_index_IndexMut (array T N) Idx := {| core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; - core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; |}. (* [core::slice::index::usize::get]: forward function *) Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). (* [core::slice::index::usize::get_mut]: forward function *) -Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). - -(* [core::slice::index::usize::get_mut]: backward function 0 *) -Axiom core_slice_index_usize_get_mut_back : - forall (T : Type), usize -> slice T -> option T -> result (slice T). +Axiom core_slice_index_usize_get_mut : + forall (T : Type), usize -> slice T -> result (option T * (option T -> result (slice T))). (* [core::slice::index::usize::get_unchecked]: forward function *) Axiom core_slice_index_usize_get_unchecked : @@ -838,11 +840,8 @@ Axiom core_slice_index_usize_get_unchecked_mut : Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. (* [core::slice::index::usize::index_mut]: forward function *) -Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. - -(* [core::slice::index::usize::index_mut]: backward function 0 *) -Axiom core_slice_index_usize_index_mut_back : - forall (T : Type), usize -> slice T -> T -> result (slice T). +Axiom core_slice_index_usize_index_mut : + forall (T : Type), usize -> slice T -> result (T * (T -> result (slice T))). (* Trait implementation: [core::slice::index::private_slice_index::usize] *) Definition core_slice_index_private_slice_index_SealedUsizeInst @@ -855,12 +854,10 @@ Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex_Output := T; core_slice_index_SliceIndex_get := core_slice_index_usize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; core_slice_index_SliceIndex_index := core_slice_index_usize_index T; core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; |}. (* [alloc::vec::Vec::index]: forward function *) @@ -869,12 +866,9 @@ Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_Slice (* [alloc::vec::Vec::index_mut]: forward function *) Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). - -(* [alloc::vec::Vec::index_mut]: backward function 0 *) -Axiom alloc_vec_Vec_index_mut_back : - forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) - (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + (Self : alloc_vec_Vec T) (i : Idx), + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (alloc_vec_Vec T))). (* Trait implementation: [alloc::vec::Vec] *) Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) @@ -890,7 +884,6 @@ Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; - core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; |}. (*** Theorems *) @@ -901,10 +894,6 @@ Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usiz Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = - alloc_vec_Vec_index_usize v i. - -Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x = - alloc_vec_Vec_update_usize v i x. + alloc_vec_Vec_index_mut_usize v i. End Primitives. diff --git a/tests/coq/traits/Traits.v b/tests/coq/traits/Traits.v index 2448e8f3..7055e25d 100644 --- a/tests/coq/traits/Traits.v +++ b/tests/coq/traits/Traits.v @@ -17,7 +17,7 @@ Record BoolTrait_t (Self : Type) := mkBoolTrait_t { Arguments mkBoolTrait_t { _ }. Arguments BoolTrait_t_get_bool { _ }. -(** [traits::{bool}::get_bool]: forward function +(** [traits::{bool}::get_bool]: Source: 'src/traits.rs', lines 12:4-12:30 *) Definition bool_get_bool (self : bool) : result bool := Return self. @@ -28,24 +28,24 @@ Definition traits_BoolTraitBoolInst : BoolTrait_t bool := {| BoolTrait_t_get_bool := bool_get_bool; |}. -(** [traits::BoolTrait::ret_true]: forward function +(** [traits::BoolTrait::ret_true]: Source: 'src/traits.rs', lines 6:4-6:30 *) Definition boolTrait_ret_true {Self : Type} (self_clause : BoolTrait_t Self) (self : Self) : result bool := Return true . -(** [traits::test_bool_trait_bool]: forward function +(** [traits::test_bool_trait_bool]: Source: 'src/traits.rs', lines 17:0-17:44 *) Definition test_bool_trait_bool (x : bool) : result bool := b <- bool_get_bool x; if b then boolTrait_ret_true traits_BoolTraitBoolInst x else Return false . -(** [traits::{core::option::Option#1}::get_bool]: forward function +(** [traits::{core::option::Option#1}::get_bool]: Source: 'src/traits.rs', lines 23:4-23:30 *) Definition option_get_bool (T : Type) (self : option T) : result bool := - match self with | None => Return false | Some t => Return true end + match self with | None => Return false | Some _ => Return true end . (** Trait implementation: [traits::{core::option::Option#1}] @@ -55,7 +55,7 @@ Definition traits_BoolTraitcoreoptionOptionTInst (T : Type) : BoolTrait_t BoolTrait_t_get_bool := option_get_bool T; |}. -(** [traits::test_bool_trait_option]: forward function +(** [traits::test_bool_trait_option]: Source: 'src/traits.rs', lines 31:0-31:54 *) Definition test_bool_trait_option (T : Type) (x : option T) : result bool := b <- option_get_bool T x; @@ -64,7 +64,7 @@ Definition test_bool_trait_option (T : Type) (x : option T) : result bool := else Return false . -(** [traits::test_bool_trait]: forward function +(** [traits::test_bool_trait]: Source: 'src/traits.rs', lines 35:0-35:50 *) Definition test_bool_trait (T : Type) (boolTraitTInst : BoolTrait_t T) (x : T) : result bool := @@ -80,7 +80,7 @@ Record ToU64_t (Self : Type) := mkToU64_t { Arguments mkToU64_t { _ }. Arguments ToU64_t_to_u64 { _ }. -(** [traits::{u64#2}::to_u64]: forward function +(** [traits::{u64#2}::to_u64]: Source: 'src/traits.rs', lines 44:4-44:26 *) Definition u64_to_u64 (self : u64) : result u64 := Return self. @@ -91,14 +91,14 @@ Definition traits_ToU64U64Inst : ToU64_t u64 := {| ToU64_t_to_u64 := u64_to_u64; |}. -(** [traits::{(A, A)#3}::to_u64]: forward function +(** [traits::{(A, A)#3}::to_u64]: Source: 'src/traits.rs', lines 50:4-50:26 *) Definition pair_to_u64 (A : Type) (toU64AInst : ToU64_t A) (self : (A * A)) : result u64 := - let (t, t0) := self in + let (t, t1) := self in i <- toU64AInst.(ToU64_t_to_u64) t; - i0 <- toU64AInst.(ToU64_t_to_u64) t0; - u64_add i i0 + i1 <- toU64AInst.(ToU64_t_to_u64) t1; + u64_add i i1 . (** Trait implementation: [traits::{(A, A)#3}] @@ -108,20 +108,20 @@ Definition traits_ToU64TupleAAInst (A : Type) (toU64AInst : ToU64_t A) : ToU64_t_to_u64 := pair_to_u64 A toU64AInst; |}. -(** [traits::f]: forward function +(** [traits::f]: Source: 'src/traits.rs', lines 55:0-55:36 *) Definition f (T : Type) (toU64TInst : ToU64_t T) (x : (T * T)) : result u64 := pair_to_u64 T toU64TInst x . -(** [traits::g]: forward function +(** [traits::g]: Source: 'src/traits.rs', lines 59:0-61:18 *) Definition g (T : Type) (toU64TupleTTInst : ToU64_t (T * T)) (x : (T * T)) : result u64 := toU64TupleTTInst.(ToU64_t_to_u64) x . -(** [traits::h0]: forward function +(** [traits::h0]: Source: 'src/traits.rs', lines 66:0-66:24 *) Definition h0 (x : u64) : result u64 := u64_to_u64 x. @@ -133,7 +133,7 @@ Record Wrapper_t (T : Type) := mkWrapper_t { wrapper_x : T; }. Arguments mkWrapper_t { _ }. Arguments wrapper_x { _ }. -(** [traits::{traits::Wrapper#4}::to_u64]: forward function +(** [traits::{traits::Wrapper#4}::to_u64]: Source: 'src/traits.rs', lines 75:4-75:26 *) Definition wrapper_to_u64 (T : Type) (toU64TInst : ToU64_t T) (self : Wrapper_t T) : result u64 := @@ -147,13 +147,13 @@ Definition traits_ToU64traitsWrapperTInst (T : Type) (toU64TInst : ToU64_t T) : ToU64_t_to_u64 := wrapper_to_u64 T toU64TInst; |}. -(** [traits::h1]: forward function +(** [traits::h1]: Source: 'src/traits.rs', lines 80:0-80:33 *) Definition h1 (x : Wrapper_t u64) : result u64 := wrapper_to_u64 u64 traits_ToU64U64Inst x . -(** [traits::h2]: forward function +(** [traits::h2]: Source: 'src/traits.rs', lines 84:0-84:41 *) Definition h2 (T : Type) (toU64TInst : ToU64_t T) (x : Wrapper_t T) : result u64 := @@ -169,7 +169,7 @@ Record ToType_t (Self T : Type) := mkToType_t { Arguments mkToType_t { _ _ }. Arguments ToType_t_to_type { _ _ }. -(** [traits::{u64#5}::to_type]: forward function +(** [traits::{u64#5}::to_type]: Source: 'src/traits.rs', lines 93:4-93:28 *) Definition u64_to_type (self : u64) : result bool := Return (self s> 0%u64). @@ -190,7 +190,7 @@ Record OfType_t (Self : Type) := mkOfType_t { Arguments mkOfType_t { _ }. Arguments OfType_t_of_type { _ }. -(** [traits::h3]: forward function +(** [traits::h3]: Source: 'src/traits.rs', lines 104:0-104:50 *) Definition h3 (T1 T2 : Type) (ofTypeT1Inst : OfType_t T1) (toTypeT2T1Inst : ToType_t T2 T1) @@ -211,7 +211,7 @@ Arguments mkOfTypeBis_t { _ _ }. Arguments OfTypeBis_tOfTypeBis_t_ToTypeTSelfInst { _ _ }. Arguments OfTypeBis_t_of_type { _ _ }. -(** [traits::h4]: forward function +(** [traits::h4]: Source: 'src/traits.rs', lines 118:0-118:57 *) Definition h4 (T1 T2 : Type) (ofTypeBisT1T2Inst : OfTypeBis_t T1 T2) (toTypeT2T1Inst : @@ -238,7 +238,7 @@ Record TestType_test_TestTrait_t (Self : Type) := mkTestType_test_TestTrait_t { Arguments mkTestType_test_TestTrait_t { _ }. Arguments TestType_test_TestTrait_t_test { _ }. -(** [traits::{traits::TestType#6}::test::{traits::{traits::TestType#6}::test::TestType1}::test]: forward function +(** [traits::{traits::TestType#6}::test::{traits::{traits::TestType#6}::test::TestType1}::test]: Source: 'src/traits.rs', lines 139:12-139:34 *) Definition testType_test_TestType1_test (self : TestType_test_TestType1_t) : result bool := @@ -252,21 +252,21 @@ Definition traits_TestType_test_TestTraittraitstraitsTestTypeTtestTestType1Inst TestType_test_TestTrait_t_test := testType_test_TestType1_test; |}. -(** [traits::{traits::TestType#6}::test]: forward function +(** [traits::{traits::TestType#6}::test]: Source: 'src/traits.rs', lines 126:4-126:36 *) Definition testType_test (T : Type) (toU64TInst : ToU64_t T) (self : TestType_t T) (x : T) : result bool := - x0 <- toU64TInst.(ToU64_t_to_u64) x; - if x0 s> 0%u64 then testType_test_TestType1_test 0%u64 else Return false + x1 <- toU64TInst.(ToU64_t_to_u64) x; + if x1 s> 0%u64 then testType_test_TestType1_test 0%u64 else Return false . (** [traits::BoolWrapper] Source: 'src/traits.rs', lines 150:0-150:22 *) Definition BoolWrapper_t : Type := bool. -(** [traits::{traits::BoolWrapper#7}::to_type]: forward function +(** [traits::{traits::BoolWrapper#7}::to_type]: Source: 'src/traits.rs', lines 156:4-156:25 *) Definition boolWrapper_to_type (T : Type) (toTypeBoolTInst : ToType_t bool T) (self : BoolWrapper_t) : @@ -312,8 +312,7 @@ Arguments WithConstTy_t_f { _ _ }. Definition bool_len1_body : result usize := Return 12%usize. Definition bool_len1_c : usize := bool_len1_body%global. -(** [traits::{bool#8}::f]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [traits::{bool#8}::f]: Source: 'src/traits.rs', lines 180:4-180:39 *) Definition bool_f (i : u64) (a : array u8 32%usize) : result u64 := Return i. @@ -329,7 +328,7 @@ Definition traits_WithConstTyBool32Inst : WithConstTy_t bool 32%usize := {| WithConstTy_t_f := bool_f; |}. -(** [traits::use_with_const_ty1]: forward function +(** [traits::use_with_const_ty1]: Source: 'src/traits.rs', lines 183:0-183:75 *) Definition use_with_const_ty1 (H : Type) (LEN : usize) (withConstTyHLENInst : WithConstTy_t H LEN) : @@ -338,7 +337,7 @@ Definition use_with_const_ty1 let i := withConstTyHLENInst.(WithConstTy_tWithConstTy_t_LEN1) in Return i . -(** [traits::use_with_const_ty2]: forward function +(** [traits::use_with_const_ty2]: Source: 'src/traits.rs', lines 187:0-187:73 *) Definition use_with_const_ty2 (H : Type) (LEN : usize) (withConstTyHLENInst : WithConstTy_t H LEN) @@ -348,7 +347,7 @@ Definition use_with_const_ty2 Return tt . -(** [traits::use_with_const_ty3]: forward function +(** [traits::use_with_const_ty3]: Source: 'src/traits.rs', lines 189:0-189:80 *) Definition use_with_const_ty3 (H : Type) (LEN : usize) (withConstTyHLENInst : WithConstTy_t H LEN) @@ -359,12 +358,12 @@ Definition use_with_const_ty3 x . -(** [traits::test_where1]: forward function +(** [traits::test_where1]: Source: 'src/traits.rs', lines 193:0-193:40 *) Definition test_where1 (T : Type) (_x : T) : result unit := Return tt. -(** [traits::test_where2]: forward function +(** [traits::test_where2]: Source: 'src/traits.rs', lines 194:0-194:57 *) Definition test_where2 (T : Type) (withConstTyT32Inst : WithConstTy_t T 32%usize) (_x : u32) : @@ -403,16 +402,25 @@ Arguments mkChildTrait_t { _ }. Arguments ChildTrait_tChildTrait_t_ParentTrait0SelfInst { _ }. Arguments ChildTrait_tChildTrait_t_ParentTrait1SelfInst { _ }. -(** [traits::test_child_trait1]: forward function - Source: 'src/traits.rs', lines 209:0-209:56 *) +(** [traits::test_parent_trait0]: + Source: 'src/traits.rs', lines 208:0-208:57 *) +Definition test_parent_trait0 + (T : Type) (parentTrait0TInst : ParentTrait0_t T) (x : T) : + result parentTrait0TInst.(ParentTrait0_tParentTrait0_t_W) + := + parentTrait0TInst.(ParentTrait0_t_get_w) x +. + +(** [traits::test_child_trait1]: + Source: 'src/traits.rs', lines 213:0-213:56 *) Definition test_child_trait1 (T : Type) (childTraitTInst : ChildTrait_t T) (x : T) : result string := childTraitTInst.(ChildTrait_tChildTrait_t_ParentTrait0SelfInst).(ParentTrait0_t_get_name) x . -(** [traits::test_child_trait2]: forward function - Source: 'src/traits.rs', lines 213:0-213:54 *) +(** [traits::test_child_trait2]: + Source: 'src/traits.rs', lines 217:0-217:54 *) Definition test_child_trait2 (T : Type) (childTraitTInst : ChildTrait_t T) (x : T) : result @@ -422,8 +430,8 @@ Definition test_child_trait2 x . -(** [traits::order1]: forward function - Source: 'src/traits.rs', lines 219:0-219:59 *) +(** [traits::order1]: + Source: 'src/traits.rs', lines 223:0-223:59 *) Definition order1 (T U : Type) (parentTrait0TInst : ParentTrait0_t T) (parentTrait0UInst : ParentTrait0_t U) : @@ -433,7 +441,7 @@ Definition order1 . (** Trait declaration: [traits::ChildTrait1] - Source: 'src/traits.rs', lines 222:0-222:35 *) + Source: 'src/traits.rs', lines 226:0-226:35 *) Record ChildTrait1_t (Self : Type) := mkChildTrait1_t { ChildTrait1_tChildTrait1_t_ParentTrait1SelfInst : ParentTrait1_t Self; }. @@ -442,19 +450,19 @@ Arguments mkChildTrait1_t { _ }. Arguments ChildTrait1_tChildTrait1_t_ParentTrait1SelfInst { _ }. (** Trait implementation: [traits::{usize#9}] - Source: 'src/traits.rs', lines 224:0-224:27 *) + Source: 'src/traits.rs', lines 228:0-228:27 *) Definition traits_ParentTrait1UsizeInst : ParentTrait1_t usize := mkParentTrait1_t. (** Trait implementation: [traits::{usize#10}] - Source: 'src/traits.rs', lines 225:0-225:26 *) + Source: 'src/traits.rs', lines 229:0-229:26 *) Definition traits_ChildTrait1UsizeInst : ChildTrait1_t usize := {| ChildTrait1_tChildTrait1_t_ParentTrait1SelfInst := traits_ParentTrait1UsizeInst; |}. (** Trait declaration: [traits::Iterator] - Source: 'src/traits.rs', lines 229:0-229:18 *) + Source: 'src/traits.rs', lines 233:0-233:18 *) Record Iterator_t (Self : Type) := mkIterator_t { Iterator_tIterator_t_Item : Type; }. @@ -463,7 +471,7 @@ Arguments mkIterator_t { _ }. Arguments Iterator_tIterator_t_Item { _ }. (** Trait declaration: [traits::IntoIterator] - Source: 'src/traits.rs', lines 233:0-233:22 *) + Source: 'src/traits.rs', lines 237:0-237:22 *) Record IntoIterator_t (Self : Type) := mkIntoIterator_t { IntoIterator_tIntoIterator_t_Item : Type; IntoIterator_tIntoIterator_t_IntoIter : Type; @@ -480,13 +488,13 @@ Arguments IntoIterator_tIntoIterator_t_IntoIter_clause_0 { _ }. Arguments IntoIterator_t_into_iter { _ }. (** Trait declaration: [traits::FromResidual] - Source: 'src/traits.rs', lines 250:0-250:21 *) + Source: 'src/traits.rs', lines 254:0-254:21 *) Record FromResidual_t (Self T : Type) := mkFromResidual_t{}. Arguments mkFromResidual_t { _ _ }. (** Trait declaration: [traits::Try] - Source: 'src/traits.rs', lines 246:0-246:48 *) + Source: 'src/traits.rs', lines 250:0-250:48 *) Record Try_t (Self : Type) := mkTry_t { Try_tTry_t_Residual : Type; Try_tTry_t_FromResidualSelftraitsTrySelfResidualInst : FromResidual_t Self @@ -498,7 +506,7 @@ Arguments Try_tTry_t_Residual { _ }. Arguments Try_tTry_t_FromResidualSelftraitsTrySelfResidualInst { _ }. (** Trait declaration: [traits::WithTarget] - Source: 'src/traits.rs', lines 252:0-252:20 *) + Source: 'src/traits.rs', lines 256:0-256:20 *) Record WithTarget_t (Self : Type) := mkWithTarget_t { WithTarget_tWithTarget_t_Target : Type; }. @@ -507,7 +515,7 @@ Arguments mkWithTarget_t { _ }. Arguments WithTarget_tWithTarget_t_Target { _ }. (** Trait declaration: [traits::ParentTrait2] - Source: 'src/traits.rs', lines 256:0-256:22 *) + Source: 'src/traits.rs', lines 260:0-260:22 *) Record ParentTrait2_t (Self : Type) := mkParentTrait2_t { ParentTrait2_tParentTrait2_t_U : Type; ParentTrait2_tParentTrait2_t_U_clause_0 : WithTarget_t @@ -519,7 +527,7 @@ Arguments ParentTrait2_tParentTrait2_t_U { _ }. Arguments ParentTrait2_tParentTrait2_t_U_clause_0 { _ }. (** Trait declaration: [traits::ChildTrait2] - Source: 'src/traits.rs', lines 260:0-260:35 *) + Source: 'src/traits.rs', lines 264:0-264:35 *) Record ChildTrait2_t (Self : Type) := mkChildTrait2_t { ChildTrait2_tChildTrait2_t_ParentTrait2SelfInst : ParentTrait2_t Self; ChildTrait2_t_convert : @@ -533,25 +541,25 @@ Arguments ChildTrait2_tChildTrait2_t_ParentTrait2SelfInst { _ }. Arguments ChildTrait2_t_convert { _ }. (** Trait implementation: [traits::{u32#11}] - Source: 'src/traits.rs', lines 264:0-264:23 *) + Source: 'src/traits.rs', lines 268:0-268:23 *) Definition traits_WithTargetU32Inst : WithTarget_t u32 := {| WithTarget_tWithTarget_t_Target := u32; |}. (** Trait implementation: [traits::{u32#12}] - Source: 'src/traits.rs', lines 268:0-268:25 *) + Source: 'src/traits.rs', lines 272:0-272:25 *) Definition traits_ParentTrait2U32Inst : ParentTrait2_t u32 := {| ParentTrait2_tParentTrait2_t_U := u32; ParentTrait2_tParentTrait2_t_U_clause_0 := traits_WithTargetU32Inst; |}. -(** [traits::{u32#13}::convert]: forward function - Source: 'src/traits.rs', lines 273:4-273:29 *) +(** [traits::{u32#13}::convert]: + Source: 'src/traits.rs', lines 277:4-277:29 *) Definition u32_convert (x : u32) : result u32 := Return x. (** Trait implementation: [traits::{u32#13}] - Source: 'src/traits.rs', lines 272:0-272:24 *) + Source: 'src/traits.rs', lines 276:0-276:24 *) Definition traits_ChildTrait2U32Inst : ChildTrait2_t u32 := {| ChildTrait2_tChildTrait2_t_ParentTrait2SelfInst := traits_ParentTrait2U32Inst; @@ -559,7 +567,7 @@ Definition traits_ChildTrait2U32Inst : ChildTrait2_t u32 := {| |}. (** Trait declaration: [traits::CFnOnce] - Source: 'src/traits.rs', lines 286:0-286:23 *) + Source: 'src/traits.rs', lines 290:0-290:23 *) Record CFnOnce_t (Self Args : Type) := mkCFnOnce_t { CFnOnce_tCFnOnce_t_Output : Type; CFnOnce_t_call_once : Self -> Args -> result CFnOnce_tCFnOnce_t_Output; @@ -570,31 +578,48 @@ Arguments CFnOnce_tCFnOnce_t_Output { _ _ }. Arguments CFnOnce_t_call_once { _ _ }. (** Trait declaration: [traits::CFnMut] - Source: 'src/traits.rs', lines 292:0-292:37 *) + Source: 'src/traits.rs', lines 296:0-296:37 *) Record CFnMut_t (Self Args : Type) := mkCFnMut_t { CFnMut_tCFnMut_t_CFnOnceSelfArgsInst : CFnOnce_t Self Args; CFnMut_t_call_mut : Self -> Args -> result - (CFnMut_tCFnMut_t_CFnOnceSelfArgsInst).(CFnOnce_tCFnOnce_t_Output); - CFnMut_t_call_mut_back : Self -> Args -> - (CFnMut_tCFnMut_t_CFnOnceSelfArgsInst).(CFnOnce_tCFnOnce_t_Output) -> - result Self; + ((CFnMut_tCFnMut_t_CFnOnceSelfArgsInst).(CFnOnce_tCFnOnce_t_Output) * + Self); }. Arguments mkCFnMut_t { _ _ }. Arguments CFnMut_tCFnMut_t_CFnOnceSelfArgsInst { _ _ }. Arguments CFnMut_t_call_mut { _ _ }. -Arguments CFnMut_t_call_mut_back { _ _ }. (** Trait declaration: [traits::CFn] - Source: 'src/traits.rs', lines 296:0-296:33 *) + Source: 'src/traits.rs', lines 300:0-300:33 *) Record CFn_t (Self Args : Type) := mkCFn_t { CFn_tCFn_t_CFnMutSelfArgsInst : CFnMut_t Self Args; - CFn_t_call_mut : Self -> Args -> result + CFn_t_call : Self -> Args -> result (CFn_tCFn_t_CFnMutSelfArgsInst).(CFnMut_tCFnMut_t_CFnOnceSelfArgsInst).(CFnOnce_tCFnOnce_t_Output); }. Arguments mkCFn_t { _ _ }. Arguments CFn_tCFn_t_CFnMutSelfArgsInst { _ _ }. -Arguments CFn_t_call_mut { _ _ }. +Arguments CFn_t_call { _ _ }. + +(** Trait declaration: [traits::GetTrait] + Source: 'src/traits.rs', lines 304:0-304:18 *) +Record GetTrait_t (Self : Type) := mkGetTrait_t { + GetTrait_tGetTrait_t_W : Type; + GetTrait_t_get_w : Self -> result GetTrait_tGetTrait_t_W; +}. + +Arguments mkGetTrait_t { _ }. +Arguments GetTrait_tGetTrait_t_W { _ }. +Arguments GetTrait_t_get_w { _ }. + +(** [traits::test_get_trait]: + Source: 'src/traits.rs', lines 309:0-309:49 *) +Definition test_get_trait + (T : Type) (getTraitTInst : GetTrait_t T) (x : T) : + result getTraitTInst.(GetTrait_tGetTrait_t_W) + := + getTraitTInst.(GetTrait_t_get_w) x +. End Traits. diff --git a/tests/fstar-split/array/Array.Clauses.Template.fst b/tests/fstar-split/array/Array.Clauses.Template.fst new file mode 100644 index 00000000..b2f2649c --- /dev/null +++ b/tests/fstar-split/array/Array.Clauses.Template.fst @@ -0,0 +1,21 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [array]: templates for the decreases clauses *) +module Array.Clauses.Template +open Primitives +open Array.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [array::sum]: decreases clause + Source: 'src/array.rs', lines 242:0-250:1 *) +unfold +let sum_loop_decreases (s : slice u32) (sum1 : u32) (i : usize) : nat = + admit () + +(** [array::sum2]: decreases clause + Source: 'src/array.rs', lines 252:0-261:1 *) +unfold +let sum2_loop_decreases (s : slice u32) (s2 : slice u32) (sum1 : u32) + (i : usize) : nat = + admit () + diff --git a/tests/fstar-split/array/Array.Clauses.fst b/tests/fstar-split/array/Array.Clauses.fst new file mode 100644 index 00000000..68cbf216 --- /dev/null +++ b/tests/fstar-split/array/Array.Clauses.fst @@ -0,0 +1,19 @@ +(** [array]: decreases clauses *) +module Array.Clauses +open Primitives +open Array.Types +open FStar.List.Tot + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [array::sum]: decreases clause *) +unfold +let sum_loop_decreases (s : slice u32) (sum : u32) (i : usize) : nat = + if i < length s then length s - i else 0 + +(** [array::sum2]: decreases clause *) +unfold +let sum2_loop_decreases (s : slice u32) (s2 : slice u32) (sum : u32) + (i : usize) : nat = + if i < length s then length s - i else 0 + diff --git a/tests/fstar-split/array/Array.Funs.fst b/tests/fstar-split/array/Array.Funs.fst new file mode 100644 index 00000000..30b19702 --- /dev/null +++ b/tests/fstar-split/array/Array.Funs.fst @@ -0,0 +1,445 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [array]: function definitions *) +module Array.Funs +open Primitives +include Array.Types +include Array.Clauses + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [array::incr]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/array.rs', lines 8:0-8:24 *) +let incr (x : u32) : result u32 = + u32_add x 1 + +(** [array::array_to_shared_slice_]: forward function + Source: 'src/array.rs', lines 16:0-16:53 *) +let array_to_shared_slice_ (t : Type0) (s : array t 32) : result (slice t) = + array_to_slice t 32 s + +(** [array::array_to_mut_slice_]: forward function + Source: 'src/array.rs', lines 21:0-21:58 *) +let array_to_mut_slice_ (t : Type0) (s : array t 32) : result (slice t) = + array_to_slice t 32 s + +(** [array::array_to_mut_slice_]: backward function 0 + Source: 'src/array.rs', lines 21:0-21:58 *) +let array_to_mut_slice__back + (t : Type0) (s : array t 32) (ret : slice t) : result (array t 32) = + array_from_slice t 32 s ret + +(** [array::array_len]: forward function + Source: 'src/array.rs', lines 25:0-25:40 *) +let array_len (t : Type0) (s : array t 32) : result usize = + let* s1 = array_to_slice t 32 s in let i = slice_len t s1 in Return i + +(** [array::shared_array_len]: forward function + Source: 'src/array.rs', lines 29:0-29:48 *) +let shared_array_len (t : Type0) (s : array t 32) : result usize = + let* s1 = array_to_slice t 32 s in let i = slice_len t s1 in Return i + +(** [array::shared_slice_len]: forward function + Source: 'src/array.rs', lines 33:0-33:44 *) +let shared_slice_len (t : Type0) (s : slice t) : result usize = + let i = slice_len t s in Return i + +(** [array::index_array_shared]: forward function + Source: 'src/array.rs', lines 37:0-37:57 *) +let index_array_shared (t : Type0) (s : array t 32) (i : usize) : result t = + array_index_usize t 32 s i + +(** [array::index_array_u32]: forward function + Source: 'src/array.rs', lines 44:0-44:53 *) +let index_array_u32 (s : array u32 32) (i : usize) : result u32 = + array_index_usize u32 32 s i + +(** [array::index_array_copy]: forward function + Source: 'src/array.rs', lines 48:0-48:45 *) +let index_array_copy (x : array u32 32) : result u32 = + array_index_usize u32 32 x 0 + +(** [array::index_mut_array]: forward function + Source: 'src/array.rs', lines 52:0-52:62 *) +let index_mut_array (t : Type0) (s : array t 32) (i : usize) : result t = + array_index_usize t 32 s i + +(** [array::index_mut_array]: backward function 0 + Source: 'src/array.rs', lines 52:0-52:62 *) +let index_mut_array_back + (t : Type0) (s : array t 32) (i : usize) (ret : t) : result (array t 32) = + array_update_usize t 32 s i ret + +(** [array::index_slice]: forward function + Source: 'src/array.rs', lines 56:0-56:46 *) +let index_slice (t : Type0) (s : slice t) (i : usize) : result t = + slice_index_usize t s i + +(** [array::index_mut_slice]: forward function + Source: 'src/array.rs', lines 60:0-60:58 *) +let index_mut_slice (t : Type0) (s : slice t) (i : usize) : result t = + slice_index_usize t s i + +(** [array::index_mut_slice]: backward function 0 + Source: 'src/array.rs', lines 60:0-60:58 *) +let index_mut_slice_back + (t : Type0) (s : slice t) (i : usize) (ret : t) : result (slice t) = + slice_update_usize t s i ret + +(** [array::slice_subslice_shared_]: forward function + Source: 'src/array.rs', lines 64:0-64:70 *) +let slice_subslice_shared_ + (x : slice u32) (y : usize) (z : usize) : result (slice u32) = + core_slice_index_Slice_index u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x + { start = y; end_ = z } + +(** [array::slice_subslice_mut_]: forward function + Source: 'src/array.rs', lines 68:0-68:75 *) +let slice_subslice_mut_ + (x : slice u32) (y : usize) (z : usize) : result (slice u32) = + core_slice_index_Slice_index_mut u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x + { start = y; end_ = z } + +(** [array::slice_subslice_mut_]: backward function 0 + Source: 'src/array.rs', lines 68:0-68:75 *) +let slice_subslice_mut__back + (x : slice u32) (y : usize) (z : usize) (ret : slice u32) : + result (slice u32) + = + core_slice_index_Slice_index_mut_back u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x + { start = y; end_ = z } ret + +(** [array::array_to_slice_shared_]: forward function + Source: 'src/array.rs', lines 72:0-72:54 *) +let array_to_slice_shared_ (x : array u32 32) : result (slice u32) = + array_to_slice u32 32 x + +(** [array::array_to_slice_mut_]: forward function + Source: 'src/array.rs', lines 76:0-76:59 *) +let array_to_slice_mut_ (x : array u32 32) : result (slice u32) = + array_to_slice u32 32 x + +(** [array::array_to_slice_mut_]: backward function 0 + Source: 'src/array.rs', lines 76:0-76:59 *) +let array_to_slice_mut__back + (x : array u32 32) (ret : slice u32) : result (array u32 32) = + array_from_slice u32 32 x ret + +(** [array::array_subslice_shared_]: forward function + Source: 'src/array.rs', lines 80:0-80:74 *) +let array_subslice_shared_ + (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = + core_array_Array_index u32 (core_ops_range_Range usize) 32 + (core_ops_index_IndexSliceTIInst u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x + { start = y; end_ = z } + +(** [array::array_subslice_mut_]: forward function + Source: 'src/array.rs', lines 84:0-84:79 *) +let array_subslice_mut_ + (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = + core_array_Array_index_mut u32 (core_ops_range_Range usize) 32 + (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x + { start = y; end_ = z } + +(** [array::array_subslice_mut_]: backward function 0 + Source: 'src/array.rs', lines 84:0-84:79 *) +let array_subslice_mut__back + (x : array u32 32) (y : usize) (z : usize) (ret : slice u32) : + result (array u32 32) + = + core_array_Array_index_mut_back u32 (core_ops_range_Range usize) 32 + (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x + { start = y; end_ = z } ret + +(** [array::index_slice_0]: forward function + Source: 'src/array.rs', lines 88:0-88:38 *) +let index_slice_0 (t : Type0) (s : slice t) : result t = + slice_index_usize t s 0 + +(** [array::index_array_0]: forward function + Source: 'src/array.rs', lines 92:0-92:42 *) +let index_array_0 (t : Type0) (s : array t 32) : result t = + array_index_usize t 32 s 0 + +(** [array::index_index_array]: forward function + Source: 'src/array.rs', lines 103:0-103:71 *) +let index_index_array + (s : array (array u32 32) 32) (i : usize) (j : usize) : result u32 = + let* a = array_index_usize (array u32 32) 32 s i in + array_index_usize u32 32 a j + +(** [array::update_update_array]: forward function + Source: 'src/array.rs', lines 114:0-114:70 *) +let update_update_array + (s : array (array u32 32) 32) (i : usize) (j : usize) : result unit = + let* a = array_index_usize (array u32 32) 32 s i in + let* a1 = array_update_usize u32 32 a j 0 in + let* _ = array_update_usize (array u32 32) 32 s i a1 in + Return () + +(** [array::array_local_deep_copy]: forward function + Source: 'src/array.rs', lines 118:0-118:43 *) +let array_local_deep_copy (x : array u32 32) : result unit = + Return () + +(** [array::take_array]: forward function + Source: 'src/array.rs', lines 122:0-122:30 *) +let take_array (a : array u32 2) : result unit = + Return () + +(** [array::take_array_borrow]: forward function + Source: 'src/array.rs', lines 123:0-123:38 *) +let take_array_borrow (a : array u32 2) : result unit = + Return () + +(** [array::take_slice]: forward function + Source: 'src/array.rs', lines 124:0-124:28 *) +let take_slice (s : slice u32) : result unit = + Return () + +(** [array::take_mut_slice]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/array.rs', lines 125:0-125:36 *) +let take_mut_slice (s : slice u32) : result (slice u32) = + Return s + +(** [array::const_array]: forward function + Source: 'src/array.rs', lines 127:0-127:32 *) +let const_array : result (array u32 2) = + Return (mk_array u32 2 [ 0; 0 ]) + +(** [array::const_slice]: forward function + Source: 'src/array.rs', lines 131:0-131:20 *) +let const_slice : result unit = + let* _ = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in Return () + +(** [array::take_all]: forward function + Source: 'src/array.rs', lines 141:0-141:17 *) +let take_all : result unit = + let* _ = take_array (mk_array u32 2 [ 0; 0 ]) in + let* _ = take_array_borrow (mk_array u32 2 [ 0; 0 ]) in + let* s = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* _ = take_slice s in + let* s1 = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* s2 = take_mut_slice s1 in + let* _ = array_from_slice u32 2 (mk_array u32 2 [ 0; 0 ]) s2 in + Return () + +(** [array::index_array]: forward function + Source: 'src/array.rs', lines 155:0-155:38 *) +let index_array (x : array u32 2) : result u32 = + array_index_usize u32 2 x 0 + +(** [array::index_array_borrow]: forward function + Source: 'src/array.rs', lines 158:0-158:46 *) +let index_array_borrow (x : array u32 2) : result u32 = + array_index_usize u32 2 x 0 + +(** [array::index_slice_u32_0]: forward function + Source: 'src/array.rs', lines 162:0-162:42 *) +let index_slice_u32_0 (x : slice u32) : result u32 = + slice_index_usize u32 x 0 + +(** [array::index_mut_slice_u32_0]: forward function + Source: 'src/array.rs', lines 166:0-166:50 *) +let index_mut_slice_u32_0 (x : slice u32) : result u32 = + slice_index_usize u32 x 0 + +(** [array::index_mut_slice_u32_0]: backward function 0 + Source: 'src/array.rs', lines 166:0-166:50 *) +let index_mut_slice_u32_0_back (x : slice u32) : result (slice u32) = + let* _ = slice_index_usize u32 x 0 in Return x + +(** [array::index_all]: forward function + Source: 'src/array.rs', lines 170:0-170:25 *) +let index_all : result u32 = + let* i = index_array (mk_array u32 2 [ 0; 0 ]) in + let* i1 = index_array (mk_array u32 2 [ 0; 0 ]) in + let* i2 = u32_add i i1 in + let* i3 = index_array_borrow (mk_array u32 2 [ 0; 0 ]) in + let* i4 = u32_add i2 i3 in + let* s = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* i5 = index_slice_u32_0 s in + let* i6 = u32_add i4 i5 in + let* s1 = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* i7 = index_mut_slice_u32_0 s1 in + let* i8 = u32_add i6 i7 in + let* s2 = index_mut_slice_u32_0_back s1 in + let* _ = array_from_slice u32 2 (mk_array u32 2 [ 0; 0 ]) s2 in + Return i8 + +(** [array::update_array]: forward function + Source: 'src/array.rs', lines 184:0-184:36 *) +let update_array (x : array u32 2) : result unit = + let* _ = array_update_usize u32 2 x 0 1 in Return () + +(** [array::update_array_mut_borrow]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/array.rs', lines 187:0-187:48 *) +let update_array_mut_borrow (x : array u32 2) : result (array u32 2) = + array_update_usize u32 2 x 0 1 + +(** [array::update_mut_slice]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/array.rs', lines 190:0-190:38 *) +let update_mut_slice (x : slice u32) : result (slice u32) = + slice_update_usize u32 x 0 1 + +(** [array::update_all]: forward function + Source: 'src/array.rs', lines 194:0-194:19 *) +let update_all : result unit = + let* _ = update_array (mk_array u32 2 [ 0; 0 ]) in + let* x = update_array_mut_borrow (mk_array u32 2 [ 0; 0 ]) in + let* s = array_to_slice u32 2 x in + let* s1 = update_mut_slice s in + let* _ = array_from_slice u32 2 x s1 in + Return () + +(** [array::range_all]: forward function + Source: 'src/array.rs', lines 205:0-205:18 *) +let range_all : result unit = + let* s = + core_array_Array_index_mut u32 (core_ops_range_Range usize) 4 + (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) + (mk_array u32 4 [ 0; 0; 0; 0 ]) { start = 1; end_ = 3 } in + let* s1 = update_mut_slice s in + let* _ = + core_array_Array_index_mut_back u32 (core_ops_range_Range usize) 4 + (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) + (mk_array u32 4 [ 0; 0; 0; 0 ]) { start = 1; end_ = 3 } s1 in + Return () + +(** [array::deref_array_borrow]: forward function + Source: 'src/array.rs', lines 214:0-214:46 *) +let deref_array_borrow (x : array u32 2) : result u32 = + array_index_usize u32 2 x 0 + +(** [array::deref_array_mut_borrow]: forward function + Source: 'src/array.rs', lines 219:0-219:54 *) +let deref_array_mut_borrow (x : array u32 2) : result u32 = + array_index_usize u32 2 x 0 + +(** [array::deref_array_mut_borrow]: backward function 0 + Source: 'src/array.rs', lines 219:0-219:54 *) +let deref_array_mut_borrow_back (x : array u32 2) : result (array u32 2) = + let* _ = array_index_usize u32 2 x 0 in Return x + +(** [array::take_array_t]: forward function + Source: 'src/array.rs', lines 227:0-227:31 *) +let take_array_t (a : array aB_t 2) : result unit = + Return () + +(** [array::non_copyable_array]: forward function + Source: 'src/array.rs', lines 229:0-229:27 *) +let non_copyable_array : result unit = + let* _ = take_array_t (mk_array aB_t 2 [ AB_A; AB_B ]) in Return () + +(** [array::sum]: loop 0: forward function + Source: 'src/array.rs', lines 242:0-250:1 *) +let rec sum_loop + (s : slice u32) (sum1 : u32) (i : usize) : + Tot (result u32) (decreases (sum_loop_decreases s sum1 i)) + = + let i1 = slice_len u32 s in + if i < i1 + then + let* i2 = slice_index_usize u32 s i in + let* sum3 = u32_add sum1 i2 in + let* i3 = usize_add i 1 in + sum_loop s sum3 i3 + else Return sum1 + +(** [array::sum]: forward function + Source: 'src/array.rs', lines 242:0-242:28 *) +let sum (s : slice u32) : result u32 = + sum_loop s 0 0 + +(** [array::sum2]: loop 0: forward function + Source: 'src/array.rs', lines 252:0-261:1 *) +let rec sum2_loop + (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) : + Tot (result u32) (decreases (sum2_loop_decreases s s2 sum1 i)) + = + let i1 = slice_len u32 s in + if i < i1 + then + let* i2 = slice_index_usize u32 s i in + let* i3 = slice_index_usize u32 s2 i in + let* i4 = u32_add i2 i3 in + let* sum3 = u32_add sum1 i4 in + let* i5 = usize_add i 1 in + sum2_loop s s2 sum3 i5 + else Return sum1 + +(** [array::sum2]: forward function + Source: 'src/array.rs', lines 252:0-252:41 *) +let sum2 (s : slice u32) (s2 : slice u32) : result u32 = + let i = slice_len u32 s in + let i1 = slice_len u32 s2 in + if not (i = i1) then Fail Failure else sum2_loop s s2 0 0 + +(** [array::f0]: forward function + Source: 'src/array.rs', lines 263:0-263:11 *) +let f0 : result unit = + let* s = array_to_slice u32 2 (mk_array u32 2 [ 1; 2 ]) in + let* s1 = slice_update_usize u32 s 0 1 in + let* _ = array_from_slice u32 2 (mk_array u32 2 [ 1; 2 ]) s1 in + Return () + +(** [array::f1]: forward function + Source: 'src/array.rs', lines 268:0-268:11 *) +let f1 : result unit = + let* _ = array_update_usize u32 2 (mk_array u32 2 [ 1; 2 ]) 0 1 in Return () + +(** [array::f2]: forward function + Source: 'src/array.rs', lines 273:0-273:17 *) +let f2 (i : u32) : result unit = + Return () + +(** [array::f4]: forward function + Source: 'src/array.rs', lines 282:0-282:54 *) +let f4 (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = + core_array_Array_index u32 (core_ops_range_Range usize) 32 + (core_ops_index_IndexSliceTIInst u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x + { start = y; end_ = z } + +(** [array::f3]: forward function + Source: 'src/array.rs', lines 275:0-275:18 *) +let f3 : result u32 = + let* i = array_index_usize u32 2 (mk_array u32 2 [ 1; 2 ]) 0 in + let* _ = f2 i in + let b = array_repeat u32 32 0 in + let* s = array_to_slice u32 2 (mk_array u32 2 [ 1; 2 ]) in + let* s1 = f4 b 16 18 in + sum2 s s1 + +(** [array::SZ] + Source: 'src/array.rs', lines 286:0-286:19 *) +let sz_body : result usize = Return 32 +let sz_c : usize = eval_global sz_body + +(** [array::f5]: forward function + Source: 'src/array.rs', lines 289:0-289:31 *) +let f5 (x : array u32 32) : result u32 = + array_index_usize u32 32 x 0 + +(** [array::ite]: forward function + Source: 'src/array.rs', lines 294:0-294:12 *) +let ite : result unit = + let* s = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* s1 = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* s2 = index_mut_slice_u32_0_back s1 in + let* _ = array_from_slice u32 2 (mk_array u32 2 [ 0; 0 ]) s2 in + let* s3 = index_mut_slice_u32_0_back s in + let* _ = array_from_slice u32 2 (mk_array u32 2 [ 0; 0 ]) s3 in + Return () + diff --git a/tests/fstar-split/array/Array.Types.fst b/tests/fstar-split/array/Array.Types.fst new file mode 100644 index 00000000..312f6018 --- /dev/null +++ b/tests/fstar-split/array/Array.Types.fst @@ -0,0 +1,11 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [array]: type definitions *) +module Array.Types +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [array::AB] + Source: 'src/array.rs', lines 3:0-3:11 *) +type aB_t = | AB_A : aB_t | AB_B : aB_t + diff --git a/tests/fstar-split/array/Makefile b/tests/fstar-split/array/Makefile new file mode 100644 index 00000000..fa7d1f36 --- /dev/null +++ b/tests/fstar-split/array/Makefile @@ -0,0 +1,49 @@ +# This file was automatically generated - modify ../Makefile.template instead +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_EXE ?= fstar.exe +FSTAR_NO_FLAGS = $(FSTAR_EXE) --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/tests/fstar-split/array/Primitives.fst b/tests/fstar-split/array/Primitives.fst new file mode 100644 index 00000000..a3ffbde4 --- /dev/null +++ b/tests/fstar-split/array/Primitives.fst @@ -0,0 +1,884 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v + +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure +let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_RangeUsize_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_RangeUsize_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_mut_back = core_slice_index_RangeUsize_get_mut_back t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; + index_mut_back = core_slice_index_RangeUsize_index_mut_back t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] + = + admit() diff --git a/tests/fstar-split/betree/BetreeMain.Clauses.Template.fst b/tests/fstar-split/betree/BetreeMain.Clauses.Template.fst new file mode 100644 index 00000000..537705c5 --- /dev/null +++ b/tests/fstar-split/betree/BetreeMain.Clauses.Template.fst @@ -0,0 +1,117 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [betree_main]: templates for the decreases clauses *) +module BetreeMain.Clauses.Template +open Primitives +open BetreeMain.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [betree_main::betree::{betree_main::betree::List#1}::len]: decreases clause + Source: 'src/betree.rs', lines 276:4-276:24 *) +unfold +let betree_List_len_decreases (t : Type0) (self : betree_List_t t) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::List#1}::split_at]: decreases clause + Source: 'src/betree.rs', lines 284:4-284:51 *) +unfold +let betree_List_split_at_decreases (t : Type0) (self : betree_List_t t) + (n : u64) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: decreases clause + Source: 'src/betree.rs', lines 339:4-339:73 *) +unfold +let betree_ListTupleU64T_partition_at_pivot_decreases (t : Type0) + (self : betree_List_t (u64 & t)) (pivot : u64) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: decreases clause + Source: 'src/betree.rs', lines 789:4-792:34 *) +unfold +let betree_Node_lookup_first_message_for_key_decreases (key : u64) + (msgs : betree_List_t (u64 & betree_Message_t)) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: decreases clause + Source: 'src/betree.rs', lines 636:4-636:80 *) +unfold +let betree_Node_lookup_in_bindings_decreases (key : u64) + (bindings : betree_List_t (u64 & u64)) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: decreases clause + Source: 'src/betree.rs', lines 819:4-819:90 *) +unfold +let betree_Node_apply_upserts_decreases + (msgs : betree_List_t (u64 & betree_Message_t)) (prev : option u64) + (key : u64) (st : state) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: decreases clause + Source: 'src/betree.rs', lines 395:4-395:63 *) +unfold +let betree_Internal_lookup_in_children_decreases (self : betree_Internal_t) + (key : u64) (st : state) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: decreases clause + Source: 'src/betree.rs', lines 709:4-709:58 *) +unfold +let betree_Node_lookup_decreases (self : betree_Node_t) (key : u64) + (st : state) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: decreases clause + Source: 'src/betree.rs', lines 674:4-674:77 *) +unfold +let betree_Node_filter_messages_for_key_decreases (key : u64) + (msgs : betree_List_t (u64 & betree_Message_t)) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: decreases clause + Source: 'src/betree.rs', lines 689:4-692:34 *) +unfold +let betree_Node_lookup_first_message_after_key_decreases (key : u64) + (msgs : betree_List_t (u64 & betree_Message_t)) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_internal]: decreases clause + Source: 'src/betree.rs', lines 502:4-505:5 *) +unfold +let betree_Node_apply_messages_to_internal_decreases + (msgs : betree_List_t (u64 & betree_Message_t)) + (new_msgs : betree_List_t (u64 & betree_Message_t)) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: decreases clause + Source: 'src/betree.rs', lines 653:4-656:32 *) +unfold +let betree_Node_lookup_mut_in_bindings_decreases (key : u64) + (bindings : betree_List_t (u64 & u64)) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_leaf]: decreases clause + Source: 'src/betree.rs', lines 444:4-447:5 *) +unfold +let betree_Node_apply_messages_to_leaf_decreases + (bindings : betree_List_t (u64 & u64)) + (new_msgs : betree_List_t (u64 & betree_Message_t)) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: decreases clause + Source: 'src/betree.rs', lines 410:4-415:26 *) +unfold +let betree_Internal_flush_decreases (self : betree_Internal_t) + (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) + (content : betree_List_t (u64 & betree_Message_t)) (st : state) : nat = + admit () + +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: decreases clause + Source: 'src/betree.rs', lines 588:4-593:5 *) +unfold +let betree_Node_apply_messages_decreases (self : betree_Node_t) + (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) + (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) : nat = + admit () + diff --git a/tests/fstar-split/betree/BetreeMain.Clauses.fst b/tests/fstar-split/betree/BetreeMain.Clauses.fst new file mode 100644 index 00000000..21f953d1 --- /dev/null +++ b/tests/fstar-split/betree/BetreeMain.Clauses.fst @@ -0,0 +1,210 @@ +(** [betree_main]: templates for the decreases clauses *) +module BetreeMain.Clauses +open Primitives +open BetreeMain.Types + +#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" + +(*** Well-founded relations *) + +(* We had a few issues when proving termination of the mutually recursive functions: + * - betree_Internal_flush + * - betree_Node_apply_messages + * + * The quantity which effectively decreases is: + * (betree_size, messages_length) + * where messages_length is 0 when there are no messages + * (and where we use the lexicographic ordering, of course) + * + * However, the `%[...]` and `{:well-founded ...} notations are not available outside + * of `decrease` clauses. + * + * We thus resorted to writing and proving correct a well-founded relation over + * pairs of natural numbers. The trick is that `<<` can be used outside of decrease + * clauses, and can be used to trigger SMT patterns. + * + * What follows is adapted from: + * https://www.fstar-lang.org/tutorial/book/part2/part2_well_founded.html + * + * Also, the following PR might make things easier: + * https://github.com/FStarLang/FStar/pull/2561 + *) + +module P = FStar.Preorder +module W = FStar.WellFounded +module L = FStar.LexicographicOrdering + +let lt_nat (x y:nat) : Type = x < y == true +let rec wf_lt_nat (x:nat) + : W.acc lt_nat x + = W.AccIntro (fun y _ -> wf_lt_nat y) + +// A type abbreviation for a pair of nats +let nat_pair = (x:nat & nat) + +// Making a lexicographic ordering from a pair of nat ordering +let lex_order_nat_pair : P.relation nat_pair = + L.lex_t lt_nat (fun _ -> lt_nat) + +// The lex order on nat pairs is well-founded, using our general proof +// of lexicographic composition of well-founded orders +let lex_order_nat_pair_wf : W.well_founded lex_order_nat_pair = + L.lex_t_wf wf_lt_nat (fun _ -> wf_lt_nat) + +// A utility to introduce lt_nat +let mk_lt_nat (x:nat) (y:nat { x < y }) : lt_nat x y = + let _ : equals (x < y) true = Refl in + () + +// A utility to make a lex ordering of nat pairs +let mk_lex_order_nat_pair (xy0:nat_pair) + (xy1:nat_pair { + let (|x0, y0|) = xy0 in + let (|x1, y1|) = xy1 in + x0 < x1 \/ (x0 == x1 /\ y0 < y1) + }) : lex_order_nat_pair xy0 xy1 = + let (|x0, y0|) = xy0 in + let (|x1, y1|) = xy1 in + if x0 < x1 then L.Left_lex x0 x1 y0 y1 (mk_lt_nat x0 x1) + else L.Right_lex x0 y0 y1 (mk_lt_nat y0 y1) + +let rec coerce #a #r #x (p:W.acc #a r x) : Tot (W.acc r x) (decreases p) = + W.AccIntro (fun y r -> coerce (p.access_smaller y r)) + +let coerce_wf #a #r (p: (x:a -> W.acc r x)) : x:a -> W.acc r x = + fun x -> coerce (p x) + +(* We need this axiom, which comes from the following discussion: + * https://github.com/FStarLang/FStar/issues/1916 + * An issue here is that the `{well-founded ... }` notation + *) +assume +val axiom_well_founded (a : Type) (rel : a -> a -> Type0) + (rwf : W.well_founded #a rel) (x y : a) : + Lemma (requires (rel x y)) (ensures (x << y)) + +(* This lemma has a pattern (which makes it work) *) +let wf_nat_pair_lem (p0 p1 : nat_pair) : + Lemma + (requires ( + let (|x0, y0|) = p0 in + let (|x1, y1|) = p1 in + x0 < x1 || (x0 = x1 && y0 < y1))) + (ensures (p0 << p1)) + [SMTPat (p0 << p1)] = + let rel = lex_order_nat_pair in + let rel_wf = lex_order_nat_pair_wf in + let _ = mk_lex_order_nat_pair p0 p1 in + assert(rel p0 p1); + axiom_well_founded nat_pair rel rel_wf p0 p1 + +(*** Decrease clauses *) +/// "Standard" decrease clauses + +(** [betree_main::betree::List::{1}::len]: decreases clause *) +unfold +let betree_List_len_decreases (t : Type0) (self : betree_List_t t) : betree_List_t t = + self + +(** [betree_main::betree::List::{1}::split_at]: decreases clause *) +unfold +let betree_List_split_at_decreases (t : Type0) (self : betree_List_t t) + (n : u64) : nat = + n + +(** [betree_main::betree::List::{2}::partition_at_pivot]: decreases clause *) +unfold +let betree_ListTupleU64T_partition_at_pivot_decreases (t : Type0) + (self : betree_List_t (u64 & t)) (pivot : u64) : betree_List_t (u64 & t) = + self + +(** [betree_main::betree::Node::{5}::lookup_in_bindings]: decreases clause *) +unfold +let betree_Node_lookup_in_bindings_decreases (key : u64) + (bindings : betree_List_t (u64 & u64)) : betree_List_t (u64 & u64) = + bindings + +(** [betree_main::betree::Node::{5}::lookup_first_message_for_key]: decreases clause *) +unfold +let betree_Node_lookup_first_message_for_key_decreases (key : u64) + (msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = + msgs + +(** [betree_main::betree::Node::{5}::apply_upserts]: decreases clause *) +unfold +let betree_Node_apply_upserts_decreases + (msgs : betree_List_t (u64 & betree_Message_t)) (prev : option u64) + (key : u64) (st : state) : betree_List_t (u64 & betree_Message_t) = + msgs + +(** [betree_main::betree::Internal::{4}::lookup_in_children]: decreases clause *) +unfold +let betree_Internal_lookup_in_children_decreases (self : betree_Internal_t) + (key : u64) (st : state) : betree_Internal_t = + self + +(** [betree_main::betree::Node::{5}::lookup]: decreases clause *) +unfold +let betree_Node_lookup_decreases (self : betree_Node_t) (key : u64) + (st : state) : betree_Node_t = + self + +(** [betree_main::betree::Node::{5}::lookup_mut_in_bindings]: decreases clause *) +unfold +let betree_Node_lookup_mut_in_bindings_decreases (key : u64) + (bindings : betree_List_t (u64 & u64)) : betree_List_t (u64 & u64) = + bindings + +unfold +let betree_Node_apply_messages_to_leaf_decreases + (bindings : betree_List_t (u64 & u64)) + (new_msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = + new_msgs + +(** [betree_main::betree::Node::{5}::filter_messages_for_key]: decreases clause *) +unfold +let betree_Node_filter_messages_for_key_decreases (key : u64) + (msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = + msgs + +(** [betree_main::betree::Node::{5}::lookup_first_message_after_key]: decreases clause *) +unfold +let betree_Node_lookup_first_message_after_key_decreases (key : u64) + (msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = + msgs + +let betree_Node_apply_messages_to_internal_decreases + (msgs : betree_List_t (u64 & betree_Message_t)) + (new_msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = + new_msgs + +(*** Decrease clauses - nat_pair *) +/// The following decrease clauses use the [nat_pair] definition and the well-founded +/// relation proven above. + +let rec betree_size (bt : betree_Node_t) : nat = + match bt with + | Betree_Node_Internal node -> 1 + betree_Internal_size node + | Betree_Node_Leaf _ -> 1 + +and betree_Internal_size (node : betree_Internal_t) : nat = + 1 + betree_size node.left + betree_size node.right + +let rec betree_List_len (#a : Type0) (ls : betree_List_t a) : nat = + match ls with + | Betree_List_Cons _ tl -> 1 + betree_List_len tl + | Betree_List_Nil -> 0 + +(** [betree_main::betree::Internal::{4}::flush]: decreases clause *) +unfold +let betree_Internal_flush_decreases (self : betree_Internal_t) + (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) + (content : betree_List_t (u64 & betree_Message_t)) (st : state) : nat_pair = + (|betree_Internal_size self, 0|) + +(** [betree_main::betree::Node::{5}::apply_messages]: decreases clause *) +unfold +let betree_Node_apply_messages_decreases (self : betree_Node_t) + (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) + (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) : nat_pair = + (|betree_size self, betree_List_len msgs|) diff --git a/tests/fstar-split/betree/BetreeMain.Funs.fst b/tests/fstar-split/betree/BetreeMain.Funs.fst new file mode 100644 index 00000000..6890488a --- /dev/null +++ b/tests/fstar-split/betree/BetreeMain.Funs.fst @@ -0,0 +1,1011 @@ +(** 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#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#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 + let l = ls0 in + Return (Betree_List_Cons hd l, ls1) + | Betree_List_Nil -> Fail Failure + end + +(** [betree_main::betree::{betree_main::betree::List#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 + let l = tl in + Return (Betree_List_Cons x l) + +(** [betree_main::betree::{betree_main::betree::List#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#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#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 + let l = ls0 in + Return (Betree_List_Cons (i, x) l, 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 l = Betree_List_Nil in + let* (st1, _) = + betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, + new_msg) l) st in + let* _ = + betree_Node_apply_messages_back self params node_id_cnt (Betree_List_Cons + (key, new_msg) l) 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) + = + let l = Betree_List_Nil in + betree_Node_apply_messages_back self params node_id_cnt (Betree_List_Cons + (key, new_msg) l) 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 ()) + diff --git a/tests/fstar-split/betree/BetreeMain.FunsExternal.fsti b/tests/fstar-split/betree/BetreeMain.FunsExternal.fsti new file mode 100644 index 00000000..cd2f956f --- /dev/null +++ b/tests/fstar-split/betree/BetreeMain.FunsExternal.fsti @@ -0,0 +1,35 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [betree_main]: external function declarations *) +module BetreeMain.FunsExternal +open Primitives +include BetreeMain.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [betree_main::betree_utils::load_internal_node]: forward function + Source: 'src/betree_utils.rs', lines 98:0-98:63 *) +val betree_utils_load_internal_node + : u64 -> state -> result (state & (betree_List_t (u64 & betree_Message_t))) + +(** [betree_main::betree_utils::store_internal_node]: forward function + Source: 'src/betree_utils.rs', lines 115:0-115:71 *) +val betree_utils_store_internal_node + : + u64 -> betree_List_t (u64 & betree_Message_t) -> state -> result (state & + unit) + +(** [betree_main::betree_utils::load_leaf_node]: forward function + Source: 'src/betree_utils.rs', lines 132:0-132:55 *) +val betree_utils_load_leaf_node + : u64 -> state -> result (state & (betree_List_t (u64 & u64))) + +(** [betree_main::betree_utils::store_leaf_node]: forward function + Source: 'src/betree_utils.rs', lines 145:0-145:63 *) +val betree_utils_store_leaf_node + : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit) + +(** [core::option::{core::option::Option}::unwrap]: forward function + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) +val core_option_Option_unwrap + (t : Type0) : option t -> state -> result (state & t) + diff --git a/tests/fstar-split/betree/BetreeMain.Types.fst b/tests/fstar-split/betree/BetreeMain.Types.fst new file mode 100644 index 00000000..b87219b2 --- /dev/null +++ b/tests/fstar-split/betree/BetreeMain.Types.fst @@ -0,0 +1,61 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [betree_main]: type definitions *) +module BetreeMain.Types +open Primitives +include BetreeMain.TypesExternal + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [betree_main::betree::List] + Source: 'src/betree.rs', lines 17:0-17:23 *) +type betree_List_t (t : Type0) = +| Betree_List_Cons : t -> betree_List_t t -> betree_List_t t +| Betree_List_Nil : betree_List_t t + +(** [betree_main::betree::UpsertFunState] + Source: 'src/betree.rs', lines 63:0-63:23 *) +type betree_UpsertFunState_t = +| Betree_UpsertFunState_Add : u64 -> betree_UpsertFunState_t +| Betree_UpsertFunState_Sub : u64 -> betree_UpsertFunState_t + +(** [betree_main::betree::Message] + Source: 'src/betree.rs', lines 69:0-69:23 *) +type betree_Message_t = +| Betree_Message_Insert : u64 -> betree_Message_t +| Betree_Message_Delete : betree_Message_t +| Betree_Message_Upsert : betree_UpsertFunState_t -> betree_Message_t + +(** [betree_main::betree::Leaf] + Source: 'src/betree.rs', lines 167:0-167:11 *) +type betree_Leaf_t = { id : u64; size : u64; } + +(** [betree_main::betree::Internal] + Source: 'src/betree.rs', lines 156:0-156:15 *) +type betree_Internal_t = +{ + id : u64; pivot : u64; left : betree_Node_t; right : betree_Node_t; +} + +(** [betree_main::betree::Node] + Source: 'src/betree.rs', lines 179:0-179:9 *) +and betree_Node_t = +| Betree_Node_Internal : betree_Internal_t -> betree_Node_t +| Betree_Node_Leaf : betree_Leaf_t -> betree_Node_t + +(** [betree_main::betree::Params] + Source: 'src/betree.rs', lines 187:0-187:13 *) +type betree_Params_t = { min_flush_size : u64; split_size : u64; } + +(** [betree_main::betree::NodeIdCounter] + Source: 'src/betree.rs', lines 201:0-201:20 *) +type betree_NodeIdCounter_t = { next_node_id : u64; } + +(** [betree_main::betree::BeTree] + Source: 'src/betree.rs', lines 218:0-218:17 *) +type betree_BeTree_t = +{ + params : betree_Params_t; + node_id_cnt : betree_NodeIdCounter_t; + root : betree_Node_t; +} + diff --git a/tests/fstar-split/betree/BetreeMain.TypesExternal.fsti b/tests/fstar-split/betree/BetreeMain.TypesExternal.fsti new file mode 100644 index 00000000..1b2c53a6 --- /dev/null +++ b/tests/fstar-split/betree/BetreeMain.TypesExternal.fsti @@ -0,0 +1,10 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [betree_main]: external type declarations *) +module BetreeMain.TypesExternal +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** The state type used in the state-error monad *) +val state : Type0 + diff --git a/tests/fstar-split/betree/Makefile b/tests/fstar-split/betree/Makefile new file mode 100644 index 00000000..fa7d1f36 --- /dev/null +++ b/tests/fstar-split/betree/Makefile @@ -0,0 +1,49 @@ +# This file was automatically generated - modify ../Makefile.template instead +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_EXE ?= fstar.exe +FSTAR_NO_FLAGS = $(FSTAR_EXE) --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/tests/fstar-split/betree/Primitives.fst b/tests/fstar-split/betree/Primitives.fst new file mode 100644 index 00000000..a3ffbde4 --- /dev/null +++ b/tests/fstar-split/betree/Primitives.fst @@ -0,0 +1,884 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v + +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure +let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_RangeUsize_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_RangeUsize_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_mut_back = core_slice_index_RangeUsize_get_mut_back t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; + index_mut_back = core_slice_index_RangeUsize_index_mut_back t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] + = + admit() diff --git a/tests/fstar-split/hashmap/Hashmap.Clauses.Template.fst b/tests/fstar-split/hashmap/Hashmap.Clauses.Template.fst new file mode 100644 index 00000000..2733b371 --- /dev/null +++ b/tests/fstar-split/hashmap/Hashmap.Clauses.Template.fst @@ -0,0 +1,71 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [hashmap]: templates for the decreases clauses *) +module Hashmap.Clauses.Template +open Primitives +open Hashmap.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [hashmap::{hashmap::HashMap}::allocate_slots]: decreases clause + Source: 'src/hashmap.rs', lines 50:4-56:5 *) +unfold +let hashMap_allocate_slots_loop_decreases (t : Type0) + (slots : alloc_vec_Vec (list_t t)) (n : usize) : nat = + admit () + +(** [hashmap::{hashmap::HashMap}::clear]: decreases clause + Source: 'src/hashmap.rs', lines 80:4-88:5 *) +unfold +let hashMap_clear_loop_decreases (t : Type0) (slots : alloc_vec_Vec (list_t t)) + (i : usize) : nat = + admit () + +(** [hashmap::{hashmap::HashMap}::insert_in_list]: decreases clause + Source: 'src/hashmap.rs', lines 97:4-114:5 *) +unfold +let hashMap_insert_in_list_loop_decreases (t : Type0) (key : usize) (value : t) + (ls : list_t t) : nat = + admit () + +(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: decreases clause + Source: 'src/hashmap.rs', lines 183:4-196:5 *) +unfold +let hashMap_move_elements_from_list_loop_decreases (t : Type0) + (ntable : hashMap_t t) (ls : list_t t) : nat = + admit () + +(** [hashmap::{hashmap::HashMap}::move_elements]: decreases clause + Source: 'src/hashmap.rs', lines 171:4-180:5 *) +unfold +let hashMap_move_elements_loop_decreases (t : Type0) (ntable : hashMap_t t) + (slots : alloc_vec_Vec (list_t t)) (i : usize) : nat = + admit () + +(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: decreases clause + Source: 'src/hashmap.rs', lines 206:4-219:5 *) +unfold +let hashMap_contains_key_in_list_loop_decreases (t : Type0) (key : usize) + (ls : list_t t) : nat = + admit () + +(** [hashmap::{hashmap::HashMap}::get_in_list]: decreases clause + Source: 'src/hashmap.rs', lines 224:4-237:5 *) +unfold +let hashMap_get_in_list_loop_decreases (t : Type0) (key : usize) + (ls : list_t t) : nat = + admit () + +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: decreases clause + Source: 'src/hashmap.rs', lines 245:4-254:5 *) +unfold +let hashMap_get_mut_in_list_loop_decreases (t : Type0) (ls : list_t t) + (key : usize) : nat = + admit () + +(** [hashmap::{hashmap::HashMap}::remove_from_list]: decreases clause + Source: 'src/hashmap.rs', lines 265:4-291:5 *) +unfold +let hashMap_remove_from_list_loop_decreases (t : Type0) (key : usize) + (ls : list_t t) : nat = + admit () + diff --git a/tests/fstar-split/hashmap/Hashmap.Clauses.fst b/tests/fstar-split/hashmap/Hashmap.Clauses.fst new file mode 100644 index 00000000..6c699d05 --- /dev/null +++ b/tests/fstar-split/hashmap/Hashmap.Clauses.fst @@ -0,0 +1,61 @@ +(** [hashmap]: the decreases clauses *) +module Hashmap.Clauses +open Primitives +open FStar.List.Tot +open Hashmap.Types + +#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" + +(** [hashmap::HashMap::allocate_slots]: decreases clause *) +unfold +let hashMap_allocate_slots_loop_decreases (t : Type0) + (slots : alloc_vec_Vec (list_t t)) (n : usize) : nat = n + +(** [hashmap::HashMap::clear]: decreases clause *) +unfold +let hashMap_clear_loop_decreases (t : Type0) (slots : alloc_vec_Vec (list_t t)) + (i : usize) : nat = + if i < length slots then length slots - i else 0 + +(** [hashmap::HashMap::insert_in_list]: decreases clause *) +unfold +let hashMap_insert_in_list_loop_decreases (t : Type0) (key : usize) (value : t) + (ls : list_t t) : list_t t = + ls + +(** [hashmap::HashMap::move_elements_from_list]: decreases clause *) +unfold +let hashMap_move_elements_from_list_loop_decreases (t : Type0) + (ntable : hashMap_t t) (ls : list_t t) : list_t t = + ls + +(** [hashmap::HashMap::move_elements]: decreases clause *) +unfold +let hashMap_move_elements_loop_decreases (t : Type0) (ntable : hashMap_t t) + (slots : alloc_vec_Vec (list_t t)) (i : usize) : nat = + if i < length slots then length slots - i else 0 + +(** [hashmap::HashMap::contains_key_in_list]: decreases clause *) +unfold +let hashMap_contains_key_in_list_loop_decreases (t : Type0) (key : usize) + (ls : list_t t) : list_t t = + ls + +(** [hashmap::HashMap::get_in_list]: decreases clause *) +unfold +let hashMap_get_in_list_loop_decreases (t : Type0) (key : usize) (ls : list_t t) : + list_t t = + ls + +(** [hashmap::HashMap::get_mut_in_list]: decreases clause *) +unfold +let hashMap_get_mut_in_list_loop_decreases (t : Type0) (ls : list_t t) + (key : usize) : list_t t = + ls + +(** [hashmap::HashMap::remove_from_list]: decreases clause *) +unfold +let hashMap_remove_from_list_loop_decreases (t : Type0) (key : usize) + (ls : list_t t) : list_t t = + ls + diff --git a/tests/fstar-split/hashmap/Hashmap.Funs.fst b/tests/fstar-split/hashmap/Hashmap.Funs.fst new file mode 100644 index 00000000..79327183 --- /dev/null +++ b/tests/fstar-split/hashmap/Hashmap.Funs.fst @@ -0,0 +1,529 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [hashmap]: function definitions *) +module Hashmap.Funs +open Primitives +include Hashmap.Types +include Hashmap.Clauses + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [hashmap::hash_key]: forward function + Source: 'src/hashmap.rs', lines 27:0-27:32 *) +let hash_key (k : usize) : result usize = + Return k + +(** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: forward function + Source: 'src/hashmap.rs', lines 50:4-56:5 *) +let rec hashMap_allocate_slots_loop + (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : + Tot (result (alloc_vec_Vec (list_t t))) + (decreases (hashMap_allocate_slots_loop_decreases t slots n)) + = + if n > 0 + then + let* slots1 = alloc_vec_Vec_push (list_t t) slots List_Nil in + let* n1 = usize_sub n 1 in + hashMap_allocate_slots_loop t slots1 n1 + else Return slots + +(** [hashmap::{hashmap::HashMap}::allocate_slots]: forward function + Source: 'src/hashmap.rs', lines 50:4-50:76 *) +let hashMap_allocate_slots + (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : + result (alloc_vec_Vec (list_t t)) + = + hashMap_allocate_slots_loop t slots n + +(** [hashmap::{hashmap::HashMap}::new_with_capacity]: forward function + Source: 'src/hashmap.rs', lines 59:4-63:13 *) +let hashMap_new_with_capacity + (t : Type0) (capacity : usize) (max_load_dividend : usize) + (max_load_divisor : usize) : + result (hashMap_t t) + = + let v = alloc_vec_Vec_new (list_t t) in + let* slots = hashMap_allocate_slots t v capacity in + let* i = usize_mul capacity max_load_dividend in + let* i1 = usize_div i max_load_divisor in + Return + { + num_entries = 0; + max_load_factor = (max_load_dividend, max_load_divisor); + max_load = i1; + slots = slots + } + +(** [hashmap::{hashmap::HashMap}::new]: forward function + Source: 'src/hashmap.rs', lines 75:4-75:24 *) +let hashMap_new (t : Type0) : result (hashMap_t t) = + hashMap_new_with_capacity t 32 4 5 + +(** [hashmap::{hashmap::HashMap}::clear]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 80:4-88:5 *) +let rec hashMap_clear_loop + (t : Type0) (slots : alloc_vec_Vec (list_t t)) (i : usize) : + Tot (result (alloc_vec_Vec (list_t t))) + (decreases (hashMap_clear_loop_decreases t slots i)) + = + let i1 = alloc_vec_Vec_len (list_t t) slots in + if i < i1 + then + let* i2 = usize_add i 1 in + let* slots1 = + alloc_vec_Vec_index_mut_back (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i + List_Nil in + hashMap_clear_loop t slots1 i2 + else Return slots + +(** [hashmap::{hashmap::HashMap}::clear]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 80:4-80:27 *) +let hashMap_clear (t : Type0) (self : hashMap_t t) : result (hashMap_t t) = + let* v = hashMap_clear_loop t self.slots 0 in + Return { self with num_entries = 0; slots = v } + +(** [hashmap::{hashmap::HashMap}::len]: forward function + Source: 'src/hashmap.rs', lines 90:4-90:30 *) +let hashMap_len (t : Type0) (self : hashMap_t t) : result usize = + Return self.num_entries + +(** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 97:4-114:5 *) +let rec hashMap_insert_in_list_loop + (t : Type0) (key : usize) (value : t) (ls : list_t t) : + Tot (result bool) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) + = + begin match ls with + | List_Cons ckey _ tl -> + if ckey = key + then Return false + else hashMap_insert_in_list_loop t key value tl + | List_Nil -> Return true + end + +(** [hashmap::{hashmap::HashMap}::insert_in_list]: forward function + Source: 'src/hashmap.rs', lines 97:4-97:71 *) +let hashMap_insert_in_list + (t : Type0) (key : usize) (value : t) (ls : list_t t) : result bool = + hashMap_insert_in_list_loop t key value ls + +(** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: backward function 0 + Source: 'src/hashmap.rs', lines 97:4-114:5 *) +let rec hashMap_insert_in_list_loop_back + (t : Type0) (key : usize) (value : t) (ls : list_t t) : + Tot (result (list_t t)) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) + = + begin match ls with + | List_Cons ckey cvalue tl -> + if ckey = key + then Return (List_Cons ckey value tl) + else + let* tl1 = hashMap_insert_in_list_loop_back t key value tl in + Return (List_Cons ckey cvalue tl1) + | List_Nil -> let l = List_Nil in Return (List_Cons key value l) + end + +(** [hashmap::{hashmap::HashMap}::insert_in_list]: backward function 0 + Source: 'src/hashmap.rs', lines 97:4-97:71 *) +let hashMap_insert_in_list_back + (t : Type0) (key : usize) (value : t) (ls : list_t t) : result (list_t t) = + hashMap_insert_in_list_loop_back t key value ls + +(** [hashmap::{hashmap::HashMap}::insert_no_resize]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 117:4-117:54 *) +let hashMap_insert_no_resize + (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + result (hashMap_t t) + = + let* hash = hash_key key in + let i = alloc_vec_Vec_len (list_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod in + let* inserted = hashMap_insert_in_list t key value l in + if inserted + then + let* i1 = usize_add self.num_entries 1 in + let* l1 = hashMap_insert_in_list_back t key value l in + let* v = + alloc_vec_Vec_index_mut_back (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod l1 in + Return { self with num_entries = i1; slots = v } + else + let* l1 = hashMap_insert_in_list_back t key value l in + let* v = + alloc_vec_Vec_index_mut_back (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod l1 in + Return { self with slots = v } + +(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 183:4-196:5 *) +let rec hashMap_move_elements_from_list_loop + (t : Type0) (ntable : hashMap_t t) (ls : list_t t) : + Tot (result (hashMap_t t)) + (decreases (hashMap_move_elements_from_list_loop_decreases t ntable ls)) + = + begin match ls with + | List_Cons k v tl -> + let* ntable1 = hashMap_insert_no_resize t ntable k v in + hashMap_move_elements_from_list_loop t ntable1 tl + | List_Nil -> Return ntable + end + +(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 183:4-183:72 *) +let hashMap_move_elements_from_list + (t : Type0) (ntable : hashMap_t t) (ls : list_t t) : result (hashMap_t t) = + hashMap_move_elements_from_list_loop t ntable ls + +(** [hashmap::{hashmap::HashMap}::move_elements]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 171:4-180:5 *) +let rec hashMap_move_elements_loop + (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) + (i : usize) : + Tot (result ((hashMap_t t) & (alloc_vec_Vec (list_t t)))) + (decreases (hashMap_move_elements_loop_decreases t ntable slots i)) + = + let i1 = alloc_vec_Vec_len (list_t t) slots in + if i < i1 + then + let* l = + alloc_vec_Vec_index_mut (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i in + let ls = core_mem_replace (list_t t) l List_Nil in + let* ntable1 = hashMap_move_elements_from_list t ntable ls in + let* i2 = usize_add i 1 in + let l1 = core_mem_replace_back (list_t t) l List_Nil in + let* slots1 = + alloc_vec_Vec_index_mut_back (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i l1 in + hashMap_move_elements_loop t ntable1 slots1 i2 + else Return (ntable, slots) + +(** [hashmap::{hashmap::HashMap}::move_elements]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 171:4-171:95 *) +let hashMap_move_elements + (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) + (i : usize) : + result ((hashMap_t t) & (alloc_vec_Vec (list_t t))) + = + hashMap_move_elements_loop t ntable slots i + +(** [hashmap::{hashmap::HashMap}::try_resize]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 140:4-140:28 *) +let hashMap_try_resize + (t : Type0) (self : hashMap_t t) : result (hashMap_t t) = + let* max_usize = scalar_cast U32 Usize core_u32_max in + let capacity = alloc_vec_Vec_len (list_t t) self.slots in + let* n1 = usize_div max_usize 2 in + let (i, i1) = self.max_load_factor in + let* i2 = usize_div n1 i in + if capacity <= i2 + then + let* i3 = usize_mul capacity 2 in + let* ntable = hashMap_new_with_capacity t i3 i i1 in + let* (ntable1, _) = hashMap_move_elements t ntable self.slots 0 in + Return + { ntable1 with num_entries = self.num_entries; max_load_factor = (i, i1) + } + else Return { self with max_load_factor = (i, i1) } + +(** [hashmap::{hashmap::HashMap}::insert]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 129:4-129:48 *) +let hashMap_insert + (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + result (hashMap_t t) + = + let* self1 = hashMap_insert_no_resize t self key value in + let* i = hashMap_len t self1 in + if i > self1.max_load then hashMap_try_resize t self1 else Return self1 + +(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 206:4-219:5 *) +let rec hashMap_contains_key_in_list_loop + (t : Type0) (key : usize) (ls : list_t t) : + Tot (result bool) + (decreases (hashMap_contains_key_in_list_loop_decreases t key ls)) + = + begin match ls with + | List_Cons ckey _ tl -> + if ckey = key + then Return true + else hashMap_contains_key_in_list_loop t key tl + | List_Nil -> Return false + end + +(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: forward function + Source: 'src/hashmap.rs', lines 206:4-206:68 *) +let hashMap_contains_key_in_list + (t : Type0) (key : usize) (ls : list_t t) : result bool = + hashMap_contains_key_in_list_loop t key ls + +(** [hashmap::{hashmap::HashMap}::contains_key]: forward function + Source: 'src/hashmap.rs', lines 199:4-199:49 *) +let hashMap_contains_key + (t : Type0) (self : hashMap_t t) (key : usize) : result bool = + let* hash = hash_key key in + let i = alloc_vec_Vec_len (list_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod in + hashMap_contains_key_in_list t key l + +(** [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 224:4-237:5 *) +let rec hashMap_get_in_list_loop + (t : Type0) (key : usize) (ls : list_t t) : + Tot (result t) (decreases (hashMap_get_in_list_loop_decreases t key ls)) + = + begin match ls with + | List_Cons ckey cvalue tl -> + if ckey = key then Return cvalue else hashMap_get_in_list_loop t key tl + | List_Nil -> Fail Failure + end + +(** [hashmap::{hashmap::HashMap}::get_in_list]: forward function + Source: 'src/hashmap.rs', lines 224:4-224:70 *) +let hashMap_get_in_list (t : Type0) (key : usize) (ls : list_t t) : result t = + hashMap_get_in_list_loop t key ls + +(** [hashmap::{hashmap::HashMap}::get]: forward function + Source: 'src/hashmap.rs', lines 239:4-239:55 *) +let hashMap_get (t : Type0) (self : hashMap_t t) (key : usize) : result t = + let* hash = hash_key key in + let i = alloc_vec_Vec_len (list_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod in + hashMap_get_in_list t key l + +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 245:4-254:5 *) +let rec hashMap_get_mut_in_list_loop + (t : Type0) (ls : list_t t) (key : usize) : + Tot (result t) (decreases (hashMap_get_mut_in_list_loop_decreases t ls key)) + = + begin match ls with + | List_Cons ckey cvalue tl -> + if ckey = key then Return cvalue else hashMap_get_mut_in_list_loop t tl key + | List_Nil -> Fail Failure + end + +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: forward function + Source: 'src/hashmap.rs', lines 245:4-245:86 *) +let hashMap_get_mut_in_list + (t : Type0) (ls : list_t t) (key : usize) : result t = + hashMap_get_mut_in_list_loop t ls key + +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: backward function 0 + Source: 'src/hashmap.rs', lines 245:4-254:5 *) +let rec hashMap_get_mut_in_list_loop_back + (t : Type0) (ls : list_t t) (key : usize) (ret : t) : + Tot (result (list_t t)) + (decreases (hashMap_get_mut_in_list_loop_decreases t ls key)) + = + begin match ls with + | List_Cons ckey cvalue tl -> + if ckey = key + then Return (List_Cons ckey ret tl) + else + let* tl1 = hashMap_get_mut_in_list_loop_back t tl key ret in + Return (List_Cons ckey cvalue tl1) + | List_Nil -> Fail Failure + end + +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: backward function 0 + Source: 'src/hashmap.rs', lines 245:4-245:86 *) +let hashMap_get_mut_in_list_back + (t : Type0) (ls : list_t t) (key : usize) (ret : t) : result (list_t t) = + hashMap_get_mut_in_list_loop_back t ls key ret + +(** [hashmap::{hashmap::HashMap}::get_mut]: forward function + Source: 'src/hashmap.rs', lines 257:4-257:67 *) +let hashMap_get_mut (t : Type0) (self : hashMap_t t) (key : usize) : result t = + let* hash = hash_key key in + let i = alloc_vec_Vec_len (list_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod in + hashMap_get_mut_in_list t l key + +(** [hashmap::{hashmap::HashMap}::get_mut]: backward function 0 + Source: 'src/hashmap.rs', lines 257:4-257:67 *) +let hashMap_get_mut_back + (t : Type0) (self : hashMap_t t) (key : usize) (ret : t) : + result (hashMap_t t) + = + let* hash = hash_key key in + let i = alloc_vec_Vec_len (list_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod in + let* l1 = hashMap_get_mut_in_list_back t l key ret in + let* v = + alloc_vec_Vec_index_mut_back (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod l1 in + Return { self with slots = v } + +(** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 265:4-291:5 *) +let rec hashMap_remove_from_list_loop + (t : Type0) (key : usize) (ls : list_t t) : + Tot (result (option t)) + (decreases (hashMap_remove_from_list_loop_decreases t key ls)) + = + begin match ls with + | List_Cons ckey x tl -> + if ckey = key + then + let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in + begin match mv_ls with + | List_Cons _ cvalue _ -> Return (Some cvalue) + | List_Nil -> Fail Failure + end + else hashMap_remove_from_list_loop t key tl + | List_Nil -> Return None + end + +(** [hashmap::{hashmap::HashMap}::remove_from_list]: forward function + Source: 'src/hashmap.rs', lines 265:4-265:69 *) +let hashMap_remove_from_list + (t : Type0) (key : usize) (ls : list_t t) : result (option t) = + hashMap_remove_from_list_loop t key ls + +(** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: backward function 1 + Source: 'src/hashmap.rs', lines 265:4-291:5 *) +let rec hashMap_remove_from_list_loop_back + (t : Type0) (key : usize) (ls : list_t t) : + Tot (result (list_t t)) + (decreases (hashMap_remove_from_list_loop_decreases t key ls)) + = + begin match ls with + | List_Cons ckey x tl -> + if ckey = key + then + let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in + begin match mv_ls with + | List_Cons _ _ tl1 -> Return tl1 + | List_Nil -> Fail Failure + end + else + let* tl1 = hashMap_remove_from_list_loop_back t key tl in + Return (List_Cons ckey x tl1) + | List_Nil -> Return List_Nil + end + +(** [hashmap::{hashmap::HashMap}::remove_from_list]: backward function 1 + Source: 'src/hashmap.rs', lines 265:4-265:69 *) +let hashMap_remove_from_list_back + (t : Type0) (key : usize) (ls : list_t t) : result (list_t t) = + hashMap_remove_from_list_loop_back t key ls + +(** [hashmap::{hashmap::HashMap}::remove]: forward function + Source: 'src/hashmap.rs', lines 294:4-294:52 *) +let hashMap_remove + (t : Type0) (self : hashMap_t t) (key : usize) : result (option t) = + let* hash = hash_key key in + let i = alloc_vec_Vec_len (list_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod in + let* x = hashMap_remove_from_list t key l in + begin match x with + | None -> Return None + | Some x1 -> let* _ = usize_sub self.num_entries 1 in Return (Some x1) + end + +(** [hashmap::{hashmap::HashMap}::remove]: backward function 0 + Source: 'src/hashmap.rs', lines 294:4-294:52 *) +let hashMap_remove_back + (t : Type0) (self : hashMap_t t) (key : usize) : result (hashMap_t t) = + let* hash = hash_key key in + let i = alloc_vec_Vec_len (list_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod in + let* x = hashMap_remove_from_list t key l in + begin match x with + | None -> + let* l1 = hashMap_remove_from_list_back t key l in + let* v = + alloc_vec_Vec_index_mut_back (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod l1 in + Return { self with slots = v } + | Some _ -> + let* i1 = usize_sub self.num_entries 1 in + let* l1 = hashMap_remove_from_list_back t key l in + let* v = + alloc_vec_Vec_index_mut_back (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots + hash_mod l1 in + Return { self with num_entries = i1; slots = v } + end + +(** [hashmap::test1]: forward function + Source: 'src/hashmap.rs', lines 315:0-315:10 *) +let test1 : result unit = + let* hm = hashMap_new u64 in + let* hm1 = hashMap_insert u64 hm 0 42 in + let* hm2 = hashMap_insert u64 hm1 128 18 in + let* hm3 = hashMap_insert u64 hm2 1024 138 in + let* hm4 = hashMap_insert u64 hm3 1056 256 in + let* i = hashMap_get u64 hm4 128 in + if not (i = 18) + then Fail Failure + else + let* hm5 = hashMap_get_mut_back u64 hm4 1024 56 in + let* i1 = hashMap_get u64 hm5 1024 in + if not (i1 = 56) + then Fail Failure + else + let* x = hashMap_remove u64 hm5 1024 in + begin match x with + | None -> Fail Failure + | Some x1 -> + if not (x1 = 56) + then Fail Failure + else + let* hm6 = hashMap_remove_back u64 hm5 1024 in + let* i2 = hashMap_get u64 hm6 0 in + if not (i2 = 42) + then Fail Failure + else + let* i3 = hashMap_get u64 hm6 128 in + if not (i3 = 18) + then Fail Failure + else + let* i4 = hashMap_get u64 hm6 1056 in + if not (i4 = 256) then Fail Failure else Return () + end + diff --git a/tests/fstar-split/hashmap/Hashmap.Properties.fst b/tests/fstar-split/hashmap/Hashmap.Properties.fst new file mode 100644 index 00000000..def520f0 --- /dev/null +++ b/tests/fstar-split/hashmap/Hashmap.Properties.fst @@ -0,0 +1,3186 @@ +(** Properties about the hashmap *) +module Hashmap.Properties +open Primitives +open FStar.List.Tot +open FStar.Mul +open Hashmap.Types +open Hashmap.Clauses +open Hashmap.Funs + +#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" + +let _align_fsti = () + +/// The proofs: +/// =========== +/// +/// The proof strategy is to do exactly as with Low* proofs (we initially tried to +/// prove more properties in one go, but it was a mistake): +/// - prove that, under some preconditions, the low-level functions translated +/// from Rust refine some higher-level functions +/// - do functional proofs about those high-level functions to prove interesting +/// properties about the hash map operations, and invariant preservation +/// - combine everything +/// +/// The fact that we work in a pure setting allows us to be more modular than when +/// working with effects. For instance we can do a case disjunction (see the proofs +/// for insert, which study the cases where the key is already/not in the hash map +/// in separate proofs - we had initially tried to do them in one step: it is doable +/// but requires some work, and the F* response time quickly becomes annoying while +/// making progress, so we split them). We can also easily prove a refinement lemma, +/// study the model, *then* combine those to also prove that the low-level function +/// preserves the invariants, rather than do everything at once as is usually the +/// case when doing intrinsic proofs with effects (I remember that having to prove +/// invariants in one go *and* a refinement step, even small, can be extremely +/// difficult in Low*). + + +(*** Utilities *) + +/// We need many small helpers and lemmas, mostly about lists (and the ones we list +/// here are not in the standard F* library). + +val index_append_lem (#a : Type0) (ls0 ls1 : list a) (i : nat{i < length ls0 + length ls1}) : + Lemma ( + (i < length ls0 ==> index (ls0 @ ls1) i == index ls0 i) /\ + (i >= length ls0 ==> index (ls0 @ ls1) i == index ls1 (i - length ls0))) + [SMTPat (index (ls0 @ ls1) i)] + +#push-options "--fuel 1" +let rec index_append_lem #a ls0 ls1 i = + match ls0 with + | [] -> () + | x :: ls0' -> + if i = 0 then () + else index_append_lem ls0' ls1 (i-1) +#pop-options + +val index_map_lem (#a #b: Type0) (f : a -> Tot b) (ls : list a) + (i : nat{i < length ls}) : + Lemma ( + index (map f ls) i == f (index ls i)) + [SMTPat (index (map f ls) i)] + +#push-options "--fuel 1" +let rec index_map_lem #a #b f ls i = + match ls with + | [] -> () + | x :: ls' -> + if i = 0 then () + else index_map_lem f ls' (i-1) +#pop-options + +val for_all_append (#a : Type0) (f : a -> Tot bool) (ls0 ls1 : list a) : + Lemma (for_all f (ls0 @ ls1) = (for_all f ls0 && for_all f ls1)) + +#push-options "--fuel 1" +let rec for_all_append #a f ls0 ls1 = + match ls0 with + | [] -> () + | x :: ls0' -> + for_all_append f ls0' ls1 +#pop-options + +/// Filter a list, stopping after we removed one element +val filter_one (#a : Type) (f : a -> bool) (ls : list a) : list a + +let rec filter_one #a f ls = + match ls with + | [] -> [] + | x :: ls' -> if f x then x :: filter_one f ls' else ls' + +val find_append (#a : Type) (f : a -> bool) (ls0 ls1 : list a) : + Lemma ( + find f (ls0 @ ls1) == + begin match find f ls0 with + | Some x -> Some x + | None -> find f ls1 + end) + +#push-options "--fuel 1" +let rec find_append #a f ls0 ls1 = + match ls0 with + | [] -> () + | x :: ls0' -> + if f x then + begin + assert(ls0 @ ls1 == x :: (ls0' @ ls1)); + assert(find f (ls0 @ ls1) == find f (x :: (ls0' @ ls1))); + // Why do I have to do this?! Is it because of subtyping?? + assert( + match find f (ls0 @ ls1) with + | Some x' -> x' == x + | None -> False) + end + else find_append f ls0' ls1 +#pop-options + +val length_flatten_update : + #a:Type + -> ls:list (list a) + -> i:nat{i < length ls} + -> x:list a -> + Lemma ( + // We want this property: + // ``` + // length (flatten (list_update ls i x)) = + // length (flatten ls) - length (index ls i) + length x + // ``` + length (flatten (list_update ls i x)) + length (index ls i) = + length (flatten ls) + length x) + +#push-options "--fuel 1" +let rec length_flatten_update #a ls i x = + match ls with + | x' :: ls' -> + assert(flatten ls == x' @ flatten ls'); // Triggers patterns + assert(length (flatten ls) == length x' + length (flatten ls')); + if i = 0 then + begin + let ls1 = x :: ls' in + assert(list_update ls i x == ls1); + assert(flatten ls1 == x @ flatten ls'); // Triggers patterns + assert(length (flatten ls1) == length x + length (flatten ls')); + () + end + else + begin + length_flatten_update ls' (i-1) x; + let ls1 = x' :: list_update ls' (i-1) x in + assert(flatten ls1 == x' @ flatten (list_update ls' (i-1) x)) // Triggers patterns + end +#pop-options + +val length_flatten_index : + #a:Type + -> ls:list (list a) + -> i:nat{i < length ls} -> + Lemma ( + length (flatten ls) >= length (index ls i)) + +#push-options "--fuel 1" +let rec length_flatten_index #a ls i = + match ls with + | x' :: ls' -> + assert(flatten ls == x' @ flatten ls'); // Triggers patterns + assert(length (flatten ls) == length x' + length (flatten ls')); + if i = 0 then () + else length_flatten_index ls' (i-1) +#pop-options + +val forall_index_equiv_list_for_all + (#a : Type) (pred : a -> Tot bool) (ls : list a) : + Lemma ((forall (i:nat{i < length ls}). pred (index ls i)) <==> for_all pred ls) + +#push-options "--fuel 1" +let rec forall_index_equiv_list_for_all pred ls = + match ls with + | [] -> () + | x :: ls' -> + assert(forall (i:nat{i < length ls'}). index ls' i == index ls (i+1)); + assert(forall (i:nat{0 < i /\ i < length ls}). index ls i == index ls' (i-1)); + assert(index ls 0 == x); + forall_index_equiv_list_for_all pred ls' +#pop-options + +val find_update: + #a:Type + -> f:(a -> Tot bool) + -> ls:list a + -> x:a + -> ls':list a{length ls' == length ls} +#push-options "--fuel 1" +let rec find_update #a f ls x = + match ls with + | [] -> [] + | hd::tl -> + if f hd then x :: tl else hd :: find_update f tl x +#pop-options + +val pairwise_distinct : #a:eqtype -> ls:list a -> Tot bool +let rec pairwise_distinct (#a : eqtype) (ls : list a) : Tot bool = + match ls with + | [] -> true + | x :: ls' -> List.Tot.for_all (fun y -> x <> y) ls' && pairwise_distinct ls' + +val pairwise_rel : #a:Type -> pred:(a -> a -> Tot bool) -> ls:list a -> Tot bool +let rec pairwise_rel #a pred ls = + match ls with + | [] -> true + | x :: ls' -> + for_all (pred x) ls' && pairwise_rel pred ls' + +#push-options "--fuel 1" +let rec flatten_append (#a : Type) (l1 l2: list (list a)) : + Lemma (flatten (l1 @ l2) == flatten l1 @ flatten l2) = + match l1 with + | [] -> () + | x :: l1' -> + flatten_append l1' l2; + append_assoc x (flatten l1') (flatten l2) +#pop-options + +/// We don't use anonymous functions as parameters to other functions, but rather +/// introduce auxiliary functions instead: otherwise we can't reason (because +/// F*'s encoding to the SMT is imprecise for functions) +let fst_is_disctinct (#a : eqtype) (#b : Type0) (p0 : a & b) (p1 : a & b) : Type0 = + fst p0 <> fst p1 + +(*** Lemmas about Primitives *) +/// TODO: move those lemmas + +// TODO: rename to 'insert'? +val list_update_index_dif_lem + (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) + (j : nat{j < length ls}) : + Lemma (requires (j <> i)) + (ensures (index (list_update ls i x) j == index ls j)) + [SMTPat (index (list_update ls i x) j)] + +#push-options "--fuel 1" +let rec list_update_index_dif_lem #a ls i x j = + match ls with + | x' :: ls -> + if i = 0 then () + else if j = 0 then () + else + list_update_index_dif_lem ls (i-1) x (j-1) +#pop-options + +val map_list_update_lem + (#a #b: Type0) (f : a -> Tot b) + (ls : list a) (i : nat{i < length ls}) (x : a) : + Lemma (list_update (map f ls) i (f x) == map f (list_update ls i x)) + [SMTPat (list_update (map f ls) i (f x))] + +#push-options "--fuel 1" +let rec map_list_update_lem #a #b f ls i x = + match ls with + | x' :: ls' -> + if i = 0 then () + else map_list_update_lem f ls' (i-1) x +#pop-options + +(*** Invariants, models *) + +(**** Internals *) +/// The following invariants, models, representation functions... are mostly +/// for the purpose of the proofs. + +let is_pos_usize (n : nat) : Type0 = 0 < n /\ n <= usize_max +type pos_usize = x:usize{x > 0} + +type binding (t : Type0) = key & t + +type slots_t (t : Type0) = alloc_vec_Vec (list_t t) + +/// We represent hash maps as associative lists +type assoc_list (t : Type0) = list (binding t) + +/// Representation function for [list_t] +let rec list_t_v (#t : Type0) (ls : list_t t) : assoc_list t = + match ls with + | List_Nil -> [] + | List_Cons k v tl -> (k,v) :: list_t_v tl + +let list_t_len (#t : Type0) (ls : list_t t) : nat = length (list_t_v ls) +let list_t_index (#t : Type0) (ls : list_t t) (i : nat{i < list_t_len ls}) : binding t = + index (list_t_v ls) i + +type slot_s (t : Type0) = list (binding t) +type slots_s (t : Type0) = list (slot_s t) + +type slot_t (t : Type0) = list_t t +let slot_t_v #t = list_t_v #t + +/// Representation function for the slots. +let slots_t_v (#t : Type0) (slots : slots_t t) : slots_s t = + map slot_t_v slots + +/// Representation function for the slots, seen as an associative list. +let slots_t_al_v (#t : Type0) (slots : slots_t t) : assoc_list t = + flatten (map list_t_v slots) + +/// High-level type for the hash-map, seen as a list of associative lists (one +/// list per slot). This is the representation we use most, internally. Note that +/// we later introduce a [map_s] representation, which is the one used in the +/// lemmas shown to the user. +type hashMap_s t = list (slot_s t) + +// TODO: why not always have the condition on the length? +// 'nes': "non-empty slots" +type hashMap_s_nes (t : Type0) : Type0 = + hm:hashMap_s t{is_pos_usize (length hm)} + +/// Representation function for [hashMap_t] as a list of slots +let hashMap_t_v (#t : Type0) (hm : hashMap_t t) : hashMap_s t = + map list_t_v hm.slots + +/// Representation function for [hashMap_t] as an associative list +let hashMap_t_al_v (#t : Type0) (hm : hashMap_t t) : assoc_list t = + flatten (hashMap_t_v hm) + +// 'nes': "non-empty slots" +type hashMap_t_nes (t : Type0) : Type0 = + hm:hashMap_t t{is_pos_usize (length hm.slots)} + +let hash_key_s (k : key) : hash = + Return?.v (hash_key k) + +let hash_mod_key (k : key) (len : usize{len > 0}) : hash = + (hash_key_s k) % len + +let not_same_key (#t : Type0) (k : key) (b : binding t) : bool = fst b <> k +let same_key (#t : Type0) (k : key) (b : binding t) : bool = fst b = k + +// We take a [nat] instead of a [hash] on purpose +let same_hash_mod_key (#t : Type0) (len : usize{len > 0}) (h : nat) (b : binding t) : bool = + hash_mod_key (fst b) len = h + +let binding_neq (#t : Type0) (b0 b1 : binding t) : bool = fst b0 <> fst b1 + +let hashMap_t_len_s (#t : Type0) (hm : hashMap_t t) : nat = + hm.num_entries + +let assoc_list_find (#t : Type0) (k : key) (slot : assoc_list t) : option t = + match find (same_key k) slot with + | None -> None + | Some (_, v) -> Some v + +let slot_s_find (#t : Type0) (k : key) (slot : list (binding t)) : option t = + assoc_list_find k slot + +let slot_t_find_s (#t : Type0) (k : key) (slot : list_t t) : option t = + slot_s_find k (slot_t_v slot) + +// This is a simpler version of the "find" function, which captures the essence +// of what happens and operates on [hashMap_s]. +let hashMap_s_find + (#t : Type0) (hm : hashMap_s_nes t) + (k : key) : option t = + let i = hash_mod_key k (length hm) in + let slot = index hm i in + slot_s_find k slot + +let hashMap_s_len + (#t : Type0) (hm : hashMap_s t) : + nat = + length (flatten hm) + +// Same as above, but operates on [hashMap_t] +// Note that we don't reuse the above function on purpose: converting to a +// [hashMap_s] then looking up an element is not the same as what we +// wrote below. +let hashMap_t_find_s + (#t : Type0) (hm : hashMap_t t{length hm.slots > 0}) (k : key) : option t = + let slots = hm.slots in + let i = hash_mod_key k (length slots) in + let slot = index slots i in + slot_t_find_s k slot + +/// Invariants for the slots + +let slot_s_inv + (#t : Type0) (len : usize{len > 0}) (i : usize) (slot : list (binding t)) : bool = + // All the bindings are in the proper slot + for_all (same_hash_mod_key len i) slot && + // All the keys are pairwise distinct + pairwise_rel binding_neq slot + +let slot_t_inv (#t : Type0) (len : usize{len > 0}) (i : usize) (slot : list_t t) : bool = + slot_s_inv len i (slot_t_v slot) + +let slots_s_inv (#t : Type0) (slots : slots_s t{length slots <= usize_max}) : Type0 = + forall(i:nat{i < length slots}). + {:pattern index slots i} + slot_s_inv (length slots) i (index slots i) + +// At some point we tried to rewrite this in terms of [slots_s_inv]. However it +// made a lot of proofs fail because those proofs relied on the [index_map_lem] +// pattern. We tried writing others lemmas with patterns (like [slots_s_inv] +// implies [slots_t_inv]) but it didn't succeed, so we keep things as they are. +let slots_t_inv (#t : Type0) (slots : slots_t t{length slots <= usize_max}) : Type0 = + forall(i:nat{i < length slots}). + {:pattern index slots i} + slot_t_inv (length slots) i (index slots i) + +let hashMap_s_inv (#t : Type0) (hm : hashMap_s t) : Type0 = + length hm <= usize_max /\ + length hm > 0 /\ + slots_s_inv hm + +/// Base invariant for the hashmap (the complete invariant can be temporarily +/// broken between the moment we inserted an element and the moment we resize) +let hashMap_t_base_inv (#t : Type0) (hm : hashMap_t t) : Type0 = + let al = hashMap_t_al_v hm in + // [num_entries] correctly tracks the number of entries in the table + // Note that it gives us that the length of the slots array is <= usize_max: + // [> length <= usize_max + // (because hashMap_num_entries has type `usize`) + hm.num_entries = length al /\ + // Slots invariant + slots_t_inv hm.slots /\ + // The capacity must be > 0 (otherwise we can't resize, because we + // multiply the capacity by two!) + length hm.slots > 0 /\ + // Load computation + begin + let capacity = length hm.slots in + let (dividend, divisor) = hm.max_load_factor in + 0 < dividend /\ dividend < divisor /\ + capacity * dividend >= divisor /\ + hm.max_load = (capacity * dividend) / divisor + end + +/// We often need to frame some values +let hashMap_t_same_params (#t : Type0) (hm0 hm1 : hashMap_t t) : Type0 = + length hm0.slots = length hm1.slots /\ + hm0.max_load = hm1.max_load /\ + hm0.max_load_factor = hm1.max_load_factor + +/// The following invariants, etc. are meant to be revealed to the user through +/// the .fsti. + +/// Invariant for the hashmap +let hashMap_t_inv (#t : Type0) (hm : hashMap_t t) : Type0 = + // Base invariant + hashMap_t_base_inv hm /\ + // The hash map is either: not overloaded, or we can't resize it + begin + let (dividend, divisor) = hm.max_load_factor in + hm.num_entries <= hm.max_load + || length hm.slots * 2 * dividend > usize_max + end + +(*** .fsti *) +/// We reveal slightly different version of the above functions to the user + +let len_s (#t : Type0) (hm : hashMap_t t) : nat = hashMap_t_len_s hm + +/// This version doesn't take any precondition (contrary to [hashMap_t_find_s]) +let find_s (#t : Type0) (hm : hashMap_t t) (k : key) : option t = + if length hm.slots = 0 then None + else hashMap_t_find_s hm k + +(*** Overloading *) + +let hashMap_not_overloaded_lem #t hm = () + +(*** allocate_slots *) + +/// Auxiliary lemma +val slots_t_all_nil_inv_lem + (#t : Type0) (slots : alloc_vec_Vec (list_t t){length slots <= usize_max}) : + Lemma (requires (forall (i:nat{i < length slots}). index slots i == List_Nil)) + (ensures (slots_t_inv slots)) + +#push-options "--fuel 1" +let slots_t_all_nil_inv_lem #t slots = () +#pop-options + +val slots_t_al_v_all_nil_is_empty_lem + (#t : Type0) (slots : alloc_vec_Vec (list_t t)) : + Lemma (requires (forall (i:nat{i < length slots}). index slots i == List_Nil)) + (ensures (slots_t_al_v slots == [])) + +#push-options "--fuel 1" +let rec slots_t_al_v_all_nil_is_empty_lem #t slots = + match slots with + | [] -> () + | s :: slots' -> + assert(forall (i:nat{i < length slots'}). index slots' i == index slots (i+1)); + slots_t_al_v_all_nil_is_empty_lem #t slots'; + assert(slots_t_al_v slots == list_t_v s @ slots_t_al_v slots'); + assert(slots_t_al_v slots == list_t_v s); + assert(index slots 0 == List_Nil) +#pop-options + +/// [allocate_slots] +val hashMap_allocate_slots_lem + (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : + Lemma + (requires (length slots + n <= usize_max)) + (ensures ( + match hashMap_allocate_slots t slots n with + | Fail _ -> False + | Return slots' -> + length slots' = length slots + n /\ + // We leave the already allocated slots unchanged + (forall (i:nat{i < length slots}). index slots' i == index slots i) /\ + // We allocate n additional empty slots + (forall (i:nat{length slots <= i /\ i < length slots'}). index slots' i == List_Nil))) + (decreases (hashMap_allocate_slots_loop_decreases t slots n)) + +#push-options "--fuel 1" +let rec hashMap_allocate_slots_lem t slots n = + begin match n with + | 0 -> () + | _ -> + begin match alloc_vec_Vec_push (list_t t) slots List_Nil with + | Fail _ -> () + | Return slots1 -> + begin match usize_sub n 1 with + | Fail _ -> () + | Return i -> + hashMap_allocate_slots_lem t slots1 i; + begin match hashMap_allocate_slots t slots1 i with + | Fail _ -> () + | Return slots2 -> + assert(length slots1 = length slots + 1); + assert(slots1 == slots @ [List_Nil]); // Triggers patterns + assert(index slots1 (length slots) == index [List_Nil] 0); // Triggers patterns + assert(index slots1 (length slots) == List_Nil) + end + end + end + end +#pop-options + +(*** new_with_capacity *) +/// Under proper conditions, [new_with_capacity] doesn't fail and returns an empty hash map. +val hashMap_new_with_capacity_lem + (t : Type0) (capacity : usize) + (max_load_dividend : usize) (max_load_divisor : usize) : + Lemma + (requires ( + 0 < max_load_dividend /\ + max_load_dividend < max_load_divisor /\ + 0 < capacity /\ + capacity * max_load_dividend >= max_load_divisor /\ + capacity * max_load_dividend <= usize_max)) + (ensures ( + match hashMap_new_with_capacity t capacity max_load_dividend max_load_divisor with + | Fail _ -> False + | Return hm -> + // The hash map invariant is satisfied + hashMap_t_inv hm /\ + // The parameters are correct + hm.max_load_factor = (max_load_dividend, max_load_divisor) /\ + hm.max_load = (capacity * max_load_dividend) / max_load_divisor /\ + // The hash map has the specified capacity - we need to reveal this + // otherwise the pre of [hashMap_t_find_s] is not satisfied. + length hm.slots = capacity /\ + // The hash map has 0 values + hashMap_t_len_s hm = 0 /\ + // It contains no bindings + (forall k. hashMap_t_find_s hm k == None) /\ + // We need this low-level property for the invariant + (forall(i:nat{i < length hm.slots}). index hm.slots i == List_Nil))) + +#push-options "--z3rlimit 50 --fuel 1" +let hashMap_new_with_capacity_lem (t : Type0) (capacity : usize) + (max_load_dividend : usize) (max_load_divisor : usize) = + let v = alloc_vec_Vec_new (list_t t) in + assert(length v = 0); + hashMap_allocate_slots_lem t v capacity; + begin match hashMap_allocate_slots t v capacity with + | Fail _ -> assert(False) + | Return v0 -> + begin match usize_mul capacity max_load_dividend with + | Fail _ -> assert(False) + | Return i -> + begin match usize_div i max_load_divisor with + | Fail _ -> assert(False) + | Return i0 -> + let hm = MkhashMap_t 0 (max_load_dividend, max_load_divisor) i0 v0 in + slots_t_all_nil_inv_lem v0; + slots_t_al_v_all_nil_is_empty_lem hm.slots + end + end + end +#pop-options + +(*** new *) + +/// [new] doesn't fail and returns an empty hash map +val hashMap_new_lem_aux (t : Type0) : + Lemma + (ensures ( + match hashMap_new t with + | Fail _ -> False + | Return hm -> + // The hash map invariant is satisfied + hashMap_t_inv hm /\ + // The hash map has 0 values + hashMap_t_len_s hm = 0 /\ + // It contains no bindings + (forall k. hashMap_t_find_s hm k == None))) + +#push-options "--fuel 1" +let hashMap_new_lem_aux t = + hashMap_new_with_capacity_lem t 32 4 5; + match hashMap_new_with_capacity t 32 4 5 with + | Fail _ -> () + | Return hm -> () +#pop-options + +/// The lemma we reveal in the .fsti +let hashMap_new_lem t = hashMap_new_lem_aux t + +(*** clear *) +/// [clear]: the loop doesn't fail and simply clears the slots starting at index i +#push-options "--fuel 1" +let rec hashMap_clear_loop_lem + (t : Type0) (slots : alloc_vec_Vec (list_t t)) (i : usize) : + Lemma + (ensures ( + match hashMap_clear_loop t slots i with + | Fail _ -> False + | Return slots' -> + // The length is preserved + length slots' == length slots /\ + // The slots before i are left unchanged + (forall (j:nat{j < i /\ j < length slots}). index slots' j == index slots j) /\ + // The slots after i are set to List_Nil + (forall (j:nat{i <= j /\ j < length slots}). index slots' j == List_Nil))) + (decreases (hashMap_clear_loop_decreases t slots i)) + = + let i0 = alloc_vec_Vec_len (list_t t) slots in + let b = i < i0 in + if b + then + begin match alloc_vec_Vec_update_usize slots i List_Nil with + | Fail _ -> () + | Return v -> + begin match usize_add i 1 with + | Fail _ -> () + | Return i1 -> + hashMap_clear_loop_lem t v i1; + begin match hashMap_clear_loop t v i1 with + | Fail _ -> () + | Return slots1 -> + assert(length slots1 == length slots); + assert(forall (j:nat{i+1 <= j /\ j < length slots}). index slots1 j == List_Nil); + assert(index slots1 i == List_Nil) + end + end + end + else () +#pop-options + +/// [clear] doesn't fail and turns the hash map into an empty map +val hashMap_clear_lem_aux + (#t : Type0) (self : hashMap_t t) : + Lemma + (requires (hashMap_t_base_inv self)) + (ensures ( + match hashMap_clear t self with + | Fail _ -> False + | Return hm -> + // The hash map invariant is satisfied + hashMap_t_base_inv hm /\ + // We preserved the parameters + hashMap_t_same_params hm self /\ + // The hash map has 0 values + hashMap_t_len_s hm = 0 /\ + // It contains no bindings + (forall k. hashMap_t_find_s hm k == None))) + +// Being lazy: fuel 1 helps a lot... +#push-options "--fuel 1" +let hashMap_clear_lem_aux #t self = + let p = self.max_load_factor in + let i = self.max_load in + let v = self.slots in + hashMap_clear_loop_lem t v 0; + begin match hashMap_clear_loop t v 0 with + | Fail _ -> () + | Return slots1 -> + slots_t_al_v_all_nil_is_empty_lem slots1; + let hm1 = MkhashMap_t 0 p i slots1 in + assert(hashMap_t_base_inv hm1); + assert(hashMap_t_inv hm1) + end +#pop-options + +let hashMap_clear_lem #t self = hashMap_clear_lem_aux #t self + +(*** len *) + +/// [len]: we link it to a non-failing function. +/// Rk.: we might want to make an analysis to not use an error monad to translate +/// functions which statically can't fail. +let hashMap_len_lem #t self = () + + +(*** insert_in_list *) + +(**** insert_in_list'fwd *) + +/// [insert_in_list]: returns true iff the key is not in the list (functional version) +val hashMap_insert_in_list_lem + (t : Type0) (key : usize) (value : t) (ls : list_t t) : + Lemma + (ensures ( + match hashMap_insert_in_list t key value ls with + | Fail _ -> False + | Return b -> + b <==> (slot_t_find_s key ls == None))) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) + +#push-options "--fuel 1" +let rec hashMap_insert_in_list_lem t key value ls = + begin match ls with + | List_Cons ckey cvalue ls0 -> + let b = ckey = key in + if b + then () + else + begin + hashMap_insert_in_list_lem t key value ls0; + match hashMap_insert_in_list t key value ls0 with + | Fail _ -> () + | Return b0 -> () + end + | List_Nil -> + assert(list_t_v ls == []); + assert_norm(find (same_key #t key) [] == None) + end +#pop-options + +(**** insert_in_list'back *) + +/// The proofs about [insert_in_list] backward are easier to do in several steps: +/// extrinsic proofs to the rescue! +/// We first prove that [insert_in_list] refines the function we wrote above, then +/// use this function to prove the invariants, etc. + +/// We write a helper which "captures" what [insert_in_list] does. +/// We then reason about this helper to prove the high-level properties we want +/// (functional properties, preservation of invariants, etc.). +let hashMap_insert_in_list_s + (#t : Type0) (key : usize) (value : t) (ls : list (binding t)) : + list (binding t) = + // Check if there is already a binding for the key + match find (same_key key) ls with + | None -> + // No binding: append the binding to the end + ls @ [(key,value)] + | Some _ -> + // There is already a binding: update it + find_update (same_key key) ls (key,value) + +/// [insert_in_list]: if the key is not in the map, appends a new bindings (functional version) +val hashMap_insert_in_list_back_lem_append_s + (t : Type0) (key : usize) (value : t) (ls : list_t t) : + Lemma + (requires ( + slot_t_find_s key ls == None)) + (ensures ( + match hashMap_insert_in_list_back t key value ls with + | Fail _ -> False + | Return ls' -> + list_t_v ls' == list_t_v ls @ [(key,value)])) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) + +#push-options "--fuel 1" +let rec hashMap_insert_in_list_back_lem_append_s t key value ls = + begin match ls with + | List_Cons ckey cvalue ls0 -> + let b = ckey = key in + if b + then () + else + begin + hashMap_insert_in_list_back_lem_append_s t key value ls0; + match hashMap_insert_in_list_back t key value ls0 with + | Fail _ -> () + | Return l -> () + end + | List_Nil -> () + end +#pop-options + +/// [insert_in_list]: if the key is in the map, we update the binding (functional version) +val hashMap_insert_in_list_back_lem_update_s + (t : Type0) (key : usize) (value : t) (ls : list_t t) : + Lemma + (requires ( + Some? (find (same_key key) (list_t_v ls)))) + (ensures ( + match hashMap_insert_in_list_back t key value ls with + | Fail _ -> False + | Return ls' -> + list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,value))) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) + +#push-options "--fuel 1" +let rec hashMap_insert_in_list_back_lem_update_s t key value ls = + begin match ls with + | List_Cons ckey cvalue ls0 -> + let b = ckey = key in + if b + then () + else + begin + hashMap_insert_in_list_back_lem_update_s t key value ls0; + match hashMap_insert_in_list_back t key value ls0 with + | Fail _ -> () + | Return l -> () + end + | List_Nil -> () + end +#pop-options + +/// Put everything together +val hashMap_insert_in_list_back_lem_s + (t : Type0) (key : usize) (value : t) (ls : list_t t) : + Lemma + (ensures ( + match hashMap_insert_in_list_back t key value ls with + | Fail _ -> False + | Return ls' -> + list_t_v ls' == hashMap_insert_in_list_s key value (list_t_v ls))) + +let hashMap_insert_in_list_back_lem_s t key value ls = + match find (same_key key) (list_t_v ls) with + | None -> hashMap_insert_in_list_back_lem_append_s t key value ls + | Some _ -> hashMap_insert_in_list_back_lem_update_s t key value ls + +(**** Invariants of insert_in_list_s *) + +/// Auxiliary lemmas +/// We work on [hashMap_insert_in_list_s], the "high-level" version of [insert_in_list'back]. +/// +/// Note that in F* we can't have recursive proofs inside of other proofs, contrary +/// to Coq, which makes it a bit cumbersome to prove auxiliary results like the +/// following ones... + +(** Auxiliary lemmas: append case *) + +val slot_t_v_for_all_binding_neq_append_lem + (t : Type0) (key : usize) (value : t) (ls : list (binding t)) (b : binding t) : + Lemma + (requires ( + fst b <> key /\ + for_all (binding_neq b) ls /\ + slot_s_find key ls == None)) + (ensures ( + for_all (binding_neq b) (ls @ [(key,value)]))) + +#push-options "--fuel 1" +let rec slot_t_v_for_all_binding_neq_append_lem t key value ls b = + match ls with + | [] -> () + | (ck, cv) :: cls -> + slot_t_v_for_all_binding_neq_append_lem t key value cls b +#pop-options + +val slot_s_inv_not_find_append_end_inv_lem + (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : + Lemma + (requires ( + slot_s_inv len (hash_mod_key key len) ls /\ + slot_s_find key ls == None)) + (ensures ( + let ls' = ls @ [(key,value)] in + slot_s_inv len (hash_mod_key key len) ls' /\ + (slot_s_find key ls' == Some value) /\ + (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) + +#push-options "--fuel 1" +let rec slot_s_inv_not_find_append_end_inv_lem t len key value ls = + match ls with + | [] -> () + | (ck, cv) :: cls -> + slot_s_inv_not_find_append_end_inv_lem t len key value cls; + let h = hash_mod_key key len in + let ls' = ls @ [(key,value)] in + assert(for_all (same_hash_mod_key len h) ls'); + slot_t_v_for_all_binding_neq_append_lem t key value cls (ck, cv); + assert(pairwise_rel binding_neq ls'); + assert(slot_s_inv len h ls') +#pop-options + +/// [insert_in_list]: if the key is not in the map, appends a new bindings +val hashMap_insert_in_list_s_lem_append + (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : + Lemma + (requires ( + slot_s_inv len (hash_mod_key key len) ls /\ + slot_s_find key ls == None)) + (ensures ( + let ls' = hashMap_insert_in_list_s key value ls in + ls' == ls @ [(key,value)] /\ + // The invariant is preserved + slot_s_inv len (hash_mod_key key len) ls' /\ + // [key] maps to [value] + slot_s_find key ls' == Some value /\ + // The other bindings are preserved + (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) + +let hashMap_insert_in_list_s_lem_append t len key value ls = + slot_s_inv_not_find_append_end_inv_lem t len key value ls + +/// [insert_in_list]: if the key is not in the map, appends a new bindings (quantifiers) +/// Rk.: we don't use this lemma. +/// TODO: remove? +val hashMap_insert_in_list_back_lem_append + (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : + Lemma + (requires ( + slot_t_inv len (hash_mod_key key len) ls /\ + slot_t_find_s key ls == None)) + (ensures ( + match hashMap_insert_in_list_back t key value ls with + | Fail _ -> False + | Return ls' -> + list_t_v ls' == list_t_v ls @ [(key,value)] /\ + // The invariant is preserved + slot_t_inv len (hash_mod_key key len) ls' /\ + // [key] maps to [value] + slot_t_find_s key ls' == Some value /\ + // The other bindings are preserved + (forall k'. k' <> key ==> slot_t_find_s k' ls' == slot_t_find_s k' ls))) + +let hashMap_insert_in_list_back_lem_append t len key value ls = + hashMap_insert_in_list_back_lem_s t key value ls; + hashMap_insert_in_list_s_lem_append t len key value (list_t_v ls) + +(** Auxiliary lemmas: update case *) + +val slot_s_find_update_for_all_binding_neq_append_lem + (t : Type0) (key : usize) (value : t) (ls : list (binding t)) (b : binding t) : + Lemma + (requires ( + fst b <> key /\ + for_all (binding_neq b) ls)) + (ensures ( + let ls' = find_update (same_key key) ls (key, value) in + for_all (binding_neq b) ls')) + +#push-options "--fuel 1" +let rec slot_s_find_update_for_all_binding_neq_append_lem t key value ls b = + match ls with + | [] -> () + | (ck, cv) :: cls -> + slot_s_find_update_for_all_binding_neq_append_lem t key value cls b +#pop-options + +/// Annoying auxiliary lemma we have to prove because there is no way to reason +/// properly about closures. +/// I'm really enjoying my time. +val for_all_binding_neq_value_indep + (#t : Type0) (key : key) (v0 v1 : t) (ls : list (binding t)) : + Lemma (for_all (binding_neq (key,v0)) ls = for_all (binding_neq (key,v1)) ls) + +#push-options "--fuel 1" +let rec for_all_binding_neq_value_indep #t key v0 v1 ls = + match ls with + | [] -> () + | _ :: ls' -> for_all_binding_neq_value_indep #t key v0 v1 ls' +#pop-options + +val slot_s_inv_find_append_end_inv_lem + (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : + Lemma + (requires ( + slot_s_inv len (hash_mod_key key len) ls /\ + Some? (slot_s_find key ls))) + (ensures ( + let ls' = find_update (same_key key) ls (key, value) in + slot_s_inv len (hash_mod_key key len) ls' /\ + (slot_s_find key ls' == Some value) /\ + (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) + +#push-options "--z3rlimit 50 --fuel 1" +let rec slot_s_inv_find_append_end_inv_lem t len key value ls = + match ls with + | [] -> () + | (ck, cv) :: cls -> + let h = hash_mod_key key len in + let ls' = find_update (same_key key) ls (key, value) in + if ck = key then + begin + assert(ls' == (ck,value) :: cls); + assert(for_all (same_hash_mod_key len h) ls'); + // For pairwise_rel: binding_neq (ck, value) is actually independent + // of `value`. Slightly annoying to prove in F*... + assert(for_all (binding_neq (ck,cv)) cls); + for_all_binding_neq_value_indep key cv value cls; + assert(for_all (binding_neq (ck,value)) cls); + assert(pairwise_rel binding_neq ls'); + assert(slot_s_inv len (hash_mod_key key len) ls') + end + else + begin + slot_s_inv_find_append_end_inv_lem t len key value cls; + assert(for_all (same_hash_mod_key len h) ls'); + slot_s_find_update_for_all_binding_neq_append_lem t key value cls (ck, cv); + assert(pairwise_rel binding_neq ls'); + assert(slot_s_inv len h ls') + end +#pop-options + +/// [insert_in_list]: if the key is in the map, update the bindings +val hashMap_insert_in_list_s_lem_update + (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : + Lemma + (requires ( + slot_s_inv len (hash_mod_key key len) ls /\ + Some? (slot_s_find key ls))) + (ensures ( + let ls' = hashMap_insert_in_list_s key value ls in + ls' == find_update (same_key key) ls (key,value) /\ + // The invariant is preserved + slot_s_inv len (hash_mod_key key len) ls' /\ + // [key] maps to [value] + slot_s_find key ls' == Some value /\ + // The other bindings are preserved + (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) + +let hashMap_insert_in_list_s_lem_update t len key value ls = + slot_s_inv_find_append_end_inv_lem t len key value ls + + +/// [insert_in_list]: if the key is in the map, update the bindings +/// TODO: not used: remove? +val hashMap_insert_in_list_back_lem_update + (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : + Lemma + (requires ( + slot_t_inv len (hash_mod_key key len) ls /\ + Some? (slot_t_find_s key ls))) + (ensures ( + match hashMap_insert_in_list_back t key value ls with + | Fail _ -> False + | Return ls' -> + let als = list_t_v ls in + list_t_v ls' == find_update (same_key key) als (key,value) /\ + // The invariant is preserved + slot_t_inv len (hash_mod_key key len) ls' /\ + // [key] maps to [value] + slot_t_find_s key ls' == Some value /\ + // The other bindings are preserved + (forall k'. k' <> key ==> slot_t_find_s k' ls' == slot_t_find_s k' ls))) + +let hashMap_insert_in_list_back_lem_update t len key value ls = + hashMap_insert_in_list_back_lem_s t key value ls; + hashMap_insert_in_list_s_lem_update t len key value (list_t_v ls) + +(** Final lemmas about [insert_in_list] *) + +/// High-level version +val hashMap_insert_in_list_s_lem + (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : + Lemma + (requires ( + slot_s_inv len (hash_mod_key key len) ls)) + (ensures ( + let ls' = hashMap_insert_in_list_s key value ls in + // The invariant is preserved + slot_s_inv len (hash_mod_key key len) ls' /\ + // [key] maps to [value] + slot_s_find key ls' == Some value /\ + // The other bindings are preserved + (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls) /\ + // The length is incremented, iff we inserted a new key + (match slot_s_find key ls with + | None -> length ls' = length ls + 1 + | Some _ -> length ls' = length ls))) + +let hashMap_insert_in_list_s_lem t len key value ls = + match slot_s_find key ls with + | None -> + assert_norm(length [(key,value)] = 1); + hashMap_insert_in_list_s_lem_append t len key value ls + | Some _ -> + hashMap_insert_in_list_s_lem_update t len key value ls + +/// [insert_in_list] +/// TODO: not used: remove? +val hashMap_insert_in_list_back_lem + (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : + Lemma + (requires (slot_t_inv len (hash_mod_key key len) ls)) + (ensures ( + match hashMap_insert_in_list_back t key value ls with + | Fail _ -> False + | Return ls' -> + // The invariant is preserved + slot_t_inv len (hash_mod_key key len) ls' /\ + // [key] maps to [value] + slot_t_find_s key ls' == Some value /\ + // The other bindings are preserved + (forall k'. k' <> key ==> slot_t_find_s k' ls' == slot_t_find_s k' ls) /\ + // The length is incremented, iff we inserted a new key + (match slot_t_find_s key ls with + | None -> + list_t_v ls' == list_t_v ls @ [(key,value)] /\ + list_t_len ls' = list_t_len ls + 1 + | Some _ -> + list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,value) /\ + list_t_len ls' = list_t_len ls))) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) + +let hashMap_insert_in_list_back_lem t len key value ls = + hashMap_insert_in_list_back_lem_s t key value ls; + hashMap_insert_in_list_s_lem t len key value (list_t_v ls) + +(*** insert_no_resize *) + +(**** Refinement proof *) +/// Same strategy as for [insert_in_list]: we introduce a high-level version of +/// the function, and reason about it. +/// We work on [hashMap_s] (we use a higher-level view of the hash-map, but +/// not too high). + +/// A high-level version of insert, which doesn't check if the table is saturated +let hashMap_insert_no_fail_s + (#t : Type0) (hm : hashMap_s_nes t) + (key : usize) (value : t) : + hashMap_s t = + let len = length hm in + let i = hash_mod_key key len in + let slot = index hm i in + let slot' = hashMap_insert_in_list_s key value slot in + let hm' = list_update hm i slot' in + hm' + +// TODO: at some point I used hashMap_s_nes and it broke proofs...x +let hashMap_insert_no_resize_s + (#t : Type0) (hm : hashMap_s_nes t) + (key : usize) (value : t) : + result (hashMap_s t) = + // Check if the table is saturated (too many entries, and we need to insert one) + let num_entries = length (flatten hm) in + if None? (hashMap_s_find hm key) && num_entries = usize_max then Fail Failure + else Return (hashMap_insert_no_fail_s hm key value) + +/// Prove that [hashMap_insert_no_resize_s] is refined by +/// [hashMap_insert_no_resize'fwd_back] +val hashMap_insert_no_resize_lem_s + (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + Lemma + (requires ( + hashMap_t_base_inv self /\ + hashMap_s_len (hashMap_t_v self) = hashMap_t_len_s self)) + (ensures ( + begin + match hashMap_insert_no_resize t self key value, + hashMap_insert_no_resize_s (hashMap_t_v self) key value + with + | Fail _, Fail _ -> True + | Return hm, Return hm_v -> + hashMap_t_base_inv hm /\ + hashMap_t_same_params hm self /\ + hashMap_t_v hm == hm_v /\ + hashMap_s_len hm_v == hashMap_t_len_s hm + | _ -> False + end)) + +let hashMap_insert_no_resize_lem_s t self key value = + begin match hash_key key with + | Fail _ -> () + | Return i -> + let i0 = self.num_entries in + let p = self.max_load_factor in + let i1 = self.max_load in + let v = self.slots in + let i2 = alloc_vec_Vec_len (list_t t) v in + let len = length v in + begin match usize_rem i i2 with + | Fail _ -> () + | Return hash_mod -> + begin match alloc_vec_Vec_index_usize v hash_mod with + | Fail _ -> () + | Return l -> + begin + // Checking that: list_t_v (index ...) == index (hashMap_t_v ...) ... + assert(list_t_v l == index (hashMap_t_v self) hash_mod); + hashMap_insert_in_list_lem t key value l; + match hashMap_insert_in_list t key value l with + | Fail _ -> () + | Return b -> + assert(b = None? (slot_s_find key (list_t_v l))); + hashMap_insert_in_list_back_lem t len key value l; + if b + then + begin match usize_add i0 1 with + | Fail _ -> () + | Return i3 -> + begin + match hashMap_insert_in_list_back t key value l with + | Fail _ -> () + | Return l0 -> + begin match alloc_vec_Vec_update_usize v hash_mod l0 with + | Fail _ -> () + | Return v0 -> + let self_v = hashMap_t_v self in + let hm = MkhashMap_t i3 p i1 v0 in + let hm_v = hashMap_t_v hm in + assert(hm_v == list_update self_v hash_mod (list_t_v l0)); + assert_norm(length [(key,value)] = 1); + assert(length (list_t_v l0) = length (list_t_v l) + 1); + length_flatten_update self_v hash_mod (list_t_v l0); + assert(hashMap_s_len hm_v = hashMap_t_len_s hm) + end + end + end + else + begin + match hashMap_insert_in_list_back t key value l with + | Fail _ -> () + | Return l0 -> + begin match alloc_vec_Vec_update_usize v hash_mod l0 with + | Fail _ -> () + | Return v0 -> + let self_v = hashMap_t_v self in + let hm = MkhashMap_t i0 p i1 v0 in + let hm_v = hashMap_t_v hm in + assert(hm_v == list_update self_v hash_mod (list_t_v l0)); + assert(length (list_t_v l0) = length (list_t_v l)); + length_flatten_update self_v hash_mod (list_t_v l0); + assert(hashMap_s_len hm_v = hashMap_t_len_s hm) + end + end + end + end + end + end + +(**** insert_{no_fail,no_resize}: invariants *) + +let hashMap_s_updated_binding + (#t : Type0) (hm : hashMap_s_nes t) + (key : usize) (opt_value : option t) (hm' : hashMap_s_nes t) : Type0 = + // [key] maps to [value] + hashMap_s_find hm' key == opt_value /\ + // The other bindings are preserved + (forall k'. k' <> key ==> hashMap_s_find hm' k' == hashMap_s_find hm k') + +let insert_post (#t : Type0) (hm : hashMap_s_nes t) + (key : usize) (value : t) (hm' : hashMap_s_nes t) : Type0 = + // The invariant is preserved + hashMap_s_inv hm' /\ + // [key] maps to [value] and the other bindings are preserved + hashMap_s_updated_binding hm key (Some value) hm' /\ + // The length is incremented, iff we inserted a new key + (match hashMap_s_find hm key with + | None -> hashMap_s_len hm' = hashMap_s_len hm + 1 + | Some _ -> hashMap_s_len hm' = hashMap_s_len hm) + +val hashMap_insert_no_fail_s_lem + (#t : Type0) (hm : hashMap_s_nes t) + (key : usize) (value : t) : + Lemma + (requires (hashMap_s_inv hm)) + (ensures ( + let hm' = hashMap_insert_no_fail_s hm key value in + insert_post hm key value hm')) + +let hashMap_insert_no_fail_s_lem #t hm key value = + let len = length hm in + let i = hash_mod_key key len in + let slot = index hm i in + hashMap_insert_in_list_s_lem t len key value slot; + let slot' = hashMap_insert_in_list_s key value slot in + length_flatten_update hm i slot' + +val hashMap_insert_no_resize_s_lem + (#t : Type0) (hm : hashMap_s_nes t) + (key : usize) (value : t) : + Lemma + (requires (hashMap_s_inv hm)) + (ensures ( + match hashMap_insert_no_resize_s hm key value with + | Fail _ -> + // Can fail only if we need to create a new binding in + // an already saturated map + hashMap_s_len hm = usize_max /\ + None? (hashMap_s_find hm key) + | Return hm' -> + insert_post hm key value hm')) + +let hashMap_insert_no_resize_s_lem #t hm key value = + let num_entries = length (flatten hm) in + if None? (hashMap_s_find hm key) && num_entries = usize_max then () + else hashMap_insert_no_fail_s_lem hm key value + + +(**** find after insert *) +/// Lemmas about what happens if we call [find] after an insertion + +val hashMap_insert_no_resize_s_get_same_lem + (#t : Type0) (hm : hashMap_s t) + (key : usize) (value : t) : + Lemma (requires (hashMap_s_inv hm)) + (ensures ( + match hashMap_insert_no_resize_s hm key value with + | Fail _ -> True + | Return hm' -> + hashMap_s_find hm' key == Some value)) + +let hashMap_insert_no_resize_s_get_same_lem #t hm key value = + let num_entries = length (flatten hm) in + if None? (hashMap_s_find hm key) && num_entries = usize_max then () + else + begin + let hm' = Return?.v (hashMap_insert_no_resize_s hm key value) in + let len = length hm in + let i = hash_mod_key key len in + let slot = index hm i in + hashMap_insert_in_list_s_lem t len key value slot + end + +val hashMap_insert_no_resize_s_get_diff_lem + (#t : Type0) (hm : hashMap_s t) + (key : usize) (value : t) (key' : usize{key' <> key}) : + Lemma (requires (hashMap_s_inv hm)) + (ensures ( + match hashMap_insert_no_resize_s hm key value with + | Fail _ -> True + | Return hm' -> + hashMap_s_find hm' key' == hashMap_s_find hm key')) + +let hashMap_insert_no_resize_s_get_diff_lem #t hm key value key' = + let num_entries = length (flatten hm) in + if None? (hashMap_s_find hm key) && num_entries = usize_max then () + else + begin + let hm' = Return?.v (hashMap_insert_no_resize_s hm key value) in + let len = length hm in + let i = hash_mod_key key len in + let slot = index hm i in + hashMap_insert_in_list_s_lem t len key value slot; + let i' = hash_mod_key key' len in + if i <> i' then () + else + begin + () + end + end + + +(*** move_elements_from_list *) + +/// Having a great time here: if we use `result (hashMap_s_res t)` as the +/// return type for [hashMap_move_elements_from_list_s] instead of having this +/// awkward match, the proof of [hashMap_move_elements_lem_refin] fails. +/// I guess it comes from F*'s poor subtyping. +/// Followingly, I'm not taking any chance and using [result_hashMap_s] +/// everywhere. +type result_hashMap_s_nes (t : Type0) : Type0 = + res:result (hashMap_s t) { + match res with + | Fail _ -> True + | Return hm -> is_pos_usize (length hm) + } + +let rec hashMap_move_elements_from_list_s + (#t : Type0) (hm : hashMap_s_nes t) + (ls : slot_s t) : + // Do *NOT* use `result (hashMap_s t)` + Tot (result_hashMap_s_nes t) + (decreases ls) = + match ls with + | [] -> Return hm + | (key, value) :: ls' -> + match hashMap_insert_no_resize_s hm key value with + | Fail e -> Fail e + | Return hm' -> + hashMap_move_elements_from_list_s hm' ls' + +/// Refinement lemma +val hashMap_move_elements_from_list_lem + (t : Type0) (ntable : hashMap_t_nes t) (ls : list_t t) : + Lemma (requires (hashMap_t_base_inv ntable)) + (ensures ( + match hashMap_move_elements_from_list t ntable ls, + hashMap_move_elements_from_list_s (hashMap_t_v ntable) (slot_t_v ls) + with + | Fail _, Fail _ -> True + | Return hm', Return hm_v -> + hashMap_t_base_inv hm' /\ + hashMap_t_v hm' == hm_v /\ + hashMap_t_same_params hm' ntable + | _ -> False)) + (decreases (hashMap_move_elements_from_list_loop_decreases t ntable ls)) + +#push-options "--fuel 1" +let rec hashMap_move_elements_from_list_lem t ntable ls = + begin match ls with + | List_Cons k v tl -> + assert(list_t_v ls == (k, v) :: list_t_v tl); + let ls_v = list_t_v ls in + let (_,_) :: tl_v = ls_v in + hashMap_insert_no_resize_lem_s t ntable k v; + begin match hashMap_insert_no_resize t ntable k v with + | Fail _ -> () + | Return h -> + let h_v = Return?.v (hashMap_insert_no_resize_s (hashMap_t_v ntable) k v) in + assert(hashMap_t_v h == h_v); + hashMap_move_elements_from_list_lem t h tl; + begin match hashMap_move_elements_from_list t h tl with + | Fail _ -> () + | Return h0 -> () + end + end + | List_Nil -> () + end +#pop-options + +(*** move_elements *) + +(**** move_elements: refinement 0 *) +/// The proof for [hashMap_move_elements_lem_refin] broke so many times +/// (while it is supposed to be super simple!) that we decided to add one refinement +/// level, to really do things step by step... +/// Doing this refinement layer made me notice that maybe the problem came from +/// the fact that at some point we have to prove `list_t_v List_Nil == []`: I +/// added the corresponding assert to help Z3 and everything became stable. +/// I finally didn't use this "simple" refinement lemma, but I still keep it here +/// because it allows for easy comparisons with [hashMap_move_elements_s]. + +/// [hashMap_move_elements] refines this function, which is actually almost +/// the same (just a little bit shorter and cleaner, and has a pre). +/// +/// The way I wrote the high-level model is the following: +/// - I copy-pasted the definition of [hashMap_move_elements], wrote the +/// signature which links this new definition to [hashMap_move_elements] and +/// checked that the proof passed +/// - I gradually simplified it, while making sure the proof still passes +#push-options "--fuel 1" +let rec hashMap_move_elements_s_simpl + (t : Type0) (ntable : hashMap_t t) + (slots : alloc_vec_Vec (list_t t)) + (i : usize{i <= length slots /\ length slots <= usize_max}) : + Pure (result ((hashMap_t t) & (alloc_vec_Vec (list_t t)))) + (requires (True)) + (ensures (fun res -> + match res, hashMap_move_elements t ntable slots i with + | Fail _, Fail _ -> True + | Return (ntable1, slots1), Return (ntable2, slots2) -> + ntable1 == ntable2 /\ + slots1 == slots2 + | _ -> False)) + (decreases (hashMap_move_elements_loop_decreases t ntable slots i)) + = + if i < length slots + then + let slot = index slots i in + begin match hashMap_move_elements_from_list t ntable slot with + | Fail e -> Fail e + | Return hm' -> + let slots' = list_update slots i List_Nil in + hashMap_move_elements_s_simpl t hm' slots' (i+1) + end + else Return (ntable, slots) +#pop-options + +(**** move_elements: refinement 1 *) +/// We prove a second refinement lemma: calling [move_elements] refines a function +/// which, for every slot, moves the element out of the slot. This first model is +/// almost exactly the translated function, it just uses `list` instead of `list_t`. + +// Note that we ignore the returned slots (we thus don't return a pair: +// only the new hash map in which we moved the elements from the slots): +// this returned value is not used. +let rec hashMap_move_elements_s + (#t : Type0) (hm : hashMap_s_nes t) + (slots : slots_s t) (i : usize{i <= length slots /\ length slots <= usize_max}) : + Tot (result_hashMap_s_nes t) + (decreases (length slots - i)) = + let len = length slots in + if i < len then + begin + let slot = index slots i in + match hashMap_move_elements_from_list_s hm slot with + | Fail e -> Fail e + | Return hm' -> + let slots' = list_update slots i [] in + hashMap_move_elements_s hm' slots' (i+1) + end + else Return hm + +val hashMap_move_elements_lem_refin + (t : Type0) (ntable : hashMap_t t) + (slots : alloc_vec_Vec (list_t t)) (i : usize{i <= length slots}) : + Lemma + (requires ( + hashMap_t_base_inv ntable)) + (ensures ( + match hashMap_move_elements t ntable slots i, + hashMap_move_elements_s (hashMap_t_v ntable) (slots_t_v slots) i + with + | Fail _, Fail _ -> True // We will prove later that this is not possible + | Return (ntable', _), Return ntable'_v -> + hashMap_t_base_inv ntable' /\ + hashMap_t_v ntable' == ntable'_v /\ + hashMap_t_same_params ntable' ntable + | _ -> False)) + (decreases (length slots - i)) + +#restart-solver +#push-options "--fuel 1" +let rec hashMap_move_elements_lem_refin t ntable slots i = + assert(hashMap_t_base_inv ntable); + let i0 = alloc_vec_Vec_len (list_t t) slots in + let b = i < i0 in + if b + then + begin match alloc_vec_Vec_index_usize slots i with + | Fail _ -> () + | Return l -> + let l0 = core_mem_replace (list_t t) l List_Nil in + assert(l0 == l); + hashMap_move_elements_from_list_lem t ntable l0; + begin match hashMap_move_elements_from_list t ntable l0 with + | Fail _ -> () + | Return h -> + let l1 = core_mem_replace_back (list_t t) l List_Nil in + assert(l1 == List_Nil); + assert(slot_t_v #t List_Nil == []); // THIS IS IMPORTANT + begin match alloc_vec_Vec_update_usize slots i l1 with + | Fail _ -> () + | Return v -> + begin match usize_add i 1 with + | Fail _ -> () + | Return i1 -> + hashMap_move_elements_lem_refin t h v i1; + begin match hashMap_move_elements t h v i1 with + | Fail _ -> + assert(Fail? (hashMap_move_elements t ntable slots i)); + () + | Return (ntable', v0) -> () + end + end + end + end + end + else () +#pop-options + + +(**** move_elements: refinement 2 *) +/// We prove a second refinement lemma: calling [move_elements] refines a function +/// which moves every binding of the hash map seen as *one* associative list +/// (and not a list of lists). + +/// [ntable] is the hash map to which we move the elements +/// [slots] is the current hash map, from which we remove the elements, and seen +/// as a "flat" associative list (and not a list of lists) +/// This is actually exactly [hashMap_move_elements_from_list_s]... +let rec hashMap_move_elements_s_flat + (#t : Type0) (ntable : hashMap_s_nes t) + (slots : assoc_list t) : + Tot (result_hashMap_s_nes t) + (decreases slots) = + match slots with + | [] -> Return ntable + | (k,v) :: slots' -> + match hashMap_insert_no_resize_s ntable k v with + | Fail e -> Fail e + | Return ntable' -> + hashMap_move_elements_s_flat ntable' slots' + +/// The refinment lemmas +/// First, auxiliary helpers. + +/// Flatten a list of lists, starting at index i +val flatten_i : + #a:Type + -> l:list (list a) + -> i:nat{i <= length l} + -> Tot (list a) (decreases (length l - i)) + +let rec flatten_i l i = + if i < length l then + index l i @ flatten_i l (i+1) + else [] + +let _ = assert(let l = [1;2] in l == hd l :: tl l) + +val flatten_i_incr : + #a:Type + -> l:list (list a) + -> i:nat{Cons? l /\ i+1 <= length l} -> + Lemma + (ensures ( + (**) assert_norm(length (hd l :: tl l) == 1 + length (tl l)); + flatten_i l (i+1) == flatten_i (tl l) i)) + (decreases (length l - (i+1))) + +#push-options "--fuel 1" +let rec flatten_i_incr l i = + let x :: tl = l in + if i + 1 < length l then + begin + assert(flatten_i l (i+1) == index l (i+1) @ flatten_i l (i+2)); + flatten_i_incr l (i+1); + assert(flatten_i l (i+2) == flatten_i tl (i+1)); + assert(index l (i+1) == index tl i) + end + else () +#pop-options + +val flatten_0_is_flatten : + #a:Type + -> l:list (list a) -> + Lemma + (ensures (flatten_i l 0 == flatten l)) + +#push-options "--fuel 1" +let rec flatten_0_is_flatten #a l = + match l with + | [] -> () + | x :: l' -> + flatten_i_incr l 0; + flatten_0_is_flatten l' +#pop-options + +/// Auxiliary lemma +val flatten_nil_prefix_as_flatten_i : + #a:Type + -> l:list (list a) + -> i:nat{i <= length l} -> + Lemma (requires (forall (j:nat{j < i}). index l j == [])) + (ensures (flatten l == flatten_i l i)) + +#push-options "--fuel 1" +let rec flatten_nil_prefix_as_flatten_i #a l i = + if i = 0 then flatten_0_is_flatten l + else + begin + let x :: l' = l in + assert(index l 0 == []); + assert(x == []); + assert(flatten l == flatten l'); + flatten_i_incr l (i-1); + assert(flatten_i l i == flatten_i l' (i-1)); + assert(forall (j:nat{j < length l'}). index l' j == index l (j+1)); + flatten_nil_prefix_as_flatten_i l' (i-1); + assert(flatten l' == flatten_i l' (i-1)) + end +#pop-options + +/// The proof is trivial, the functions are the same. +/// Just keeping two definitions to allow changes... +val hashMap_move_elements_from_list_s_as_flat_lem + (#t : Type0) (hm : hashMap_s_nes t) + (ls : slot_s t) : + Lemma + (ensures ( + hashMap_move_elements_from_list_s hm ls == + hashMap_move_elements_s_flat hm ls)) + (decreases ls) + +#push-options "--fuel 1" +let rec hashMap_move_elements_from_list_s_as_flat_lem #t hm ls = + match ls with + | [] -> () + | (key, value) :: ls' -> + match hashMap_insert_no_resize_s hm key value with + | Fail _ -> () + | Return hm' -> + hashMap_move_elements_from_list_s_as_flat_lem hm' ls' +#pop-options + +/// Composition of two calls to [hashMap_move_elements_s_flat] +let hashMap_move_elements_s_flat_comp + (#t : Type0) (hm : hashMap_s_nes t) (slot0 slot1 : slot_s t) : + Tot (result_hashMap_s_nes t) = + match hashMap_move_elements_s_flat hm slot0 with + | Fail e -> Fail e + | Return hm1 -> hashMap_move_elements_s_flat hm1 slot1 + +/// High-level desc: +/// move_elements (move_elements hm slot0) slo1 == move_elements hm (slot0 @ slot1) +val hashMap_move_elements_s_flat_append_lem + (#t : Type0) (hm : hashMap_s_nes t) (slot0 slot1 : slot_s t) : + Lemma + (ensures ( + match hashMap_move_elements_s_flat_comp hm slot0 slot1, + hashMap_move_elements_s_flat hm (slot0 @ slot1) + with + | Fail _, Fail _ -> True + | Return hm1, Return hm2 -> hm1 == hm2 + | _ -> False)) + (decreases (slot0)) + +#push-options "--fuel 1" +let rec hashMap_move_elements_s_flat_append_lem #t hm slot0 slot1 = + match slot0 with + | [] -> () + | (k,v) :: slot0' -> + match hashMap_insert_no_resize_s hm k v with + | Fail _ -> () + | Return hm' -> + hashMap_move_elements_s_flat_append_lem hm' slot0' slot1 +#pop-options + +val flatten_i_same_suffix (#a : Type) (l0 l1 : list (list a)) (i : nat) : + Lemma + (requires ( + i <= length l0 /\ + length l0 = length l1 /\ + (forall (j:nat{i <= j /\ j < length l0}). index l0 j == index l1 j))) + (ensures (flatten_i l0 i == flatten_i l1 i)) + (decreases (length l0 - i)) + +#push-options "--fuel 1" +let rec flatten_i_same_suffix #a l0 l1 i = + if i < length l0 then + flatten_i_same_suffix l0 l1 (i+1) + else () +#pop-options + +/// Refinement lemma: +/// [hashMap_move_elements_s] refines [hashMap_move_elements_s_flat] +/// (actually the functions are equal on all inputs). +val hashMap_move_elements_s_lem_refin_flat + (#t : Type0) (hm : hashMap_s_nes t) + (slots : slots_s t) + (i : nat{i <= length slots /\ length slots <= usize_max}) : + Lemma + (ensures ( + match hashMap_move_elements_s hm slots i, + hashMap_move_elements_s_flat hm (flatten_i slots i) + with + | Fail _, Fail _ -> True + | Return hm, Return hm' -> hm == hm' + | _ -> False)) + (decreases (length slots - i)) + +#push-options "--fuel 1" +let rec hashMap_move_elements_s_lem_refin_flat #t hm slots i = + let len = length slots in + if i < len then + begin + let slot = index slots i in + hashMap_move_elements_from_list_s_as_flat_lem hm slot; + match hashMap_move_elements_from_list_s hm slot with + | Fail _ -> + assert(flatten_i slots i == slot @ flatten_i slots (i+1)); + hashMap_move_elements_s_flat_append_lem hm slot (flatten_i slots (i+1)); + assert(Fail? (hashMap_move_elements_s_flat hm (flatten_i slots i))) + | Return hm' -> + let slots' = list_update slots i [] in + flatten_i_same_suffix slots slots' (i+1); + hashMap_move_elements_s_lem_refin_flat hm' slots' (i+1); + hashMap_move_elements_s_flat_append_lem hm slot (flatten_i slots' (i+1)); + () + end + else () +#pop-options + +let assoc_list_inv (#t : Type0) (al : assoc_list t) : Type0 = + // All the keys are pairwise distinct + pairwise_rel binding_neq al + +let disjoint_hm_al_on_key + (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) (k : key) : Type0 = + match hashMap_s_find hm k, assoc_list_find k al with + | Some _, None + | None, Some _ + | None, None -> True + | Some _, Some _ -> False + +/// Playing a dangerous game here: using forall quantifiers +let disjoint_hm_al (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) : Type0 = + forall (k:key). disjoint_hm_al_on_key hm al k + +let find_in_union_hm_al + (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) (k : key) : + option t = + match hashMap_s_find hm k with + | Some b -> Some b + | None -> assoc_list_find k al + +/// Auxiliary lemma +val for_all_binding_neq_find_lem (#t : Type0) (k : key) (v : t) (al : assoc_list t) : + Lemma (requires (for_all (binding_neq (k,v)) al)) + (ensures (assoc_list_find k al == None)) + +#push-options "--fuel 1" +let rec for_all_binding_neq_find_lem #t k v al = + match al with + | [] -> () + | b :: al' -> for_all_binding_neq_find_lem k v al' +#pop-options + +val hashMap_move_elements_s_flat_lem + (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) : + Lemma + (requires ( + // Invariants + hashMap_s_inv hm /\ + assoc_list_inv al /\ + // The two are disjoint + disjoint_hm_al hm al /\ + // We can add all the elements to the hashmap + hashMap_s_len hm + length al <= usize_max)) + (ensures ( + match hashMap_move_elements_s_flat hm al with + | Fail _ -> False // We can't fail + | Return hm' -> + // The invariant is preserved + hashMap_s_inv hm' /\ + // The new hash map is the union of the two maps + (forall (k:key). hashMap_s_find hm' k == find_in_union_hm_al hm al k) /\ + hashMap_s_len hm' = hashMap_s_len hm + length al)) + (decreases al) + +#restart-solver +#push-options "--z3rlimit 200 --fuel 1" +let rec hashMap_move_elements_s_flat_lem #t hm al = + match al with + | [] -> () + | (k,v) :: al' -> + hashMap_insert_no_resize_s_lem hm k v; + match hashMap_insert_no_resize_s hm k v with + | Fail _ -> () + | Return hm' -> + assert(hashMap_s_inv hm'); + assert(assoc_list_inv al'); + let disjoint_lem (k' : key) : + Lemma (disjoint_hm_al_on_key hm' al' k') + [SMTPat (disjoint_hm_al_on_key hm' al' k')] = + if k' = k then + begin + assert(hashMap_s_find hm' k' == Some v); + for_all_binding_neq_find_lem k v al'; + assert(assoc_list_find k' al' == None) + end + else + begin + assert(hashMap_s_find hm' k' == hashMap_s_find hm k'); + assert(assoc_list_find k' al' == assoc_list_find k' al) + end + in + assert(disjoint_hm_al hm' al'); + assert(hashMap_s_len hm' + length al' <= usize_max); + hashMap_move_elements_s_flat_lem hm' al' +#pop-options + +/// We need to prove that the invariants on the "low-level" representations of +/// the hash map imply the invariants on the "high-level" representations. + +val slots_t_inv_implies_slots_s_inv + (#t : Type0) (slots : slots_t t{length slots <= usize_max}) : + Lemma (requires (slots_t_inv slots)) + (ensures (slots_s_inv (slots_t_v slots))) + +let slots_t_inv_implies_slots_s_inv #t slots = + // Ok, works fine: this lemma was useless. + // Problem is: I can never really predict for sure with F*... + () + +val hashMap_t_base_inv_implies_hashMap_s_inv + (#t : Type0) (hm : hashMap_t t) : + Lemma (requires (hashMap_t_base_inv hm)) + (ensures (hashMap_s_inv (hashMap_t_v hm))) + +let hashMap_t_base_inv_implies_hashMap_s_inv #t hm = () // same as previous + +/// Introducing a "partial" version of the hash map invariant, which operates on +/// a suffix of the hash map. +let partial_hashMap_s_inv + (#t : Type0) (len : usize{len > 0}) (offset : usize) + (hm : hashMap_s t{offset + length hm <= usize_max}) : Type0 = + forall(i:nat{i < length hm}). {:pattern index hm i} slot_s_inv len (offset + i) (index hm i) + +/// Auxiliary lemma. +/// If a binding comes from a slot i, then its key is different from the keys +/// of the bindings in the other slots (because the hashes of the keys are distinct). +val binding_in_previous_slot_implies_neq + (#t : Type0) (len : usize{len > 0}) + (i : usize) (b : binding t) + (offset : usize{i < offset}) + (slots : hashMap_s t{offset + length slots <= usize_max}) : + Lemma + (requires ( + // The binding comes from a slot not in [slots] + hash_mod_key (fst b) len = i /\ + // The slots are the well-formed suffix of a hash map + partial_hashMap_s_inv len offset slots)) + (ensures ( + for_all (binding_neq b) (flatten slots))) + (decreases slots) + +#push-options "--z3rlimit 100 --fuel 1" +let rec binding_in_previous_slot_implies_neq #t len i b offset slots = + match slots with + | [] -> () + | s :: slots' -> + assert(slot_s_inv len offset (index slots 0)); // Triggers patterns + assert(slot_s_inv len offset s); + // Proving TARGET. We use quantifiers. + assert(for_all (same_hash_mod_key len offset) s); + forall_index_equiv_list_for_all (same_hash_mod_key len offset) s; + assert(forall (i:nat{i < length s}). same_hash_mod_key len offset (index s i)); + let aux (i:nat{i < length s}) : + Lemma + (requires (same_hash_mod_key len offset (index s i))) + (ensures (binding_neq b (index s i))) + [SMTPat (index s i)] = () + in + assert(forall (i:nat{i < length s}). binding_neq b (index s i)); + forall_index_equiv_list_for_all (binding_neq b) s; + assert(for_all (binding_neq b) s); // TARGET + // + assert(forall (i:nat{i < length slots'}). index slots' i == index slots (i+1)); // Triggers instantiations + binding_in_previous_slot_implies_neq len i b (offset+1) slots'; + for_all_append (binding_neq b) s (flatten slots') +#pop-options + +val partial_hashMap_s_inv_implies_assoc_list_lem + (#t : Type0) (len : usize{len > 0}) (offset : usize) + (hm : hashMap_s t{offset + length hm <= usize_max}) : + Lemma + (requires ( + partial_hashMap_s_inv len offset hm)) + (ensures (assoc_list_inv (flatten hm))) + (decreases (length hm + length (flatten hm))) + +#push-options "--fuel 1" +let rec partial_hashMap_s_inv_implies_assoc_list_lem #t len offset hm = + match hm with + | [] -> () + | slot :: hm' -> + assert(flatten hm == slot @ flatten hm'); + assert(forall (i:nat{i < length hm'}). index hm' i == index hm (i+1)); // Triggers instantiations + match slot with + | [] -> + assert(flatten hm == flatten hm'); + assert(partial_hashMap_s_inv len (offset+1) hm'); // Triggers instantiations + partial_hashMap_s_inv_implies_assoc_list_lem len (offset+1) hm' + | x :: slot' -> + assert(flatten (slot' :: hm') == slot' @ flatten hm'); + let hm'' = slot' :: hm' in + assert(forall (i:nat{0 < i /\ i < length hm''}). index hm'' i == index hm i); // Triggers instantiations + assert(forall (i:nat{0 < i /\ i < length hm''}). slot_s_inv len (offset + i) (index hm'' i)); + assert(index hm 0 == slot); // Triggers instantiations + assert(slot_s_inv len offset slot); + assert(slot_s_inv len offset slot'); + assert(partial_hashMap_s_inv len offset hm''); + partial_hashMap_s_inv_implies_assoc_list_lem len offset (slot' :: hm'); + // Proving that the key in `x` is different from all the other keys in + // the flattened map + assert(for_all (binding_neq x) slot'); + for_all_append (binding_neq x) slot' (flatten hm'); + assert(partial_hashMap_s_inv len (offset+1) hm'); + binding_in_previous_slot_implies_neq #t len offset x (offset+1) hm'; + assert(for_all (binding_neq x) (flatten hm')); + assert(for_all (binding_neq x) (flatten (slot' :: hm'))) +#pop-options + +val hashMap_s_inv_implies_assoc_list_lem + (#t : Type0) (hm : hashMap_s t) : + Lemma (requires (hashMap_s_inv hm)) + (ensures (assoc_list_inv (flatten hm))) + +let hashMap_s_inv_implies_assoc_list_lem #t hm = + partial_hashMap_s_inv_implies_assoc_list_lem (length hm) 0 hm + +val hashMap_t_base_inv_implies_assoc_list_lem + (#t : Type0) (hm : hashMap_t t): + Lemma (requires (hashMap_t_base_inv hm)) + (ensures (assoc_list_inv (hashMap_t_al_v hm))) + +let hashMap_t_base_inv_implies_assoc_list_lem #t hm = + hashMap_s_inv_implies_assoc_list_lem (hashMap_t_v hm) + +/// For some reason, we can't write the below [forall] directly in the [ensures] +/// clause of the next lemma: it makes Z3 fails even with a huge rlimit. +/// I have no idea what's going on. +let hashMap_is_assoc_list + (#t : Type0) (ntable : hashMap_t t{length ntable.slots > 0}) + (al : assoc_list t) : Type0 = + (forall (k:key). hashMap_t_find_s ntable k == assoc_list_find k al) + +let partial_hashMap_s_find + (#t : Type0) (len : usize{len > 0}) (offset : usize) + (hm : hashMap_s_nes t{offset + length hm = len}) + (k : key{hash_mod_key k len >= offset}) : option t = + let i = hash_mod_key k len in + let slot = index hm (i - offset) in + slot_s_find k slot + +val not_same_hash_key_not_found_in_slot + (#t : Type0) (len : usize{len > 0}) + (k : key) + (i : usize) + (slot : slot_s t) : + Lemma + (requires ( + hash_mod_key k len <> i /\ + slot_s_inv len i slot)) + (ensures (slot_s_find k slot == None)) + +#push-options "--fuel 1" +let rec not_same_hash_key_not_found_in_slot #t len k i slot = + match slot with + | [] -> () + | (k',v) :: slot' -> not_same_hash_key_not_found_in_slot len k i slot' +#pop-options + +/// Small variation of [binding_in_previous_slot_implies_neq]: if the hash of +/// a key links it to a previous slot, it can't be found in the slots after. +val key_in_previous_slot_implies_not_found + (#t : Type0) (len : usize{len > 0}) + (k : key) + (offset : usize) + (slots : hashMap_s t{offset + length slots = len}) : + Lemma + (requires ( + // The binding comes from a slot not in [slots] + hash_mod_key k len < offset /\ + // The slots are the well-formed suffix of a hash map + partial_hashMap_s_inv len offset slots)) + (ensures ( + assoc_list_find k (flatten slots) == None)) + (decreases slots) + +#push-options "--fuel 1" +let rec key_in_previous_slot_implies_not_found #t len k offset slots = + match slots with + | [] -> () + | slot :: slots' -> + find_append (same_key k) slot (flatten slots'); + assert(index slots 0 == slot); // Triggers instantiations + not_same_hash_key_not_found_in_slot #t len k offset slot; + assert(assoc_list_find k slot == None); + assert(forall (i:nat{i < length slots'}). index slots' i == index slots (i+1)); // Triggers instantiations + key_in_previous_slot_implies_not_found len k (offset+1) slots' +#pop-options + +val partial_hashMap_s_is_assoc_list_lem + (#t : Type0) (len : usize{len > 0}) (offset : usize) + (hm : hashMap_s_nes t{offset + length hm = len}) + (k : key{hash_mod_key k len >= offset}) : + Lemma + (requires ( + partial_hashMap_s_inv len offset hm)) + (ensures ( + partial_hashMap_s_find len offset hm k == assoc_list_find k (flatten hm))) + (decreases hm) + +#push-options "--fuel 1" +let rec partial_hashMap_s_is_assoc_list_lem #t len offset hm k = + match hm with + | [] -> () + | slot :: hm' -> + let h = hash_mod_key k len in + let i = h - offset in + if i = 0 then + begin + // We must look in the current slot + assert(partial_hashMap_s_find len offset hm k == slot_s_find k slot); + find_append (same_key k) slot (flatten hm'); + assert(forall (i:nat{i < length hm'}). index hm' i == index hm (i+1)); // Triggers instantiations + key_in_previous_slot_implies_not_found #t len k (offset+1) hm'; + assert( // Of course, writing `== None` doesn't work... + match find (same_key k) (flatten hm') with + | None -> True + | Some _ -> False); + assert( + find (same_key k) (flatten hm) == + begin match find (same_key k) slot with + | Some x -> Some x + | None -> find (same_key k) (flatten hm') + end); + () + end + else + begin + // We must ignore the current slot + assert(partial_hashMap_s_find len offset hm k == + partial_hashMap_s_find len (offset+1) hm' k); + find_append (same_key k) slot (flatten hm'); + assert(index hm 0 == slot); // Triggers instantiations + not_same_hash_key_not_found_in_slot #t len k offset slot; + assert(forall (i:nat{i < length hm'}). index hm' i == index hm (i+1)); // Triggers instantiations + partial_hashMap_s_is_assoc_list_lem #t len (offset+1) hm' k + end +#pop-options + +val hashMap_is_assoc_list_lem (#t : Type0) (hm : hashMap_t t) : + Lemma (requires (hashMap_t_base_inv hm)) + (ensures (hashMap_is_assoc_list hm (hashMap_t_al_v hm))) + +let hashMap_is_assoc_list_lem #t hm = + let aux (k:key) : + Lemma (hashMap_t_find_s hm k == assoc_list_find k (hashMap_t_al_v hm)) + [SMTPat (hashMap_t_find_s hm k)] = + let hm_v = hashMap_t_v hm in + let len = length hm_v in + partial_hashMap_s_is_assoc_list_lem #t len 0 hm_v k + in + () + +/// The final lemma about [move_elements]: calling it on an empty hash table moves +/// all the elements to this empty table. +val hashMap_move_elements_lem + (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) : + Lemma + (requires ( + let al = flatten (slots_t_v slots) in + hashMap_t_base_inv ntable /\ + length al <= usize_max /\ + assoc_list_inv al /\ + // The table is empty + hashMap_t_len_s ntable = 0 /\ + (forall (k:key). hashMap_t_find_s ntable k == None))) + (ensures ( + let al = flatten (slots_t_v slots) in + match hashMap_move_elements t ntable slots 0, + hashMap_move_elements_s_flat (hashMap_t_v ntable) al + with + | Return (ntable', _), Return ntable'_v -> + // The invariant is preserved + hashMap_t_base_inv ntable' /\ + // We preserved the parameters + hashMap_t_same_params ntable' ntable /\ + // The table has the same number of slots + length ntable'.slots = length ntable.slots /\ + // The count is good + hashMap_t_len_s ntable' = length al /\ + // The table can be linked to its model (we need this only to reveal + // "pretty" functional lemmas to the user in the fsti - so that we + // can write lemmas with SMT patterns - this is very F* specific) + hashMap_t_v ntable' == ntable'_v /\ + // The new table contains exactly all the bindings from the slots + // Rk.: see the comment for [hashMap_is_assoc_list] + hashMap_is_assoc_list ntable' al + | _ -> False // We can only succeed + )) + +// Weird, dirty things happen below. +// Manually unfolding some postconditions allowed to make the proof pass, +// and also revealed the reason why some proofs failed with "Unknown assertion +// failed" (resulting in the call to [flatten_0_is_flatten] for instance). +// I think manually unfolding the postconditions allowed to account for the +// lack of ifuel (this kind of proofs is annoying, really). +#restart-solver +#push-options "--z3rlimit 100" +let hashMap_move_elements_lem t ntable slots = + let ntable_v = hashMap_t_v ntable in + let slots_v = slots_t_v slots in + let al = flatten slots_v in + hashMap_move_elements_lem_refin t ntable slots 0; + begin + match hashMap_move_elements t ntable slots 0, + hashMap_move_elements_s ntable_v slots_v 0 + with + | Fail _, Fail _ -> () + | Return (ntable', _), Return ntable'_v -> + assert(hashMap_t_base_inv ntable'); + assert(hashMap_t_v ntable' == ntable'_v) + | _ -> assert(False) + end; + hashMap_move_elements_s_lem_refin_flat ntable_v slots_v 0; + begin + match hashMap_move_elements_s ntable_v slots_v 0, + hashMap_move_elements_s_flat ntable_v (flatten_i slots_v 0) + with + | Fail _, Fail _ -> () + | Return hm, Return hm' -> assert(hm == hm') + | _ -> assert(False) + end; + flatten_0_is_flatten slots_v; // flatten_i slots_v 0 == flatten slots_v + hashMap_move_elements_s_flat_lem ntable_v al; + match hashMap_move_elements t ntable slots 0, + hashMap_move_elements_s_flat ntable_v al + with + | Return (ntable', _), Return ntable'_v -> + assert(hashMap_t_base_inv ntable'); + assert(length ntable'.slots = length ntable.slots); + assert(hashMap_t_len_s ntable' = length al); + assert(hashMap_t_v ntable' == ntable'_v); + assert(hashMap_is_assoc_list ntable' al) + | _ -> assert(False) +#pop-options + +(*** try_resize *) + +/// High-level model 1. +/// This is one is slightly "crude": we just simplify a bit the function. + +let hashMap_try_resize_s_simpl + (#t : Type0) + (hm : hashMap_t t) : + Pure (result (hashMap_t t)) + (requires ( + let (divid, divis) = hm.max_load_factor in + divid > 0 /\ divis > 0)) + (ensures (fun _ -> True)) = + let capacity = length hm.slots in + let (divid, divis) = hm.max_load_factor in + if capacity <= (usize_max / 2) / divid then + let ncapacity : usize = capacity * 2 in + begin match hashMap_new_with_capacity t ncapacity divid divis with + | Fail e -> Fail e + | Return ntable -> + match hashMap_move_elements t ntable hm.slots 0 with + | Fail e -> Fail e + | Return (ntable', _) -> + let hm = + { hm with slots = ntable'.slots; + max_load = ntable'.max_load } + in + Return hm + end + else Return hm + +val hashMap_try_resize_lem_refin + (t : Type0) (self : hashMap_t t) : + Lemma + (requires ( + let (divid, divis) = self.max_load_factor in + divid > 0 /\ divis > 0)) + (ensures ( + match hashMap_try_resize t self, + hashMap_try_resize_s_simpl self + with + | Fail _, Fail _ -> True + | Return hm1, Return hm2 -> hm1 == hm2 + | _ -> False)) + +let hashMap_try_resize_lem_refin t self = () + +/// Isolating arithmetic proofs + +let gt_lem0 (n m q : nat) : + Lemma (requires (m > 0 /\ n > q)) + (ensures (n * m > q * m)) = () + +let ge_lem0 (n m q : nat) : + Lemma (requires (m > 0 /\ n >= q)) + (ensures (n * m >= q * m)) = () + +let gt_ge_trans (n m p : nat) : + Lemma (requires (n > m /\ m >= p)) (ensures (n > p)) = () + +let ge_trans (n m p : nat) : + Lemma (requires (n >= m /\ m >= p)) (ensures (n >= p)) = () + +#push-options "--z3rlimit 200" +let gt_lem1 (n m q : nat) : + Lemma (requires (m > 0 /\ n > q / m)) (ensures (n * m > q)) = + assert(n >= q / m + 1); + ge_lem0 n m (q / m + 1); + assert(n * m >= (q / m) * m + m) +#pop-options + +let gt_lem2 (n m p q : nat) : + Lemma (requires (m > 0 /\ p > 0 /\ n > (q / m) / p)) (ensures (n * m * p > q)) = + gt_lem1 n p (q / m); + assert(n * p > q / m); + gt_lem1 (n * p) m q + +let ge_lem1 (n m q : nat) : + Lemma (requires (n >= m /\ q > 0)) + (ensures (n / q >= m / q)) = + FStar.Math.Lemmas.lemma_div_le m n q + +#restart-solver +#push-options "--z3rlimit 200" +let times_divid_lem (n m p : pos) : Lemma ((n * m) / p >= n * (m / p)) + = + FStar.Math.Lemmas.multiply_fractions m p; + assert(m >= (m / p) * p); + assert(n * m >= n * (m / p) * p); // + ge_lem1 (n * m) (n * (m / p) * p) p; + assert((n * m) / p >= (n * (m / p) * p) / p); + assert(n * (m / p) * p = (n * (m / p)) * p); + FStar.Math.Lemmas.cancel_mul_div (n * (m / p)) p; + assert(((n * (m / p)) * p) / p = n * (m / p)) +#pop-options + +/// The good old arithmetic proofs and their unstability... +/// At some point I thought it was stable because it worked with `--quake 100`. +/// Of course, it broke the next time I checked the file... +/// It seems things are ok when we check this proof on its own, but not when +/// it is sent at the same time as the one above (though we put #restart-solver!). +/// I also tried `--quake 1/100` to no avail: it seems that when Z3 decides to +/// fail the first one, it fails them all. I inserted #restart-solver before +/// the previous lemma to see if it had an effect (of course not). +val new_max_load_lem + (len : usize) (capacity : usize{capacity > 0}) + (divid : usize{divid > 0}) (divis : usize{divis > 0}) : + Lemma + (requires ( + let max_load = (capacity * divid) / divis in + let ncapacity = 2 * capacity in + let nmax_load = (ncapacity * divid) / divis in + capacity > 0 /\ 0 < divid /\ divid < divis /\ + capacity * divid >= divis /\ + len = max_load + 1)) + (ensures ( + let max_load = (capacity * divid) / divis in + let ncapacity = 2 * capacity in + let nmax_load = (ncapacity * divid) / divis in + len <= nmax_load)) + +let mul_assoc (a b c : nat) : Lemma (a * b * c == a * (b * c)) = () + +let ge_lem2 (a b c d : nat) : Lemma (requires (a >= b + c /\ c >= d)) (ensures (a >= b + d)) = () +let ge_div_lem1 (a b : nat) : Lemma (requires (a >= b /\ b > 0)) (ensures (a / b >= 1)) = () + +#restart-solver +#push-options "--z3rlimit 100 --z3cliopt smt.arith.nl=false" +let new_max_load_lem len capacity divid divis = + FStar.Math.Lemmas.paren_mul_left 2 capacity divid; + mul_assoc 2 capacity divid; + // The following assertion often breaks though it is given by the above + // lemma. I really don't know what to do (I deactivated non-linear + // arithmetic and added the previous lemma call, moved the assertion up, + // boosted the rlimit...). + assert(2 * capacity * divid == 2 * (capacity * divid)); + let max_load = (capacity * divid) / divis in + let ncapacity = 2 * capacity in + let nmax_load = (ncapacity * divid) / divis in + assert(nmax_load = (2 * capacity * divid) / divis); + times_divid_lem 2 (capacity * divid) divis; + assert((2 * (capacity * divid)) / divis >= 2 * ((capacity * divid) / divis)); + assert(nmax_load >= 2 * ((capacity * divid) / divis)); + assert(nmax_load >= 2 * max_load); + assert(nmax_load >= max_load + max_load); + ge_div_lem1 (capacity * divid) divis; + ge_lem2 nmax_load max_load max_load 1; + assert(nmax_load >= max_load + 1) +#pop-options + +val hashMap_try_resize_s_simpl_lem (#t : Type0) (hm : hashMap_t t) : + Lemma + (requires ( + // The base invariant is satisfied + hashMap_t_base_inv hm /\ + // However, the "full" invariant is broken, as we call [try_resize] + // only if the current number of entries is > the max load. + // + // There are two situations: + // - either we just reached the max load + // - or we were already saturated and can't resize + (let (dividend, divisor) = hm.max_load_factor in + hm.num_entries == hm.max_load + 1 \/ + length hm.slots * 2 * dividend > usize_max) + )) + (ensures ( + match hashMap_try_resize_s_simpl hm with + | Fail _ -> False + | Return hm' -> + // The full invariant is now satisfied (the full invariant is "base + // invariant" + the map is not overloaded (or can't be resized because + // already too big) + hashMap_t_inv hm' /\ + // It contains the same bindings as the initial map + (forall (k:key). hashMap_t_find_s hm' k == hashMap_t_find_s hm k))) + +#restart-solver +#push-options "--z3rlimit 400" +let hashMap_try_resize_s_simpl_lem #t hm = + let capacity = length hm.slots in + let (divid, divis) = hm.max_load_factor in + if capacity <= (usize_max / 2) / divid then + begin + let ncapacity : usize = capacity * 2 in + assert(ncapacity * divid <= usize_max); + assert(hashMap_t_len_s hm = hm.max_load + 1); + new_max_load_lem (hashMap_t_len_s hm) capacity divid divis; + hashMap_new_with_capacity_lem t ncapacity divid divis; + match hashMap_new_with_capacity t ncapacity divid divis with + | Fail _ -> () + | Return ntable -> + let slots = hm.slots in + let al = flatten (slots_t_v slots) in + // Proving that: length al = hm.num_entries + assert(al == flatten (map slot_t_v slots)); + assert(al == flatten (map list_t_v slots)); + assert(hashMap_t_al_v hm == flatten (hashMap_t_v hm)); + assert(hashMap_t_al_v hm == flatten (map list_t_v hm.slots)); + assert(al == hashMap_t_al_v hm); + assert(hashMap_t_base_inv ntable); + assert(length al = hm.num_entries); + assert(length al <= usize_max); + hashMap_t_base_inv_implies_assoc_list_lem hm; + assert(assoc_list_inv al); + assert(hashMap_t_len_s ntable = 0); + assert(forall (k:key). hashMap_t_find_s ntable k == None); + hashMap_move_elements_lem t ntable hm.slots; + match hashMap_move_elements t ntable hm.slots 0 with + | Fail _ -> () + | Return (ntable', _) -> + hashMap_is_assoc_list_lem hm; + assert(hashMap_is_assoc_list hm (hashMap_t_al_v hm)); + let hm' = + { hm with slots = ntable'.slots; + max_load = ntable'.max_load } + in + assert(hashMap_t_base_inv ntable'); + assert(hashMap_t_base_inv hm'); + assert(hashMap_t_len_s hm' = hashMap_t_len_s hm); + new_max_load_lem (hashMap_t_len_s hm') capacity divid divis; + assert(hashMap_t_len_s hm' <= hm'.max_load); // Requires a lemma + assert(hashMap_t_inv hm') + end + else + begin + gt_lem2 capacity 2 divid usize_max; + assert(capacity * 2 * divid > usize_max) + end +#pop-options + +let hashMap_t_same_bindings (#t : Type0) (hm hm' : hashMap_t_nes t) : Type0 = + forall (k:key). hashMap_t_find_s hm k == hashMap_t_find_s hm' k + +/// The final lemma about [try_resize] +val hashMap_try_resize_lem (#t : Type0) (hm : hashMap_t t) : + Lemma + (requires ( + hashMap_t_base_inv hm /\ + // However, the "full" invariant is broken, as we call [try_resize] + // only if the current number of entries is > the max load. + // + // There are two situations: + // - either we just reached the max load + // - or we were already saturated and can't resize + (let (dividend, divisor) = hm.max_load_factor in + hm.num_entries == hm.max_load + 1 \/ + length hm.slots * 2 * dividend > usize_max))) + (ensures ( + match hashMap_try_resize t hm with + | Fail _ -> False + | Return hm' -> + // The full invariant is now satisfied (the full invariant is "base + // invariant" + the map is not overloaded (or can't be resized because + // already too big) + hashMap_t_inv hm' /\ + // The length is the same + hashMap_t_len_s hm' = hashMap_t_len_s hm /\ + // It contains the same bindings as the initial map + hashMap_t_same_bindings hm' hm)) + +let hashMap_try_resize_lem #t hm = + hashMap_try_resize_lem_refin t hm; + hashMap_try_resize_s_simpl_lem hm + +(*** insert *) + +/// The high-level model (very close to the original function: we don't need something +/// very high level, just to clean it a bit) +let hashMap_insert_s + (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + result (hashMap_t t) = + match hashMap_insert_no_resize t self key value with + | Fail e -> Fail e + | Return hm' -> + if hashMap_t_len_s hm' > hm'.max_load then + hashMap_try_resize t hm' + else Return hm' + +val hashMap_insert_lem_refin + (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + Lemma (requires True) + (ensures ( + match hashMap_insert t self key value, + hashMap_insert_s self key value + with + | Fail _, Fail _ -> True + | Return hm1, Return hm2 -> hm1 == hm2 + | _ -> False)) + +let hashMap_insert_lem_refin t self key value = () + +/// Helper +let hashMap_insert_bindings_lem + (t : Type0) (self : hashMap_t_nes t) (key : usize) (value : t) + (hm' hm'' : hashMap_t_nes t) : + Lemma + (requires ( + hashMap_s_updated_binding (hashMap_t_v self) key + (Some value) (hashMap_t_v hm') /\ + hashMap_t_same_bindings hm' hm'')) + (ensures ( + hashMap_s_updated_binding (hashMap_t_v self) key + (Some value) (hashMap_t_v hm''))) + = () + +val hashMap_insert_lem_aux + (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + Lemma (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_insert t self key value with + | Fail _ -> + // We can fail only if: + // - the key is not in the map and we need to add it + // - we are already saturated + hashMap_t_len_s self = usize_max /\ + None? (hashMap_t_find_s self key) + | Return hm' -> + // The invariant is preserved + hashMap_t_inv hm' /\ + // [key] maps to [value] and the other bindings are preserved + hashMap_s_updated_binding (hashMap_t_v self) key (Some value) (hashMap_t_v hm') /\ + // The length is incremented, iff we inserted a new key + (match hashMap_t_find_s self key with + | None -> hashMap_t_len_s hm' = hashMap_t_len_s self + 1 + | Some _ -> hashMap_t_len_s hm' = hashMap_t_len_s self))) + +#restart-solver +#push-options "--z3rlimit 200" +let hashMap_insert_lem_aux #t self key value = + hashMap_insert_no_resize_lem_s t self key value; + hashMap_insert_no_resize_s_lem (hashMap_t_v self) key value; + match hashMap_insert_no_resize t self key value with + | Fail _ -> () + | Return hm' -> + // Expanding the post of [hashMap_insert_no_resize_lem_s] + let self_v = hashMap_t_v self in + let hm'_v = Return?.v (hashMap_insert_no_resize_s self_v key value) in + assert(hashMap_t_base_inv hm'); + assert(hashMap_t_same_params hm' self); + assert(hashMap_t_v hm' == hm'_v); + assert(hashMap_s_len hm'_v == hashMap_t_len_s hm'); + // Expanding the post of [hashMap_insert_no_resize_s_lem] + assert(insert_post self_v key value hm'_v); + // Expanding [insert_post] + assert(hashMap_s_inv hm'_v); + assert( + match hashMap_s_find self_v key with + | None -> hashMap_s_len hm'_v = hashMap_s_len self_v + 1 + | Some _ -> hashMap_s_len hm'_v = hashMap_s_len self_v); + if hashMap_t_len_s hm' > hm'.max_load then + begin + hashMap_try_resize_lem hm'; + // Expanding the post of [hashMap_try_resize_lem] + let hm'' = Return?.v (hashMap_try_resize t hm') in + assert(hashMap_t_inv hm''); + let hm''_v = hashMap_t_v hm'' in + assert(forall k. hashMap_t_find_s hm'' k == hashMap_t_find_s hm' k); + assert(hashMap_t_len_s hm'' = hashMap_t_len_s hm'); // TODO + // Proving the post + assert(hashMap_t_inv hm''); + hashMap_insert_bindings_lem t self key value hm' hm''; + assert( + match hashMap_t_find_s self key with + | None -> hashMap_t_len_s hm'' = hashMap_t_len_s self + 1 + | Some _ -> hashMap_t_len_s hm'' = hashMap_t_len_s self) + end + else () +#pop-options + +let hashMap_insert_lem #t self key value = + hashMap_insert_lem_aux #t self key value + +(*** contains_key *) + +(**** contains_key_in_list *) + +val hashMap_contains_key_in_list_lem + (#t : Type0) (key : usize) (ls : list_t t) : + Lemma + (ensures ( + match hashMap_contains_key_in_list t key ls with + | Fail _ -> False + | Return b -> + b = Some? (slot_t_find_s key ls))) + + +#push-options "--fuel 1" +let rec hashMap_contains_key_in_list_lem #t key ls = + match ls with + | List_Cons ckey x ls0 -> + let b = ckey = key in + if b + then () + else + begin + hashMap_contains_key_in_list_lem key ls0; + match hashMap_contains_key_in_list t key ls0 with + | Fail _ -> () + | Return b0 -> () + end + | List_Nil -> () +#pop-options + +(**** contains_key *) + +val hashMap_contains_key_lem_aux + (#t : Type0) (self : hashMap_t_nes t) (key : usize) : + Lemma + (ensures ( + match hashMap_contains_key t self key with + | Fail _ -> False + | Return b -> b = Some? (hashMap_t_find_s self key))) + +let hashMap_contains_key_lem_aux #t self key = + begin match hash_key key with + | Fail _ -> () + | Return i -> + let v = self.slots in + let i0 = alloc_vec_Vec_len (list_t t) v in + begin match usize_rem i i0 with + | Fail _ -> () + | Return hash_mod -> + begin match alloc_vec_Vec_index_usize v hash_mod with + | Fail _ -> () + | Return l -> + hashMap_contains_key_in_list_lem key l; + begin match hashMap_contains_key_in_list t key l with + | Fail _ -> () + | Return b -> () + end + end + end + end + +/// The lemma in the .fsti +let hashMap_contains_key_lem #t self key = + hashMap_contains_key_lem_aux #t self key + +(*** get *) + +(**** get_in_list *) + +val hashMap_get_in_list_lem + (#t : Type0) (key : usize) (ls : list_t t) : + Lemma + (ensures ( + match hashMap_get_in_list t key ls, slot_t_find_s key ls with + | Fail _, None -> True + | Return x, Some x' -> x == x' + | _ -> False)) + +#push-options "--fuel 1" +let rec hashMap_get_in_list_lem #t key ls = + begin match ls with + | List_Cons ckey cvalue ls0 -> + let b = ckey = key in + if b + then () + else + begin + hashMap_get_in_list_lem key ls0; + match hashMap_get_in_list t key ls0 with + | Fail _ -> () + | Return x -> () + end + | List_Nil -> () + end +#pop-options + +(**** get *) + +val hashMap_get_lem_aux + (#t : Type0) (self : hashMap_t_nes t) (key : usize) : + Lemma + (ensures ( + match hashMap_get t self key, hashMap_t_find_s self key with + | Fail _, None -> True + | Return x, Some x' -> x == x' + | _ -> False)) + +let hashMap_get_lem_aux #t self key = + begin match hash_key key with + | Fail _ -> () + | Return i -> + let v = self.slots in + let i0 = alloc_vec_Vec_len (list_t t) v in + begin match usize_rem i i0 with + | Fail _ -> () + | Return hash_mod -> + begin match alloc_vec_Vec_index_usize v hash_mod with + | Fail _ -> () + | Return l -> + begin + hashMap_get_in_list_lem key l; + match hashMap_get_in_list t key l with + | Fail _ -> () + | Return x -> () + end + end + end + end + +/// .fsti +let hashMap_get_lem #t self key = hashMap_get_lem_aux #t self key + +(*** get_mut'fwd *) + + +(**** get_mut_in_list'fwd *) + +val hashMap_get_mut_in_list_loop_lem + (#t : Type0) (ls : list_t t) (key : usize) : + Lemma + (ensures ( + match hashMap_get_mut_in_list_loop t ls key, slot_t_find_s key ls with + | Fail _, None -> True + | Return x, Some x' -> x == x' + | _ -> False)) + +#push-options "--fuel 1" +let rec hashMap_get_mut_in_list_loop_lem #t ls key = + begin match ls with + | List_Cons ckey cvalue ls0 -> + let b = ckey = key in + if b + then () + else + begin + hashMap_get_mut_in_list_loop_lem ls0 key; + match hashMap_get_mut_in_list_loop t ls0 key with + | Fail _ -> () + | Return x -> () + end + | List_Nil -> () + end +#pop-options + +(**** get_mut'fwd *) + +val hashMap_get_mut_lem_aux + (#t : Type0) (self : hashMap_t_nes t) (key : usize) : + Lemma + (ensures ( + match hashMap_get_mut t self key, hashMap_t_find_s self key with + | Fail _, None -> True + | Return x, Some x' -> x == x' + | _ -> False)) + +let hashMap_get_mut_lem_aux #t self key = + begin match hash_key key with + | Fail _ -> () + | Return i -> + let v = self.slots in + let i0 = alloc_vec_Vec_len (list_t t) v in + begin match usize_rem i i0 with + | Fail _ -> () + | Return hash_mod -> + begin match alloc_vec_Vec_index_usize v hash_mod with + | Fail _ -> () + | Return l -> + begin + hashMap_get_mut_in_list_loop_lem l key; + match hashMap_get_mut_in_list_loop t l key with + | Fail _ -> () + | Return x -> () + end + end + end + end + +let hashMap_get_mut_lem #t self key = + hashMap_get_mut_lem_aux #t self key + +(*** get_mut'back *) + +(**** get_mut_in_list'back *) + +val hashMap_get_mut_in_list_loop_back_lem + (#t : Type0) (ls : list_t t) (key : usize) (ret : t) : + Lemma + (requires (Some? (slot_t_find_s key ls))) + (ensures ( + match hashMap_get_mut_in_list_loop_back t ls key ret with + | Fail _ -> False + | Return ls' -> list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,ret) + | _ -> False)) + +#push-options "--fuel 1" +let rec hashMap_get_mut_in_list_loop_back_lem #t ls key ret = + begin match ls with + | List_Cons ckey cvalue ls0 -> + let b = ckey = key in + if b + then let ls1 = List_Cons ckey ret ls0 in () + else + begin + hashMap_get_mut_in_list_loop_back_lem ls0 key ret; + match hashMap_get_mut_in_list_loop_back t ls0 key ret with + | Fail _ -> () + | Return l -> let ls1 = List_Cons ckey cvalue l in () + end + | List_Nil -> () + end +#pop-options + +(**** get_mut'back *) + +/// Refinement lemma +val hashMap_get_mut_back_lem_refin + (#t : Type0) (self : hashMap_t t{length self.slots > 0}) + (key : usize) (ret : t) : + Lemma + (requires (Some? (hashMap_t_find_s self key))) + (ensures ( + match hashMap_get_mut_back t self key ret with + | Fail _ -> False + | Return hm' -> + hashMap_t_v hm' == hashMap_insert_no_fail_s (hashMap_t_v self) key ret)) + +let hashMap_get_mut_back_lem_refin #t self key ret = + begin match hash_key key with + | Fail _ -> () + | Return i -> + let i0 = self.num_entries in + let p = self.max_load_factor in + let i1 = self.max_load in + let v = self.slots in + let i2 = alloc_vec_Vec_len (list_t t) v in + begin match usize_rem i i2 with + | Fail _ -> () + | Return hash_mod -> + begin match alloc_vec_Vec_index_usize v hash_mod with + | Fail _ -> () + | Return l -> + begin + hashMap_get_mut_in_list_loop_back_lem l key ret; + match hashMap_get_mut_in_list_loop_back t l key ret with + | Fail _ -> () + | Return l0 -> + begin match alloc_vec_Vec_update_usize v hash_mod l0 with + | Fail _ -> () + | Return v0 -> let self0 = MkhashMap_t i0 p i1 v0 in () + end + end + end + end + end + +/// Final lemma +val hashMap_get_mut_back_lem_aux + (#t : Type0) (hm : hashMap_t t) + (key : usize) (ret : t) : + Lemma + (requires ( + hashMap_t_inv hm /\ + Some? (hashMap_t_find_s hm key))) + (ensures ( + match hashMap_get_mut_back t hm key ret with + | Fail _ -> False + | Return hm' -> + // Functional spec + hashMap_t_v hm' == hashMap_insert_no_fail_s (hashMap_t_v hm) key ret /\ + // The invariant is preserved + hashMap_t_inv hm' /\ + // The length is preserved + hashMap_t_len_s hm' = hashMap_t_len_s hm /\ + // [key] maps to [value] + hashMap_t_find_s hm' key == Some ret /\ + // The other bindings are preserved + (forall k'. k' <> key ==> hashMap_t_find_s hm' k' == hashMap_t_find_s hm k'))) + +let hashMap_get_mut_back_lem_aux #t hm key ret = + let hm_v = hashMap_t_v hm in + hashMap_get_mut_back_lem_refin hm key ret; + match hashMap_get_mut_back t hm key ret with + | Fail _ -> assert(False) + | Return hm' -> + hashMap_insert_no_fail_s_lem hm_v key ret + +/// .fsti +let hashMap_get_mut_back_lem #t hm key ret = hashMap_get_mut_back_lem_aux hm key ret + +(*** remove'fwd *) + +val hashMap_remove_from_list_lem + (#t : Type0) (key : usize) (ls : list_t t) : + Lemma + (ensures ( + match hashMap_remove_from_list t key ls with + | Fail _ -> False + | Return opt_x -> + opt_x == slot_t_find_s key ls /\ + (Some? opt_x ==> length (slot_t_v ls) > 0))) + +#push-options "--fuel 1" +let rec hashMap_remove_from_list_lem #t key ls = + begin match ls with + | List_Cons ckey x tl -> + let b = ckey = key in + if b + then + let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in + begin match mv_ls with + | List_Cons i cvalue tl0 -> () + | List_Nil -> () + end + else + begin + hashMap_remove_from_list_lem key tl; + match hashMap_remove_from_list t key tl with + | Fail _ -> () + | Return opt -> () + end + | List_Nil -> () + end +#pop-options + +val hashMap_remove_lem_aux + (#t : Type0) (self : hashMap_t t) (key : usize) : + Lemma + (requires ( + // We need the invariant to prove that upon decrementing the entries counter, + // the counter doesn't become negative + hashMap_t_inv self)) + (ensures ( + match hashMap_remove t self key with + | Fail _ -> False + | Return opt_x -> opt_x == hashMap_t_find_s self key)) + +let hashMap_remove_lem_aux #t self key = + begin match hash_key key with + | Fail _ -> () + | Return i -> + let i0 = self.num_entries in + let v = self.slots in + let i1 = alloc_vec_Vec_len (list_t t) v in + begin match usize_rem i i1 with + | Fail _ -> () + | Return hash_mod -> + begin match alloc_vec_Vec_index_usize v hash_mod with + | Fail _ -> () + | Return l -> + begin + hashMap_remove_from_list_lem key l; + match hashMap_remove_from_list t key l with + | Fail _ -> () + | Return x -> + begin match x with + | None -> () + | Some x0 -> + begin + assert(l == index v hash_mod); + assert(length (list_t_v #t l) > 0); + length_flatten_index (hashMap_t_v self) hash_mod; + match usize_sub i0 1 with + | Fail _ -> () + | Return _ -> () + end + end + end + end + end + end + +/// .fsti +let hashMap_remove_lem #t self key = hashMap_remove_lem_aux #t self key + +(*** remove'back *) + +(**** Refinement proofs *) + +/// High-level model for [remove_from_list'back] +let hashMap_remove_from_list_s + (#t : Type0) (key : usize) (ls : slot_s t) : + slot_s t = + filter_one (not_same_key key) ls + +/// Refinement lemma +val hashMap_remove_from_list_back_lem_refin + (#t : Type0) (key : usize) (ls : list_t t) : + Lemma + (ensures ( + match hashMap_remove_from_list_back t key ls with + | Fail _ -> False + | Return ls' -> + list_t_v ls' == hashMap_remove_from_list_s key (list_t_v ls) /\ + // The length is decremented, iff the key was in the slot + (let len = length (list_t_v ls) in + let len' = length (list_t_v ls') in + match slot_s_find key (list_t_v ls) with + | None -> len = len' + | Some _ -> len = len' + 1))) + +#push-options "--fuel 1" +let rec hashMap_remove_from_list_back_lem_refin #t key ls = + begin match ls with + | List_Cons ckey x tl -> + let b = ckey = key in + if b + then + let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in + begin match mv_ls with + | List_Cons i cvalue tl0 -> () + | List_Nil -> () + end + else + begin + hashMap_remove_from_list_back_lem_refin key tl; + match hashMap_remove_from_list_back t key tl with + | Fail _ -> () + | Return l -> let ls0 = List_Cons ckey x l in () + end + | List_Nil -> () + end +#pop-options + +/// High-level model for [remove_from_list'back] +let hashMap_remove_s + (#t : Type0) (self : hashMap_s_nes t) (key : usize) : + hashMap_s t = + let len = length self in + let hash = hash_mod_key key len in + let slot = index self hash in + let slot' = hashMap_remove_from_list_s key slot in + list_update self hash slot' + +/// Refinement lemma +val hashMap_remove_back_lem_refin + (#t : Type0) (self : hashMap_t_nes t) (key : usize) : + Lemma + (requires ( + // We need the invariant to prove that upon decrementing the entries counter, + // the counter doesn't become negative + hashMap_t_inv self)) + (ensures ( + match hashMap_remove_back t self key with + | Fail _ -> False + | Return hm' -> + hashMap_t_same_params hm' self /\ + hashMap_t_v hm' == hashMap_remove_s (hashMap_t_v self) key /\ + // The length is decremented iff the key was in the map + (let len = hashMap_t_len_s self in + let len' = hashMap_t_len_s hm' in + match hashMap_t_find_s self key with + | None -> len = len' + | Some _ -> len = len' + 1))) + +let hashMap_remove_back_lem_refin #t self key = + begin match hash_key key with + | Fail _ -> () + | Return i -> + let i0 = self.num_entries in + let p = self.max_load_factor in + let i1 = self.max_load in + let v = self.slots in + let i2 = alloc_vec_Vec_len (list_t t) v in + begin match usize_rem i i2 with + | Fail _ -> () + | Return hash_mod -> + begin match alloc_vec_Vec_index_usize v hash_mod with + | Fail _ -> () + | Return l -> + begin + hashMap_remove_from_list_lem key l; + match hashMap_remove_from_list t key l with + | Fail _ -> () + | Return x -> + begin match x with + | None -> + begin + hashMap_remove_from_list_back_lem_refin key l; + match hashMap_remove_from_list_back t key l with + | Fail _ -> () + | Return l0 -> + begin + length_flatten_update (slots_t_v v) hash_mod (list_t_v l0); + match alloc_vec_Vec_update_usize v hash_mod l0 with + | Fail _ -> () + | Return v0 -> () + end + end + | Some x0 -> + begin + assert(l == index v hash_mod); + assert(length (list_t_v #t l) > 0); + length_flatten_index (hashMap_t_v self) hash_mod; + match usize_sub i0 1 with + | Fail _ -> () + | Return i3 -> + begin + hashMap_remove_from_list_back_lem_refin key l; + match hashMap_remove_from_list_back t key l with + | Fail _ -> () + | Return l0 -> + begin + length_flatten_update (slots_t_v v) hash_mod (list_t_v l0); + match alloc_vec_Vec_update_usize v hash_mod l0 with + | Fail _ -> () + | Return v0 -> () + end + end + end + end + end + end + end + end + +(**** Invariants, high-level properties *) + +val hashMap_remove_from_list_s_lem + (#t : Type0) (k : usize) (slot : slot_s t) (len : usize{len > 0}) (i : usize) : + Lemma + (requires (slot_s_inv len i slot)) + (ensures ( + let slot' = hashMap_remove_from_list_s k slot in + slot_s_inv len i slot' /\ + slot_s_find k slot' == None /\ + (forall (k':key{k' <> k}). slot_s_find k' slot' == slot_s_find k' slot) /\ + // This postcondition is necessary to prove that the invariant is preserved + // in the recursive calls. This allows us to do the proof in one go. + (forall (b:binding t). for_all (binding_neq b) slot ==> for_all (binding_neq b) slot') + )) + +#push-options "--fuel 1" +let rec hashMap_remove_from_list_s_lem #t key slot len i = + match slot with + | [] -> () + | (k',v) :: slot' -> + if k' <> key then + begin + hashMap_remove_from_list_s_lem key slot' len i; + let slot'' = hashMap_remove_from_list_s key slot' in + assert(for_all (same_hash_mod_key len i) ((k',v)::slot'')); + assert(for_all (binding_neq (k',v)) slot'); // Triggers instanciation + assert(for_all (binding_neq (k',v)) slot'') + end + else + begin + assert(for_all (binding_neq (k',v)) slot'); + for_all_binding_neq_find_lem key v slot' + end +#pop-options + +val hashMap_remove_s_lem + (#t : Type0) (self : hashMap_s_nes t) (key : usize) : + Lemma + (requires (hashMap_s_inv self)) + (ensures ( + let hm' = hashMap_remove_s self key in + // The invariant is preserved + hashMap_s_inv hm' /\ + // We updated the binding + hashMap_s_updated_binding self key None hm')) + +let hashMap_remove_s_lem #t self key = + let len = length self in + let hash = hash_mod_key key len in + let slot = index self hash in + hashMap_remove_from_list_s_lem key slot len hash; + let slot' = hashMap_remove_from_list_s key slot in + let hm' = list_update self hash slot' in + assert(hashMap_s_inv self) + +/// Final lemma about [remove'back] +val hashMap_remove_back_lem_aux + (#t : Type0) (self : hashMap_t t) (key : usize) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_remove_back t self key with + | Fail _ -> False + | Return hm' -> + hashMap_t_inv self /\ + hashMap_t_same_params hm' self /\ + // We updated the binding + hashMap_s_updated_binding (hashMap_t_v self) key None (hashMap_t_v hm') /\ + hashMap_t_v hm' == hashMap_remove_s (hashMap_t_v self) key /\ + // The length is decremented iff the key was in the map + (let len = hashMap_t_len_s self in + let len' = hashMap_t_len_s hm' in + match hashMap_t_find_s self key with + | None -> len = len' + | Some _ -> len = len' + 1))) + +let hashMap_remove_back_lem_aux #t self key = + hashMap_remove_back_lem_refin self key; + hashMap_remove_s_lem (hashMap_t_v self) key + +/// .fsti +let hashMap_remove_back_lem #t self key = + hashMap_remove_back_lem_aux #t self key diff --git a/tests/fstar-split/hashmap/Hashmap.Properties.fsti b/tests/fstar-split/hashmap/Hashmap.Properties.fsti new file mode 100644 index 00000000..26c0ec06 --- /dev/null +++ b/tests/fstar-split/hashmap/Hashmap.Properties.fsti @@ -0,0 +1,267 @@ +(** Properties about the hashmap *) +module Hashmap.Properties +open Primitives +open FStar.List.Tot +open FStar.Mul +open Hashmap.Types +open Hashmap.Clauses +open Hashmap.Funs + +#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" + +// Small trick to align the .fst and the .fsti +val _align_fsti : unit + +(*** Utilities *) + +type key : eqtype = usize + +type hash : eqtype = usize + +val hashMap_t_inv (#t : Type0) (hm : hashMap_t t) : Type0 + +val len_s (#t : Type0) (hm : hashMap_t t) : nat + +val find_s (#t : Type0) (hm : hashMap_t t) (k : key) : option t + +(*** Overloading *) + +/// Upon inserting *new* entries in the hash map, the slots vector is resized +/// whenever we reach the max load, unless we can't resize anymore because +/// there are already too many entries. This way, we maintain performance by +/// limiting the hash collisions. +/// This is expressed by the following property, which is maintained in the hash +/// map invariant. +val hashMap_not_overloaded_lem (#t : Type0) (hm : hashMap_t t) : + Lemma + (requires (hashMap_t_inv hm)) + (ensures ( + // The capacity is the number of slots + let capacity = length hm.slots in + // The max load factor defines a threshold on the number of entries: + // if there are more entries than a given fraction of the number of slots, + // we resize the slots vector to limit the hash collisions + let (dividend, divisor) = hm.max_load_factor in + // technicality: this postcondition won't typecheck if we don't reveal + // that divisor > 0 (because of the division) + divisor > 0 /\ + begin + // The max load, computed as a fraction of the capacity + let max_load = (capacity * dividend) / divisor in + // The number of entries inserted in the map is given by [len_s] (see + // the functional correctness lemmas, which state how this number evolves): + let len = len_s hm in + // We prove that: + // - either the number of entries is <= than the max load threshold + len <= max_load + // - or we couldn't resize the map, because then the arithmetic computations + // would overflow (note that we always multiply the number of slots by 2) + || 2* capacity * dividend > usize_max + end)) + +(*** Functional correctness *) +(**** [new'fwd] *) + +/// [new] doesn't fail and returns an empty hash map +val hashMap_new_lem (t : Type0) : + Lemma + (ensures ( + match hashMap_new t with + | Fail _ -> False + | Return hm -> + // The hash map invariant is satisfied + hashMap_t_inv hm /\ + // The hash map has a length of 0 + len_s hm = 0 /\ + // It contains no bindings + (forall k. find_s hm k == None))) + +(**** [clear] *) + +/// [clear] doesn't fail and turns the hash map into an empty map +val hashMap_clear_lem + (#t : Type0) (self : hashMap_t t) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_clear t self with + | Fail _ -> False + | Return hm -> + // The hash map invariant is satisfied + hashMap_t_inv hm /\ + // The hash map has a length of 0 + len_s hm = 0 /\ + // It contains no bindings + (forall k. find_s hm k == None))) + +(**** [len] *) + +/// [len] can't fail and returns the length (the number of elements) of the hash map +val hashMap_len_lem (#t : Type0) (self : hashMap_t t) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_len t self with + | Fail _ -> False + | Return l -> l = len_s self)) + + +(**** [insert'fwd_back] *) + +/// The backward function for [insert] (note it is named "...insert'fwd_back" because +/// the forward function doesn't return anything, and was thus filtered - in a +/// sense the effect of applying the forward function then the backward function is +/// entirely encompassed by the effect of the backward function alone). +/// +/// [insert'fwd_back] simply inserts a binding. +val hashMap_insert_lem + (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_insert t self key value with + | Fail _ -> + // We can fail only if: + // - the key is not in the map and we thus need to add it + None? (find_s self key) /\ + // - and we are already saturated (we can't increment the internal counter) + len_s self = usize_max + | Return hm' -> + // The invariant is preserved + hashMap_t_inv hm' /\ + // [key] maps to [value] + find_s hm' key == Some value /\ + // The other bindings are preserved + (forall k'. k' <> key ==> find_s hm' k' == find_s self k') /\ + begin + // The length is incremented, iff we inserted a new key + match find_s self key with + | None -> len_s hm' = len_s self + 1 + | Some _ -> len_s hm' = len_s self + end)) + + +(**** [contains_key] *) + +/// [contains_key'fwd] can't fail and returns `true` if and only if there is +/// a binding for key [key] +val hashMap_contains_key_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_contains_key t self key with + | Fail _ -> False + | Return b -> b = Some? (find_s self key))) + +(**** [get'fwd] *) + +/// [get] returns (a shared borrow to) the binding for key [key] +val hashMap_get_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_get t self key, find_s self key with + | Fail _, None -> True + | Return x, Some x' -> x == x' + | _ -> False)) + +(**** [get_mut'fwd] *) + +/// [get_mut'fwd] returns (a mutable borrow to) the binding for key [key]. +/// +/// The *forward* function models the action of getting a borrow to an element +/// in Rust, which gives the possibility of modifying this element in place. Then, +/// upon ending the borrow, the effect of the modification is modelled in the +/// translation through a call to the backward function. +val hashMap_get_mut_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_get_mut t self key, find_s self key with + | Fail _, None -> True + | Return x, Some x' -> x == x' + | _ -> False)) + + +(**** [get_mut'back] *) + +/// [get_mut'back] updates the binding for key [key], without failing. +/// A call to [get_mut'back] must follow a call to [get_mut'fwd], which gives +/// us that there must be a binding for key [key] in the map (otherwise we +/// can't prove the absence of failure). +val hashMap_get_mut_back_lem + (#t : Type0) (hm : hashMap_t t) (key : usize) (ret : t) : + Lemma + (requires ( + hashMap_t_inv hm /\ + // A call to the backward function must follow a call to the forward + // function, whose success gives us that there is a binding for the key. + // In the case of *forward* functions, "success" has to be understood as + // the absence of panics. When translating code from Rust to pure lambda + // calculus, we have the property that the generated calls to the backward + // functions can't fail (because their are preceded by calls to forward + // functions, which must then have succeeded before): for a backward function, + // "failure" is to be understood as the semantics getting stuck. + // This is of course true unless we filtered the call to the forward function + // because its effect is encompassed by the backward function, as with + // [hashMap_clear]). + Some? (find_s hm key))) + (ensures ( + match hashMap_get_mut_back t hm key ret with + | Fail _ -> False // Can't fail + | Return hm' -> + // The invariant is preserved + hashMap_t_inv hm' /\ + // The length is preserved + len_s hm' = len_s hm /\ + // [key] maps to the update value, [ret] + find_s hm' key == Some ret /\ + // The other bindings are preserved + (forall k'. k' <> key ==> find_s hm' k' == find_s hm k'))) + +(**** [remove'fwd] *) + +/// [remove'fwd] returns the (optional) element which has been removed from the map +/// (the rust function *moves* it out of the map). Note that the effect of the update +/// on the map is modelles through the call to [remove'back] ([remove] takes a +/// mutable borrow to the hash map as parameter). +val hashMap_remove_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_remove t self key with + | Fail _ -> False + | Return opt_x -> opt_x == find_s self key)) + + +(**** [remove'back] *) + +/// The hash map given as parameter to [remove] is given through a mutable borrow: +/// hence the backward function which gives back the updated map, without the +/// binding. +val hashMap_remove_back_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : + Lemma + (requires (hashMap_t_inv self)) + (ensures ( + match hashMap_remove_back t self key with + | Fail _ -> False + | Return hm' -> + // The invariant is preserved + hashMap_t_inv self /\ + // The binding for [key] is not there anymore + find_s hm' key == None /\ + // The other bindings are preserved + (forall k'. k' <> key ==> find_s hm' k' == find_s self k') /\ + begin + // The length is decremented iff the key was in the map + let len = len_s self in + let len' = len_s hm' in + match find_s self key with + | None -> len = len' + | Some _ -> len = len' + 1 + end)) diff --git a/tests/fstar-split/hashmap/Hashmap.Types.fst b/tests/fstar-split/hashmap/Hashmap.Types.fst new file mode 100644 index 00000000..ef96b1e9 --- /dev/null +++ b/tests/fstar-split/hashmap/Hashmap.Types.fst @@ -0,0 +1,23 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [hashmap]: type definitions *) +module Hashmap.Types +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [hashmap::List] + Source: 'src/hashmap.rs', lines 19:0-19:16 *) +type list_t (t : Type0) = +| List_Cons : usize -> t -> list_t t -> list_t t +| List_Nil : list_t t + +(** [hashmap::HashMap] + Source: 'src/hashmap.rs', lines 35:0-35:21 *) +type hashMap_t (t : Type0) = +{ + num_entries : usize; + max_load_factor : (usize & usize); + max_load : usize; + slots : alloc_vec_Vec (list_t t); +} + diff --git a/tests/fstar-split/hashmap/Makefile b/tests/fstar-split/hashmap/Makefile new file mode 100644 index 00000000..fa7d1f36 --- /dev/null +++ b/tests/fstar-split/hashmap/Makefile @@ -0,0 +1,49 @@ +# This file was automatically generated - modify ../Makefile.template instead +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_EXE ?= fstar.exe +FSTAR_NO_FLAGS = $(FSTAR_EXE) --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/tests/fstar-split/hashmap/Primitives.fst b/tests/fstar-split/hashmap/Primitives.fst new file mode 100644 index 00000000..a3ffbde4 --- /dev/null +++ b/tests/fstar-split/hashmap/Primitives.fst @@ -0,0 +1,884 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v + +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure +let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_RangeUsize_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_RangeUsize_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_mut_back = core_slice_index_RangeUsize_get_mut_back t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; + index_mut_back = core_slice_index_RangeUsize_index_mut_back t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] + = + admit() diff --git a/tests/fstar-split/hashmap_on_disk/HashmapMain.Clauses.Template.fst b/tests/fstar-split/hashmap_on_disk/HashmapMain.Clauses.Template.fst new file mode 100644 index 00000000..7b274f59 --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/HashmapMain.Clauses.Template.fst @@ -0,0 +1,72 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [hashmap_main]: templates for the decreases clauses *) +module HashmapMain.Clauses.Template +open Primitives +open HashmapMain.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: decreases clause + Source: 'src/hashmap.rs', lines 50:4-56:5 *) +unfold +let hashmap_HashMap_allocate_slots_loop_decreases (t : Type0) + (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : nat = + admit () + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: decreases clause + Source: 'src/hashmap.rs', lines 80:4-88:5 *) +unfold +let hashmap_HashMap_clear_loop_decreases (t : Type0) + (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : nat = + admit () + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: decreases clause + Source: 'src/hashmap.rs', lines 97:4-114:5 *) +unfold +let hashmap_HashMap_insert_in_list_loop_decreases (t : Type0) (key : usize) + (value : t) (ls : hashmap_List_t t) : nat = + admit () + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: decreases clause + Source: 'src/hashmap.rs', lines 183:4-196:5 *) +unfold +let hashmap_HashMap_move_elements_from_list_loop_decreases (t : Type0) + (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : nat = + admit () + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: decreases clause + Source: 'src/hashmap.rs', lines 171:4-180:5 *) +unfold +let hashmap_HashMap_move_elements_loop_decreases (t : Type0) + (ntable : hashmap_HashMap_t t) (slots : alloc_vec_Vec (hashmap_List_t t)) + (i : usize) : nat = + admit () + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: decreases clause + Source: 'src/hashmap.rs', lines 206:4-219:5 *) +unfold +let hashmap_HashMap_contains_key_in_list_loop_decreases (t : Type0) + (key : usize) (ls : hashmap_List_t t) : nat = + admit () + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: decreases clause + Source: 'src/hashmap.rs', lines 224:4-237:5 *) +unfold +let hashmap_HashMap_get_in_list_loop_decreases (t : Type0) (key : usize) + (ls : hashmap_List_t t) : nat = + admit () + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: decreases clause + Source: 'src/hashmap.rs', lines 245:4-254:5 *) +unfold +let hashmap_HashMap_get_mut_in_list_loop_decreases (t : Type0) + (ls : hashmap_List_t t) (key : usize) : nat = + admit () + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: decreases clause + Source: 'src/hashmap.rs', lines 265:4-291:5 *) +unfold +let hashmap_HashMap_remove_from_list_loop_decreases (t : Type0) (key : usize) + (ls : hashmap_List_t t) : nat = + admit () + diff --git a/tests/fstar-split/hashmap_on_disk/HashmapMain.Clauses.fst b/tests/fstar-split/hashmap_on_disk/HashmapMain.Clauses.fst new file mode 100644 index 00000000..be5a4ab1 --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/HashmapMain.Clauses.fst @@ -0,0 +1,61 @@ +(** [hashmap]: the decreases clauses *) +module HashmapMain.Clauses +open Primitives +open FStar.List.Tot +open HashmapMain.Types + +#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" + +(** [hashmap::HashMap::allocate_slots]: decreases clause *) +unfold +let hashmap_HashMap_allocate_slots_loop_decreases (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) + (n : usize) : nat = n + +(** [hashmap::HashMap::clear]: decreases clause *) +unfold +let hashmap_HashMap_clear_loop_decreases (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) + (i : usize) : nat = + if i < length slots then length slots - i else 0 + +(** [hashmap::HashMap::insert_in_list]: decreases clause *) +unfold +let hashmap_HashMap_insert_in_list_loop_decreases (t : Type0) (key : usize) (value : t) + (ls : hashmap_List_t t) : hashmap_List_t t = + ls + +(** [hashmap::HashMap::move_elements_from_list]: decreases clause *) +unfold +let hashmap_HashMap_move_elements_from_list_loop_decreases (t : Type0) + (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : hashmap_List_t t = + ls + +(** [hashmap::HashMap::move_elements]: decreases clause *) +unfold +let hashmap_HashMap_move_elements_loop_decreases (t : Type0) (ntable : hashmap_HashMap_t t) + (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : nat = + if i < length slots then length slots - i else 0 + +(** [hashmap::HashMap::contains_key_in_list]: decreases clause *) +unfold +let hashmap_HashMap_contains_key_in_list_loop_decreases (t : Type0) (key : usize) + (ls : hashmap_List_t t) : hashmap_List_t t = + ls + +(** [hashmap::HashMap::get_in_list]: decreases clause *) +unfold +let hashmap_HashMap_get_in_list_loop_decreases (t : Type0) (key : usize) (ls : hashmap_List_t t) : + hashmap_List_t t = + ls + +(** [hashmap::HashMap::get_mut_in_list]: decreases clause *) +unfold +let hashmap_HashMap_get_mut_in_list_loop_decreases (t : Type0) + (ls : hashmap_List_t t) (key : usize) : hashmap_List_t t = + ls + +(** [hashmap::HashMap::remove_from_list]: decreases clause *) +unfold +let hashmap_HashMap_remove_from_list_loop_decreases (t : Type0) (key : usize) + (ls : hashmap_List_t t) : hashmap_List_t t = + ls + diff --git a/tests/fstar-split/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar-split/hashmap_on_disk/HashmapMain.Funs.fst new file mode 100644 index 00000000..b2800e1e --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/HashmapMain.Funs.fst @@ -0,0 +1,576 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [hashmap_main]: function definitions *) +module HashmapMain.Funs +open Primitives +include HashmapMain.Types +include HashmapMain.FunsExternal +include HashmapMain.Clauses + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [hashmap_main::hashmap::hash_key]: forward function + Source: 'src/hashmap.rs', lines 27:0-27:32 *) +let hashmap_hash_key (k : usize) : result usize = + Return k + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: forward function + Source: 'src/hashmap.rs', lines 50:4-56:5 *) +let rec hashmap_HashMap_allocate_slots_loop + (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : + Tot (result (alloc_vec_Vec (hashmap_List_t t))) + (decreases (hashmap_HashMap_allocate_slots_loop_decreases t slots n)) + = + if n > 0 + then + let* slots1 = alloc_vec_Vec_push (hashmap_List_t t) slots Hashmap_List_Nil + in + let* n1 = usize_sub n 1 in + hashmap_HashMap_allocate_slots_loop t slots1 n1 + else Return slots + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: forward function + Source: 'src/hashmap.rs', lines 50:4-50:76 *) +let hashmap_HashMap_allocate_slots + (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : + result (alloc_vec_Vec (hashmap_List_t t)) + = + hashmap_HashMap_allocate_slots_loop t slots n + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new_with_capacity]: forward function + Source: 'src/hashmap.rs', lines 59:4-63:13 *) +let hashmap_HashMap_new_with_capacity + (t : Type0) (capacity : usize) (max_load_dividend : usize) + (max_load_divisor : usize) : + result (hashmap_HashMap_t t) + = + let v = alloc_vec_Vec_new (hashmap_List_t t) in + let* slots = hashmap_HashMap_allocate_slots t v capacity in + let* i = usize_mul capacity max_load_dividend in + let* i1 = usize_div i max_load_divisor in + Return + { + num_entries = 0; + max_load_factor = (max_load_dividend, max_load_divisor); + max_load = i1; + slots = slots + } + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new]: forward function + Source: 'src/hashmap.rs', lines 75:4-75:24 *) +let hashmap_HashMap_new (t : Type0) : result (hashmap_HashMap_t t) = + hashmap_HashMap_new_with_capacity t 32 4 5 + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 80:4-88:5 *) +let rec hashmap_HashMap_clear_loop + (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : + Tot (result (alloc_vec_Vec (hashmap_List_t t))) + (decreases (hashmap_HashMap_clear_loop_decreases t slots i)) + = + let i1 = alloc_vec_Vec_len (hashmap_List_t t) slots in + if i < i1 + then + let* i2 = usize_add i 1 in + let* slots1 = + alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) slots i + Hashmap_List_Nil in + hashmap_HashMap_clear_loop t slots1 i2 + else Return slots + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 80:4-80:27 *) +let hashmap_HashMap_clear + (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) = + let* v = hashmap_HashMap_clear_loop t self.slots 0 in + Return { self with num_entries = 0; slots = v } + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: forward function + Source: 'src/hashmap.rs', lines 90:4-90:30 *) +let hashmap_HashMap_len + (t : Type0) (self : hashmap_HashMap_t t) : result usize = + Return self.num_entries + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 97:4-114:5 *) +let rec hashmap_HashMap_insert_in_list_loop + (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : + Tot (result bool) + (decreases (hashmap_HashMap_insert_in_list_loop_decreases t key value ls)) + = + begin match ls with + | Hashmap_List_Cons ckey _ tl -> + if ckey = key + then Return false + else hashmap_HashMap_insert_in_list_loop t key value tl + | Hashmap_List_Nil -> Return true + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: forward function + Source: 'src/hashmap.rs', lines 97:4-97:71 *) +let hashmap_HashMap_insert_in_list + (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : result bool = + hashmap_HashMap_insert_in_list_loop t key value ls + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: backward function 0 + Source: 'src/hashmap.rs', lines 97:4-114:5 *) +let rec hashmap_HashMap_insert_in_list_loop_back + (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : + Tot (result (hashmap_List_t t)) + (decreases (hashmap_HashMap_insert_in_list_loop_decreases t key value ls)) + = + begin match ls with + | Hashmap_List_Cons ckey cvalue tl -> + if ckey = key + then Return (Hashmap_List_Cons ckey value tl) + else + let* tl1 = hashmap_HashMap_insert_in_list_loop_back t key value tl in + Return (Hashmap_List_Cons ckey cvalue tl1) + | Hashmap_List_Nil -> + let l = Hashmap_List_Nil in Return (Hashmap_List_Cons key value l) + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: backward function 0 + Source: 'src/hashmap.rs', lines 97:4-97:71 *) +let hashmap_HashMap_insert_in_list_back + (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : + result (hashmap_List_t t) + = + hashmap_HashMap_insert_in_list_loop_back t key value ls + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_no_resize]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 117:4-117:54 *) +let hashmap_HashMap_insert_no_resize + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) (value : t) : + result (hashmap_HashMap_t t) + = + let* hash = hashmap_hash_key key in + let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod in + let* inserted = hashmap_HashMap_insert_in_list t key value l in + if inserted + then + let* i1 = usize_add self.num_entries 1 in + let* l1 = hashmap_HashMap_insert_in_list_back t key value l in + let* v = + alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod l1 in + Return { self with num_entries = i1; slots = v } + else + let* l1 = hashmap_HashMap_insert_in_list_back t key value l in + let* v = + alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod l1 in + Return { self with slots = v } + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 183:4-196:5 *) +let rec hashmap_HashMap_move_elements_from_list_loop + (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : + Tot (result (hashmap_HashMap_t t)) + (decreases ( + hashmap_HashMap_move_elements_from_list_loop_decreases t ntable ls)) + = + begin match ls with + | Hashmap_List_Cons k v tl -> + let* ntable1 = hashmap_HashMap_insert_no_resize t ntable k v in + hashmap_HashMap_move_elements_from_list_loop t ntable1 tl + | Hashmap_List_Nil -> Return ntable + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 183:4-183:72 *) +let hashmap_HashMap_move_elements_from_list + (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : + result (hashmap_HashMap_t t) + = + hashmap_HashMap_move_elements_from_list_loop t ntable ls + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 171:4-180:5 *) +let rec hashmap_HashMap_move_elements_loop + (t : Type0) (ntable : hashmap_HashMap_t t) + (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : + Tot (result ((hashmap_HashMap_t t) & (alloc_vec_Vec (hashmap_List_t t)))) + (decreases (hashmap_HashMap_move_elements_loop_decreases t ntable slots i)) + = + let i1 = alloc_vec_Vec_len (hashmap_List_t t) slots in + if i < i1 + then + let* l = + alloc_vec_Vec_index_mut (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) slots i + in + let ls = core_mem_replace (hashmap_List_t t) l Hashmap_List_Nil in + let* ntable1 = hashmap_HashMap_move_elements_from_list t ntable ls in + let* i2 = usize_add i 1 in + let l1 = core_mem_replace_back (hashmap_List_t t) l Hashmap_List_Nil in + let* slots1 = + alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) slots i + l1 in + hashmap_HashMap_move_elements_loop t ntable1 slots1 i2 + else Return (ntable, slots) + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 171:4-171:95 *) +let hashmap_HashMap_move_elements + (t : Type0) (ntable : hashmap_HashMap_t t) + (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : + result ((hashmap_HashMap_t t) & (alloc_vec_Vec (hashmap_List_t t))) + = + hashmap_HashMap_move_elements_loop t ntable slots i + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::try_resize]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 140:4-140:28 *) +let hashmap_HashMap_try_resize + (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) = + let* max_usize = scalar_cast U32 Usize core_u32_max in + let capacity = alloc_vec_Vec_len (hashmap_List_t t) self.slots in + let* n1 = usize_div max_usize 2 in + let (i, i1) = self.max_load_factor in + let* i2 = usize_div n1 i in + if capacity <= i2 + then + let* i3 = usize_mul capacity 2 in + let* ntable = hashmap_HashMap_new_with_capacity t i3 i i1 in + let* (ntable1, _) = hashmap_HashMap_move_elements t ntable self.slots 0 in + Return + { ntable1 with num_entries = self.num_entries; max_load_factor = (i, i1) + } + else Return { self with max_load_factor = (i, i1) } + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/hashmap.rs', lines 129:4-129:48 *) +let hashmap_HashMap_insert + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) (value : t) : + result (hashmap_HashMap_t t) + = + let* self1 = hashmap_HashMap_insert_no_resize t self key value in + let* i = hashmap_HashMap_len t self1 in + if i > self1.max_load + then hashmap_HashMap_try_resize t self1 + else Return self1 + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 206:4-219:5 *) +let rec hashmap_HashMap_contains_key_in_list_loop + (t : Type0) (key : usize) (ls : hashmap_List_t t) : + Tot (result bool) + (decreases (hashmap_HashMap_contains_key_in_list_loop_decreases t key ls)) + = + begin match ls with + | Hashmap_List_Cons ckey _ tl -> + if ckey = key + then Return true + else hashmap_HashMap_contains_key_in_list_loop t key tl + | Hashmap_List_Nil -> Return false + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: forward function + Source: 'src/hashmap.rs', lines 206:4-206:68 *) +let hashmap_HashMap_contains_key_in_list + (t : Type0) (key : usize) (ls : hashmap_List_t t) : result bool = + hashmap_HashMap_contains_key_in_list_loop t key ls + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key]: forward function + Source: 'src/hashmap.rs', lines 199:4-199:49 *) +let hashmap_HashMap_contains_key + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result bool = + let* hash = hashmap_hash_key key in + let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod in + hashmap_HashMap_contains_key_in_list t key l + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 224:4-237:5 *) +let rec hashmap_HashMap_get_in_list_loop + (t : Type0) (key : usize) (ls : hashmap_List_t t) : + Tot (result t) + (decreases (hashmap_HashMap_get_in_list_loop_decreases t key ls)) + = + begin match ls with + | Hashmap_List_Cons ckey cvalue tl -> + if ckey = key + then Return cvalue + else hashmap_HashMap_get_in_list_loop t key tl + | Hashmap_List_Nil -> Fail Failure + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: forward function + Source: 'src/hashmap.rs', lines 224:4-224:70 *) +let hashmap_HashMap_get_in_list + (t : Type0) (key : usize) (ls : hashmap_List_t t) : result t = + hashmap_HashMap_get_in_list_loop t key ls + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get]: forward function + Source: 'src/hashmap.rs', lines 239:4-239:55 *) +let hashmap_HashMap_get + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result t = + let* hash = hashmap_hash_key key in + let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod in + hashmap_HashMap_get_in_list t key l + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 245:4-254:5 *) +let rec hashmap_HashMap_get_mut_in_list_loop + (t : Type0) (ls : hashmap_List_t t) (key : usize) : + Tot (result t) + (decreases (hashmap_HashMap_get_mut_in_list_loop_decreases t ls key)) + = + begin match ls with + | Hashmap_List_Cons ckey cvalue tl -> + if ckey = key + then Return cvalue + else hashmap_HashMap_get_mut_in_list_loop t tl key + | Hashmap_List_Nil -> Fail Failure + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: forward function + Source: 'src/hashmap.rs', lines 245:4-245:86 *) +let hashmap_HashMap_get_mut_in_list + (t : Type0) (ls : hashmap_List_t t) (key : usize) : result t = + hashmap_HashMap_get_mut_in_list_loop t ls key + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: backward function 0 + Source: 'src/hashmap.rs', lines 245:4-254:5 *) +let rec hashmap_HashMap_get_mut_in_list_loop_back + (t : Type0) (ls : hashmap_List_t t) (key : usize) (ret : t) : + Tot (result (hashmap_List_t t)) + (decreases (hashmap_HashMap_get_mut_in_list_loop_decreases t ls key)) + = + begin match ls with + | Hashmap_List_Cons ckey cvalue tl -> + if ckey = key + then Return (Hashmap_List_Cons ckey ret tl) + else + let* tl1 = hashmap_HashMap_get_mut_in_list_loop_back t tl key ret in + Return (Hashmap_List_Cons ckey cvalue tl1) + | Hashmap_List_Nil -> Fail Failure + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: backward function 0 + Source: 'src/hashmap.rs', lines 245:4-245:86 *) +let hashmap_HashMap_get_mut_in_list_back + (t : Type0) (ls : hashmap_List_t t) (key : usize) (ret : t) : + result (hashmap_List_t t) + = + hashmap_HashMap_get_mut_in_list_loop_back t ls key ret + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: forward function + Source: 'src/hashmap.rs', lines 257:4-257:67 *) +let hashmap_HashMap_get_mut + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result t = + let* hash = hashmap_hash_key key in + let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod in + hashmap_HashMap_get_mut_in_list t l key + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: backward function 0 + Source: 'src/hashmap.rs', lines 257:4-257:67 *) +let hashmap_HashMap_get_mut_back + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) (ret : t) : + result (hashmap_HashMap_t t) + = + let* hash = hashmap_hash_key key in + let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod in + let* l1 = hashmap_HashMap_get_mut_in_list_back t l key ret in + let* v = + alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod l1 in + Return { self with slots = v } + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: forward function + Source: 'src/hashmap.rs', lines 265:4-291:5 *) +let rec hashmap_HashMap_remove_from_list_loop + (t : Type0) (key : usize) (ls : hashmap_List_t t) : + Tot (result (option t)) + (decreases (hashmap_HashMap_remove_from_list_loop_decreases t key ls)) + = + begin match ls with + | Hashmap_List_Cons ckey x tl -> + if ckey = key + then + let mv_ls = + core_mem_replace (hashmap_List_t t) (Hashmap_List_Cons ckey x tl) + Hashmap_List_Nil in + begin match mv_ls with + | Hashmap_List_Cons _ cvalue _ -> Return (Some cvalue) + | Hashmap_List_Nil -> Fail Failure + end + else hashmap_HashMap_remove_from_list_loop t key tl + | Hashmap_List_Nil -> Return None + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: forward function + Source: 'src/hashmap.rs', lines 265:4-265:69 *) +let hashmap_HashMap_remove_from_list + (t : Type0) (key : usize) (ls : hashmap_List_t t) : result (option t) = + hashmap_HashMap_remove_from_list_loop t key ls + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: backward function 1 + Source: 'src/hashmap.rs', lines 265:4-291:5 *) +let rec hashmap_HashMap_remove_from_list_loop_back + (t : Type0) (key : usize) (ls : hashmap_List_t t) : + Tot (result (hashmap_List_t t)) + (decreases (hashmap_HashMap_remove_from_list_loop_decreases t key ls)) + = + begin match ls with + | Hashmap_List_Cons ckey x tl -> + if ckey = key + then + let mv_ls = + core_mem_replace (hashmap_List_t t) (Hashmap_List_Cons ckey x tl) + Hashmap_List_Nil in + begin match mv_ls with + | Hashmap_List_Cons _ _ tl1 -> Return tl1 + | Hashmap_List_Nil -> Fail Failure + end + else + let* tl1 = hashmap_HashMap_remove_from_list_loop_back t key tl in + Return (Hashmap_List_Cons ckey x tl1) + | Hashmap_List_Nil -> Return Hashmap_List_Nil + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: backward function 1 + Source: 'src/hashmap.rs', lines 265:4-265:69 *) +let hashmap_HashMap_remove_from_list_back + (t : Type0) (key : usize) (ls : hashmap_List_t t) : + result (hashmap_List_t t) + = + hashmap_HashMap_remove_from_list_loop_back t key ls + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: forward function + Source: 'src/hashmap.rs', lines 294:4-294:52 *) +let hashmap_HashMap_remove + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result (option t) = + let* hash = hashmap_hash_key key in + let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod in + let* x = hashmap_HashMap_remove_from_list t key l in + begin match x with + | None -> Return None + | Some x1 -> let* _ = usize_sub self.num_entries 1 in Return (Some x1) + end + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: backward function 0 + Source: 'src/hashmap.rs', lines 294:4-294:52 *) +let hashmap_HashMap_remove_back + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : + result (hashmap_HashMap_t t) + = + let* hash = hashmap_hash_key key in + let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in + let* hash_mod = usize_rem hash i in + let* l = + alloc_vec_Vec_index_mut (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod in + let* x = hashmap_HashMap_remove_from_list t key l in + begin match x with + | None -> + let* l1 = hashmap_HashMap_remove_from_list_back t key l in + let* v = + alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod l1 in + Return { self with slots = v } + | Some _ -> + let* i1 = usize_sub self.num_entries 1 in + let* l1 = hashmap_HashMap_remove_from_list_back t key l in + let* v = + alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) + self.slots hash_mod l1 in + Return { self with num_entries = i1; slots = v } + end + +(** [hashmap_main::hashmap::test1]: forward function + Source: 'src/hashmap.rs', lines 315:0-315:10 *) +let hashmap_test1 : result unit = + let* hm = hashmap_HashMap_new u64 in + let* hm1 = hashmap_HashMap_insert u64 hm 0 42 in + let* hm2 = hashmap_HashMap_insert u64 hm1 128 18 in + let* hm3 = hashmap_HashMap_insert u64 hm2 1024 138 in + let* hm4 = hashmap_HashMap_insert u64 hm3 1056 256 in + let* i = hashmap_HashMap_get u64 hm4 128 in + if not (i = 18) + then Fail Failure + else + let* hm5 = hashmap_HashMap_get_mut_back u64 hm4 1024 56 in + let* i1 = hashmap_HashMap_get u64 hm5 1024 in + if not (i1 = 56) + then Fail Failure + else + let* x = hashmap_HashMap_remove u64 hm5 1024 in + begin match x with + | None -> Fail Failure + | Some x1 -> + if not (x1 = 56) + then Fail Failure + else + let* hm6 = hashmap_HashMap_remove_back u64 hm5 1024 in + let* i2 = hashmap_HashMap_get u64 hm6 0 in + if not (i2 = 42) + then Fail Failure + else + let* i3 = hashmap_HashMap_get u64 hm6 128 in + if not (i3 = 18) + then Fail Failure + else + let* i4 = hashmap_HashMap_get u64 hm6 1056 in + if not (i4 = 256) then Fail Failure else Return () + end + +(** [hashmap_main::insert_on_disk]: forward function + Source: 'src/hashmap_main.rs', lines 7:0-7:43 *) +let insert_on_disk + (key : usize) (value : u64) (st : state) : result (state & unit) = + let* (st1, hm) = hashmap_utils_deserialize st in + let* hm1 = hashmap_HashMap_insert u64 hm key value in + let* (st2, _) = hashmap_utils_serialize hm1 st1 in + Return (st2, ()) + +(** [hashmap_main::main]: forward function + Source: 'src/hashmap_main.rs', lines 16:0-16:13 *) +let main : result unit = + Return () + diff --git a/tests/fstar-split/hashmap_on_disk/HashmapMain.FunsExternal.fsti b/tests/fstar-split/hashmap_on_disk/HashmapMain.FunsExternal.fsti new file mode 100644 index 00000000..b00bbcde --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/HashmapMain.FunsExternal.fsti @@ -0,0 +1,18 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [hashmap_main]: external function declarations *) +module HashmapMain.FunsExternal +open Primitives +include HashmapMain.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [hashmap_main::hashmap_utils::deserialize]: forward function + Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *) +val hashmap_utils_deserialize + : state -> result (state & (hashmap_HashMap_t u64)) + +(** [hashmap_main::hashmap_utils::serialize]: forward function + Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *) +val hashmap_utils_serialize + : hashmap_HashMap_t u64 -> state -> result (state & unit) + diff --git a/tests/fstar-split/hashmap_on_disk/HashmapMain.Properties.fst b/tests/fstar-split/hashmap_on_disk/HashmapMain.Properties.fst new file mode 100644 index 00000000..358df29e --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/HashmapMain.Properties.fst @@ -0,0 +1,48 @@ +(** Properties about the hashmap written on disk *) +module HashmapMain.Properties +open Primitives +open HashmapMain.Funs + +#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" + +/// Below, we focus on the functions to read from disk/write to disk to showcase +/// how such reasoning which mixes opaque functions together with a state-error +/// monad can be performed. + +(*** Hypotheses *) + +/// [state_v] gives us the hash map currently stored on disk +assume +val state_v : state -> hashmap_HashMap_t u64 + +/// [serialize] updates the hash map stored on disk +assume +val serialize_lem (hm : hashmap_HashMap_t u64) (st : state) : Lemma ( + match hashmap_utils_serialize hm st with + | Fail _ -> True + | Return (st', ()) -> state_v st' == hm) + [SMTPat (hashmap_utils_serialize hm st)] + +/// [deserialize] gives us the hash map stored on disk, without updating it +assume +val deserialize_lem (st : state) : Lemma ( + match hashmap_utils_deserialize st with + | Fail _ -> True + | Return (st', hm) -> hm == state_v st /\ st' == st) + [SMTPat (hashmap_utils_deserialize st)] + +(*** Lemmas *) + +/// The obvious lemma about [insert_on_disk]: the updated hash map stored on disk +/// is exactly the hash map produced from inserting the binding ([key], [value]) +/// in the hash map previously stored on disk. +val insert_on_disk_lem (key : usize) (value : u64) (st : state) : Lemma ( + match insert_on_disk key value st with + | Fail _ -> True + | Return (st', ()) -> + let hm = state_v st in + match hashmap_HashMap_insert u64 hm key value with + | Fail _ -> False + | Return hm' -> hm' == state_v st') + +let insert_on_disk_lem key value st = () diff --git a/tests/fstar-split/hashmap_on_disk/HashmapMain.Types.fst b/tests/fstar-split/hashmap_on_disk/HashmapMain.Types.fst new file mode 100644 index 00000000..afebcde3 --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/HashmapMain.Types.fst @@ -0,0 +1,24 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [hashmap_main]: type definitions *) +module HashmapMain.Types +open Primitives +include HashmapMain.TypesExternal + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [hashmap_main::hashmap::List] + Source: 'src/hashmap.rs', lines 19:0-19:16 *) +type hashmap_List_t (t : Type0) = +| Hashmap_List_Cons : usize -> t -> hashmap_List_t t -> hashmap_List_t t +| Hashmap_List_Nil : hashmap_List_t t + +(** [hashmap_main::hashmap::HashMap] + Source: 'src/hashmap.rs', lines 35:0-35:21 *) +type hashmap_HashMap_t (t : Type0) = +{ + num_entries : usize; + max_load_factor : (usize & usize); + max_load : usize; + slots : alloc_vec_Vec (hashmap_List_t t); +} + diff --git a/tests/fstar-split/hashmap_on_disk/HashmapMain.TypesExternal.fsti b/tests/fstar-split/hashmap_on_disk/HashmapMain.TypesExternal.fsti new file mode 100644 index 00000000..75747408 --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/HashmapMain.TypesExternal.fsti @@ -0,0 +1,10 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [hashmap_main]: external type declarations *) +module HashmapMain.TypesExternal +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** The state type used in the state-error monad *) +val state : Type0 + diff --git a/tests/fstar-split/hashmap_on_disk/Makefile b/tests/fstar-split/hashmap_on_disk/Makefile new file mode 100644 index 00000000..fa7d1f36 --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/Makefile @@ -0,0 +1,49 @@ +# This file was automatically generated - modify ../Makefile.template instead +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_EXE ?= fstar.exe +FSTAR_NO_FLAGS = $(FSTAR_EXE) --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/tests/fstar-split/hashmap_on_disk/Primitives.fst b/tests/fstar-split/hashmap_on_disk/Primitives.fst new file mode 100644 index 00000000..a3ffbde4 --- /dev/null +++ b/tests/fstar-split/hashmap_on_disk/Primitives.fst @@ -0,0 +1,884 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v + +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure +let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_RangeUsize_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_RangeUsize_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_mut_back = core_slice_index_RangeUsize_get_mut_back t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; + index_mut_back = core_slice_index_RangeUsize_index_mut_back t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] + = + admit() diff --git a/tests/fstar-split/misc/Bitwise.fst b/tests/fstar-split/misc/Bitwise.fst new file mode 100644 index 00000000..d7ba2c57 --- /dev/null +++ b/tests/fstar-split/misc/Bitwise.fst @@ -0,0 +1,32 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [bitwise] *) +module Bitwise +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [bitwise::shift_u32]: forward function + Source: 'src/bitwise.rs', lines 3:0-3:31 *) +let shift_u32 (a : u32) : result u32 = + let* t = u32_shr #Usize a 16 in u32_shl #Usize t 16 + +(** [bitwise::shift_i32]: forward function + Source: 'src/bitwise.rs', lines 10:0-10:31 *) +let shift_i32 (a : i32) : result i32 = + let* t = i32_shr #Isize a 16 in i32_shl #Isize t 16 + +(** [bitwise::xor_u32]: forward function + Source: 'src/bitwise.rs', lines 17:0-17:37 *) +let xor_u32 (a : u32) (b : u32) : result u32 = + Return (u32_xor a b) + +(** [bitwise::or_u32]: forward function + Source: 'src/bitwise.rs', lines 21:0-21:36 *) +let or_u32 (a : u32) (b : u32) : result u32 = + Return (u32_or a b) + +(** [bitwise::and_u32]: forward function + Source: 'src/bitwise.rs', lines 25:0-25:37 *) +let and_u32 (a : u32) (b : u32) : result u32 = + Return (u32_and a b) + diff --git a/tests/fstar-split/misc/Constants.fst b/tests/fstar-split/misc/Constants.fst new file mode 100644 index 00000000..7e56cc20 --- /dev/null +++ b/tests/fstar-split/misc/Constants.fst @@ -0,0 +1,145 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [constants] *) +module Constants +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [constants::X0] + Source: 'src/constants.rs', lines 5:0-5:17 *) +let x0_body : result u32 = Return 0 +let x0_c : u32 = eval_global x0_body + +(** [constants::X1] + Source: 'src/constants.rs', lines 7:0-7:17 *) +let x1_body : result u32 = Return core_u32_max +let x1_c : u32 = eval_global x1_body + +(** [constants::X2] + Source: 'src/constants.rs', lines 10:0-10:17 *) +let x2_body : result u32 = Return 3 +let x2_c : u32 = eval_global x2_body + +(** [constants::incr]: forward function + Source: 'src/constants.rs', lines 17:0-17:32 *) +let incr (n : u32) : result u32 = + u32_add n 1 + +(** [constants::X3] + Source: 'src/constants.rs', lines 15:0-15:17 *) +let x3_body : result u32 = incr 32 +let x3_c : u32 = eval_global x3_body + +(** [constants::mk_pair0]: forward function + Source: 'src/constants.rs', lines 23:0-23:51 *) +let mk_pair0 (x : u32) (y : u32) : result (u32 & u32) = + Return (x, y) + +(** [constants::Pair] + Source: 'src/constants.rs', lines 36:0-36:23 *) +type pair_t (t1 t2 : Type0) = { x : t1; y : t2; } + +(** [constants::mk_pair1]: forward function + Source: 'src/constants.rs', lines 27:0-27:55 *) +let mk_pair1 (x : u32) (y : u32) : result (pair_t u32 u32) = + Return { x = x; y = y } + +(** [constants::P0] + Source: 'src/constants.rs', lines 31:0-31:24 *) +let p0_body : result (u32 & u32) = mk_pair0 0 1 +let p0_c : (u32 & u32) = eval_global p0_body + +(** [constants::P1] + Source: 'src/constants.rs', lines 32:0-32:28 *) +let p1_body : result (pair_t u32 u32) = mk_pair1 0 1 +let p1_c : pair_t u32 u32 = eval_global p1_body + +(** [constants::P2] + Source: 'src/constants.rs', lines 33:0-33:24 *) +let p2_body : result (u32 & u32) = Return (0, 1) +let p2_c : (u32 & u32) = eval_global p2_body + +(** [constants::P3] + Source: 'src/constants.rs', lines 34:0-34:28 *) +let p3_body : result (pair_t u32 u32) = Return { x = 0; y = 1 } +let p3_c : pair_t u32 u32 = eval_global p3_body + +(** [constants::Wrap] + Source: 'src/constants.rs', lines 49:0-49:18 *) +type wrap_t (t : Type0) = { value : t; } + +(** [constants::{constants::Wrap}::new]: forward function + Source: 'src/constants.rs', lines 54:4-54:41 *) +let wrap_new (t : Type0) (value : t) : result (wrap_t t) = + Return { value = value } + +(** [constants::Y] + Source: 'src/constants.rs', lines 41:0-41:22 *) +let y_body : result (wrap_t i32) = wrap_new i32 2 +let y_c : wrap_t i32 = eval_global y_body + +(** [constants::unwrap_y]: forward function + Source: 'src/constants.rs', lines 43:0-43:30 *) +let unwrap_y : result i32 = + Return y_c.value + +(** [constants::YVAL] + Source: 'src/constants.rs', lines 47:0-47:19 *) +let yval_body : result i32 = unwrap_y +let yval_c : i32 = eval_global yval_body + +(** [constants::get_z1::Z1] + Source: 'src/constants.rs', lines 62:4-62:17 *) +let get_z1_z1_body : result i32 = Return 3 +let get_z1_z1_c : i32 = eval_global get_z1_z1_body + +(** [constants::get_z1]: forward function + Source: 'src/constants.rs', lines 61:0-61:28 *) +let get_z1 : result i32 = + Return get_z1_z1_c + +(** [constants::add]: forward function + Source: 'src/constants.rs', lines 66:0-66:39 *) +let add (a : i32) (b : i32) : result i32 = + i32_add a b + +(** [constants::Q1] + Source: 'src/constants.rs', lines 74:0-74:17 *) +let q1_body : result i32 = Return 5 +let q1_c : i32 = eval_global q1_body + +(** [constants::Q2] + Source: 'src/constants.rs', lines 75:0-75:17 *) +let q2_body : result i32 = Return q1_c +let q2_c : i32 = eval_global q2_body + +(** [constants::Q3] + Source: 'src/constants.rs', lines 76:0-76:17 *) +let q3_body : result i32 = add q2_c 3 +let q3_c : i32 = eval_global q3_body + +(** [constants::get_z2]: forward function + Source: 'src/constants.rs', lines 70:0-70:28 *) +let get_z2 : result i32 = + let* i = get_z1 in let* i1 = add i q3_c in add q1_c i1 + +(** [constants::S1] + Source: 'src/constants.rs', lines 80:0-80:18 *) +let s1_body : result u32 = Return 6 +let s1_c : u32 = eval_global s1_body + +(** [constants::S2] + Source: 'src/constants.rs', lines 81:0-81:18 *) +let s2_body : result u32 = incr s1_c +let s2_c : u32 = eval_global s2_body + +(** [constants::S3] + Source: 'src/constants.rs', lines 82:0-82:29 *) +let s3_body : result (pair_t u32 u32) = Return p3_c +let s3_c : pair_t u32 u32 = eval_global s3_body + +(** [constants::S4] + Source: 'src/constants.rs', lines 83:0-83:29 *) +let s4_body : result (pair_t u32 u32) = mk_pair1 7 8 +let s4_c : pair_t u32 u32 = eval_global s4_body + diff --git a/tests/fstar-split/misc/External.Funs.fst b/tests/fstar-split/misc/External.Funs.fst new file mode 100644 index 00000000..3b84697e --- /dev/null +++ b/tests/fstar-split/misc/External.Funs.fst @@ -0,0 +1,84 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [external]: function definitions *) +module External.Funs +open Primitives +include External.Types +include External.FunsExternal + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [external::swap]: forward function + Source: 'src/external.rs', lines 6:0-6:46 *) +let swap (t : Type0) (x : t) (y : t) (st : state) : result (state & unit) = + let* (st1, _) = core_mem_swap t x y st in + let* (st2, _) = core_mem_swap_back0 t x y st st1 in + let* (st3, _) = core_mem_swap_back1 t x y st st2 in + Return (st3, ()) + +(** [external::swap]: backward function 0 + Source: 'src/external.rs', lines 6:0-6:46 *) +let swap_back + (t : Type0) (x : t) (y : t) (st : state) (st1 : state) : + result (state & (t & t)) + = + let* (st2, _) = core_mem_swap t x y st in + let* (st3, x1) = core_mem_swap_back0 t x y st st2 in + let* (_, y1) = core_mem_swap_back1 t x y st st3 in + Return (st1, (x1, y1)) + +(** [external::test_new_non_zero_u32]: forward function + Source: 'src/external.rs', lines 11:0-11:60 *) +let test_new_non_zero_u32 + (x : u32) (st : state) : result (state & core_num_nonzero_NonZeroU32_t) = + let* (st1, o) = core_num_nonzero_NonZeroU32_new x st in + core_option_Option_unwrap core_num_nonzero_NonZeroU32_t o st1 + +(** [external::test_vec]: forward function + Source: 'src/external.rs', lines 17:0-17:17 *) +let test_vec : result unit = + let v = alloc_vec_Vec_new u32 in + let* _ = alloc_vec_Vec_push u32 v 0 in + Return () + +(** Unit test for [external::test_vec] *) +let _ = assert_norm (test_vec = Return ()) + +(** [external::custom_swap]: forward function + Source: 'src/external.rs', lines 24:0-24:66 *) +let custom_swap (t : Type0) (x : t) (y : t) (st : state) : result (state & t) = + let* (st1, _) = core_mem_swap t x y st in + let* (st2, x1) = core_mem_swap_back0 t x y st st1 in + let* (st3, _) = core_mem_swap_back1 t x y st st2 in + Return (st3, x1) + +(** [external::custom_swap]: backward function 0 + Source: 'src/external.rs', lines 24:0-24:66 *) +let custom_swap_back + (t : Type0) (x : t) (y : t) (st : state) (ret : t) (st1 : state) : + result (state & (t & t)) + = + let* (st2, _) = core_mem_swap t x y st in + let* (st3, _) = core_mem_swap_back0 t x y st st2 in + let* (_, y1) = core_mem_swap_back1 t x y st st3 in + Return (st1, (ret, y1)) + +(** [external::test_custom_swap]: forward function + Source: 'src/external.rs', lines 29:0-29:59 *) +let test_custom_swap (x : u32) (y : u32) (st : state) : result (state & unit) = + let* (st1, _) = custom_swap u32 x y st in Return (st1, ()) + +(** [external::test_custom_swap]: backward function 0 + Source: 'src/external.rs', lines 29:0-29:59 *) +let test_custom_swap_back + (x : u32) (y : u32) (st : state) (st1 : state) : + result (state & (u32 & u32)) + = + custom_swap_back u32 x y st 1 st1 + +(** [external::test_swap_non_zero]: forward function + Source: 'src/external.rs', lines 35:0-35:44 *) +let test_swap_non_zero (x : u32) (st : state) : result (state & u32) = + let* (st1, _) = swap u32 x 0 st in + let* (st2, (x1, _)) = swap_back u32 x 0 st st1 in + if x1 = 0 then Fail Failure else Return (st2, x1) + diff --git a/tests/fstar-split/misc/External.FunsExternal.fsti b/tests/fstar-split/misc/External.FunsExternal.fsti new file mode 100644 index 00000000..923a1101 --- /dev/null +++ b/tests/fstar-split/misc/External.FunsExternal.fsti @@ -0,0 +1,32 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [external]: external function declarations *) +module External.FunsExternal +open Primitives +include External.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [core::mem::swap]: forward function + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) +val core_mem_swap (t : Type0) : t -> t -> state -> result (state & unit) + +(** [core::mem::swap]: backward function 0 + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) +val core_mem_swap_back0 + (t : Type0) : t -> t -> state -> state -> result (state & t) + +(** [core::mem::swap]: backward function 1 + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) +val core_mem_swap_back1 + (t : Type0) : t -> t -> state -> state -> result (state & t) + +(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *) +val core_num_nonzero_NonZeroU32_new + : u32 -> state -> result (state & (option core_num_nonzero_NonZeroU32_t)) + +(** [core::option::{core::option::Option}::unwrap]: forward function + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) +val core_option_Option_unwrap + (t : Type0) : option t -> state -> result (state & t) + diff --git a/tests/fstar-split/misc/External.Types.fst b/tests/fstar-split/misc/External.Types.fst new file mode 100644 index 00000000..4fbcec47 --- /dev/null +++ b/tests/fstar-split/misc/External.Types.fst @@ -0,0 +1,8 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [external]: type definitions *) +module External.Types +open Primitives +include External.TypesExternal + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + diff --git a/tests/fstar-split/misc/External.TypesExternal.fsti b/tests/fstar-split/misc/External.TypesExternal.fsti new file mode 100644 index 00000000..4bfbe0c5 --- /dev/null +++ b/tests/fstar-split/misc/External.TypesExternal.fsti @@ -0,0 +1,14 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [external]: external type declarations *) +module External.TypesExternal +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [core::num::nonzero::NonZeroU32] + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 *) +val core_num_nonzero_NonZeroU32_t : Type0 + +(** The state type used in the state-error monad *) +val state : Type0 + diff --git a/tests/fstar-split/misc/Loops.Clauses.Template.fst b/tests/fstar-split/misc/Loops.Clauses.Template.fst new file mode 100644 index 00000000..6be351c6 --- /dev/null +++ b/tests/fstar-split/misc/Loops.Clauses.Template.fst @@ -0,0 +1,131 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [loops]: templates for the decreases clauses *) +module Loops.Clauses.Template +open Primitives +open Loops.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [loops::sum]: decreases clause + Source: 'src/loops.rs', lines 4:0-14:1 *) +unfold let sum_loop_decreases (max : u32) (i : u32) (s : u32) : nat = admit () + +(** [loops::sum_with_mut_borrows]: decreases clause + Source: 'src/loops.rs', lines 19:0-31:1 *) +unfold +let sum_with_mut_borrows_loop_decreases (max : u32) (mi : u32) (ms : u32) : nat + = + admit () + +(** [loops::sum_with_shared_borrows]: decreases clause + Source: 'src/loops.rs', lines 34:0-48:1 *) +unfold +let sum_with_shared_borrows_loop_decreases (max : u32) (i : u32) (s : u32) : + nat = + admit () + +(** [loops::clear]: decreases clause + Source: 'src/loops.rs', lines 52:0-58:1 *) +unfold +let clear_loop_decreases (v : alloc_vec_Vec u32) (i : usize) : nat = admit () + +(** [loops::list_mem]: decreases clause + Source: 'src/loops.rs', lines 66:0-75:1 *) +unfold let list_mem_loop_decreases (x : u32) (ls : list_t u32) : nat = admit () + +(** [loops::list_nth_mut_loop]: decreases clause + Source: 'src/loops.rs', lines 78:0-88:1 *) +unfold +let list_nth_mut_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : + nat = + admit () + +(** [loops::list_nth_shared_loop]: decreases clause + Source: 'src/loops.rs', lines 91:0-101:1 *) +unfold +let list_nth_shared_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : + nat = + admit () + +(** [loops::get_elem_mut]: decreases clause + Source: 'src/loops.rs', lines 103:0-117:1 *) +unfold +let get_elem_mut_loop_decreases (x : usize) (ls : list_t usize) : nat = + admit () + +(** [loops::get_elem_shared]: decreases clause + Source: 'src/loops.rs', lines 119:0-133:1 *) +unfold +let get_elem_shared_loop_decreases (x : usize) (ls : list_t usize) : nat = + admit () + +(** [loops::list_nth_mut_loop_with_id]: decreases clause + Source: 'src/loops.rs', lines 144:0-155:1 *) +unfold +let list_nth_mut_loop_with_id_loop_decreases (t : Type0) (i : u32) + (ls : list_t t) : nat = + admit () + +(** [loops::list_nth_shared_loop_with_id]: decreases clause + Source: 'src/loops.rs', lines 158:0-169:1 *) +unfold +let list_nth_shared_loop_with_id_loop_decreases (t : Type0) (i : u32) + (ls : list_t t) : nat = + admit () + +(** [loops::list_nth_mut_loop_pair]: decreases clause + Source: 'src/loops.rs', lines 174:0-195:1 *) +unfold +let list_nth_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_shared_loop_pair]: decreases clause + Source: 'src/loops.rs', lines 198:0-219:1 *) +unfold +let list_nth_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_mut_loop_pair_merge]: decreases clause + Source: 'src/loops.rs', lines 223:0-238:1 *) +unfold +let list_nth_mut_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_shared_loop_pair_merge]: decreases clause + Source: 'src/loops.rs', lines 241:0-256:1 *) +unfold +let list_nth_shared_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_mut_shared_loop_pair]: decreases clause + Source: 'src/loops.rs', lines 259:0-274:1 *) +unfold +let list_nth_mut_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_mut_shared_loop_pair_merge]: decreases clause + Source: 'src/loops.rs', lines 278:0-293:1 *) +unfold +let list_nth_mut_shared_loop_pair_merge_loop_decreases (t : Type0) + (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_shared_mut_loop_pair]: decreases clause + Source: 'src/loops.rs', lines 297:0-312:1 *) +unfold +let list_nth_shared_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_shared_mut_loop_pair_merge]: decreases clause + Source: 'src/loops.rs', lines 316:0-331:1 *) +unfold +let list_nth_shared_mut_loop_pair_merge_loop_decreases (t : Type0) + (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = + admit () + diff --git a/tests/fstar-split/misc/Loops.Clauses.fst b/tests/fstar-split/misc/Loops.Clauses.fst new file mode 100644 index 00000000..75194437 --- /dev/null +++ b/tests/fstar-split/misc/Loops.Clauses.fst @@ -0,0 +1,107 @@ +(** [loops]: templates for the decreases clauses *) +module Loops.Clauses +open Primitives +open Loops.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [loops::sum]: decreases clause *) +unfold let sum_loop_decreases (max : u32) (i : u32) (s : u32) : nat = + if i <= max then max - i else 0 + +(** [loops::sum_with_mut_borrows]: decreases clause *) +unfold +let sum_with_mut_borrows_loop_decreases (max : u32) (mi : u32) (ms : u32) : nat = + if max >= mi then max - mi else 0 + +(** [loops::sum_with_shared_borrows]: decreases clause *) +unfold +let sum_with_shared_borrows_loop_decreases (max : u32) (i : u32) (s : u32) : nat = + if max >= i then max - i else 0 + +(** [loops::clear]: decreases clause *) +unfold let clear_loop_decreases (v : alloc_vec_Vec u32) (i : usize) : nat = + if i <= List.Tot.length v then List.Tot.length v - i else 0 + +(** [loops::list_mem]: decreases clause *) +unfold let list_mem_loop_decreases (i : u32) (ls : list_t u32) : list_t u32 = + ls + +(** [loops::list_nth_mut_loop]: decreases clause *) +unfold +let list_nth_mut_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : nat = + i + +(** [loops::list_nth_shared_loop]: decreases clause *) +unfold +let list_nth_shared_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : list_t t = + ls + +(** [loops::get_elem_mut]: decreases clause *) +unfold +let get_elem_mut_loop_decreases (x : usize) (ls : list_t usize) : list_t usize = ls + +(** [loops::get_elem_shared]: decreases clause *) +unfold +let get_elem_shared_loop_decreases (x : usize) (ls : list_t usize) : list_t usize = + ls + +(** [loops::list_nth_mut_loop_with_id]: decreases clause *) +unfold +let list_nth_mut_loop_with_id_loop_decreases (t : Type0) (i : u32) (ls : list_t t) : + list_t t = + ls + +(** [loops::list_nth_shared_loop_with_id]: decreases clause *) +unfold +let list_nth_shared_loop_with_id_loop_decreases (t : Type0) (i : u32) + (ls : list_t t) : list_t t = + ls + +(** [loops::list_nth_mut_loop_pair]: decreases clause *) +unfold +let list_nth_mut_loop_pair_loop_decreases (t : Type0) (l : list_t t) (l0 : list_t t) + (i : u32) : nat = + i + +(** [loops::list_nth_shared_loop_pair]: decreases clause *) +unfold +let list_nth_shared_loop_pair_loop_decreases (t : Type0) (l : list_t t) + (l0 : list_t t) (i : u32) : list_t t = + l + +(** [loops::list_nth_mut_loop_pair_merge]: decreases clause *) +unfold +let list_nth_mut_loop_pair_merge_loop_decreases (t : Type0) (l : list_t t) + (l0 : list_t t) (i : u32) : nat = + i + +(** [loops::list_nth_shared_loop_pair_merge]: decreases clause *) +unfold +let list_nth_shared_loop_pair_merge_loop_decreases (t : Type0) (l : list_t t) + (l0 : list_t t) (i : u32) : list_t t = + l + +(** [loops::list_nth_mut_shared_loop_pair]: decreases clause *) +unfold +let list_nth_mut_shared_loop_pair_loop_decreases (t : Type0) (l : list_t t) + (l0 : list_t t) (i : u32) : list_t t = + l + +(** [loops::list_nth_mut_shared_loop_pair_merge]: decreases clause *) +unfold +let list_nth_mut_shared_loop_pair_merge_loop_decreases (t : Type0) (l : list_t t) + (l0 : list_t t) (i : u32) : list_t t = + l + +(** [loops::list_nth_shared_mut_loop_pair]: decreases clause *) +unfold +let list_nth_shared_mut_loop_pair_loop_decreases (t : Type0) (l : list_t t) + (l0 : list_t t) (i : u32) : list_t t = + l + +(** [loops::list_nth_shared_mut_loop_pair_merge]: decreases clause *) +unfold +let list_nth_shared_mut_loop_pair_merge_loop_decreases (t : Type0) (l : list_t t) + (l0 : list_t t) (i : u32) : list_t t = + l diff --git a/tests/fstar-split/misc/Loops.Funs.fst b/tests/fstar-split/misc/Loops.Funs.fst new file mode 100644 index 00000000..3168fddb --- /dev/null +++ b/tests/fstar-split/misc/Loops.Funs.fst @@ -0,0 +1,734 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [loops]: function definitions *) +module Loops.Funs +open Primitives +include Loops.Types +include Loops.Clauses + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [loops::sum]: loop 0: forward function + Source: 'src/loops.rs', lines 4:0-14:1 *) +let rec sum_loop + (max : u32) (i : u32) (s : u32) : + Tot (result u32) (decreases (sum_loop_decreases max i s)) + = + if i < max + then let* s1 = u32_add s i in let* i1 = u32_add i 1 in sum_loop max i1 s1 + else u32_mul s 2 + +(** [loops::sum]: forward function + Source: 'src/loops.rs', lines 4:0-4:27 *) +let sum (max : u32) : result u32 = + sum_loop max 0 0 + +(** [loops::sum_with_mut_borrows]: loop 0: forward function + Source: 'src/loops.rs', lines 19:0-31:1 *) +let rec sum_with_mut_borrows_loop + (max : u32) (mi : u32) (ms : u32) : + Tot (result u32) (decreases (sum_with_mut_borrows_loop_decreases max mi ms)) + = + if mi < max + then + let* ms1 = u32_add ms mi in + let* mi1 = u32_add mi 1 in + sum_with_mut_borrows_loop max mi1 ms1 + else u32_mul ms 2 + +(** [loops::sum_with_mut_borrows]: forward function + Source: 'src/loops.rs', lines 19:0-19:44 *) +let sum_with_mut_borrows (max : u32) : result u32 = + sum_with_mut_borrows_loop max 0 0 + +(** [loops::sum_with_shared_borrows]: loop 0: forward function + Source: 'src/loops.rs', lines 34:0-48:1 *) +let rec sum_with_shared_borrows_loop + (max : u32) (i : u32) (s : u32) : + Tot (result u32) (decreases (sum_with_shared_borrows_loop_decreases max i s)) + = + if i < max + then + let* i1 = u32_add i 1 in + let* s1 = u32_add s i1 in + sum_with_shared_borrows_loop max i1 s1 + else u32_mul s 2 + +(** [loops::sum_with_shared_borrows]: forward function + Source: 'src/loops.rs', lines 34:0-34:47 *) +let sum_with_shared_borrows (max : u32) : result u32 = + sum_with_shared_borrows_loop max 0 0 + +(** [loops::clear]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/loops.rs', lines 52:0-58:1 *) +let rec clear_loop + (v : alloc_vec_Vec u32) (i : usize) : + Tot (result (alloc_vec_Vec u32)) (decreases (clear_loop_decreases v i)) + = + let i1 = alloc_vec_Vec_len u32 v in + if i < i1 + then + let* i2 = usize_add i 1 in + let* v1 = + alloc_vec_Vec_index_mut_back u32 usize + (core_slice_index_SliceIndexUsizeSliceTInst u32) v i 0 in + clear_loop v1 i2 + else Return v + +(** [loops::clear]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/loops.rs', lines 52:0-52:30 *) +let clear (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) = + clear_loop v 0 + +(** [loops::list_mem]: loop 0: forward function + Source: 'src/loops.rs', lines 66:0-75:1 *) +let rec list_mem_loop + (x : u32) (ls : list_t u32) : + Tot (result bool) (decreases (list_mem_loop_decreases x ls)) + = + begin match ls with + | List_Cons y tl -> if y = x then Return true else list_mem_loop x tl + | List_Nil -> Return false + end + +(** [loops::list_mem]: forward function + Source: 'src/loops.rs', lines 66:0-66:52 *) +let list_mem (x : u32) (ls : list_t u32) : result bool = + list_mem_loop x ls + +(** [loops::list_nth_mut_loop]: loop 0: forward function + Source: 'src/loops.rs', lines 78:0-88:1 *) +let rec list_nth_mut_loop_loop + (t : Type0) (ls : list_t t) (i : u32) : + Tot (result t) (decreases (list_nth_mut_loop_loop_decreases t ls i)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i1 = u32_sub i 1 in list_nth_mut_loop_loop t tl i1 + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop]: forward function + Source: 'src/loops.rs', lines 78:0-78:71 *) +let list_nth_mut_loop (t : Type0) (ls : list_t t) (i : u32) : result t = + list_nth_mut_loop_loop t ls i + +(** [loops::list_nth_mut_loop]: loop 0: backward function 0 + Source: 'src/loops.rs', lines 78:0-88:1 *) +let rec list_nth_mut_loop_loop_back + (t : Type0) (ls : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) (decreases (list_nth_mut_loop_loop_decreases t ls i)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return (List_Cons ret tl) + else + let* i1 = u32_sub i 1 in + let* tl1 = list_nth_mut_loop_loop_back t tl i1 ret in + Return (List_Cons x tl1) + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop]: backward function 0 + Source: 'src/loops.rs', lines 78:0-78:71 *) +let list_nth_mut_loop_back + (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = + list_nth_mut_loop_loop_back t ls i ret + +(** [loops::list_nth_shared_loop]: loop 0: forward function + Source: 'src/loops.rs', lines 91:0-101:1 *) +let rec list_nth_shared_loop_loop + (t : Type0) (ls : list_t t) (i : u32) : + Tot (result t) (decreases (list_nth_shared_loop_loop_decreases t ls i)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i1 = u32_sub i 1 in list_nth_shared_loop_loop t tl i1 + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_loop]: forward function + Source: 'src/loops.rs', lines 91:0-91:66 *) +let list_nth_shared_loop (t : Type0) (ls : list_t t) (i : u32) : result t = + list_nth_shared_loop_loop t ls i + +(** [loops::get_elem_mut]: loop 0: forward function + Source: 'src/loops.rs', lines 103:0-117:1 *) +let rec get_elem_mut_loop + (x : usize) (ls : list_t usize) : + Tot (result usize) (decreases (get_elem_mut_loop_decreases x ls)) + = + begin match ls with + | List_Cons y tl -> if y = x then Return y else get_elem_mut_loop x tl + | List_Nil -> Fail Failure + end + +(** [loops::get_elem_mut]: forward function + Source: 'src/loops.rs', lines 103:0-103:73 *) +let get_elem_mut + (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = + let* l = + alloc_vec_Vec_index_mut (list_t usize) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in + get_elem_mut_loop x l + +(** [loops::get_elem_mut]: loop 0: backward function 0 + Source: 'src/loops.rs', lines 103:0-117:1 *) +let rec get_elem_mut_loop_back + (x : usize) (ls : list_t usize) (ret : usize) : + Tot (result (list_t usize)) (decreases (get_elem_mut_loop_decreases x ls)) + = + begin match ls with + | List_Cons y tl -> + if y = x + then Return (List_Cons ret tl) + else let* tl1 = get_elem_mut_loop_back x tl ret in Return (List_Cons y tl1) + | List_Nil -> Fail Failure + end + +(** [loops::get_elem_mut]: backward function 0 + Source: 'src/loops.rs', lines 103:0-103:73 *) +let get_elem_mut_back + (slots : alloc_vec_Vec (list_t usize)) (x : usize) (ret : usize) : + result (alloc_vec_Vec (list_t usize)) + = + let* l = + alloc_vec_Vec_index_mut (list_t usize) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in + let* l1 = get_elem_mut_loop_back x l ret in + alloc_vec_Vec_index_mut_back (list_t usize) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 l1 + +(** [loops::get_elem_shared]: loop 0: forward function + Source: 'src/loops.rs', lines 119:0-133:1 *) +let rec get_elem_shared_loop + (x : usize) (ls : list_t usize) : + Tot (result usize) (decreases (get_elem_shared_loop_decreases x ls)) + = + begin match ls with + | List_Cons y tl -> if y = x then Return y else get_elem_shared_loop x tl + | List_Nil -> Fail Failure + end + +(** [loops::get_elem_shared]: forward function + Source: 'src/loops.rs', lines 119:0-119:68 *) +let get_elem_shared + (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = + let* l = + alloc_vec_Vec_index (list_t usize) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in + get_elem_shared_loop x l + +(** [loops::id_mut]: forward function + Source: 'src/loops.rs', lines 135:0-135:50 *) +let id_mut (t : Type0) (ls : list_t t) : result (list_t t) = + Return ls + +(** [loops::id_mut]: backward function 0 + Source: 'src/loops.rs', lines 135:0-135:50 *) +let id_mut_back + (t : Type0) (ls : list_t t) (ret : list_t t) : result (list_t t) = + Return ret + +(** [loops::id_shared]: forward function + Source: 'src/loops.rs', lines 139:0-139:45 *) +let id_shared (t : Type0) (ls : list_t t) : result (list_t t) = + Return ls + +(** [loops::list_nth_mut_loop_with_id]: loop 0: forward function + Source: 'src/loops.rs', lines 144:0-155:1 *) +let rec list_nth_mut_loop_with_id_loop + (t : Type0) (i : u32) (ls : list_t t) : + Tot (result t) (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i1 = u32_sub i 1 in list_nth_mut_loop_with_id_loop t i1 tl + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_with_id]: forward function + Source: 'src/loops.rs', lines 144:0-144:75 *) +let list_nth_mut_loop_with_id + (t : Type0) (ls : list_t t) (i : u32) : result t = + let* ls1 = id_mut t ls in list_nth_mut_loop_with_id_loop t i ls1 + +(** [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 + Source: 'src/loops.rs', lines 144:0-155:1 *) +let rec list_nth_mut_loop_with_id_loop_back + (t : Type0) (i : u32) (ls : list_t t) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return (List_Cons ret tl) + else + let* i1 = u32_sub i 1 in + let* tl1 = list_nth_mut_loop_with_id_loop_back t i1 tl ret in + Return (List_Cons x tl1) + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_with_id]: backward function 0 + Source: 'src/loops.rs', lines 144:0-144:75 *) +let list_nth_mut_loop_with_id_back + (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = + let* ls1 = id_mut t ls in + let* l = list_nth_mut_loop_with_id_loop_back t i ls1 ret in + id_mut_back t ls l + +(** [loops::list_nth_shared_loop_with_id]: loop 0: forward function + Source: 'src/loops.rs', lines 158:0-169:1 *) +let rec list_nth_shared_loop_with_id_loop + (t : Type0) (i : u32) (ls : list_t t) : + Tot (result t) + (decreases (list_nth_shared_loop_with_id_loop_decreases t i ls)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i1 = u32_sub i 1 in list_nth_shared_loop_with_id_loop t i1 tl + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_loop_with_id]: forward function + Source: 'src/loops.rs', lines 158:0-158:70 *) +let list_nth_shared_loop_with_id + (t : Type0) (ls : list_t t) (i : u32) : result t = + let* ls1 = id_shared t ls in list_nth_shared_loop_with_id_loop t i ls1 + +(** [loops::list_nth_mut_loop_pair]: loop 0: forward function + Source: 'src/loops.rs', lines 174:0-195:1 *) +let rec list_nth_mut_loop_pair_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else let* i1 = u32_sub i 1 in list_nth_mut_loop_pair_loop t tl0 tl1 i1 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair]: forward function + Source: 'src/loops.rs', lines 174:0-178:27 *) +let list_nth_mut_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_mut_loop_pair_loop t ls0 ls1 i + +(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 + Source: 'src/loops.rs', lines 174:0-195:1 *) +let rec list_nth_mut_loop_pair_loop_back'a + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons _ tl1 -> + if i = 0 + then Return (List_Cons ret tl0) + else + let* i1 = u32_sub i 1 in + let* tl01 = list_nth_mut_loop_pair_loop_back'a t tl0 tl1 i1 ret in + Return (List_Cons x0 tl01) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair]: backward function 0 + Source: 'src/loops.rs', lines 174:0-178:27 *) +let list_nth_mut_loop_pair_back'a + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_mut_loop_pair_loop_back'a t ls0 ls1 i ret + +(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 1 + Source: 'src/loops.rs', lines 174:0-195:1 *) +let rec list_nth_mut_loop_pair_loop_back'b + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons _ tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl1) + else + let* i1 = u32_sub i 1 in + let* tl11 = list_nth_mut_loop_pair_loop_back'b t tl0 tl1 i1 ret in + Return (List_Cons x1 tl11) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair]: backward function 1 + Source: 'src/loops.rs', lines 174:0-178:27 *) +let list_nth_mut_loop_pair_back'b + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_mut_loop_pair_loop_back'b t ls0 ls1 i ret + +(** [loops::list_nth_shared_loop_pair]: loop 0: forward function + Source: 'src/loops.rs', lines 198:0-219:1 *) +let rec list_nth_shared_loop_pair_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_shared_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else let* i1 = u32_sub i 1 in list_nth_shared_loop_pair_loop t tl0 tl1 i1 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_loop_pair]: forward function + Source: 'src/loops.rs', lines 198:0-202:19 *) +let list_nth_shared_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_shared_loop_pair_loop t ls0 ls1 i + +(** [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function + Source: 'src/loops.rs', lines 223:0-238:1 *) +let rec list_nth_mut_loop_pair_merge_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i1 = u32_sub i 1 in list_nth_mut_loop_pair_merge_loop t tl0 tl1 i1 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair_merge]: forward function + Source: 'src/loops.rs', lines 223:0-227:27 *) +let list_nth_mut_loop_pair_merge + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_mut_loop_pair_merge_loop t ls0 ls1 i + +(** [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 + Source: 'src/loops.rs', lines 223:0-238:1 *) +let rec list_nth_mut_loop_pair_merge_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : (t & t)) : + Tot (result ((list_t t) & (list_t t))) + (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then let (x, x2) = ret in Return (List_Cons x tl0, List_Cons x2 tl1) + else + let* i1 = u32_sub i 1 in + let* (tl01, tl11) = + list_nth_mut_loop_pair_merge_loop_back t tl0 tl1 i1 ret in + Return (List_Cons x0 tl01, List_Cons x1 tl11) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair_merge]: backward function 0 + Source: 'src/loops.rs', lines 223:0-227:27 *) +let list_nth_mut_loop_pair_merge_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : (t & t)) : + result ((list_t t) & (list_t t)) + = + list_nth_mut_loop_pair_merge_loop_back t ls0 ls1 i ret + +(** [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function + Source: 'src/loops.rs', lines 241:0-256:1 *) +let rec list_nth_shared_loop_pair_merge_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i1 = u32_sub i 1 in + list_nth_shared_loop_pair_merge_loop t tl0 tl1 i1 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_loop_pair_merge]: forward function + Source: 'src/loops.rs', lines 241:0-245:19 *) +let list_nth_shared_loop_pair_merge + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_shared_loop_pair_merge_loop t ls0 ls1 i + +(** [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function + Source: 'src/loops.rs', lines 259:0-274:1 *) +let rec list_nth_mut_shared_loop_pair_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i1 = u32_sub i 1 in + list_nth_mut_shared_loop_pair_loop t tl0 tl1 i1 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_shared_loop_pair]: forward function + Source: 'src/loops.rs', lines 259:0-263:23 *) +let list_nth_mut_shared_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_mut_shared_loop_pair_loop t ls0 ls1 i + +(** [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 + Source: 'src/loops.rs', lines 259:0-274:1 *) +let rec list_nth_mut_shared_loop_pair_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons _ tl1 -> + if i = 0 + then Return (List_Cons ret tl0) + else + let* i1 = u32_sub i 1 in + let* tl01 = list_nth_mut_shared_loop_pair_loop_back t tl0 tl1 i1 ret in + Return (List_Cons x0 tl01) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_shared_loop_pair]: backward function 0 + Source: 'src/loops.rs', lines 259:0-263:23 *) +let list_nth_mut_shared_loop_pair_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_mut_shared_loop_pair_loop_back t ls0 ls1 i ret + +(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function + Source: 'src/loops.rs', lines 278:0-293:1 *) +let rec list_nth_mut_shared_loop_pair_merge_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i1 = u32_sub i 1 in + list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i1 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_shared_loop_pair_merge]: forward function + Source: 'src/loops.rs', lines 278:0-282:23 *) +let list_nth_mut_shared_loop_pair_merge + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i + +(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 + Source: 'src/loops.rs', lines 278:0-293:1 *) +let rec list_nth_mut_shared_loop_pair_merge_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons _ tl1 -> + if i = 0 + then Return (List_Cons ret tl0) + else + let* i1 = u32_sub i 1 in + let* tl01 = + list_nth_mut_shared_loop_pair_merge_loop_back t tl0 tl1 i1 ret in + Return (List_Cons x0 tl01) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 + Source: 'src/loops.rs', lines 278:0-282:23 *) +let list_nth_mut_shared_loop_pair_merge_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_mut_shared_loop_pair_merge_loop_back t ls0 ls1 i ret + +(** [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function + Source: 'src/loops.rs', lines 297:0-312:1 *) +let rec list_nth_shared_mut_loop_pair_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i1 = u32_sub i 1 in + list_nth_shared_mut_loop_pair_loop t tl0 tl1 i1 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_mut_loop_pair]: forward function + Source: 'src/loops.rs', lines 297:0-301:23 *) +let list_nth_shared_mut_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_shared_mut_loop_pair_loop t ls0 ls1 i + +(** [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 + Source: 'src/loops.rs', lines 297:0-312:1 *) +let rec list_nth_shared_mut_loop_pair_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons _ tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl1) + else + let* i1 = u32_sub i 1 in + let* tl11 = list_nth_shared_mut_loop_pair_loop_back t tl0 tl1 i1 ret in + Return (List_Cons x1 tl11) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_mut_loop_pair]: backward function 1 + Source: 'src/loops.rs', lines 297:0-301:23 *) +let list_nth_shared_mut_loop_pair_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_shared_mut_loop_pair_loop_back t ls0 ls1 i ret + +(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function + Source: 'src/loops.rs', lines 316:0-331:1 *) +let rec list_nth_shared_mut_loop_pair_merge_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i1 = u32_sub i 1 in + list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i1 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_mut_loop_pair_merge]: forward function + Source: 'src/loops.rs', lines 316:0-320:23 *) +let list_nth_shared_mut_loop_pair_merge + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i + +(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 + Source: 'src/loops.rs', lines 316:0-331:1 *) +let rec list_nth_shared_mut_loop_pair_merge_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons _ tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl1) + else + let* i1 = u32_sub i 1 in + let* tl11 = + list_nth_shared_mut_loop_pair_merge_loop_back t tl0 tl1 i1 ret in + Return (List_Cons x1 tl11) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 + Source: 'src/loops.rs', lines 316:0-320:23 *) +let list_nth_shared_mut_loop_pair_merge_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_shared_mut_loop_pair_merge_loop_back t ls0 ls1 i ret + diff --git a/tests/fstar-split/misc/Loops.Types.fst b/tests/fstar-split/misc/Loops.Types.fst new file mode 100644 index 00000000..8aa38290 --- /dev/null +++ b/tests/fstar-split/misc/Loops.Types.fst @@ -0,0 +1,13 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [loops]: type definitions *) +module Loops.Types +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [loops::List] + Source: 'src/loops.rs', lines 60:0-60:16 *) +type list_t (t : Type0) = +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t + diff --git a/tests/fstar-split/misc/Paper.fst b/tests/fstar-split/misc/Paper.fst new file mode 100644 index 00000000..2dc804de --- /dev/null +++ b/tests/fstar-split/misc/Paper.fst @@ -0,0 +1,110 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [paper] *) +module Paper +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [paper::ref_incr]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/paper.rs', lines 4:0-4:28 *) +let ref_incr (x : i32) : result i32 = + i32_add x 1 + +(** [paper::test_incr]: forward function + Source: 'src/paper.rs', lines 8:0-8:18 *) +let test_incr : result unit = + let* x = ref_incr 0 in if not (x = 1) then Fail Failure else Return () + +(** Unit test for [paper::test_incr] *) +let _ = assert_norm (test_incr = Return ()) + +(** [paper::choose]: forward function + Source: 'src/paper.rs', lines 15:0-15:70 *) +let choose (t : Type0) (b : bool) (x : t) (y : t) : result t = + if b then Return x else Return y + +(** [paper::choose]: backward function 0 + Source: 'src/paper.rs', lines 15:0-15:70 *) +let choose_back + (t : Type0) (b : bool) (x : t) (y : t) (ret : t) : result (t & t) = + if b then Return (ret, y) else Return (x, ret) + +(** [paper::test_choose]: forward function + Source: 'src/paper.rs', lines 23:0-23:20 *) +let test_choose : result unit = + let* z = choose i32 true 0 0 in + let* z1 = i32_add z 1 in + if not (z1 = 1) + then Fail Failure + else + let* (x, y) = choose_back i32 true 0 0 z1 in + if not (x = 1) + then Fail Failure + else if not (y = 0) then Fail Failure else Return () + +(** Unit test for [paper::test_choose] *) +let _ = assert_norm (test_choose = Return ()) + +(** [paper::List] + Source: 'src/paper.rs', lines 35:0-35:16 *) +type list_t (t : Type0) = +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t + +(** [paper::list_nth_mut]: forward function + Source: 'src/paper.rs', lines 42:0-42:67 *) +let rec list_nth_mut (t : Type0) (l : list_t t) (i : u32) : result t = + begin match l with + | List_Cons x tl -> + if i = 0 then Return x else let* i1 = u32_sub i 1 in list_nth_mut t tl i1 + | List_Nil -> Fail Failure + end + +(** [paper::list_nth_mut]: backward function 0 + Source: 'src/paper.rs', lines 42:0-42:67 *) +let rec list_nth_mut_back + (t : Type0) (l : list_t t) (i : u32) (ret : t) : result (list_t t) = + begin match l with + | List_Cons x tl -> + if i = 0 + then Return (List_Cons ret tl) + else + let* i1 = u32_sub i 1 in + let* tl1 = list_nth_mut_back t tl i1 ret in + Return (List_Cons x tl1) + | List_Nil -> Fail Failure + end + +(** [paper::sum]: forward function + Source: 'src/paper.rs', lines 57:0-57:32 *) +let rec sum (l : list_t i32) : result i32 = + begin match l with + | List_Cons x tl -> let* i = sum tl in i32_add x i + | List_Nil -> Return 0 + end + +(** [paper::test_nth]: forward function + Source: 'src/paper.rs', lines 68:0-68:17 *) +let test_nth : result unit = + let l = List_Nil in + let l1 = List_Cons 3 l in + let l2 = List_Cons 2 l1 in + let* x = list_nth_mut i32 (List_Cons 1 l2) 2 in + let* x1 = i32_add x 1 in + let* l3 = list_nth_mut_back i32 (List_Cons 1 l2) 2 x1 in + let* i = sum l3 in + if not (i = 7) then Fail Failure else Return () + +(** Unit test for [paper::test_nth] *) +let _ = assert_norm (test_nth = Return ()) + +(** [paper::call_choose]: forward function + Source: 'src/paper.rs', lines 76:0-76:44 *) +let call_choose (p : (u32 & u32)) : result u32 = + let (px, py) = p in + let* pz = choose u32 true px py in + let* pz1 = u32_add pz 1 in + let* (px1, _) = choose_back u32 true px py pz1 in + Return px1 + diff --git a/tests/fstar-split/misc/PoloniusList.fst b/tests/fstar-split/misc/PoloniusList.fst new file mode 100644 index 00000000..8a8b7ae3 --- /dev/null +++ b/tests/fstar-split/misc/PoloniusList.fst @@ -0,0 +1,34 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [polonius_list] *) +module PoloniusList +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [polonius_list::List] + Source: 'src/polonius_list.rs', lines 3:0-3:16 *) +type list_t (t : Type0) = +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t + +(** [polonius_list::get_list_at_x]: forward function + Source: 'src/polonius_list.rs', lines 13:0-13:76 *) +let rec get_list_at_x (ls : list_t u32) (x : u32) : result (list_t u32) = + begin match ls with + | List_Cons hd tl -> + if hd = x then Return (List_Cons hd tl) else get_list_at_x tl x + | List_Nil -> Return List_Nil + end + +(** [polonius_list::get_list_at_x]: backward function 0 + Source: 'src/polonius_list.rs', lines 13:0-13:76 *) +let rec get_list_at_x_back + (ls : list_t u32) (x : u32) (ret : list_t u32) : result (list_t u32) = + begin match ls with + | List_Cons hd tl -> + if hd = x + then Return ret + else let* tl1 = get_list_at_x_back tl x ret in Return (List_Cons hd tl1) + | List_Nil -> Return ret + end + diff --git a/tests/fstar-split/traits/Makefile b/tests/fstar-split/traits/Makefile new file mode 100644 index 00000000..fa7d1f36 --- /dev/null +++ b/tests/fstar-split/traits/Makefile @@ -0,0 +1,49 @@ +# This file was automatically generated - modify ../Makefile.template instead +INCLUDE_DIRS = . + +FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) + +FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints + +FSTAR_OPTIONS = $(FSTAR_HINTS) \ + --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ + --warn_error '+241@247+285-274' \ + +FSTAR_EXE ?= fstar.exe +FSTAR_NO_FLAGS = $(FSTAR_EXE) --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj + +FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) + +# The F* roots are used to compute the dependency graph, and generate the .depend file +FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) + +# Build all the files +all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) + +# This is the right way to ensure the .depend file always gets re-built. +ifeq (,$(filter %-in,$(MAKECMDGOALS))) +ifndef NODEPEND +ifndef MAKE_RESTARTS +.depend: .FORCE + $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ + +.PHONY: .FORCE +.FORCE: +endif +endif + +include .depend +endif + +# For the interactive mode +%.fst-in %.fsti-in: + @echo $(FSTAR_OPTIONS) + +# Generete the .checked files in batch mode +%.checked: + $(FSTAR) $(FSTAR_OPTIONS) $< && \ + touch -c $@ + +.PHONY: clean +clean: + rm -f obj/* diff --git a/tests/fstar-split/traits/Primitives.fst b/tests/fstar-split/traits/Primitives.fst new file mode 100644 index 00000000..a3ffbde4 --- /dev/null +++ b/tests/fstar-split/traits/Primitives.fst @@ -0,0 +1,884 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v + +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +// The **forward** function shouldn't be used +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure +let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_RangeUsize_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_RangeUsize_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_mut_back = core_slice_index_RangeUsize_get_mut_back t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; + index_mut_back = core_slice_index_RangeUsize_index_mut_back t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] + = + admit() diff --git a/tests/fstar-split/traits/Traits.fst b/tests/fstar-split/traits/Traits.fst new file mode 100644 index 00000000..29a001b2 --- /dev/null +++ b/tests/fstar-split/traits/Traits.fst @@ -0,0 +1,476 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [traits] *) +module Traits +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** Trait declaration: [traits::BoolTrait] + Source: 'src/traits.rs', lines 1:0-1:19 *) +noeq type boolTrait_t (self : Type0) = { get_bool : self -> result bool; } + +(** [traits::{bool}::get_bool]: forward function + Source: 'src/traits.rs', lines 12:4-12:30 *) +let bool_get_bool (self : bool) : result bool = + Return self + +(** Trait implementation: [traits::{bool}] + Source: 'src/traits.rs', lines 11:0-11:23 *) +let traits_BoolTraitBoolInst : boolTrait_t bool = { get_bool = bool_get_bool; } + +(** [traits::BoolTrait::ret_true]: forward function + Source: 'src/traits.rs', lines 6:4-6:30 *) +let boolTrait_ret_true + (#self : Type0) (self_clause : boolTrait_t self) (self1 : self) : + result bool + = + Return true + +(** [traits::test_bool_trait_bool]: forward function + Source: 'src/traits.rs', lines 17:0-17:44 *) +let test_bool_trait_bool (x : bool) : result bool = + let* b = bool_get_bool x in + if b then boolTrait_ret_true traits_BoolTraitBoolInst x else Return false + +(** [traits::{core::option::Option#1}::get_bool]: forward function + Source: 'src/traits.rs', lines 23:4-23:30 *) +let option_get_bool (t : Type0) (self : option t) : result bool = + begin match self with | None -> Return false | Some _ -> Return true end + +(** Trait implementation: [traits::{core::option::Option#1}] + Source: 'src/traits.rs', lines 22:0-22:31 *) +let traits_BoolTraitcoreoptionOptionTInst (t : Type0) : boolTrait_t (option t) + = { + get_bool = option_get_bool t; +} + +(** [traits::test_bool_trait_option]: forward function + Source: 'src/traits.rs', lines 31:0-31:54 *) +let test_bool_trait_option (t : Type0) (x : option t) : result bool = + let* b = option_get_bool t x in + if b + then boolTrait_ret_true (traits_BoolTraitcoreoptionOptionTInst t) x + else Return false + +(** [traits::test_bool_trait]: forward function + Source: 'src/traits.rs', lines 35:0-35:50 *) +let test_bool_trait + (t : Type0) (boolTraitTInst : boolTrait_t t) (x : t) : result bool = + boolTraitTInst.get_bool x + +(** Trait declaration: [traits::ToU64] + Source: 'src/traits.rs', lines 39:0-39:15 *) +noeq type toU64_t (self : Type0) = { to_u64 : self -> result u64; } + +(** [traits::{u64#2}::to_u64]: forward function + Source: 'src/traits.rs', lines 44:4-44:26 *) +let u64_to_u64 (self : u64) : result u64 = + Return self + +(** Trait implementation: [traits::{u64#2}] + Source: 'src/traits.rs', lines 43:0-43:18 *) +let traits_ToU64U64Inst : toU64_t u64 = { to_u64 = u64_to_u64; } + +(** [traits::{(A, A)#3}::to_u64]: forward function + Source: 'src/traits.rs', lines 50:4-50:26 *) +let pair_to_u64 + (a : Type0) (toU64AInst : toU64_t a) (self : (a & a)) : result u64 = + let (x, x1) = self in + let* i = toU64AInst.to_u64 x in + let* i1 = toU64AInst.to_u64 x1 in + u64_add i i1 + +(** Trait implementation: [traits::{(A, A)#3}] + Source: 'src/traits.rs', lines 49:0-49:31 *) +let traits_ToU64TupleAAInst (a : Type0) (toU64AInst : toU64_t a) : toU64_t (a & + a) = { + to_u64 = pair_to_u64 a toU64AInst; +} + +(** [traits::f]: forward function + Source: 'src/traits.rs', lines 55:0-55:36 *) +let f (t : Type0) (toU64TInst : toU64_t t) (x : (t & t)) : result u64 = + pair_to_u64 t toU64TInst x + +(** [traits::g]: forward function + Source: 'src/traits.rs', lines 59:0-61:18 *) +let g + (t : Type0) (toU64TupleTTInst : toU64_t (t & t)) (x : (t & t)) : result u64 = + toU64TupleTTInst.to_u64 x + +(** [traits::h0]: forward function + Source: 'src/traits.rs', lines 66:0-66:24 *) +let h0 (x : u64) : result u64 = + u64_to_u64 x + +(** [traits::Wrapper] + Source: 'src/traits.rs', lines 70:0-70:21 *) +type wrapper_t (t : Type0) = { x : t; } + +(** [traits::{traits::Wrapper#4}::to_u64]: forward function + Source: 'src/traits.rs', lines 75:4-75:26 *) +let wrapper_to_u64 + (t : Type0) (toU64TInst : toU64_t t) (self : wrapper_t t) : result u64 = + toU64TInst.to_u64 self.x + +(** Trait implementation: [traits::{traits::Wrapper#4}] + Source: 'src/traits.rs', lines 74:0-74:35 *) +let traits_ToU64traitsWrapperTInst (t : Type0) (toU64TInst : toU64_t t) : + toU64_t (wrapper_t t) = { + to_u64 = wrapper_to_u64 t toU64TInst; +} + +(** [traits::h1]: forward function + Source: 'src/traits.rs', lines 80:0-80:33 *) +let h1 (x : wrapper_t u64) : result u64 = + wrapper_to_u64 u64 traits_ToU64U64Inst x + +(** [traits::h2]: forward function + Source: 'src/traits.rs', lines 84:0-84:41 *) +let h2 (t : Type0) (toU64TInst : toU64_t t) (x : wrapper_t t) : result u64 = + wrapper_to_u64 t toU64TInst x + +(** Trait declaration: [traits::ToType] + Source: 'src/traits.rs', lines 88:0-88:19 *) +noeq type toType_t (self t : Type0) = { to_type : self -> result t; } + +(** [traits::{u64#5}::to_type]: forward function + Source: 'src/traits.rs', lines 93:4-93:28 *) +let u64_to_type (self : u64) : result bool = + Return (self > 0) + +(** Trait implementation: [traits::{u64#5}] + Source: 'src/traits.rs', lines 92:0-92:25 *) +let traits_ToTypeU64BoolInst : toType_t u64 bool = { to_type = u64_to_type; } + +(** Trait declaration: [traits::OfType] + Source: 'src/traits.rs', lines 98:0-98:16 *) +noeq type ofType_t (self : Type0) = { + of_type : (t : Type0) -> (toTypeTSelfInst : toType_t t self) -> t -> result + self; +} + +(** [traits::h3]: forward function + Source: 'src/traits.rs', lines 104:0-104:50 *) +let h3 + (t1 t2 : Type0) (ofTypeT1Inst : ofType_t t1) (toTypeT2T1Inst : toType_t t2 + t1) (y : t2) : + result t1 + = + ofTypeT1Inst.of_type t2 toTypeT2T1Inst y + +(** Trait declaration: [traits::OfTypeBis] + Source: 'src/traits.rs', lines 109:0-109:36 *) +noeq type ofTypeBis_t (self t : Type0) = { + toTypeTSelfInst : toType_t t self; + of_type : t -> result self; +} + +(** [traits::h4]: forward function + Source: 'src/traits.rs', lines 118:0-118:57 *) +let h4 + (t1 t2 : Type0) (ofTypeBisT1T2Inst : ofTypeBis_t t1 t2) (toTypeT2T1Inst : + toType_t t2 t1) (y : t2) : + result t1 + = + ofTypeBisT1T2Inst.of_type y + +(** [traits::TestType] + Source: 'src/traits.rs', lines 122:0-122:22 *) +type testType_t (t : Type0) = t + +(** [traits::{traits::TestType#6}::test::TestType1] + Source: 'src/traits.rs', lines 127:8-127:24 *) +type testType_test_TestType1_t = u64 + +(** Trait declaration: [traits::{traits::TestType#6}::test::TestTrait] + Source: 'src/traits.rs', lines 128:8-128:23 *) +noeq type testType_test_TestTrait_t (self : Type0) = { + test : self -> result bool; +} + +(** [traits::{traits::TestType#6}::test::{traits::{traits::TestType#6}::test::TestType1}::test]: forward function + Source: 'src/traits.rs', lines 139:12-139:34 *) +let testType_test_TestType1_test + (self : testType_test_TestType1_t) : result bool = + Return (self > 1) + +(** Trait implementation: [traits::{traits::TestType#6}::test::{traits::{traits::TestType#6}::test::TestType1}] + Source: 'src/traits.rs', lines 138:8-138:36 *) +let traits_TestType_test_TestTraittraitstraitsTestTypeTtestTestType1Inst : + testType_test_TestTrait_t testType_test_TestType1_t = { + test = testType_test_TestType1_test; +} + +(** [traits::{traits::TestType#6}::test]: forward function + Source: 'src/traits.rs', lines 126:4-126:36 *) +let testType_test + (t : Type0) (toU64TInst : toU64_t t) (self : testType_t t) (x : t) : + result bool + = + let* x1 = toU64TInst.to_u64 x in + if x1 > 0 then testType_test_TestType1_test 0 else Return false + +(** [traits::BoolWrapper] + Source: 'src/traits.rs', lines 150:0-150:22 *) +type boolWrapper_t = bool + +(** [traits::{traits::BoolWrapper#7}::to_type]: forward function + Source: 'src/traits.rs', lines 156:4-156:25 *) +let boolWrapper_to_type + (t : Type0) (toTypeBoolTInst : toType_t bool t) (self : boolWrapper_t) : + result t + = + toTypeBoolTInst.to_type self + +(** Trait implementation: [traits::{traits::BoolWrapper#7}] + Source: 'src/traits.rs', lines 152:0-152:33 *) +let traits_ToTypetraitsBoolWrapperTInst (t : Type0) (toTypeBoolTInst : toType_t + bool t) : toType_t boolWrapper_t t = { + to_type = boolWrapper_to_type t toTypeBoolTInst; +} + +(** [traits::WithConstTy::LEN2] + Source: 'src/traits.rs', lines 164:4-164:21 *) +let with_const_ty_len2_body : result usize = Return 32 +let with_const_ty_len2_c : usize = eval_global with_const_ty_len2_body + +(** Trait declaration: [traits::WithConstTy] + Source: 'src/traits.rs', lines 161:0-161:39 *) +noeq type withConstTy_t (self : Type0) (len : usize) = { + cLEN1 : usize; + cLEN2 : usize; + tV : Type0; + tW : Type0; + tW_clause_0 : toU64_t tW; + f : tW -> array u8 len -> result tW; +} + +(** [traits::{bool#8}::LEN1] + Source: 'src/traits.rs', lines 175:4-175:21 *) +let bool_len1_body : result usize = Return 12 +let bool_len1_c : usize = eval_global bool_len1_body + +(** [traits::{bool#8}::f]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) + Source: 'src/traits.rs', lines 180:4-180:39 *) +let bool_f (i : u64) (a : array u8 32) : result u64 = + Return i + +(** Trait implementation: [traits::{bool#8}] + Source: 'src/traits.rs', lines 174:0-174:29 *) +let traits_WithConstTyBool32Inst : withConstTy_t bool 32 = { + cLEN1 = bool_len1_c; + cLEN2 = with_const_ty_len2_c; + tV = u8; + tW = u64; + tW_clause_0 = traits_ToU64U64Inst; + f = bool_f; +} + +(** [traits::use_with_const_ty1]: forward function + Source: 'src/traits.rs', lines 183:0-183:75 *) +let use_with_const_ty1 + (h : Type0) (len : usize) (withConstTyHLENInst : withConstTy_t h len) : + result usize + = + let i = withConstTyHLENInst.cLEN1 in Return i + +(** [traits::use_with_const_ty2]: forward function + Source: 'src/traits.rs', lines 187:0-187:73 *) +let use_with_const_ty2 + (h : Type0) (len : usize) (withConstTyHLENInst : withConstTy_t h len) + (w : withConstTyHLENInst.tW) : + result unit + = + Return () + +(** [traits::use_with_const_ty3]: forward function + Source: 'src/traits.rs', lines 189:0-189:80 *) +let use_with_const_ty3 + (h : Type0) (len : usize) (withConstTyHLENInst : withConstTy_t h len) + (x : withConstTyHLENInst.tW) : + result u64 + = + withConstTyHLENInst.tW_clause_0.to_u64 x + +(** [traits::test_where1]: forward function + Source: 'src/traits.rs', lines 193:0-193:40 *) +let test_where1 (t : Type0) (_x : t) : result unit = + Return () + +(** [traits::test_where2]: forward function + Source: 'src/traits.rs', lines 194:0-194:57 *) +let test_where2 + (t : Type0) (withConstTyT32Inst : withConstTy_t t 32) (_x : u32) : + result unit + = + Return () + +(** Trait declaration: [traits::ParentTrait0] + Source: 'src/traits.rs', lines 200:0-200:22 *) +noeq type parentTrait0_t (self : Type0) = { + tW : Type0; + get_name : self -> result string; + get_w : self -> result tW; +} + +(** Trait declaration: [traits::ParentTrait1] + Source: 'src/traits.rs', lines 205:0-205:22 *) +type parentTrait1_t (self : Type0) = unit + +(** Trait declaration: [traits::ChildTrait] + Source: 'src/traits.rs', lines 206:0-206:49 *) +noeq type childTrait_t (self : Type0) = { + parentTrait0SelfInst : parentTrait0_t self; + parentTrait1SelfInst : parentTrait1_t self; +} + +(** [traits::test_parent_trait0]: forward function + Source: 'src/traits.rs', lines 208:0-208:57 *) +let test_parent_trait0 + (t : Type0) (parentTrait0TInst : parentTrait0_t t) (x : t) : + result parentTrait0TInst.tW + = + parentTrait0TInst.get_w x + +(** [traits::test_child_trait1]: forward function + Source: 'src/traits.rs', lines 213:0-213:56 *) +let test_child_trait1 + (t : Type0) (childTraitTInst : childTrait_t t) (x : t) : result string = + childTraitTInst.parentTrait0SelfInst.get_name x + +(** [traits::test_child_trait2]: forward function + Source: 'src/traits.rs', lines 217:0-217:54 *) +let test_child_trait2 + (t : Type0) (childTraitTInst : childTrait_t t) (x : t) : + result childTraitTInst.parentTrait0SelfInst.tW + = + childTraitTInst.parentTrait0SelfInst.get_w x + +(** [traits::order1]: forward function + Source: 'src/traits.rs', lines 223:0-223:59 *) +let order1 + (t u : Type0) (parentTrait0TInst : parentTrait0_t t) (parentTrait0UInst : + parentTrait0_t u) : + result unit + = + Return () + +(** Trait declaration: [traits::ChildTrait1] + Source: 'src/traits.rs', lines 226:0-226:35 *) +noeq type childTrait1_t (self : Type0) = { + parentTrait1SelfInst : parentTrait1_t self; +} + +(** Trait implementation: [traits::{usize#9}] + Source: 'src/traits.rs', lines 228:0-228:27 *) +let traits_ParentTrait1UsizeInst : parentTrait1_t usize = () + +(** Trait implementation: [traits::{usize#10}] + Source: 'src/traits.rs', lines 229:0-229:26 *) +let traits_ChildTrait1UsizeInst : childTrait1_t usize = { + parentTrait1SelfInst = traits_ParentTrait1UsizeInst; +} + +(** Trait declaration: [traits::Iterator] + Source: 'src/traits.rs', lines 233:0-233:18 *) +noeq type iterator_t (self : Type0) = { tItem : Type0; } + +(** Trait declaration: [traits::IntoIterator] + Source: 'src/traits.rs', lines 237:0-237:22 *) +noeq type intoIterator_t (self : Type0) = { + tItem : Type0; + tIntoIter : Type0; + tIntoIter_clause_0 : iterator_t tIntoIter; + into_iter : self -> result tIntoIter; +} + +(** Trait declaration: [traits::FromResidual] + Source: 'src/traits.rs', lines 254:0-254:21 *) +type fromResidual_t (self t : Type0) = unit + +(** Trait declaration: [traits::Try] + Source: 'src/traits.rs', lines 250:0-250:48 *) +noeq type try_t (self : Type0) = { + tResidual : Type0; + fromResidualSelftraitsTrySelfResidualInst : fromResidual_t self tResidual; +} + +(** Trait declaration: [traits::WithTarget] + Source: 'src/traits.rs', lines 256:0-256:20 *) +noeq type withTarget_t (self : Type0) = { tTarget : Type0; } + +(** Trait declaration: [traits::ParentTrait2] + Source: 'src/traits.rs', lines 260:0-260:22 *) +noeq type parentTrait2_t (self : Type0) = { + tU : Type0; + tU_clause_0 : withTarget_t tU; +} + +(** Trait declaration: [traits::ChildTrait2] + Source: 'src/traits.rs', lines 264:0-264:35 *) +noeq type childTrait2_t (self : Type0) = { + parentTrait2SelfInst : parentTrait2_t self; + convert : parentTrait2SelfInst.tU -> result + parentTrait2SelfInst.tU_clause_0.tTarget; +} + +(** Trait implementation: [traits::{u32#11}] + Source: 'src/traits.rs', lines 268:0-268:23 *) +let traits_WithTargetU32Inst : withTarget_t u32 = { tTarget = u32; } + +(** Trait implementation: [traits::{u32#12}] + Source: 'src/traits.rs', lines 272:0-272:25 *) +let traits_ParentTrait2U32Inst : parentTrait2_t u32 = { + tU = u32; + tU_clause_0 = traits_WithTargetU32Inst; +} + +(** [traits::{u32#13}::convert]: forward function + Source: 'src/traits.rs', lines 277:4-277:29 *) +let u32_convert (x : u32) : result u32 = + Return x + +(** Trait implementation: [traits::{u32#13}] + Source: 'src/traits.rs', lines 276:0-276:24 *) +let traits_ChildTrait2U32Inst : childTrait2_t u32 = { + parentTrait2SelfInst = traits_ParentTrait2U32Inst; + convert = u32_convert; +} + +(** Trait declaration: [traits::CFnOnce] + Source: 'src/traits.rs', lines 290:0-290:23 *) +noeq type cFnOnce_t (self args : Type0) = { + tOutput : Type0; + call_once : self -> args -> result tOutput; +} + +(** Trait declaration: [traits::CFnMut] + Source: 'src/traits.rs', lines 296:0-296:37 *) +noeq type cFnMut_t (self args : Type0) = { + cFnOnceSelfArgsInst : cFnOnce_t self args; + call_mut : self -> args -> result cFnOnceSelfArgsInst.tOutput; + call_mut_back : self -> args -> result self; +} + +(** Trait declaration: [traits::CFn] + Source: 'src/traits.rs', lines 300:0-300:33 *) +noeq type cFn_t (self args : Type0) = { + cFnMutSelfArgsInst : cFnMut_t self args; + call : self -> args -> result cFnMutSelfArgsInst.cFnOnceSelfArgsInst.tOutput; +} + +(** Trait declaration: [traits::GetTrait] + Source: 'src/traits.rs', lines 304:0-304:18 *) +noeq type getTrait_t (self : Type0) = { tW : Type0; get_w : self -> result tW; +} + +(** [traits::test_get_trait]: forward function + Source: 'src/traits.rs', lines 309:0-309:49 *) +let test_get_trait + (t : Type0) (getTraitTInst : getTrait_t t) (x : t) : + result getTraitTInst.tW + = + getTraitTInst.get_w x + diff --git a/tests/fstar/array/Array.Clauses.Template.fst b/tests/fstar/array/Array.Clauses.Template.fst index 84347ab9..b2f2649c 100644 --- a/tests/fstar/array/Array.Clauses.Template.fst +++ b/tests/fstar/array/Array.Clauses.Template.fst @@ -9,13 +9,13 @@ open Array.Types (** [array::sum]: decreases clause Source: 'src/array.rs', lines 242:0-250:1 *) unfold -let sum_loop_decreases (s : slice u32) (sum0 : u32) (i : usize) : nat = +let sum_loop_decreases (s : slice u32) (sum1 : u32) (i : usize) : nat = admit () (** [array::sum2]: decreases clause Source: 'src/array.rs', lines 252:0-261:1 *) unfold -let sum2_loop_decreases (s : slice u32) (s2 : slice u32) (sum0 : u32) +let sum2_loop_decreases (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) : nat = admit () diff --git a/tests/fstar/array/Array.Funs.fst b/tests/fstar/array/Array.Funs.fst index 935bd9c9..da4164bc 100644 --- a/tests/fstar/array/Array.Funs.fst +++ b/tests/fstar/array/Array.Funs.fst @@ -7,86 +7,82 @@ include Array.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [array::incr]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [array::incr]: Source: 'src/array.rs', lines 8:0-8:24 *) let incr (x : u32) : result u32 = u32_add x 1 -(** [array::array_to_shared_slice_]: forward function +(** [array::array_to_shared_slice_]: Source: 'src/array.rs', lines 16:0-16:53 *) let array_to_shared_slice_ (t : Type0) (s : array t 32) : result (slice t) = array_to_slice t 32 s -(** [array::array_to_mut_slice_]: forward function +(** [array::array_to_mut_slice_]: Source: 'src/array.rs', lines 21:0-21:58 *) -let array_to_mut_slice_ (t : Type0) (s : array t 32) : result (slice t) = - array_to_slice t 32 s - -(** [array::array_to_mut_slice_]: backward function 0 - Source: 'src/array.rs', lines 21:0-21:58 *) -let array_to_mut_slice__back - (t : Type0) (s : array t 32) (ret : slice t) : result (array t 32) = - array_from_slice t 32 s ret +let array_to_mut_slice_ + (t : Type0) (s : array t 32) : + result ((slice t) & (slice t -> result (array t 32))) + = + let* (s1, to_slice_mut_back) = array_to_slice_mut t 32 s in + let back = fun ret -> to_slice_mut_back ret in + Return (s1, back) -(** [array::array_len]: forward function +(** [array::array_len]: Source: 'src/array.rs', lines 25:0-25:40 *) let array_len (t : Type0) (s : array t 32) : result usize = - let* s0 = array_to_slice t 32 s in let i = slice_len t s0 in Return i + let* s1 = array_to_slice t 32 s in let i = slice_len t s1 in Return i -(** [array::shared_array_len]: forward function +(** [array::shared_array_len]: Source: 'src/array.rs', lines 29:0-29:48 *) let shared_array_len (t : Type0) (s : array t 32) : result usize = - let* s0 = array_to_slice t 32 s in let i = slice_len t s0 in Return i + let* s1 = array_to_slice t 32 s in let i = slice_len t s1 in Return i -(** [array::shared_slice_len]: forward function +(** [array::shared_slice_len]: Source: 'src/array.rs', lines 33:0-33:44 *) let shared_slice_len (t : Type0) (s : slice t) : result usize = let i = slice_len t s in Return i -(** [array::index_array_shared]: forward function +(** [array::index_array_shared]: Source: 'src/array.rs', lines 37:0-37:57 *) let index_array_shared (t : Type0) (s : array t 32) (i : usize) : result t = array_index_usize t 32 s i -(** [array::index_array_u32]: forward function +(** [array::index_array_u32]: Source: 'src/array.rs', lines 44:0-44:53 *) let index_array_u32 (s : array u32 32) (i : usize) : result u32 = array_index_usize u32 32 s i -(** [array::index_array_copy]: forward function +(** [array::index_array_copy]: Source: 'src/array.rs', lines 48:0-48:45 *) let index_array_copy (x : array u32 32) : result u32 = array_index_usize u32 32 x 0 -(** [array::index_mut_array]: forward function - Source: 'src/array.rs', lines 52:0-52:62 *) -let index_mut_array (t : Type0) (s : array t 32) (i : usize) : result t = - array_index_usize t 32 s i - -(** [array::index_mut_array]: backward function 0 +(** [array::index_mut_array]: Source: 'src/array.rs', lines 52:0-52:62 *) -let index_mut_array_back - (t : Type0) (s : array t 32) (i : usize) (ret : t) : result (array t 32) = - array_update_usize t 32 s i ret +let index_mut_array + (t : Type0) (s : array t 32) (i : usize) : + result (t & (t -> result (array t 32))) + = + let* (x, index_mut_back) = array_index_mut_usize t 32 s i in + let back = fun ret -> index_mut_back ret in + Return (x, back) -(** [array::index_slice]: forward function +(** [array::index_slice]: Source: 'src/array.rs', lines 56:0-56:46 *) let index_slice (t : Type0) (s : slice t) (i : usize) : result t = slice_index_usize t s i -(** [array::index_mut_slice]: forward function - Source: 'src/array.rs', lines 60:0-60:58 *) -let index_mut_slice (t : Type0) (s : slice t) (i : usize) : result t = - slice_index_usize t s i - -(** [array::index_mut_slice]: backward function 0 +(** [array::index_mut_slice]: Source: 'src/array.rs', lines 60:0-60:58 *) -let index_mut_slice_back - (t : Type0) (s : slice t) (i : usize) (ret : t) : result (slice t) = - slice_update_usize t s i ret +let index_mut_slice + (t : Type0) (s : slice t) (i : usize) : + result (t & (t -> result (slice t))) + = + let* (x, index_mut_back) = slice_index_mut_usize t s i in + let back = fun ret -> index_mut_back ret in + Return (x, back) -(** [array::slice_subslice_shared_]: forward function +(** [array::slice_subslice_shared_]: Source: 'src/array.rs', lines 64:0-64:70 *) let slice_subslice_shared_ (x : slice u32) (y : usize) (z : usize) : result (slice u32) = @@ -94,41 +90,35 @@ let slice_subslice_shared_ (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x { start = y; end_ = z } -(** [array::slice_subslice_mut_]: forward function +(** [array::slice_subslice_mut_]: Source: 'src/array.rs', lines 68:0-68:75 *) let slice_subslice_mut_ - (x : slice u32) (y : usize) (z : usize) : result (slice u32) = - core_slice_index_Slice_index_mut u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x - { start = y; end_ = z } - -(** [array::slice_subslice_mut_]: backward function 0 - Source: 'src/array.rs', lines 68:0-68:75 *) -let slice_subslice_mut__back - (x : slice u32) (y : usize) (z : usize) (ret : slice u32) : - result (slice u32) + (x : slice u32) (y : usize) (z : usize) : + result ((slice u32) & (slice u32 -> result (slice u32))) = - core_slice_index_Slice_index_mut_back u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x - { start = y; end_ = z } ret - -(** [array::array_to_slice_shared_]: forward function + let* (s, index_mut_back) = + core_slice_index_Slice_index_mut u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x + { start = y; end_ = z } in + let back = fun ret -> index_mut_back ret in + Return (s, back) + +(** [array::array_to_slice_shared_]: Source: 'src/array.rs', lines 72:0-72:54 *) let array_to_slice_shared_ (x : array u32 32) : result (slice u32) = array_to_slice u32 32 x -(** [array::array_to_slice_mut_]: forward function +(** [array::array_to_slice_mut_]: Source: 'src/array.rs', lines 76:0-76:59 *) -let array_to_slice_mut_ (x : array u32 32) : result (slice u32) = - array_to_slice u32 32 x - -(** [array::array_to_slice_mut_]: backward function 0 - Source: 'src/array.rs', lines 76:0-76:59 *) -let array_to_slice_mut__back - (x : array u32 32) (ret : slice u32) : result (array u32 32) = - array_from_slice u32 32 x ret +let array_to_slice_mut_ + (x : array u32 32) : + result ((slice u32) & (slice u32 -> result (array u32 32))) + = + let* (s, to_slice_mut_back) = array_to_slice_mut u32 32 x in + let back = fun ret -> to_slice_mut_back ret in + Return (s, back) -(** [array::array_subslice_shared_]: forward function +(** [array::array_subslice_shared_]: Source: 'src/array.rs', lines 80:0-80:74 *) let array_subslice_shared_ (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = @@ -137,274 +127,263 @@ let array_subslice_shared_ (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x { start = y; end_ = z } -(** [array::array_subslice_mut_]: forward function +(** [array::array_subslice_mut_]: Source: 'src/array.rs', lines 84:0-84:79 *) let array_subslice_mut_ - (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = - core_array_Array_index_mut u32 (core_ops_range_Range usize) 32 - (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x - { start = y; end_ = z } - -(** [array::array_subslice_mut_]: backward function 0 - Source: 'src/array.rs', lines 84:0-84:79 *) -let array_subslice_mut__back - (x : array u32 32) (y : usize) (z : usize) (ret : slice u32) : - result (array u32 32) + (x : array u32 32) (y : usize) (z : usize) : + result ((slice u32) & (slice u32 -> result (array u32 32))) = - core_array_Array_index_mut_back u32 (core_ops_range_Range usize) 32 - (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x - { start = y; end_ = z } ret + let* (s, index_mut_back) = + core_array_Array_index_mut u32 (core_ops_range_Range usize) 32 + (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x + { start = y; end_ = z } in + let back = fun ret -> index_mut_back ret in + Return (s, back) -(** [array::index_slice_0]: forward function +(** [array::index_slice_0]: Source: 'src/array.rs', lines 88:0-88:38 *) let index_slice_0 (t : Type0) (s : slice t) : result t = slice_index_usize t s 0 -(** [array::index_array_0]: forward function +(** [array::index_array_0]: Source: 'src/array.rs', lines 92:0-92:42 *) let index_array_0 (t : Type0) (s : array t 32) : result t = array_index_usize t 32 s 0 -(** [array::index_index_array]: forward function +(** [array::index_index_array]: Source: 'src/array.rs', lines 103:0-103:71 *) let index_index_array (s : array (array u32 32) 32) (i : usize) (j : usize) : result u32 = let* a = array_index_usize (array u32 32) 32 s i in array_index_usize u32 32 a j -(** [array::update_update_array]: forward function +(** [array::update_update_array]: Source: 'src/array.rs', lines 114:0-114:70 *) let update_update_array (s : array (array u32 32) 32) (i : usize) (j : usize) : result unit = - let* a = array_index_usize (array u32 32) 32 s i in - let* a0 = array_update_usize u32 32 a j 0 in - let* _ = array_update_usize (array u32 32) 32 s i a0 in + let* (a, index_mut_back) = array_index_mut_usize (array u32 32) 32 s i in + let* (_, index_mut_back1) = array_index_mut_usize u32 32 a j in + let* a1 = index_mut_back1 0 in + let* _ = index_mut_back a1 in Return () -(** [array::array_local_deep_copy]: forward function +(** [array::array_local_deep_copy]: Source: 'src/array.rs', lines 118:0-118:43 *) let array_local_deep_copy (x : array u32 32) : result unit = Return () -(** [array::take_array]: forward function +(** [array::take_array]: Source: 'src/array.rs', lines 122:0-122:30 *) let take_array (a : array u32 2) : result unit = Return () -(** [array::take_array_borrow]: forward function +(** [array::take_array_borrow]: Source: 'src/array.rs', lines 123:0-123:38 *) let take_array_borrow (a : array u32 2) : result unit = Return () -(** [array::take_slice]: forward function +(** [array::take_slice]: Source: 'src/array.rs', lines 124:0-124:28 *) let take_slice (s : slice u32) : result unit = Return () -(** [array::take_mut_slice]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [array::take_mut_slice]: Source: 'src/array.rs', lines 125:0-125:36 *) let take_mut_slice (s : slice u32) : result (slice u32) = Return s -(** [array::const_array]: forward function +(** [array::const_array]: Source: 'src/array.rs', lines 127:0-127:32 *) let const_array : result (array u32 2) = Return (mk_array u32 2 [ 0; 0 ]) -(** [array::const_slice]: forward function +(** [array::const_slice]: Source: 'src/array.rs', lines 131:0-131:20 *) let const_slice : result unit = let* _ = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in Return () -(** [array::take_all]: forward function +(** [array::take_all]: Source: 'src/array.rs', lines 141:0-141:17 *) let take_all : result unit = + let* _ = take_array (mk_array u32 2 [ 0; 0 ]) in let* _ = take_array (mk_array u32 2 [ 0; 0 ]) in let* _ = take_array_borrow (mk_array u32 2 [ 0; 0 ]) in let* s = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in let* _ = take_slice s in - let* s0 = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in - let* s1 = take_mut_slice s0 in - let* _ = array_from_slice u32 2 (mk_array u32 2 [ 0; 0 ]) s1 in + let* (s1, to_slice_mut_back) = + array_to_slice_mut u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* s2 = take_mut_slice s1 in + let* _ = to_slice_mut_back s2 in Return () -(** [array::index_array]: forward function +(** [array::index_array]: Source: 'src/array.rs', lines 155:0-155:38 *) let index_array (x : array u32 2) : result u32 = array_index_usize u32 2 x 0 -(** [array::index_array_borrow]: forward function +(** [array::index_array_borrow]: Source: 'src/array.rs', lines 158:0-158:46 *) let index_array_borrow (x : array u32 2) : result u32 = array_index_usize u32 2 x 0 -(** [array::index_slice_u32_0]: forward function +(** [array::index_slice_u32_0]: Source: 'src/array.rs', lines 162:0-162:42 *) let index_slice_u32_0 (x : slice u32) : result u32 = slice_index_usize u32 x 0 -(** [array::index_mut_slice_u32_0]: forward function - Source: 'src/array.rs', lines 166:0-166:50 *) -let index_mut_slice_u32_0 (x : slice u32) : result u32 = - slice_index_usize u32 x 0 - -(** [array::index_mut_slice_u32_0]: backward function 0 +(** [array::index_mut_slice_u32_0]: Source: 'src/array.rs', lines 166:0-166:50 *) -let index_mut_slice_u32_0_back (x : slice u32) : result (slice u32) = - let* _ = slice_index_usize u32 x 0 in Return x +let index_mut_slice_u32_0 (x : slice u32) : result (u32 & (slice u32)) = + let* i = slice_index_usize u32 x 0 in Return (i, x) -(** [array::index_all]: forward function +(** [array::index_all]: Source: 'src/array.rs', lines 170:0-170:25 *) let index_all : result u32 = let* i = index_array (mk_array u32 2 [ 0; 0 ]) in - let* i0 = index_array (mk_array u32 2 [ 0; 0 ]) in - let* i1 = u32_add i i0 in - let* i2 = index_array_borrow (mk_array u32 2 [ 0; 0 ]) in - let* i3 = u32_add i1 i2 in + let* i1 = index_array (mk_array u32 2 [ 0; 0 ]) in + let* i2 = u32_add i i1 in + let* i3 = index_array_borrow (mk_array u32 2 [ 0; 0 ]) in + let* i4 = u32_add i2 i3 in let* s = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in - let* i4 = index_slice_u32_0 s in - let* i5 = u32_add i3 i4 in - let* s0 = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in - let* i6 = index_mut_slice_u32_0 s0 in - let* i7 = u32_add i5 i6 in - let* s1 = index_mut_slice_u32_0_back s0 in - let* _ = array_from_slice u32 2 (mk_array u32 2 [ 0; 0 ]) s1 in - Return i7 - -(** [array::update_array]: forward function + let* i5 = index_slice_u32_0 s in + let* i6 = u32_add i4 i5 in + let* (s1, to_slice_mut_back) = + array_to_slice_mut u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* (i7, s2) = index_mut_slice_u32_0 s1 in + let* i8 = u32_add i6 i7 in + let* _ = to_slice_mut_back s2 in + Return i8 + +(** [array::update_array]: Source: 'src/array.rs', lines 184:0-184:36 *) let update_array (x : array u32 2) : result unit = - let* _ = array_update_usize u32 2 x 0 1 in Return () + let* (_, index_mut_back) = array_index_mut_usize u32 2 x 0 in + let* _ = index_mut_back 1 in + Return () -(** [array::update_array_mut_borrow]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [array::update_array_mut_borrow]: Source: 'src/array.rs', lines 187:0-187:48 *) let update_array_mut_borrow (x : array u32 2) : result (array u32 2) = - array_update_usize u32 2 x 0 1 + let* (_, index_mut_back) = array_index_mut_usize u32 2 x 0 in + index_mut_back 1 -(** [array::update_mut_slice]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [array::update_mut_slice]: Source: 'src/array.rs', lines 190:0-190:38 *) let update_mut_slice (x : slice u32) : result (slice u32) = - slice_update_usize u32 x 0 1 + let* (_, index_mut_back) = slice_index_mut_usize u32 x 0 in index_mut_back 1 -(** [array::update_all]: forward function +(** [array::update_all]: Source: 'src/array.rs', lines 194:0-194:19 *) let update_all : result unit = let* _ = update_array (mk_array u32 2 [ 0; 0 ]) in - let* x = update_array_mut_borrow (mk_array u32 2 [ 0; 0 ]) in - let* s = array_to_slice u32 2 x in - let* s0 = update_mut_slice s in - let* _ = array_from_slice u32 2 x s0 in + let* _ = update_array (mk_array u32 2 [ 0; 0 ]) in + let* a = update_array_mut_borrow (mk_array u32 2 [ 0; 0 ]) in + let* (s, to_slice_mut_back) = array_to_slice_mut u32 2 a in + let* s1 = update_mut_slice s in + let* _ = to_slice_mut_back s1 in Return () -(** [array::range_all]: forward function +(** [array::range_all]: Source: 'src/array.rs', lines 205:0-205:18 *) let range_all : result unit = - let* s = + let* (s, index_mut_back) = core_array_Array_index_mut u32 (core_ops_range_Range usize) 4 (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) (mk_array u32 4 [ 0; 0; 0; 0 ]) { start = 1; end_ = 3 } in - let* s0 = update_mut_slice s in - let* _ = - core_array_Array_index_mut_back u32 (core_ops_range_Range usize) 4 - (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) - (mk_array u32 4 [ 0; 0; 0; 0 ]) { start = 1; end_ = 3 } s0 in + let* s1 = update_mut_slice s in + let* _ = index_mut_back s1 in Return () -(** [array::deref_array_borrow]: forward function +(** [array::deref_array_borrow]: Source: 'src/array.rs', lines 214:0-214:46 *) let deref_array_borrow (x : array u32 2) : result u32 = array_index_usize u32 2 x 0 -(** [array::deref_array_mut_borrow]: forward function +(** [array::deref_array_mut_borrow]: Source: 'src/array.rs', lines 219:0-219:54 *) -let deref_array_mut_borrow (x : array u32 2) : result u32 = - array_index_usize u32 2 x 0 +let deref_array_mut_borrow (x : array u32 2) : result (u32 & (array u32 2)) = + let* i = array_index_usize u32 2 x 0 in Return (i, x) -(** [array::deref_array_mut_borrow]: backward function 0 - Source: 'src/array.rs', lines 219:0-219:54 *) -let deref_array_mut_borrow_back (x : array u32 2) : result (array u32 2) = - let* _ = array_index_usize u32 2 x 0 in Return x - -(** [array::take_array_t]: forward function +(** [array::take_array_t]: Source: 'src/array.rs', lines 227:0-227:31 *) let take_array_t (a : array aB_t 2) : result unit = Return () -(** [array::non_copyable_array]: forward function +(** [array::non_copyable_array]: Source: 'src/array.rs', lines 229:0-229:27 *) let non_copyable_array : result unit = let* _ = take_array_t (mk_array aB_t 2 [ AB_A; AB_B ]) in Return () -(** [array::sum]: loop 0: forward function +(** [array::sum]: loop 0: Source: 'src/array.rs', lines 242:0-250:1 *) let rec sum_loop - (s : slice u32) (sum0 : u32) (i : usize) : - Tot (result u32) (decreases (sum_loop_decreases s sum0 i)) + (s : slice u32) (sum1 : u32) (i : usize) : + Tot (result u32) (decreases (sum_loop_decreases s sum1 i)) = - let i0 = slice_len u32 s in - if i < i0 + let i1 = slice_len u32 s in + if i < i1 then - let* i1 = slice_index_usize u32 s i in - let* sum1 = u32_add sum0 i1 in - let* i2 = usize_add i 1 in - sum_loop s sum1 i2 - else Return sum0 + let* i2 = slice_index_usize u32 s i in + let* sum3 = u32_add sum1 i2 in + let* i3 = usize_add i 1 in + sum_loop s sum3 i3 + else Return sum1 -(** [array::sum]: forward function +(** [array::sum]: Source: 'src/array.rs', lines 242:0-242:28 *) let sum (s : slice u32) : result u32 = sum_loop s 0 0 -(** [array::sum2]: loop 0: forward function +(** [array::sum2]: loop 0: Source: 'src/array.rs', lines 252:0-261:1 *) let rec sum2_loop - (s : slice u32) (s2 : slice u32) (sum0 : u32) (i : usize) : - Tot (result u32) (decreases (sum2_loop_decreases s s2 sum0 i)) + (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) : + Tot (result u32) (decreases (sum2_loop_decreases s s2 sum1 i)) = - let i0 = slice_len u32 s in - if i < i0 + let i1 = slice_len u32 s in + if i < i1 then - let* i1 = slice_index_usize u32 s i in - let* i2 = slice_index_usize u32 s2 i in - let* i3 = u32_add i1 i2 in - let* sum1 = u32_add sum0 i3 in - let* i4 = usize_add i 1 in - sum2_loop s s2 sum1 i4 - else Return sum0 - -(** [array::sum2]: forward function + let* i2 = slice_index_usize u32 s i in + let* i3 = slice_index_usize u32 s2 i in + let* i4 = u32_add i2 i3 in + let* sum3 = u32_add sum1 i4 in + let* i5 = usize_add i 1 in + sum2_loop s s2 sum3 i5 + else Return sum1 + +(** [array::sum2]: Source: 'src/array.rs', lines 252:0-252:41 *) let sum2 (s : slice u32) (s2 : slice u32) : result u32 = let i = slice_len u32 s in - let i0 = slice_len u32 s2 in - if not (i = i0) then Fail Failure else sum2_loop s s2 0 0 + let i1 = slice_len u32 s2 in + if not (i = i1) then Fail Failure else sum2_loop s s2 0 0 -(** [array::f0]: forward function +(** [array::f0]: Source: 'src/array.rs', lines 263:0-263:11 *) let f0 : result unit = - let* s = array_to_slice u32 2 (mk_array u32 2 [ 1; 2 ]) in - let* s0 = slice_update_usize u32 s 0 1 in - let* _ = array_from_slice u32 2 (mk_array u32 2 [ 1; 2 ]) s0 in + let* (s, to_slice_mut_back) = + array_to_slice_mut u32 2 (mk_array u32 2 [ 1; 2 ]) in + let* (_, index_mut_back) = slice_index_mut_usize u32 s 0 in + let* s1 = index_mut_back 1 in + let* _ = to_slice_mut_back s1 in Return () -(** [array::f1]: forward function +(** [array::f1]: Source: 'src/array.rs', lines 268:0-268:11 *) let f1 : result unit = - let* _ = array_update_usize u32 2 (mk_array u32 2 [ 1; 2 ]) 0 1 in Return () + let* (_, index_mut_back) = + array_index_mut_usize u32 2 (mk_array u32 2 [ 1; 2 ]) 0 in + let* _ = index_mut_back 1 in + Return () -(** [array::f2]: forward function +(** [array::f2]: Source: 'src/array.rs', lines 273:0-273:17 *) let f2 (i : u32) : result unit = Return () -(** [array::f4]: forward function +(** [array::f4]: Source: 'src/array.rs', lines 282:0-282:54 *) let f4 (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = core_array_Array_index u32 (core_ops_range_Range usize) 32 @@ -412,34 +391,36 @@ let f4 (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x { start = y; end_ = z } -(** [array::f3]: forward function +(** [array::f3]: Source: 'src/array.rs', lines 275:0-275:18 *) let f3 : result u32 = let* i = array_index_usize u32 2 (mk_array u32 2 [ 1; 2 ]) 0 in let* _ = f2 i in let b = array_repeat u32 32 0 in let* s = array_to_slice u32 2 (mk_array u32 2 [ 1; 2 ]) in - let* s0 = f4 b 16 18 in - sum2 s s0 + let* s1 = f4 b 16 18 in + sum2 s s1 (** [array::SZ] Source: 'src/array.rs', lines 286:0-286:19 *) let sz_body : result usize = Return 32 let sz_c : usize = eval_global sz_body -(** [array::f5]: forward function +(** [array::f5]: Source: 'src/array.rs', lines 289:0-289:31 *) let f5 (x : array u32 32) : result u32 = array_index_usize u32 32 x 0 -(** [array::ite]: forward function +(** [array::ite]: Source: 'src/array.rs', lines 294:0-294:12 *) let ite : result unit = - let* s = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in - let* s0 = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in - let* s1 = index_mut_slice_u32_0_back s0 in - let* _ = array_from_slice u32 2 (mk_array u32 2 [ 0; 0 ]) s1 in - let* s2 = index_mut_slice_u32_0_back s in - let* _ = array_from_slice u32 2 (mk_array u32 2 [ 0; 0 ]) s2 in + let* (s, to_slice_mut_back) = + array_to_slice_mut u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* (_, s1) = index_mut_slice_u32_0 s in + let* (s2, to_slice_mut_back1) = + array_to_slice_mut u32 2 (mk_array u32 2 [ 0; 0 ]) in + let* (_, s3) = index_mut_slice_u32_0 s2 in + let* _ = to_slice_mut_back1 s3 in + let* _ = to_slice_mut_back s1 in Return () diff --git a/tests/fstar/array/Primitives.fst b/tests/fstar/array/Primitives.fst index a3ffbde4..fca80829 100644 --- a/tests/fstar/array/Primitives.fst +++ b/tests/fstar/array/Primitives.fst @@ -55,8 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a = x -let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -477,8 +476,7 @@ noeq type core_ops_index_Index (self idx : Type0) = { // Trait declaration: [core::ops::index::IndexMut] noeq type core_ops_index_IndexMut (self idx : Type0) = { indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result indexInst.output; - index_mut_back : self → idx → indexInst.output → result self; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); } // Trait declaration [core::ops::deref::Deref] @@ -490,8 +488,7 @@ noeq type core_ops_deref_Deref (self : Type0) = { // Trait declaration [core::ops::deref::DerefMut] noeq type core_ops_deref_DerefMut (self : Type0) = { derefInst : core_ops_deref_Deref self; - deref_mut : self → result derefInst.target; - deref_mut_back : self → derefInst.target → result self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); } type core_ops_range_Range (a : Type0) = { @@ -502,8 +499,8 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = + Return (x, (fun x -> Return x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -515,7 +512,6 @@ let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { derefInst = alloc_boxed_Box_coreopsDerefInst self; deref_mut = alloc_boxed_Box_deref_mut self; - deref_mut_back = alloc_boxed_Box_deref_mut_back self; } (*** Array *) @@ -535,10 +531,18 @@ let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : resu if i < length x then Return (index x i) else Fail Failure -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : + result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure +let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : + result (a & (a -> result (array a n))) = + match array_index_usize a n x i with + | Fail e -> Fail e + | Return v -> + Return (v, array_update_usize a n x i) + (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -552,6 +556,13 @@ let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result ( if i < length x then Return (list_update x i nx) else Fail Failure +let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : + result (a & (a -> result (slice a))) = + match slice_index_usize a s i with + | Fail e -> Fail e + | Return x -> + Return (x, slice_update_usize a s i) + (*** Subslices *) let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x @@ -559,6 +570,10 @@ let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : res if length s = n then Return s else Fail Failure +let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : + result (slice a & (slice a -> result (array a n))) = + Return (x, array_from_slice a n x) + // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() @@ -588,8 +603,13 @@ let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : r let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : + result (a & (a → result (alloc_vec_Vec a))) = + match alloc_vec_Vec_index_usize v i with + | Return x -> + Return (x, alloc_vec_Vec_update_usize v i) + | Fail e -> Fail e + let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : Pure (result (alloc_vec_Vec a)) (requires True) @@ -605,9 +625,6 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : end else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure @@ -619,13 +636,11 @@ noeq type core_slice_index_SliceIndex (self t : Type0) = { sealedInst : core_slice_index_private_slice_index_Sealed self; output : Type0; get : self → t → result (option output); - get_mut : self → t → result (option output); - get_mut_back : self → t → option output → result t; + get_mut : self → t → result (option output & (option output -> result t)); get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); index : self → t → result output; - index_mut : self → t → result output; - index_mut_back : self → t → output → result t; + index_mut : self → t → result (output & (output -> result t)); } // [core::slice::index::[T]::index]: forward function @@ -643,14 +658,8 @@ let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) admit () // TODO // [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_RangeUsize_get_mut_back - (t : Type0) : - core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = admit () // TODO // [core::slice::index::Range::get_unchecked]: forward function @@ -675,27 +684,16 @@ let core_slice_index_RangeUsize_index admit () // TODO // [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_RangeUsize_index_mut_back - (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = admit () // TODO // [core::slice::index::[T]::index_mut]: forward function let core_slice_index_Slice_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result inst.output = + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = admit () // -// [core::slice::index::[T]::index_mut]: backward function 0 -let core_slice_index_Slice_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → inst.output → result (slice t) = - admit () // TODO - // [core::array::[T; N]::index]: forward function let core_array_Array_index (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) @@ -705,13 +703,8 @@ let core_array_Array_index // [core::array::[T; N]::index_mut]: forward function let core_array_Array_index_mut (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : result inst.indexInst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: backward function 0 -let core_array_Array_index_mut_back - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::Range] @@ -725,12 +718,10 @@ let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : output = slice t; get = core_slice_index_RangeUsize_get t; get_mut = core_slice_index_RangeUsize_get_mut t; - get_mut_back = core_slice_index_RangeUsize_get_mut_back t; get_unchecked = core_slice_index_RangeUsize_get_unchecked t; get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; index = core_slice_index_RangeUsize_index t; index_mut = core_slice_index_RangeUsize_index_mut t; - index_mut_back = core_slice_index_RangeUsize_index_mut_back t; } // Trait implementation: [core::slice::index::[T]] @@ -747,7 +738,6 @@ let core_ops_index_IndexMutSliceTIInst (t idx : Type0) core_ops_index_IndexMut (slice t) idx = { indexInst = core_ops_index_IndexSliceTIInst t idx inst; index_mut = core_slice_index_Slice_index_mut t idx inst; - index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; } // Trait implementation: [core::array::[T; N]] @@ -764,7 +754,6 @@ let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) core_ops_index_IndexMut (array t n) idx = { indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; index_mut = core_array_Array_index_mut t idx n inst; - index_mut_back = core_array_Array_index_mut_back t idx n inst; } // [core::slice::index::usize::get]: forward function @@ -773,13 +762,8 @@ let core_slice_index_usize_get admit () // TODO // [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: backward function 0 -let core_slice_index_usize_get_mut_back - (t : Type0) : usize → slice t → option t → result (slice t) = +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = admit () // TODO // [core::slice::index::usize::get_unchecked]: forward function @@ -797,12 +781,8 @@ let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = admit () // TODO // [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: backward function 0 -let core_slice_index_usize_index_mut_back - (t : Type0) : usize → slice t → t → result (slice t) = +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::usize] @@ -816,12 +796,10 @@ let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : output = t; get = core_slice_index_usize_get t; get_mut = core_slice_index_usize_get_mut t; - get_mut_back = core_slice_index_usize_get_mut_back t; get_unchecked = core_slice_index_usize_get_unchecked t; get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; index = core_slice_index_usize_index t; index_mut = core_slice_index_usize_index_mut t; - index_mut_back = core_slice_index_usize_index_mut_back t; } // [alloc::vec::Vec::index]: forward function @@ -831,13 +809,8 @@ let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx // [alloc::vec::Vec::index_mut]: forward function let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: backward function 0 -let alloc_vec_Vec_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = admit () // TODO // Trait implementation: [alloc::vec::Vec] @@ -854,7 +827,6 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) core_ops_index_IndexMut (alloc_vec_Vec t) idx = { indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; index_mut = alloc_vec_Vec_index_mut t idx inst; - index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } (*** Theorems *) @@ -870,15 +842,7 @@ let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : Lemma ( alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) + alloc_vec_Vec_index_mut_usize v i) [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] = admit() - -let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : - Lemma ( - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == - alloc_vec_Vec_update_usize v i x) - [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] - = - admit() diff --git a/tests/fstar/betree/BetreeMain.Funs.fst b/tests/fstar/betree/BetreeMain.Funs.fst index f844b0ec..a3065f3d 100644 --- a/tests/fstar/betree/BetreeMain.Funs.fst +++ b/tests/fstar/betree/BetreeMain.Funs.fst @@ -8,7 +8,7 @@ include BetreeMain.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [betree_main::betree::load_internal_node]: forward function +(** [betree_main::betree::load_internal_node]: Source: 'src/betree.rs', lines 36:0-36:52 *) let betree_load_internal_node (id : u64) (st : state) : @@ -16,58 +16,48 @@ let betree_load_internal_node = betree_utils_load_internal_node id st -(** [betree_main::betree::store_internal_node]: forward function +(** [betree_main::betree::store_internal_node]: 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* (st0, _) = betree_utils_store_internal_node id content st in - Return (st0, ()) + let* (st1, _) = betree_utils_store_internal_node id content st in + Return (st1, ()) -(** [betree_main::betree::load_leaf_node]: forward function +(** [betree_main::betree::load_leaf_node]: 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 +(** [betree_main::betree::store_leaf_node]: 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* (st0, _) = betree_utils_store_leaf_node id content st in - Return (st0, ()) + let* (st1, _) = betree_utils_store_leaf_node id content st in + Return (st1, ()) -(** [betree_main::betree::fresh_node_id]: forward function +(** [betree_main::betree::fresh_node_id]: 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 +let betree_fresh_node_id (counter : u64) : result (u64 & u64) = + let* counter1 = u64_add counter 1 in Return (counter, counter1) -(** [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 +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: 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 +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: 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 } + (self : betree_NodeIdCounter_t) : result (u64 & betree_NodeIdCounter_t) = + let* i = u64_add self.next_node_id 1 in + Return (self.next_node_id, { next_node_id = i }) -(** [betree_main::betree::upsert_update]: forward function +(** [betree_main::betree::upsert_update]: Source: 'src/betree.rs', lines 234:0-234:70 *) let betree_upsert_update (prev : option u64) (st : betree_UpsertFunState_t) : result u64 = @@ -75,30 +65,30 @@ let betree_upsert_update | None -> begin match st with | Betree_UpsertFunState_Add v -> Return v - | Betree_UpsertFunState_Sub i -> Return 0 + | Betree_UpsertFunState_Sub _ -> Return 0 end - | Some prev0 -> + | Some prev1 -> begin match st with | Betree_UpsertFunState_Add v -> - let* margin = u64_sub core_u64_max prev0 in - if margin >= v then u64_add prev0 v else Return core_u64_max + 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 prev0 >= v then u64_sub prev0 v else Return 0 + if prev1 >= v then u64_sub prev1 v else Return 0 end end -(** [betree_main::betree::{betree_main::betree::List#1}::len]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::len]: 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 x tl -> let* i = betree_List_len t tl in u64_add 1 i + | 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#1}::split_at]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::split_at]: Source: 'src/betree.rs', lines 284:4-284:51 *) let rec betree_List_split_at (t : Type0) (self : betree_List_t t) (n : u64) : @@ -118,52 +108,42 @@ let rec betree_List_split_at | Betree_List_Nil -> Fail Failure end -(** [betree_main::betree::{betree_main::betree::List#1}::push_front]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [betree_main::betree::{betree_main::betree::List#1}::push_front]: 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 + let (tl, _) = core_mem_replace (betree_List_t t) self Betree_List_Nil in let l = tl in Return (Betree_List_Cons x l) -(** [betree_main::betree::{betree_main::betree::List#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 tl -> Return x - | Betree_List_Nil -> Fail Failure - end - -(** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: backward function 0 +(** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: 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 +let betree_List_pop_front + (t : Type0) (self : betree_List_t t) : result (t & (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 x tl -> Return tl + | Betree_List_Cons x tl -> Return (x, tl) | Betree_List_Nil -> Fail Failure end -(** [betree_main::betree::{betree_main::betree::List#1}::hd]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::hd]: 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 l -> Return hd + | 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 +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::head_has_key]: 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 l -> let (i, _) = hd in Return (i = key) + | 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 +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: 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) : @@ -183,82 +163,54 @@ let rec betree_ListTupleU64T_partition_at_pivot | Betree_List_Nil -> Return (Betree_List_Nil, Betree_List_Nil) end -(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: forward function +(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: 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) + result (state & (betree_Internal_t & betree_NodeIdCounter_t)) = let* p = betree_List_split_at (u64 & u64) content params.split_size in let (content0, content1) = p in - let* p0 = betree_List_hd (u64 & u64) content1 in - let (pivot, _) = p0 in - let* id0 = betree_NodeIdCounter_fresh_id node_id_cnt in - let* node_id_cnt0 = betree_NodeIdCounter_fresh_id_back node_id_cnt in - let* id1 = betree_NodeIdCounter_fresh_id node_id_cnt0 in - let* (st0, _) = betree_store_leaf_node id0 content0 st in - let* (st1, _) = betree_store_leaf_node id1 content1 st0 in + let* p1 = betree_List_hd (u64 & u64) content1 in + let (pivot, _) = p1 in + let* (id0, nic) = betree_NodeIdCounter_fresh_id node_id_cnt in + let* (id1, nic1) = betree_NodeIdCounter_fresh_id nic 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 n0 = Betree_Node_Leaf { id = id1; size = params.split_size } in - Return (st1, { id = self.id; pivot = pivot; left = n; right = n0 }) + let n1 = Betree_Node_Leaf { id = id1; size = params.split_size } in + Return (st2, ({ id = self.id; pivot = pivot; left = n; right = n1 }, nic1)) -(** [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_cnt0 = betree_NodeIdCounter_fresh_id_back node_id_cnt in - let* id1 = betree_NodeIdCounter_fresh_id node_id_cnt0 in - let* (st0, _) = betree_store_leaf_node id0 content0 st in - let* _ = betree_store_leaf_node id1 content1 st0 in - betree_NodeIdCounter_fresh_id_back node_id_cnt0 - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: 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))) + Tot (result ((betree_List_t (u64 & betree_Message_t)) & (betree_List_t (u64 & + betree_Message_t) -> 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 + then + let back_'a = fun ret -> Return ret in + Return (Betree_List_Cons (i, m) next_msgs, back_'a) else - let* next_msgs0 = - betree_Node_lookup_first_message_for_key_back key next_msgs ret in - Return (Betree_List_Cons (i, m) next_msgs0) - | Betree_List_Nil -> Return ret + let* (l, lookup_first_message_for_key_back) = + betree_Node_lookup_first_message_for_key key next_msgs in + let back_'a = + fun ret -> + let* next_msgs1 = lookup_first_message_for_key_back ret in + Return (Betree_List_Cons (i, m) next_msgs1) in + Return (l, back_'a) + | Betree_List_Nil -> + let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) end -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: Source: 'src/betree.rs', lines 636:4-636:80 *) let rec betree_Node_lookup_in_bindings (key : u64) (bindings : betree_List_t (u64 & u64)) : @@ -267,215 +219,110 @@ let rec betree_Node_lookup_in_bindings = begin match bindings with | Betree_List_Cons hd tl -> - let (i, i0) = hd in + let (i, i1) = hd in if i = key - then Return (Some i0) + 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 +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: 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)) + Tot (result (state & (u64 & (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* (msg, l) = betree_List_pop_front (u64 & betree_Message_t) msgs in let (_, m) = msg in begin match m with - | Betree_Message_Insert i -> Fail Failure + | Betree_Message_Insert _ -> Fail Failure | Betree_Message_Delete -> Fail Failure | Betree_Message_Upsert s -> let* v = betree_upsert_update prev s in - let* msgs0 = betree_List_pop_front_back (u64 & betree_Message_t) msgs in - betree_Node_apply_upserts msgs0 (Some v) key st + betree_Node_apply_upserts l (Some v) key st end else - let* (st0, v) = core_option_Option_unwrap u64 prev st in - let* _ = + let* (st1, v) = core_option_Option_unwrap u64 prev st in + let* l = betree_List_push_front (u64 & betree_Message_t) msgs (key, Betree_Message_Insert v) in - Return (st0, 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 i -> Fail Failure - | Betree_Message_Delete -> Fail Failure - | Betree_Message_Upsert s -> - let* v = betree_upsert_update prev s in - let* msgs0 = betree_List_pop_front_back (u64 & betree_Message_t) msgs in - betree_Node_apply_upserts_back msgs0 (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) + Return (st1, (v, l)) -(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: forward function +(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: 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) + Tot (result (state & ((option u64) & 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 } + let* (st1, (o, n)) = betree_Node_lookup self.left key st in + Return (st1, (o, { self with left = n })) else - let* n = betree_Node_lookup_back self.right key st in - Return { self with right = n } + let* (st1, (o, n)) = betree_Node_lookup self.right key st in + Return (st1, (o, { self with right = n })) -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: 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))) + Tot (result (state & ((option u64) & betree_Node_t))) (decreases (betree_Node_lookup_decreases self key st)) = begin match self with | Betree_Node_Internal node -> - let* (st0, msgs) = betree_load_internal_node node.id st in - let* pending = betree_Node_lookup_first_message_for_key key msgs in + let* (st1, msgs) = betree_load_internal_node node.id st in + let* (pending, lookup_first_message_for_key_back) = + 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* (st1, o) = betree_Internal_lookup_in_children node key st0 in + let* (st2, (o, i)) = 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 (st1, o) + lookup_first_message_for_key_back (Betree_List_Cons (k, msg) l) in + Return (st2, (o, Betree_Node_Internal i)) 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 (st0, Some v) + lookup_first_message_for_key_back (Betree_List_Cons (k, + Betree_Message_Insert v) l) in + Return (st1, (Some v, 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 (st0, None) + lookup_first_message_for_key_back (Betree_List_Cons (k, + Betree_Message_Delete) l) in + Return (st1, (None, Betree_Node_Internal node)) | Betree_Message_Upsert ufs -> - let* (st1, v) = betree_Internal_lookup_in_children node key st0 in - let* (st2, v0) = + let* (st2, (v, i)) = betree_Internal_lookup_in_children node key st1 + in + let* (st3, (v1, l1)) = betree_Node_apply_upserts (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1 in - let* node0 = betree_Internal_lookup_in_children_back node key st0 in - let* pending0 = - betree_Node_apply_upserts_back (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1 in - let* msgs0 = - betree_Node_lookup_first_message_for_key_back key msgs pending0 in - let* (st3, _) = betree_store_internal_node node0.id msgs0 st2 in - Return (st3, Some v0) + Betree_Message_Upsert ufs) l) v key st2 in + let* msgs1 = lookup_first_message_for_key_back l1 in + let* (st4, _) = betree_store_internal_node i.id msgs1 st3 in + Return (st4, (Some v1, Betree_Node_Internal i)) end | Betree_List_Nil -> - let* (st1, o) = betree_Internal_lookup_in_children node key st0 in - let* _ = - betree_Node_lookup_first_message_for_key_back key msgs Betree_List_Nil - in - Return (st1, o) + let* (st2, (o, i)) = betree_Internal_lookup_in_children node key st1 in + let* _ = lookup_first_message_for_key_back Betree_List_Nil in + Return (st2, (o, Betree_Node_Internal i)) end | Betree_Node_Leaf node -> - let* (st0, bindings) = betree_load_leaf_node node.id st in + let* (st1, bindings) = betree_load_leaf_node node.id st in let* o = betree_Node_lookup_in_bindings key bindings in - Return (st0, o) + Return (st1, (o, Betree_Node_Leaf node)) 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* (st0, 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* node0 = betree_Internal_lookup_in_children_back node key st0 in - Return (Betree_Node_Internal node0) - 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* (st1, v) = betree_Internal_lookup_in_children node key st0 in - let* (st2, _) = - betree_Node_apply_upserts (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1 in - let* node0 = betree_Internal_lookup_in_children_back node key st0 in - let* pending0 = - betree_Node_apply_upserts_back (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1 in - let* msgs0 = - betree_Node_lookup_first_message_for_key_back key msgs pending0 in - let* _ = betree_store_internal_node node0.id msgs0 st2 in - Return (Betree_Node_Internal node0) - end - | Betree_List_Nil -> - let* _ = - betree_Node_lookup_first_message_for_key_back key msgs Betree_List_Nil - in - let* node0 = betree_Internal_lookup_in_children_back node key st0 in - Return (Betree_Node_Internal node0) - 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: 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)) : @@ -487,36 +334,20 @@ let rec betree_Node_filter_messages_for_key let (k, m) = p in if k = key then - let* msgs0 = - betree_List_pop_front_back (u64 & betree_Message_t) (Betree_List_Cons - (k, m) l) in - betree_Node_filter_messages_for_key key msgs0 + let* (_, l1) = + betree_List_pop_front (u64 & betree_Message_t) (Betree_List_Cons (k, m) + l) in + betree_Node_filter_messages_for_key key l1 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 +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: 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))) + Tot (result ((betree_List_t (u64 & betree_Message_t)) & (betree_List_t (u64 & + betree_Message_t) -> result (betree_List_t (u64 & betree_Message_t))))) (decreases (betree_Node_lookup_first_message_after_key_decreases key msgs)) = begin match msgs with @@ -524,75 +355,79 @@ let rec betree_Node_lookup_first_message_after_key_back let (k, m) = p in if k = key then - let* next_msgs0 = - betree_Node_lookup_first_message_after_key_back key next_msgs ret in - Return (Betree_List_Cons (k, m) next_msgs0) - else Return ret - | Betree_List_Nil -> Return ret + let* (l, lookup_first_message_after_key_back) = + betree_Node_lookup_first_message_after_key key next_msgs in + let back_'a = + fun ret -> + let* next_msgs1 = lookup_first_message_after_key_back ret in + Return (Betree_List_Cons (k, m) next_msgs1) in + Return (l, back_'a) + else + let back_'a = fun ret -> Return ret in + Return (Betree_List_Cons (k, m) next_msgs, back_'a) + | Betree_List_Nil -> + let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: 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* msgs0 = betree_Node_lookup_first_message_for_key key msgs in - let* b = betree_ListTupleU64T_head_has_key betree_Message_t msgs0 key in + let* (msgs1, lookup_first_message_for_key_back) = + 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* msgs1 = betree_Node_filter_messages_for_key key msgs0 in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + let* l = betree_Node_filter_messages_for_key key msgs1 in + let* l1 = + betree_List_push_front (u64 & betree_Message_t) l (key, Betree_Message_Insert i) in - betree_Node_lookup_first_message_for_key_back key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Delete -> - let* msgs1 = betree_Node_filter_messages_for_key key msgs0 in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + let* l = betree_Node_filter_messages_for_key key msgs1 in + let* l1 = + betree_List_push_front (u64 & betree_Message_t) l (key, Betree_Message_Delete) in - betree_Node_lookup_first_message_for_key_back key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Upsert s -> - let* p = betree_List_hd (u64 & betree_Message_t) msgs0 in + 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* msgs1 = betree_List_pop_front_back (u64 & betree_Message_t) msgs0 - in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + let* (_, l) = betree_List_pop_front (u64 & betree_Message_t) msgs1 in + let* l1 = + betree_List_push_front (u64 & betree_Message_t) l (key, Betree_Message_Insert v) in - betree_Node_lookup_first_message_for_key_back key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Delete -> + let* (_, l) = betree_List_pop_front (u64 & betree_Message_t) msgs1 in let* v = betree_upsert_update None s in - let* msgs1 = betree_List_pop_front_back (u64 & betree_Message_t) msgs0 - in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + let* l1 = + betree_List_push_front (u64 & betree_Message_t) l (key, Betree_Message_Insert v) in - betree_Node_lookup_first_message_for_key_back key msgs msgs2 - | Betree_Message_Upsert ufs -> - let* msgs1 = betree_Node_lookup_first_message_after_key key msgs0 in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + lookup_first_message_for_key_back l1 + | Betree_Message_Upsert _ -> + let* (msgs2, lookup_first_message_after_key_back) = + betree_Node_lookup_first_message_after_key key msgs1 in + let* l = + betree_List_push_front (u64 & betree_Message_t) msgs2 (key, Betree_Message_Upsert s) in - let* msgs3 = - betree_Node_lookup_first_message_after_key_back key msgs0 msgs2 in - betree_Node_lookup_first_message_for_key_back key msgs msgs3 + let* msgs3 = lookup_first_message_after_key_back l in + lookup_first_message_for_key_back msgs3 end end else - let* msgs1 = - betree_List_push_front (u64 & betree_Message_t) msgs0 (key, new_msg) in - betree_Node_lookup_first_message_for_key_back key msgs msgs1 + let* l = + betree_List_push_front (u64 & betree_Message_t) msgs1 (key, new_msg) in + lookup_first_message_for_key_back l -(** [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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_internal]: 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)) @@ -603,89 +438,75 @@ let rec betree_Node_apply_messages_to_internal begin match new_msgs with | Betree_List_Cons new_msg new_msgs_tl -> let (i, m) = new_msg in - let* msgs0 = betree_Node_apply_to_internal msgs i m in - betree_Node_apply_messages_to_internal msgs0 new_msgs_tl + let* l = betree_Node_apply_to_internal msgs i m in + betree_Node_apply_messages_to_internal l new_msgs_tl | Betree_List_Nil -> Return msgs end -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: 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, i0) = hd in - if i >= key - then Return (Betree_List_Cons (i, i0) 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))) + Tot (result ((betree_List_t (u64 & u64)) & (betree_List_t (u64 & u64) -> + 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, i0) = hd in + let (i, i1) = hd in if i >= key - then Return ret + then + let back_'a = fun ret -> Return ret in + Return (Betree_List_Cons (i, i1) tl, back_'a) else - let* tl0 = betree_Node_lookup_mut_in_bindings_back key tl ret in - Return (Betree_List_Cons (i, i0) tl0) - | Betree_List_Nil -> Return ret + let* (l, lookup_mut_in_bindings_back) = + betree_Node_lookup_mut_in_bindings key tl in + let back_'a = + fun ret -> + let* tl1 = lookup_mut_in_bindings_back ret in + Return (Betree_List_Cons (i, i1) tl1) in + Return (l, back_'a) + | Betree_List_Nil -> + let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: 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* bindings0 = betree_Node_lookup_mut_in_bindings key bindings in - let* b = betree_ListTupleU64T_head_has_key u64 bindings0 key in + let* (bindings1, lookup_mut_in_bindings_back) = + 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) bindings0 in + let* (hd, l) = betree_List_pop_front (u64 & u64) bindings1 in begin match new_msg with | Betree_Message_Insert v -> - let* bindings1 = betree_List_pop_front_back (u64 & u64) bindings0 in - 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 -> - let* bindings1 = betree_List_pop_front_back (u64 & u64) bindings0 in - betree_Node_lookup_mut_in_bindings_back key bindings bindings1 + let* l1 = betree_List_push_front (u64 & u64) l (key, v) in + lookup_mut_in_bindings_back l1 + | Betree_Message_Delete -> lookup_mut_in_bindings_back l | Betree_Message_Upsert s -> let (_, i) = hd in let* v = betree_upsert_update (Some i) s in - let* bindings1 = betree_List_pop_front_back (u64 & u64) bindings0 in - let* bindings2 = betree_List_push_front (u64 & u64) bindings1 (key, v) in - betree_Node_lookup_mut_in_bindings_back key bindings bindings2 + let* l1 = betree_List_push_front (u64 & u64) l (key, v) in + lookup_mut_in_bindings_back l1 end else begin match new_msg with | Betree_Message_Insert v -> - let* bindings1 = betree_List_push_front (u64 & u64) bindings0 (key, v) in - betree_Node_lookup_mut_in_bindings_back key bindings bindings1 - | Betree_Message_Delete -> - betree_Node_lookup_mut_in_bindings_back key bindings bindings0 + let* l = betree_List_push_front (u64 & u64) bindings1 (key, v) in + lookup_mut_in_bindings_back l + | Betree_Message_Delete -> lookup_mut_in_bindings_back bindings1 | Betree_Message_Upsert s -> let* v = betree_upsert_update None s in - let* bindings1 = betree_List_push_front (u64 & u64) bindings0 (key, v) in - betree_Node_lookup_mut_in_bindings_back key bindings bindings1 + let* l = betree_List_push_front (u64 & u64) bindings1 (key, v) in + lookup_mut_in_bindings_back l 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_leaf]: Source: 'src/betree.rs', lines 444:4-447:5 *) let rec betree_Node_apply_messages_to_leaf (bindings : betree_List_t (u64 & u64)) @@ -696,18 +517,19 @@ let rec betree_Node_apply_messages_to_leaf begin match new_msgs with | Betree_List_Cons new_msg new_msgs_tl -> let (i, m) = new_msg in - let* bindings0 = betree_Node_apply_to_leaf bindings i m in - betree_Node_apply_messages_to_leaf bindings0 new_msgs_tl + let* l = betree_Node_apply_to_leaf bindings i m in + betree_Node_apply_messages_to_leaf l new_msgs_tl | Betree_List_Nil -> Return bindings end -(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: forward function +(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: 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)))) + Tot (result (state & ((betree_List_t (u64 & betree_Message_t)) & + (betree_Internal_t & betree_NodeIdCounter_t)))) (decreases ( betree_Internal_flush_decreases self params node_id_cnt content st)) = @@ -718,290 +540,143 @@ let rec betree_Internal_flush let* len_left = betree_List_len (u64 & betree_Message_t) msgs_left in if len_left >= params.min_flush_size then - let* (st0, _) = + let* (st1, p1) = betree_Node_apply_messages self.left params node_id_cnt msgs_left st in - let* (_, node_id_cnt0) = - betree_Node_apply_messages_back self.left params node_id_cnt msgs_left st - in + let (n, node_id_cnt1) = p1 in let* len_right = betree_List_len (u64 & betree_Message_t) msgs_right in if len_right >= params.min_flush_size then - let* (st1, _) = - betree_Node_apply_messages self.right params node_id_cnt0 msgs_right - st0 in - let* _ = - betree_Node_apply_messages_back self.right params node_id_cnt0 - msgs_right st0 in - Return (st1, Betree_List_Nil) - else Return (st0, msgs_right) + let* (st2, p2) = + betree_Node_apply_messages self.right params node_id_cnt1 msgs_right + st1 in + let (n1, node_id_cnt2) = p2 in + Return (st2, (Betree_List_Nil, ({ self with left = n; right = n1 }, + node_id_cnt2))) + else Return (st1, (msgs_right, ({ self with left = n }, node_id_cnt1))) else - let* (st0, _) = + let* (st1, p1) = 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 (st0, msgs_left) + let (n, node_id_cnt1) = p1 in + Return (st1, (msgs_left, ({ self with right = n }, node_id_cnt1))) -(** [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* (st0, _) = - betree_Node_apply_messages self.left params node_id_cnt msgs_left st in - let* (n, node_id_cnt0) = - 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* (n0, node_id_cnt1) = - betree_Node_apply_messages_back self.right params node_id_cnt0 - msgs_right st0 in - Return ({ self with left = n; right = n0 }, node_id_cnt1) - else Return ({ self with left = n }, node_id_cnt0) - else - let* (n, node_id_cnt0) = - betree_Node_apply_messages_back self.right params node_id_cnt msgs_right - st in - Return ({ self with right = n }, node_id_cnt0) - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: 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* (st0, content) = betree_load_internal_node node.id st in - let* content0 = betree_Node_apply_messages_to_internal content msgs in - let* num_msgs = betree_List_len (u64 & betree_Message_t) content0 in - if num_msgs >= params.min_flush_size - then - let* (st1, content1) = - betree_Internal_flush node params node_id_cnt content0 st0 in - let* (node0, _) = - betree_Internal_flush_back node params node_id_cnt content0 st0 in - let* (st2, _) = betree_store_internal_node node0.id content1 st1 in - Return (st2, ()) - else - let* (st1, _) = betree_store_internal_node node.id content0 st0 in - Return (st1, ()) - | Betree_Node_Leaf node -> - let* (st0, content) = betree_load_leaf_node node.id st in - let* content0 = betree_Node_apply_messages_to_leaf content msgs in - let* len = betree_List_len (u64 & u64) content0 in - let* i = u64_mul 2 params.split_size in - if len >= i - then - let* (st1, _) = betree_Leaf_split node content0 params node_id_cnt st0 in - let* (st2, _) = betree_store_leaf_node node.id Betree_List_Nil st1 in - Return (st2, ()) - else - let* (st1, _) = betree_store_leaf_node node.id content0 st0 in - Return (st1, ()) - 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)) + Tot (result (state & (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* (st0, content) = betree_load_internal_node node.id st in - let* content0 = betree_Node_apply_messages_to_internal content msgs in - let* num_msgs = betree_List_len (u64 & betree_Message_t) content0 in + let* (st1, content) = betree_load_internal_node node.id st in + let* l = betree_Node_apply_messages_to_internal content msgs in + let* num_msgs = betree_List_len (u64 & betree_Message_t) l in if num_msgs >= params.min_flush_size then - let* (st1, content1) = - betree_Internal_flush node params node_id_cnt content0 st0 in - let* (node0, node_id_cnt0) = - betree_Internal_flush_back node params node_id_cnt content0 st0 in - let* _ = betree_store_internal_node node0.id content1 st1 in - Return (Betree_Node_Internal node0, node_id_cnt0) + let* (st2, (content1, p)) = + betree_Internal_flush node params node_id_cnt l st1 in + let (node1, node_id_cnt1) = p in + let* (st3, _) = betree_store_internal_node node1.id content1 st2 in + Return (st3, (Betree_Node_Internal node1, node_id_cnt1)) else - let* _ = betree_store_internal_node node.id content0 st0 in - Return (Betree_Node_Internal node, node_id_cnt) + let* (st2, _) = betree_store_internal_node node.id l st1 in + Return (st2, (Betree_Node_Internal node, node_id_cnt)) | Betree_Node_Leaf node -> - let* (st0, content) = betree_load_leaf_node node.id st in - let* content0 = betree_Node_apply_messages_to_leaf content msgs in - let* len = betree_List_len (u64 & u64) content0 in + let* (st1, content) = betree_load_leaf_node node.id st in + let* l = betree_Node_apply_messages_to_leaf content msgs in + let* len = betree_List_len (u64 & u64) l in let* i = u64_mul 2 params.split_size in if len >= i then - let* (st1, new_node) = - betree_Leaf_split node content0 params node_id_cnt st0 in - let* _ = betree_store_leaf_node node.id Betree_List_Nil st1 in - let* node_id_cnt0 = - betree_Leaf_split_back node content0 params node_id_cnt st0 in - Return (Betree_Node_Internal new_node, node_id_cnt0) + let* (st2, (new_node, nic)) = + betree_Leaf_split node l params node_id_cnt st1 in + let* (st3, _) = betree_store_leaf_node node.id Betree_List_Nil st2 in + Return (st3, (Betree_Node_Internal new_node, nic)) else - let* _ = betree_store_leaf_node node.id content0 st0 in - Return (Betree_Node_Leaf { node with size = len }, node_id_cnt) + let* (st2, _) = betree_store_leaf_node node.id l st1 in + Return (st2, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) end -(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: 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) + result (state & (betree_Node_t & betree_NodeIdCounter_t)) = let l = Betree_List_Nil in - let* (st0, _) = + let* (st1, p) = betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, new_msg) l) st in - let* _ = - betree_Node_apply_messages_back self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st in - Return (st0, ()) + let (self1, node_id_cnt1) = p in + Return (st1, (self1, node_id_cnt1)) -(** [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) - = - let l = Betree_List_Nil in - betree_Node_apply_messages_back self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: 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* (st0, _) = betree_store_leaf_node id Betree_List_Nil st in - let* node_id_cnt0 = betree_NodeIdCounter_fresh_id_back node_id_cnt in - Return (st0, + let* (id, nic) = betree_NodeIdCounter_fresh_id node_id_cnt in + let* (st1, _) = betree_store_leaf_node id Betree_List_Nil st in + Return (st1, { params = { min_flush_size = min_flush_size; split_size = split_size }; - node_id_cnt = node_id_cnt0; + node_id_cnt = nic; root = (Betree_Node_Leaf { id = id; size = 0 }) }) -(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: 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) + result (state & betree_BeTree_t) = - let* (st0, _) = + let* (st1, p) = 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 (st0, ()) + let (n, nic) = p in + Return (st1, { self with node_id_cnt = nic; root = n }) -(** [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 +(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: 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* (st0, _) = 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 (st0, ()) - -(** [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 + result (state & betree_BeTree_t) = - betree_BeTree_apply_back self key (Betree_Message_Insert value) st + betree_BeTree_apply self key (Betree_Message_Insert value) st -(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: 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* (st0, _) = betree_BeTree_apply self key Betree_Message_Delete st in - let* _ = betree_BeTree_apply_back self key Betree_Message_Delete st in - Return (st0, ()) - -(** [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) + (self : betree_BeTree_t) (key : u64) (st : state) : + result (state & betree_BeTree_t) = - let* (st0, _) = 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 (st0, ()) + betree_BeTree_apply self key Betree_Message_Delete st -(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: backward function 0 +(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: Source: 'src/betree.rs', lines 886:4-886:59 *) -let betree_BeTree_upsert_back +let betree_BeTree_upsert (self : betree_BeTree_t) (key : u64) (upd : betree_UpsertFunState_t) (st : state) : - result betree_BeTree_t + result (state & betree_BeTree_t) = - betree_BeTree_apply_back self key (Betree_Message_Upsert upd) st + betree_BeTree_apply self key (Betree_Message_Upsert upd) st -(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: 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)) + result (state & ((option u64) & betree_BeTree_t)) = - 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 } + let* (st1, (o, n)) = betree_Node_lookup self.root key st in + Return (st1, (o, { self with root = n })) -(** [betree_main::main]: forward function +(** [betree_main::main]: Source: 'src/betree_main.rs', lines 5:0-5:9 *) let main : result unit = Return () diff --git a/tests/fstar/betree/BetreeMain.FunsExternal.fsti b/tests/fstar/betree/BetreeMain.FunsExternal.fsti index cd2f956f..de9b96fd 100644 --- a/tests/fstar/betree/BetreeMain.FunsExternal.fsti +++ b/tests/fstar/betree/BetreeMain.FunsExternal.fsti @@ -6,29 +6,29 @@ include BetreeMain.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [betree_main::betree_utils::load_internal_node]: forward function +(** [betree_main::betree_utils::load_internal_node]: Source: 'src/betree_utils.rs', lines 98:0-98:63 *) val betree_utils_load_internal_node : u64 -> state -> result (state & (betree_List_t (u64 & betree_Message_t))) -(** [betree_main::betree_utils::store_internal_node]: forward function +(** [betree_main::betree_utils::store_internal_node]: Source: 'src/betree_utils.rs', lines 115:0-115:71 *) val betree_utils_store_internal_node : u64 -> betree_List_t (u64 & betree_Message_t) -> state -> result (state & unit) -(** [betree_main::betree_utils::load_leaf_node]: forward function +(** [betree_main::betree_utils::load_leaf_node]: Source: 'src/betree_utils.rs', lines 132:0-132:55 *) val betree_utils_load_leaf_node : u64 -> state -> result (state & (betree_List_t (u64 & u64))) -(** [betree_main::betree_utils::store_leaf_node]: forward function +(** [betree_main::betree_utils::store_leaf_node]: Source: 'src/betree_utils.rs', lines 145:0-145:63 *) val betree_utils_store_leaf_node : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit) -(** [core::option::{core::option::Option}::unwrap]: forward function +(** [core::option::{core::option::Option}::unwrap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) val core_option_Option_unwrap (t : Type0) : option t -> state -> result (state & t) diff --git a/tests/fstar/betree/Primitives.fst b/tests/fstar/betree/Primitives.fst index a3ffbde4..fca80829 100644 --- a/tests/fstar/betree/Primitives.fst +++ b/tests/fstar/betree/Primitives.fst @@ -55,8 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a = x -let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -477,8 +476,7 @@ noeq type core_ops_index_Index (self idx : Type0) = { // Trait declaration: [core::ops::index::IndexMut] noeq type core_ops_index_IndexMut (self idx : Type0) = { indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result indexInst.output; - index_mut_back : self → idx → indexInst.output → result self; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); } // Trait declaration [core::ops::deref::Deref] @@ -490,8 +488,7 @@ noeq type core_ops_deref_Deref (self : Type0) = { // Trait declaration [core::ops::deref::DerefMut] noeq type core_ops_deref_DerefMut (self : Type0) = { derefInst : core_ops_deref_Deref self; - deref_mut : self → result derefInst.target; - deref_mut_back : self → derefInst.target → result self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); } type core_ops_range_Range (a : Type0) = { @@ -502,8 +499,8 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = + Return (x, (fun x -> Return x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -515,7 +512,6 @@ let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { derefInst = alloc_boxed_Box_coreopsDerefInst self; deref_mut = alloc_boxed_Box_deref_mut self; - deref_mut_back = alloc_boxed_Box_deref_mut_back self; } (*** Array *) @@ -535,10 +531,18 @@ let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : resu if i < length x then Return (index x i) else Fail Failure -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : + result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure +let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : + result (a & (a -> result (array a n))) = + match array_index_usize a n x i with + | Fail e -> Fail e + | Return v -> + Return (v, array_update_usize a n x i) + (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -552,6 +556,13 @@ let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result ( if i < length x then Return (list_update x i nx) else Fail Failure +let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : + result (a & (a -> result (slice a))) = + match slice_index_usize a s i with + | Fail e -> Fail e + | Return x -> + Return (x, slice_update_usize a s i) + (*** Subslices *) let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x @@ -559,6 +570,10 @@ let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : res if length s = n then Return s else Fail Failure +let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : + result (slice a & (slice a -> result (array a n))) = + Return (x, array_from_slice a n x) + // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() @@ -588,8 +603,13 @@ let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : r let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : + result (a & (a → result (alloc_vec_Vec a))) = + match alloc_vec_Vec_index_usize v i with + | Return x -> + Return (x, alloc_vec_Vec_update_usize v i) + | Fail e -> Fail e + let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : Pure (result (alloc_vec_Vec a)) (requires True) @@ -605,9 +625,6 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : end else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure @@ -619,13 +636,11 @@ noeq type core_slice_index_SliceIndex (self t : Type0) = { sealedInst : core_slice_index_private_slice_index_Sealed self; output : Type0; get : self → t → result (option output); - get_mut : self → t → result (option output); - get_mut_back : self → t → option output → result t; + get_mut : self → t → result (option output & (option output -> result t)); get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); index : self → t → result output; - index_mut : self → t → result output; - index_mut_back : self → t → output → result t; + index_mut : self → t → result (output & (output -> result t)); } // [core::slice::index::[T]::index]: forward function @@ -643,14 +658,8 @@ let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) admit () // TODO // [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_RangeUsize_get_mut_back - (t : Type0) : - core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = admit () // TODO // [core::slice::index::Range::get_unchecked]: forward function @@ -675,27 +684,16 @@ let core_slice_index_RangeUsize_index admit () // TODO // [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_RangeUsize_index_mut_back - (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = admit () // TODO // [core::slice::index::[T]::index_mut]: forward function let core_slice_index_Slice_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result inst.output = + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = admit () // -// [core::slice::index::[T]::index_mut]: backward function 0 -let core_slice_index_Slice_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → inst.output → result (slice t) = - admit () // TODO - // [core::array::[T; N]::index]: forward function let core_array_Array_index (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) @@ -705,13 +703,8 @@ let core_array_Array_index // [core::array::[T; N]::index_mut]: forward function let core_array_Array_index_mut (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : result inst.indexInst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: backward function 0 -let core_array_Array_index_mut_back - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::Range] @@ -725,12 +718,10 @@ let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : output = slice t; get = core_slice_index_RangeUsize_get t; get_mut = core_slice_index_RangeUsize_get_mut t; - get_mut_back = core_slice_index_RangeUsize_get_mut_back t; get_unchecked = core_slice_index_RangeUsize_get_unchecked t; get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; index = core_slice_index_RangeUsize_index t; index_mut = core_slice_index_RangeUsize_index_mut t; - index_mut_back = core_slice_index_RangeUsize_index_mut_back t; } // Trait implementation: [core::slice::index::[T]] @@ -747,7 +738,6 @@ let core_ops_index_IndexMutSliceTIInst (t idx : Type0) core_ops_index_IndexMut (slice t) idx = { indexInst = core_ops_index_IndexSliceTIInst t idx inst; index_mut = core_slice_index_Slice_index_mut t idx inst; - index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; } // Trait implementation: [core::array::[T; N]] @@ -764,7 +754,6 @@ let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) core_ops_index_IndexMut (array t n) idx = { indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; index_mut = core_array_Array_index_mut t idx n inst; - index_mut_back = core_array_Array_index_mut_back t idx n inst; } // [core::slice::index::usize::get]: forward function @@ -773,13 +762,8 @@ let core_slice_index_usize_get admit () // TODO // [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: backward function 0 -let core_slice_index_usize_get_mut_back - (t : Type0) : usize → slice t → option t → result (slice t) = +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = admit () // TODO // [core::slice::index::usize::get_unchecked]: forward function @@ -797,12 +781,8 @@ let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = admit () // TODO // [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: backward function 0 -let core_slice_index_usize_index_mut_back - (t : Type0) : usize → slice t → t → result (slice t) = +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::usize] @@ -816,12 +796,10 @@ let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : output = t; get = core_slice_index_usize_get t; get_mut = core_slice_index_usize_get_mut t; - get_mut_back = core_slice_index_usize_get_mut_back t; get_unchecked = core_slice_index_usize_get_unchecked t; get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; index = core_slice_index_usize_index t; index_mut = core_slice_index_usize_index_mut t; - index_mut_back = core_slice_index_usize_index_mut_back t; } // [alloc::vec::Vec::index]: forward function @@ -831,13 +809,8 @@ let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx // [alloc::vec::Vec::index_mut]: forward function let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: backward function 0 -let alloc_vec_Vec_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = admit () // TODO // Trait implementation: [alloc::vec::Vec] @@ -854,7 +827,6 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) core_ops_index_IndexMut (alloc_vec_Vec t) idx = { indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; index_mut = alloc_vec_Vec_index_mut t idx inst; - index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } (*** Theorems *) @@ -870,15 +842,7 @@ let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : Lemma ( alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) + alloc_vec_Vec_index_mut_usize v i) [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] = admit() - -let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : - Lemma ( - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == - alloc_vec_Vec_update_usize v i x) - [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] - = - admit() diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst index 6c3c2161..a3065f3d 100644 --- a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst +++ b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst @@ -8,7 +8,7 @@ include BetreeMain.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [betree_main::betree::load_internal_node]: forward function +(** [betree_main::betree::load_internal_node]: Source: 'src/betree.rs', lines 36:0-36:52 *) let betree_load_internal_node (id : u64) (st : state) : @@ -16,58 +16,48 @@ let betree_load_internal_node = betree_utils_load_internal_node id st -(** [betree_main::betree::store_internal_node]: forward function +(** [betree_main::betree::store_internal_node]: 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* (st0, _) = betree_utils_store_internal_node id content st in - Return (st0, ()) + let* (st1, _) = betree_utils_store_internal_node id content st in + Return (st1, ()) -(** [betree_main::betree::load_leaf_node]: forward function +(** [betree_main::betree::load_leaf_node]: 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 +(** [betree_main::betree::store_leaf_node]: 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* (st0, _) = betree_utils_store_leaf_node id content st in - Return (st0, ()) - -(** [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 + let* (st1, _) = betree_utils_store_leaf_node id content st in + Return (st1, ()) -(** [betree_main::betree::fresh_node_id]: backward function 0 +(** [betree_main::betree::fresh_node_id]: Source: 'src/betree.rs', lines 55:0-55:48 *) -let betree_fresh_node_id_back (counter : u64) : result u64 = - u64_add counter 1 +let betree_fresh_node_id (counter : u64) : result (u64 & u64) = + let* counter1 = u64_add counter 1 in Return (counter, counter1) -(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: forward function +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: 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 +(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: 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 + (self : betree_NodeIdCounter_t) : result (u64 & betree_NodeIdCounter_t) = + let* i = u64_add self.next_node_id 1 in + Return (self.next_node_id, { next_node_id = i }) -(** [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 +(** [betree_main::betree::upsert_update]: Source: 'src/betree.rs', lines 234:0-234:70 *) let betree_upsert_update (prev : option u64) (st : betree_UpsertFunState_t) : result u64 = @@ -75,30 +65,30 @@ let betree_upsert_update | None -> begin match st with | Betree_UpsertFunState_Add v -> Return v - | Betree_UpsertFunState_Sub i -> Return 0 + | Betree_UpsertFunState_Sub _ -> Return 0 end - | Some prev0 -> + | Some prev1 -> begin match st with | Betree_UpsertFunState_Add v -> - let* margin = u64_sub core_u64_max prev0 in - if margin >= v then u64_add prev0 v else Return core_u64_max + 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 prev0 >= v then u64_sub prev0 v else Return 0 + if prev1 >= v then u64_sub prev1 v else Return 0 end end -(** [betree_main::betree::{betree_main::betree::List#1}::len]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::len]: 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 x tl -> let* i = betree_List_len t tl in u64_add 1 i + | 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#1}::split_at]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::split_at]: Source: 'src/betree.rs', lines 284:4-284:51 *) let rec betree_List_split_at (t : Type0) (self : betree_List_t t) (n : u64) : @@ -118,52 +108,42 @@ let rec betree_List_split_at | Betree_List_Nil -> Fail Failure end -(** [betree_main::betree::{betree_main::betree::List#1}::push_front]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [betree_main::betree::{betree_main::betree::List#1}::push_front]: 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 + let (tl, _) = core_mem_replace (betree_List_t t) self Betree_List_Nil in let l = tl in Return (Betree_List_Cons x l) -(** [betree_main::betree::{betree_main::betree::List#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 tl -> Return x - | Betree_List_Nil -> Fail Failure - end - -(** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: backward function 0 +(** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: 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 +let betree_List_pop_front + (t : Type0) (self : betree_List_t t) : result (t & (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 x tl -> Return tl + | Betree_List_Cons x tl -> Return (x, tl) | Betree_List_Nil -> Fail Failure end -(** [betree_main::betree::{betree_main::betree::List#1}::hd]: forward function +(** [betree_main::betree::{betree_main::betree::List#1}::hd]: 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 l -> Return hd + | 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 +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::head_has_key]: 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 l -> let (i, _) = hd in Return (i = key) + | 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 +(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: 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) : @@ -183,119 +163,54 @@ let rec betree_ListTupleU64T_partition_at_pivot | Betree_List_Nil -> Return (Betree_List_Nil, Betree_List_Nil) end -(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: forward function +(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: 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* p0 = betree_List_hd (u64 & u64) content1 in - let (pivot, _) = p0 in - let* id0 = betree_NodeIdCounter_fresh_id node_id_cnt in - let* node_id_cnt0 = betree_NodeIdCounter_fresh_id_back node_id_cnt in - let* id1 = betree_NodeIdCounter_fresh_id node_id_cnt0 in - let* (st0, _) = betree_store_leaf_node id0 content0 st in - let* (st1, _) = betree_store_leaf_node id1 content1 st0 in - let n = Betree_Node_Leaf { id = id0; size = params.split_size } in - let n0 = Betree_Node_Leaf { id = id1; size = params.split_size } in - Return (st1, { id = self.id; pivot = pivot; left = n; right = n0 }) - -(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: backward function 0 - Source: 'src/betree.rs', lines 359:4-364:17 *) -let betree_Leaf_split_back0 - (self : betree_Leaf_t) (content : betree_List_t (u64 & u64)) - (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) - (st : state) (st0 : state) : - result (state & unit) - = - 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_cnt0 = betree_NodeIdCounter_fresh_id_back node_id_cnt in - let* id1 = betree_NodeIdCounter_fresh_id node_id_cnt0 in - let* (st1, _) = betree_store_leaf_node id0 content0 st in - let* _ = betree_store_leaf_node id1 content1 st1 in - Return (st0, ()) - -(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: backward function 1 - Source: 'src/betree.rs', lines 359:4-364:17 *) -let betree_Leaf_split_back1 - (self : betree_Leaf_t) (content : betree_List_t (u64 & u64)) - (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) - (st : state) (st0 : state) : - result (state & unit) + result (state & (betree_Internal_t & 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_cnt0 = betree_NodeIdCounter_fresh_id_back node_id_cnt in - let* id1 = betree_NodeIdCounter_fresh_id node_id_cnt0 in + let* p1 = betree_List_hd (u64 & u64) content1 in + let (pivot, _) = p1 in + let* (id0, nic) = betree_NodeIdCounter_fresh_id node_id_cnt in + let* (id1, nic1) = betree_NodeIdCounter_fresh_id nic in let* (st1, _) = betree_store_leaf_node id0 content0 st in - let* _ = betree_store_leaf_node id1 content1 st1 in - Return (st0, ()) - -(** [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_back2 - (self : betree_Leaf_t) (content : betree_List_t (u64 & u64)) - (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) - (st : state) (st0 : state) : - result (state & 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_cnt0 = betree_NodeIdCounter_fresh_id_back node_id_cnt in - let* id1 = betree_NodeIdCounter_fresh_id node_id_cnt0 in - let* (st1, _) = betree_store_leaf_node id0 content0 st in - let* _ = betree_store_leaf_node id1 content1 st1 in - let* node_id_cnt1 = betree_NodeIdCounter_fresh_id_back node_id_cnt0 in - Return (st0, node_id_cnt1) + 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 }, nic1)) -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: 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))) + Tot (result ((betree_List_t (u64 & betree_Message_t)) & (betree_List_t (u64 & + betree_Message_t) -> 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 + then + let back_'a = fun ret -> Return ret in + Return (Betree_List_Cons (i, m) next_msgs, back_'a) else - let* next_msgs0 = - betree_Node_lookup_first_message_for_key_back key next_msgs ret in - Return (Betree_List_Cons (i, m) next_msgs0) - | Betree_List_Nil -> Return ret + let* (l, lookup_first_message_for_key_back) = + betree_Node_lookup_first_message_for_key key next_msgs in + let back_'a = + fun ret -> + let* next_msgs1 = lookup_first_message_for_key_back ret in + Return (Betree_List_Cons (i, m) next_msgs1) in + Return (l, back_'a) + | Betree_List_Nil -> + let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) end -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: Source: 'src/betree.rs', lines 636:4-636:80 *) let rec betree_Node_lookup_in_bindings (key : u64) (bindings : betree_List_t (u64 & u64)) : @@ -304,221 +219,110 @@ let rec betree_Node_lookup_in_bindings = begin match bindings with | Betree_List_Cons hd tl -> - let (i, i0) = hd in + let (i, i1) = hd in if i = key - then Return (Some i0) + 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 +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: 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 i -> Fail Failure - | Betree_Message_Delete -> Fail Failure - | Betree_Message_Upsert s -> - let* v = betree_upsert_update prev s in - let* msgs0 = betree_List_pop_front_back (u64 & betree_Message_t) msgs in - betree_Node_apply_upserts msgs0 (Some v) key st - end - else - let* (st0, 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 (st0, 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) (st0 : state) : - Tot (result (state & (betree_List_t (u64 & betree_Message_t)))) + Tot (result (state & (u64 & (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* (msg, l) = betree_List_pop_front (u64 & betree_Message_t) msgs in let (_, m) = msg in begin match m with - | Betree_Message_Insert i -> Fail Failure + | Betree_Message_Insert _ -> Fail Failure | Betree_Message_Delete -> Fail Failure | Betree_Message_Upsert s -> let* v = betree_upsert_update prev s in - let* msgs0 = betree_List_pop_front_back (u64 & betree_Message_t) msgs in - betree_Node_apply_upserts_back msgs0 (Some v) key st st0 + betree_Node_apply_upserts l (Some v) key st end else - let* (_, v) = core_option_Option_unwrap u64 prev st in - let* msgs0 = + let* (st1, v) = core_option_Option_unwrap u64 prev st in + let* l = betree_List_push_front (u64 & betree_Message_t) msgs (key, Betree_Message_Insert v) in - Return (st0, msgs0) + Return (st1, (v, l)) -(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: forward function +(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: 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) (st0 : state) : - Tot (result (state & betree_Internal_t)) + Tot (result (state & ((option u64) & betree_Internal_t))) (decreases (betree_Internal_lookup_in_children_decreases self key st)) = if key < self.pivot then - let* (st1, n) = betree_Node_lookup_back self.left key st st0 in - Return (st1, { self with left = n }) + let* (st1, (o, n)) = betree_Node_lookup self.left key st in + Return (st1, (o, { self with left = n })) else - let* (st1, n) = betree_Node_lookup_back self.right key st st0 in - Return (st1, { self with right = n }) + let* (st1, (o, n)) = betree_Node_lookup self.right key st in + Return (st1, (o, { self with right = n })) -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: 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* (st0, 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* (st1, o) = betree_Internal_lookup_in_children node key st0 in - let* _ = - betree_Node_lookup_first_message_for_key_back key msgs - (Betree_List_Cons (k, msg) l) in - Return (st1, 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 (st0, 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 (st0, None) - | Betree_Message_Upsert ufs -> - let* (st1, v) = betree_Internal_lookup_in_children node key st0 in - let* (st2, v0) = - betree_Node_apply_upserts (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1 in - let* (st3, node0) = - betree_Internal_lookup_in_children_back node key st0 st2 in - let* (st4, pending0) = - betree_Node_apply_upserts_back (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st1 st3 in - let* msgs0 = - betree_Node_lookup_first_message_for_key_back key msgs pending0 in - let* (st5, _) = betree_store_internal_node node0.id msgs0 st4 in - Return (st5, Some v0) - end - | Betree_List_Nil -> - let* (st1, o) = betree_Internal_lookup_in_children node key st0 in - let* _ = - betree_Node_lookup_first_message_for_key_back key msgs Betree_List_Nil - in - Return (st1, o) - end - | Betree_Node_Leaf node -> - let* (st0, bindings) = betree_load_leaf_node node.id st in - let* o = betree_Node_lookup_in_bindings key bindings in - Return (st0, 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) (st0 : state) : - Tot (result (state & betree_Node_t)) + Tot (result (state & ((option u64) & 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 + let* (pending, lookup_first_message_for_key_back) = + 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, i)) = 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 - let* (st2, node0) = - betree_Internal_lookup_in_children_back node key st1 st0 in - Return (st2, Betree_Node_Internal node0) + lookup_first_message_for_key_back (Betree_List_Cons (k, msg) l) in + Return (st2, (o, Betree_Node_Internal i)) 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 (st0, Betree_Node_Internal node) + lookup_first_message_for_key_back (Betree_List_Cons (k, + Betree_Message_Insert v) l) in + Return (st1, (Some v, 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 (st0, Betree_Node_Internal node) + lookup_first_message_for_key_back (Betree_List_Cons (k, + Betree_Message_Delete) l) in + Return (st1, (None, Betree_Node_Internal node)) | Betree_Message_Upsert ufs -> - let* (st2, v) = betree_Internal_lookup_in_children node key st1 in - let* (st3, _) = + let* (st2, (v, i)) = betree_Internal_lookup_in_children node key st1 + in + let* (st3, (v1, l1)) = betree_Node_apply_upserts (Betree_List_Cons (k, Betree_Message_Upsert ufs) l) v key st2 in - let* (st4, node0) = - betree_Internal_lookup_in_children_back node key st1 st3 in - let* (st5, pending0) = - betree_Node_apply_upserts_back (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key st2 st4 in - let* msgs0 = - betree_Node_lookup_first_message_for_key_back key msgs pending0 in - let* _ = betree_store_internal_node node0.id msgs0 st5 in - Return (st0, Betree_Node_Internal node0) + let* msgs1 = lookup_first_message_for_key_back l1 in + let* (st4, _) = betree_store_internal_node i.id msgs1 st3 in + Return (st4, (Some v1, Betree_Node_Internal i)) end | Betree_List_Nil -> - let* _ = - betree_Node_lookup_first_message_for_key_back key msgs Betree_List_Nil - in - let* (st2, node0) = - betree_Internal_lookup_in_children_back node key st1 st0 in - Return (st2, Betree_Node_Internal node0) + let* (st2, (o, i)) = betree_Internal_lookup_in_children node key st1 in + let* _ = lookup_first_message_for_key_back Betree_List_Nil in + Return (st2, (o, Betree_Node_Internal i)) 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 (st0, 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, 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: 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)) : @@ -530,36 +334,20 @@ let rec betree_Node_filter_messages_for_key let (k, m) = p in if k = key then - let* msgs0 = - betree_List_pop_front_back (u64 & betree_Message_t) (Betree_List_Cons - (k, m) l) in - betree_Node_filter_messages_for_key key msgs0 + let* (_, l1) = + betree_List_pop_front (u64 & betree_Message_t) (Betree_List_Cons (k, m) + l) in + betree_Node_filter_messages_for_key key l1 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 +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: 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))) + Tot (result ((betree_List_t (u64 & betree_Message_t)) & (betree_List_t (u64 & + betree_Message_t) -> result (betree_List_t (u64 & betree_Message_t))))) (decreases (betree_Node_lookup_first_message_after_key_decreases key msgs)) = begin match msgs with @@ -567,75 +355,79 @@ let rec betree_Node_lookup_first_message_after_key_back let (k, m) = p in if k = key then - let* next_msgs0 = - betree_Node_lookup_first_message_after_key_back key next_msgs ret in - Return (Betree_List_Cons (k, m) next_msgs0) - else Return ret - | Betree_List_Nil -> Return ret + let* (l, lookup_first_message_after_key_back) = + betree_Node_lookup_first_message_after_key key next_msgs in + let back_'a = + fun ret -> + let* next_msgs1 = lookup_first_message_after_key_back ret in + Return (Betree_List_Cons (k, m) next_msgs1) in + Return (l, back_'a) + else + let back_'a = fun ret -> Return ret in + Return (Betree_List_Cons (k, m) next_msgs, back_'a) + | Betree_List_Nil -> + let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: 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* msgs0 = betree_Node_lookup_first_message_for_key key msgs in - let* b = betree_ListTupleU64T_head_has_key betree_Message_t msgs0 key in + let* (msgs1, lookup_first_message_for_key_back) = + 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* msgs1 = betree_Node_filter_messages_for_key key msgs0 in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + let* l = betree_Node_filter_messages_for_key key msgs1 in + let* l1 = + betree_List_push_front (u64 & betree_Message_t) l (key, Betree_Message_Insert i) in - betree_Node_lookup_first_message_for_key_back key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Delete -> - let* msgs1 = betree_Node_filter_messages_for_key key msgs0 in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + let* l = betree_Node_filter_messages_for_key key msgs1 in + let* l1 = + betree_List_push_front (u64 & betree_Message_t) l (key, Betree_Message_Delete) in - betree_Node_lookup_first_message_for_key_back key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Upsert s -> - let* p = betree_List_hd (u64 & betree_Message_t) msgs0 in + 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* msgs1 = betree_List_pop_front_back (u64 & betree_Message_t) msgs0 - in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + let* (_, l) = betree_List_pop_front (u64 & betree_Message_t) msgs1 in + let* l1 = + betree_List_push_front (u64 & betree_Message_t) l (key, Betree_Message_Insert v) in - betree_Node_lookup_first_message_for_key_back key msgs msgs2 + lookup_first_message_for_key_back l1 | Betree_Message_Delete -> + let* (_, l) = betree_List_pop_front (u64 & betree_Message_t) msgs1 in let* v = betree_upsert_update None s in - let* msgs1 = betree_List_pop_front_back (u64 & betree_Message_t) msgs0 - in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + let* l1 = + betree_List_push_front (u64 & betree_Message_t) l (key, Betree_Message_Insert v) in - betree_Node_lookup_first_message_for_key_back key msgs msgs2 - | Betree_Message_Upsert ufs -> - let* msgs1 = betree_Node_lookup_first_message_after_key key msgs0 in - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, + lookup_first_message_for_key_back l1 + | Betree_Message_Upsert _ -> + let* (msgs2, lookup_first_message_after_key_back) = + betree_Node_lookup_first_message_after_key key msgs1 in + let* l = + betree_List_push_front (u64 & betree_Message_t) msgs2 (key, Betree_Message_Upsert s) in - let* msgs3 = - betree_Node_lookup_first_message_after_key_back key msgs0 msgs2 in - betree_Node_lookup_first_message_for_key_back key msgs msgs3 + let* msgs3 = lookup_first_message_after_key_back l in + lookup_first_message_for_key_back msgs3 end end else - let* msgs1 = - betree_List_push_front (u64 & betree_Message_t) msgs0 (key, new_msg) in - betree_Node_lookup_first_message_for_key_back key msgs msgs1 + let* l = + betree_List_push_front (u64 & betree_Message_t) msgs1 (key, new_msg) in + lookup_first_message_for_key_back l -(** [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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_internal]: 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)) @@ -646,89 +438,75 @@ let rec betree_Node_apply_messages_to_internal begin match new_msgs with | Betree_List_Cons new_msg new_msgs_tl -> let (i, m) = new_msg in - let* msgs0 = betree_Node_apply_to_internal msgs i m in - betree_Node_apply_messages_to_internal msgs0 new_msgs_tl + let* l = betree_Node_apply_to_internal msgs i m in + betree_Node_apply_messages_to_internal l new_msgs_tl | Betree_List_Nil -> Return msgs end -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: 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))) + Tot (result ((betree_List_t (u64 & u64)) & (betree_List_t (u64 & u64) -> + 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, i0) = hd in + let (i, i1) = hd in if i >= key - then Return (Betree_List_Cons (i, i0) 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, i0) = hd in - if i >= key - then Return ret + then + let back_'a = fun ret -> Return ret in + Return (Betree_List_Cons (i, i1) tl, back_'a) else - let* tl0 = betree_Node_lookup_mut_in_bindings_back key tl ret in - Return (Betree_List_Cons (i, i0) tl0) - | Betree_List_Nil -> Return ret + let* (l, lookup_mut_in_bindings_back) = + betree_Node_lookup_mut_in_bindings key tl in + let back_'a = + fun ret -> + let* tl1 = lookup_mut_in_bindings_back ret in + Return (Betree_List_Cons (i, i1) tl1) in + Return (l, back_'a) + | Betree_List_Nil -> + let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: 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* bindings0 = betree_Node_lookup_mut_in_bindings key bindings in - let* b = betree_ListTupleU64T_head_has_key u64 bindings0 key in + let* (bindings1, lookup_mut_in_bindings_back) = + 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) bindings0 in + let* (hd, l) = betree_List_pop_front (u64 & u64) bindings1 in begin match new_msg with | Betree_Message_Insert v -> - let* bindings1 = betree_List_pop_front_back (u64 & u64) bindings0 in - 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 -> - let* bindings1 = betree_List_pop_front_back (u64 & u64) bindings0 in - betree_Node_lookup_mut_in_bindings_back key bindings bindings1 + let* l1 = betree_List_push_front (u64 & u64) l (key, v) in + lookup_mut_in_bindings_back l1 + | Betree_Message_Delete -> lookup_mut_in_bindings_back l | Betree_Message_Upsert s -> let (_, i) = hd in let* v = betree_upsert_update (Some i) s in - let* bindings1 = betree_List_pop_front_back (u64 & u64) bindings0 in - let* bindings2 = betree_List_push_front (u64 & u64) bindings1 (key, v) in - betree_Node_lookup_mut_in_bindings_back key bindings bindings2 + let* l1 = betree_List_push_front (u64 & u64) l (key, v) in + lookup_mut_in_bindings_back l1 end else begin match new_msg with | Betree_Message_Insert v -> - let* bindings1 = betree_List_push_front (u64 & u64) bindings0 (key, v) in - betree_Node_lookup_mut_in_bindings_back key bindings bindings1 - | Betree_Message_Delete -> - betree_Node_lookup_mut_in_bindings_back key bindings bindings0 + let* l = betree_List_push_front (u64 & u64) bindings1 (key, v) in + lookup_mut_in_bindings_back l + | Betree_Message_Delete -> lookup_mut_in_bindings_back bindings1 | Betree_Message_Upsert s -> let* v = betree_upsert_update None s in - let* bindings1 = betree_List_push_front (u64 & u64) bindings0 (key, v) in - betree_Node_lookup_mut_in_bindings_back key bindings bindings1 + let* l = betree_List_push_front (u64 & u64) bindings1 (key, v) in + lookup_mut_in_bindings_back l 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 ()) +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_leaf]: Source: 'src/betree.rs', lines 444:4-447:5 *) let rec betree_Node_apply_messages_to_leaf (bindings : betree_List_t (u64 & u64)) @@ -739,69 +517,19 @@ let rec betree_Node_apply_messages_to_leaf begin match new_msgs with | Betree_List_Cons new_msg new_msgs_tl -> let (i, m) = new_msg in - let* bindings0 = betree_Node_apply_to_leaf bindings i m in - betree_Node_apply_messages_to_leaf bindings0 new_msgs_tl + let* l = betree_Node_apply_to_leaf bindings i m in + betree_Node_apply_messages_to_leaf l new_msgs_tl | Betree_List_Nil -> Return bindings end -(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: forward function +(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: 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* (st0, _) = - betree_Node_apply_messages self.left params node_id_cnt msgs_left st in - let* (st1, (_, node_id_cnt0)) = - betree_Node_apply_messages_back'a self.left params node_id_cnt msgs_left - st st0 in - let* (st2, ()) = - betree_Node_apply_messages_back1 self.left params node_id_cnt msgs_left - st st1 in - let* len_right = betree_List_len (u64 & betree_Message_t) msgs_right in - if len_right >= params.min_flush_size - then - let* (st3, _) = - betree_Node_apply_messages self.right params node_id_cnt0 msgs_right - st2 in - let* (st4, (_, _)) = - betree_Node_apply_messages_back'a self.right params node_id_cnt0 - msgs_right st2 st3 in - let* (st5, ()) = - betree_Node_apply_messages_back1 self.right params node_id_cnt0 - msgs_right st2 st4 in - Return (st5, Betree_List_Nil) - else Return (st2, msgs_right) - else - let* (st0, _) = - betree_Node_apply_messages self.right params node_id_cnt msgs_right st in - let* (st1, (_, _)) = - betree_Node_apply_messages_back'a self.right params node_id_cnt - msgs_right st st0 in - let* (st2, ()) = - betree_Node_apply_messages_back1 self.right params node_id_cnt msgs_right - st st1 in - Return (st2, 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'a - (self : betree_Internal_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) - (content : betree_List_t (u64 & betree_Message_t)) (st : state) (st0 : state) - : - Tot (result (state & (betree_Internal_t & betree_NodeIdCounter_t))) + Tot (result (state & ((betree_List_t (u64 & betree_Message_t)) & + (betree_Internal_t & betree_NodeIdCounter_t)))) (decreases ( betree_Internal_flush_decreases self params node_id_cnt content st)) = @@ -812,138 +540,31 @@ and betree_Internal_flush_back'a let* len_left = betree_List_len (u64 & betree_Message_t) msgs_left in if len_left >= params.min_flush_size then - let* (st1, _) = + let* (st1, p1) = betree_Node_apply_messages self.left params node_id_cnt msgs_left st in - let* (st2, (n, node_id_cnt0)) = - betree_Node_apply_messages_back'a self.left params node_id_cnt msgs_left - st st1 in - let* (st3, ()) = - betree_Node_apply_messages_back1 self.left params node_id_cnt msgs_left - st st2 in + let (n, node_id_cnt1) = p1 in let* len_right = betree_List_len (u64 & betree_Message_t) msgs_right in if len_right >= params.min_flush_size then - let* (st4, _) = - betree_Node_apply_messages self.right params node_id_cnt0 msgs_right - st3 in - let* (st5, (n0, node_id_cnt1)) = - betree_Node_apply_messages_back'a self.right params node_id_cnt0 - msgs_right st3 st4 in - let* _ = - betree_Node_apply_messages_back1 self.right params node_id_cnt0 - msgs_right st3 st5 in - Return (st0, ({ self with left = n; right = n0 }, node_id_cnt1)) - else Return (st0, ({ self with left = n }, node_id_cnt0)) + let* (st2, p2) = + betree_Node_apply_messages self.right params node_id_cnt1 msgs_right + st1 in + let (n1, node_id_cnt2) = p2 in + Return (st2, (Betree_List_Nil, ({ self with left = n; right = n1 }, + node_id_cnt2))) + else Return (st1, (msgs_right, ({ self with left = n }, node_id_cnt1))) else - let* (st1, _) = + let* (st1, p1) = betree_Node_apply_messages self.right params node_id_cnt msgs_right st in - let* (st2, (n, node_id_cnt0)) = - betree_Node_apply_messages_back'a self.right params node_id_cnt - msgs_right st st1 in - let* _ = - betree_Node_apply_messages_back1 self.right params node_id_cnt msgs_right - st st2 in - Return (st0, ({ self with right = n }, node_id_cnt0)) + let (n, node_id_cnt1) = p1 in + Return (st1, (msgs_left, ({ self with right = n }, node_id_cnt1))) -(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: backward function 1 - Source: 'src/betree.rs', lines 410:4-415:26 *) -and betree_Internal_flush_back1 - (self : betree_Internal_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) - (content : betree_List_t (u64 & betree_Message_t)) (st : state) (st0 : state) - : - Tot (result (state & unit)) - (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* (st2, (_, node_id_cnt0)) = - betree_Node_apply_messages_back'a self.left params node_id_cnt msgs_left - st st1 in - let* (st3, ()) = - betree_Node_apply_messages_back1 self.left params node_id_cnt msgs_left - st st2 in - let* len_right = betree_List_len (u64 & betree_Message_t) msgs_right in - if len_right >= params.min_flush_size - then - let* (st4, _) = - betree_Node_apply_messages self.right params node_id_cnt0 msgs_right - st3 in - let* (st5, (_, _)) = - betree_Node_apply_messages_back'a self.right params node_id_cnt0 - msgs_right st3 st4 in - let* _ = - betree_Node_apply_messages_back1 self.right params node_id_cnt0 - msgs_right st3 st5 in - Return (st0, ()) - else Return (st0, ()) - else - let* (st1, _) = - betree_Node_apply_messages self.right params node_id_cnt msgs_right st in - let* (st2, (_, _)) = - betree_Node_apply_messages_back'a self.right params node_id_cnt - msgs_right st st1 in - let* _ = - betree_Node_apply_messages_back1 self.right params node_id_cnt msgs_right - st st2 in - Return (st0, ()) - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: 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* (st0, content) = betree_load_internal_node node.id st in - let* content0 = betree_Node_apply_messages_to_internal content msgs in - let* num_msgs = betree_List_len (u64 & betree_Message_t) content0 in - if num_msgs >= params.min_flush_size - then - let* (st1, content1) = - betree_Internal_flush node params node_id_cnt content0 st0 in - let* (st2, (node0, _)) = - betree_Internal_flush_back'a node params node_id_cnt content0 st0 st1 - in - let* (st3, _) = betree_store_internal_node node0.id content1 st2 in - Return (st3, ()) - else - let* (st1, _) = betree_store_internal_node node.id content0 st0 in - Return (st1, ()) - | Betree_Node_Leaf node -> - let* (st0, content) = betree_load_leaf_node node.id st in - let* content0 = betree_Node_apply_messages_to_leaf content msgs in - let* len = betree_List_len (u64 & u64) content0 in - let* i = u64_mul 2 params.split_size in - if len >= i - then - let* (st1, _) = betree_Leaf_split node content0 params node_id_cnt st0 in - let* (st2, _) = betree_store_leaf_node node.id Betree_List_Nil st1 in - betree_Leaf_split_back0 node content0 params node_id_cnt st0 st2 - else - let* (st1, _) = betree_store_leaf_node node.id content0 st0 in - Return (st1, ()) - 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'a - (self : betree_Node_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) - (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) (st0 : state) : Tot (result (state & (betree_Node_t & betree_NodeIdCounter_t))) (decreases ( betree_Node_apply_messages_decreases self params node_id_cnt msgs st)) @@ -951,277 +572,111 @@ and betree_Node_apply_messages_back'a begin match self with | Betree_Node_Internal node -> let* (st1, content) = betree_load_internal_node node.id st in - let* content0 = betree_Node_apply_messages_to_internal content msgs in - let* num_msgs = betree_List_len (u64 & betree_Message_t) content0 in - if num_msgs >= params.min_flush_size - then - let* (st2, content1) = - betree_Internal_flush node params node_id_cnt content0 st1 in - let* (st3, (node0, node_id_cnt0)) = - betree_Internal_flush_back'a node params node_id_cnt content0 st1 st2 - in - let* _ = betree_store_internal_node node0.id content1 st3 in - Return (st0, (Betree_Node_Internal node0, node_id_cnt0)) - else - let* _ = betree_store_internal_node node.id content0 st1 in - Return (st0, (Betree_Node_Internal node, node_id_cnt)) - | Betree_Node_Leaf node -> - let* (st1, content) = betree_load_leaf_node node.id st in - let* content0 = betree_Node_apply_messages_to_leaf content msgs in - let* len = betree_List_len (u64 & u64) content0 in - let* i = u64_mul 2 params.split_size in - if len >= i - then - let* (st2, new_node) = - betree_Leaf_split node content0 params node_id_cnt st1 in - let* (st3, _) = betree_store_leaf_node node.id Betree_List_Nil st2 in - let* _ = betree_Leaf_split_back0 node content0 params node_id_cnt st1 st3 - in - let* (st4, node_id_cnt0) = - betree_Leaf_split_back2 node content0 params node_id_cnt st1 st0 in - Return (st4, (Betree_Node_Internal new_node, node_id_cnt0)) - else - let* _ = betree_store_leaf_node node.id content0 st1 in - Return (st0, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: backward function 1 - Source: 'src/betree.rs', lines 588:4-593:5 *) -and betree_Node_apply_messages_back1 - (self : betree_Node_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) - (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) (st0 : 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* content0 = betree_Node_apply_messages_to_internal content msgs in - let* num_msgs = betree_List_len (u64 & betree_Message_t) content0 in + let* l = betree_Node_apply_messages_to_internal content msgs in + let* num_msgs = betree_List_len (u64 & betree_Message_t) l in if num_msgs >= params.min_flush_size then - let* (st2, content1) = - betree_Internal_flush node params node_id_cnt content0 st1 in - let* (st3, (node0, _)) = - betree_Internal_flush_back'a node params node_id_cnt content0 st1 st2 - in - let* _ = betree_store_internal_node node0.id content1 st3 in - betree_Internal_flush_back1 node params node_id_cnt content0 st1 st0 + let* (st2, (content1, p)) = + betree_Internal_flush node params node_id_cnt l st1 in + let (node1, node_id_cnt1) = p in + let* (st3, _) = betree_store_internal_node node1.id content1 st2 in + Return (st3, (Betree_Node_Internal node1, node_id_cnt1)) else - let* _ = betree_store_internal_node node.id content0 st1 in - Return (st0, ()) + let* (st2, _) = betree_store_internal_node node.id l st1 in + Return (st2, (Betree_Node_Internal node, node_id_cnt)) | Betree_Node_Leaf node -> let* (st1, content) = betree_load_leaf_node node.id st in - let* content0 = betree_Node_apply_messages_to_leaf content msgs in - let* len = betree_List_len (u64 & u64) content0 in + let* l = betree_Node_apply_messages_to_leaf content msgs in + let* len = betree_List_len (u64 & u64) l in let* i = u64_mul 2 params.split_size in if len >= i then - let* (st2, _) = betree_Leaf_split node content0 params node_id_cnt st1 in + let* (st2, (new_node, nic)) = + betree_Leaf_split node l params node_id_cnt st1 in let* (st3, _) = betree_store_leaf_node node.id Betree_List_Nil st2 in - let* _ = betree_Leaf_split_back0 node content0 params node_id_cnt st1 st3 - in - betree_Leaf_split_back1 node content0 params node_id_cnt st1 st0 + Return (st3, (Betree_Node_Internal new_node, nic)) else - let* _ = betree_store_leaf_node node.id content0 st1 in Return (st0, ()) + let* (st2, _) = betree_store_leaf_node node.id l st1 in + Return (st2, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) end -(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: forward function +(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: 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 l = Betree_List_Nil in - let* (st0, _) = - betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, - new_msg) l) st in - let* (st1, (_, _)) = - betree_Node_apply_messages_back'a self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st st0 in - betree_Node_apply_messages_back1 self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st 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'a - (self : betree_Node_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) (key : u64) - (new_msg : betree_Message_t) (st : state) (st0 : state) : result (state & (betree_Node_t & betree_NodeIdCounter_t)) = let l = Betree_List_Nil in - let* (st1, _) = + let* (st1, p) = betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, new_msg) l) st in - let* (st2, (self0, node_id_cnt0)) = - betree_Node_apply_messages_back'a self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st st1 in - let* _ = - betree_Node_apply_messages_back1 self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st st2 in - Return (st0, (self0, node_id_cnt0)) + let (self1, node_id_cnt1) = p in + Return (st1, (self1, node_id_cnt1)) -(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: backward function 1 - Source: 'src/betree.rs', lines 576:4-582:5 *) -let betree_Node_apply_back1 - (self : betree_Node_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) (key : u64) - (new_msg : betree_Message_t) (st : state) (st0 : state) : - result (state & unit) - = - let l = Betree_List_Nil in - let* (st1, _) = - betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, - new_msg) l) st in - let* (st2, (_, _)) = - betree_Node_apply_messages_back'a self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st st1 in - let* _ = - betree_Node_apply_messages_back1 self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st st2 in - Return (st0, ()) - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: 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* (st0, _) = betree_store_leaf_node id Betree_List_Nil st in - let* node_id_cnt0 = betree_NodeIdCounter_fresh_id_back node_id_cnt in - Return (st0, + let* (id, nic) = betree_NodeIdCounter_fresh_id node_id_cnt in + let* (st1, _) = betree_store_leaf_node id Betree_List_Nil st in + Return (st1, { params = { min_flush_size = min_flush_size; split_size = split_size }; - node_id_cnt = node_id_cnt0; + node_id_cnt = nic; root = (Betree_Node_Leaf { id = id; size = 0 }) }) -(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: 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* (st0, _) = - betree_Node_apply self.root self.params self.node_id_cnt key msg st in - let* (st1, (_, _)) = - betree_Node_apply_back'a self.root self.params self.node_id_cnt key msg st - st0 in - betree_Node_apply_back1 self.root self.params self.node_id_cnt key msg st 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) - (st0 : state) : result (state & betree_BeTree_t) = - let* (st1, _) = + let* (st1, p) = betree_Node_apply self.root self.params self.node_id_cnt key msg st in - let* (st2, (n, nic)) = - betree_Node_apply_back'a self.root self.params self.node_id_cnt key msg st - st1 in - let* _ = - betree_Node_apply_back1 self.root self.params self.node_id_cnt key msg st - st2 in - Return (st0, { self with node_id_cnt = nic; root = n }) + let (n, nic) = p in + Return (st1, { self with node_id_cnt = nic; root = n }) -(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: 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* (st0, _) = betree_BeTree_apply self key (Betree_Message_Insert value) st - in - let* (st1, _) = - betree_BeTree_apply_back self key (Betree_Message_Insert value) st st0 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) (st0 : state) - : result (state & betree_BeTree_t) = - let* (st1, _) = betree_BeTree_apply self key (Betree_Message_Insert value) st - in - let* (_, self0) = - betree_BeTree_apply_back self key (Betree_Message_Insert value) st st1 in - Return (st0, self0) + betree_BeTree_apply self key (Betree_Message_Insert value) st -(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: 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* (st0, _) = betree_BeTree_apply self key Betree_Message_Delete st in - let* (st1, _) = - betree_BeTree_apply_back self key Betree_Message_Delete st st0 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) (st0 : state) : + (self : betree_BeTree_t) (key : u64) (st : state) : result (state & betree_BeTree_t) = - let* (st1, _) = betree_BeTree_apply self key Betree_Message_Delete st in - let* (_, self0) = - betree_BeTree_apply_back self key Betree_Message_Delete st st1 in - Return (st0, self0) + betree_BeTree_apply self key Betree_Message_Delete st -(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: 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* (st0, _) = betree_BeTree_apply self key (Betree_Message_Upsert upd) st - in - let* (st1, _) = - betree_BeTree_apply_back self key (Betree_Message_Upsert upd) st st0 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) (st0 : state) : result (state & betree_BeTree_t) = - let* (st1, _) = betree_BeTree_apply self key (Betree_Message_Upsert upd) st - in - let* (_, self0) = - betree_BeTree_apply_back self key (Betree_Message_Upsert upd) st st1 in - Return (st0, self0) + betree_BeTree_apply self key (Betree_Message_Upsert upd) st -(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: forward function +(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: 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) (st0 : state) : - result (state & betree_BeTree_t) + result (state & ((option u64) & betree_BeTree_t)) = - let* (st1, n) = betree_Node_lookup_back self.root key st st0 in - Return (st1, { self with root = n }) + let* (st1, (o, n)) = betree_Node_lookup self.root key st in + Return (st1, (o, { self with root = n })) -(** [betree_main::main]: forward function +(** [betree_main::main]: Source: 'src/betree_main.rs', lines 5:0-5:9 *) let main : result unit = Return () diff --git a/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti b/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti index cd2f956f..de9b96fd 100644 --- a/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti +++ b/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti @@ -6,29 +6,29 @@ include BetreeMain.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [betree_main::betree_utils::load_internal_node]: forward function +(** [betree_main::betree_utils::load_internal_node]: Source: 'src/betree_utils.rs', lines 98:0-98:63 *) val betree_utils_load_internal_node : u64 -> state -> result (state & (betree_List_t (u64 & betree_Message_t))) -(** [betree_main::betree_utils::store_internal_node]: forward function +(** [betree_main::betree_utils::store_internal_node]: Source: 'src/betree_utils.rs', lines 115:0-115:71 *) val betree_utils_store_internal_node : u64 -> betree_List_t (u64 & betree_Message_t) -> state -> result (state & unit) -(** [betree_main::betree_utils::load_leaf_node]: forward function +(** [betree_main::betree_utils::load_leaf_node]: Source: 'src/betree_utils.rs', lines 132:0-132:55 *) val betree_utils_load_leaf_node : u64 -> state -> result (state & (betree_List_t (u64 & u64))) -(** [betree_main::betree_utils::store_leaf_node]: forward function +(** [betree_main::betree_utils::store_leaf_node]: Source: 'src/betree_utils.rs', lines 145:0-145:63 *) val betree_utils_store_leaf_node : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit) -(** [core::option::{core::option::Option}::unwrap]: forward function +(** [core::option::{core::option::Option}::unwrap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) val core_option_Option_unwrap (t : Type0) : option t -> state -> result (state & t) diff --git a/tests/fstar/betree_back_stateful/Primitives.fst b/tests/fstar/betree_back_stateful/Primitives.fst index a3ffbde4..fca80829 100644 --- a/tests/fstar/betree_back_stateful/Primitives.fst +++ b/tests/fstar/betree_back_stateful/Primitives.fst @@ -55,8 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a = x -let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -477,8 +476,7 @@ noeq type core_ops_index_Index (self idx : Type0) = { // Trait declaration: [core::ops::index::IndexMut] noeq type core_ops_index_IndexMut (self idx : Type0) = { indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result indexInst.output; - index_mut_back : self → idx → indexInst.output → result self; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); } // Trait declaration [core::ops::deref::Deref] @@ -490,8 +488,7 @@ noeq type core_ops_deref_Deref (self : Type0) = { // Trait declaration [core::ops::deref::DerefMut] noeq type core_ops_deref_DerefMut (self : Type0) = { derefInst : core_ops_deref_Deref self; - deref_mut : self → result derefInst.target; - deref_mut_back : self → derefInst.target → result self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); } type core_ops_range_Range (a : Type0) = { @@ -502,8 +499,8 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = + Return (x, (fun x -> Return x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -515,7 +512,6 @@ let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { derefInst = alloc_boxed_Box_coreopsDerefInst self; deref_mut = alloc_boxed_Box_deref_mut self; - deref_mut_back = alloc_boxed_Box_deref_mut_back self; } (*** Array *) @@ -535,10 +531,18 @@ let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : resu if i < length x then Return (index x i) else Fail Failure -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : + result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure +let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : + result (a & (a -> result (array a n))) = + match array_index_usize a n x i with + | Fail e -> Fail e + | Return v -> + Return (v, array_update_usize a n x i) + (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -552,6 +556,13 @@ let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result ( if i < length x then Return (list_update x i nx) else Fail Failure +let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : + result (a & (a -> result (slice a))) = + match slice_index_usize a s i with + | Fail e -> Fail e + | Return x -> + Return (x, slice_update_usize a s i) + (*** Subslices *) let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x @@ -559,6 +570,10 @@ let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : res if length s = n then Return s else Fail Failure +let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : + result (slice a & (slice a -> result (array a n))) = + Return (x, array_from_slice a n x) + // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() @@ -588,8 +603,13 @@ let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : r let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : + result (a & (a → result (alloc_vec_Vec a))) = + match alloc_vec_Vec_index_usize v i with + | Return x -> + Return (x, alloc_vec_Vec_update_usize v i) + | Fail e -> Fail e + let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : Pure (result (alloc_vec_Vec a)) (requires True) @@ -605,9 +625,6 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : end else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure @@ -619,13 +636,11 @@ noeq type core_slice_index_SliceIndex (self t : Type0) = { sealedInst : core_slice_index_private_slice_index_Sealed self; output : Type0; get : self → t → result (option output); - get_mut : self → t → result (option output); - get_mut_back : self → t → option output → result t; + get_mut : self → t → result (option output & (option output -> result t)); get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); index : self → t → result output; - index_mut : self → t → result output; - index_mut_back : self → t → output → result t; + index_mut : self → t → result (output & (output -> result t)); } // [core::slice::index::[T]::index]: forward function @@ -643,14 +658,8 @@ let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) admit () // TODO // [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_RangeUsize_get_mut_back - (t : Type0) : - core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = admit () // TODO // [core::slice::index::Range::get_unchecked]: forward function @@ -675,27 +684,16 @@ let core_slice_index_RangeUsize_index admit () // TODO // [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_RangeUsize_index_mut_back - (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = admit () // TODO // [core::slice::index::[T]::index_mut]: forward function let core_slice_index_Slice_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result inst.output = + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = admit () // -// [core::slice::index::[T]::index_mut]: backward function 0 -let core_slice_index_Slice_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → inst.output → result (slice t) = - admit () // TODO - // [core::array::[T; N]::index]: forward function let core_array_Array_index (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) @@ -705,13 +703,8 @@ let core_array_Array_index // [core::array::[T; N]::index_mut]: forward function let core_array_Array_index_mut (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : result inst.indexInst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: backward function 0 -let core_array_Array_index_mut_back - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::Range] @@ -725,12 +718,10 @@ let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : output = slice t; get = core_slice_index_RangeUsize_get t; get_mut = core_slice_index_RangeUsize_get_mut t; - get_mut_back = core_slice_index_RangeUsize_get_mut_back t; get_unchecked = core_slice_index_RangeUsize_get_unchecked t; get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; index = core_slice_index_RangeUsize_index t; index_mut = core_slice_index_RangeUsize_index_mut t; - index_mut_back = core_slice_index_RangeUsize_index_mut_back t; } // Trait implementation: [core::slice::index::[T]] @@ -747,7 +738,6 @@ let core_ops_index_IndexMutSliceTIInst (t idx : Type0) core_ops_index_IndexMut (slice t) idx = { indexInst = core_ops_index_IndexSliceTIInst t idx inst; index_mut = core_slice_index_Slice_index_mut t idx inst; - index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; } // Trait implementation: [core::array::[T; N]] @@ -764,7 +754,6 @@ let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) core_ops_index_IndexMut (array t n) idx = { indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; index_mut = core_array_Array_index_mut t idx n inst; - index_mut_back = core_array_Array_index_mut_back t idx n inst; } // [core::slice::index::usize::get]: forward function @@ -773,13 +762,8 @@ let core_slice_index_usize_get admit () // TODO // [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: backward function 0 -let core_slice_index_usize_get_mut_back - (t : Type0) : usize → slice t → option t → result (slice t) = +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = admit () // TODO // [core::slice::index::usize::get_unchecked]: forward function @@ -797,12 +781,8 @@ let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = admit () // TODO // [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: backward function 0 -let core_slice_index_usize_index_mut_back - (t : Type0) : usize → slice t → t → result (slice t) = +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::usize] @@ -816,12 +796,10 @@ let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : output = t; get = core_slice_index_usize_get t; get_mut = core_slice_index_usize_get_mut t; - get_mut_back = core_slice_index_usize_get_mut_back t; get_unchecked = core_slice_index_usize_get_unchecked t; get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; index = core_slice_index_usize_index t; index_mut = core_slice_index_usize_index_mut t; - index_mut_back = core_slice_index_usize_index_mut_back t; } // [alloc::vec::Vec::index]: forward function @@ -831,13 +809,8 @@ let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx // [alloc::vec::Vec::index_mut]: forward function let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: backward function 0 -let alloc_vec_Vec_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = admit () // TODO // Trait implementation: [alloc::vec::Vec] @@ -854,7 +827,6 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) core_ops_index_IndexMut (alloc_vec_Vec t) idx = { indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; index_mut = alloc_vec_Vec_index_mut t idx inst; - index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } (*** Theorems *) @@ -870,15 +842,7 @@ let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : Lemma ( alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) + alloc_vec_Vec_index_mut_usize v i) [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] = admit() - -let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : - Lemma ( - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == - alloc_vec_Vec_update_usize v i x) - [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] - = - admit() diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index e6cd1411..9fc5d8a0 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -7,12 +7,12 @@ include Hashmap.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [hashmap::hash_key]: forward function +(** [hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 *) let hash_key (k : usize) : result usize = Return k -(** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 *) let rec hashMap_allocate_slots_loop (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : @@ -21,12 +21,12 @@ let rec hashMap_allocate_slots_loop = if n > 0 then - let* slots0 = alloc_vec_Vec_push (list_t t) slots List_Nil in - let* n0 = usize_sub n 1 in - hashMap_allocate_slots_loop t slots0 n0 + let* v = alloc_vec_Vec_push (list_t t) slots List_Nil in + let* n1 = usize_sub n 1 in + hashMap_allocate_slots_loop t v n1 else Return slots -(** [hashmap::{hashmap::HashMap}::allocate_slots]: forward function +(** [hashmap::{hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 *) let hashMap_allocate_slots (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : @@ -34,7 +34,7 @@ let hashMap_allocate_slots = hashMap_allocate_slots_loop t slots n -(** [hashmap::{hashmap::HashMap}::new_with_capacity]: forward function +(** [hashmap::{hashmap::HashMap}::new_with_capacity]: Source: 'src/hashmap.rs', lines 59:4-63:13 *) let hashMap_new_with_capacity (t : Type0) (capacity : usize) (max_load_dividend : usize) @@ -44,97 +44,75 @@ let hashMap_new_with_capacity let v = alloc_vec_Vec_new (list_t t) in let* slots = hashMap_allocate_slots t v capacity in let* i = usize_mul capacity max_load_dividend in - let* i0 = usize_div i max_load_divisor in + let* i1 = usize_div i max_load_divisor in Return { num_entries = 0; max_load_factor = (max_load_dividend, max_load_divisor); - max_load = i0; + max_load = i1; slots = slots } -(** [hashmap::{hashmap::HashMap}::new]: forward function +(** [hashmap::{hashmap::HashMap}::new]: Source: 'src/hashmap.rs', lines 75:4-75:24 *) let hashMap_new (t : Type0) : result (hashMap_t t) = hashMap_new_with_capacity t 32 4 5 -(** [hashmap::{hashmap::HashMap}::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::clear]: loop 0: Source: 'src/hashmap.rs', lines 80:4-88:5 *) let rec hashMap_clear_loop (t : Type0) (slots : alloc_vec_Vec (list_t t)) (i : usize) : Tot (result (alloc_vec_Vec (list_t t))) (decreases (hashMap_clear_loop_decreases t slots i)) = - let i0 = alloc_vec_Vec_len (list_t t) slots in - if i < i0 + let i1 = alloc_vec_Vec_len (list_t t) slots in + if i < i1 then - let* i1 = usize_add i 1 in - let* slots0 = - alloc_vec_Vec_index_mut_back (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i - List_Nil in - hashMap_clear_loop t slots0 i1 + let* (_, index_mut_back) = + alloc_vec_Vec_index_mut (list_t t) usize + (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i in + let* i2 = usize_add i 1 in + let* slots1 = index_mut_back List_Nil in + hashMap_clear_loop t slots1 i2 else Return slots -(** [hashmap::{hashmap::HashMap}::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 *) let hashMap_clear (t : Type0) (self : hashMap_t t) : result (hashMap_t t) = - let* v = hashMap_clear_loop t self.slots 0 in - Return { self with num_entries = 0; slots = v } + let* back = hashMap_clear_loop t self.slots 0 in + Return { self with num_entries = 0; slots = back } -(** [hashmap::{hashmap::HashMap}::len]: forward function +(** [hashmap::{hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) let hashMap_len (t : Type0) (self : hashMap_t t) : result usize = Return self.num_entries -(** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 *) let rec hashMap_insert_in_list_loop (t : Type0) (key : usize) (value : t) (ls : list_t t) : - Tot (result bool) + Tot (result (bool & (list_t t))) (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) = begin match ls with | List_Cons ckey cvalue tl -> if ckey = key - then Return false - else hashMap_insert_in_list_loop t key value tl - | List_Nil -> Return true + then Return (false, List_Cons ckey value tl) + else + let* (b, back) = hashMap_insert_in_list_loop t key value tl in + Return (b, List_Cons ckey cvalue back) + | List_Nil -> let l = List_Nil in Return (true, List_Cons key value l) end -(** [hashmap::{hashmap::HashMap}::insert_in_list]: forward function +(** [hashmap::{hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 *) let hashMap_insert_in_list - (t : Type0) (key : usize) (value : t) (ls : list_t t) : result bool = - hashMap_insert_in_list_loop t key value ls - -(** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 97:4-114:5 *) -let rec hashMap_insert_in_list_loop_back (t : Type0) (key : usize) (value : t) (ls : list_t t) : - Tot (result (list_t t)) - (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) + result (bool & (list_t t)) = - begin match ls with - | List_Cons ckey cvalue tl -> - if ckey = key - then Return (List_Cons ckey value tl) - else - let* tl0 = hashMap_insert_in_list_loop_back t key value tl in - Return (List_Cons ckey cvalue tl0) - | List_Nil -> let l = List_Nil in Return (List_Cons key value l) - end - -(** [hashmap::{hashmap::HashMap}::insert_in_list]: backward function 0 - Source: 'src/hashmap.rs', lines 97:4-97:71 *) -let hashMap_insert_in_list_back - (t : Type0) (key : usize) (value : t) (ls : list_t t) : result (list_t t) = - hashMap_insert_in_list_loop_back t key value ls + hashMap_insert_in_list_loop t key value ls -(** [hashmap::{hashmap::HashMap}::insert_no_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::insert_no_resize]: Source: 'src/hashmap.rs', lines 117:4-117:54 *) let hashMap_insert_no_resize (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : @@ -143,30 +121,19 @@ let hashMap_insert_no_resize let* hash = hash_key key in let i = alloc_vec_Vec_len (list_t t) self.slots in let* hash_mod = usize_rem hash i in - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (list_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots hash_mod in - let* inserted = hashMap_insert_in_list t key value l in + let* (inserted, l1) = hashMap_insert_in_list t key value l in if inserted then - let* i0 = usize_add self.num_entries 1 in - let* l0 = hashMap_insert_in_list_back t key value l in - let* v = - alloc_vec_Vec_index_mut_back (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots - hash_mod l0 in - Return { self with num_entries = i0; slots = v } - else - let* l0 = hashMap_insert_in_list_back t key value l in - let* v = - alloc_vec_Vec_index_mut_back (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots - hash_mod l0 in - Return { self with slots = v } - -(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) + let* i1 = usize_add self.num_entries 1 in + let* v = index_mut_back l1 in + Return { self with num_entries = i1; slots = v } + else let* v = index_mut_back l1 in Return { self with slots = v } + +(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 *) let rec hashMap_move_elements_from_list_loop (t : Type0) (ntable : hashMap_t t) (ls : list_t t) : @@ -175,20 +142,18 @@ let rec hashMap_move_elements_from_list_loop = begin match ls with | List_Cons k v tl -> - let* ntable0 = hashMap_insert_no_resize t ntable k v in - hashMap_move_elements_from_list_loop t ntable0 tl + let* hm = hashMap_insert_no_resize t ntable k v in + hashMap_move_elements_from_list_loop t hm tl | List_Nil -> Return ntable end -(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::move_elements_from_list]: Source: 'src/hashmap.rs', lines 183:4-183:72 *) let hashMap_move_elements_from_list (t : Type0) (ntable : hashMap_t t) (ls : list_t t) : result (hashMap_t t) = hashMap_move_elements_from_list_loop t ntable ls -(** [hashmap::{hashmap::HashMap}::move_elements]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::move_elements]: loop 0: Source: 'src/hashmap.rs', lines 171:4-180:5 *) let rec hashMap_move_elements_loop (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) @@ -196,64 +161,63 @@ let rec hashMap_move_elements_loop Tot (result ((hashMap_t t) & (alloc_vec_Vec (list_t t)))) (decreases (hashMap_move_elements_loop_decreases t ntable slots i)) = - let i0 = alloc_vec_Vec_len (list_t t) slots in - if i < i0 + let i1 = alloc_vec_Vec_len (list_t t) slots in + if i < i1 then - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (list_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i in - let ls = core_mem_replace (list_t t) l List_Nil in - let* ntable0 = hashMap_move_elements_from_list t ntable ls in - let* i1 = usize_add i 1 in - let l0 = core_mem_replace_back (list_t t) l List_Nil in - let* slots0 = - alloc_vec_Vec_index_mut_back (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i l0 in - hashMap_move_elements_loop t ntable0 slots0 i1 + let (ls, l1) = core_mem_replace (list_t t) l List_Nil in + let* hm = hashMap_move_elements_from_list t ntable ls in + let* i2 = usize_add i 1 in + let* slots1 = index_mut_back l1 in + let* back_'a = hashMap_move_elements_loop t hm slots1 i2 in + let (hm1, v) = back_'a in + Return (hm1, v) else Return (ntable, slots) -(** [hashmap::{hashmap::HashMap}::move_elements]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 *) let hashMap_move_elements (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) (i : usize) : result ((hashMap_t t) & (alloc_vec_Vec (list_t t))) = - hashMap_move_elements_loop t ntable slots i + let* back_'a = hashMap_move_elements_loop t ntable slots i in + let (hm, v) = back_'a in + Return (hm, v) -(** [hashmap::{hashmap::HashMap}::try_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::try_resize]: Source: 'src/hashmap.rs', lines 140:4-140:28 *) let hashMap_try_resize (t : Type0) (self : hashMap_t t) : result (hashMap_t t) = let* max_usize = scalar_cast U32 Usize core_u32_max in let capacity = alloc_vec_Vec_len (list_t t) self.slots in let* n1 = usize_div max_usize 2 in - let (i, i0) = self.max_load_factor in - let* i1 = usize_div n1 i in - if capacity <= i1 + let (i, i1) = self.max_load_factor in + let* i2 = usize_div n1 i in + if capacity <= i2 then - let* i2 = usize_mul capacity 2 in - let* ntable = hashMap_new_with_capacity t i2 i i0 in - let* (ntable0, _) = hashMap_move_elements t ntable self.slots 0 in + let* i3 = usize_mul capacity 2 in + let* ntable = hashMap_new_with_capacity t i3 i i1 in + let* p = hashMap_move_elements t ntable self.slots 0 in + let (ntable1, _) = p in Return - { ntable0 with num_entries = self.num_entries; max_load_factor = (i, i0) + { ntable1 with num_entries = self.num_entries; max_load_factor = (i, i1) } - else Return { self with max_load_factor = (i, i0) } + else Return { self with max_load_factor = (i, i1) } -(** [hashmap::{hashmap::HashMap}::insert]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap::{hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 *) let hashMap_insert (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : result (hashMap_t t) = - let* self0 = hashMap_insert_no_resize t self key value in - let* i = hashMap_len t self0 in - if i > self0.max_load then hashMap_try_resize t self0 else Return self0 + let* hm = hashMap_insert_no_resize t self key value in + let* i = hashMap_len t hm in + if i > hm.max_load then hashMap_try_resize t hm else Return hm -(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 *) let rec hashMap_contains_key_in_list_loop (t : Type0) (key : usize) (ls : list_t t) : @@ -261,20 +225,20 @@ let rec hashMap_contains_key_in_list_loop (decreases (hashMap_contains_key_in_list_loop_decreases t key ls)) = begin match ls with - | List_Cons ckey x tl -> + | List_Cons ckey _ tl -> if ckey = key then Return true else hashMap_contains_key_in_list_loop t key tl | List_Nil -> Return false end -(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: forward function +(** [hashmap::{hashmap::HashMap}::contains_key_in_list]: Source: 'src/hashmap.rs', lines 206:4-206:68 *) let hashMap_contains_key_in_list (t : Type0) (key : usize) (ls : list_t t) : result bool = hashMap_contains_key_in_list_loop t key ls -(** [hashmap::{hashmap::HashMap}::contains_key]: forward function +(** [hashmap::{hashmap::HashMap}::contains_key]: Source: 'src/hashmap.rs', lines 199:4-199:49 *) let hashMap_contains_key (t : Type0) (self : hashMap_t t) (key : usize) : result bool = @@ -287,7 +251,7 @@ let hashMap_contains_key hash_mod in hashMap_contains_key_in_list t key l -(** [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: Source: 'src/hashmap.rs', lines 224:4-237:5 *) let rec hashMap_get_in_list_loop (t : Type0) (key : usize) (ls : list_t t) : @@ -299,12 +263,12 @@ let rec hashMap_get_in_list_loop | List_Nil -> Fail Failure end -(** [hashmap::{hashmap::HashMap}::get_in_list]: forward function +(** [hashmap::{hashmap::HashMap}::get_in_list]: Source: 'src/hashmap.rs', lines 224:4-224:70 *) let hashMap_get_in_list (t : Type0) (key : usize) (ls : list_t t) : result t = hashMap_get_in_list_loop t key ls -(** [hashmap::{hashmap::HashMap}::get]: forward function +(** [hashmap::{hashmap::HashMap}::get]: Source: 'src/hashmap.rs', lines 239:4-239:55 *) let hashMap_get (t : Type0) (self : hashMap_t t) (key : usize) : result t = let* hash = hash_key key in @@ -316,214 +280,147 @@ let hashMap_get (t : Type0) (self : hashMap_t t) (key : usize) : result t = hash_mod in hashMap_get_in_list t key l -(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: forward function +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: Source: 'src/hashmap.rs', lines 245:4-254:5 *) let rec hashMap_get_mut_in_list_loop (t : Type0) (ls : list_t t) (key : usize) : - Tot (result t) (decreases (hashMap_get_mut_in_list_loop_decreases t ls key)) - = - begin match ls with - | List_Cons ckey cvalue tl -> - if ckey = key then Return cvalue else hashMap_get_mut_in_list_loop t tl key - | List_Nil -> Fail Failure - end - -(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: forward function - Source: 'src/hashmap.rs', lines 245:4-245:86 *) -let hashMap_get_mut_in_list - (t : Type0) (ls : list_t t) (key : usize) : result t = - hashMap_get_mut_in_list_loop t ls key - -(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 245:4-254:5 *) -let rec hashMap_get_mut_in_list_loop_back - (t : Type0) (ls : list_t t) (key : usize) (ret : t) : - Tot (result (list_t t)) + Tot (result (t & (t -> result (list_t t)))) (decreases (hashMap_get_mut_in_list_loop_decreases t ls key)) = begin match ls with | List_Cons ckey cvalue tl -> if ckey = key - then Return (List_Cons ckey ret tl) + then + let back_'a = fun ret -> Return (List_Cons ckey ret tl) in + Return (cvalue, back_'a) else - let* tl0 = hashMap_get_mut_in_list_loop_back t tl key ret in - Return (List_Cons ckey cvalue tl0) + let* (x, back_'a) = hashMap_get_mut_in_list_loop t tl key in + let back_'a1 = + fun ret -> let* tl1 = back_'a ret in Return (List_Cons ckey cvalue tl1) + in + Return (x, back_'a1) | List_Nil -> Fail Failure end -(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: backward function 0 +(** [hashmap::{hashmap::HashMap}::get_mut_in_list]: Source: 'src/hashmap.rs', lines 245:4-245:86 *) -let hashMap_get_mut_in_list_back - (t : Type0) (ls : list_t t) (key : usize) (ret : t) : result (list_t t) = - hashMap_get_mut_in_list_loop_back t ls key ret - -(** [hashmap::{hashmap::HashMap}::get_mut]: forward function - Source: 'src/hashmap.rs', lines 257:4-257:67 *) -let hashMap_get_mut (t : Type0) (self : hashMap_t t) (key : usize) : result t = - let* hash = hash_key key in - let i = alloc_vec_Vec_len (list_t t) self.slots in - let* hash_mod = usize_rem hash i in - let* l = - alloc_vec_Vec_index_mut (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots - hash_mod in - hashMap_get_mut_in_list t l key +let hashMap_get_mut_in_list + (t : Type0) (ls : list_t t) (key : usize) : + result (t & (t -> result (list_t t))) + = + let* (x, back_'a) = hashMap_get_mut_in_list_loop t ls key in + let back_'a1 = fun ret -> back_'a ret in + Return (x, back_'a1) -(** [hashmap::{hashmap::HashMap}::get_mut]: backward function 0 +(** [hashmap::{hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 *) -let hashMap_get_mut_back - (t : Type0) (self : hashMap_t t) (key : usize) (ret : t) : - result (hashMap_t t) +let hashMap_get_mut + (t : Type0) (self : hashMap_t t) (key : usize) : + result (t & (t -> result (hashMap_t t))) = let* hash = hash_key key in let i = alloc_vec_Vec_len (list_t t) self.slots in let* hash_mod = usize_rem hash i in - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (list_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots hash_mod in - let* l0 = hashMap_get_mut_in_list_back t l key ret in - let* v = - alloc_vec_Vec_index_mut_back (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots - hash_mod l0 in - Return { self with slots = v } - -(** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: forward function + let* (x, get_mut_in_list_back) = hashMap_get_mut_in_list t l key in + let back_'a = + fun ret -> + let* l1 = get_mut_in_list_back ret in + let* v = index_mut_back l1 in + Return { self with slots = v } in + Return (x, back_'a) + +(** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 *) let rec hashMap_remove_from_list_loop (t : Type0) (key : usize) (ls : list_t t) : - Tot (result (option t)) + Tot (result ((option t) & (list_t t))) (decreases (hashMap_remove_from_list_loop_decreases t key ls)) = begin match ls with | List_Cons ckey x tl -> if ckey = key then - let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in + let (mv_ls, _) = + core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in begin match mv_ls with - | List_Cons i cvalue tl0 -> Return (Some cvalue) + | List_Cons _ cvalue tl1 -> Return (Some cvalue, tl1) | List_Nil -> Fail Failure end - else hashMap_remove_from_list_loop t key tl - | List_Nil -> Return None + else + let* (o, back) = hashMap_remove_from_list_loop t key tl in + Return (o, List_Cons ckey x back) + | List_Nil -> Return (None, List_Nil) end -(** [hashmap::{hashmap::HashMap}::remove_from_list]: forward function +(** [hashmap::{hashmap::HashMap}::remove_from_list]: Source: 'src/hashmap.rs', lines 265:4-265:69 *) let hashMap_remove_from_list - (t : Type0) (key : usize) (ls : list_t t) : result (option t) = - hashMap_remove_from_list_loop t key ls - -(** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: backward function 1 - Source: 'src/hashmap.rs', lines 265:4-291:5 *) -let rec hashMap_remove_from_list_loop_back (t : Type0) (key : usize) (ls : list_t t) : - Tot (result (list_t t)) - (decreases (hashMap_remove_from_list_loop_decreases t key ls)) + result ((option t) & (list_t t)) = - begin match ls with - | List_Cons ckey x tl -> - if ckey = key - then - let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in - begin match mv_ls with - | List_Cons i cvalue tl0 -> Return tl0 - | List_Nil -> Fail Failure - end - else - let* tl0 = hashMap_remove_from_list_loop_back t key tl in - Return (List_Cons ckey x tl0) - | List_Nil -> Return List_Nil - end - -(** [hashmap::{hashmap::HashMap}::remove_from_list]: backward function 1 - Source: 'src/hashmap.rs', lines 265:4-265:69 *) -let hashMap_remove_from_list_back - (t : Type0) (key : usize) (ls : list_t t) : result (list_t t) = - hashMap_remove_from_list_loop_back t key ls + hashMap_remove_from_list_loop t key ls -(** [hashmap::{hashmap::HashMap}::remove]: forward function +(** [hashmap::{hashmap::HashMap}::remove]: Source: 'src/hashmap.rs', lines 294:4-294:52 *) let hashMap_remove - (t : Type0) (self : hashMap_t t) (key : usize) : result (option t) = - let* hash = hash_key key in - let i = alloc_vec_Vec_len (list_t t) self.slots in - let* hash_mod = usize_rem hash i in - let* l = - alloc_vec_Vec_index_mut (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots - hash_mod in - let* x = hashMap_remove_from_list t key l in - begin match x with - | None -> Return None - | Some x0 -> let* _ = usize_sub self.num_entries 1 in Return (Some x0) - end - -(** [hashmap::{hashmap::HashMap}::remove]: backward function 0 - Source: 'src/hashmap.rs', lines 294:4-294:52 *) -let hashMap_remove_back - (t : Type0) (self : hashMap_t t) (key : usize) : result (hashMap_t t) = + (t : Type0) (self : hashMap_t t) (key : usize) : + result ((option t) & (hashMap_t t)) + = let* hash = hash_key key in let i = alloc_vec_Vec_len (list_t t) self.slots in let* hash_mod = usize_rem hash i in - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (list_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots hash_mod in - let* x = hashMap_remove_from_list t key l in + let* (x, l1) = hashMap_remove_from_list t key l in begin match x with | None -> - let* l0 = hashMap_remove_from_list_back t key l in - let* v = - alloc_vec_Vec_index_mut_back (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots - hash_mod l0 in - Return { self with slots = v } - | Some x0 -> - let* i0 = usize_sub self.num_entries 1 in - let* l0 = hashMap_remove_from_list_back t key l in - let* v = - alloc_vec_Vec_index_mut_back (list_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots - hash_mod l0 in - Return { self with num_entries = i0; slots = v } + let* v = index_mut_back l1 in Return (None, { self with slots = v }) + | Some x1 -> + let* i1 = usize_sub self.num_entries 1 in + let* v = index_mut_back l1 in + Return (Some x1, { self with num_entries = i1; slots = v }) end -(** [hashmap::test1]: forward function +(** [hashmap::test1]: Source: 'src/hashmap.rs', lines 315:0-315:10 *) let test1 : result unit = let* hm = hashMap_new u64 in - let* hm0 = hashMap_insert u64 hm 0 42 in - let* hm1 = hashMap_insert u64 hm0 128 18 in - let* hm2 = hashMap_insert u64 hm1 1024 138 in - let* hm3 = hashMap_insert u64 hm2 1056 256 in - let* i = hashMap_get u64 hm3 128 in + let* hm1 = hashMap_insert u64 hm 0 42 in + let* hm2 = hashMap_insert u64 hm1 128 18 in + let* hm3 = hashMap_insert u64 hm2 1024 138 in + let* hm4 = hashMap_insert u64 hm3 1056 256 in + let* i = hashMap_get u64 hm4 128 in if not (i = 18) then Fail Failure else - let* hm4 = hashMap_get_mut_back u64 hm3 1024 56 in - let* i0 = hashMap_get u64 hm4 1024 in - if not (i0 = 56) + let* (_, get_mut_back) = hashMap_get_mut u64 hm4 1024 in + let* hm5 = get_mut_back 56 in + let* i1 = hashMap_get u64 hm5 1024 in + if not (i1 = 56) then Fail Failure else - let* x = hashMap_remove u64 hm4 1024 in + let* (x, hm6) = hashMap_remove u64 hm5 1024 in begin match x with | None -> Fail Failure - | Some x0 -> - if not (x0 = 56) + | Some x1 -> + if not (x1 = 56) then Fail Failure else - let* hm5 = hashMap_remove_back u64 hm4 1024 in - let* i1 = hashMap_get u64 hm5 0 in - if not (i1 = 42) + let* i2 = hashMap_get u64 hm6 0 in + if not (i2 = 42) then Fail Failure else - let* i2 = hashMap_get u64 hm5 128 in - if not (i2 = 18) + let* i3 = hashMap_get u64 hm6 128 in + if not (i3 = 18) then Fail Failure else - let* i3 = hashMap_get u64 hm5 1056 in - if not (i3 = 256) then Fail Failure else Return () + let* i4 = hashMap_get u64 hm6 1056 in + if not (i4 = 256) then Fail Failure else Return () end diff --git a/tests/fstar/hashmap/Hashmap.Properties.fst b/tests/fstar/hashmap/Hashmap.Properties.fst deleted file mode 100644 index def520f0..00000000 --- a/tests/fstar/hashmap/Hashmap.Properties.fst +++ /dev/null @@ -1,3186 +0,0 @@ -(** Properties about the hashmap *) -module Hashmap.Properties -open Primitives -open FStar.List.Tot -open FStar.Mul -open Hashmap.Types -open Hashmap.Clauses -open Hashmap.Funs - -#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" - -let _align_fsti = () - -/// The proofs: -/// =========== -/// -/// The proof strategy is to do exactly as with Low* proofs (we initially tried to -/// prove more properties in one go, but it was a mistake): -/// - prove that, under some preconditions, the low-level functions translated -/// from Rust refine some higher-level functions -/// - do functional proofs about those high-level functions to prove interesting -/// properties about the hash map operations, and invariant preservation -/// - combine everything -/// -/// The fact that we work in a pure setting allows us to be more modular than when -/// working with effects. For instance we can do a case disjunction (see the proofs -/// for insert, which study the cases where the key is already/not in the hash map -/// in separate proofs - we had initially tried to do them in one step: it is doable -/// but requires some work, and the F* response time quickly becomes annoying while -/// making progress, so we split them). We can also easily prove a refinement lemma, -/// study the model, *then* combine those to also prove that the low-level function -/// preserves the invariants, rather than do everything at once as is usually the -/// case when doing intrinsic proofs with effects (I remember that having to prove -/// invariants in one go *and* a refinement step, even small, can be extremely -/// difficult in Low*). - - -(*** Utilities *) - -/// We need many small helpers and lemmas, mostly about lists (and the ones we list -/// here are not in the standard F* library). - -val index_append_lem (#a : Type0) (ls0 ls1 : list a) (i : nat{i < length ls0 + length ls1}) : - Lemma ( - (i < length ls0 ==> index (ls0 @ ls1) i == index ls0 i) /\ - (i >= length ls0 ==> index (ls0 @ ls1) i == index ls1 (i - length ls0))) - [SMTPat (index (ls0 @ ls1) i)] - -#push-options "--fuel 1" -let rec index_append_lem #a ls0 ls1 i = - match ls0 with - | [] -> () - | x :: ls0' -> - if i = 0 then () - else index_append_lem ls0' ls1 (i-1) -#pop-options - -val index_map_lem (#a #b: Type0) (f : a -> Tot b) (ls : list a) - (i : nat{i < length ls}) : - Lemma ( - index (map f ls) i == f (index ls i)) - [SMTPat (index (map f ls) i)] - -#push-options "--fuel 1" -let rec index_map_lem #a #b f ls i = - match ls with - | [] -> () - | x :: ls' -> - if i = 0 then () - else index_map_lem f ls' (i-1) -#pop-options - -val for_all_append (#a : Type0) (f : a -> Tot bool) (ls0 ls1 : list a) : - Lemma (for_all f (ls0 @ ls1) = (for_all f ls0 && for_all f ls1)) - -#push-options "--fuel 1" -let rec for_all_append #a f ls0 ls1 = - match ls0 with - | [] -> () - | x :: ls0' -> - for_all_append f ls0' ls1 -#pop-options - -/// Filter a list, stopping after we removed one element -val filter_one (#a : Type) (f : a -> bool) (ls : list a) : list a - -let rec filter_one #a f ls = - match ls with - | [] -> [] - | x :: ls' -> if f x then x :: filter_one f ls' else ls' - -val find_append (#a : Type) (f : a -> bool) (ls0 ls1 : list a) : - Lemma ( - find f (ls0 @ ls1) == - begin match find f ls0 with - | Some x -> Some x - | None -> find f ls1 - end) - -#push-options "--fuel 1" -let rec find_append #a f ls0 ls1 = - match ls0 with - | [] -> () - | x :: ls0' -> - if f x then - begin - assert(ls0 @ ls1 == x :: (ls0' @ ls1)); - assert(find f (ls0 @ ls1) == find f (x :: (ls0' @ ls1))); - // Why do I have to do this?! Is it because of subtyping?? - assert( - match find f (ls0 @ ls1) with - | Some x' -> x' == x - | None -> False) - end - else find_append f ls0' ls1 -#pop-options - -val length_flatten_update : - #a:Type - -> ls:list (list a) - -> i:nat{i < length ls} - -> x:list a -> - Lemma ( - // We want this property: - // ``` - // length (flatten (list_update ls i x)) = - // length (flatten ls) - length (index ls i) + length x - // ``` - length (flatten (list_update ls i x)) + length (index ls i) = - length (flatten ls) + length x) - -#push-options "--fuel 1" -let rec length_flatten_update #a ls i x = - match ls with - | x' :: ls' -> - assert(flatten ls == x' @ flatten ls'); // Triggers patterns - assert(length (flatten ls) == length x' + length (flatten ls')); - if i = 0 then - begin - let ls1 = x :: ls' in - assert(list_update ls i x == ls1); - assert(flatten ls1 == x @ flatten ls'); // Triggers patterns - assert(length (flatten ls1) == length x + length (flatten ls')); - () - end - else - begin - length_flatten_update ls' (i-1) x; - let ls1 = x' :: list_update ls' (i-1) x in - assert(flatten ls1 == x' @ flatten (list_update ls' (i-1) x)) // Triggers patterns - end -#pop-options - -val length_flatten_index : - #a:Type - -> ls:list (list a) - -> i:nat{i < length ls} -> - Lemma ( - length (flatten ls) >= length (index ls i)) - -#push-options "--fuel 1" -let rec length_flatten_index #a ls i = - match ls with - | x' :: ls' -> - assert(flatten ls == x' @ flatten ls'); // Triggers patterns - assert(length (flatten ls) == length x' + length (flatten ls')); - if i = 0 then () - else length_flatten_index ls' (i-1) -#pop-options - -val forall_index_equiv_list_for_all - (#a : Type) (pred : a -> Tot bool) (ls : list a) : - Lemma ((forall (i:nat{i < length ls}). pred (index ls i)) <==> for_all pred ls) - -#push-options "--fuel 1" -let rec forall_index_equiv_list_for_all pred ls = - match ls with - | [] -> () - | x :: ls' -> - assert(forall (i:nat{i < length ls'}). index ls' i == index ls (i+1)); - assert(forall (i:nat{0 < i /\ i < length ls}). index ls i == index ls' (i-1)); - assert(index ls 0 == x); - forall_index_equiv_list_for_all pred ls' -#pop-options - -val find_update: - #a:Type - -> f:(a -> Tot bool) - -> ls:list a - -> x:a - -> ls':list a{length ls' == length ls} -#push-options "--fuel 1" -let rec find_update #a f ls x = - match ls with - | [] -> [] - | hd::tl -> - if f hd then x :: tl else hd :: find_update f tl x -#pop-options - -val pairwise_distinct : #a:eqtype -> ls:list a -> Tot bool -let rec pairwise_distinct (#a : eqtype) (ls : list a) : Tot bool = - match ls with - | [] -> true - | x :: ls' -> List.Tot.for_all (fun y -> x <> y) ls' && pairwise_distinct ls' - -val pairwise_rel : #a:Type -> pred:(a -> a -> Tot bool) -> ls:list a -> Tot bool -let rec pairwise_rel #a pred ls = - match ls with - | [] -> true - | x :: ls' -> - for_all (pred x) ls' && pairwise_rel pred ls' - -#push-options "--fuel 1" -let rec flatten_append (#a : Type) (l1 l2: list (list a)) : - Lemma (flatten (l1 @ l2) == flatten l1 @ flatten l2) = - match l1 with - | [] -> () - | x :: l1' -> - flatten_append l1' l2; - append_assoc x (flatten l1') (flatten l2) -#pop-options - -/// We don't use anonymous functions as parameters to other functions, but rather -/// introduce auxiliary functions instead: otherwise we can't reason (because -/// F*'s encoding to the SMT is imprecise for functions) -let fst_is_disctinct (#a : eqtype) (#b : Type0) (p0 : a & b) (p1 : a & b) : Type0 = - fst p0 <> fst p1 - -(*** Lemmas about Primitives *) -/// TODO: move those lemmas - -// TODO: rename to 'insert'? -val list_update_index_dif_lem - (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) - (j : nat{j < length ls}) : - Lemma (requires (j <> i)) - (ensures (index (list_update ls i x) j == index ls j)) - [SMTPat (index (list_update ls i x) j)] - -#push-options "--fuel 1" -let rec list_update_index_dif_lem #a ls i x j = - match ls with - | x' :: ls -> - if i = 0 then () - else if j = 0 then () - else - list_update_index_dif_lem ls (i-1) x (j-1) -#pop-options - -val map_list_update_lem - (#a #b: Type0) (f : a -> Tot b) - (ls : list a) (i : nat{i < length ls}) (x : a) : - Lemma (list_update (map f ls) i (f x) == map f (list_update ls i x)) - [SMTPat (list_update (map f ls) i (f x))] - -#push-options "--fuel 1" -let rec map_list_update_lem #a #b f ls i x = - match ls with - | x' :: ls' -> - if i = 0 then () - else map_list_update_lem f ls' (i-1) x -#pop-options - -(*** Invariants, models *) - -(**** Internals *) -/// The following invariants, models, representation functions... are mostly -/// for the purpose of the proofs. - -let is_pos_usize (n : nat) : Type0 = 0 < n /\ n <= usize_max -type pos_usize = x:usize{x > 0} - -type binding (t : Type0) = key & t - -type slots_t (t : Type0) = alloc_vec_Vec (list_t t) - -/// We represent hash maps as associative lists -type assoc_list (t : Type0) = list (binding t) - -/// Representation function for [list_t] -let rec list_t_v (#t : Type0) (ls : list_t t) : assoc_list t = - match ls with - | List_Nil -> [] - | List_Cons k v tl -> (k,v) :: list_t_v tl - -let list_t_len (#t : Type0) (ls : list_t t) : nat = length (list_t_v ls) -let list_t_index (#t : Type0) (ls : list_t t) (i : nat{i < list_t_len ls}) : binding t = - index (list_t_v ls) i - -type slot_s (t : Type0) = list (binding t) -type slots_s (t : Type0) = list (slot_s t) - -type slot_t (t : Type0) = list_t t -let slot_t_v #t = list_t_v #t - -/// Representation function for the slots. -let slots_t_v (#t : Type0) (slots : slots_t t) : slots_s t = - map slot_t_v slots - -/// Representation function for the slots, seen as an associative list. -let slots_t_al_v (#t : Type0) (slots : slots_t t) : assoc_list t = - flatten (map list_t_v slots) - -/// High-level type for the hash-map, seen as a list of associative lists (one -/// list per slot). This is the representation we use most, internally. Note that -/// we later introduce a [map_s] representation, which is the one used in the -/// lemmas shown to the user. -type hashMap_s t = list (slot_s t) - -// TODO: why not always have the condition on the length? -// 'nes': "non-empty slots" -type hashMap_s_nes (t : Type0) : Type0 = - hm:hashMap_s t{is_pos_usize (length hm)} - -/// Representation function for [hashMap_t] as a list of slots -let hashMap_t_v (#t : Type0) (hm : hashMap_t t) : hashMap_s t = - map list_t_v hm.slots - -/// Representation function for [hashMap_t] as an associative list -let hashMap_t_al_v (#t : Type0) (hm : hashMap_t t) : assoc_list t = - flatten (hashMap_t_v hm) - -// 'nes': "non-empty slots" -type hashMap_t_nes (t : Type0) : Type0 = - hm:hashMap_t t{is_pos_usize (length hm.slots)} - -let hash_key_s (k : key) : hash = - Return?.v (hash_key k) - -let hash_mod_key (k : key) (len : usize{len > 0}) : hash = - (hash_key_s k) % len - -let not_same_key (#t : Type0) (k : key) (b : binding t) : bool = fst b <> k -let same_key (#t : Type0) (k : key) (b : binding t) : bool = fst b = k - -// We take a [nat] instead of a [hash] on purpose -let same_hash_mod_key (#t : Type0) (len : usize{len > 0}) (h : nat) (b : binding t) : bool = - hash_mod_key (fst b) len = h - -let binding_neq (#t : Type0) (b0 b1 : binding t) : bool = fst b0 <> fst b1 - -let hashMap_t_len_s (#t : Type0) (hm : hashMap_t t) : nat = - hm.num_entries - -let assoc_list_find (#t : Type0) (k : key) (slot : assoc_list t) : option t = - match find (same_key k) slot with - | None -> None - | Some (_, v) -> Some v - -let slot_s_find (#t : Type0) (k : key) (slot : list (binding t)) : option t = - assoc_list_find k slot - -let slot_t_find_s (#t : Type0) (k : key) (slot : list_t t) : option t = - slot_s_find k (slot_t_v slot) - -// This is a simpler version of the "find" function, which captures the essence -// of what happens and operates on [hashMap_s]. -let hashMap_s_find - (#t : Type0) (hm : hashMap_s_nes t) - (k : key) : option t = - let i = hash_mod_key k (length hm) in - let slot = index hm i in - slot_s_find k slot - -let hashMap_s_len - (#t : Type0) (hm : hashMap_s t) : - nat = - length (flatten hm) - -// Same as above, but operates on [hashMap_t] -// Note that we don't reuse the above function on purpose: converting to a -// [hashMap_s] then looking up an element is not the same as what we -// wrote below. -let hashMap_t_find_s - (#t : Type0) (hm : hashMap_t t{length hm.slots > 0}) (k : key) : option t = - let slots = hm.slots in - let i = hash_mod_key k (length slots) in - let slot = index slots i in - slot_t_find_s k slot - -/// Invariants for the slots - -let slot_s_inv - (#t : Type0) (len : usize{len > 0}) (i : usize) (slot : list (binding t)) : bool = - // All the bindings are in the proper slot - for_all (same_hash_mod_key len i) slot && - // All the keys are pairwise distinct - pairwise_rel binding_neq slot - -let slot_t_inv (#t : Type0) (len : usize{len > 0}) (i : usize) (slot : list_t t) : bool = - slot_s_inv len i (slot_t_v slot) - -let slots_s_inv (#t : Type0) (slots : slots_s t{length slots <= usize_max}) : Type0 = - forall(i:nat{i < length slots}). - {:pattern index slots i} - slot_s_inv (length slots) i (index slots i) - -// At some point we tried to rewrite this in terms of [slots_s_inv]. However it -// made a lot of proofs fail because those proofs relied on the [index_map_lem] -// pattern. We tried writing others lemmas with patterns (like [slots_s_inv] -// implies [slots_t_inv]) but it didn't succeed, so we keep things as they are. -let slots_t_inv (#t : Type0) (slots : slots_t t{length slots <= usize_max}) : Type0 = - forall(i:nat{i < length slots}). - {:pattern index slots i} - slot_t_inv (length slots) i (index slots i) - -let hashMap_s_inv (#t : Type0) (hm : hashMap_s t) : Type0 = - length hm <= usize_max /\ - length hm > 0 /\ - slots_s_inv hm - -/// Base invariant for the hashmap (the complete invariant can be temporarily -/// broken between the moment we inserted an element and the moment we resize) -let hashMap_t_base_inv (#t : Type0) (hm : hashMap_t t) : Type0 = - let al = hashMap_t_al_v hm in - // [num_entries] correctly tracks the number of entries in the table - // Note that it gives us that the length of the slots array is <= usize_max: - // [> length <= usize_max - // (because hashMap_num_entries has type `usize`) - hm.num_entries = length al /\ - // Slots invariant - slots_t_inv hm.slots /\ - // The capacity must be > 0 (otherwise we can't resize, because we - // multiply the capacity by two!) - length hm.slots > 0 /\ - // Load computation - begin - let capacity = length hm.slots in - let (dividend, divisor) = hm.max_load_factor in - 0 < dividend /\ dividend < divisor /\ - capacity * dividend >= divisor /\ - hm.max_load = (capacity * dividend) / divisor - end - -/// We often need to frame some values -let hashMap_t_same_params (#t : Type0) (hm0 hm1 : hashMap_t t) : Type0 = - length hm0.slots = length hm1.slots /\ - hm0.max_load = hm1.max_load /\ - hm0.max_load_factor = hm1.max_load_factor - -/// The following invariants, etc. are meant to be revealed to the user through -/// the .fsti. - -/// Invariant for the hashmap -let hashMap_t_inv (#t : Type0) (hm : hashMap_t t) : Type0 = - // Base invariant - hashMap_t_base_inv hm /\ - // The hash map is either: not overloaded, or we can't resize it - begin - let (dividend, divisor) = hm.max_load_factor in - hm.num_entries <= hm.max_load - || length hm.slots * 2 * dividend > usize_max - end - -(*** .fsti *) -/// We reveal slightly different version of the above functions to the user - -let len_s (#t : Type0) (hm : hashMap_t t) : nat = hashMap_t_len_s hm - -/// This version doesn't take any precondition (contrary to [hashMap_t_find_s]) -let find_s (#t : Type0) (hm : hashMap_t t) (k : key) : option t = - if length hm.slots = 0 then None - else hashMap_t_find_s hm k - -(*** Overloading *) - -let hashMap_not_overloaded_lem #t hm = () - -(*** allocate_slots *) - -/// Auxiliary lemma -val slots_t_all_nil_inv_lem - (#t : Type0) (slots : alloc_vec_Vec (list_t t){length slots <= usize_max}) : - Lemma (requires (forall (i:nat{i < length slots}). index slots i == List_Nil)) - (ensures (slots_t_inv slots)) - -#push-options "--fuel 1" -let slots_t_all_nil_inv_lem #t slots = () -#pop-options - -val slots_t_al_v_all_nil_is_empty_lem - (#t : Type0) (slots : alloc_vec_Vec (list_t t)) : - Lemma (requires (forall (i:nat{i < length slots}). index slots i == List_Nil)) - (ensures (slots_t_al_v slots == [])) - -#push-options "--fuel 1" -let rec slots_t_al_v_all_nil_is_empty_lem #t slots = - match slots with - | [] -> () - | s :: slots' -> - assert(forall (i:nat{i < length slots'}). index slots' i == index slots (i+1)); - slots_t_al_v_all_nil_is_empty_lem #t slots'; - assert(slots_t_al_v slots == list_t_v s @ slots_t_al_v slots'); - assert(slots_t_al_v slots == list_t_v s); - assert(index slots 0 == List_Nil) -#pop-options - -/// [allocate_slots] -val hashMap_allocate_slots_lem - (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : - Lemma - (requires (length slots + n <= usize_max)) - (ensures ( - match hashMap_allocate_slots t slots n with - | Fail _ -> False - | Return slots' -> - length slots' = length slots + n /\ - // We leave the already allocated slots unchanged - (forall (i:nat{i < length slots}). index slots' i == index slots i) /\ - // We allocate n additional empty slots - (forall (i:nat{length slots <= i /\ i < length slots'}). index slots' i == List_Nil))) - (decreases (hashMap_allocate_slots_loop_decreases t slots n)) - -#push-options "--fuel 1" -let rec hashMap_allocate_slots_lem t slots n = - begin match n with - | 0 -> () - | _ -> - begin match alloc_vec_Vec_push (list_t t) slots List_Nil with - | Fail _ -> () - | Return slots1 -> - begin match usize_sub n 1 with - | Fail _ -> () - | Return i -> - hashMap_allocate_slots_lem t slots1 i; - begin match hashMap_allocate_slots t slots1 i with - | Fail _ -> () - | Return slots2 -> - assert(length slots1 = length slots + 1); - assert(slots1 == slots @ [List_Nil]); // Triggers patterns - assert(index slots1 (length slots) == index [List_Nil] 0); // Triggers patterns - assert(index slots1 (length slots) == List_Nil) - end - end - end - end -#pop-options - -(*** new_with_capacity *) -/// Under proper conditions, [new_with_capacity] doesn't fail and returns an empty hash map. -val hashMap_new_with_capacity_lem - (t : Type0) (capacity : usize) - (max_load_dividend : usize) (max_load_divisor : usize) : - Lemma - (requires ( - 0 < max_load_dividend /\ - max_load_dividend < max_load_divisor /\ - 0 < capacity /\ - capacity * max_load_dividend >= max_load_divisor /\ - capacity * max_load_dividend <= usize_max)) - (ensures ( - match hashMap_new_with_capacity t capacity max_load_dividend max_load_divisor with - | Fail _ -> False - | Return hm -> - // The hash map invariant is satisfied - hashMap_t_inv hm /\ - // The parameters are correct - hm.max_load_factor = (max_load_dividend, max_load_divisor) /\ - hm.max_load = (capacity * max_load_dividend) / max_load_divisor /\ - // The hash map has the specified capacity - we need to reveal this - // otherwise the pre of [hashMap_t_find_s] is not satisfied. - length hm.slots = capacity /\ - // The hash map has 0 values - hashMap_t_len_s hm = 0 /\ - // It contains no bindings - (forall k. hashMap_t_find_s hm k == None) /\ - // We need this low-level property for the invariant - (forall(i:nat{i < length hm.slots}). index hm.slots i == List_Nil))) - -#push-options "--z3rlimit 50 --fuel 1" -let hashMap_new_with_capacity_lem (t : Type0) (capacity : usize) - (max_load_dividend : usize) (max_load_divisor : usize) = - let v = alloc_vec_Vec_new (list_t t) in - assert(length v = 0); - hashMap_allocate_slots_lem t v capacity; - begin match hashMap_allocate_slots t v capacity with - | Fail _ -> assert(False) - | Return v0 -> - begin match usize_mul capacity max_load_dividend with - | Fail _ -> assert(False) - | Return i -> - begin match usize_div i max_load_divisor with - | Fail _ -> assert(False) - | Return i0 -> - let hm = MkhashMap_t 0 (max_load_dividend, max_load_divisor) i0 v0 in - slots_t_all_nil_inv_lem v0; - slots_t_al_v_all_nil_is_empty_lem hm.slots - end - end - end -#pop-options - -(*** new *) - -/// [new] doesn't fail and returns an empty hash map -val hashMap_new_lem_aux (t : Type0) : - Lemma - (ensures ( - match hashMap_new t with - | Fail _ -> False - | Return hm -> - // The hash map invariant is satisfied - hashMap_t_inv hm /\ - // The hash map has 0 values - hashMap_t_len_s hm = 0 /\ - // It contains no bindings - (forall k. hashMap_t_find_s hm k == None))) - -#push-options "--fuel 1" -let hashMap_new_lem_aux t = - hashMap_new_with_capacity_lem t 32 4 5; - match hashMap_new_with_capacity t 32 4 5 with - | Fail _ -> () - | Return hm -> () -#pop-options - -/// The lemma we reveal in the .fsti -let hashMap_new_lem t = hashMap_new_lem_aux t - -(*** clear *) -/// [clear]: the loop doesn't fail and simply clears the slots starting at index i -#push-options "--fuel 1" -let rec hashMap_clear_loop_lem - (t : Type0) (slots : alloc_vec_Vec (list_t t)) (i : usize) : - Lemma - (ensures ( - match hashMap_clear_loop t slots i with - | Fail _ -> False - | Return slots' -> - // The length is preserved - length slots' == length slots /\ - // The slots before i are left unchanged - (forall (j:nat{j < i /\ j < length slots}). index slots' j == index slots j) /\ - // The slots after i are set to List_Nil - (forall (j:nat{i <= j /\ j < length slots}). index slots' j == List_Nil))) - (decreases (hashMap_clear_loop_decreases t slots i)) - = - let i0 = alloc_vec_Vec_len (list_t t) slots in - let b = i < i0 in - if b - then - begin match alloc_vec_Vec_update_usize slots i List_Nil with - | Fail _ -> () - | Return v -> - begin match usize_add i 1 with - | Fail _ -> () - | Return i1 -> - hashMap_clear_loop_lem t v i1; - begin match hashMap_clear_loop t v i1 with - | Fail _ -> () - | Return slots1 -> - assert(length slots1 == length slots); - assert(forall (j:nat{i+1 <= j /\ j < length slots}). index slots1 j == List_Nil); - assert(index slots1 i == List_Nil) - end - end - end - else () -#pop-options - -/// [clear] doesn't fail and turns the hash map into an empty map -val hashMap_clear_lem_aux - (#t : Type0) (self : hashMap_t t) : - Lemma - (requires (hashMap_t_base_inv self)) - (ensures ( - match hashMap_clear t self with - | Fail _ -> False - | Return hm -> - // The hash map invariant is satisfied - hashMap_t_base_inv hm /\ - // We preserved the parameters - hashMap_t_same_params hm self /\ - // The hash map has 0 values - hashMap_t_len_s hm = 0 /\ - // It contains no bindings - (forall k. hashMap_t_find_s hm k == None))) - -// Being lazy: fuel 1 helps a lot... -#push-options "--fuel 1" -let hashMap_clear_lem_aux #t self = - let p = self.max_load_factor in - let i = self.max_load in - let v = self.slots in - hashMap_clear_loop_lem t v 0; - begin match hashMap_clear_loop t v 0 with - | Fail _ -> () - | Return slots1 -> - slots_t_al_v_all_nil_is_empty_lem slots1; - let hm1 = MkhashMap_t 0 p i slots1 in - assert(hashMap_t_base_inv hm1); - assert(hashMap_t_inv hm1) - end -#pop-options - -let hashMap_clear_lem #t self = hashMap_clear_lem_aux #t self - -(*** len *) - -/// [len]: we link it to a non-failing function. -/// Rk.: we might want to make an analysis to not use an error monad to translate -/// functions which statically can't fail. -let hashMap_len_lem #t self = () - - -(*** insert_in_list *) - -(**** insert_in_list'fwd *) - -/// [insert_in_list]: returns true iff the key is not in the list (functional version) -val hashMap_insert_in_list_lem - (t : Type0) (key : usize) (value : t) (ls : list_t t) : - Lemma - (ensures ( - match hashMap_insert_in_list t key value ls with - | Fail _ -> False - | Return b -> - b <==> (slot_t_find_s key ls == None))) - (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) - -#push-options "--fuel 1" -let rec hashMap_insert_in_list_lem t key value ls = - begin match ls with - | List_Cons ckey cvalue ls0 -> - let b = ckey = key in - if b - then () - else - begin - hashMap_insert_in_list_lem t key value ls0; - match hashMap_insert_in_list t key value ls0 with - | Fail _ -> () - | Return b0 -> () - end - | List_Nil -> - assert(list_t_v ls == []); - assert_norm(find (same_key #t key) [] == None) - end -#pop-options - -(**** insert_in_list'back *) - -/// The proofs about [insert_in_list] backward are easier to do in several steps: -/// extrinsic proofs to the rescue! -/// We first prove that [insert_in_list] refines the function we wrote above, then -/// use this function to prove the invariants, etc. - -/// We write a helper which "captures" what [insert_in_list] does. -/// We then reason about this helper to prove the high-level properties we want -/// (functional properties, preservation of invariants, etc.). -let hashMap_insert_in_list_s - (#t : Type0) (key : usize) (value : t) (ls : list (binding t)) : - list (binding t) = - // Check if there is already a binding for the key - match find (same_key key) ls with - | None -> - // No binding: append the binding to the end - ls @ [(key,value)] - | Some _ -> - // There is already a binding: update it - find_update (same_key key) ls (key,value) - -/// [insert_in_list]: if the key is not in the map, appends a new bindings (functional version) -val hashMap_insert_in_list_back_lem_append_s - (t : Type0) (key : usize) (value : t) (ls : list_t t) : - Lemma - (requires ( - slot_t_find_s key ls == None)) - (ensures ( - match hashMap_insert_in_list_back t key value ls with - | Fail _ -> False - | Return ls' -> - list_t_v ls' == list_t_v ls @ [(key,value)])) - (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) - -#push-options "--fuel 1" -let rec hashMap_insert_in_list_back_lem_append_s t key value ls = - begin match ls with - | List_Cons ckey cvalue ls0 -> - let b = ckey = key in - if b - then () - else - begin - hashMap_insert_in_list_back_lem_append_s t key value ls0; - match hashMap_insert_in_list_back t key value ls0 with - | Fail _ -> () - | Return l -> () - end - | List_Nil -> () - end -#pop-options - -/// [insert_in_list]: if the key is in the map, we update the binding (functional version) -val hashMap_insert_in_list_back_lem_update_s - (t : Type0) (key : usize) (value : t) (ls : list_t t) : - Lemma - (requires ( - Some? (find (same_key key) (list_t_v ls)))) - (ensures ( - match hashMap_insert_in_list_back t key value ls with - | Fail _ -> False - | Return ls' -> - list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,value))) - (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) - -#push-options "--fuel 1" -let rec hashMap_insert_in_list_back_lem_update_s t key value ls = - begin match ls with - | List_Cons ckey cvalue ls0 -> - let b = ckey = key in - if b - then () - else - begin - hashMap_insert_in_list_back_lem_update_s t key value ls0; - match hashMap_insert_in_list_back t key value ls0 with - | Fail _ -> () - | Return l -> () - end - | List_Nil -> () - end -#pop-options - -/// Put everything together -val hashMap_insert_in_list_back_lem_s - (t : Type0) (key : usize) (value : t) (ls : list_t t) : - Lemma - (ensures ( - match hashMap_insert_in_list_back t key value ls with - | Fail _ -> False - | Return ls' -> - list_t_v ls' == hashMap_insert_in_list_s key value (list_t_v ls))) - -let hashMap_insert_in_list_back_lem_s t key value ls = - match find (same_key key) (list_t_v ls) with - | None -> hashMap_insert_in_list_back_lem_append_s t key value ls - | Some _ -> hashMap_insert_in_list_back_lem_update_s t key value ls - -(**** Invariants of insert_in_list_s *) - -/// Auxiliary lemmas -/// We work on [hashMap_insert_in_list_s], the "high-level" version of [insert_in_list'back]. -/// -/// Note that in F* we can't have recursive proofs inside of other proofs, contrary -/// to Coq, which makes it a bit cumbersome to prove auxiliary results like the -/// following ones... - -(** Auxiliary lemmas: append case *) - -val slot_t_v_for_all_binding_neq_append_lem - (t : Type0) (key : usize) (value : t) (ls : list (binding t)) (b : binding t) : - Lemma - (requires ( - fst b <> key /\ - for_all (binding_neq b) ls /\ - slot_s_find key ls == None)) - (ensures ( - for_all (binding_neq b) (ls @ [(key,value)]))) - -#push-options "--fuel 1" -let rec slot_t_v_for_all_binding_neq_append_lem t key value ls b = - match ls with - | [] -> () - | (ck, cv) :: cls -> - slot_t_v_for_all_binding_neq_append_lem t key value cls b -#pop-options - -val slot_s_inv_not_find_append_end_inv_lem - (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : - Lemma - (requires ( - slot_s_inv len (hash_mod_key key len) ls /\ - slot_s_find key ls == None)) - (ensures ( - let ls' = ls @ [(key,value)] in - slot_s_inv len (hash_mod_key key len) ls' /\ - (slot_s_find key ls' == Some value) /\ - (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) - -#push-options "--fuel 1" -let rec slot_s_inv_not_find_append_end_inv_lem t len key value ls = - match ls with - | [] -> () - | (ck, cv) :: cls -> - slot_s_inv_not_find_append_end_inv_lem t len key value cls; - let h = hash_mod_key key len in - let ls' = ls @ [(key,value)] in - assert(for_all (same_hash_mod_key len h) ls'); - slot_t_v_for_all_binding_neq_append_lem t key value cls (ck, cv); - assert(pairwise_rel binding_neq ls'); - assert(slot_s_inv len h ls') -#pop-options - -/// [insert_in_list]: if the key is not in the map, appends a new bindings -val hashMap_insert_in_list_s_lem_append - (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : - Lemma - (requires ( - slot_s_inv len (hash_mod_key key len) ls /\ - slot_s_find key ls == None)) - (ensures ( - let ls' = hashMap_insert_in_list_s key value ls in - ls' == ls @ [(key,value)] /\ - // The invariant is preserved - slot_s_inv len (hash_mod_key key len) ls' /\ - // [key] maps to [value] - slot_s_find key ls' == Some value /\ - // The other bindings are preserved - (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) - -let hashMap_insert_in_list_s_lem_append t len key value ls = - slot_s_inv_not_find_append_end_inv_lem t len key value ls - -/// [insert_in_list]: if the key is not in the map, appends a new bindings (quantifiers) -/// Rk.: we don't use this lemma. -/// TODO: remove? -val hashMap_insert_in_list_back_lem_append - (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : - Lemma - (requires ( - slot_t_inv len (hash_mod_key key len) ls /\ - slot_t_find_s key ls == None)) - (ensures ( - match hashMap_insert_in_list_back t key value ls with - | Fail _ -> False - | Return ls' -> - list_t_v ls' == list_t_v ls @ [(key,value)] /\ - // The invariant is preserved - slot_t_inv len (hash_mod_key key len) ls' /\ - // [key] maps to [value] - slot_t_find_s key ls' == Some value /\ - // The other bindings are preserved - (forall k'. k' <> key ==> slot_t_find_s k' ls' == slot_t_find_s k' ls))) - -let hashMap_insert_in_list_back_lem_append t len key value ls = - hashMap_insert_in_list_back_lem_s t key value ls; - hashMap_insert_in_list_s_lem_append t len key value (list_t_v ls) - -(** Auxiliary lemmas: update case *) - -val slot_s_find_update_for_all_binding_neq_append_lem - (t : Type0) (key : usize) (value : t) (ls : list (binding t)) (b : binding t) : - Lemma - (requires ( - fst b <> key /\ - for_all (binding_neq b) ls)) - (ensures ( - let ls' = find_update (same_key key) ls (key, value) in - for_all (binding_neq b) ls')) - -#push-options "--fuel 1" -let rec slot_s_find_update_for_all_binding_neq_append_lem t key value ls b = - match ls with - | [] -> () - | (ck, cv) :: cls -> - slot_s_find_update_for_all_binding_neq_append_lem t key value cls b -#pop-options - -/// Annoying auxiliary lemma we have to prove because there is no way to reason -/// properly about closures. -/// I'm really enjoying my time. -val for_all_binding_neq_value_indep - (#t : Type0) (key : key) (v0 v1 : t) (ls : list (binding t)) : - Lemma (for_all (binding_neq (key,v0)) ls = for_all (binding_neq (key,v1)) ls) - -#push-options "--fuel 1" -let rec for_all_binding_neq_value_indep #t key v0 v1 ls = - match ls with - | [] -> () - | _ :: ls' -> for_all_binding_neq_value_indep #t key v0 v1 ls' -#pop-options - -val slot_s_inv_find_append_end_inv_lem - (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : - Lemma - (requires ( - slot_s_inv len (hash_mod_key key len) ls /\ - Some? (slot_s_find key ls))) - (ensures ( - let ls' = find_update (same_key key) ls (key, value) in - slot_s_inv len (hash_mod_key key len) ls' /\ - (slot_s_find key ls' == Some value) /\ - (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) - -#push-options "--z3rlimit 50 --fuel 1" -let rec slot_s_inv_find_append_end_inv_lem t len key value ls = - match ls with - | [] -> () - | (ck, cv) :: cls -> - let h = hash_mod_key key len in - let ls' = find_update (same_key key) ls (key, value) in - if ck = key then - begin - assert(ls' == (ck,value) :: cls); - assert(for_all (same_hash_mod_key len h) ls'); - // For pairwise_rel: binding_neq (ck, value) is actually independent - // of `value`. Slightly annoying to prove in F*... - assert(for_all (binding_neq (ck,cv)) cls); - for_all_binding_neq_value_indep key cv value cls; - assert(for_all (binding_neq (ck,value)) cls); - assert(pairwise_rel binding_neq ls'); - assert(slot_s_inv len (hash_mod_key key len) ls') - end - else - begin - slot_s_inv_find_append_end_inv_lem t len key value cls; - assert(for_all (same_hash_mod_key len h) ls'); - slot_s_find_update_for_all_binding_neq_append_lem t key value cls (ck, cv); - assert(pairwise_rel binding_neq ls'); - assert(slot_s_inv len h ls') - end -#pop-options - -/// [insert_in_list]: if the key is in the map, update the bindings -val hashMap_insert_in_list_s_lem_update - (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : - Lemma - (requires ( - slot_s_inv len (hash_mod_key key len) ls /\ - Some? (slot_s_find key ls))) - (ensures ( - let ls' = hashMap_insert_in_list_s key value ls in - ls' == find_update (same_key key) ls (key,value) /\ - // The invariant is preserved - slot_s_inv len (hash_mod_key key len) ls' /\ - // [key] maps to [value] - slot_s_find key ls' == Some value /\ - // The other bindings are preserved - (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) - -let hashMap_insert_in_list_s_lem_update t len key value ls = - slot_s_inv_find_append_end_inv_lem t len key value ls - - -/// [insert_in_list]: if the key is in the map, update the bindings -/// TODO: not used: remove? -val hashMap_insert_in_list_back_lem_update - (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : - Lemma - (requires ( - slot_t_inv len (hash_mod_key key len) ls /\ - Some? (slot_t_find_s key ls))) - (ensures ( - match hashMap_insert_in_list_back t key value ls with - | Fail _ -> False - | Return ls' -> - let als = list_t_v ls in - list_t_v ls' == find_update (same_key key) als (key,value) /\ - // The invariant is preserved - slot_t_inv len (hash_mod_key key len) ls' /\ - // [key] maps to [value] - slot_t_find_s key ls' == Some value /\ - // The other bindings are preserved - (forall k'. k' <> key ==> slot_t_find_s k' ls' == slot_t_find_s k' ls))) - -let hashMap_insert_in_list_back_lem_update t len key value ls = - hashMap_insert_in_list_back_lem_s t key value ls; - hashMap_insert_in_list_s_lem_update t len key value (list_t_v ls) - -(** Final lemmas about [insert_in_list] *) - -/// High-level version -val hashMap_insert_in_list_s_lem - (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : - Lemma - (requires ( - slot_s_inv len (hash_mod_key key len) ls)) - (ensures ( - let ls' = hashMap_insert_in_list_s key value ls in - // The invariant is preserved - slot_s_inv len (hash_mod_key key len) ls' /\ - // [key] maps to [value] - slot_s_find key ls' == Some value /\ - // The other bindings are preserved - (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls) /\ - // The length is incremented, iff we inserted a new key - (match slot_s_find key ls with - | None -> length ls' = length ls + 1 - | Some _ -> length ls' = length ls))) - -let hashMap_insert_in_list_s_lem t len key value ls = - match slot_s_find key ls with - | None -> - assert_norm(length [(key,value)] = 1); - hashMap_insert_in_list_s_lem_append t len key value ls - | Some _ -> - hashMap_insert_in_list_s_lem_update t len key value ls - -/// [insert_in_list] -/// TODO: not used: remove? -val hashMap_insert_in_list_back_lem - (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : - Lemma - (requires (slot_t_inv len (hash_mod_key key len) ls)) - (ensures ( - match hashMap_insert_in_list_back t key value ls with - | Fail _ -> False - | Return ls' -> - // The invariant is preserved - slot_t_inv len (hash_mod_key key len) ls' /\ - // [key] maps to [value] - slot_t_find_s key ls' == Some value /\ - // The other bindings are preserved - (forall k'. k' <> key ==> slot_t_find_s k' ls' == slot_t_find_s k' ls) /\ - // The length is incremented, iff we inserted a new key - (match slot_t_find_s key ls with - | None -> - list_t_v ls' == list_t_v ls @ [(key,value)] /\ - list_t_len ls' = list_t_len ls + 1 - | Some _ -> - list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,value) /\ - list_t_len ls' = list_t_len ls))) - (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) - -let hashMap_insert_in_list_back_lem t len key value ls = - hashMap_insert_in_list_back_lem_s t key value ls; - hashMap_insert_in_list_s_lem t len key value (list_t_v ls) - -(*** insert_no_resize *) - -(**** Refinement proof *) -/// Same strategy as for [insert_in_list]: we introduce a high-level version of -/// the function, and reason about it. -/// We work on [hashMap_s] (we use a higher-level view of the hash-map, but -/// not too high). - -/// A high-level version of insert, which doesn't check if the table is saturated -let hashMap_insert_no_fail_s - (#t : Type0) (hm : hashMap_s_nes t) - (key : usize) (value : t) : - hashMap_s t = - let len = length hm in - let i = hash_mod_key key len in - let slot = index hm i in - let slot' = hashMap_insert_in_list_s key value slot in - let hm' = list_update hm i slot' in - hm' - -// TODO: at some point I used hashMap_s_nes and it broke proofs...x -let hashMap_insert_no_resize_s - (#t : Type0) (hm : hashMap_s_nes t) - (key : usize) (value : t) : - result (hashMap_s t) = - // Check if the table is saturated (too many entries, and we need to insert one) - let num_entries = length (flatten hm) in - if None? (hashMap_s_find hm key) && num_entries = usize_max then Fail Failure - else Return (hashMap_insert_no_fail_s hm key value) - -/// Prove that [hashMap_insert_no_resize_s] is refined by -/// [hashMap_insert_no_resize'fwd_back] -val hashMap_insert_no_resize_lem_s - (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : - Lemma - (requires ( - hashMap_t_base_inv self /\ - hashMap_s_len (hashMap_t_v self) = hashMap_t_len_s self)) - (ensures ( - begin - match hashMap_insert_no_resize t self key value, - hashMap_insert_no_resize_s (hashMap_t_v self) key value - with - | Fail _, Fail _ -> True - | Return hm, Return hm_v -> - hashMap_t_base_inv hm /\ - hashMap_t_same_params hm self /\ - hashMap_t_v hm == hm_v /\ - hashMap_s_len hm_v == hashMap_t_len_s hm - | _ -> False - end)) - -let hashMap_insert_no_resize_lem_s t self key value = - begin match hash_key key with - | Fail _ -> () - | Return i -> - let i0 = self.num_entries in - let p = self.max_load_factor in - let i1 = self.max_load in - let v = self.slots in - let i2 = alloc_vec_Vec_len (list_t t) v in - let len = length v in - begin match usize_rem i i2 with - | Fail _ -> () - | Return hash_mod -> - begin match alloc_vec_Vec_index_usize v hash_mod with - | Fail _ -> () - | Return l -> - begin - // Checking that: list_t_v (index ...) == index (hashMap_t_v ...) ... - assert(list_t_v l == index (hashMap_t_v self) hash_mod); - hashMap_insert_in_list_lem t key value l; - match hashMap_insert_in_list t key value l with - | Fail _ -> () - | Return b -> - assert(b = None? (slot_s_find key (list_t_v l))); - hashMap_insert_in_list_back_lem t len key value l; - if b - then - begin match usize_add i0 1 with - | Fail _ -> () - | Return i3 -> - begin - match hashMap_insert_in_list_back t key value l with - | Fail _ -> () - | Return l0 -> - begin match alloc_vec_Vec_update_usize v hash_mod l0 with - | Fail _ -> () - | Return v0 -> - let self_v = hashMap_t_v self in - let hm = MkhashMap_t i3 p i1 v0 in - let hm_v = hashMap_t_v hm in - assert(hm_v == list_update self_v hash_mod (list_t_v l0)); - assert_norm(length [(key,value)] = 1); - assert(length (list_t_v l0) = length (list_t_v l) + 1); - length_flatten_update self_v hash_mod (list_t_v l0); - assert(hashMap_s_len hm_v = hashMap_t_len_s hm) - end - end - end - else - begin - match hashMap_insert_in_list_back t key value l with - | Fail _ -> () - | Return l0 -> - begin match alloc_vec_Vec_update_usize v hash_mod l0 with - | Fail _ -> () - | Return v0 -> - let self_v = hashMap_t_v self in - let hm = MkhashMap_t i0 p i1 v0 in - let hm_v = hashMap_t_v hm in - assert(hm_v == list_update self_v hash_mod (list_t_v l0)); - assert(length (list_t_v l0) = length (list_t_v l)); - length_flatten_update self_v hash_mod (list_t_v l0); - assert(hashMap_s_len hm_v = hashMap_t_len_s hm) - end - end - end - end - end - end - -(**** insert_{no_fail,no_resize}: invariants *) - -let hashMap_s_updated_binding - (#t : Type0) (hm : hashMap_s_nes t) - (key : usize) (opt_value : option t) (hm' : hashMap_s_nes t) : Type0 = - // [key] maps to [value] - hashMap_s_find hm' key == opt_value /\ - // The other bindings are preserved - (forall k'. k' <> key ==> hashMap_s_find hm' k' == hashMap_s_find hm k') - -let insert_post (#t : Type0) (hm : hashMap_s_nes t) - (key : usize) (value : t) (hm' : hashMap_s_nes t) : Type0 = - // The invariant is preserved - hashMap_s_inv hm' /\ - // [key] maps to [value] and the other bindings are preserved - hashMap_s_updated_binding hm key (Some value) hm' /\ - // The length is incremented, iff we inserted a new key - (match hashMap_s_find hm key with - | None -> hashMap_s_len hm' = hashMap_s_len hm + 1 - | Some _ -> hashMap_s_len hm' = hashMap_s_len hm) - -val hashMap_insert_no_fail_s_lem - (#t : Type0) (hm : hashMap_s_nes t) - (key : usize) (value : t) : - Lemma - (requires (hashMap_s_inv hm)) - (ensures ( - let hm' = hashMap_insert_no_fail_s hm key value in - insert_post hm key value hm')) - -let hashMap_insert_no_fail_s_lem #t hm key value = - let len = length hm in - let i = hash_mod_key key len in - let slot = index hm i in - hashMap_insert_in_list_s_lem t len key value slot; - let slot' = hashMap_insert_in_list_s key value slot in - length_flatten_update hm i slot' - -val hashMap_insert_no_resize_s_lem - (#t : Type0) (hm : hashMap_s_nes t) - (key : usize) (value : t) : - Lemma - (requires (hashMap_s_inv hm)) - (ensures ( - match hashMap_insert_no_resize_s hm key value with - | Fail _ -> - // Can fail only if we need to create a new binding in - // an already saturated map - hashMap_s_len hm = usize_max /\ - None? (hashMap_s_find hm key) - | Return hm' -> - insert_post hm key value hm')) - -let hashMap_insert_no_resize_s_lem #t hm key value = - let num_entries = length (flatten hm) in - if None? (hashMap_s_find hm key) && num_entries = usize_max then () - else hashMap_insert_no_fail_s_lem hm key value - - -(**** find after insert *) -/// Lemmas about what happens if we call [find] after an insertion - -val hashMap_insert_no_resize_s_get_same_lem - (#t : Type0) (hm : hashMap_s t) - (key : usize) (value : t) : - Lemma (requires (hashMap_s_inv hm)) - (ensures ( - match hashMap_insert_no_resize_s hm key value with - | Fail _ -> True - | Return hm' -> - hashMap_s_find hm' key == Some value)) - -let hashMap_insert_no_resize_s_get_same_lem #t hm key value = - let num_entries = length (flatten hm) in - if None? (hashMap_s_find hm key) && num_entries = usize_max then () - else - begin - let hm' = Return?.v (hashMap_insert_no_resize_s hm key value) in - let len = length hm in - let i = hash_mod_key key len in - let slot = index hm i in - hashMap_insert_in_list_s_lem t len key value slot - end - -val hashMap_insert_no_resize_s_get_diff_lem - (#t : Type0) (hm : hashMap_s t) - (key : usize) (value : t) (key' : usize{key' <> key}) : - Lemma (requires (hashMap_s_inv hm)) - (ensures ( - match hashMap_insert_no_resize_s hm key value with - | Fail _ -> True - | Return hm' -> - hashMap_s_find hm' key' == hashMap_s_find hm key')) - -let hashMap_insert_no_resize_s_get_diff_lem #t hm key value key' = - let num_entries = length (flatten hm) in - if None? (hashMap_s_find hm key) && num_entries = usize_max then () - else - begin - let hm' = Return?.v (hashMap_insert_no_resize_s hm key value) in - let len = length hm in - let i = hash_mod_key key len in - let slot = index hm i in - hashMap_insert_in_list_s_lem t len key value slot; - let i' = hash_mod_key key' len in - if i <> i' then () - else - begin - () - end - end - - -(*** move_elements_from_list *) - -/// Having a great time here: if we use `result (hashMap_s_res t)` as the -/// return type for [hashMap_move_elements_from_list_s] instead of having this -/// awkward match, the proof of [hashMap_move_elements_lem_refin] fails. -/// I guess it comes from F*'s poor subtyping. -/// Followingly, I'm not taking any chance and using [result_hashMap_s] -/// everywhere. -type result_hashMap_s_nes (t : Type0) : Type0 = - res:result (hashMap_s t) { - match res with - | Fail _ -> True - | Return hm -> is_pos_usize (length hm) - } - -let rec hashMap_move_elements_from_list_s - (#t : Type0) (hm : hashMap_s_nes t) - (ls : slot_s t) : - // Do *NOT* use `result (hashMap_s t)` - Tot (result_hashMap_s_nes t) - (decreases ls) = - match ls with - | [] -> Return hm - | (key, value) :: ls' -> - match hashMap_insert_no_resize_s hm key value with - | Fail e -> Fail e - | Return hm' -> - hashMap_move_elements_from_list_s hm' ls' - -/// Refinement lemma -val hashMap_move_elements_from_list_lem - (t : Type0) (ntable : hashMap_t_nes t) (ls : list_t t) : - Lemma (requires (hashMap_t_base_inv ntable)) - (ensures ( - match hashMap_move_elements_from_list t ntable ls, - hashMap_move_elements_from_list_s (hashMap_t_v ntable) (slot_t_v ls) - with - | Fail _, Fail _ -> True - | Return hm', Return hm_v -> - hashMap_t_base_inv hm' /\ - hashMap_t_v hm' == hm_v /\ - hashMap_t_same_params hm' ntable - | _ -> False)) - (decreases (hashMap_move_elements_from_list_loop_decreases t ntable ls)) - -#push-options "--fuel 1" -let rec hashMap_move_elements_from_list_lem t ntable ls = - begin match ls with - | List_Cons k v tl -> - assert(list_t_v ls == (k, v) :: list_t_v tl); - let ls_v = list_t_v ls in - let (_,_) :: tl_v = ls_v in - hashMap_insert_no_resize_lem_s t ntable k v; - begin match hashMap_insert_no_resize t ntable k v with - | Fail _ -> () - | Return h -> - let h_v = Return?.v (hashMap_insert_no_resize_s (hashMap_t_v ntable) k v) in - assert(hashMap_t_v h == h_v); - hashMap_move_elements_from_list_lem t h tl; - begin match hashMap_move_elements_from_list t h tl with - | Fail _ -> () - | Return h0 -> () - end - end - | List_Nil -> () - end -#pop-options - -(*** move_elements *) - -(**** move_elements: refinement 0 *) -/// The proof for [hashMap_move_elements_lem_refin] broke so many times -/// (while it is supposed to be super simple!) that we decided to add one refinement -/// level, to really do things step by step... -/// Doing this refinement layer made me notice that maybe the problem came from -/// the fact that at some point we have to prove `list_t_v List_Nil == []`: I -/// added the corresponding assert to help Z3 and everything became stable. -/// I finally didn't use this "simple" refinement lemma, but I still keep it here -/// because it allows for easy comparisons with [hashMap_move_elements_s]. - -/// [hashMap_move_elements] refines this function, which is actually almost -/// the same (just a little bit shorter and cleaner, and has a pre). -/// -/// The way I wrote the high-level model is the following: -/// - I copy-pasted the definition of [hashMap_move_elements], wrote the -/// signature which links this new definition to [hashMap_move_elements] and -/// checked that the proof passed -/// - I gradually simplified it, while making sure the proof still passes -#push-options "--fuel 1" -let rec hashMap_move_elements_s_simpl - (t : Type0) (ntable : hashMap_t t) - (slots : alloc_vec_Vec (list_t t)) - (i : usize{i <= length slots /\ length slots <= usize_max}) : - Pure (result ((hashMap_t t) & (alloc_vec_Vec (list_t t)))) - (requires (True)) - (ensures (fun res -> - match res, hashMap_move_elements t ntable slots i with - | Fail _, Fail _ -> True - | Return (ntable1, slots1), Return (ntable2, slots2) -> - ntable1 == ntable2 /\ - slots1 == slots2 - | _ -> False)) - (decreases (hashMap_move_elements_loop_decreases t ntable slots i)) - = - if i < length slots - then - let slot = index slots i in - begin match hashMap_move_elements_from_list t ntable slot with - | Fail e -> Fail e - | Return hm' -> - let slots' = list_update slots i List_Nil in - hashMap_move_elements_s_simpl t hm' slots' (i+1) - end - else Return (ntable, slots) -#pop-options - -(**** move_elements: refinement 1 *) -/// We prove a second refinement lemma: calling [move_elements] refines a function -/// which, for every slot, moves the element out of the slot. This first model is -/// almost exactly the translated function, it just uses `list` instead of `list_t`. - -// Note that we ignore the returned slots (we thus don't return a pair: -// only the new hash map in which we moved the elements from the slots): -// this returned value is not used. -let rec hashMap_move_elements_s - (#t : Type0) (hm : hashMap_s_nes t) - (slots : slots_s t) (i : usize{i <= length slots /\ length slots <= usize_max}) : - Tot (result_hashMap_s_nes t) - (decreases (length slots - i)) = - let len = length slots in - if i < len then - begin - let slot = index slots i in - match hashMap_move_elements_from_list_s hm slot with - | Fail e -> Fail e - | Return hm' -> - let slots' = list_update slots i [] in - hashMap_move_elements_s hm' slots' (i+1) - end - else Return hm - -val hashMap_move_elements_lem_refin - (t : Type0) (ntable : hashMap_t t) - (slots : alloc_vec_Vec (list_t t)) (i : usize{i <= length slots}) : - Lemma - (requires ( - hashMap_t_base_inv ntable)) - (ensures ( - match hashMap_move_elements t ntable slots i, - hashMap_move_elements_s (hashMap_t_v ntable) (slots_t_v slots) i - with - | Fail _, Fail _ -> True // We will prove later that this is not possible - | Return (ntable', _), Return ntable'_v -> - hashMap_t_base_inv ntable' /\ - hashMap_t_v ntable' == ntable'_v /\ - hashMap_t_same_params ntable' ntable - | _ -> False)) - (decreases (length slots - i)) - -#restart-solver -#push-options "--fuel 1" -let rec hashMap_move_elements_lem_refin t ntable slots i = - assert(hashMap_t_base_inv ntable); - let i0 = alloc_vec_Vec_len (list_t t) slots in - let b = i < i0 in - if b - then - begin match alloc_vec_Vec_index_usize slots i with - | Fail _ -> () - | Return l -> - let l0 = core_mem_replace (list_t t) l List_Nil in - assert(l0 == l); - hashMap_move_elements_from_list_lem t ntable l0; - begin match hashMap_move_elements_from_list t ntable l0 with - | Fail _ -> () - | Return h -> - let l1 = core_mem_replace_back (list_t t) l List_Nil in - assert(l1 == List_Nil); - assert(slot_t_v #t List_Nil == []); // THIS IS IMPORTANT - begin match alloc_vec_Vec_update_usize slots i l1 with - | Fail _ -> () - | Return v -> - begin match usize_add i 1 with - | Fail _ -> () - | Return i1 -> - hashMap_move_elements_lem_refin t h v i1; - begin match hashMap_move_elements t h v i1 with - | Fail _ -> - assert(Fail? (hashMap_move_elements t ntable slots i)); - () - | Return (ntable', v0) -> () - end - end - end - end - end - else () -#pop-options - - -(**** move_elements: refinement 2 *) -/// We prove a second refinement lemma: calling [move_elements] refines a function -/// which moves every binding of the hash map seen as *one* associative list -/// (and not a list of lists). - -/// [ntable] is the hash map to which we move the elements -/// [slots] is the current hash map, from which we remove the elements, and seen -/// as a "flat" associative list (and not a list of lists) -/// This is actually exactly [hashMap_move_elements_from_list_s]... -let rec hashMap_move_elements_s_flat - (#t : Type0) (ntable : hashMap_s_nes t) - (slots : assoc_list t) : - Tot (result_hashMap_s_nes t) - (decreases slots) = - match slots with - | [] -> Return ntable - | (k,v) :: slots' -> - match hashMap_insert_no_resize_s ntable k v with - | Fail e -> Fail e - | Return ntable' -> - hashMap_move_elements_s_flat ntable' slots' - -/// The refinment lemmas -/// First, auxiliary helpers. - -/// Flatten a list of lists, starting at index i -val flatten_i : - #a:Type - -> l:list (list a) - -> i:nat{i <= length l} - -> Tot (list a) (decreases (length l - i)) - -let rec flatten_i l i = - if i < length l then - index l i @ flatten_i l (i+1) - else [] - -let _ = assert(let l = [1;2] in l == hd l :: tl l) - -val flatten_i_incr : - #a:Type - -> l:list (list a) - -> i:nat{Cons? l /\ i+1 <= length l} -> - Lemma - (ensures ( - (**) assert_norm(length (hd l :: tl l) == 1 + length (tl l)); - flatten_i l (i+1) == flatten_i (tl l) i)) - (decreases (length l - (i+1))) - -#push-options "--fuel 1" -let rec flatten_i_incr l i = - let x :: tl = l in - if i + 1 < length l then - begin - assert(flatten_i l (i+1) == index l (i+1) @ flatten_i l (i+2)); - flatten_i_incr l (i+1); - assert(flatten_i l (i+2) == flatten_i tl (i+1)); - assert(index l (i+1) == index tl i) - end - else () -#pop-options - -val flatten_0_is_flatten : - #a:Type - -> l:list (list a) -> - Lemma - (ensures (flatten_i l 0 == flatten l)) - -#push-options "--fuel 1" -let rec flatten_0_is_flatten #a l = - match l with - | [] -> () - | x :: l' -> - flatten_i_incr l 0; - flatten_0_is_flatten l' -#pop-options - -/// Auxiliary lemma -val flatten_nil_prefix_as_flatten_i : - #a:Type - -> l:list (list a) - -> i:nat{i <= length l} -> - Lemma (requires (forall (j:nat{j < i}). index l j == [])) - (ensures (flatten l == flatten_i l i)) - -#push-options "--fuel 1" -let rec flatten_nil_prefix_as_flatten_i #a l i = - if i = 0 then flatten_0_is_flatten l - else - begin - let x :: l' = l in - assert(index l 0 == []); - assert(x == []); - assert(flatten l == flatten l'); - flatten_i_incr l (i-1); - assert(flatten_i l i == flatten_i l' (i-1)); - assert(forall (j:nat{j < length l'}). index l' j == index l (j+1)); - flatten_nil_prefix_as_flatten_i l' (i-1); - assert(flatten l' == flatten_i l' (i-1)) - end -#pop-options - -/// The proof is trivial, the functions are the same. -/// Just keeping two definitions to allow changes... -val hashMap_move_elements_from_list_s_as_flat_lem - (#t : Type0) (hm : hashMap_s_nes t) - (ls : slot_s t) : - Lemma - (ensures ( - hashMap_move_elements_from_list_s hm ls == - hashMap_move_elements_s_flat hm ls)) - (decreases ls) - -#push-options "--fuel 1" -let rec hashMap_move_elements_from_list_s_as_flat_lem #t hm ls = - match ls with - | [] -> () - | (key, value) :: ls' -> - match hashMap_insert_no_resize_s hm key value with - | Fail _ -> () - | Return hm' -> - hashMap_move_elements_from_list_s_as_flat_lem hm' ls' -#pop-options - -/// Composition of two calls to [hashMap_move_elements_s_flat] -let hashMap_move_elements_s_flat_comp - (#t : Type0) (hm : hashMap_s_nes t) (slot0 slot1 : slot_s t) : - Tot (result_hashMap_s_nes t) = - match hashMap_move_elements_s_flat hm slot0 with - | Fail e -> Fail e - | Return hm1 -> hashMap_move_elements_s_flat hm1 slot1 - -/// High-level desc: -/// move_elements (move_elements hm slot0) slo1 == move_elements hm (slot0 @ slot1) -val hashMap_move_elements_s_flat_append_lem - (#t : Type0) (hm : hashMap_s_nes t) (slot0 slot1 : slot_s t) : - Lemma - (ensures ( - match hashMap_move_elements_s_flat_comp hm slot0 slot1, - hashMap_move_elements_s_flat hm (slot0 @ slot1) - with - | Fail _, Fail _ -> True - | Return hm1, Return hm2 -> hm1 == hm2 - | _ -> False)) - (decreases (slot0)) - -#push-options "--fuel 1" -let rec hashMap_move_elements_s_flat_append_lem #t hm slot0 slot1 = - match slot0 with - | [] -> () - | (k,v) :: slot0' -> - match hashMap_insert_no_resize_s hm k v with - | Fail _ -> () - | Return hm' -> - hashMap_move_elements_s_flat_append_lem hm' slot0' slot1 -#pop-options - -val flatten_i_same_suffix (#a : Type) (l0 l1 : list (list a)) (i : nat) : - Lemma - (requires ( - i <= length l0 /\ - length l0 = length l1 /\ - (forall (j:nat{i <= j /\ j < length l0}). index l0 j == index l1 j))) - (ensures (flatten_i l0 i == flatten_i l1 i)) - (decreases (length l0 - i)) - -#push-options "--fuel 1" -let rec flatten_i_same_suffix #a l0 l1 i = - if i < length l0 then - flatten_i_same_suffix l0 l1 (i+1) - else () -#pop-options - -/// Refinement lemma: -/// [hashMap_move_elements_s] refines [hashMap_move_elements_s_flat] -/// (actually the functions are equal on all inputs). -val hashMap_move_elements_s_lem_refin_flat - (#t : Type0) (hm : hashMap_s_nes t) - (slots : slots_s t) - (i : nat{i <= length slots /\ length slots <= usize_max}) : - Lemma - (ensures ( - match hashMap_move_elements_s hm slots i, - hashMap_move_elements_s_flat hm (flatten_i slots i) - with - | Fail _, Fail _ -> True - | Return hm, Return hm' -> hm == hm' - | _ -> False)) - (decreases (length slots - i)) - -#push-options "--fuel 1" -let rec hashMap_move_elements_s_lem_refin_flat #t hm slots i = - let len = length slots in - if i < len then - begin - let slot = index slots i in - hashMap_move_elements_from_list_s_as_flat_lem hm slot; - match hashMap_move_elements_from_list_s hm slot with - | Fail _ -> - assert(flatten_i slots i == slot @ flatten_i slots (i+1)); - hashMap_move_elements_s_flat_append_lem hm slot (flatten_i slots (i+1)); - assert(Fail? (hashMap_move_elements_s_flat hm (flatten_i slots i))) - | Return hm' -> - let slots' = list_update slots i [] in - flatten_i_same_suffix slots slots' (i+1); - hashMap_move_elements_s_lem_refin_flat hm' slots' (i+1); - hashMap_move_elements_s_flat_append_lem hm slot (flatten_i slots' (i+1)); - () - end - else () -#pop-options - -let assoc_list_inv (#t : Type0) (al : assoc_list t) : Type0 = - // All the keys are pairwise distinct - pairwise_rel binding_neq al - -let disjoint_hm_al_on_key - (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) (k : key) : Type0 = - match hashMap_s_find hm k, assoc_list_find k al with - | Some _, None - | None, Some _ - | None, None -> True - | Some _, Some _ -> False - -/// Playing a dangerous game here: using forall quantifiers -let disjoint_hm_al (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) : Type0 = - forall (k:key). disjoint_hm_al_on_key hm al k - -let find_in_union_hm_al - (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) (k : key) : - option t = - match hashMap_s_find hm k with - | Some b -> Some b - | None -> assoc_list_find k al - -/// Auxiliary lemma -val for_all_binding_neq_find_lem (#t : Type0) (k : key) (v : t) (al : assoc_list t) : - Lemma (requires (for_all (binding_neq (k,v)) al)) - (ensures (assoc_list_find k al == None)) - -#push-options "--fuel 1" -let rec for_all_binding_neq_find_lem #t k v al = - match al with - | [] -> () - | b :: al' -> for_all_binding_neq_find_lem k v al' -#pop-options - -val hashMap_move_elements_s_flat_lem - (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) : - Lemma - (requires ( - // Invariants - hashMap_s_inv hm /\ - assoc_list_inv al /\ - // The two are disjoint - disjoint_hm_al hm al /\ - // We can add all the elements to the hashmap - hashMap_s_len hm + length al <= usize_max)) - (ensures ( - match hashMap_move_elements_s_flat hm al with - | Fail _ -> False // We can't fail - | Return hm' -> - // The invariant is preserved - hashMap_s_inv hm' /\ - // The new hash map is the union of the two maps - (forall (k:key). hashMap_s_find hm' k == find_in_union_hm_al hm al k) /\ - hashMap_s_len hm' = hashMap_s_len hm + length al)) - (decreases al) - -#restart-solver -#push-options "--z3rlimit 200 --fuel 1" -let rec hashMap_move_elements_s_flat_lem #t hm al = - match al with - | [] -> () - | (k,v) :: al' -> - hashMap_insert_no_resize_s_lem hm k v; - match hashMap_insert_no_resize_s hm k v with - | Fail _ -> () - | Return hm' -> - assert(hashMap_s_inv hm'); - assert(assoc_list_inv al'); - let disjoint_lem (k' : key) : - Lemma (disjoint_hm_al_on_key hm' al' k') - [SMTPat (disjoint_hm_al_on_key hm' al' k')] = - if k' = k then - begin - assert(hashMap_s_find hm' k' == Some v); - for_all_binding_neq_find_lem k v al'; - assert(assoc_list_find k' al' == None) - end - else - begin - assert(hashMap_s_find hm' k' == hashMap_s_find hm k'); - assert(assoc_list_find k' al' == assoc_list_find k' al) - end - in - assert(disjoint_hm_al hm' al'); - assert(hashMap_s_len hm' + length al' <= usize_max); - hashMap_move_elements_s_flat_lem hm' al' -#pop-options - -/// We need to prove that the invariants on the "low-level" representations of -/// the hash map imply the invariants on the "high-level" representations. - -val slots_t_inv_implies_slots_s_inv - (#t : Type0) (slots : slots_t t{length slots <= usize_max}) : - Lemma (requires (slots_t_inv slots)) - (ensures (slots_s_inv (slots_t_v slots))) - -let slots_t_inv_implies_slots_s_inv #t slots = - // Ok, works fine: this lemma was useless. - // Problem is: I can never really predict for sure with F*... - () - -val hashMap_t_base_inv_implies_hashMap_s_inv - (#t : Type0) (hm : hashMap_t t) : - Lemma (requires (hashMap_t_base_inv hm)) - (ensures (hashMap_s_inv (hashMap_t_v hm))) - -let hashMap_t_base_inv_implies_hashMap_s_inv #t hm = () // same as previous - -/// Introducing a "partial" version of the hash map invariant, which operates on -/// a suffix of the hash map. -let partial_hashMap_s_inv - (#t : Type0) (len : usize{len > 0}) (offset : usize) - (hm : hashMap_s t{offset + length hm <= usize_max}) : Type0 = - forall(i:nat{i < length hm}). {:pattern index hm i} slot_s_inv len (offset + i) (index hm i) - -/// Auxiliary lemma. -/// If a binding comes from a slot i, then its key is different from the keys -/// of the bindings in the other slots (because the hashes of the keys are distinct). -val binding_in_previous_slot_implies_neq - (#t : Type0) (len : usize{len > 0}) - (i : usize) (b : binding t) - (offset : usize{i < offset}) - (slots : hashMap_s t{offset + length slots <= usize_max}) : - Lemma - (requires ( - // The binding comes from a slot not in [slots] - hash_mod_key (fst b) len = i /\ - // The slots are the well-formed suffix of a hash map - partial_hashMap_s_inv len offset slots)) - (ensures ( - for_all (binding_neq b) (flatten slots))) - (decreases slots) - -#push-options "--z3rlimit 100 --fuel 1" -let rec binding_in_previous_slot_implies_neq #t len i b offset slots = - match slots with - | [] -> () - | s :: slots' -> - assert(slot_s_inv len offset (index slots 0)); // Triggers patterns - assert(slot_s_inv len offset s); - // Proving TARGET. We use quantifiers. - assert(for_all (same_hash_mod_key len offset) s); - forall_index_equiv_list_for_all (same_hash_mod_key len offset) s; - assert(forall (i:nat{i < length s}). same_hash_mod_key len offset (index s i)); - let aux (i:nat{i < length s}) : - Lemma - (requires (same_hash_mod_key len offset (index s i))) - (ensures (binding_neq b (index s i))) - [SMTPat (index s i)] = () - in - assert(forall (i:nat{i < length s}). binding_neq b (index s i)); - forall_index_equiv_list_for_all (binding_neq b) s; - assert(for_all (binding_neq b) s); // TARGET - // - assert(forall (i:nat{i < length slots'}). index slots' i == index slots (i+1)); // Triggers instantiations - binding_in_previous_slot_implies_neq len i b (offset+1) slots'; - for_all_append (binding_neq b) s (flatten slots') -#pop-options - -val partial_hashMap_s_inv_implies_assoc_list_lem - (#t : Type0) (len : usize{len > 0}) (offset : usize) - (hm : hashMap_s t{offset + length hm <= usize_max}) : - Lemma - (requires ( - partial_hashMap_s_inv len offset hm)) - (ensures (assoc_list_inv (flatten hm))) - (decreases (length hm + length (flatten hm))) - -#push-options "--fuel 1" -let rec partial_hashMap_s_inv_implies_assoc_list_lem #t len offset hm = - match hm with - | [] -> () - | slot :: hm' -> - assert(flatten hm == slot @ flatten hm'); - assert(forall (i:nat{i < length hm'}). index hm' i == index hm (i+1)); // Triggers instantiations - match slot with - | [] -> - assert(flatten hm == flatten hm'); - assert(partial_hashMap_s_inv len (offset+1) hm'); // Triggers instantiations - partial_hashMap_s_inv_implies_assoc_list_lem len (offset+1) hm' - | x :: slot' -> - assert(flatten (slot' :: hm') == slot' @ flatten hm'); - let hm'' = slot' :: hm' in - assert(forall (i:nat{0 < i /\ i < length hm''}). index hm'' i == index hm i); // Triggers instantiations - assert(forall (i:nat{0 < i /\ i < length hm''}). slot_s_inv len (offset + i) (index hm'' i)); - assert(index hm 0 == slot); // Triggers instantiations - assert(slot_s_inv len offset slot); - assert(slot_s_inv len offset slot'); - assert(partial_hashMap_s_inv len offset hm''); - partial_hashMap_s_inv_implies_assoc_list_lem len offset (slot' :: hm'); - // Proving that the key in `x` is different from all the other keys in - // the flattened map - assert(for_all (binding_neq x) slot'); - for_all_append (binding_neq x) slot' (flatten hm'); - assert(partial_hashMap_s_inv len (offset+1) hm'); - binding_in_previous_slot_implies_neq #t len offset x (offset+1) hm'; - assert(for_all (binding_neq x) (flatten hm')); - assert(for_all (binding_neq x) (flatten (slot' :: hm'))) -#pop-options - -val hashMap_s_inv_implies_assoc_list_lem - (#t : Type0) (hm : hashMap_s t) : - Lemma (requires (hashMap_s_inv hm)) - (ensures (assoc_list_inv (flatten hm))) - -let hashMap_s_inv_implies_assoc_list_lem #t hm = - partial_hashMap_s_inv_implies_assoc_list_lem (length hm) 0 hm - -val hashMap_t_base_inv_implies_assoc_list_lem - (#t : Type0) (hm : hashMap_t t): - Lemma (requires (hashMap_t_base_inv hm)) - (ensures (assoc_list_inv (hashMap_t_al_v hm))) - -let hashMap_t_base_inv_implies_assoc_list_lem #t hm = - hashMap_s_inv_implies_assoc_list_lem (hashMap_t_v hm) - -/// For some reason, we can't write the below [forall] directly in the [ensures] -/// clause of the next lemma: it makes Z3 fails even with a huge rlimit. -/// I have no idea what's going on. -let hashMap_is_assoc_list - (#t : Type0) (ntable : hashMap_t t{length ntable.slots > 0}) - (al : assoc_list t) : Type0 = - (forall (k:key). hashMap_t_find_s ntable k == assoc_list_find k al) - -let partial_hashMap_s_find - (#t : Type0) (len : usize{len > 0}) (offset : usize) - (hm : hashMap_s_nes t{offset + length hm = len}) - (k : key{hash_mod_key k len >= offset}) : option t = - let i = hash_mod_key k len in - let slot = index hm (i - offset) in - slot_s_find k slot - -val not_same_hash_key_not_found_in_slot - (#t : Type0) (len : usize{len > 0}) - (k : key) - (i : usize) - (slot : slot_s t) : - Lemma - (requires ( - hash_mod_key k len <> i /\ - slot_s_inv len i slot)) - (ensures (slot_s_find k slot == None)) - -#push-options "--fuel 1" -let rec not_same_hash_key_not_found_in_slot #t len k i slot = - match slot with - | [] -> () - | (k',v) :: slot' -> not_same_hash_key_not_found_in_slot len k i slot' -#pop-options - -/// Small variation of [binding_in_previous_slot_implies_neq]: if the hash of -/// a key links it to a previous slot, it can't be found in the slots after. -val key_in_previous_slot_implies_not_found - (#t : Type0) (len : usize{len > 0}) - (k : key) - (offset : usize) - (slots : hashMap_s t{offset + length slots = len}) : - Lemma - (requires ( - // The binding comes from a slot not in [slots] - hash_mod_key k len < offset /\ - // The slots are the well-formed suffix of a hash map - partial_hashMap_s_inv len offset slots)) - (ensures ( - assoc_list_find k (flatten slots) == None)) - (decreases slots) - -#push-options "--fuel 1" -let rec key_in_previous_slot_implies_not_found #t len k offset slots = - match slots with - | [] -> () - | slot :: slots' -> - find_append (same_key k) slot (flatten slots'); - assert(index slots 0 == slot); // Triggers instantiations - not_same_hash_key_not_found_in_slot #t len k offset slot; - assert(assoc_list_find k slot == None); - assert(forall (i:nat{i < length slots'}). index slots' i == index slots (i+1)); // Triggers instantiations - key_in_previous_slot_implies_not_found len k (offset+1) slots' -#pop-options - -val partial_hashMap_s_is_assoc_list_lem - (#t : Type0) (len : usize{len > 0}) (offset : usize) - (hm : hashMap_s_nes t{offset + length hm = len}) - (k : key{hash_mod_key k len >= offset}) : - Lemma - (requires ( - partial_hashMap_s_inv len offset hm)) - (ensures ( - partial_hashMap_s_find len offset hm k == assoc_list_find k (flatten hm))) - (decreases hm) - -#push-options "--fuel 1" -let rec partial_hashMap_s_is_assoc_list_lem #t len offset hm k = - match hm with - | [] -> () - | slot :: hm' -> - let h = hash_mod_key k len in - let i = h - offset in - if i = 0 then - begin - // We must look in the current slot - assert(partial_hashMap_s_find len offset hm k == slot_s_find k slot); - find_append (same_key k) slot (flatten hm'); - assert(forall (i:nat{i < length hm'}). index hm' i == index hm (i+1)); // Triggers instantiations - key_in_previous_slot_implies_not_found #t len k (offset+1) hm'; - assert( // Of course, writing `== None` doesn't work... - match find (same_key k) (flatten hm') with - | None -> True - | Some _ -> False); - assert( - find (same_key k) (flatten hm) == - begin match find (same_key k) slot with - | Some x -> Some x - | None -> find (same_key k) (flatten hm') - end); - () - end - else - begin - // We must ignore the current slot - assert(partial_hashMap_s_find len offset hm k == - partial_hashMap_s_find len (offset+1) hm' k); - find_append (same_key k) slot (flatten hm'); - assert(index hm 0 == slot); // Triggers instantiations - not_same_hash_key_not_found_in_slot #t len k offset slot; - assert(forall (i:nat{i < length hm'}). index hm' i == index hm (i+1)); // Triggers instantiations - partial_hashMap_s_is_assoc_list_lem #t len (offset+1) hm' k - end -#pop-options - -val hashMap_is_assoc_list_lem (#t : Type0) (hm : hashMap_t t) : - Lemma (requires (hashMap_t_base_inv hm)) - (ensures (hashMap_is_assoc_list hm (hashMap_t_al_v hm))) - -let hashMap_is_assoc_list_lem #t hm = - let aux (k:key) : - Lemma (hashMap_t_find_s hm k == assoc_list_find k (hashMap_t_al_v hm)) - [SMTPat (hashMap_t_find_s hm k)] = - let hm_v = hashMap_t_v hm in - let len = length hm_v in - partial_hashMap_s_is_assoc_list_lem #t len 0 hm_v k - in - () - -/// The final lemma about [move_elements]: calling it on an empty hash table moves -/// all the elements to this empty table. -val hashMap_move_elements_lem - (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) : - Lemma - (requires ( - let al = flatten (slots_t_v slots) in - hashMap_t_base_inv ntable /\ - length al <= usize_max /\ - assoc_list_inv al /\ - // The table is empty - hashMap_t_len_s ntable = 0 /\ - (forall (k:key). hashMap_t_find_s ntable k == None))) - (ensures ( - let al = flatten (slots_t_v slots) in - match hashMap_move_elements t ntable slots 0, - hashMap_move_elements_s_flat (hashMap_t_v ntable) al - with - | Return (ntable', _), Return ntable'_v -> - // The invariant is preserved - hashMap_t_base_inv ntable' /\ - // We preserved the parameters - hashMap_t_same_params ntable' ntable /\ - // The table has the same number of slots - length ntable'.slots = length ntable.slots /\ - // The count is good - hashMap_t_len_s ntable' = length al /\ - // The table can be linked to its model (we need this only to reveal - // "pretty" functional lemmas to the user in the fsti - so that we - // can write lemmas with SMT patterns - this is very F* specific) - hashMap_t_v ntable' == ntable'_v /\ - // The new table contains exactly all the bindings from the slots - // Rk.: see the comment for [hashMap_is_assoc_list] - hashMap_is_assoc_list ntable' al - | _ -> False // We can only succeed - )) - -// Weird, dirty things happen below. -// Manually unfolding some postconditions allowed to make the proof pass, -// and also revealed the reason why some proofs failed with "Unknown assertion -// failed" (resulting in the call to [flatten_0_is_flatten] for instance). -// I think manually unfolding the postconditions allowed to account for the -// lack of ifuel (this kind of proofs is annoying, really). -#restart-solver -#push-options "--z3rlimit 100" -let hashMap_move_elements_lem t ntable slots = - let ntable_v = hashMap_t_v ntable in - let slots_v = slots_t_v slots in - let al = flatten slots_v in - hashMap_move_elements_lem_refin t ntable slots 0; - begin - match hashMap_move_elements t ntable slots 0, - hashMap_move_elements_s ntable_v slots_v 0 - with - | Fail _, Fail _ -> () - | Return (ntable', _), Return ntable'_v -> - assert(hashMap_t_base_inv ntable'); - assert(hashMap_t_v ntable' == ntable'_v) - | _ -> assert(False) - end; - hashMap_move_elements_s_lem_refin_flat ntable_v slots_v 0; - begin - match hashMap_move_elements_s ntable_v slots_v 0, - hashMap_move_elements_s_flat ntable_v (flatten_i slots_v 0) - with - | Fail _, Fail _ -> () - | Return hm, Return hm' -> assert(hm == hm') - | _ -> assert(False) - end; - flatten_0_is_flatten slots_v; // flatten_i slots_v 0 == flatten slots_v - hashMap_move_elements_s_flat_lem ntable_v al; - match hashMap_move_elements t ntable slots 0, - hashMap_move_elements_s_flat ntable_v al - with - | Return (ntable', _), Return ntable'_v -> - assert(hashMap_t_base_inv ntable'); - assert(length ntable'.slots = length ntable.slots); - assert(hashMap_t_len_s ntable' = length al); - assert(hashMap_t_v ntable' == ntable'_v); - assert(hashMap_is_assoc_list ntable' al) - | _ -> assert(False) -#pop-options - -(*** try_resize *) - -/// High-level model 1. -/// This is one is slightly "crude": we just simplify a bit the function. - -let hashMap_try_resize_s_simpl - (#t : Type0) - (hm : hashMap_t t) : - Pure (result (hashMap_t t)) - (requires ( - let (divid, divis) = hm.max_load_factor in - divid > 0 /\ divis > 0)) - (ensures (fun _ -> True)) = - let capacity = length hm.slots in - let (divid, divis) = hm.max_load_factor in - if capacity <= (usize_max / 2) / divid then - let ncapacity : usize = capacity * 2 in - begin match hashMap_new_with_capacity t ncapacity divid divis with - | Fail e -> Fail e - | Return ntable -> - match hashMap_move_elements t ntable hm.slots 0 with - | Fail e -> Fail e - | Return (ntable', _) -> - let hm = - { hm with slots = ntable'.slots; - max_load = ntable'.max_load } - in - Return hm - end - else Return hm - -val hashMap_try_resize_lem_refin - (t : Type0) (self : hashMap_t t) : - Lemma - (requires ( - let (divid, divis) = self.max_load_factor in - divid > 0 /\ divis > 0)) - (ensures ( - match hashMap_try_resize t self, - hashMap_try_resize_s_simpl self - with - | Fail _, Fail _ -> True - | Return hm1, Return hm2 -> hm1 == hm2 - | _ -> False)) - -let hashMap_try_resize_lem_refin t self = () - -/// Isolating arithmetic proofs - -let gt_lem0 (n m q : nat) : - Lemma (requires (m > 0 /\ n > q)) - (ensures (n * m > q * m)) = () - -let ge_lem0 (n m q : nat) : - Lemma (requires (m > 0 /\ n >= q)) - (ensures (n * m >= q * m)) = () - -let gt_ge_trans (n m p : nat) : - Lemma (requires (n > m /\ m >= p)) (ensures (n > p)) = () - -let ge_trans (n m p : nat) : - Lemma (requires (n >= m /\ m >= p)) (ensures (n >= p)) = () - -#push-options "--z3rlimit 200" -let gt_lem1 (n m q : nat) : - Lemma (requires (m > 0 /\ n > q / m)) (ensures (n * m > q)) = - assert(n >= q / m + 1); - ge_lem0 n m (q / m + 1); - assert(n * m >= (q / m) * m + m) -#pop-options - -let gt_lem2 (n m p q : nat) : - Lemma (requires (m > 0 /\ p > 0 /\ n > (q / m) / p)) (ensures (n * m * p > q)) = - gt_lem1 n p (q / m); - assert(n * p > q / m); - gt_lem1 (n * p) m q - -let ge_lem1 (n m q : nat) : - Lemma (requires (n >= m /\ q > 0)) - (ensures (n / q >= m / q)) = - FStar.Math.Lemmas.lemma_div_le m n q - -#restart-solver -#push-options "--z3rlimit 200" -let times_divid_lem (n m p : pos) : Lemma ((n * m) / p >= n * (m / p)) - = - FStar.Math.Lemmas.multiply_fractions m p; - assert(m >= (m / p) * p); - assert(n * m >= n * (m / p) * p); // - ge_lem1 (n * m) (n * (m / p) * p) p; - assert((n * m) / p >= (n * (m / p) * p) / p); - assert(n * (m / p) * p = (n * (m / p)) * p); - FStar.Math.Lemmas.cancel_mul_div (n * (m / p)) p; - assert(((n * (m / p)) * p) / p = n * (m / p)) -#pop-options - -/// The good old arithmetic proofs and their unstability... -/// At some point I thought it was stable because it worked with `--quake 100`. -/// Of course, it broke the next time I checked the file... -/// It seems things are ok when we check this proof on its own, but not when -/// it is sent at the same time as the one above (though we put #restart-solver!). -/// I also tried `--quake 1/100` to no avail: it seems that when Z3 decides to -/// fail the first one, it fails them all. I inserted #restart-solver before -/// the previous lemma to see if it had an effect (of course not). -val new_max_load_lem - (len : usize) (capacity : usize{capacity > 0}) - (divid : usize{divid > 0}) (divis : usize{divis > 0}) : - Lemma - (requires ( - let max_load = (capacity * divid) / divis in - let ncapacity = 2 * capacity in - let nmax_load = (ncapacity * divid) / divis in - capacity > 0 /\ 0 < divid /\ divid < divis /\ - capacity * divid >= divis /\ - len = max_load + 1)) - (ensures ( - let max_load = (capacity * divid) / divis in - let ncapacity = 2 * capacity in - let nmax_load = (ncapacity * divid) / divis in - len <= nmax_load)) - -let mul_assoc (a b c : nat) : Lemma (a * b * c == a * (b * c)) = () - -let ge_lem2 (a b c d : nat) : Lemma (requires (a >= b + c /\ c >= d)) (ensures (a >= b + d)) = () -let ge_div_lem1 (a b : nat) : Lemma (requires (a >= b /\ b > 0)) (ensures (a / b >= 1)) = () - -#restart-solver -#push-options "--z3rlimit 100 --z3cliopt smt.arith.nl=false" -let new_max_load_lem len capacity divid divis = - FStar.Math.Lemmas.paren_mul_left 2 capacity divid; - mul_assoc 2 capacity divid; - // The following assertion often breaks though it is given by the above - // lemma. I really don't know what to do (I deactivated non-linear - // arithmetic and added the previous lemma call, moved the assertion up, - // boosted the rlimit...). - assert(2 * capacity * divid == 2 * (capacity * divid)); - let max_load = (capacity * divid) / divis in - let ncapacity = 2 * capacity in - let nmax_load = (ncapacity * divid) / divis in - assert(nmax_load = (2 * capacity * divid) / divis); - times_divid_lem 2 (capacity * divid) divis; - assert((2 * (capacity * divid)) / divis >= 2 * ((capacity * divid) / divis)); - assert(nmax_load >= 2 * ((capacity * divid) / divis)); - assert(nmax_load >= 2 * max_load); - assert(nmax_load >= max_load + max_load); - ge_div_lem1 (capacity * divid) divis; - ge_lem2 nmax_load max_load max_load 1; - assert(nmax_load >= max_load + 1) -#pop-options - -val hashMap_try_resize_s_simpl_lem (#t : Type0) (hm : hashMap_t t) : - Lemma - (requires ( - // The base invariant is satisfied - hashMap_t_base_inv hm /\ - // However, the "full" invariant is broken, as we call [try_resize] - // only if the current number of entries is > the max load. - // - // There are two situations: - // - either we just reached the max load - // - or we were already saturated and can't resize - (let (dividend, divisor) = hm.max_load_factor in - hm.num_entries == hm.max_load + 1 \/ - length hm.slots * 2 * dividend > usize_max) - )) - (ensures ( - match hashMap_try_resize_s_simpl hm with - | Fail _ -> False - | Return hm' -> - // The full invariant is now satisfied (the full invariant is "base - // invariant" + the map is not overloaded (or can't be resized because - // already too big) - hashMap_t_inv hm' /\ - // It contains the same bindings as the initial map - (forall (k:key). hashMap_t_find_s hm' k == hashMap_t_find_s hm k))) - -#restart-solver -#push-options "--z3rlimit 400" -let hashMap_try_resize_s_simpl_lem #t hm = - let capacity = length hm.slots in - let (divid, divis) = hm.max_load_factor in - if capacity <= (usize_max / 2) / divid then - begin - let ncapacity : usize = capacity * 2 in - assert(ncapacity * divid <= usize_max); - assert(hashMap_t_len_s hm = hm.max_load + 1); - new_max_load_lem (hashMap_t_len_s hm) capacity divid divis; - hashMap_new_with_capacity_lem t ncapacity divid divis; - match hashMap_new_with_capacity t ncapacity divid divis with - | Fail _ -> () - | Return ntable -> - let slots = hm.slots in - let al = flatten (slots_t_v slots) in - // Proving that: length al = hm.num_entries - assert(al == flatten (map slot_t_v slots)); - assert(al == flatten (map list_t_v slots)); - assert(hashMap_t_al_v hm == flatten (hashMap_t_v hm)); - assert(hashMap_t_al_v hm == flatten (map list_t_v hm.slots)); - assert(al == hashMap_t_al_v hm); - assert(hashMap_t_base_inv ntable); - assert(length al = hm.num_entries); - assert(length al <= usize_max); - hashMap_t_base_inv_implies_assoc_list_lem hm; - assert(assoc_list_inv al); - assert(hashMap_t_len_s ntable = 0); - assert(forall (k:key). hashMap_t_find_s ntable k == None); - hashMap_move_elements_lem t ntable hm.slots; - match hashMap_move_elements t ntable hm.slots 0 with - | Fail _ -> () - | Return (ntable', _) -> - hashMap_is_assoc_list_lem hm; - assert(hashMap_is_assoc_list hm (hashMap_t_al_v hm)); - let hm' = - { hm with slots = ntable'.slots; - max_load = ntable'.max_load } - in - assert(hashMap_t_base_inv ntable'); - assert(hashMap_t_base_inv hm'); - assert(hashMap_t_len_s hm' = hashMap_t_len_s hm); - new_max_load_lem (hashMap_t_len_s hm') capacity divid divis; - assert(hashMap_t_len_s hm' <= hm'.max_load); // Requires a lemma - assert(hashMap_t_inv hm') - end - else - begin - gt_lem2 capacity 2 divid usize_max; - assert(capacity * 2 * divid > usize_max) - end -#pop-options - -let hashMap_t_same_bindings (#t : Type0) (hm hm' : hashMap_t_nes t) : Type0 = - forall (k:key). hashMap_t_find_s hm k == hashMap_t_find_s hm' k - -/// The final lemma about [try_resize] -val hashMap_try_resize_lem (#t : Type0) (hm : hashMap_t t) : - Lemma - (requires ( - hashMap_t_base_inv hm /\ - // However, the "full" invariant is broken, as we call [try_resize] - // only if the current number of entries is > the max load. - // - // There are two situations: - // - either we just reached the max load - // - or we were already saturated and can't resize - (let (dividend, divisor) = hm.max_load_factor in - hm.num_entries == hm.max_load + 1 \/ - length hm.slots * 2 * dividend > usize_max))) - (ensures ( - match hashMap_try_resize t hm with - | Fail _ -> False - | Return hm' -> - // The full invariant is now satisfied (the full invariant is "base - // invariant" + the map is not overloaded (or can't be resized because - // already too big) - hashMap_t_inv hm' /\ - // The length is the same - hashMap_t_len_s hm' = hashMap_t_len_s hm /\ - // It contains the same bindings as the initial map - hashMap_t_same_bindings hm' hm)) - -let hashMap_try_resize_lem #t hm = - hashMap_try_resize_lem_refin t hm; - hashMap_try_resize_s_simpl_lem hm - -(*** insert *) - -/// The high-level model (very close to the original function: we don't need something -/// very high level, just to clean it a bit) -let hashMap_insert_s - (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : - result (hashMap_t t) = - match hashMap_insert_no_resize t self key value with - | Fail e -> Fail e - | Return hm' -> - if hashMap_t_len_s hm' > hm'.max_load then - hashMap_try_resize t hm' - else Return hm' - -val hashMap_insert_lem_refin - (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : - Lemma (requires True) - (ensures ( - match hashMap_insert t self key value, - hashMap_insert_s self key value - with - | Fail _, Fail _ -> True - | Return hm1, Return hm2 -> hm1 == hm2 - | _ -> False)) - -let hashMap_insert_lem_refin t self key value = () - -/// Helper -let hashMap_insert_bindings_lem - (t : Type0) (self : hashMap_t_nes t) (key : usize) (value : t) - (hm' hm'' : hashMap_t_nes t) : - Lemma - (requires ( - hashMap_s_updated_binding (hashMap_t_v self) key - (Some value) (hashMap_t_v hm') /\ - hashMap_t_same_bindings hm' hm'')) - (ensures ( - hashMap_s_updated_binding (hashMap_t_v self) key - (Some value) (hashMap_t_v hm''))) - = () - -val hashMap_insert_lem_aux - (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : - Lemma (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_insert t self key value with - | Fail _ -> - // We can fail only if: - // - the key is not in the map and we need to add it - // - we are already saturated - hashMap_t_len_s self = usize_max /\ - None? (hashMap_t_find_s self key) - | Return hm' -> - // The invariant is preserved - hashMap_t_inv hm' /\ - // [key] maps to [value] and the other bindings are preserved - hashMap_s_updated_binding (hashMap_t_v self) key (Some value) (hashMap_t_v hm') /\ - // The length is incremented, iff we inserted a new key - (match hashMap_t_find_s self key with - | None -> hashMap_t_len_s hm' = hashMap_t_len_s self + 1 - | Some _ -> hashMap_t_len_s hm' = hashMap_t_len_s self))) - -#restart-solver -#push-options "--z3rlimit 200" -let hashMap_insert_lem_aux #t self key value = - hashMap_insert_no_resize_lem_s t self key value; - hashMap_insert_no_resize_s_lem (hashMap_t_v self) key value; - match hashMap_insert_no_resize t self key value with - | Fail _ -> () - | Return hm' -> - // Expanding the post of [hashMap_insert_no_resize_lem_s] - let self_v = hashMap_t_v self in - let hm'_v = Return?.v (hashMap_insert_no_resize_s self_v key value) in - assert(hashMap_t_base_inv hm'); - assert(hashMap_t_same_params hm' self); - assert(hashMap_t_v hm' == hm'_v); - assert(hashMap_s_len hm'_v == hashMap_t_len_s hm'); - // Expanding the post of [hashMap_insert_no_resize_s_lem] - assert(insert_post self_v key value hm'_v); - // Expanding [insert_post] - assert(hashMap_s_inv hm'_v); - assert( - match hashMap_s_find self_v key with - | None -> hashMap_s_len hm'_v = hashMap_s_len self_v + 1 - | Some _ -> hashMap_s_len hm'_v = hashMap_s_len self_v); - if hashMap_t_len_s hm' > hm'.max_load then - begin - hashMap_try_resize_lem hm'; - // Expanding the post of [hashMap_try_resize_lem] - let hm'' = Return?.v (hashMap_try_resize t hm') in - assert(hashMap_t_inv hm''); - let hm''_v = hashMap_t_v hm'' in - assert(forall k. hashMap_t_find_s hm'' k == hashMap_t_find_s hm' k); - assert(hashMap_t_len_s hm'' = hashMap_t_len_s hm'); // TODO - // Proving the post - assert(hashMap_t_inv hm''); - hashMap_insert_bindings_lem t self key value hm' hm''; - assert( - match hashMap_t_find_s self key with - | None -> hashMap_t_len_s hm'' = hashMap_t_len_s self + 1 - | Some _ -> hashMap_t_len_s hm'' = hashMap_t_len_s self) - end - else () -#pop-options - -let hashMap_insert_lem #t self key value = - hashMap_insert_lem_aux #t self key value - -(*** contains_key *) - -(**** contains_key_in_list *) - -val hashMap_contains_key_in_list_lem - (#t : Type0) (key : usize) (ls : list_t t) : - Lemma - (ensures ( - match hashMap_contains_key_in_list t key ls with - | Fail _ -> False - | Return b -> - b = Some? (slot_t_find_s key ls))) - - -#push-options "--fuel 1" -let rec hashMap_contains_key_in_list_lem #t key ls = - match ls with - | List_Cons ckey x ls0 -> - let b = ckey = key in - if b - then () - else - begin - hashMap_contains_key_in_list_lem key ls0; - match hashMap_contains_key_in_list t key ls0 with - | Fail _ -> () - | Return b0 -> () - end - | List_Nil -> () -#pop-options - -(**** contains_key *) - -val hashMap_contains_key_lem_aux - (#t : Type0) (self : hashMap_t_nes t) (key : usize) : - Lemma - (ensures ( - match hashMap_contains_key t self key with - | Fail _ -> False - | Return b -> b = Some? (hashMap_t_find_s self key))) - -let hashMap_contains_key_lem_aux #t self key = - begin match hash_key key with - | Fail _ -> () - | Return i -> - let v = self.slots in - let i0 = alloc_vec_Vec_len (list_t t) v in - begin match usize_rem i i0 with - | Fail _ -> () - | Return hash_mod -> - begin match alloc_vec_Vec_index_usize v hash_mod with - | Fail _ -> () - | Return l -> - hashMap_contains_key_in_list_lem key l; - begin match hashMap_contains_key_in_list t key l with - | Fail _ -> () - | Return b -> () - end - end - end - end - -/// The lemma in the .fsti -let hashMap_contains_key_lem #t self key = - hashMap_contains_key_lem_aux #t self key - -(*** get *) - -(**** get_in_list *) - -val hashMap_get_in_list_lem - (#t : Type0) (key : usize) (ls : list_t t) : - Lemma - (ensures ( - match hashMap_get_in_list t key ls, slot_t_find_s key ls with - | Fail _, None -> True - | Return x, Some x' -> x == x' - | _ -> False)) - -#push-options "--fuel 1" -let rec hashMap_get_in_list_lem #t key ls = - begin match ls with - | List_Cons ckey cvalue ls0 -> - let b = ckey = key in - if b - then () - else - begin - hashMap_get_in_list_lem key ls0; - match hashMap_get_in_list t key ls0 with - | Fail _ -> () - | Return x -> () - end - | List_Nil -> () - end -#pop-options - -(**** get *) - -val hashMap_get_lem_aux - (#t : Type0) (self : hashMap_t_nes t) (key : usize) : - Lemma - (ensures ( - match hashMap_get t self key, hashMap_t_find_s self key with - | Fail _, None -> True - | Return x, Some x' -> x == x' - | _ -> False)) - -let hashMap_get_lem_aux #t self key = - begin match hash_key key with - | Fail _ -> () - | Return i -> - let v = self.slots in - let i0 = alloc_vec_Vec_len (list_t t) v in - begin match usize_rem i i0 with - | Fail _ -> () - | Return hash_mod -> - begin match alloc_vec_Vec_index_usize v hash_mod with - | Fail _ -> () - | Return l -> - begin - hashMap_get_in_list_lem key l; - match hashMap_get_in_list t key l with - | Fail _ -> () - | Return x -> () - end - end - end - end - -/// .fsti -let hashMap_get_lem #t self key = hashMap_get_lem_aux #t self key - -(*** get_mut'fwd *) - - -(**** get_mut_in_list'fwd *) - -val hashMap_get_mut_in_list_loop_lem - (#t : Type0) (ls : list_t t) (key : usize) : - Lemma - (ensures ( - match hashMap_get_mut_in_list_loop t ls key, slot_t_find_s key ls with - | Fail _, None -> True - | Return x, Some x' -> x == x' - | _ -> False)) - -#push-options "--fuel 1" -let rec hashMap_get_mut_in_list_loop_lem #t ls key = - begin match ls with - | List_Cons ckey cvalue ls0 -> - let b = ckey = key in - if b - then () - else - begin - hashMap_get_mut_in_list_loop_lem ls0 key; - match hashMap_get_mut_in_list_loop t ls0 key with - | Fail _ -> () - | Return x -> () - end - | List_Nil -> () - end -#pop-options - -(**** get_mut'fwd *) - -val hashMap_get_mut_lem_aux - (#t : Type0) (self : hashMap_t_nes t) (key : usize) : - Lemma - (ensures ( - match hashMap_get_mut t self key, hashMap_t_find_s self key with - | Fail _, None -> True - | Return x, Some x' -> x == x' - | _ -> False)) - -let hashMap_get_mut_lem_aux #t self key = - begin match hash_key key with - | Fail _ -> () - | Return i -> - let v = self.slots in - let i0 = alloc_vec_Vec_len (list_t t) v in - begin match usize_rem i i0 with - | Fail _ -> () - | Return hash_mod -> - begin match alloc_vec_Vec_index_usize v hash_mod with - | Fail _ -> () - | Return l -> - begin - hashMap_get_mut_in_list_loop_lem l key; - match hashMap_get_mut_in_list_loop t l key with - | Fail _ -> () - | Return x -> () - end - end - end - end - -let hashMap_get_mut_lem #t self key = - hashMap_get_mut_lem_aux #t self key - -(*** get_mut'back *) - -(**** get_mut_in_list'back *) - -val hashMap_get_mut_in_list_loop_back_lem - (#t : Type0) (ls : list_t t) (key : usize) (ret : t) : - Lemma - (requires (Some? (slot_t_find_s key ls))) - (ensures ( - match hashMap_get_mut_in_list_loop_back t ls key ret with - | Fail _ -> False - | Return ls' -> list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,ret) - | _ -> False)) - -#push-options "--fuel 1" -let rec hashMap_get_mut_in_list_loop_back_lem #t ls key ret = - begin match ls with - | List_Cons ckey cvalue ls0 -> - let b = ckey = key in - if b - then let ls1 = List_Cons ckey ret ls0 in () - else - begin - hashMap_get_mut_in_list_loop_back_lem ls0 key ret; - match hashMap_get_mut_in_list_loop_back t ls0 key ret with - | Fail _ -> () - | Return l -> let ls1 = List_Cons ckey cvalue l in () - end - | List_Nil -> () - end -#pop-options - -(**** get_mut'back *) - -/// Refinement lemma -val hashMap_get_mut_back_lem_refin - (#t : Type0) (self : hashMap_t t{length self.slots > 0}) - (key : usize) (ret : t) : - Lemma - (requires (Some? (hashMap_t_find_s self key))) - (ensures ( - match hashMap_get_mut_back t self key ret with - | Fail _ -> False - | Return hm' -> - hashMap_t_v hm' == hashMap_insert_no_fail_s (hashMap_t_v self) key ret)) - -let hashMap_get_mut_back_lem_refin #t self key ret = - begin match hash_key key with - | Fail _ -> () - | Return i -> - let i0 = self.num_entries in - let p = self.max_load_factor in - let i1 = self.max_load in - let v = self.slots in - let i2 = alloc_vec_Vec_len (list_t t) v in - begin match usize_rem i i2 with - | Fail _ -> () - | Return hash_mod -> - begin match alloc_vec_Vec_index_usize v hash_mod with - | Fail _ -> () - | Return l -> - begin - hashMap_get_mut_in_list_loop_back_lem l key ret; - match hashMap_get_mut_in_list_loop_back t l key ret with - | Fail _ -> () - | Return l0 -> - begin match alloc_vec_Vec_update_usize v hash_mod l0 with - | Fail _ -> () - | Return v0 -> let self0 = MkhashMap_t i0 p i1 v0 in () - end - end - end - end - end - -/// Final lemma -val hashMap_get_mut_back_lem_aux - (#t : Type0) (hm : hashMap_t t) - (key : usize) (ret : t) : - Lemma - (requires ( - hashMap_t_inv hm /\ - Some? (hashMap_t_find_s hm key))) - (ensures ( - match hashMap_get_mut_back t hm key ret with - | Fail _ -> False - | Return hm' -> - // Functional spec - hashMap_t_v hm' == hashMap_insert_no_fail_s (hashMap_t_v hm) key ret /\ - // The invariant is preserved - hashMap_t_inv hm' /\ - // The length is preserved - hashMap_t_len_s hm' = hashMap_t_len_s hm /\ - // [key] maps to [value] - hashMap_t_find_s hm' key == Some ret /\ - // The other bindings are preserved - (forall k'. k' <> key ==> hashMap_t_find_s hm' k' == hashMap_t_find_s hm k'))) - -let hashMap_get_mut_back_lem_aux #t hm key ret = - let hm_v = hashMap_t_v hm in - hashMap_get_mut_back_lem_refin hm key ret; - match hashMap_get_mut_back t hm key ret with - | Fail _ -> assert(False) - | Return hm' -> - hashMap_insert_no_fail_s_lem hm_v key ret - -/// .fsti -let hashMap_get_mut_back_lem #t hm key ret = hashMap_get_mut_back_lem_aux hm key ret - -(*** remove'fwd *) - -val hashMap_remove_from_list_lem - (#t : Type0) (key : usize) (ls : list_t t) : - Lemma - (ensures ( - match hashMap_remove_from_list t key ls with - | Fail _ -> False - | Return opt_x -> - opt_x == slot_t_find_s key ls /\ - (Some? opt_x ==> length (slot_t_v ls) > 0))) - -#push-options "--fuel 1" -let rec hashMap_remove_from_list_lem #t key ls = - begin match ls with - | List_Cons ckey x tl -> - let b = ckey = key in - if b - then - let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in - begin match mv_ls with - | List_Cons i cvalue tl0 -> () - | List_Nil -> () - end - else - begin - hashMap_remove_from_list_lem key tl; - match hashMap_remove_from_list t key tl with - | Fail _ -> () - | Return opt -> () - end - | List_Nil -> () - end -#pop-options - -val hashMap_remove_lem_aux - (#t : Type0) (self : hashMap_t t) (key : usize) : - Lemma - (requires ( - // We need the invariant to prove that upon decrementing the entries counter, - // the counter doesn't become negative - hashMap_t_inv self)) - (ensures ( - match hashMap_remove t self key with - | Fail _ -> False - | Return opt_x -> opt_x == hashMap_t_find_s self key)) - -let hashMap_remove_lem_aux #t self key = - begin match hash_key key with - | Fail _ -> () - | Return i -> - let i0 = self.num_entries in - let v = self.slots in - let i1 = alloc_vec_Vec_len (list_t t) v in - begin match usize_rem i i1 with - | Fail _ -> () - | Return hash_mod -> - begin match alloc_vec_Vec_index_usize v hash_mod with - | Fail _ -> () - | Return l -> - begin - hashMap_remove_from_list_lem key l; - match hashMap_remove_from_list t key l with - | Fail _ -> () - | Return x -> - begin match x with - | None -> () - | Some x0 -> - begin - assert(l == index v hash_mod); - assert(length (list_t_v #t l) > 0); - length_flatten_index (hashMap_t_v self) hash_mod; - match usize_sub i0 1 with - | Fail _ -> () - | Return _ -> () - end - end - end - end - end - end - -/// .fsti -let hashMap_remove_lem #t self key = hashMap_remove_lem_aux #t self key - -(*** remove'back *) - -(**** Refinement proofs *) - -/// High-level model for [remove_from_list'back] -let hashMap_remove_from_list_s - (#t : Type0) (key : usize) (ls : slot_s t) : - slot_s t = - filter_one (not_same_key key) ls - -/// Refinement lemma -val hashMap_remove_from_list_back_lem_refin - (#t : Type0) (key : usize) (ls : list_t t) : - Lemma - (ensures ( - match hashMap_remove_from_list_back t key ls with - | Fail _ -> False - | Return ls' -> - list_t_v ls' == hashMap_remove_from_list_s key (list_t_v ls) /\ - // The length is decremented, iff the key was in the slot - (let len = length (list_t_v ls) in - let len' = length (list_t_v ls') in - match slot_s_find key (list_t_v ls) with - | None -> len = len' - | Some _ -> len = len' + 1))) - -#push-options "--fuel 1" -let rec hashMap_remove_from_list_back_lem_refin #t key ls = - begin match ls with - | List_Cons ckey x tl -> - let b = ckey = key in - if b - then - let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in - begin match mv_ls with - | List_Cons i cvalue tl0 -> () - | List_Nil -> () - end - else - begin - hashMap_remove_from_list_back_lem_refin key tl; - match hashMap_remove_from_list_back t key tl with - | Fail _ -> () - | Return l -> let ls0 = List_Cons ckey x l in () - end - | List_Nil -> () - end -#pop-options - -/// High-level model for [remove_from_list'back] -let hashMap_remove_s - (#t : Type0) (self : hashMap_s_nes t) (key : usize) : - hashMap_s t = - let len = length self in - let hash = hash_mod_key key len in - let slot = index self hash in - let slot' = hashMap_remove_from_list_s key slot in - list_update self hash slot' - -/// Refinement lemma -val hashMap_remove_back_lem_refin - (#t : Type0) (self : hashMap_t_nes t) (key : usize) : - Lemma - (requires ( - // We need the invariant to prove that upon decrementing the entries counter, - // the counter doesn't become negative - hashMap_t_inv self)) - (ensures ( - match hashMap_remove_back t self key with - | Fail _ -> False - | Return hm' -> - hashMap_t_same_params hm' self /\ - hashMap_t_v hm' == hashMap_remove_s (hashMap_t_v self) key /\ - // The length is decremented iff the key was in the map - (let len = hashMap_t_len_s self in - let len' = hashMap_t_len_s hm' in - match hashMap_t_find_s self key with - | None -> len = len' - | Some _ -> len = len' + 1))) - -let hashMap_remove_back_lem_refin #t self key = - begin match hash_key key with - | Fail _ -> () - | Return i -> - let i0 = self.num_entries in - let p = self.max_load_factor in - let i1 = self.max_load in - let v = self.slots in - let i2 = alloc_vec_Vec_len (list_t t) v in - begin match usize_rem i i2 with - | Fail _ -> () - | Return hash_mod -> - begin match alloc_vec_Vec_index_usize v hash_mod with - | Fail _ -> () - | Return l -> - begin - hashMap_remove_from_list_lem key l; - match hashMap_remove_from_list t key l with - | Fail _ -> () - | Return x -> - begin match x with - | None -> - begin - hashMap_remove_from_list_back_lem_refin key l; - match hashMap_remove_from_list_back t key l with - | Fail _ -> () - | Return l0 -> - begin - length_flatten_update (slots_t_v v) hash_mod (list_t_v l0); - match alloc_vec_Vec_update_usize v hash_mod l0 with - | Fail _ -> () - | Return v0 -> () - end - end - | Some x0 -> - begin - assert(l == index v hash_mod); - assert(length (list_t_v #t l) > 0); - length_flatten_index (hashMap_t_v self) hash_mod; - match usize_sub i0 1 with - | Fail _ -> () - | Return i3 -> - begin - hashMap_remove_from_list_back_lem_refin key l; - match hashMap_remove_from_list_back t key l with - | Fail _ -> () - | Return l0 -> - begin - length_flatten_update (slots_t_v v) hash_mod (list_t_v l0); - match alloc_vec_Vec_update_usize v hash_mod l0 with - | Fail _ -> () - | Return v0 -> () - end - end - end - end - end - end - end - end - -(**** Invariants, high-level properties *) - -val hashMap_remove_from_list_s_lem - (#t : Type0) (k : usize) (slot : slot_s t) (len : usize{len > 0}) (i : usize) : - Lemma - (requires (slot_s_inv len i slot)) - (ensures ( - let slot' = hashMap_remove_from_list_s k slot in - slot_s_inv len i slot' /\ - slot_s_find k slot' == None /\ - (forall (k':key{k' <> k}). slot_s_find k' slot' == slot_s_find k' slot) /\ - // This postcondition is necessary to prove that the invariant is preserved - // in the recursive calls. This allows us to do the proof in one go. - (forall (b:binding t). for_all (binding_neq b) slot ==> for_all (binding_neq b) slot') - )) - -#push-options "--fuel 1" -let rec hashMap_remove_from_list_s_lem #t key slot len i = - match slot with - | [] -> () - | (k',v) :: slot' -> - if k' <> key then - begin - hashMap_remove_from_list_s_lem key slot' len i; - let slot'' = hashMap_remove_from_list_s key slot' in - assert(for_all (same_hash_mod_key len i) ((k',v)::slot'')); - assert(for_all (binding_neq (k',v)) slot'); // Triggers instanciation - assert(for_all (binding_neq (k',v)) slot'') - end - else - begin - assert(for_all (binding_neq (k',v)) slot'); - for_all_binding_neq_find_lem key v slot' - end -#pop-options - -val hashMap_remove_s_lem - (#t : Type0) (self : hashMap_s_nes t) (key : usize) : - Lemma - (requires (hashMap_s_inv self)) - (ensures ( - let hm' = hashMap_remove_s self key in - // The invariant is preserved - hashMap_s_inv hm' /\ - // We updated the binding - hashMap_s_updated_binding self key None hm')) - -let hashMap_remove_s_lem #t self key = - let len = length self in - let hash = hash_mod_key key len in - let slot = index self hash in - hashMap_remove_from_list_s_lem key slot len hash; - let slot' = hashMap_remove_from_list_s key slot in - let hm' = list_update self hash slot' in - assert(hashMap_s_inv self) - -/// Final lemma about [remove'back] -val hashMap_remove_back_lem_aux - (#t : Type0) (self : hashMap_t t) (key : usize) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_remove_back t self key with - | Fail _ -> False - | Return hm' -> - hashMap_t_inv self /\ - hashMap_t_same_params hm' self /\ - // We updated the binding - hashMap_s_updated_binding (hashMap_t_v self) key None (hashMap_t_v hm') /\ - hashMap_t_v hm' == hashMap_remove_s (hashMap_t_v self) key /\ - // The length is decremented iff the key was in the map - (let len = hashMap_t_len_s self in - let len' = hashMap_t_len_s hm' in - match hashMap_t_find_s self key with - | None -> len = len' - | Some _ -> len = len' + 1))) - -let hashMap_remove_back_lem_aux #t self key = - hashMap_remove_back_lem_refin self key; - hashMap_remove_s_lem (hashMap_t_v self) key - -/// .fsti -let hashMap_remove_back_lem #t self key = - hashMap_remove_back_lem_aux #t self key diff --git a/tests/fstar/hashmap/Hashmap.Properties.fsti b/tests/fstar/hashmap/Hashmap.Properties.fsti deleted file mode 100644 index 26c0ec06..00000000 --- a/tests/fstar/hashmap/Hashmap.Properties.fsti +++ /dev/null @@ -1,267 +0,0 @@ -(** Properties about the hashmap *) -module Hashmap.Properties -open Primitives -open FStar.List.Tot -open FStar.Mul -open Hashmap.Types -open Hashmap.Clauses -open Hashmap.Funs - -#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" - -// Small trick to align the .fst and the .fsti -val _align_fsti : unit - -(*** Utilities *) - -type key : eqtype = usize - -type hash : eqtype = usize - -val hashMap_t_inv (#t : Type0) (hm : hashMap_t t) : Type0 - -val len_s (#t : Type0) (hm : hashMap_t t) : nat - -val find_s (#t : Type0) (hm : hashMap_t t) (k : key) : option t - -(*** Overloading *) - -/// Upon inserting *new* entries in the hash map, the slots vector is resized -/// whenever we reach the max load, unless we can't resize anymore because -/// there are already too many entries. This way, we maintain performance by -/// limiting the hash collisions. -/// This is expressed by the following property, which is maintained in the hash -/// map invariant. -val hashMap_not_overloaded_lem (#t : Type0) (hm : hashMap_t t) : - Lemma - (requires (hashMap_t_inv hm)) - (ensures ( - // The capacity is the number of slots - let capacity = length hm.slots in - // The max load factor defines a threshold on the number of entries: - // if there are more entries than a given fraction of the number of slots, - // we resize the slots vector to limit the hash collisions - let (dividend, divisor) = hm.max_load_factor in - // technicality: this postcondition won't typecheck if we don't reveal - // that divisor > 0 (because of the division) - divisor > 0 /\ - begin - // The max load, computed as a fraction of the capacity - let max_load = (capacity * dividend) / divisor in - // The number of entries inserted in the map is given by [len_s] (see - // the functional correctness lemmas, which state how this number evolves): - let len = len_s hm in - // We prove that: - // - either the number of entries is <= than the max load threshold - len <= max_load - // - or we couldn't resize the map, because then the arithmetic computations - // would overflow (note that we always multiply the number of slots by 2) - || 2* capacity * dividend > usize_max - end)) - -(*** Functional correctness *) -(**** [new'fwd] *) - -/// [new] doesn't fail and returns an empty hash map -val hashMap_new_lem (t : Type0) : - Lemma - (ensures ( - match hashMap_new t with - | Fail _ -> False - | Return hm -> - // The hash map invariant is satisfied - hashMap_t_inv hm /\ - // The hash map has a length of 0 - len_s hm = 0 /\ - // It contains no bindings - (forall k. find_s hm k == None))) - -(**** [clear] *) - -/// [clear] doesn't fail and turns the hash map into an empty map -val hashMap_clear_lem - (#t : Type0) (self : hashMap_t t) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_clear t self with - | Fail _ -> False - | Return hm -> - // The hash map invariant is satisfied - hashMap_t_inv hm /\ - // The hash map has a length of 0 - len_s hm = 0 /\ - // It contains no bindings - (forall k. find_s hm k == None))) - -(**** [len] *) - -/// [len] can't fail and returns the length (the number of elements) of the hash map -val hashMap_len_lem (#t : Type0) (self : hashMap_t t) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_len t self with - | Fail _ -> False - | Return l -> l = len_s self)) - - -(**** [insert'fwd_back] *) - -/// The backward function for [insert] (note it is named "...insert'fwd_back" because -/// the forward function doesn't return anything, and was thus filtered - in a -/// sense the effect of applying the forward function then the backward function is -/// entirely encompassed by the effect of the backward function alone). -/// -/// [insert'fwd_back] simply inserts a binding. -val hashMap_insert_lem - (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_insert t self key value with - | Fail _ -> - // We can fail only if: - // - the key is not in the map and we thus need to add it - None? (find_s self key) /\ - // - and we are already saturated (we can't increment the internal counter) - len_s self = usize_max - | Return hm' -> - // The invariant is preserved - hashMap_t_inv hm' /\ - // [key] maps to [value] - find_s hm' key == Some value /\ - // The other bindings are preserved - (forall k'. k' <> key ==> find_s hm' k' == find_s self k') /\ - begin - // The length is incremented, iff we inserted a new key - match find_s self key with - | None -> len_s hm' = len_s self + 1 - | Some _ -> len_s hm' = len_s self - end)) - - -(**** [contains_key] *) - -/// [contains_key'fwd] can't fail and returns `true` if and only if there is -/// a binding for key [key] -val hashMap_contains_key_lem - (#t : Type0) (self : hashMap_t t) (key : usize) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_contains_key t self key with - | Fail _ -> False - | Return b -> b = Some? (find_s self key))) - -(**** [get'fwd] *) - -/// [get] returns (a shared borrow to) the binding for key [key] -val hashMap_get_lem - (#t : Type0) (self : hashMap_t t) (key : usize) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_get t self key, find_s self key with - | Fail _, None -> True - | Return x, Some x' -> x == x' - | _ -> False)) - -(**** [get_mut'fwd] *) - -/// [get_mut'fwd] returns (a mutable borrow to) the binding for key [key]. -/// -/// The *forward* function models the action of getting a borrow to an element -/// in Rust, which gives the possibility of modifying this element in place. Then, -/// upon ending the borrow, the effect of the modification is modelled in the -/// translation through a call to the backward function. -val hashMap_get_mut_lem - (#t : Type0) (self : hashMap_t t) (key : usize) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_get_mut t self key, find_s self key with - | Fail _, None -> True - | Return x, Some x' -> x == x' - | _ -> False)) - - -(**** [get_mut'back] *) - -/// [get_mut'back] updates the binding for key [key], without failing. -/// A call to [get_mut'back] must follow a call to [get_mut'fwd], which gives -/// us that there must be a binding for key [key] in the map (otherwise we -/// can't prove the absence of failure). -val hashMap_get_mut_back_lem - (#t : Type0) (hm : hashMap_t t) (key : usize) (ret : t) : - Lemma - (requires ( - hashMap_t_inv hm /\ - // A call to the backward function must follow a call to the forward - // function, whose success gives us that there is a binding for the key. - // In the case of *forward* functions, "success" has to be understood as - // the absence of panics. When translating code from Rust to pure lambda - // calculus, we have the property that the generated calls to the backward - // functions can't fail (because their are preceded by calls to forward - // functions, which must then have succeeded before): for a backward function, - // "failure" is to be understood as the semantics getting stuck. - // This is of course true unless we filtered the call to the forward function - // because its effect is encompassed by the backward function, as with - // [hashMap_clear]). - Some? (find_s hm key))) - (ensures ( - match hashMap_get_mut_back t hm key ret with - | Fail _ -> False // Can't fail - | Return hm' -> - // The invariant is preserved - hashMap_t_inv hm' /\ - // The length is preserved - len_s hm' = len_s hm /\ - // [key] maps to the update value, [ret] - find_s hm' key == Some ret /\ - // The other bindings are preserved - (forall k'. k' <> key ==> find_s hm' k' == find_s hm k'))) - -(**** [remove'fwd] *) - -/// [remove'fwd] returns the (optional) element which has been removed from the map -/// (the rust function *moves* it out of the map). Note that the effect of the update -/// on the map is modelles through the call to [remove'back] ([remove] takes a -/// mutable borrow to the hash map as parameter). -val hashMap_remove_lem - (#t : Type0) (self : hashMap_t t) (key : usize) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_remove t self key with - | Fail _ -> False - | Return opt_x -> opt_x == find_s self key)) - - -(**** [remove'back] *) - -/// The hash map given as parameter to [remove] is given through a mutable borrow: -/// hence the backward function which gives back the updated map, without the -/// binding. -val hashMap_remove_back_lem - (#t : Type0) (self : hashMap_t t) (key : usize) : - Lemma - (requires (hashMap_t_inv self)) - (ensures ( - match hashMap_remove_back t self key with - | Fail _ -> False - | Return hm' -> - // The invariant is preserved - hashMap_t_inv self /\ - // The binding for [key] is not there anymore - find_s hm' key == None /\ - // The other bindings are preserved - (forall k'. k' <> key ==> find_s hm' k' == find_s self k') /\ - begin - // The length is decremented iff the key was in the map - let len = len_s self in - let len' = len_s hm' in - match find_s self key with - | None -> len = len' - | Some _ -> len = len' + 1 - end)) diff --git a/tests/fstar/hashmap/Primitives.fst b/tests/fstar/hashmap/Primitives.fst index a3ffbde4..fca80829 100644 --- a/tests/fstar/hashmap/Primitives.fst +++ b/tests/fstar/hashmap/Primitives.fst @@ -55,8 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a = x -let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -477,8 +476,7 @@ noeq type core_ops_index_Index (self idx : Type0) = { // Trait declaration: [core::ops::index::IndexMut] noeq type core_ops_index_IndexMut (self idx : Type0) = { indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result indexInst.output; - index_mut_back : self → idx → indexInst.output → result self; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); } // Trait declaration [core::ops::deref::Deref] @@ -490,8 +488,7 @@ noeq type core_ops_deref_Deref (self : Type0) = { // Trait declaration [core::ops::deref::DerefMut] noeq type core_ops_deref_DerefMut (self : Type0) = { derefInst : core_ops_deref_Deref self; - deref_mut : self → result derefInst.target; - deref_mut_back : self → derefInst.target → result self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); } type core_ops_range_Range (a : Type0) = { @@ -502,8 +499,8 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = + Return (x, (fun x -> Return x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -515,7 +512,6 @@ let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { derefInst = alloc_boxed_Box_coreopsDerefInst self; deref_mut = alloc_boxed_Box_deref_mut self; - deref_mut_back = alloc_boxed_Box_deref_mut_back self; } (*** Array *) @@ -535,10 +531,18 @@ let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : resu if i < length x then Return (index x i) else Fail Failure -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : + result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure +let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : + result (a & (a -> result (array a n))) = + match array_index_usize a n x i with + | Fail e -> Fail e + | Return v -> + Return (v, array_update_usize a n x i) + (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -552,6 +556,13 @@ let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result ( if i < length x then Return (list_update x i nx) else Fail Failure +let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : + result (a & (a -> result (slice a))) = + match slice_index_usize a s i with + | Fail e -> Fail e + | Return x -> + Return (x, slice_update_usize a s i) + (*** Subslices *) let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x @@ -559,6 +570,10 @@ let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : res if length s = n then Return s else Fail Failure +let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : + result (slice a & (slice a -> result (array a n))) = + Return (x, array_from_slice a n x) + // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() @@ -588,8 +603,13 @@ let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : r let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : + result (a & (a → result (alloc_vec_Vec a))) = + match alloc_vec_Vec_index_usize v i with + | Return x -> + Return (x, alloc_vec_Vec_update_usize v i) + | Fail e -> Fail e + let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : Pure (result (alloc_vec_Vec a)) (requires True) @@ -605,9 +625,6 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : end else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure @@ -619,13 +636,11 @@ noeq type core_slice_index_SliceIndex (self t : Type0) = { sealedInst : core_slice_index_private_slice_index_Sealed self; output : Type0; get : self → t → result (option output); - get_mut : self → t → result (option output); - get_mut_back : self → t → option output → result t; + get_mut : self → t → result (option output & (option output -> result t)); get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); index : self → t → result output; - index_mut : self → t → result output; - index_mut_back : self → t → output → result t; + index_mut : self → t → result (output & (output -> result t)); } // [core::slice::index::[T]::index]: forward function @@ -643,14 +658,8 @@ let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) admit () // TODO // [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_RangeUsize_get_mut_back - (t : Type0) : - core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = admit () // TODO // [core::slice::index::Range::get_unchecked]: forward function @@ -675,27 +684,16 @@ let core_slice_index_RangeUsize_index admit () // TODO // [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_RangeUsize_index_mut_back - (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = admit () // TODO // [core::slice::index::[T]::index_mut]: forward function let core_slice_index_Slice_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result inst.output = + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = admit () // -// [core::slice::index::[T]::index_mut]: backward function 0 -let core_slice_index_Slice_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → inst.output → result (slice t) = - admit () // TODO - // [core::array::[T; N]::index]: forward function let core_array_Array_index (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) @@ -705,13 +703,8 @@ let core_array_Array_index // [core::array::[T; N]::index_mut]: forward function let core_array_Array_index_mut (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : result inst.indexInst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: backward function 0 -let core_array_Array_index_mut_back - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::Range] @@ -725,12 +718,10 @@ let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : output = slice t; get = core_slice_index_RangeUsize_get t; get_mut = core_slice_index_RangeUsize_get_mut t; - get_mut_back = core_slice_index_RangeUsize_get_mut_back t; get_unchecked = core_slice_index_RangeUsize_get_unchecked t; get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; index = core_slice_index_RangeUsize_index t; index_mut = core_slice_index_RangeUsize_index_mut t; - index_mut_back = core_slice_index_RangeUsize_index_mut_back t; } // Trait implementation: [core::slice::index::[T]] @@ -747,7 +738,6 @@ let core_ops_index_IndexMutSliceTIInst (t idx : Type0) core_ops_index_IndexMut (slice t) idx = { indexInst = core_ops_index_IndexSliceTIInst t idx inst; index_mut = core_slice_index_Slice_index_mut t idx inst; - index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; } // Trait implementation: [core::array::[T; N]] @@ -764,7 +754,6 @@ let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) core_ops_index_IndexMut (array t n) idx = { indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; index_mut = core_array_Array_index_mut t idx n inst; - index_mut_back = core_array_Array_index_mut_back t idx n inst; } // [core::slice::index::usize::get]: forward function @@ -773,13 +762,8 @@ let core_slice_index_usize_get admit () // TODO // [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: backward function 0 -let core_slice_index_usize_get_mut_back - (t : Type0) : usize → slice t → option t → result (slice t) = +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = admit () // TODO // [core::slice::index::usize::get_unchecked]: forward function @@ -797,12 +781,8 @@ let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = admit () // TODO // [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: backward function 0 -let core_slice_index_usize_index_mut_back - (t : Type0) : usize → slice t → t → result (slice t) = +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::usize] @@ -816,12 +796,10 @@ let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : output = t; get = core_slice_index_usize_get t; get_mut = core_slice_index_usize_get_mut t; - get_mut_back = core_slice_index_usize_get_mut_back t; get_unchecked = core_slice_index_usize_get_unchecked t; get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; index = core_slice_index_usize_index t; index_mut = core_slice_index_usize_index_mut t; - index_mut_back = core_slice_index_usize_index_mut_back t; } // [alloc::vec::Vec::index]: forward function @@ -831,13 +809,8 @@ let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx // [alloc::vec::Vec::index_mut]: forward function let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: backward function 0 -let alloc_vec_Vec_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = admit () // TODO // Trait implementation: [alloc::vec::Vec] @@ -854,7 +827,6 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) core_ops_index_IndexMut (alloc_vec_Vec t) idx = { indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; index_mut = alloc_vec_Vec_index_mut t idx inst; - index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } (*** Theorems *) @@ -870,15 +842,7 @@ let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : Lemma ( alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) + alloc_vec_Vec_index_mut_usize v i) [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] = admit() - -let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : - Lemma ( - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == - alloc_vec_Vec_update_usize v i x) - [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] - = - admit() diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst index f2d09a38..3a042678 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst @@ -8,12 +8,12 @@ include HashmapMain.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [hashmap_main::hashmap::hash_key]: forward function +(** [hashmap_main::hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 *) let hashmap_hash_key (k : usize) : result usize = Return k -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 *) let rec hashmap_HashMap_allocate_slots_loop (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : @@ -22,13 +22,12 @@ let rec hashmap_HashMap_allocate_slots_loop = if n > 0 then - let* slots0 = alloc_vec_Vec_push (hashmap_List_t t) slots Hashmap_List_Nil - in - let* n0 = usize_sub n 1 in - hashmap_HashMap_allocate_slots_loop t slots0 n0 + let* v = alloc_vec_Vec_push (hashmap_List_t t) slots Hashmap_List_Nil in + let* n1 = usize_sub n 1 in + hashmap_HashMap_allocate_slots_loop t v n1 else Return slots -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 *) let hashmap_HashMap_allocate_slots (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : @@ -36,7 +35,7 @@ let hashmap_HashMap_allocate_slots = hashmap_HashMap_allocate_slots_loop t slots n -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new_with_capacity]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new_with_capacity]: Source: 'src/hashmap.rs', lines 59:4-63:13 *) let hashmap_HashMap_new_with_capacity (t : Type0) (capacity : usize) (max_load_dividend : usize) @@ -46,102 +45,79 @@ let hashmap_HashMap_new_with_capacity let v = alloc_vec_Vec_new (hashmap_List_t t) in let* slots = hashmap_HashMap_allocate_slots t v capacity in let* i = usize_mul capacity max_load_dividend in - let* i0 = usize_div i max_load_divisor in + let* i1 = usize_div i max_load_divisor in Return { num_entries = 0; max_load_factor = (max_load_dividend, max_load_divisor); - max_load = i0; + max_load = i1; slots = slots } -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new]: Source: 'src/hashmap.rs', lines 75:4-75:24 *) let hashmap_HashMap_new (t : Type0) : result (hashmap_HashMap_t t) = hashmap_HashMap_new_with_capacity t 32 4 5 -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: loop 0: Source: 'src/hashmap.rs', lines 80:4-88:5 *) let rec hashmap_HashMap_clear_loop (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : Tot (result (alloc_vec_Vec (hashmap_List_t t))) (decreases (hashmap_HashMap_clear_loop_decreases t slots i)) = - let i0 = alloc_vec_Vec_len (hashmap_List_t t) slots in - if i < i0 + let i1 = alloc_vec_Vec_len (hashmap_List_t t) slots in + if i < i1 then - let* i1 = usize_add i 1 in - let* slots0 = - alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize + let* (_, index_mut_back) = + alloc_vec_Vec_index_mut (hashmap_List_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) slots i - Hashmap_List_Nil in - hashmap_HashMap_clear_loop t slots0 i1 + in + let* i2 = usize_add i 1 in + let* slots1 = index_mut_back Hashmap_List_Nil in + hashmap_HashMap_clear_loop t slots1 i2 else Return slots -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 *) let hashmap_HashMap_clear (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) = - let* v = hashmap_HashMap_clear_loop t self.slots 0 in - Return { self with num_entries = 0; slots = v } + let* back = hashmap_HashMap_clear_loop t self.slots 0 in + Return { self with num_entries = 0; slots = back } -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) let hashmap_HashMap_len (t : Type0) (self : hashmap_HashMap_t t) : result usize = Return self.num_entries -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 *) let rec hashmap_HashMap_insert_in_list_loop (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : - Tot (result bool) + Tot (result (bool & (hashmap_List_t t))) (decreases (hashmap_HashMap_insert_in_list_loop_decreases t key value ls)) = begin match ls with | Hashmap_List_Cons ckey cvalue tl -> if ckey = key - then Return false - else hashmap_HashMap_insert_in_list_loop t key value tl - | Hashmap_List_Nil -> Return true - end - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: forward function - Source: 'src/hashmap.rs', lines 97:4-97:71 *) -let hashmap_HashMap_insert_in_list - (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : result bool = - hashmap_HashMap_insert_in_list_loop t key value ls - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 97:4-114:5 *) -let rec hashmap_HashMap_insert_in_list_loop_back - (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : - Tot (result (hashmap_List_t t)) - (decreases (hashmap_HashMap_insert_in_list_loop_decreases t key value ls)) - = - begin match ls with - | Hashmap_List_Cons ckey cvalue tl -> - if ckey = key - then Return (Hashmap_List_Cons ckey value tl) + then Return (false, Hashmap_List_Cons ckey value tl) else - let* tl0 = hashmap_HashMap_insert_in_list_loop_back t key value tl in - Return (Hashmap_List_Cons ckey cvalue tl0) + let* (b, back) = hashmap_HashMap_insert_in_list_loop t key value tl in + Return (b, Hashmap_List_Cons ckey cvalue back) | Hashmap_List_Nil -> - let l = Hashmap_List_Nil in Return (Hashmap_List_Cons key value l) + let l = Hashmap_List_Nil in Return (true, Hashmap_List_Cons key value l) end -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: backward function 0 +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 *) -let hashmap_HashMap_insert_in_list_back +let hashmap_HashMap_insert_in_list (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : - result (hashmap_List_t t) + result (bool & (hashmap_List_t t)) = - hashmap_HashMap_insert_in_list_loop_back t key value ls + hashmap_HashMap_insert_in_list_loop t key value ls -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_no_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_no_resize]: Source: 'src/hashmap.rs', lines 117:4-117:54 *) let hashmap_HashMap_insert_no_resize (t : Type0) (self : hashmap_HashMap_t t) (key : usize) (value : t) : @@ -150,30 +126,19 @@ let hashmap_HashMap_insert_no_resize let* hash = hashmap_hash_key key in let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in let* hash_mod = usize_rem hash i in - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (hashmap_List_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) self.slots hash_mod in - let* inserted = hashmap_HashMap_insert_in_list t key value l in + let* (inserted, l1) = hashmap_HashMap_insert_in_list t key value l in if inserted then - let* i0 = usize_add self.num_entries 1 in - let* l0 = hashmap_HashMap_insert_in_list_back t key value l in - let* v = - alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) - self.slots hash_mod l0 in - Return { self with num_entries = i0; slots = v } - else - let* l0 = hashmap_HashMap_insert_in_list_back t key value l in - let* v = - alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) - self.slots hash_mod l0 in - Return { self with slots = v } - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) + let* i1 = usize_add self.num_entries 1 in + let* v = index_mut_back l1 in + Return { self with num_entries = i1; slots = v } + else let* v = index_mut_back l1 in Return { self with slots = v } + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 *) let rec hashmap_HashMap_move_elements_from_list_loop (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : @@ -183,13 +148,12 @@ let rec hashmap_HashMap_move_elements_from_list_loop = begin match ls with | Hashmap_List_Cons k v tl -> - let* ntable0 = hashmap_HashMap_insert_no_resize t ntable k v in - hashmap_HashMap_move_elements_from_list_loop t ntable0 tl + let* hm = hashmap_HashMap_insert_no_resize t ntable k v in + hashmap_HashMap_move_elements_from_list_loop t hm tl | Hashmap_List_Nil -> Return ntable end -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: Source: 'src/hashmap.rs', lines 183:4-183:72 *) let hashmap_HashMap_move_elements_from_list (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : @@ -197,8 +161,7 @@ let hashmap_HashMap_move_elements_from_list = hashmap_HashMap_move_elements_from_list_loop t ntable ls -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: loop 0: Source: 'src/hashmap.rs', lines 171:4-180:5 *) let rec hashmap_HashMap_move_elements_loop (t : Type0) (ntable : hashmap_HashMap_t t) @@ -206,68 +169,64 @@ let rec hashmap_HashMap_move_elements_loop Tot (result ((hashmap_HashMap_t t) & (alloc_vec_Vec (hashmap_List_t t)))) (decreases (hashmap_HashMap_move_elements_loop_decreases t ntable slots i)) = - let i0 = alloc_vec_Vec_len (hashmap_List_t t) slots in - if i < i0 + let i1 = alloc_vec_Vec_len (hashmap_List_t t) slots in + if i < i1 then - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (hashmap_List_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) slots i in - let ls = core_mem_replace (hashmap_List_t t) l Hashmap_List_Nil in - let* ntable0 = hashmap_HashMap_move_elements_from_list t ntable ls in - let* i1 = usize_add i 1 in - let l0 = core_mem_replace_back (hashmap_List_t t) l Hashmap_List_Nil in - let* slots0 = - alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) slots i - l0 in - hashmap_HashMap_move_elements_loop t ntable0 slots0 i1 + let (ls, l1) = core_mem_replace (hashmap_List_t t) l Hashmap_List_Nil in + let* hm = hashmap_HashMap_move_elements_from_list t ntable ls in + let* i2 = usize_add i 1 in + let* slots1 = index_mut_back l1 in + let* back_'a = hashmap_HashMap_move_elements_loop t hm slots1 i2 in + let (hm1, v) = back_'a in + Return (hm1, v) else Return (ntable, slots) -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 *) let hashmap_HashMap_move_elements (t : Type0) (ntable : hashmap_HashMap_t t) (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : result ((hashmap_HashMap_t t) & (alloc_vec_Vec (hashmap_List_t t))) = - hashmap_HashMap_move_elements_loop t ntable slots i + let* back_'a = hashmap_HashMap_move_elements_loop t ntable slots i in + let (hm, v) = back_'a in + Return (hm, v) -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::try_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::try_resize]: Source: 'src/hashmap.rs', lines 140:4-140:28 *) let hashmap_HashMap_try_resize (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) = let* max_usize = scalar_cast U32 Usize core_u32_max in let capacity = alloc_vec_Vec_len (hashmap_List_t t) self.slots in let* n1 = usize_div max_usize 2 in - let (i, i0) = self.max_load_factor in - let* i1 = usize_div n1 i in - if capacity <= i1 + let (i, i1) = self.max_load_factor in + let* i2 = usize_div n1 i in + if capacity <= i2 then - let* i2 = usize_mul capacity 2 in - let* ntable = hashmap_HashMap_new_with_capacity t i2 i i0 in - let* (ntable0, _) = hashmap_HashMap_move_elements t ntable self.slots 0 in + let* i3 = usize_mul capacity 2 in + let* ntable = hashmap_HashMap_new_with_capacity t i3 i i1 in + let* p = hashmap_HashMap_move_elements t ntable self.slots 0 in + let (ntable1, _) = p in Return - { ntable0 with num_entries = self.num_entries; max_load_factor = (i, i0) + { ntable1 with num_entries = self.num_entries; max_load_factor = (i, i1) } - else Return { self with max_load_factor = (i, i0) } + else Return { self with max_load_factor = (i, i1) } -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 *) let hashmap_HashMap_insert (t : Type0) (self : hashmap_HashMap_t t) (key : usize) (value : t) : result (hashmap_HashMap_t t) = - let* self0 = hashmap_HashMap_insert_no_resize t self key value in - let* i = hashmap_HashMap_len t self0 in - if i > self0.max_load - then hashmap_HashMap_try_resize t self0 - else Return self0 + let* hm = hashmap_HashMap_insert_no_resize t self key value in + let* i = hashmap_HashMap_len t hm in + if i > hm.max_load then hashmap_HashMap_try_resize t hm else Return hm -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 *) let rec hashmap_HashMap_contains_key_in_list_loop (t : Type0) (key : usize) (ls : hashmap_List_t t) : @@ -275,20 +234,20 @@ let rec hashmap_HashMap_contains_key_in_list_loop (decreases (hashmap_HashMap_contains_key_in_list_loop_decreases t key ls)) = begin match ls with - | Hashmap_List_Cons ckey x tl -> + | Hashmap_List_Cons ckey _ tl -> if ckey = key then Return true else hashmap_HashMap_contains_key_in_list_loop t key tl | Hashmap_List_Nil -> Return false end -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: Source: 'src/hashmap.rs', lines 206:4-206:68 *) let hashmap_HashMap_contains_key_in_list (t : Type0) (key : usize) (ls : hashmap_List_t t) : result bool = hashmap_HashMap_contains_key_in_list_loop t key ls -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key]: Source: 'src/hashmap.rs', lines 199:4-199:49 *) let hashmap_HashMap_contains_key (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result bool = @@ -301,7 +260,7 @@ let hashmap_HashMap_contains_key self.slots hash_mod in hashmap_HashMap_contains_key_in_list t key l -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: loop 0: Source: 'src/hashmap.rs', lines 224:4-237:5 *) let rec hashmap_HashMap_get_in_list_loop (t : Type0) (key : usize) (ls : hashmap_List_t t) : @@ -316,13 +275,13 @@ let rec hashmap_HashMap_get_in_list_loop | Hashmap_List_Nil -> Fail Failure end -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: Source: 'src/hashmap.rs', lines 224:4-224:70 *) let hashmap_HashMap_get_in_list (t : Type0) (key : usize) (ls : hashmap_List_t t) : result t = hashmap_HashMap_get_in_list_loop t key ls -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get]: Source: 'src/hashmap.rs', lines 239:4-239:55 *) let hashmap_HashMap_get (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result t = @@ -335,241 +294,162 @@ let hashmap_HashMap_get self.slots hash_mod in hashmap_HashMap_get_in_list t key l -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: Source: 'src/hashmap.rs', lines 245:4-254:5 *) let rec hashmap_HashMap_get_mut_in_list_loop (t : Type0) (ls : hashmap_List_t t) (key : usize) : - Tot (result t) - (decreases (hashmap_HashMap_get_mut_in_list_loop_decreases t ls key)) - = - begin match ls with - | Hashmap_List_Cons ckey cvalue tl -> - if ckey = key - then Return cvalue - else hashmap_HashMap_get_mut_in_list_loop t tl key - | Hashmap_List_Nil -> Fail Failure - end - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: forward function - Source: 'src/hashmap.rs', lines 245:4-245:86 *) -let hashmap_HashMap_get_mut_in_list - (t : Type0) (ls : hashmap_List_t t) (key : usize) : result t = - hashmap_HashMap_get_mut_in_list_loop t ls key - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 245:4-254:5 *) -let rec hashmap_HashMap_get_mut_in_list_loop_back - (t : Type0) (ls : hashmap_List_t t) (key : usize) (ret : t) : - Tot (result (hashmap_List_t t)) + Tot (result (t & (t -> result (hashmap_List_t t)))) (decreases (hashmap_HashMap_get_mut_in_list_loop_decreases t ls key)) = begin match ls with | Hashmap_List_Cons ckey cvalue tl -> if ckey = key - then Return (Hashmap_List_Cons ckey ret tl) + then + let back_'a = fun ret -> Return (Hashmap_List_Cons ckey ret tl) in + Return (cvalue, back_'a) else - let* tl0 = hashmap_HashMap_get_mut_in_list_loop_back t tl key ret in - Return (Hashmap_List_Cons ckey cvalue tl0) + let* (x, back_'a) = hashmap_HashMap_get_mut_in_list_loop t tl key in + let back_'a1 = + fun ret -> + let* tl1 = back_'a ret in Return (Hashmap_List_Cons ckey cvalue tl1) + in + Return (x, back_'a1) | Hashmap_List_Nil -> Fail Failure end -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: backward function 0 +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: Source: 'src/hashmap.rs', lines 245:4-245:86 *) -let hashmap_HashMap_get_mut_in_list_back - (t : Type0) (ls : hashmap_List_t t) (key : usize) (ret : t) : - result (hashmap_List_t t) +let hashmap_HashMap_get_mut_in_list + (t : Type0) (ls : hashmap_List_t t) (key : usize) : + result (t & (t -> result (hashmap_List_t t))) = - hashmap_HashMap_get_mut_in_list_loop_back t ls key ret + let* (x, back_'a) = hashmap_HashMap_get_mut_in_list_loop t ls key in + let back_'a1 = fun ret -> back_'a ret in + Return (x, back_'a1) -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 *) let hashmap_HashMap_get_mut - (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result t = - let* hash = hashmap_hash_key key in - let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in - let* hash_mod = usize_rem hash i in - let* l = - alloc_vec_Vec_index_mut (hashmap_List_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) - self.slots hash_mod in - hashmap_HashMap_get_mut_in_list t l key - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: backward function 0 - Source: 'src/hashmap.rs', lines 257:4-257:67 *) -let hashmap_HashMap_get_mut_back - (t : Type0) (self : hashmap_HashMap_t t) (key : usize) (ret : t) : - result (hashmap_HashMap_t t) + (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : + result (t & (t -> result (hashmap_HashMap_t t))) = let* hash = hashmap_hash_key key in let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in let* hash_mod = usize_rem hash i in - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (hashmap_List_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) self.slots hash_mod in - let* l0 = hashmap_HashMap_get_mut_in_list_back t l key ret in - let* v = - alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) - self.slots hash_mod l0 in - Return { self with slots = v } - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: forward function + let* (x, get_mut_in_list_back) = hashmap_HashMap_get_mut_in_list t l key in + let back_'a = + fun ret -> + let* l1 = get_mut_in_list_back ret in + let* v = index_mut_back l1 in + Return { self with slots = v } in + Return (x, back_'a) + +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 *) let rec hashmap_HashMap_remove_from_list_loop (t : Type0) (key : usize) (ls : hashmap_List_t t) : - Tot (result (option t)) + Tot (result ((option t) & (hashmap_List_t t))) (decreases (hashmap_HashMap_remove_from_list_loop_decreases t key ls)) = begin match ls with | Hashmap_List_Cons ckey x tl -> if ckey = key then - let mv_ls = + let (mv_ls, _) = core_mem_replace (hashmap_List_t t) (Hashmap_List_Cons ckey x tl) Hashmap_List_Nil in begin match mv_ls with - | Hashmap_List_Cons i cvalue tl0 -> Return (Some cvalue) - | Hashmap_List_Nil -> Fail Failure - end - else hashmap_HashMap_remove_from_list_loop t key tl - | Hashmap_List_Nil -> Return None - end - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: forward function - Source: 'src/hashmap.rs', lines 265:4-265:69 *) -let hashmap_HashMap_remove_from_list - (t : Type0) (key : usize) (ls : hashmap_List_t t) : result (option t) = - hashmap_HashMap_remove_from_list_loop t key ls - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: backward function 1 - Source: 'src/hashmap.rs', lines 265:4-291:5 *) -let rec hashmap_HashMap_remove_from_list_loop_back - (t : Type0) (key : usize) (ls : hashmap_List_t t) : - Tot (result (hashmap_List_t t)) - (decreases (hashmap_HashMap_remove_from_list_loop_decreases t key ls)) - = - begin match ls with - | Hashmap_List_Cons ckey x tl -> - if ckey = key - then - let mv_ls = - core_mem_replace (hashmap_List_t t) (Hashmap_List_Cons ckey x tl) - Hashmap_List_Nil in - begin match mv_ls with - | Hashmap_List_Cons i cvalue tl0 -> Return tl0 + | Hashmap_List_Cons _ cvalue tl1 -> Return (Some cvalue, tl1) | Hashmap_List_Nil -> Fail Failure end else - let* tl0 = hashmap_HashMap_remove_from_list_loop_back t key tl in - Return (Hashmap_List_Cons ckey x tl0) - | Hashmap_List_Nil -> Return Hashmap_List_Nil + let* (o, back) = hashmap_HashMap_remove_from_list_loop t key tl in + Return (o, Hashmap_List_Cons ckey x back) + | Hashmap_List_Nil -> Return (None, Hashmap_List_Nil) end -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: backward function 1 +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: Source: 'src/hashmap.rs', lines 265:4-265:69 *) -let hashmap_HashMap_remove_from_list_back +let hashmap_HashMap_remove_from_list (t : Type0) (key : usize) (ls : hashmap_List_t t) : - result (hashmap_List_t t) + result ((option t) & (hashmap_List_t t)) = - hashmap_HashMap_remove_from_list_loop_back t key ls + hashmap_HashMap_remove_from_list_loop t key ls -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: forward function +(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: Source: 'src/hashmap.rs', lines 294:4-294:52 *) let hashmap_HashMap_remove - (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result (option t) = - let* hash = hashmap_hash_key key in - let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in - let* hash_mod = usize_rem hash i in - let* l = - alloc_vec_Vec_index_mut (hashmap_List_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) - self.slots hash_mod in - let* x = hashmap_HashMap_remove_from_list t key l in - begin match x with - | None -> Return None - | Some x0 -> let* _ = usize_sub self.num_entries 1 in Return (Some x0) - end - -(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: backward function 0 - Source: 'src/hashmap.rs', lines 294:4-294:52 *) -let hashmap_HashMap_remove_back (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : - result (hashmap_HashMap_t t) + result ((option t) & (hashmap_HashMap_t t)) = let* hash = hashmap_hash_key key in let i = alloc_vec_Vec_len (hashmap_List_t t) self.slots in let* hash_mod = usize_rem hash i in - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (hashmap_List_t t) usize (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) self.slots hash_mod in - let* x = hashmap_HashMap_remove_from_list t key l in + let* (x, l1) = hashmap_HashMap_remove_from_list t key l in begin match x with | None -> - let* l0 = hashmap_HashMap_remove_from_list_back t key l in - let* v = - alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) - self.slots hash_mod l0 in - Return { self with slots = v } - | Some x0 -> - let* i0 = usize_sub self.num_entries 1 in - let* l0 = hashmap_HashMap_remove_from_list_back t key l in - let* v = - alloc_vec_Vec_index_mut_back (hashmap_List_t t) usize - (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) - self.slots hash_mod l0 in - Return { self with num_entries = i0; slots = v } + let* v = index_mut_back l1 in Return (None, { self with slots = v }) + | Some x1 -> + let* i1 = usize_sub self.num_entries 1 in + let* v = index_mut_back l1 in + Return (Some x1, { self with num_entries = i1; slots = v }) end -(** [hashmap_main::hashmap::test1]: forward function +(** [hashmap_main::hashmap::test1]: Source: 'src/hashmap.rs', lines 315:0-315:10 *) let hashmap_test1 : result unit = let* hm = hashmap_HashMap_new u64 in - let* hm0 = hashmap_HashMap_insert u64 hm 0 42 in - let* hm1 = hashmap_HashMap_insert u64 hm0 128 18 in - let* hm2 = hashmap_HashMap_insert u64 hm1 1024 138 in - let* hm3 = hashmap_HashMap_insert u64 hm2 1056 256 in - let* i = hashmap_HashMap_get u64 hm3 128 in + let* hm1 = hashmap_HashMap_insert u64 hm 0 42 in + let* hm2 = hashmap_HashMap_insert u64 hm1 128 18 in + let* hm3 = hashmap_HashMap_insert u64 hm2 1024 138 in + let* hm4 = hashmap_HashMap_insert u64 hm3 1056 256 in + let* i = hashmap_HashMap_get u64 hm4 128 in if not (i = 18) then Fail Failure else - let* hm4 = hashmap_HashMap_get_mut_back u64 hm3 1024 56 in - let* i0 = hashmap_HashMap_get u64 hm4 1024 in - if not (i0 = 56) + let* (_, get_mut_back) = hashmap_HashMap_get_mut u64 hm4 1024 in + let* hm5 = get_mut_back 56 in + let* i1 = hashmap_HashMap_get u64 hm5 1024 in + if not (i1 = 56) then Fail Failure else - let* x = hashmap_HashMap_remove u64 hm4 1024 in + let* (x, hm6) = hashmap_HashMap_remove u64 hm5 1024 in begin match x with | None -> Fail Failure - | Some x0 -> - if not (x0 = 56) + | Some x1 -> + if not (x1 = 56) then Fail Failure else - let* hm5 = hashmap_HashMap_remove_back u64 hm4 1024 in - let* i1 = hashmap_HashMap_get u64 hm5 0 in - if not (i1 = 42) + let* i2 = hashmap_HashMap_get u64 hm6 0 in + if not (i2 = 42) then Fail Failure else - let* i2 = hashmap_HashMap_get u64 hm5 128 in - if not (i2 = 18) + let* i3 = hashmap_HashMap_get u64 hm6 128 in + if not (i3 = 18) then Fail Failure else - let* i3 = hashmap_HashMap_get u64 hm5 1056 in - if not (i3 = 256) then Fail Failure else Return () + let* i4 = hashmap_HashMap_get u64 hm6 1056 in + if not (i4 = 256) then Fail Failure else Return () end -(** [hashmap_main::insert_on_disk]: forward function +(** [hashmap_main::insert_on_disk]: Source: 'src/hashmap_main.rs', lines 7:0-7:43 *) let insert_on_disk (key : usize) (value : u64) (st : state) : result (state & unit) = - let* (st0, hm) = hashmap_utils_deserialize st in - let* hm0 = hashmap_HashMap_insert u64 hm key value in - let* (st1, _) = hashmap_utils_serialize hm0 st0 in - Return (st1, ()) + let* (st1, hm) = hashmap_utils_deserialize st in + let* hm1 = hashmap_HashMap_insert u64 hm key value in + let* (st2, _) = hashmap_utils_serialize hm1 st1 in + Return (st2, ()) -(** [hashmap_main::main]: forward function +(** [hashmap_main::main]: Source: 'src/hashmap_main.rs', lines 16:0-16:13 *) let main : result unit = Return () diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti b/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti index b00bbcde..50a6509f 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti +++ b/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti @@ -6,12 +6,12 @@ include HashmapMain.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [hashmap_main::hashmap_utils::deserialize]: forward function +(** [hashmap_main::hashmap_utils::deserialize]: Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *) val hashmap_utils_deserialize : state -> result (state & (hashmap_HashMap_t u64)) -(** [hashmap_main::hashmap_utils::serialize]: forward function +(** [hashmap_main::hashmap_utils::serialize]: Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *) val hashmap_utils_serialize : hashmap_HashMap_t u64 -> state -> result (state & unit) diff --git a/tests/fstar/hashmap_on_disk/Primitives.fst b/tests/fstar/hashmap_on_disk/Primitives.fst index a3ffbde4..fca80829 100644 --- a/tests/fstar/hashmap_on_disk/Primitives.fst +++ b/tests/fstar/hashmap_on_disk/Primitives.fst @@ -55,8 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a = x -let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -477,8 +476,7 @@ noeq type core_ops_index_Index (self idx : Type0) = { // Trait declaration: [core::ops::index::IndexMut] noeq type core_ops_index_IndexMut (self idx : Type0) = { indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result indexInst.output; - index_mut_back : self → idx → indexInst.output → result self; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); } // Trait declaration [core::ops::deref::Deref] @@ -490,8 +488,7 @@ noeq type core_ops_deref_Deref (self : Type0) = { // Trait declaration [core::ops::deref::DerefMut] noeq type core_ops_deref_DerefMut (self : Type0) = { derefInst : core_ops_deref_Deref self; - deref_mut : self → result derefInst.target; - deref_mut_back : self → derefInst.target → result self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); } type core_ops_range_Range (a : Type0) = { @@ -502,8 +499,8 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = + Return (x, (fun x -> Return x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -515,7 +512,6 @@ let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { derefInst = alloc_boxed_Box_coreopsDerefInst self; deref_mut = alloc_boxed_Box_deref_mut self; - deref_mut_back = alloc_boxed_Box_deref_mut_back self; } (*** Array *) @@ -535,10 +531,18 @@ let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : resu if i < length x then Return (index x i) else Fail Failure -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : + result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure +let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : + result (a & (a -> result (array a n))) = + match array_index_usize a n x i with + | Fail e -> Fail e + | Return v -> + Return (v, array_update_usize a n x i) + (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -552,6 +556,13 @@ let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result ( if i < length x then Return (list_update x i nx) else Fail Failure +let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : + result (a & (a -> result (slice a))) = + match slice_index_usize a s i with + | Fail e -> Fail e + | Return x -> + Return (x, slice_update_usize a s i) + (*** Subslices *) let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x @@ -559,6 +570,10 @@ let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : res if length s = n then Return s else Fail Failure +let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : + result (slice a & (slice a -> result (array a n))) = + Return (x, array_from_slice a n x) + // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() @@ -588,8 +603,13 @@ let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : r let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : + result (a & (a → result (alloc_vec_Vec a))) = + match alloc_vec_Vec_index_usize v i with + | Return x -> + Return (x, alloc_vec_Vec_update_usize v i) + | Fail e -> Fail e + let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : Pure (result (alloc_vec_Vec a)) (requires True) @@ -605,9 +625,6 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : end else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure @@ -619,13 +636,11 @@ noeq type core_slice_index_SliceIndex (self t : Type0) = { sealedInst : core_slice_index_private_slice_index_Sealed self; output : Type0; get : self → t → result (option output); - get_mut : self → t → result (option output); - get_mut_back : self → t → option output → result t; + get_mut : self → t → result (option output & (option output -> result t)); get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); index : self → t → result output; - index_mut : self → t → result output; - index_mut_back : self → t → output → result t; + index_mut : self → t → result (output & (output -> result t)); } // [core::slice::index::[T]::index]: forward function @@ -643,14 +658,8 @@ let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) admit () // TODO // [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_RangeUsize_get_mut_back - (t : Type0) : - core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = admit () // TODO // [core::slice::index::Range::get_unchecked]: forward function @@ -675,27 +684,16 @@ let core_slice_index_RangeUsize_index admit () // TODO // [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_RangeUsize_index_mut_back - (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = admit () // TODO // [core::slice::index::[T]::index_mut]: forward function let core_slice_index_Slice_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result inst.output = + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = admit () // -// [core::slice::index::[T]::index_mut]: backward function 0 -let core_slice_index_Slice_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → inst.output → result (slice t) = - admit () // TODO - // [core::array::[T; N]::index]: forward function let core_array_Array_index (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) @@ -705,13 +703,8 @@ let core_array_Array_index // [core::array::[T; N]::index_mut]: forward function let core_array_Array_index_mut (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : result inst.indexInst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: backward function 0 -let core_array_Array_index_mut_back - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::Range] @@ -725,12 +718,10 @@ let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : output = slice t; get = core_slice_index_RangeUsize_get t; get_mut = core_slice_index_RangeUsize_get_mut t; - get_mut_back = core_slice_index_RangeUsize_get_mut_back t; get_unchecked = core_slice_index_RangeUsize_get_unchecked t; get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; index = core_slice_index_RangeUsize_index t; index_mut = core_slice_index_RangeUsize_index_mut t; - index_mut_back = core_slice_index_RangeUsize_index_mut_back t; } // Trait implementation: [core::slice::index::[T]] @@ -747,7 +738,6 @@ let core_ops_index_IndexMutSliceTIInst (t idx : Type0) core_ops_index_IndexMut (slice t) idx = { indexInst = core_ops_index_IndexSliceTIInst t idx inst; index_mut = core_slice_index_Slice_index_mut t idx inst; - index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; } // Trait implementation: [core::array::[T; N]] @@ -764,7 +754,6 @@ let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) core_ops_index_IndexMut (array t n) idx = { indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; index_mut = core_array_Array_index_mut t idx n inst; - index_mut_back = core_array_Array_index_mut_back t idx n inst; } // [core::slice::index::usize::get]: forward function @@ -773,13 +762,8 @@ let core_slice_index_usize_get admit () // TODO // [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: backward function 0 -let core_slice_index_usize_get_mut_back - (t : Type0) : usize → slice t → option t → result (slice t) = +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = admit () // TODO // [core::slice::index::usize::get_unchecked]: forward function @@ -797,12 +781,8 @@ let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = admit () // TODO // [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: backward function 0 -let core_slice_index_usize_index_mut_back - (t : Type0) : usize → slice t → t → result (slice t) = +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::usize] @@ -816,12 +796,10 @@ let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : output = t; get = core_slice_index_usize_get t; get_mut = core_slice_index_usize_get_mut t; - get_mut_back = core_slice_index_usize_get_mut_back t; get_unchecked = core_slice_index_usize_get_unchecked t; get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; index = core_slice_index_usize_index t; index_mut = core_slice_index_usize_index_mut t; - index_mut_back = core_slice_index_usize_index_mut_back t; } // [alloc::vec::Vec::index]: forward function @@ -831,13 +809,8 @@ let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx // [alloc::vec::Vec::index_mut]: forward function let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: backward function 0 -let alloc_vec_Vec_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = admit () // TODO // Trait implementation: [alloc::vec::Vec] @@ -854,7 +827,6 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) core_ops_index_IndexMut (alloc_vec_Vec t) idx = { indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; index_mut = alloc_vec_Vec_index_mut t idx inst; - index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } (*** Theorems *) @@ -870,15 +842,7 @@ let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : Lemma ( alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) + alloc_vec_Vec_index_mut_usize v i) [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] = admit() - -let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : - Lemma ( - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == - alloc_vec_Vec_update_usize v i x) - [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] - = - admit() diff --git a/tests/fstar/misc/Bitwise.fst b/tests/fstar/misc/Bitwise.fst index d7ba2c57..7330f07a 100644 --- a/tests/fstar/misc/Bitwise.fst +++ b/tests/fstar/misc/Bitwise.fst @@ -5,27 +5,27 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [bitwise::shift_u32]: forward function +(** [bitwise::shift_u32]: Source: 'src/bitwise.rs', lines 3:0-3:31 *) let shift_u32 (a : u32) : result u32 = let* t = u32_shr #Usize a 16 in u32_shl #Usize t 16 -(** [bitwise::shift_i32]: forward function +(** [bitwise::shift_i32]: Source: 'src/bitwise.rs', lines 10:0-10:31 *) let shift_i32 (a : i32) : result i32 = let* t = i32_shr #Isize a 16 in i32_shl #Isize t 16 -(** [bitwise::xor_u32]: forward function +(** [bitwise::xor_u32]: Source: 'src/bitwise.rs', lines 17:0-17:37 *) let xor_u32 (a : u32) (b : u32) : result u32 = Return (u32_xor a b) -(** [bitwise::or_u32]: forward function +(** [bitwise::or_u32]: Source: 'src/bitwise.rs', lines 21:0-21:36 *) let or_u32 (a : u32) (b : u32) : result u32 = Return (u32_or a b) -(** [bitwise::and_u32]: forward function +(** [bitwise::and_u32]: Source: 'src/bitwise.rs', lines 25:0-25:37 *) let and_u32 (a : u32) (b : u32) : result u32 = Return (u32_and a b) diff --git a/tests/fstar/misc/Constants.fst b/tests/fstar/misc/Constants.fst index daeefbb0..7bf42b46 100644 --- a/tests/fstar/misc/Constants.fst +++ b/tests/fstar/misc/Constants.fst @@ -20,7 +20,7 @@ let x1_c : u32 = eval_global x1_body let x2_body : result u32 = Return 3 let x2_c : u32 = eval_global x2_body -(** [constants::incr]: forward function +(** [constants::incr]: Source: 'src/constants.rs', lines 17:0-17:32 *) let incr (n : u32) : result u32 = u32_add n 1 @@ -30,7 +30,7 @@ let incr (n : u32) : result u32 = let x3_body : result u32 = incr 32 let x3_c : u32 = eval_global x3_body -(** [constants::mk_pair0]: forward function +(** [constants::mk_pair0]: Source: 'src/constants.rs', lines 23:0-23:51 *) let mk_pair0 (x : u32) (y : u32) : result (u32 & u32) = Return (x, y) @@ -39,7 +39,7 @@ let mk_pair0 (x : u32) (y : u32) : result (u32 & u32) = Source: 'src/constants.rs', lines 36:0-36:23 *) type pair_t (t1 t2 : Type0) = { x : t1; y : t2; } -(** [constants::mk_pair1]: forward function +(** [constants::mk_pair1]: Source: 'src/constants.rs', lines 27:0-27:55 *) let mk_pair1 (x : u32) (y : u32) : result (pair_t u32 u32) = Return { x = x; y = y } @@ -68,7 +68,7 @@ let p3_c : pair_t u32 u32 = eval_global p3_body Source: 'src/constants.rs', lines 49:0-49:18 *) type wrap_t (t : Type0) = { value : t; } -(** [constants::{constants::Wrap}::new]: forward function +(** [constants::{constants::Wrap}::new]: Source: 'src/constants.rs', lines 54:4-54:41 *) let wrap_new (t : Type0) (value : t) : result (wrap_t t) = Return { value = value } @@ -78,7 +78,7 @@ let wrap_new (t : Type0) (value : t) : result (wrap_t t) = let y_body : result (wrap_t i32) = wrap_new i32 2 let y_c : wrap_t i32 = eval_global y_body -(** [constants::unwrap_y]: forward function +(** [constants::unwrap_y]: Source: 'src/constants.rs', lines 43:0-43:30 *) let unwrap_y : result i32 = Return y_c.value @@ -93,12 +93,12 @@ let yval_c : i32 = eval_global yval_body let get_z1_z1_body : result i32 = Return 3 let get_z1_z1_c : i32 = eval_global get_z1_z1_body -(** [constants::get_z1]: forward function +(** [constants::get_z1]: Source: 'src/constants.rs', lines 61:0-61:28 *) let get_z1 : result i32 = Return get_z1_z1_c -(** [constants::add]: forward function +(** [constants::add]: Source: 'src/constants.rs', lines 66:0-66:39 *) let add (a : i32) (b : i32) : result i32 = i32_add a b @@ -118,10 +118,10 @@ let q2_c : i32 = eval_global q2_body let q3_body : result i32 = add q2_c 3 let q3_c : i32 = eval_global q3_body -(** [constants::get_z2]: forward function +(** [constants::get_z2]: Source: 'src/constants.rs', lines 70:0-70:28 *) let get_z2 : result i32 = - let* i = get_z1 in let* i0 = add i q3_c in add q1_c i0 + let* i = get_z1 in let* i1 = add i q3_c in add q1_c i1 (** [constants::S1] Source: 'src/constants.rs', lines 80:0-80:18 *) diff --git a/tests/fstar/misc/External.Funs.fst b/tests/fstar/misc/External.Funs.fst index 00995634..bb1b9a64 100644 --- a/tests/fstar/misc/External.Funs.fst +++ b/tests/fstar/misc/External.Funs.fst @@ -7,33 +7,19 @@ include External.FunsExternal #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [external::swap]: forward function +(** [external::swap]: Source: 'src/external.rs', lines 6:0-6:46 *) -let swap (t : Type0) (x : t) (y : t) (st : state) : result (state & unit) = - let* (st0, _) = core_mem_swap t x y st in - let* (st1, _) = core_mem_swap_back0 t x y st st0 in - let* (st2, _) = core_mem_swap_back1 t x y st st1 in - Return (st2, ()) +let swap (t : Type0) (x : t) (y : t) (st : state) : result (state & (t & t)) = + core_mem_swap t x y st -(** [external::swap]: backward function 0 - Source: 'src/external.rs', lines 6:0-6:46 *) -let swap_back - (t : Type0) (x : t) (y : t) (st : state) (st0 : state) : - result (state & (t & t)) - = - let* (st1, _) = core_mem_swap t x y st in - let* (st2, x0) = core_mem_swap_back0 t x y st st1 in - let* (_, y0) = core_mem_swap_back1 t x y st st2 in - Return (st0, (x0, y0)) - -(** [external::test_new_non_zero_u32]: forward function +(** [external::test_new_non_zero_u32]: Source: 'src/external.rs', lines 11:0-11:60 *) let test_new_non_zero_u32 (x : u32) (st : state) : result (state & core_num_nonzero_NonZeroU32_t) = - let* (st0, o) = core_num_nonzero_NonZeroU32_new x st in - core_option_Option_unwrap core_num_nonzero_NonZeroU32_t o st0 + let* (st1, o) = core_num_nonzero_NonZeroU32_new x st in + core_option_Option_unwrap core_num_nonzero_NonZeroU32_t o st1 -(** [external::test_vec]: forward function +(** [external::test_vec]: Source: 'src/external.rs', lines 17:0-17:17 *) let test_vec : result unit = let v = alloc_vec_Vec_new u32 in @@ -43,42 +29,28 @@ let test_vec : result unit = (** Unit test for [external::test_vec] *) let _ = assert_norm (test_vec = Return ()) -(** [external::custom_swap]: forward function - Source: 'src/external.rs', lines 24:0-24:66 *) -let custom_swap (t : Type0) (x : t) (y : t) (st : state) : result (state & t) = - let* (st0, _) = core_mem_swap t x y st in - let* (st1, x0) = core_mem_swap_back0 t x y st st0 in - let* (st2, _) = core_mem_swap_back1 t x y st st1 in - Return (st2, x0) - -(** [external::custom_swap]: backward function 0 +(** [external::custom_swap]: Source: 'src/external.rs', lines 24:0-24:66 *) -let custom_swap_back - (t : Type0) (x : t) (y : t) (st : state) (ret : t) (st0 : state) : - result (state & (t & t)) +let custom_swap + (t : Type0) (x : t) (y : t) (st : state) : + result (state & (t & (t -> state -> result (state & (t & t))))) = - let* (st1, _) = core_mem_swap t x y st in - let* (st2, _) = core_mem_swap_back0 t x y st st1 in - let* (_, y0) = core_mem_swap_back1 t x y st st2 in - Return (st0, (ret, y0)) - -(** [external::test_custom_swap]: forward function - Source: 'src/external.rs', lines 29:0-29:59 *) -let test_custom_swap (x : u32) (y : u32) (st : state) : result (state & unit) = - let* (st0, _) = custom_swap u32 x y st in Return (st0, ()) + let* (st1, (x1, x2)) = core_mem_swap t x y st in + let back_'a = fun ret st2 -> Return (st2, (ret, x2)) in + Return (st1, (x1, back_'a)) -(** [external::test_custom_swap]: backward function 0 +(** [external::test_custom_swap]: Source: 'src/external.rs', lines 29:0-29:59 *) -let test_custom_swap_back - (x : u32) (y : u32) (st : state) (st0 : state) : - result (state & (u32 & u32)) - = - custom_swap_back u32 x y st 1 st0 +let test_custom_swap + (x : u32) (y : u32) (st : state) : result (state & (u32 & u32)) = + let* (st1, (_, custom_swap_back)) = custom_swap u32 x y st in + let* (_, (x1, y1)) = custom_swap_back 1 st1 in + Return (st1, (x1, y1)) -(** [external::test_swap_non_zero]: forward function +(** [external::test_swap_non_zero]: Source: 'src/external.rs', lines 35:0-35:44 *) let test_swap_non_zero (x : u32) (st : state) : result (state & u32) = - let* (st0, _) = swap u32 x 0 st in - let* (st1, (x0, _)) = swap_back u32 x 0 st st0 in - if x0 = 0 then Fail Failure else Return (st1, x0) + let* (st1, p) = swap u32 x 0 st in + let (x1, _) = p in + if x1 = 0 then Fail Failure else Return (st1, x1) diff --git a/tests/fstar/misc/External.FunsExternal.fsti b/tests/fstar/misc/External.FunsExternal.fsti index 923a1101..a412aea9 100644 --- a/tests/fstar/misc/External.FunsExternal.fsti +++ b/tests/fstar/misc/External.FunsExternal.fsti @@ -6,26 +6,16 @@ include External.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [core::mem::swap]: forward function +(** [core::mem::swap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) -val core_mem_swap (t : Type0) : t -> t -> state -> result (state & unit) +val core_mem_swap (t : Type0) : t -> t -> state -> result (state & (t & t)) -(** [core::mem::swap]: backward function 0 - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) -val core_mem_swap_back0 - (t : Type0) : t -> t -> state -> state -> result (state & t) - -(** [core::mem::swap]: backward function 1 - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) -val core_mem_swap_back1 - (t : Type0) : t -> t -> state -> state -> result (state & t) - -(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function +(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *) val core_num_nonzero_NonZeroU32_new : u32 -> state -> result (state & (option core_num_nonzero_NonZeroU32_t)) -(** [core::option::{core::option::Option}::unwrap]: forward function +(** [core::option::{core::option::Option}::unwrap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) val core_option_Option_unwrap (t : Type0) : option t -> state -> result (state & t) diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst index d2ac5561..a047c170 100644 --- a/tests/fstar/misc/Loops.Funs.fst +++ b/tests/fstar/misc/Loops.Funs.fst @@ -7,22 +7,22 @@ include Loops.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [loops::sum]: loop 0: forward function +(** [loops::sum]: loop 0: Source: 'src/loops.rs', lines 4:0-14:1 *) let rec sum_loop (max : u32) (i : u32) (s : u32) : Tot (result u32) (decreases (sum_loop_decreases max i s)) = if i < max - then let* s0 = u32_add s i in let* i0 = u32_add i 1 in sum_loop max i0 s0 + then let* s1 = u32_add s i in let* i1 = u32_add i 1 in sum_loop max i1 s1 else u32_mul s 2 -(** [loops::sum]: forward function +(** [loops::sum]: Source: 'src/loops.rs', lines 4:0-4:27 *) let sum (max : u32) : result u32 = sum_loop max 0 0 -(** [loops::sum_with_mut_borrows]: loop 0: forward function +(** [loops::sum_with_mut_borrows]: loop 0: Source: 'src/loops.rs', lines 19:0-31:1 *) let rec sum_with_mut_borrows_loop (max : u32) (mi : u32) (ms : u32) : @@ -30,17 +30,17 @@ let rec sum_with_mut_borrows_loop = if mi < max then - let* ms0 = u32_add ms mi in - let* mi0 = u32_add mi 1 in - sum_with_mut_borrows_loop max mi0 ms0 + let* ms1 = u32_add ms mi in + let* mi1 = u32_add mi 1 in + sum_with_mut_borrows_loop max mi1 ms1 else u32_mul ms 2 -(** [loops::sum_with_mut_borrows]: forward function +(** [loops::sum_with_mut_borrows]: Source: 'src/loops.rs', lines 19:0-19:44 *) let sum_with_mut_borrows (max : u32) : result u32 = sum_with_mut_borrows_loop max 0 0 -(** [loops::sum_with_shared_borrows]: loop 0: forward function +(** [loops::sum_with_shared_borrows]: loop 0: Source: 'src/loops.rs', lines 34:0-48:1 *) let rec sum_with_shared_borrows_loop (max : u32) (i : u32) (s : u32) : @@ -48,40 +48,39 @@ let rec sum_with_shared_borrows_loop = if i < max then - let* i0 = u32_add i 1 in - let* s0 = u32_add s i0 in - sum_with_shared_borrows_loop max i0 s0 + let* i1 = u32_add i 1 in + let* s1 = u32_add s i1 in + sum_with_shared_borrows_loop max i1 s1 else u32_mul s 2 -(** [loops::sum_with_shared_borrows]: forward function +(** [loops::sum_with_shared_borrows]: Source: 'src/loops.rs', lines 34:0-34:47 *) let sum_with_shared_borrows (max : u32) : result u32 = sum_with_shared_borrows_loop max 0 0 -(** [loops::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [loops::clear]: loop 0: Source: 'src/loops.rs', lines 52:0-58:1 *) let rec clear_loop (v : alloc_vec_Vec u32) (i : usize) : Tot (result (alloc_vec_Vec u32)) (decreases (clear_loop_decreases v i)) = - let i0 = alloc_vec_Vec_len u32 v in - if i < i0 + let i1 = alloc_vec_Vec_len u32 v in + if i < i1 then - let* i1 = usize_add i 1 in - let* v0 = - alloc_vec_Vec_index_mut_back u32 usize - (core_slice_index_SliceIndexUsizeSliceTInst u32) v i 0 in - clear_loop v0 i1 + let* (_, index_mut_back) = + alloc_vec_Vec_index_mut u32 usize + (core_slice_index_SliceIndexUsizeSliceTInst u32) v i in + let* i2 = usize_add i 1 in + let* v1 = index_mut_back 0 in + clear_loop v1 i2 else Return v -(** [loops::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [loops::clear]: Source: 'src/loops.rs', lines 52:0-52:30 *) let clear (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) = clear_loop v 0 -(** [loops::list_mem]: loop 0: forward function +(** [loops::list_mem]: loop 0: Source: 'src/loops.rs', lines 66:0-75:1 *) let rec list_mem_loop (x : u32) (ls : list_t u32) : @@ -92,54 +91,41 @@ let rec list_mem_loop | List_Nil -> Return false end -(** [loops::list_mem]: forward function +(** [loops::list_mem]: Source: 'src/loops.rs', lines 66:0-66:52 *) let list_mem (x : u32) (ls : list_t u32) : result bool = list_mem_loop x ls -(** [loops::list_nth_mut_loop]: loop 0: forward function +(** [loops::list_nth_mut_loop]: loop 0: Source: 'src/loops.rs', lines 78:0-88:1 *) let rec list_nth_mut_loop_loop (t : Type0) (ls : list_t t) (i : u32) : - Tot (result t) (decreases (list_nth_mut_loop_loop_decreases t ls i)) + Tot (result (t & (t -> result (list_t t)))) + (decreases (list_nth_mut_loop_loop_decreases t ls i)) = begin match ls with | List_Cons x tl -> if i = 0 - then Return x - else let* i0 = u32_sub i 1 in list_nth_mut_loop_loop t tl i0 - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop]: forward function - Source: 'src/loops.rs', lines 78:0-78:71 *) -let list_nth_mut_loop (t : Type0) (ls : list_t t) (i : u32) : result t = - list_nth_mut_loop_loop t ls i - -(** [loops::list_nth_mut_loop]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 78:0-88:1 *) -let rec list_nth_mut_loop_loop_back - (t : Type0) (ls : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) (decreases (list_nth_mut_loop_loop_decreases t ls i)) - = - begin match ls with - | List_Cons x tl -> - if i = 0 - then Return (List_Cons ret tl) + then let back = fun ret -> Return (List_Cons ret tl) in Return (x, back) else - let* i0 = u32_sub i 1 in - let* tl0 = list_nth_mut_loop_loop_back t tl i0 ret in - Return (List_Cons x tl0) + let* i1 = u32_sub i 1 in + let* (x1, back) = list_nth_mut_loop_loop t tl i1 in + let back1 = fun ret -> let* tl1 = back ret in Return (List_Cons x tl1) in + Return (x1, back1) | List_Nil -> Fail Failure end -(** [loops::list_nth_mut_loop]: backward function 0 +(** [loops::list_nth_mut_loop]: Source: 'src/loops.rs', lines 78:0-78:71 *) -let list_nth_mut_loop_back - (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = - list_nth_mut_loop_loop_back t ls i ret +let list_nth_mut_loop + (t : Type0) (ls : list_t t) (i : u32) : + result (t & (t -> result (list_t t))) + = + let* (x, back) = list_nth_mut_loop_loop t ls i in + let back1 = fun ret -> back ret in + Return (x, back1) -(** [loops::list_nth_shared_loop]: loop 0: forward function +(** [loops::list_nth_shared_loop]: loop 0: Source: 'src/loops.rs', lines 91:0-101:1 *) let rec list_nth_shared_loop_loop (t : Type0) (ls : list_t t) (i : u32) : @@ -149,63 +135,47 @@ let rec list_nth_shared_loop_loop | List_Cons x tl -> if i = 0 then Return x - else let* i0 = u32_sub i 1 in list_nth_shared_loop_loop t tl i0 + else let* i1 = u32_sub i 1 in list_nth_shared_loop_loop t tl i1 | List_Nil -> Fail Failure end -(** [loops::list_nth_shared_loop]: forward function +(** [loops::list_nth_shared_loop]: Source: 'src/loops.rs', lines 91:0-91:66 *) let list_nth_shared_loop (t : Type0) (ls : list_t t) (i : u32) : result t = list_nth_shared_loop_loop t ls i -(** [loops::get_elem_mut]: loop 0: forward function +(** [loops::get_elem_mut]: loop 0: Source: 'src/loops.rs', lines 103:0-117:1 *) let rec get_elem_mut_loop (x : usize) (ls : list_t usize) : - Tot (result usize) (decreases (get_elem_mut_loop_decreases x ls)) - = - begin match ls with - | List_Cons y tl -> if y = x then Return y else get_elem_mut_loop x tl - | List_Nil -> Fail Failure - end - -(** [loops::get_elem_mut]: forward function - Source: 'src/loops.rs', lines 103:0-103:73 *) -let get_elem_mut - (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = - let* l = - alloc_vec_Vec_index_mut (list_t usize) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in - get_elem_mut_loop x l - -(** [loops::get_elem_mut]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 103:0-117:1 *) -let rec get_elem_mut_loop_back - (x : usize) (ls : list_t usize) (ret : usize) : - Tot (result (list_t usize)) (decreases (get_elem_mut_loop_decreases x ls)) + Tot (result (usize & (usize -> result (list_t usize)))) + (decreases (get_elem_mut_loop_decreases x ls)) = begin match ls with | List_Cons y tl -> if y = x - then Return (List_Cons ret tl) - else let* tl0 = get_elem_mut_loop_back x tl ret in Return (List_Cons y tl0) + then let back = fun ret -> Return (List_Cons ret tl) in Return (y, back) + else + let* (i, back) = get_elem_mut_loop x tl in + let back1 = fun ret -> let* tl1 = back ret in Return (List_Cons y tl1) in + Return (i, back1) | List_Nil -> Fail Failure end -(** [loops::get_elem_mut]: backward function 0 +(** [loops::get_elem_mut]: Source: 'src/loops.rs', lines 103:0-103:73 *) -let get_elem_mut_back - (slots : alloc_vec_Vec (list_t usize)) (x : usize) (ret : usize) : - result (alloc_vec_Vec (list_t usize)) +let get_elem_mut + (slots : alloc_vec_Vec (list_t usize)) (x : usize) : + result (usize & (usize -> result (alloc_vec_Vec (list_t usize)))) = - let* l = + let* (l, index_mut_back) = alloc_vec_Vec_index_mut (list_t usize) usize (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in - let* l0 = get_elem_mut_loop_back x l ret in - alloc_vec_Vec_index_mut_back (list_t usize) usize - (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 l0 + let* (i, back) = get_elem_mut_loop x l in + let back1 = fun ret -> let* l1 = back ret in index_mut_back l1 in + Return (i, back1) -(** [loops::get_elem_shared]: loop 0: forward function +(** [loops::get_elem_shared]: loop 0: Source: 'src/loops.rs', lines 119:0-133:1 *) let rec get_elem_shared_loop (x : usize) (ls : list_t usize) : @@ -216,7 +186,7 @@ let rec get_elem_shared_loop | List_Nil -> Fail Failure end -(** [loops::get_elem_shared]: forward function +(** [loops::get_elem_shared]: Source: 'src/loops.rs', lines 119:0-119:68 *) let get_elem_shared (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = @@ -225,69 +195,50 @@ let get_elem_shared (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in get_elem_shared_loop x l -(** [loops::id_mut]: forward function - Source: 'src/loops.rs', lines 135:0-135:50 *) -let id_mut (t : Type0) (ls : list_t t) : result (list_t t) = - Return ls - -(** [loops::id_mut]: backward function 0 +(** [loops::id_mut]: Source: 'src/loops.rs', lines 135:0-135:50 *) -let id_mut_back - (t : Type0) (ls : list_t t) (ret : list_t t) : result (list_t t) = - Return ret +let id_mut + (t : Type0) (ls : list_t t) : + result ((list_t t) & (list_t t -> result (list_t t))) + = + let back = fun ret -> Return ret in Return (ls, back) -(** [loops::id_shared]: forward function +(** [loops::id_shared]: Source: 'src/loops.rs', lines 139:0-139:45 *) let id_shared (t : Type0) (ls : list_t t) : result (list_t t) = Return ls -(** [loops::list_nth_mut_loop_with_id]: loop 0: forward function +(** [loops::list_nth_mut_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 144:0-155:1 *) let rec list_nth_mut_loop_with_id_loop (t : Type0) (i : u32) (ls : list_t t) : - Tot (result t) (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) - = - begin match ls with - | List_Cons x tl -> - if i = 0 - then Return x - else let* i0 = u32_sub i 1 in list_nth_mut_loop_with_id_loop t i0 tl - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_with_id]: forward function - Source: 'src/loops.rs', lines 144:0-144:75 *) -let list_nth_mut_loop_with_id - (t : Type0) (ls : list_t t) (i : u32) : result t = - let* ls0 = id_mut t ls in list_nth_mut_loop_with_id_loop t i ls0 - -(** [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 144:0-155:1 *) -let rec list_nth_mut_loop_with_id_loop_back - (t : Type0) (i : u32) (ls : list_t t) (ret : t) : - Tot (result (list_t t)) + Tot (result (t & (t -> result (list_t t)))) (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) = begin match ls with | List_Cons x tl -> if i = 0 - then Return (List_Cons ret tl) + then let back = fun ret -> Return (List_Cons ret tl) in Return (x, back) else - let* i0 = u32_sub i 1 in - let* tl0 = list_nth_mut_loop_with_id_loop_back t i0 tl ret in - Return (List_Cons x tl0) + let* i1 = u32_sub i 1 in + let* (x1, back) = list_nth_mut_loop_with_id_loop t i1 tl in + let back1 = fun ret -> let* tl1 = back ret in Return (List_Cons x tl1) in + Return (x1, back1) | List_Nil -> Fail Failure end -(** [loops::list_nth_mut_loop_with_id]: backward function 0 +(** [loops::list_nth_mut_loop_with_id]: Source: 'src/loops.rs', lines 144:0-144:75 *) -let list_nth_mut_loop_with_id_back - (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = - let* ls0 = id_mut t ls in - let* l = list_nth_mut_loop_with_id_loop_back t i ls0 ret in - id_mut_back t ls l +let list_nth_mut_loop_with_id + (t : Type0) (ls : list_t t) (i : u32) : + result (t & (t -> result (list_t t))) + = + let* (ls1, id_mut_back) = id_mut t ls in + let* (x, back) = list_nth_mut_loop_with_id_loop t i ls1 in + let back1 = fun ret -> let* l = back ret in id_mut_back l in + Return (x, back1) -(** [loops::list_nth_shared_loop_with_id]: loop 0: forward function +(** [loops::list_nth_shared_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 158:0-169:1 *) let rec list_nth_shared_loop_with_id_loop (t : Type0) (i : u32) (ls : list_t t) : @@ -298,46 +249,21 @@ let rec list_nth_shared_loop_with_id_loop | List_Cons x tl -> if i = 0 then Return x - else let* i0 = u32_sub i 1 in list_nth_shared_loop_with_id_loop t i0 tl + else let* i1 = u32_sub i 1 in list_nth_shared_loop_with_id_loop t i1 tl | List_Nil -> Fail Failure end -(** [loops::list_nth_shared_loop_with_id]: forward function +(** [loops::list_nth_shared_loop_with_id]: Source: 'src/loops.rs', lines 158:0-158:70 *) let list_nth_shared_loop_with_id (t : Type0) (ls : list_t t) (i : u32) : result t = - let* ls0 = id_shared t ls in list_nth_shared_loop_with_id_loop t i ls0 + let* ls1 = id_shared t ls in list_nth_shared_loop_with_id_loop t i ls1 -(** [loops::list_nth_mut_loop_pair]: loop 0: forward function +(** [loops::list_nth_mut_loop_pair]: loop 0: Source: 'src/loops.rs', lines 174:0-195:1 *) let rec list_nth_mut_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_pair]: forward function - Source: 'src/loops.rs', lines 174:0-178:27 *) -let list_nth_mut_loop_pair - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_loop_pair_loop t ls0 ls1 i - -(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 174:0-195:1 *) -let rec list_nth_mut_loop_pair_loop_back'a - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) + Tot (result ((t & t) & (t -> result (list_t t)) & (t -> result (list_t t)))) (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with @@ -345,55 +271,36 @@ let rec list_nth_mut_loop_pair_loop_back'a begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then Return (List_Cons ret tl0) + then + let back_'a = fun ret -> Return (List_Cons ret tl0) in + let back_'b = fun ret -> Return (List_Cons ret tl1) in + Return ((x0, x1), back_'a, back_'b) else - let* i0 = u32_sub i 1 in - let* tl00 = list_nth_mut_loop_pair_loop_back'a t tl0 tl1 i0 ret in - Return (List_Cons x0 tl00) + let* i1 = u32_sub i 1 in + let* (p, back_'a, back_'b) = list_nth_mut_loop_pair_loop t tl0 tl1 i1 + in + let back_'a1 = + fun ret -> let* tl01 = back_'a ret in Return (List_Cons x0 tl01) in + let back_'b1 = + fun ret -> let* tl11 = back_'b ret in Return (List_Cons x1 tl11) in + Return (p, back_'a1, back_'b1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure end -(** [loops::list_nth_mut_loop_pair]: backward function 0 +(** [loops::list_nth_mut_loop_pair]: Source: 'src/loops.rs', lines 174:0-178:27 *) -let list_nth_mut_loop_pair_back'a - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) - = - list_nth_mut_loop_pair_loop_back'a t ls0 ls1 i ret - -(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 1 - Source: 'src/loops.rs', lines 174:0-195:1 *) -let rec list_nth_mut_loop_pair_loop_back'b - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl1) - else - let* i0 = u32_sub i 1 in - let* tl10 = list_nth_mut_loop_pair_loop_back'b t tl0 tl1 i0 ret in - Return (List_Cons x1 tl10) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_pair]: backward function 1 - Source: 'src/loops.rs', lines 174:0-178:27 *) -let list_nth_mut_loop_pair_back'b - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) +let list_nth_mut_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + result ((t & t) & (t -> result (list_t t)) & (t -> result (list_t t))) = - list_nth_mut_loop_pair_loop_back'b t ls0 ls1 i ret + let* (p, back_'a, back_'b) = list_nth_mut_loop_pair_loop t ls0 ls1 i in + let back_'a1 = fun ret -> back_'a ret in + let back_'b1 = fun ret -> back_'b ret in + Return (p, back_'a1, back_'b1) -(** [loops::list_nth_shared_loop_pair]: loop 0: forward function +(** [loops::list_nth_shared_loop_pair]: loop 0: Source: 'src/loops.rs', lines 198:0-219:1 *) let rec list_nth_shared_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : @@ -406,23 +313,23 @@ let rec list_nth_shared_loop_pair_loop | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) - else let* i0 = u32_sub i 1 in list_nth_shared_loop_pair_loop t tl0 tl1 i0 + else let* i1 = u32_sub i 1 in list_nth_shared_loop_pair_loop t tl0 tl1 i1 | List_Nil -> Fail Failure end | List_Nil -> Fail Failure end -(** [loops::list_nth_shared_loop_pair]: forward function +(** [loops::list_nth_shared_loop_pair]: Source: 'src/loops.rs', lines 198:0-202:19 *) let list_nth_shared_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = list_nth_shared_loop_pair_loop t ls0 ls1 i -(** [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function +(** [loops::list_nth_mut_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 223:0-238:1 *) let rec list_nth_mut_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) + Tot (result ((t & t) & ((t & t) -> result ((list_t t) & (list_t t))))) (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with @@ -430,52 +337,35 @@ let rec list_nth_mut_loop_pair_merge_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then Return (x0, x1) + then + let back_'a = + fun ret -> + let (x, x2) = ret in Return (List_Cons x tl0, List_Cons x2 tl1) in + Return ((x0, x1), back_'a) else - let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_merge_loop t tl0 tl1 i0 + let* i1 = u32_sub i 1 in + let* (p, back_'a) = list_nth_mut_loop_pair_merge_loop t tl0 tl1 i1 in + let back_'a1 = + fun ret -> + let* (tl01, tl11) = back_'a ret in + Return (List_Cons x0 tl01, List_Cons x1 tl11) in + Return (p, back_'a1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure end -(** [loops::list_nth_mut_loop_pair_merge]: forward function +(** [loops::list_nth_mut_loop_pair_merge]: Source: 'src/loops.rs', lines 223:0-227:27 *) let list_nth_mut_loop_pair_merge - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_loop_pair_merge_loop t ls0 ls1 i - -(** [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 223:0-238:1 *) -let rec list_nth_mut_loop_pair_merge_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : (t & t)) : - Tot (result ((list_t t) & (list_t t))) - (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then let (x, x2) = ret in Return (List_Cons x tl0, List_Cons x2 tl1) - else - let* i0 = u32_sub i 1 in - let* (tl00, tl10) = - list_nth_mut_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x0 tl00, List_Cons x1 tl10) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_pair_merge]: backward function 0 - Source: 'src/loops.rs', lines 223:0-227:27 *) -let list_nth_mut_loop_pair_merge_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : (t & t)) : - result ((list_t t) & (list_t t)) + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + result ((t & t) & ((t & t) -> result ((list_t t) & (list_t t)))) = - list_nth_mut_loop_pair_merge_loop_back t ls0 ls1 i ret + let* (p, back_'a) = list_nth_mut_loop_pair_merge_loop t ls0 ls1 i in + let back_'a1 = fun ret -> back_'a ret in + Return (p, back_'a1) -(** [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function +(** [loops::list_nth_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 241:0-256:1 *) let rec list_nth_shared_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : @@ -489,24 +379,24 @@ let rec list_nth_shared_loop_pair_merge_loop if i = 0 then Return (x0, x1) else - let* i0 = u32_sub i 1 in - list_nth_shared_loop_pair_merge_loop t tl0 tl1 i0 + let* i1 = u32_sub i 1 in + list_nth_shared_loop_pair_merge_loop t tl0 tl1 i1 | List_Nil -> Fail Failure end | List_Nil -> Fail Failure end -(** [loops::list_nth_shared_loop_pair_merge]: forward function +(** [loops::list_nth_shared_loop_pair_merge]: Source: 'src/loops.rs', lines 241:0-245:19 *) let list_nth_shared_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = list_nth_shared_loop_pair_merge_loop t ls0 ls1 i -(** [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function +(** [loops::list_nth_mut_shared_loop_pair]: loop 0: Source: 'src/loops.rs', lines 259:0-274:1 *) let rec list_nth_mut_shared_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) + Tot (result ((t & t) & (t -> result (list_t t)))) (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with @@ -514,56 +404,35 @@ let rec list_nth_mut_shared_loop_pair_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then Return (x0, x1) + then + let back_'a = fun ret -> Return (List_Cons ret tl0) in + Return ((x0, x1), back_'a) else - let* i0 = u32_sub i 1 in - list_nth_mut_shared_loop_pair_loop t tl0 tl1 i0 + let* i1 = u32_sub i 1 in + let* (p, back_'a) = list_nth_mut_shared_loop_pair_loop t tl0 tl1 i1 in + let back_'a1 = + fun ret -> let* tl01 = back_'a ret in Return (List_Cons x0 tl01) in + Return (p, back_'a1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure end -(** [loops::list_nth_mut_shared_loop_pair]: forward function +(** [loops::list_nth_mut_shared_loop_pair]: Source: 'src/loops.rs', lines 259:0-263:23 *) let list_nth_mut_shared_loop_pair - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_shared_loop_pair_loop t ls0 ls1 i - -(** [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 259:0-274:1 *) -let rec list_nth_mut_shared_loop_pair_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl0) - else - let* i0 = u32_sub i 1 in - let* tl00 = list_nth_mut_shared_loop_pair_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x0 tl00) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_shared_loop_pair]: backward function 0 - Source: 'src/loops.rs', lines 259:0-263:23 *) -let list_nth_mut_shared_loop_pair_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + result ((t & t) & (t -> result (list_t t))) = - list_nth_mut_shared_loop_pair_loop_back t ls0 ls1 i ret + let* (p, back_'a) = list_nth_mut_shared_loop_pair_loop t ls0 ls1 i in + let back_'a1 = fun ret -> back_'a ret in + Return (p, back_'a1) -(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function +(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 278:0-293:1 *) let rec list_nth_mut_shared_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) + Tot (result ((t & t) & (t -> result (list_t t)))) (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with @@ -571,57 +440,36 @@ let rec list_nth_mut_shared_loop_pair_merge_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then Return (x0, x1) + then + let back_'a = fun ret -> Return (List_Cons ret tl0) in + Return ((x0, x1), back_'a) else - let* i0 = u32_sub i 1 in - list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i0 + let* i1 = u32_sub i 1 in + let* (p, back_'a) = + list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i1 in + let back_'a1 = + fun ret -> let* tl01 = back_'a ret in Return (List_Cons x0 tl01) in + Return (p, back_'a1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure end -(** [loops::list_nth_mut_shared_loop_pair_merge]: forward function +(** [loops::list_nth_mut_shared_loop_pair_merge]: Source: 'src/loops.rs', lines 278:0-282:23 *) let list_nth_mut_shared_loop_pair_merge - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i - -(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 278:0-293:1 *) -let rec list_nth_mut_shared_loop_pair_merge_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl0) - else - let* i0 = u32_sub i 1 in - let* tl00 = - list_nth_mut_shared_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x0 tl00) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 - Source: 'src/loops.rs', lines 278:0-282:23 *) -let list_nth_mut_shared_loop_pair_merge_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + result ((t & t) & (t -> result (list_t t))) = - list_nth_mut_shared_loop_pair_merge_loop_back t ls0 ls1 i ret + let* (p, back_'a) = list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i in + let back_'a1 = fun ret -> back_'a ret in + Return (p, back_'a1) -(** [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function +(** [loops::list_nth_shared_mut_loop_pair]: loop 0: Source: 'src/loops.rs', lines 297:0-312:1 *) let rec list_nth_shared_mut_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) + Tot (result ((t & t) & (t -> result (list_t t)))) (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with @@ -629,56 +477,35 @@ let rec list_nth_shared_mut_loop_pair_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then Return (x0, x1) + then + let back_'b = fun ret -> Return (List_Cons ret tl1) in + Return ((x0, x1), back_'b) else - let* i0 = u32_sub i 1 in - list_nth_shared_mut_loop_pair_loop t tl0 tl1 i0 + let* i1 = u32_sub i 1 in + let* (p, back_'b) = list_nth_shared_mut_loop_pair_loop t tl0 tl1 i1 in + let back_'b1 = + fun ret -> let* tl11 = back_'b ret in Return (List_Cons x1 tl11) in + Return (p, back_'b1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure end -(** [loops::list_nth_shared_mut_loop_pair]: forward function +(** [loops::list_nth_shared_mut_loop_pair]: Source: 'src/loops.rs', lines 297:0-301:23 *) let list_nth_shared_mut_loop_pair - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_mut_loop_pair_loop t ls0 ls1 i - -(** [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 - Source: 'src/loops.rs', lines 297:0-312:1 *) -let rec list_nth_shared_mut_loop_pair_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl1) - else - let* i0 = u32_sub i 1 in - let* tl10 = list_nth_shared_mut_loop_pair_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x1 tl10) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_mut_loop_pair]: backward function 1 - Source: 'src/loops.rs', lines 297:0-301:23 *) -let list_nth_shared_mut_loop_pair_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + result ((t & t) & (t -> result (list_t t))) = - list_nth_shared_mut_loop_pair_loop_back t ls0 ls1 i ret + let* (p, back_'b) = list_nth_shared_mut_loop_pair_loop t ls0 ls1 i in + let back_'b1 = fun ret -> back_'b ret in + Return (p, back_'b1) -(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function +(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 316:0-331:1 *) let rec list_nth_shared_mut_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) + Tot (result ((t & t) & (t -> result (list_t t)))) (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with @@ -686,49 +513,28 @@ let rec list_nth_shared_mut_loop_pair_merge_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then Return (x0, x1) + then + let back_'a = fun ret -> Return (List_Cons ret tl1) in + Return ((x0, x1), back_'a) else - let* i0 = u32_sub i 1 in - list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i0 + let* i1 = u32_sub i 1 in + let* (p, back_'a) = + list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i1 in + let back_'a1 = + fun ret -> let* tl11 = back_'a ret in Return (List_Cons x1 tl11) in + Return (p, back_'a1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure end -(** [loops::list_nth_shared_mut_loop_pair_merge]: forward function +(** [loops::list_nth_shared_mut_loop_pair_merge]: Source: 'src/loops.rs', lines 316:0-320:23 *) let list_nth_shared_mut_loop_pair_merge - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i - -(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 316:0-331:1 *) -let rec list_nth_shared_mut_loop_pair_merge_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl1) - else - let* i0 = u32_sub i 1 in - let* tl10 = - list_nth_shared_mut_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x1 tl10) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 - Source: 'src/loops.rs', lines 316:0-320:23 *) -let list_nth_shared_mut_loop_pair_merge_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + result ((t & t) & (t -> result (list_t t))) = - list_nth_shared_mut_loop_pair_merge_loop_back t ls0 ls1 i ret + let* (p, back_'a) = list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i in + let back_'a1 = fun ret -> back_'a ret in + Return (p, back_'a1) diff --git a/tests/fstar/misc/Paper.fst b/tests/fstar/misc/Paper.fst index 14bc59e8..c6082929 100644 --- a/tests/fstar/misc/Paper.fst +++ b/tests/fstar/misc/Paper.fst @@ -5,40 +5,36 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" -(** [paper::ref_incr]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [paper::ref_incr]: Source: 'src/paper.rs', lines 4:0-4:28 *) let ref_incr (x : i32) : result i32 = i32_add x 1 -(** [paper::test_incr]: forward function +(** [paper::test_incr]: Source: 'src/paper.rs', lines 8:0-8:18 *) let test_incr : result unit = - let* x = ref_incr 0 in if not (x = 1) then Fail Failure else Return () + let* i = ref_incr 0 in if not (i = 1) then Fail Failure else Return () (** Unit test for [paper::test_incr] *) let _ = assert_norm (test_incr = Return ()) -(** [paper::choose]: forward function +(** [paper::choose]: Source: 'src/paper.rs', lines 15:0-15:70 *) -let choose (t : Type0) (b : bool) (x : t) (y : t) : result t = - if b then Return x else Return y +let choose + (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = + if b + then let back_'a = fun ret -> Return (ret, y) in Return (x, back_'a) + else let back_'a = fun ret -> Return (x, ret) in Return (y, back_'a) -(** [paper::choose]: backward function 0 - Source: 'src/paper.rs', lines 15:0-15:70 *) -let choose_back - (t : Type0) (b : bool) (x : t) (y : t) (ret : t) : result (t & t) = - if b then Return (ret, y) else Return (x, ret) - -(** [paper::test_choose]: forward function +(** [paper::test_choose]: Source: 'src/paper.rs', lines 23:0-23:20 *) let test_choose : result unit = - let* z = choose i32 true 0 0 in - let* z0 = i32_add z 1 in - if not (z0 = 1) + let* (z, choose_back) = choose i32 true 0 0 in + let* z1 = i32_add z 1 in + if not (z1 = 1) then Fail Failure else - let* (x, y) = choose_back i32 true 0 0 z0 in + let* (x, y) = choose_back z1 in if not (x = 1) then Fail Failure else if not (y = 0) then Fail Failure else Return () @@ -52,31 +48,28 @@ type list_t (t : Type0) = | List_Cons : t -> list_t t -> list_t t | List_Nil : list_t t -(** [paper::list_nth_mut]: forward function - Source: 'src/paper.rs', lines 42:0-42:67 *) -let rec list_nth_mut (t : Type0) (l : list_t t) (i : u32) : result t = - begin match l with - | List_Cons x tl -> - if i = 0 then Return x else let* i0 = u32_sub i 1 in list_nth_mut t tl i0 - | List_Nil -> Fail Failure - end - -(** [paper::list_nth_mut]: backward function 0 +(** [paper::list_nth_mut]: Source: 'src/paper.rs', lines 42:0-42:67 *) -let rec list_nth_mut_back - (t : Type0) (l : list_t t) (i : u32) (ret : t) : result (list_t t) = +let rec list_nth_mut + (t : Type0) (l : list_t t) (i : u32) : + result (t & (t -> result (list_t t))) + = begin match l with | List_Cons x tl -> if i = 0 - then Return (List_Cons ret tl) + then + let back_'a = fun ret -> Return (List_Cons ret tl) in Return (x, back_'a) else - let* i0 = u32_sub i 1 in - let* tl0 = list_nth_mut_back t tl i0 ret in - Return (List_Cons x tl0) + let* i1 = u32_sub i 1 in + let* (x1, list_nth_mut_back) = list_nth_mut t tl i1 in + let back_'a = + fun ret -> let* tl1 = list_nth_mut_back ret in Return (List_Cons x tl1) + in + Return (x1, back_'a) | List_Nil -> Fail Failure end -(** [paper::sum]: forward function +(** [paper::sum]: Source: 'src/paper.rs', lines 57:0-57:32 *) let rec sum (l : list_t i32) : result i32 = begin match l with @@ -84,27 +77,27 @@ let rec sum (l : list_t i32) : result i32 = | List_Nil -> Return 0 end -(** [paper::test_nth]: forward function +(** [paper::test_nth]: Source: 'src/paper.rs', lines 68:0-68:17 *) let test_nth : result unit = let l = List_Nil in - let l0 = List_Cons 3 l in - let l1 = List_Cons 2 l0 in - let* x = list_nth_mut i32 (List_Cons 1 l1) 2 in - let* x0 = i32_add x 1 in - let* l2 = list_nth_mut_back i32 (List_Cons 1 l1) 2 x0 in - let* i = sum l2 in + let l1 = List_Cons 3 l in + let l2 = List_Cons 2 l1 in + let* (x, list_nth_mut_back) = list_nth_mut i32 (List_Cons 1 l2) 2 in + let* x1 = i32_add x 1 in + let* l3 = list_nth_mut_back x1 in + let* i = sum l3 in if not (i = 7) then Fail Failure else Return () (** Unit test for [paper::test_nth] *) let _ = assert_norm (test_nth = Return ()) -(** [paper::call_choose]: forward function +(** [paper::call_choose]: Source: 'src/paper.rs', lines 76:0-76:44 *) let call_choose (p : (u32 & u32)) : result u32 = let (px, py) = p in - let* pz = choose u32 true px py in - let* pz0 = u32_add pz 1 in - let* (px0, _) = choose_back u32 true px py pz0 in - Return px0 + let* (pz, choose_back) = choose u32 true px py in + let* pz1 = u32_add pz 1 in + let* (px1, _) = choose_back pz1 in + Return px1 diff --git a/tests/fstar/misc/PoloniusList.fst b/tests/fstar/misc/PoloniusList.fst index 188b22d8..cbe7d6b8 100644 --- a/tests/fstar/misc/PoloniusList.fst +++ b/tests/fstar/misc/PoloniusList.fst @@ -11,24 +11,24 @@ type list_t (t : Type0) = | List_Cons : t -> list_t t -> list_t t | List_Nil : list_t t -(** [polonius_list::get_list_at_x]: forward function +(** [polonius_list::get_list_at_x]: Source: 'src/polonius_list.rs', lines 13:0-13:76 *) -let rec get_list_at_x (ls : list_t u32) (x : u32) : result (list_t u32) = - begin match ls with - | List_Cons hd tl -> - if hd = x then Return (List_Cons hd tl) else get_list_at_x tl x - | List_Nil -> Return List_Nil - end - -(** [polonius_list::get_list_at_x]: backward function 0 - Source: 'src/polonius_list.rs', lines 13:0-13:76 *) -let rec get_list_at_x_back - (ls : list_t u32) (x : u32) (ret : list_t u32) : result (list_t u32) = +let rec get_list_at_x + (ls : list_t u32) (x : u32) : + result ((list_t u32) & (list_t u32 -> result (list_t u32))) + = begin match ls with | List_Cons hd tl -> if hd = x - then Return ret - else let* tl0 = get_list_at_x_back tl x ret in Return (List_Cons hd tl0) - | List_Nil -> Return ret + then + let back_'a = fun ret -> Return ret in Return (List_Cons hd tl, back_'a) + else + let* (l, get_list_at_x_back) = get_list_at_x tl x in + let back_'a = + fun ret -> + let* tl1 = get_list_at_x_back ret in Return (List_Cons hd tl1) in + Return (l, back_'a) + | List_Nil -> + let back_'a = fun ret -> Return ret in Return (List_Nil, back_'a) end diff --git a/tests/fstar/misc/Primitives.fst b/tests/fstar/misc/Primitives.fst index 6b8dbeb7..fca80829 100644 --- a/tests/fstar/misc/Primitives.fst +++ b/tests/fstar/misc/Primitives.fst @@ -55,7 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a & (a -> a) = (x, (fun x -> x)) +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -531,10 +531,18 @@ let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : resu if i < length x then Return (index x i) else Fail Failure -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : + result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure +let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : + result (a & (a -> result (array a n))) = + match array_index_usize a n x i with + | Fail e -> Fail e + | Return v -> + Return (v, array_update_usize a n x i) + (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -548,6 +556,13 @@ let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result ( if i < length x then Return (list_update x i nx) else Fail Failure +let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : + result (a & (a -> result (slice a))) = + match slice_index_usize a s i with + | Fail e -> Fail e + | Return x -> + Return (x, slice_update_usize a s i) + (*** Subslices *) let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x @@ -555,6 +570,10 @@ let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : res if length s = n then Return s else Fail Failure +let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : + result (slice a & (slice a -> result (array a n))) = + Return (x, array_from_slice a n x) + // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() diff --git a/tests/fstar/traits/Primitives.fst b/tests/fstar/traits/Primitives.fst index a3ffbde4..fca80829 100644 --- a/tests/fstar/traits/Primitives.fst +++ b/tests/fstar/traits/Primitives.fst @@ -55,8 +55,7 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let core_mem_replace (a : Type0) (x : a) (y : a) : a = x -let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -477,8 +476,7 @@ noeq type core_ops_index_Index (self idx : Type0) = { // Trait declaration: [core::ops::index::IndexMut] noeq type core_ops_index_IndexMut (self idx : Type0) = { indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result indexInst.output; - index_mut_back : self → idx → indexInst.output → result self; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); } // Trait declaration [core::ops::deref::Deref] @@ -490,8 +488,7 @@ noeq type core_ops_deref_Deref (self : Type0) = { // Trait declaration [core::ops::deref::DerefMut] noeq type core_ops_deref_DerefMut (self : Type0) = { derefInst : core_ops_deref_Deref self; - deref_mut : self → result derefInst.target; - deref_mut_back : self → derefInst.target → result self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); } type core_ops_range_Range (a : Type0) = { @@ -502,8 +499,8 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x -let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = + Return (x, (fun x -> Return x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -515,7 +512,6 @@ let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { derefInst = alloc_boxed_Box_coreopsDerefInst self; deref_mut = alloc_boxed_Box_deref_mut self; - deref_mut_back = alloc_boxed_Box_deref_mut_back self; } (*** Array *) @@ -535,10 +531,18 @@ let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : resu if i < length x then Return (index x i) else Fail Failure -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : + result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure +let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : + result (a & (a -> result (array a n))) = + match array_index_usize a n x i with + | Fail e -> Fail e + | Return v -> + Return (v, array_update_usize a n x i) + (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -552,6 +556,13 @@ let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result ( if i < length x then Return (list_update x i nx) else Fail Failure +let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : + result (a & (a -> result (slice a))) = + match slice_index_usize a s i with + | Fail e -> Fail e + | Return x -> + Return (x, slice_update_usize a s i) + (*** Subslices *) let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x @@ -559,6 +570,10 @@ let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : res if length s = n then Return s else Fail Failure +let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : + result (slice a & (slice a -> result (array a n))) = + Return (x, array_from_slice a n x) + // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() @@ -588,8 +603,13 @@ let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : r let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () +let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : + result (a & (a → result (alloc_vec_Vec a))) = + match alloc_vec_Vec_index_usize v i with + | Return x -> + Return (x, alloc_vec_Vec_update_usize v i) + | Fail e -> Fail e + let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : Pure (result (alloc_vec_Vec a)) (requires True) @@ -605,9 +625,6 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : end else Fail Failure -// The **forward** function shouldn't be used -let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = if i < length v then Return (list_update v i x) else Fail Failure @@ -619,13 +636,11 @@ noeq type core_slice_index_SliceIndex (self t : Type0) = { sealedInst : core_slice_index_private_slice_index_Sealed self; output : Type0; get : self → t → result (option output); - get_mut : self → t → result (option output); - get_mut_back : self → t → option output → result t; + get_mut : self → t → result (option output & (option output -> result t)); get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); index : self → t → result output; - index_mut : self → t → result output; - index_mut_back : self → t → output → result t; + index_mut : self → t → result (output & (output -> result t)); } // [core::slice::index::[T]::index]: forward function @@ -643,14 +658,8 @@ let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) admit () // TODO // [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_RangeUsize_get_mut_back - (t : Type0) : - core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = admit () // TODO // [core::slice::index::Range::get_unchecked]: forward function @@ -675,27 +684,16 @@ let core_slice_index_RangeUsize_index admit () // TODO // [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_RangeUsize_index_mut_back - (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = admit () // TODO // [core::slice::index::[T]::index_mut]: forward function let core_slice_index_Slice_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result inst.output = + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = admit () // -// [core::slice::index::[T]::index_mut]: backward function 0 -let core_slice_index_Slice_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → inst.output → result (slice t) = - admit () // TODO - // [core::array::[T; N]::index]: forward function let core_array_Array_index (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) @@ -705,13 +703,8 @@ let core_array_Array_index // [core::array::[T; N]::index_mut]: forward function let core_array_Array_index_mut (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : result inst.indexInst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: backward function 0 -let core_array_Array_index_mut_back - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::Range] @@ -725,12 +718,10 @@ let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : output = slice t; get = core_slice_index_RangeUsize_get t; get_mut = core_slice_index_RangeUsize_get_mut t; - get_mut_back = core_slice_index_RangeUsize_get_mut_back t; get_unchecked = core_slice_index_RangeUsize_get_unchecked t; get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; index = core_slice_index_RangeUsize_index t; index_mut = core_slice_index_RangeUsize_index_mut t; - index_mut_back = core_slice_index_RangeUsize_index_mut_back t; } // Trait implementation: [core::slice::index::[T]] @@ -747,7 +738,6 @@ let core_ops_index_IndexMutSliceTIInst (t idx : Type0) core_ops_index_IndexMut (slice t) idx = { indexInst = core_ops_index_IndexSliceTIInst t idx inst; index_mut = core_slice_index_Slice_index_mut t idx inst; - index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; } // Trait implementation: [core::array::[T; N]] @@ -764,7 +754,6 @@ let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) core_ops_index_IndexMut (array t n) idx = { indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; index_mut = core_array_Array_index_mut t idx n inst; - index_mut_back = core_array_Array_index_mut_back t idx n inst; } // [core::slice::index::usize::get]: forward function @@ -773,13 +762,8 @@ let core_slice_index_usize_get admit () // TODO // [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: backward function 0 -let core_slice_index_usize_get_mut_back - (t : Type0) : usize → slice t → option t → result (slice t) = +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = admit () // TODO // [core::slice::index::usize::get_unchecked]: forward function @@ -797,12 +781,8 @@ let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = admit () // TODO // [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: backward function 0 -let core_slice_index_usize_index_mut_back - (t : Type0) : usize → slice t → t → result (slice t) = +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::usize] @@ -816,12 +796,10 @@ let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : output = t; get = core_slice_index_usize_get t; get_mut = core_slice_index_usize_get_mut t; - get_mut_back = core_slice_index_usize_get_mut_back t; get_unchecked = core_slice_index_usize_get_unchecked t; get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; index = core_slice_index_usize_index t; index_mut = core_slice_index_usize_index_mut t; - index_mut_back = core_slice_index_usize_index_mut_back t; } // [alloc::vec::Vec::index]: forward function @@ -831,13 +809,8 @@ let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx // [alloc::vec::Vec::index_mut]: forward function let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: backward function 0 -let alloc_vec_Vec_index_mut_back - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = admit () // TODO // Trait implementation: [alloc::vec::Vec] @@ -854,7 +827,6 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) core_ops_index_IndexMut (alloc_vec_Vec t) idx = { indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; index_mut = alloc_vec_Vec_index_mut t idx inst; - index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } (*** Theorems *) @@ -870,15 +842,7 @@ let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : Lemma ( alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) + alloc_vec_Vec_index_mut_usize v i) [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] = admit() - -let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : - Lemma ( - alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x == - alloc_vec_Vec_update_usize v i x) - [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] - = - admit() diff --git a/tests/fstar/traits/Traits.fst b/tests/fstar/traits/Traits.fst index 7d504cb5..3543bd73 100644 --- a/tests/fstar/traits/Traits.fst +++ b/tests/fstar/traits/Traits.fst @@ -9,7 +9,7 @@ open Primitives Source: 'src/traits.rs', lines 1:0-1:19 *) noeq type boolTrait_t (self : Type0) = { get_bool : self -> result bool; } -(** [traits::{bool}::get_bool]: forward function +(** [traits::{bool}::get_bool]: Source: 'src/traits.rs', lines 12:4-12:30 *) let bool_get_bool (self : bool) : result bool = Return self @@ -18,24 +18,24 @@ let bool_get_bool (self : bool) : result bool = Source: 'src/traits.rs', lines 11:0-11:23 *) let traits_BoolTraitBoolInst : boolTrait_t bool = { get_bool = bool_get_bool; } -(** [traits::BoolTrait::ret_true]: forward function +(** [traits::BoolTrait::ret_true]: Source: 'src/traits.rs', lines 6:4-6:30 *) let boolTrait_ret_true - (#self : Type0) (self_clause : boolTrait_t self) (self0 : self) : + (#self : Type0) (self_clause : boolTrait_t self) (self1 : self) : result bool = Return true -(** [traits::test_bool_trait_bool]: forward function +(** [traits::test_bool_trait_bool]: Source: 'src/traits.rs', lines 17:0-17:44 *) let test_bool_trait_bool (x : bool) : result bool = let* b = bool_get_bool x in if b then boolTrait_ret_true traits_BoolTraitBoolInst x else Return false -(** [traits::{core::option::Option#1}::get_bool]: forward function +(** [traits::{core::option::Option#1}::get_bool]: Source: 'src/traits.rs', lines 23:4-23:30 *) let option_get_bool (t : Type0) (self : option t) : result bool = - begin match self with | None -> Return false | Some x -> Return true end + begin match self with | None -> Return false | Some _ -> Return true end (** Trait implementation: [traits::{core::option::Option#1}] Source: 'src/traits.rs', lines 22:0-22:31 *) @@ -44,7 +44,7 @@ let traits_BoolTraitcoreoptionOptionTInst (t : Type0) : boolTrait_t (option t) get_bool = option_get_bool t; } -(** [traits::test_bool_trait_option]: forward function +(** [traits::test_bool_trait_option]: Source: 'src/traits.rs', lines 31:0-31:54 *) let test_bool_trait_option (t : Type0) (x : option t) : result bool = let* b = option_get_bool t x in @@ -52,7 +52,7 @@ let test_bool_trait_option (t : Type0) (x : option t) : result bool = then boolTrait_ret_true (traits_BoolTraitcoreoptionOptionTInst t) x else Return false -(** [traits::test_bool_trait]: forward function +(** [traits::test_bool_trait]: Source: 'src/traits.rs', lines 35:0-35:50 *) let test_bool_trait (t : Type0) (boolTraitTInst : boolTrait_t t) (x : t) : result bool = @@ -62,7 +62,7 @@ let test_bool_trait Source: 'src/traits.rs', lines 39:0-39:15 *) noeq type toU64_t (self : Type0) = { to_u64 : self -> result u64; } -(** [traits::{u64#2}::to_u64]: forward function +(** [traits::{u64#2}::to_u64]: Source: 'src/traits.rs', lines 44:4-44:26 *) let u64_to_u64 (self : u64) : result u64 = Return self @@ -71,14 +71,14 @@ let u64_to_u64 (self : u64) : result u64 = Source: 'src/traits.rs', lines 43:0-43:18 *) let traits_ToU64U64Inst : toU64_t u64 = { to_u64 = u64_to_u64; } -(** [traits::{(A, A)#3}::to_u64]: forward function +(** [traits::{(A, A)#3}::to_u64]: Source: 'src/traits.rs', lines 50:4-50:26 *) let pair_to_u64 (a : Type0) (toU64AInst : toU64_t a) (self : (a & a)) : result u64 = - let (x, x0) = self in + let (x, x1) = self in let* i = toU64AInst.to_u64 x in - let* i0 = toU64AInst.to_u64 x0 in - u64_add i i0 + let* i1 = toU64AInst.to_u64 x1 in + u64_add i i1 (** Trait implementation: [traits::{(A, A)#3}] Source: 'src/traits.rs', lines 49:0-49:31 *) @@ -87,18 +87,18 @@ let traits_ToU64TupleAAInst (a : Type0) (toU64AInst : toU64_t a) : toU64_t (a & to_u64 = pair_to_u64 a toU64AInst; } -(** [traits::f]: forward function +(** [traits::f]: Source: 'src/traits.rs', lines 55:0-55:36 *) let f (t : Type0) (toU64TInst : toU64_t t) (x : (t & t)) : result u64 = pair_to_u64 t toU64TInst x -(** [traits::g]: forward function +(** [traits::g]: Source: 'src/traits.rs', lines 59:0-61:18 *) let g (t : Type0) (toU64TupleTTInst : toU64_t (t & t)) (x : (t & t)) : result u64 = toU64TupleTTInst.to_u64 x -(** [traits::h0]: forward function +(** [traits::h0]: Source: 'src/traits.rs', lines 66:0-66:24 *) let h0 (x : u64) : result u64 = u64_to_u64 x @@ -107,7 +107,7 @@ let h0 (x : u64) : result u64 = Source: 'src/traits.rs', lines 70:0-70:21 *) type wrapper_t (t : Type0) = { x : t; } -(** [traits::{traits::Wrapper#4}::to_u64]: forward function +(** [traits::{traits::Wrapper#4}::to_u64]: Source: 'src/traits.rs', lines 75:4-75:26 *) let wrapper_to_u64 (t : Type0) (toU64TInst : toU64_t t) (self : wrapper_t t) : result u64 = @@ -120,12 +120,12 @@ let traits_ToU64traitsWrapperTInst (t : Type0) (toU64TInst : toU64_t t) : to_u64 = wrapper_to_u64 t toU64TInst; } -(** [traits::h1]: forward function +(** [traits::h1]: Source: 'src/traits.rs', lines 80:0-80:33 *) let h1 (x : wrapper_t u64) : result u64 = wrapper_to_u64 u64 traits_ToU64U64Inst x -(** [traits::h2]: forward function +(** [traits::h2]: Source: 'src/traits.rs', lines 84:0-84:41 *) let h2 (t : Type0) (toU64TInst : toU64_t t) (x : wrapper_t t) : result u64 = wrapper_to_u64 t toU64TInst x @@ -134,7 +134,7 @@ let h2 (t : Type0) (toU64TInst : toU64_t t) (x : wrapper_t t) : result u64 = Source: 'src/traits.rs', lines 88:0-88:19 *) noeq type toType_t (self t : Type0) = { to_type : self -> result t; } -(** [traits::{u64#5}::to_type]: forward function +(** [traits::{u64#5}::to_type]: Source: 'src/traits.rs', lines 93:4-93:28 *) let u64_to_type (self : u64) : result bool = Return (self > 0) @@ -150,7 +150,7 @@ noeq type ofType_t (self : Type0) = { self; } -(** [traits::h3]: forward function +(** [traits::h3]: Source: 'src/traits.rs', lines 104:0-104:50 *) let h3 (t1 t2 : Type0) (ofTypeT1Inst : ofType_t t1) (toTypeT2T1Inst : toType_t t2 @@ -166,7 +166,7 @@ noeq type ofTypeBis_t (self t : Type0) = { of_type : t -> result self; } -(** [traits::h4]: forward function +(** [traits::h4]: Source: 'src/traits.rs', lines 118:0-118:57 *) let h4 (t1 t2 : Type0) (ofTypeBisT1T2Inst : ofTypeBis_t t1 t2) (toTypeT2T1Inst : @@ -189,7 +189,7 @@ noeq type testType_test_TestTrait_t (self : Type0) = { test : self -> result bool; } -(** [traits::{traits::TestType#6}::test::{traits::{traits::TestType#6}::test::TestType1}::test]: forward function +(** [traits::{traits::TestType#6}::test::{traits::{traits::TestType#6}::test::TestType1}::test]: Source: 'src/traits.rs', lines 139:12-139:34 *) let testType_test_TestType1_test (self : testType_test_TestType1_t) : result bool = @@ -202,20 +202,20 @@ let traits_TestType_test_TestTraittraitstraitsTestTypeTtestTestType1Inst : test = testType_test_TestType1_test; } -(** [traits::{traits::TestType#6}::test]: forward function +(** [traits::{traits::TestType#6}::test]: Source: 'src/traits.rs', lines 126:4-126:36 *) let testType_test (t : Type0) (toU64TInst : toU64_t t) (self : testType_t t) (x : t) : result bool = - let* x0 = toU64TInst.to_u64 x in - if x0 > 0 then testType_test_TestType1_test 0 else Return false + let* x1 = toU64TInst.to_u64 x in + if x1 > 0 then testType_test_TestType1_test 0 else Return false (** [traits::BoolWrapper] Source: 'src/traits.rs', lines 150:0-150:22 *) type boolWrapper_t = bool -(** [traits::{traits::BoolWrapper#7}::to_type]: forward function +(** [traits::{traits::BoolWrapper#7}::to_type]: Source: 'src/traits.rs', lines 156:4-156:25 *) let boolWrapper_to_type (t : Type0) (toTypeBoolTInst : toType_t bool t) (self : boolWrapper_t) : @@ -251,8 +251,7 @@ noeq type withConstTy_t (self : Type0) (len : usize) = { let bool_len1_body : result usize = Return 12 let bool_len1_c : usize = eval_global bool_len1_body -(** [traits::{bool#8}::f]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +(** [traits::{bool#8}::f]: Source: 'src/traits.rs', lines 180:4-180:39 *) let bool_f (i : u64) (a : array u8 32) : result u64 = Return i @@ -268,7 +267,7 @@ let traits_WithConstTyBool32Inst : withConstTy_t bool 32 = { f = bool_f; } -(** [traits::use_with_const_ty1]: forward function +(** [traits::use_with_const_ty1]: Source: 'src/traits.rs', lines 183:0-183:75 *) let use_with_const_ty1 (h : Type0) (len : usize) (withConstTyHLENInst : withConstTy_t h len) : @@ -276,7 +275,7 @@ let use_with_const_ty1 = let i = withConstTyHLENInst.cLEN1 in Return i -(** [traits::use_with_const_ty2]: forward function +(** [traits::use_with_const_ty2]: Source: 'src/traits.rs', lines 187:0-187:73 *) let use_with_const_ty2 (h : Type0) (len : usize) (withConstTyHLENInst : withConstTy_t h len) @@ -285,7 +284,7 @@ let use_with_const_ty2 = Return () -(** [traits::use_with_const_ty3]: forward function +(** [traits::use_with_const_ty3]: Source: 'src/traits.rs', lines 189:0-189:80 *) let use_with_const_ty3 (h : Type0) (len : usize) (withConstTyHLENInst : withConstTy_t h len) @@ -294,12 +293,12 @@ let use_with_const_ty3 = withConstTyHLENInst.tW_clause_0.to_u64 x -(** [traits::test_where1]: forward function +(** [traits::test_where1]: Source: 'src/traits.rs', lines 193:0-193:40 *) let test_where1 (t : Type0) (_x : t) : result unit = Return () -(** [traits::test_where2]: forward function +(** [traits::test_where2]: Source: 'src/traits.rs', lines 194:0-194:57 *) let test_where2 (t : Type0) (withConstTyT32Inst : withConstTy_t t 32) (_x : u32) : @@ -326,22 +325,30 @@ noeq type childTrait_t (self : Type0) = { parentTrait1SelfInst : parentTrait1_t self; } -(** [traits::test_child_trait1]: forward function - Source: 'src/traits.rs', lines 209:0-209:56 *) +(** [traits::test_parent_trait0]: + Source: 'src/traits.rs', lines 208:0-208:57 *) +let test_parent_trait0 + (t : Type0) (parentTrait0TInst : parentTrait0_t t) (x : t) : + result parentTrait0TInst.tW + = + parentTrait0TInst.get_w x + +(** [traits::test_child_trait1]: + Source: 'src/traits.rs', lines 213:0-213:56 *) let test_child_trait1 (t : Type0) (childTraitTInst : childTrait_t t) (x : t) : result string = childTraitTInst.parentTrait0SelfInst.get_name x -(** [traits::test_child_trait2]: forward function - Source: 'src/traits.rs', lines 213:0-213:54 *) +(** [traits::test_child_trait2]: + Source: 'src/traits.rs', lines 217:0-217:54 *) let test_child_trait2 (t : Type0) (childTraitTInst : childTrait_t t) (x : t) : result childTraitTInst.parentTrait0SelfInst.tW = childTraitTInst.parentTrait0SelfInst.get_w x -(** [traits::order1]: forward function - Source: 'src/traits.rs', lines 219:0-219:59 *) +(** [traits::order1]: + Source: 'src/traits.rs', lines 223:0-223:59 *) let order1 (t u : Type0) (parentTrait0TInst : parentTrait0_t t) (parentTrait0UInst : parentTrait0_t u) : @@ -350,27 +357,27 @@ let order1 Return () (** Trait declaration: [traits::ChildTrait1] - Source: 'src/traits.rs', lines 222:0-222:35 *) + Source: 'src/traits.rs', lines 226:0-226:35 *) noeq type childTrait1_t (self : Type0) = { parentTrait1SelfInst : parentTrait1_t self; } (** Trait implementation: [traits::{usize#9}] - Source: 'src/traits.rs', lines 224:0-224:27 *) + Source: 'src/traits.rs', lines 228:0-228:27 *) let traits_ParentTrait1UsizeInst : parentTrait1_t usize = () (** Trait implementation: [traits::{usize#10}] - Source: 'src/traits.rs', lines 225:0-225:26 *) + Source: 'src/traits.rs', lines 229:0-229:26 *) let traits_ChildTrait1UsizeInst : childTrait1_t usize = { parentTrait1SelfInst = traits_ParentTrait1UsizeInst; } (** Trait declaration: [traits::Iterator] - Source: 'src/traits.rs', lines 229:0-229:18 *) + Source: 'src/traits.rs', lines 233:0-233:18 *) noeq type iterator_t (self : Type0) = { tItem : Type0; } (** Trait declaration: [traits::IntoIterator] - Source: 'src/traits.rs', lines 233:0-233:22 *) + Source: 'src/traits.rs', lines 237:0-237:22 *) noeq type intoIterator_t (self : Type0) = { tItem : Type0; tIntoIter : Type0; @@ -379,29 +386,29 @@ noeq type intoIterator_t (self : Type0) = { } (** Trait declaration: [traits::FromResidual] - Source: 'src/traits.rs', lines 250:0-250:21 *) + Source: 'src/traits.rs', lines 254:0-254:21 *) type fromResidual_t (self t : Type0) = unit (** Trait declaration: [traits::Try] - Source: 'src/traits.rs', lines 246:0-246:48 *) + Source: 'src/traits.rs', lines 250:0-250:48 *) noeq type try_t (self : Type0) = { tResidual : Type0; fromResidualSelftraitsTrySelfResidualInst : fromResidual_t self tResidual; } (** Trait declaration: [traits::WithTarget] - Source: 'src/traits.rs', lines 252:0-252:20 *) + Source: 'src/traits.rs', lines 256:0-256:20 *) noeq type withTarget_t (self : Type0) = { tTarget : Type0; } (** Trait declaration: [traits::ParentTrait2] - Source: 'src/traits.rs', lines 256:0-256:22 *) + Source: 'src/traits.rs', lines 260:0-260:22 *) noeq type parentTrait2_t (self : Type0) = { tU : Type0; tU_clause_0 : withTarget_t tU; } (** Trait declaration: [traits::ChildTrait2] - Source: 'src/traits.rs', lines 260:0-260:35 *) + Source: 'src/traits.rs', lines 264:0-264:35 *) noeq type childTrait2_t (self : Type0) = { parentTrait2SelfInst : parentTrait2_t self; convert : parentTrait2SelfInst.tU -> result @@ -409,48 +416,59 @@ noeq type childTrait2_t (self : Type0) = { } (** Trait implementation: [traits::{u32#11}] - Source: 'src/traits.rs', lines 264:0-264:23 *) + Source: 'src/traits.rs', lines 268:0-268:23 *) let traits_WithTargetU32Inst : withTarget_t u32 = { tTarget = u32; } (** Trait implementation: [traits::{u32#12}] - Source: 'src/traits.rs', lines 268:0-268:25 *) + Source: 'src/traits.rs', lines 272:0-272:25 *) let traits_ParentTrait2U32Inst : parentTrait2_t u32 = { tU = u32; tU_clause_0 = traits_WithTargetU32Inst; } -(** [traits::{u32#13}::convert]: forward function - Source: 'src/traits.rs', lines 273:4-273:29 *) +(** [traits::{u32#13}::convert]: + Source: 'src/traits.rs', lines 277:4-277:29 *) let u32_convert (x : u32) : result u32 = Return x (** Trait implementation: [traits::{u32#13}] - Source: 'src/traits.rs', lines 272:0-272:24 *) + Source: 'src/traits.rs', lines 276:0-276:24 *) let traits_ChildTrait2U32Inst : childTrait2_t u32 = { parentTrait2SelfInst = traits_ParentTrait2U32Inst; convert = u32_convert; } (** Trait declaration: [traits::CFnOnce] - Source: 'src/traits.rs', lines 286:0-286:23 *) + Source: 'src/traits.rs', lines 290:0-290:23 *) noeq type cFnOnce_t (self args : Type0) = { tOutput : Type0; call_once : self -> args -> result tOutput; } (** Trait declaration: [traits::CFnMut] - Source: 'src/traits.rs', lines 292:0-292:37 *) + Source: 'src/traits.rs', lines 296:0-296:37 *) noeq type cFnMut_t (self args : Type0) = { cFnOnceSelfArgsInst : cFnOnce_t self args; - call_mut : self -> args -> result cFnOnceSelfArgsInst.tOutput; - call_mut_back : self -> args -> cFnOnceSelfArgsInst.tOutput -> result self; + call_mut : self -> args -> result (cFnOnceSelfArgsInst.tOutput & self); } (** Trait declaration: [traits::CFn] - Source: 'src/traits.rs', lines 296:0-296:33 *) + Source: 'src/traits.rs', lines 300:0-300:33 *) noeq type cFn_t (self args : Type0) = { cFnMutSelfArgsInst : cFnMut_t self args; - call_mut : self -> args -> result - cFnMutSelfArgsInst.cFnOnceSelfArgsInst.tOutput; + call : self -> args -> result cFnMutSelfArgsInst.cFnOnceSelfArgsInst.tOutput; +} + +(** Trait declaration: [traits::GetTrait] + Source: 'src/traits.rs', lines 304:0-304:18 *) +noeq type getTrait_t (self : Type0) = { tW : Type0; get_w : self -> result tW; } +(** [traits::test_get_trait]: + Source: 'src/traits.rs', lines 309:0-309:49 *) +let test_get_trait + (t : Type0) (getTraitTInst : getTrait_t t) (x : t) : + result getTraitTInst.tW + = + getTraitTInst.get_w x + diff --git a/tests/lean/Array.lean b/tests/lean/Array.lean index 25dad3cf..20f3425e 100644 --- a/tests/lean/Array.lean +++ b/tests/lean/Array.lean @@ -11,99 +11,94 @@ inductive AB := | A : AB | B : AB -/- [array::incr]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [array::incr]: Source: 'src/array.rs', lines 8:0-8:24 -/ def incr (x : U32) : Result U32 := x + 1#u32 -/- [array::array_to_shared_slice_]: forward function +/- [array::array_to_shared_slice_]: Source: 'src/array.rs', lines 16:0-16:53 -/ def array_to_shared_slice_ (T : Type) (s : Array T 32#usize) : Result (Slice T) := Array.to_slice T 32#usize s -/- [array::array_to_mut_slice_]: forward function +/- [array::array_to_mut_slice_]: Source: 'src/array.rs', lines 21:0-21:58 -/ -def array_to_mut_slice_ (T : Type) (s : Array T 32#usize) : Result (Slice T) := - Array.to_slice T 32#usize s - -/- [array::array_to_mut_slice_]: backward function 0 - Source: 'src/array.rs', lines 21:0-21:58 -/ -def array_to_mut_slice__back - (T : Type) (s : Array T 32#usize) (ret : Slice T) : - Result (Array T 32#usize) +def array_to_mut_slice_ + (T : Type) (s : Array T 32#usize) : + Result ((Slice T) × (Slice T → Result (Array T 32#usize))) := - Array.from_slice T 32#usize s ret + do + let (s1, to_slice_mut_back) ← Array.to_slice_mut T 32#usize s + let back := fun ret => to_slice_mut_back ret + Result.ret (s1, back) -/- [array::array_len]: forward function +/- [array::array_len]: Source: 'src/array.rs', lines 25:0-25:40 -/ def array_len (T : Type) (s : Array T 32#usize) : Result Usize := do - let s0 ← Array.to_slice T 32#usize s - let i := Slice.len T s0 - Result.ret i + let s1 ← Array.to_slice T 32#usize s + let i := Slice.len T s1 + Result.ret i -/- [array::shared_array_len]: forward function +/- [array::shared_array_len]: Source: 'src/array.rs', lines 29:0-29:48 -/ def shared_array_len (T : Type) (s : Array T 32#usize) : Result Usize := do - let s0 ← Array.to_slice T 32#usize s - let i := Slice.len T s0 - Result.ret i + let s1 ← Array.to_slice T 32#usize s + let i := Slice.len T s1 + Result.ret i -/- [array::shared_slice_len]: forward function +/- [array::shared_slice_len]: Source: 'src/array.rs', lines 33:0-33:44 -/ def shared_slice_len (T : Type) (s : Slice T) : Result Usize := let i := Slice.len T s Result.ret i -/- [array::index_array_shared]: forward function +/- [array::index_array_shared]: Source: 'src/array.rs', lines 37:0-37:57 -/ def index_array_shared (T : Type) (s : Array T 32#usize) (i : Usize) : Result T := Array.index_usize T 32#usize s i -/- [array::index_array_u32]: forward function +/- [array::index_array_u32]: Source: 'src/array.rs', lines 44:0-44:53 -/ def index_array_u32 (s : Array U32 32#usize) (i : Usize) : Result U32 := Array.index_usize U32 32#usize s i -/- [array::index_array_copy]: forward function +/- [array::index_array_copy]: Source: 'src/array.rs', lines 48:0-48:45 -/ def index_array_copy (x : Array U32 32#usize) : Result U32 := Array.index_usize U32 32#usize x 0#usize -/- [array::index_mut_array]: forward function +/- [array::index_mut_array]: Source: 'src/array.rs', lines 52:0-52:62 -/ -def index_mut_array (T : Type) (s : Array T 32#usize) (i : Usize) : Result T := - Array.index_usize T 32#usize s i - -/- [array::index_mut_array]: backward function 0 - Source: 'src/array.rs', lines 52:0-52:62 -/ -def index_mut_array_back - (T : Type) (s : Array T 32#usize) (i : Usize) (ret : T) : - Result (Array T 32#usize) +def index_mut_array + (T : Type) (s : Array T 32#usize) (i : Usize) : + Result (T × (T → Result (Array T 32#usize))) := - Array.update_usize T 32#usize s i ret + do + let (t, index_mut_back) ← Array.index_mut_usize T 32#usize s i + let back := fun ret => index_mut_back ret + Result.ret (t, back) -/- [array::index_slice]: forward function +/- [array::index_slice]: Source: 'src/array.rs', lines 56:0-56:46 -/ def index_slice (T : Type) (s : Slice T) (i : Usize) : Result T := Slice.index_usize T s i -/- [array::index_mut_slice]: forward function +/- [array::index_mut_slice]: Source: 'src/array.rs', lines 60:0-60:58 -/ -def index_mut_slice (T : Type) (s : Slice T) (i : Usize) : Result T := - Slice.index_usize T s i - -/- [array::index_mut_slice]: backward function 0 - Source: 'src/array.rs', lines 60:0-60:58 -/ -def index_mut_slice_back - (T : Type) (s : Slice T) (i : Usize) (ret : T) : Result (Slice T) := - Slice.update_usize T s i ret +def index_mut_slice + (T : Type) (s : Slice T) (i : Usize) : + Result (T × (T → Result (Slice T))) + := + do + let (t, index_mut_back) ← Slice.index_mut_usize T s i + let back := fun ret => index_mut_back ret + Result.ret (t, back) -/- [array::slice_subslice_shared_]: forward function +/- [array::slice_subslice_shared_]: Source: 'src/array.rs', lines 64:0-64:70 -/ def slice_subslice_shared_ (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := @@ -111,41 +106,37 @@ def slice_subslice_shared_ (core.slice.index.SliceIndexRangeUsizeSliceTInst U32) x { start := y, end_ := z } -/- [array::slice_subslice_mut_]: forward function +/- [array::slice_subslice_mut_]: Source: 'src/array.rs', lines 68:0-68:75 -/ def slice_subslice_mut_ - (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := - core.slice.index.Slice.index_mut U32 (core.ops.range.Range Usize) - (core.slice.index.SliceIndexRangeUsizeSliceTInst U32) x - { start := y, end_ := z } - -/- [array::slice_subslice_mut_]: backward function 0 - Source: 'src/array.rs', lines 68:0-68:75 -/ -def slice_subslice_mut__back - (x : Slice U32) (y : Usize) (z : Usize) (ret : Slice U32) : - Result (Slice U32) + (x : Slice U32) (y : Usize) (z : Usize) : + Result ((Slice U32) × (Slice U32 → Result (Slice U32))) := - core.slice.index.Slice.index_mut_back U32 (core.ops.range.Range Usize) - (core.slice.index.SliceIndexRangeUsizeSliceTInst U32) x - { start := y, end_ := z } ret - -/- [array::array_to_slice_shared_]: forward function + do + let (s, index_mut_back) ← + core.slice.index.Slice.index_mut U32 (core.ops.range.Range Usize) + (core.slice.index.SliceIndexRangeUsizeSliceTInst U32) x + { start := y, end_ := z } + let back := fun ret => index_mut_back ret + Result.ret (s, back) + +/- [array::array_to_slice_shared_]: Source: 'src/array.rs', lines 72:0-72:54 -/ def array_to_slice_shared_ (x : Array U32 32#usize) : Result (Slice U32) := Array.to_slice U32 32#usize x -/- [array::array_to_slice_mut_]: forward function +/- [array::array_to_slice_mut_]: Source: 'src/array.rs', lines 76:0-76:59 -/ -def array_to_slice_mut_ (x : Array U32 32#usize) : Result (Slice U32) := - Array.to_slice U32 32#usize x - -/- [array::array_to_slice_mut_]: backward function 0 - Source: 'src/array.rs', lines 76:0-76:59 -/ -def array_to_slice_mut__back - (x : Array U32 32#usize) (ret : Slice U32) : Result (Array U32 32#usize) := - Array.from_slice U32 32#usize x ret +def array_to_slice_mut_ + (x : Array U32 32#usize) : + Result ((Slice U32) × (Slice U32 → Result (Array U32 32#usize))) + := + do + let (s, to_slice_mut_back) ← Array.to_slice_mut U32 32#usize x + let back := fun ret => to_slice_mut_back ret + Result.ret (s, back) -/- [array::array_subslice_shared_]: forward function +/- [array::array_subslice_shared_]: Source: 'src/array.rs', lines 80:0-80:74 -/ def array_subslice_shared_ (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := @@ -154,311 +145,295 @@ def array_subslice_shared_ (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x { start := y, end_ := z } -/- [array::array_subslice_mut_]: forward function +/- [array::array_subslice_mut_]: Source: 'src/array.rs', lines 84:0-84:79 -/ def array_subslice_mut_ - (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := - core.array.Array.index_mut U32 (core.ops.range.Range Usize) 32#usize - (core.ops.index.IndexMutSliceTIInst U32 (core.ops.range.Range Usize) - (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x - { start := y, end_ := z } - -/- [array::array_subslice_mut_]: backward function 0 - Source: 'src/array.rs', lines 84:0-84:79 -/ -def array_subslice_mut__back - (x : Array U32 32#usize) (y : Usize) (z : Usize) (ret : Slice U32) : - Result (Array U32 32#usize) + (x : Array U32 32#usize) (y : Usize) (z : Usize) : + Result ((Slice U32) × (Slice U32 → Result (Array U32 32#usize))) := - core.array.Array.index_mut_back U32 (core.ops.range.Range Usize) 32#usize - (core.ops.index.IndexMutSliceTIInst U32 (core.ops.range.Range Usize) - (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x - { start := y, end_ := z } ret - -/- [array::index_slice_0]: forward function + do + let (s, index_mut_back) ← + core.array.Array.index_mut U32 (core.ops.range.Range Usize) 32#usize + (core.ops.index.IndexMutSliceTIInst U32 (core.ops.range.Range Usize) + (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x + { start := y, end_ := z } + let back := fun ret => index_mut_back ret + Result.ret (s, back) + +/- [array::index_slice_0]: Source: 'src/array.rs', lines 88:0-88:38 -/ def index_slice_0 (T : Type) (s : Slice T) : Result T := Slice.index_usize T s 0#usize -/- [array::index_array_0]: forward function +/- [array::index_array_0]: Source: 'src/array.rs', lines 92:0-92:42 -/ def index_array_0 (T : Type) (s : Array T 32#usize) : Result T := Array.index_usize T 32#usize s 0#usize -/- [array::index_index_array]: forward function +/- [array::index_index_array]: Source: 'src/array.rs', lines 103:0-103:71 -/ def index_index_array (s : Array (Array U32 32#usize) 32#usize) (i : Usize) (j : Usize) : Result U32 := do - let a ← Array.index_usize (Array U32 32#usize) 32#usize s i - Array.index_usize U32 32#usize a j + let a ← Array.index_usize (Array U32 32#usize) 32#usize s i + Array.index_usize U32 32#usize a j -/- [array::update_update_array]: forward function +/- [array::update_update_array]: Source: 'src/array.rs', lines 114:0-114:70 -/ def update_update_array (s : Array (Array U32 32#usize) 32#usize) (i : Usize) (j : Usize) : Result Unit := do - let a ← Array.index_usize (Array U32 32#usize) 32#usize s i - let a0 ← Array.update_usize U32 32#usize a j 0#u32 - let _ ← Array.update_usize (Array U32 32#usize) 32#usize s i a0 - Result.ret () + let (a, index_mut_back) ← + Array.index_mut_usize (Array U32 32#usize) 32#usize s i + let (_, index_mut_back1) ← Array.index_mut_usize U32 32#usize a j + let a1 ← index_mut_back1 0#u32 + let _ ← index_mut_back a1 + Result.ret () -/- [array::array_local_deep_copy]: forward function +/- [array::array_local_deep_copy]: Source: 'src/array.rs', lines 118:0-118:43 -/ def array_local_deep_copy (x : Array U32 32#usize) : Result Unit := Result.ret () -/- [array::take_array]: forward function +/- [array::take_array]: Source: 'src/array.rs', lines 122:0-122:30 -/ def take_array (a : Array U32 2#usize) : Result Unit := Result.ret () -/- [array::take_array_borrow]: forward function +/- [array::take_array_borrow]: Source: 'src/array.rs', lines 123:0-123:38 -/ def take_array_borrow (a : Array U32 2#usize) : Result Unit := Result.ret () -/- [array::take_slice]: forward function +/- [array::take_slice]: Source: 'src/array.rs', lines 124:0-124:28 -/ def take_slice (s : Slice U32) : Result Unit := Result.ret () -/- [array::take_mut_slice]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [array::take_mut_slice]: Source: 'src/array.rs', lines 125:0-125:36 -/ def take_mut_slice (s : Slice U32) : Result (Slice U32) := Result.ret s -/- [array::const_array]: forward function +/- [array::const_array]: Source: 'src/array.rs', lines 127:0-127:32 -/ def const_array : Result (Array U32 2#usize) := Result.ret (Array.make U32 2#usize [ 0#u32, 0#u32 ]) -/- [array::const_slice]: forward function +/- [array::const_slice]: Source: 'src/array.rs', lines 131:0-131:20 -/ def const_slice : Result Unit := do - let _ ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - Result.ret () + let _ ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + Result.ret () -/- [array::take_all]: forward function +/- [array::take_all]: Source: 'src/array.rs', lines 141:0-141:17 -/ def take_all : Result Unit := do - let _ ← take_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let _ ← take_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let s ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let _ ← take_slice s - let s0 ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let s1 ← take_mut_slice s0 - let _ ← - Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 - Result.ret () - -/- [array::index_array]: forward function + let _ ← take_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let _ ← take_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let _ ← take_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let s ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let _ ← take_slice s + let (s1, to_slice_mut_back) ← + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let s2 ← take_mut_slice s1 + let _ ← to_slice_mut_back s2 + Result.ret () + +/- [array::index_array]: Source: 'src/array.rs', lines 155:0-155:38 -/ def index_array (x : Array U32 2#usize) : Result U32 := Array.index_usize U32 2#usize x 0#usize -/- [array::index_array_borrow]: forward function +/- [array::index_array_borrow]: Source: 'src/array.rs', lines 158:0-158:46 -/ def index_array_borrow (x : Array U32 2#usize) : Result U32 := Array.index_usize U32 2#usize x 0#usize -/- [array::index_slice_u32_0]: forward function +/- [array::index_slice_u32_0]: Source: 'src/array.rs', lines 162:0-162:42 -/ def index_slice_u32_0 (x : Slice U32) : Result U32 := Slice.index_usize U32 x 0#usize -/- [array::index_mut_slice_u32_0]: forward function +/- [array::index_mut_slice_u32_0]: Source: 'src/array.rs', lines 166:0-166:50 -/ -def index_mut_slice_u32_0 (x : Slice U32) : Result U32 := - Slice.index_usize U32 x 0#usize - -/- [array::index_mut_slice_u32_0]: backward function 0 - Source: 'src/array.rs', lines 166:0-166:50 -/ -def index_mut_slice_u32_0_back (x : Slice U32) : Result (Slice U32) := +def index_mut_slice_u32_0 (x : Slice U32) : Result (U32 × (Slice U32)) := do - let _ ← Slice.index_usize U32 x 0#usize - Result.ret x + let i ← Slice.index_usize U32 x 0#usize + Result.ret (i, x) -/- [array::index_all]: forward function +/- [array::index_all]: Source: 'src/array.rs', lines 170:0-170:25 -/ def index_all : Result U32 := do - let i ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let i0 ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let i1 ← i + i0 - let i2 ← index_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let i3 ← i1 + i2 - let s ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let i4 ← index_slice_u32_0 s - let i5 ← i3 + i4 - let s0 ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let i6 ← index_mut_slice_u32_0 s0 - let i7 ← i5 + i6 - let s1 ← index_mut_slice_u32_0_back s0 - let _ ← - Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 - Result.ret i7 - -/- [array::update_array]: forward function + let i ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i1 ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i2 ← i + i1 + let i3 ← index_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i4 ← i2 + i3 + let s ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i5 ← index_slice_u32_0 s + let i6 ← i4 + i5 + let (s1, to_slice_mut_back) ← + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let (i7, s2) ← index_mut_slice_u32_0 s1 + let i8 ← i6 + i7 + let _ ← to_slice_mut_back s2 + Result.ret i8 + +/- [array::update_array]: Source: 'src/array.rs', lines 184:0-184:36 -/ def update_array (x : Array U32 2#usize) : Result Unit := do - let _ ← Array.update_usize U32 2#usize x 0#usize 1#u32 - Result.ret () + let (_, index_mut_back) ← Array.index_mut_usize U32 2#usize x 0#usize + let _ ← index_mut_back 1#u32 + Result.ret () -/- [array::update_array_mut_borrow]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [array::update_array_mut_borrow]: Source: 'src/array.rs', lines 187:0-187:48 -/ def update_array_mut_borrow (x : Array U32 2#usize) : Result (Array U32 2#usize) := - Array.update_usize U32 2#usize x 0#usize 1#u32 + do + let (_, index_mut_back) ← Array.index_mut_usize U32 2#usize x 0#usize + index_mut_back 1#u32 -/- [array::update_mut_slice]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [array::update_mut_slice]: Source: 'src/array.rs', lines 190:0-190:38 -/ def update_mut_slice (x : Slice U32) : Result (Slice U32) := - Slice.update_usize U32 x 0#usize 1#u32 + do + let (_, index_mut_back) ← Slice.index_mut_usize U32 x 0#usize + index_mut_back 1#u32 -/- [array::update_all]: forward function +/- [array::update_all]: Source: 'src/array.rs', lines 194:0-194:19 -/ def update_all : Result Unit := do - let _ ← update_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let x ← update_array_mut_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let s ← Array.to_slice U32 2#usize x - let s0 ← update_mut_slice s - let _ ← Array.from_slice U32 2#usize x s0 - Result.ret () - -/- [array::range_all]: forward function + let _ ← update_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let _ ← update_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let a ← update_array_mut_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let (s, to_slice_mut_back) ← Array.to_slice_mut U32 2#usize a + let s1 ← update_mut_slice s + let _ ← to_slice_mut_back s1 + Result.ret () + +/- [array::range_all]: Source: 'src/array.rs', lines 205:0-205:18 -/ def range_all : Result Unit := do - let s ← - core.array.Array.index_mut U32 (core.ops.range.Range Usize) 4#usize - (core.ops.index.IndexMutSliceTIInst U32 (core.ops.range.Range Usize) - (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) - (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) - { start := 1#usize, end_ := 3#usize } - let s0 ← update_mut_slice s - let _ ← - core.array.Array.index_mut_back U32 (core.ops.range.Range Usize) 4#usize - (core.ops.index.IndexMutSliceTIInst U32 (core.ops.range.Range Usize) - (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) - (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) - { start := 1#usize, end_ := 3#usize } s0 - Result.ret () - -/- [array::deref_array_borrow]: forward function + let (s, index_mut_back) ← + core.array.Array.index_mut U32 (core.ops.range.Range Usize) 4#usize + (core.ops.index.IndexMutSliceTIInst U32 (core.ops.range.Range Usize) + (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) + (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) + { start := 1#usize, end_ := 3#usize } + let s1 ← update_mut_slice s + let _ ← index_mut_back s1 + Result.ret () + +/- [array::deref_array_borrow]: Source: 'src/array.rs', lines 214:0-214:46 -/ def deref_array_borrow (x : Array U32 2#usize) : Result U32 := Array.index_usize U32 2#usize x 0#usize -/- [array::deref_array_mut_borrow]: forward function - Source: 'src/array.rs', lines 219:0-219:54 -/ -def deref_array_mut_borrow (x : Array U32 2#usize) : Result U32 := - Array.index_usize U32 2#usize x 0#usize - -/- [array::deref_array_mut_borrow]: backward function 0 +/- [array::deref_array_mut_borrow]: Source: 'src/array.rs', lines 219:0-219:54 -/ -def deref_array_mut_borrow_back - (x : Array U32 2#usize) : Result (Array U32 2#usize) := +def deref_array_mut_borrow + (x : Array U32 2#usize) : Result (U32 × (Array U32 2#usize)) := do - let _ ← Array.index_usize U32 2#usize x 0#usize - Result.ret x + let i ← Array.index_usize U32 2#usize x 0#usize + Result.ret (i, x) -/- [array::take_array_t]: forward function +/- [array::take_array_t]: Source: 'src/array.rs', lines 227:0-227:31 -/ def take_array_t (a : Array AB 2#usize) : Result Unit := Result.ret () -/- [array::non_copyable_array]: forward function +/- [array::non_copyable_array]: Source: 'src/array.rs', lines 229:0-229:27 -/ def non_copyable_array : Result Unit := do - let _ ← take_array_t (Array.make AB 2#usize [ AB.A, AB.B ]) - Result.ret () + let _ ← take_array_t (Array.make AB 2#usize [ AB.A, AB.B ]) + Result.ret () -/- [array::sum]: loop 0: forward function +/- [array::sum]: loop 0: Source: 'src/array.rs', lines 242:0-250:1 -/ -divergent def sum_loop (s : Slice U32) (sum0 : U32) (i : Usize) : Result U32 := - let i0 := Slice.len U32 s - if i < i0 +divergent def sum_loop (s : Slice U32) (sum1 : U32) (i : Usize) : Result U32 := + let i1 := Slice.len U32 s + if i < i1 then do - let i1 ← Slice.index_usize U32 s i - let sum1 ← sum0 + i1 - let i2 ← i + 1#usize - sum_loop s sum1 i2 - else Result.ret sum0 + let i2 ← Slice.index_usize U32 s i + let sum3 ← sum1 + i2 + let i3 ← i + 1#usize + sum_loop s sum3 i3 + else Result.ret sum1 -/- [array::sum]: forward function +/- [array::sum]: Source: 'src/array.rs', lines 242:0-242:28 -/ def sum (s : Slice U32) : Result U32 := sum_loop s 0#u32 0#usize -/- [array::sum2]: loop 0: forward function +/- [array::sum2]: loop 0: Source: 'src/array.rs', lines 252:0-261:1 -/ divergent def sum2_loop - (s : Slice U32) (s2 : Slice U32) (sum0 : U32) (i : Usize) : Result U32 := - let i0 := Slice.len U32 s - if i < i0 + (s : Slice U32) (s2 : Slice U32) (sum1 : U32) (i : Usize) : Result U32 := + let i1 := Slice.len U32 s + if i < i1 then do - let i1 ← Slice.index_usize U32 s i - let i2 ← Slice.index_usize U32 s2 i - let i3 ← i1 + i2 - let sum1 ← sum0 + i3 - let i4 ← i + 1#usize - sum2_loop s s2 sum1 i4 - else Result.ret sum0 - -/- [array::sum2]: forward function + let i2 ← Slice.index_usize U32 s i + let i3 ← Slice.index_usize U32 s2 i + let i4 ← i2 + i3 + let sum3 ← sum1 + i4 + let i5 ← i + 1#usize + sum2_loop s s2 sum3 i5 + else Result.ret sum1 + +/- [array::sum2]: Source: 'src/array.rs', lines 252:0-252:41 -/ def sum2 (s : Slice U32) (s2 : Slice U32) : Result U32 := let i := Slice.len U32 s - let i0 := Slice.len U32 s2 - if not (i = i0) + let i1 := Slice.len U32 s2 + if not (i = i1) then Result.fail .panic else sum2_loop s s2 0#u32 0#usize -/- [array::f0]: forward function +/- [array::f0]: Source: 'src/array.rs', lines 263:0-263:11 -/ def f0 : Result Unit := do - let s ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) - let s0 ← Slice.update_usize U32 s 0#usize 1#u32 - let _ ← - Array.from_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) s0 - Result.ret () - -/- [array::f1]: forward function + let (s, to_slice_mut_back) ← + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + let (_, index_mut_back) ← Slice.index_mut_usize U32 s 0#usize + let s1 ← index_mut_back 1#u32 + let _ ← to_slice_mut_back s1 + Result.ret () + +/- [array::f1]: Source: 'src/array.rs', lines 268:0-268:11 -/ def f1 : Result Unit := do - let _ ← - Array.update_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) - 0#usize 1#u32 - Result.ret () + let (_, index_mut_back) ← + Array.index_mut_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + 0#usize + let _ ← index_mut_back 1#u32 + Result.ret () -/- [array::f2]: forward function +/- [array::f2]: Source: 'src/array.rs', lines 273:0-273:17 -/ def f2 (i : U32) : Result Unit := Result.ret () -/- [array::f4]: forward function +/- [array::f4]: Source: 'src/array.rs', lines 282:0-282:54 -/ def f4 (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := core.array.Array.index U32 (core.ops.range.Range Usize) 32#usize @@ -466,44 +441,42 @@ def f4 (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x { start := y, end_ := z } -/- [array::f3]: forward function +/- [array::f3]: Source: 'src/array.rs', lines 275:0-275:18 -/ def f3 : Result U32 := do - let i ← - Array.index_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) - 0#usize - let _ ← f2 i - let b := Array.repeat U32 32#usize 0#u32 - let s ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) - let s0 ← f4 b 16#usize 18#usize - sum2 s s0 + let i ← + Array.index_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + 0#usize + let _ ← f2 i + let b := Array.repeat U32 32#usize 0#u32 + let s ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + let s1 ← f4 b 16#usize 18#usize + sum2 s s1 /- [array::SZ] Source: 'src/array.rs', lines 286:0-286:19 -/ def sz_body : Result Usize := Result.ret 32#usize def sz_c : Usize := eval_global sz_body (by simp) -/- [array::f5]: forward function +/- [array::f5]: Source: 'src/array.rs', lines 289:0-289:31 -/ def f5 (x : Array U32 32#usize) : Result U32 := Array.index_usize U32 32#usize x 0#usize -/- [array::ite]: forward function +/- [array::ite]: Source: 'src/array.rs', lines 294:0-294:12 -/ def ite : Result Unit := do - let s ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let s0 ← - Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let s1 ← index_mut_slice_u32_0_back s0 - let _ ← - Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 - let s2 ← index_mut_slice_u32_0_back s - let _ ← - Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s2 - Result.ret () + let (s, to_slice_mut_back) ← + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let (_, s1) ← index_mut_slice_u32_0 s + let (s2, to_slice_mut_back1) ← + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let (_, s3) ← index_mut_slice_u32_0 s2 + let _ ← to_slice_mut_back1 s3 + let _ ← to_slice_mut_back s1 + Result.ret () end array diff --git a/tests/lean/BetreeMain/Funs.lean b/tests/lean/BetreeMain/Funs.lean index 0d7cb984..4e64d217 100644 --- a/tests/lean/BetreeMain/Funs.lean +++ b/tests/lean/BetreeMain/Funs.lean @@ -7,7 +7,7 @@ open Primitives namespace betree_main -/- [betree_main::betree::load_internal_node]: forward function +/- [betree_main::betree::load_internal_node]: Source: 'src/betree.rs', lines 36:0-36:52 -/ def betree.load_internal_node (id : U64) (st : State) : @@ -15,65 +15,53 @@ def betree.load_internal_node := betree_utils.load_internal_node id st -/- [betree_main::betree::store_internal_node]: forward function +/- [betree_main::betree::store_internal_node]: Source: 'src/betree.rs', lines 41:0-41:60 -/ def betree.store_internal_node (id : U64) (content : betree.List (U64 × betree.Message)) (st : State) : Result (State × Unit) := do - let (st0, _) ← betree_utils.store_internal_node id content st - Result.ret (st0, ()) + let (st1, _) ← betree_utils.store_internal_node id content st + Result.ret (st1, ()) -/- [betree_main::betree::load_leaf_node]: forward function +/- [betree_main::betree::load_leaf_node]: Source: 'src/betree.rs', lines 46:0-46:44 -/ def betree.load_leaf_node (id : U64) (st : State) : Result (State × (betree.List (U64 × U64))) := betree_utils.load_leaf_node id st -/- [betree_main::betree::store_leaf_node]: forward function +/- [betree_main::betree::store_leaf_node]: Source: 'src/betree.rs', lines 51:0-51:52 -/ def betree.store_leaf_node (id : U64) (content : betree.List (U64 × U64)) (st : State) : Result (State × Unit) := do - let (st0, _) ← betree_utils.store_leaf_node id content st - Result.ret (st0, ()) + let (st1, _) ← betree_utils.store_leaf_node id content st + Result.ret (st1, ()) -/- [betree_main::betree::fresh_node_id]: forward function +/- [betree_main::betree::fresh_node_id]: Source: 'src/betree.rs', lines 55:0-55:48 -/ -def betree.fresh_node_id (counter : U64) : Result U64 := +def betree.fresh_node_id (counter : U64) : Result (U64 × U64) := do - let _ ← counter + 1#u64 - Result.ret counter + let counter1 ← counter + 1#u64 + Result.ret (counter, counter1) -/- [betree_main::betree::fresh_node_id]: backward function 0 - Source: 'src/betree.rs', lines 55:0-55:48 -/ -def betree.fresh_node_id_back (counter : U64) : Result U64 := - counter + 1#u64 - -/- [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: forward function +/- [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: Source: 'src/betree.rs', lines 206:4-206:20 -/ def betree.NodeIdCounter.new : Result betree.NodeIdCounter := Result.ret { next_node_id := 0#u64 } -/- [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: forward function +/- [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: Source: 'src/betree.rs', lines 210:4-210:36 -/ -def betree.NodeIdCounter.fresh_id (self : betree.NodeIdCounter) : Result U64 := +def betree.NodeIdCounter.fresh_id + (self : betree.NodeIdCounter) : Result (U64 × betree.NodeIdCounter) := do - let _ ← self.next_node_id + 1#u64 - Result.ret self.next_node_id + let i ← self.next_node_id + 1#u64 + Result.ret (self.next_node_id, { next_node_id := i }) -/- [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: backward function 0 - Source: 'src/betree.rs', lines 210:4-210:36 -/ -def betree.NodeIdCounter.fresh_id_back - (self : betree.NodeIdCounter) : Result betree.NodeIdCounter := - do - let i ← self.next_node_id + 1#u64 - Result.ret { next_node_id := i } - -/- [betree_main::betree::upsert_update]: forward function +/- [betree_main::betree::upsert_update]: Source: 'src/betree.rs', lines 234:0-234:70 -/ def betree.upsert_update (prev : Option U64) (st : betree.UpsertFunState) : Result U64 := @@ -81,30 +69,30 @@ def betree.upsert_update | none => match st with | betree.UpsertFunState.Add v => Result.ret v - | betree.UpsertFunState.Sub i => Result.ret 0#u64 - | some prev0 => + | betree.UpsertFunState.Sub _ => Result.ret 0#u64 + | some prev1 => match st with | betree.UpsertFunState.Add v => do - let margin ← core_u64_max - prev0 - if margin >= v - then prev0 + v - else Result.ret core_u64_max + let margin ← core_u64_max - prev1 + if margin >= v + then prev1 + v + else Result.ret core_u64_max | betree.UpsertFunState.Sub v => - if prev0 >= v - then prev0 - v + if prev1 >= v + then prev1 - v else Result.ret 0#u64 -/- [betree_main::betree::{betree_main::betree::List#1}::len]: forward function +/- [betree_main::betree::{betree_main::betree::List#1}::len]: Source: 'src/betree.rs', lines 276:4-276:24 -/ divergent def betree.List.len (T : Type) (self : betree.List T) : Result U64 := match self with - | betree.List.Cons t tl => do - let i ← betree.List.len T tl - 1#u64 + i + | betree.List.Cons _ tl => do + let i ← betree.List.len T tl + 1#u64 + i | betree.List.Nil => Result.ret 0#u64 -/- [betree_main::betree::{betree_main::betree::List#1}::split_at]: forward function +/- [betree_main::betree::{betree_main::betree::List#1}::split_at]: Source: 'src/betree.rs', lines 284:4-284:51 -/ divergent def betree.List.split_at (T : Type) (self : betree.List T) (n : U64) : @@ -116,56 +104,47 @@ divergent def betree.List.split_at match self with | betree.List.Cons hd tl => do - let i ← n - 1#u64 - let p ← betree.List.split_at T tl i - let (ls0, ls1) := p - let l := ls0 - Result.ret (betree.List.Cons hd l, ls1) + let i ← n - 1#u64 + let p ← betree.List.split_at T tl i + let (ls0, ls1) := p + let l := ls0 + Result.ret (betree.List.Cons hd l, ls1) | betree.List.Nil => Result.fail .panic -/- [betree_main::betree::{betree_main::betree::List#1}::push_front]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [betree_main::betree::{betree_main::betree::List#1}::push_front]: Source: 'src/betree.rs', lines 299:4-299:34 -/ def betree.List.push_front (T : Type) (self : betree.List T) (x : T) : Result (betree.List T) := - let tl := core.mem.replace (betree.List T) self betree.List.Nil + let (tl, _) := core.mem.replace (betree.List T) self betree.List.Nil let l := tl Result.ret (betree.List.Cons x l) -/- [betree_main::betree::{betree_main::betree::List#1}::pop_front]: forward function - Source: 'src/betree.rs', lines 306:4-306:32 -/ -def betree.List.pop_front (T : Type) (self : betree.List T) : Result T := - let ls := core.mem.replace (betree.List T) self betree.List.Nil - match ls with - | betree.List.Cons x tl => Result.ret x - | betree.List.Nil => Result.fail .panic - -/- [betree_main::betree::{betree_main::betree::List#1}::pop_front]: backward function 0 +/- [betree_main::betree::{betree_main::betree::List#1}::pop_front]: Source: 'src/betree.rs', lines 306:4-306:32 -/ -def betree.List.pop_front_back - (T : Type) (self : betree.List T) : Result (betree.List T) := - let ls := core.mem.replace (betree.List T) self betree.List.Nil +def betree.List.pop_front + (T : Type) (self : betree.List T) : Result (T × (betree.List T)) := + let (ls, _) := core.mem.replace (betree.List T) self betree.List.Nil match ls with - | betree.List.Cons x tl => Result.ret tl + | betree.List.Cons x tl => Result.ret (x, tl) | betree.List.Nil => Result.fail .panic -/- [betree_main::betree::{betree_main::betree::List#1}::hd]: forward function +/- [betree_main::betree::{betree_main::betree::List#1}::hd]: Source: 'src/betree.rs', lines 318:4-318:22 -/ def betree.List.hd (T : Type) (self : betree.List T) : Result T := match self with - | betree.List.Cons hd l => Result.ret hd + | betree.List.Cons hd _ => Result.ret hd | betree.List.Nil => Result.fail .panic -/- [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::head_has_key]: forward function +/- [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::head_has_key]: Source: 'src/betree.rs', lines 327:4-327:44 -/ def betree.ListTupleU64T.head_has_key (T : Type) (self : betree.List (U64 × T)) (key : U64) : Result Bool := match self with - | betree.List.Cons hd l => let (i, _) := hd + | betree.List.Cons hd _ => let (i, _) := hd Result.ret (i = key) | betree.List.Nil => Result.ret false -/- [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: forward function +/- [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: Source: 'src/betree.rs', lines 339:4-339:73 -/ divergent def betree.ListTupleU64T.partition_at_pivot (T : Type) (self : betree.List (U64 × T)) (pivot : U64) : @@ -178,334 +157,191 @@ divergent def betree.ListTupleU64T.partition_at_pivot then Result.ret (betree.List.Nil, betree.List.Cons (i, t) tl) else do - let p ← betree.ListTupleU64T.partition_at_pivot T tl pivot - let (ls0, ls1) := p - let l := ls0 - Result.ret (betree.List.Cons (i, t) l, ls1) + let p ← betree.ListTupleU64T.partition_at_pivot T tl pivot + let (ls0, ls1) := p + let l := ls0 + Result.ret (betree.List.Cons (i, t) l, ls1) | betree.List.Nil => Result.ret (betree.List.Nil, betree.List.Nil) -/- [betree_main::betree::{betree_main::betree::Leaf#3}::split]: forward function +/- [betree_main::betree::{betree_main::betree::Leaf#3}::split]: Source: 'src/betree.rs', lines 359:4-364:17 -/ def betree.Leaf.split (self : betree.Leaf) (content : betree.List (U64 × U64)) (params : betree.Params) (node_id_cnt : betree.NodeIdCounter) (st : State) : - Result (State × betree.Internal) + Result (State × (betree.Internal × betree.NodeIdCounter)) := do - let p ← betree.List.split_at (U64 × U64) content params.split_size - let (content0, content1) := p - let p0 ← betree.List.hd (U64 × U64) content1 - let (pivot, _) := p0 - let id0 ← betree.NodeIdCounter.fresh_id node_id_cnt - let node_id_cnt0 ← betree.NodeIdCounter.fresh_id_back node_id_cnt - let id1 ← betree.NodeIdCounter.fresh_id node_id_cnt0 - let (st0, _) ← betree.store_leaf_node id0 content0 st - let (st1, _) ← betree.store_leaf_node id1 content1 st0 - let n := betree.Node.Leaf { id := id0, size := params.split_size } - let n0 := betree.Node.Leaf { id := id1, size := params.split_size } - Result.ret (st1, betree.Internal.mk self.id pivot n n0) - -/- [betree_main::betree::{betree_main::betree::Leaf#3}::split]: backward function 2 - Source: 'src/betree.rs', lines 359:4-364:17 -/ -def betree.Leaf.split_back - (self : betree.Leaf) (content : betree.List (U64 × U64)) - (params : betree.Params) (node_id_cnt : betree.NodeIdCounter) (st : State) : - Result betree.NodeIdCounter - := - do - let p ← betree.List.split_at (U64 × U64) content params.split_size - let (content0, content1) := p - let _ ← betree.List.hd (U64 × U64) content1 - let id0 ← betree.NodeIdCounter.fresh_id node_id_cnt - let node_id_cnt0 ← betree.NodeIdCounter.fresh_id_back node_id_cnt - let id1 ← betree.NodeIdCounter.fresh_id node_id_cnt0 - let (st0, _) ← betree.store_leaf_node id0 content0 st - let _ ← betree.store_leaf_node id1 content1 st0 - betree.NodeIdCounter.fresh_id_back node_id_cnt0 - -/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: forward function + let p ← betree.List.split_at (U64 × U64) content params.split_size + let (content0, content1) := p + let p1 ← betree.List.hd (U64 × U64) content1 + let (pivot, _) := p1 + let (id0, nic) ← betree.NodeIdCounter.fresh_id node_id_cnt + let (id1, nic1) ← betree.NodeIdCounter.fresh_id nic + let (st1, _) ← betree.store_leaf_node id0 content0 st + let (st2, _) ← betree.store_leaf_node id1 content1 st1 + let n := betree.Node.Leaf { id := id0, size := params.split_size } + let n1 := betree.Node.Leaf { id := id1, size := params.split_size } + Result.ret (st2, (betree.Internal.mk self.id pivot n n1, nic1)) + +/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: Source: 'src/betree.rs', lines 789:4-792:34 -/ divergent def betree.Node.lookup_first_message_for_key (key : U64) (msgs : betree.List (U64 × betree.Message)) : - Result (betree.List (U64 × betree.Message)) + Result ((betree.List (U64 × betree.Message)) × (betree.List (U64 × + betree.Message) → Result (betree.List (U64 × betree.Message)))) := match msgs with | betree.List.Cons x next_msgs => let (i, m) := x if i >= key - then Result.ret (betree.List.Cons (i, m) next_msgs) - else betree.Node.lookup_first_message_for_key key next_msgs - | betree.List.Nil => Result.ret betree.List.Nil - -/- [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 -/ -divergent def betree.Node.lookup_first_message_for_key_back - (key : U64) (msgs : betree.List (U64 × betree.Message)) - (ret : betree.List (U64 × betree.Message)) : - Result (betree.List (U64 × betree.Message)) - := - match msgs with - | betree.List.Cons x next_msgs => - let (i, m) := x - if i >= key - then Result.ret ret + then + let back_'a := fun ret => Result.ret ret + Result.ret (betree.List.Cons (i, m) next_msgs, back_'a) else do - let next_msgs0 ← - betree.Node.lookup_first_message_for_key_back key next_msgs ret - Result.ret (betree.List.Cons (i, m) next_msgs0) - | betree.List.Nil => Result.ret ret - -/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: forward function + let (l, lookup_first_message_for_key_back) ← + betree.Node.lookup_first_message_for_key key next_msgs + let back_'a := + fun ret => + do + let next_msgs1 ← lookup_first_message_for_key_back ret + Result.ret (betree.List.Cons (i, m) next_msgs1) + Result.ret (l, back_'a) + | betree.List.Nil => + let back_'a := fun ret => Result.ret ret + Result.ret (betree.List.Nil, back_'a) + +/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: Source: 'src/betree.rs', lines 636:4-636:80 -/ divergent def betree.Node.lookup_in_bindings (key : U64) (bindings : betree.List (U64 × U64)) : Result (Option U64) := match bindings with | betree.List.Cons hd tl => - let (i, i0) := hd + let (i, i1) := hd if i = key - then Result.ret (some i0) + then Result.ret (some i1) else if i > key then Result.ret none else betree.Node.lookup_in_bindings key tl | betree.List.Nil => Result.ret none -/- [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: forward function +/- [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: Source: 'src/betree.rs', lines 819:4-819:90 -/ divergent def betree.Node.apply_upserts (msgs : betree.List (U64 × betree.Message)) (prev : Option U64) (key : U64) (st : State) : - Result (State × U64) + Result (State × (U64 × (betree.List (U64 × betree.Message)))) := do - let b ← betree.ListTupleU64T.head_has_key betree.Message msgs key - if b - then - do - let msg ← betree.List.pop_front (U64 × betree.Message) msgs - let (_, m) := msg - match m with - | betree.Message.Insert i => Result.fail .panic - | betree.Message.Delete => Result.fail .panic - | betree.Message.Upsert s => - do - let v ← betree.upsert_update prev s - let msgs0 ← - betree.List.pop_front_back (U64 × betree.Message) msgs - betree.Node.apply_upserts msgs0 (some v) key st - else - do - let (st0, v) ← core.option.Option.unwrap U64 prev st - let _ ← - betree.List.push_front (U64 × betree.Message) msgs (key, - betree.Message.Insert v) - Result.ret (st0, v) - -/- [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: backward function 0 - Source: 'src/betree.rs', lines 819:4-819:90 -/ -divergent def betree.Node.apply_upserts_back - (msgs : betree.List (U64 × betree.Message)) (prev : Option U64) (key : U64) - (st : State) : - Result (betree.List (U64 × betree.Message)) - := - do - let b ← betree.ListTupleU64T.head_has_key betree.Message msgs key - if b - then - do - let msg ← betree.List.pop_front (U64 × betree.Message) msgs - let (_, m) := msg - match m with - | betree.Message.Insert i => Result.fail .panic - | betree.Message.Delete => Result.fail .panic - | betree.Message.Upsert s => - do - let v ← betree.upsert_update prev s - let msgs0 ← - betree.List.pop_front_back (U64 × betree.Message) msgs - betree.Node.apply_upserts_back msgs0 (some v) key st - else + let b ← betree.ListTupleU64T.head_has_key betree.Message msgs key + if b + then + do + let (msg, l) ← betree.List.pop_front (U64 × betree.Message) msgs + let (_, m) := msg + match m with + | betree.Message.Insert _ => Result.fail .panic + | betree.Message.Delete => Result.fail .panic + | betree.Message.Upsert s => do - let (_, v) ← core.option.Option.unwrap U64 prev st - betree.List.push_front (U64 × betree.Message) msgs (key, - betree.Message.Insert v) + let v ← betree.upsert_update prev s + betree.Node.apply_upserts l (some v) key st + else + do + let (st1, v) ← core.option.Option.unwrap U64 prev st + let l ← + betree.List.push_front (U64 × betree.Message) msgs (key, + betree.Message.Insert v) + Result.ret (st1, (v, l)) -/- [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: forward function +/- [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: Source: 'src/betree.rs', lines 395:4-395:63 -/ mutual divergent def betree.Internal.lookup_in_children (self : betree.Internal) (key : U64) (st : State) : - Result (State × (Option U64)) + Result (State × ((Option U64) × betree.Internal)) := - let ⟨ _, i, n, n0 ⟩ := self - if key < i - then betree.Node.lookup n key st - else betree.Node.lookup n0 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 -/ -divergent def betree.Internal.lookup_in_children_back - (self : betree.Internal) (key : U64) (st : State) : Result betree.Internal := - let ⟨ i, i0, n, n0 ⟩ := self - if key < i0 + let ⟨ i, i1, n, n1 ⟩ := self + if key < i1 then do - let n1 ← betree.Node.lookup_back n key st - Result.ret (betree.Internal.mk i i0 n1 n0) + let (st1, (o, n2)) ← betree.Node.lookup n key st + Result.ret (st1, (o, betree.Internal.mk i i1 n2 n1)) else do - let n1 ← betree.Node.lookup_back n0 key st - Result.ret (betree.Internal.mk i i0 n n1) + let (st1, (o, n2)) ← betree.Node.lookup n1 key st + Result.ret (st1, (o, betree.Internal.mk i i1 n n2)) -/- [betree_main::betree::{betree_main::betree::Node#5}::lookup]: forward function +/- [betree_main::betree::{betree_main::betree::Node#5}::lookup]: Source: 'src/betree.rs', lines 709:4-709:58 -/ divergent def betree.Node.lookup (self : betree.Node) (key : U64) (st : State) : - Result (State × (Option U64)) + Result (State × ((Option U64) × betree.Node)) := match self with | betree.Node.Internal node => do - let ⟨ i, i0, n, n0 ⟩ := node - let (st0, msgs) ← betree.load_internal_node i st - let pending ← betree.Node.lookup_first_message_for_key key msgs - match pending with - | betree.List.Cons p l => - let (k, msg) := p - if k != key - then - do - let (st1, o) ← - betree.Internal.lookup_in_children (betree.Internal.mk i i0 n n0) - key st0 - let _ ← - betree.Node.lookup_first_message_for_key_back key msgs - (betree.List.Cons (k, msg) l) - Result.ret (st1, o) - else - match msg with - | betree.Message.Insert v => - do - let _ ← - betree.Node.lookup_first_message_for_key_back key msgs - (betree.List.Cons (k, betree.Message.Insert v) l) - Result.ret (st0, some v) - | betree.Message.Delete => - do - let _ ← - betree.Node.lookup_first_message_for_key_back key msgs - (betree.List.Cons (k, betree.Message.Delete) l) - Result.ret (st0, none) - | betree.Message.Upsert ufs => - do - let (st1, v) ← - betree.Internal.lookup_in_children (betree.Internal.mk i i0 n - n0) key st0 - let (st2, v0) ← - betree.Node.apply_upserts (betree.List.Cons (k, - betree.Message.Upsert ufs) l) v key st1 - let node0 ← - betree.Internal.lookup_in_children_back (betree.Internal.mk i - i0 n n0) key st0 - let ⟨ i1, _, _, _ ⟩ := node0 - let pending0 ← - betree.Node.apply_upserts_back (betree.List.Cons (k, - betree.Message.Upsert ufs) l) v key st1 - let msgs0 ← - betree.Node.lookup_first_message_for_key_back key msgs pending0 - let (st3, _) ← betree.store_internal_node i1 msgs0 st2 - Result.ret (st3, some v0) - | betree.List.Nil => + let ⟨ i, i1, n, n1 ⟩ := node + let (st1, msgs) ← betree.load_internal_node i st + let (pending, lookup_first_message_for_key_back) ← + betree.Node.lookup_first_message_for_key key msgs + match pending with + | betree.List.Cons p l => + let (k, msg) := p + if k != key + then do - let (st1, o) ← - betree.Internal.lookup_in_children (betree.Internal.mk i i0 n n0) - key st0 + let (st2, (o, i2)) ← + betree.Internal.lookup_in_children (betree.Internal.mk i i1 n n1) key + st1 + let _ ← + lookup_first_message_for_key_back (betree.List.Cons (k, msg) l) + Result.ret (st2, (o, betree.Node.Internal i2)) + else + match msg with + | betree.Message.Insert v => + do let _ ← - betree.Node.lookup_first_message_for_key_back key msgs - betree.List.Nil - Result.ret (st1, o) - | betree.Node.Leaf node => - do - let (st0, bindings) ← betree.load_leaf_node node.id st - let o ← betree.Node.lookup_in_bindings key bindings - Result.ret (st0, o) - -/- [betree_main::betree::{betree_main::betree::Node#5}::lookup]: backward function 0 - Source: 'src/betree.rs', lines 709:4-709:58 -/ -divergent def betree.Node.lookup_back - (self : betree.Node) (key : U64) (st : State) : Result betree.Node := - match self with - | betree.Node.Internal node => - do - let ⟨ i, i0, n, n0 ⟩ := node - let (st0, msgs) ← betree.load_internal_node i st - let pending ← betree.Node.lookup_first_message_for_key key msgs - match pending with - | betree.List.Cons p l => - let (k, msg) := p - if k != key - then + lookup_first_message_for_key_back (betree.List.Cons (k, + betree.Message.Insert v) l) + Result.ret (st1, (some v, betree.Node.Internal (betree.Internal.mk i + i1 n n1))) + | betree.Message.Delete => do - let _ ← - betree.Node.lookup_first_message_for_key_back key msgs - (betree.List.Cons (k, msg) l) - let node0 ← - betree.Internal.lookup_in_children_back (betree.Internal.mk i i0 - n n0) key st0 - Result.ret (betree.Node.Internal node0) - else - match msg with - | betree.Message.Insert v => - do - let _ ← - betree.Node.lookup_first_message_for_key_back key msgs - (betree.List.Cons (k, betree.Message.Insert v) l) - Result.ret (betree.Node.Internal (betree.Internal.mk i i0 n n0)) - | betree.Message.Delete => - do - let _ ← - betree.Node.lookup_first_message_for_key_back key msgs - (betree.List.Cons (k, betree.Message.Delete) l) - Result.ret (betree.Node.Internal (betree.Internal.mk i i0 n n0)) - | betree.Message.Upsert ufs => - do - let (st1, v) ← - betree.Internal.lookup_in_children (betree.Internal.mk i i0 n - n0) key st0 - let (st2, _) ← - betree.Node.apply_upserts (betree.List.Cons (k, - betree.Message.Upsert ufs) l) v key st1 - let node0 ← - betree.Internal.lookup_in_children_back (betree.Internal.mk i - i0 n n0) key st0 - let ⟨ i1, i2, n1, n2 ⟩ := node0 - let pending0 ← - betree.Node.apply_upserts_back (betree.List.Cons (k, - betree.Message.Upsert ufs) l) v key st1 - let msgs0 ← - betree.Node.lookup_first_message_for_key_back key msgs pending0 - let _ ← betree.store_internal_node i1 msgs0 st2 - Result.ret (betree.Node.Internal (betree.Internal.mk i1 i2 n1 - n2)) - | betree.List.Nil => - do let _ ← - betree.Node.lookup_first_message_for_key_back key msgs - betree.List.Nil - let node0 ← - betree.Internal.lookup_in_children_back (betree.Internal.mk i i0 n - n0) key st0 - Result.ret (betree.Node.Internal node0) + lookup_first_message_for_key_back (betree.List.Cons (k, + betree.Message.Delete) l) + Result.ret (st1, (none, betree.Node.Internal (betree.Internal.mk i i1 + n n1))) + | betree.Message.Upsert ufs => + do + let (st2, (v, i2)) ← + betree.Internal.lookup_in_children (betree.Internal.mk i i1 n n1) + key st1 + let (st3, (v1, l1)) ← + betree.Node.apply_upserts (betree.List.Cons (k, + betree.Message.Upsert ufs) l) v key st2 + let ⟨ i3, i4, n2, n3 ⟩ := i2 + let msgs1 ← lookup_first_message_for_key_back l1 + let (st4, _) ← betree.store_internal_node i3 msgs1 st3 + Result.ret (st4, (some v1, betree.Node.Internal (betree.Internal.mk + i3 i4 n2 n3))) + | betree.List.Nil => + do + let (st2, (o, i2)) ← + betree.Internal.lookup_in_children (betree.Internal.mk i i1 n n1) key + st1 + let _ ← lookup_first_message_for_key_back betree.List.Nil + Result.ret (st2, (o, betree.Node.Internal i2)) | betree.Node.Leaf node => do - let (_, bindings) ← betree.load_leaf_node node.id st - let _ ← betree.Node.lookup_in_bindings key bindings - Result.ret (betree.Node.Leaf node) + let (st1, bindings) ← betree.load_leaf_node node.id st + let o ← betree.Node.lookup_in_bindings key bindings + Result.ret (st1, (o, 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 ()) +/- [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: Source: 'src/betree.rs', lines 674:4-674:77 -/ divergent def betree.Node.filter_messages_for_key (key : U64) (msgs : betree.List (U64 × betree.Message)) : @@ -517,33 +353,19 @@ divergent def betree.Node.filter_messages_for_key if k = key then do - let msgs0 ← - betree.List.pop_front_back (U64 × betree.Message) (betree.List.Cons - (k, m) l) - betree.Node.filter_messages_for_key key msgs0 + let (_, l1) ← + betree.List.pop_front (U64 × betree.Message) (betree.List.Cons (k, m) + l) + betree.Node.filter_messages_for_key key l1 else Result.ret (betree.List.Cons (k, m) l) | betree.List.Nil => Result.ret betree.List.Nil -/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: forward function +/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: Source: 'src/betree.rs', lines 689:4-692:34 -/ divergent def betree.Node.lookup_first_message_after_key (key : U64) (msgs : betree.List (U64 × betree.Message)) : - Result (betree.List (U64 × betree.Message)) - := - match msgs with - | betree.List.Cons p next_msgs => - let (k, m) := p - if k = key - then betree.Node.lookup_first_message_after_key key next_msgs - else Result.ret (betree.List.Cons (k, m) next_msgs) - | betree.List.Nil => Result.ret betree.List.Nil - -/- [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 -/ -divergent def betree.Node.lookup_first_message_after_key_back - (key : U64) (msgs : betree.List (U64 × betree.Message)) - (ret : betree.List (U64 × betree.Message)) : - Result (betree.List (U64 × betree.Message)) + Result ((betree.List (U64 × betree.Message)) × (betree.List (U64 × + betree.Message) → Result (betree.List (U64 × betree.Message)))) := match msgs with | betree.List.Cons p next_msgs => @@ -551,14 +373,22 @@ divergent def betree.Node.lookup_first_message_after_key_back if k = key then do - let next_msgs0 ← - betree.Node.lookup_first_message_after_key_back key next_msgs ret - Result.ret (betree.List.Cons (k, m) next_msgs0) - else Result.ret ret - | betree.List.Nil => Result.ret ret + let (l, lookup_first_message_after_key_back) ← + betree.Node.lookup_first_message_after_key key next_msgs + let back_'a := + fun ret => + do + let next_msgs1 ← lookup_first_message_after_key_back ret + Result.ret (betree.List.Cons (k, m) next_msgs1) + Result.ret (l, back_'a) + else + let back_'a := fun ret => Result.ret ret + Result.ret (betree.List.Cons (k, m) next_msgs, back_'a) + | betree.List.Nil => + let back_'a := fun ret => Result.ret ret + Result.ret (betree.List.Nil, back_'a) -/- [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 ()) +/- [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: Source: 'src/betree.rs', lines 521:4-521:89 -/ def betree.Node.apply_to_internal (msgs : betree.List (U64 × betree.Message)) (key : U64) @@ -566,66 +396,63 @@ def betree.Node.apply_to_internal Result (betree.List (U64 × betree.Message)) := do - let msgs0 ← betree.Node.lookup_first_message_for_key key msgs - let b ← betree.ListTupleU64T.head_has_key betree.Message msgs0 key - if b - then - match new_msg with - | betree.Message.Insert i => + let (msgs1, lookup_first_message_for_key_back) ← + betree.Node.lookup_first_message_for_key key msgs + let b ← betree.ListTupleU64T.head_has_key betree.Message msgs1 key + if b + then + match new_msg with + | betree.Message.Insert i => + do + let l ← betree.Node.filter_messages_for_key key msgs1 + let l1 ← + betree.List.push_front (U64 × betree.Message) l (key, + betree.Message.Insert i) + lookup_first_message_for_key_back l1 + | betree.Message.Delete => + do + let l ← betree.Node.filter_messages_for_key key msgs1 + let l1 ← + betree.List.push_front (U64 × betree.Message) l (key, + betree.Message.Delete) + lookup_first_message_for_key_back l1 + | betree.Message.Upsert s => + do + let p ← betree.List.hd (U64 × betree.Message) msgs1 + let (_, m) := p + match m with + | betree.Message.Insert prev => do - let msgs1 ← betree.Node.filter_messages_for_key key msgs0 - let msgs2 ← - betree.List.push_front (U64 × betree.Message) msgs1 (key, - betree.Message.Insert i) - betree.Node.lookup_first_message_for_key_back key msgs msgs2 + let v ← betree.upsert_update (some prev) s + let (_, l) ← betree.List.pop_front (U64 × betree.Message) msgs1 + let l1 ← + betree.List.push_front (U64 × betree.Message) l (key, + betree.Message.Insert v) + lookup_first_message_for_key_back l1 | betree.Message.Delete => do - let msgs1 ← betree.Node.filter_messages_for_key key msgs0 - let msgs2 ← - betree.List.push_front (U64 × betree.Message) msgs1 (key, - betree.Message.Delete) - betree.Node.lookup_first_message_for_key_back key msgs msgs2 - | betree.Message.Upsert s => + let (_, l) ← betree.List.pop_front (U64 × betree.Message) msgs1 + let v ← betree.upsert_update none s + let l1 ← + betree.List.push_front (U64 × betree.Message) l (key, + betree.Message.Insert v) + lookup_first_message_for_key_back l1 + | betree.Message.Upsert _ => do - let p ← betree.List.hd (U64 × betree.Message) msgs0 - let (_, m) := p - match m with - | betree.Message.Insert prev => - do - let v ← betree.upsert_update (some prev) s - let msgs1 ← - betree.List.pop_front_back (U64 × betree.Message) msgs0 - let msgs2 ← - betree.List.push_front (U64 × betree.Message) msgs1 (key, - betree.Message.Insert v) - betree.Node.lookup_first_message_for_key_back key msgs msgs2 - | betree.Message.Delete => - do - let v ← betree.upsert_update none s - let msgs1 ← - betree.List.pop_front_back (U64 × betree.Message) msgs0 - let msgs2 ← - betree.List.push_front (U64 × betree.Message) msgs1 (key, - betree.Message.Insert v) - betree.Node.lookup_first_message_for_key_back key msgs msgs2 - | betree.Message.Upsert ufs => - do - let msgs1 ← - betree.Node.lookup_first_message_after_key key msgs0 - let msgs2 ← - betree.List.push_front (U64 × betree.Message) msgs1 (key, - betree.Message.Upsert s) - let msgs3 ← - betree.Node.lookup_first_message_after_key_back key msgs0 msgs2 - betree.Node.lookup_first_message_for_key_back key msgs msgs3 - else - do - let msgs1 ← - betree.List.push_front (U64 × betree.Message) msgs0 (key, new_msg) - betree.Node.lookup_first_message_for_key_back key msgs msgs1 + let (msgs2, lookup_first_message_after_key_back) ← + betree.Node.lookup_first_message_after_key key msgs1 + let l ← + betree.List.push_front (U64 × betree.Message) msgs2 (key, + betree.Message.Upsert s) + let msgs3 ← lookup_first_message_after_key_back l + lookup_first_message_for_key_back msgs3 + else + do + let l ← + betree.List.push_front (U64 × betree.Message) msgs1 (key, new_msg) + lookup_first_message_for_key_back l -/- [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 ()) +/- [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_internal]: Source: 'src/betree.rs', lines 502:4-505:5 -/ divergent def betree.Node.apply_messages_to_internal (msgs : betree.List (U64 × betree.Message)) @@ -635,45 +462,40 @@ divergent def betree.Node.apply_messages_to_internal match new_msgs with | betree.List.Cons new_msg new_msgs_tl => do - let (i, m) := new_msg - let msgs0 ← betree.Node.apply_to_internal msgs i m - betree.Node.apply_messages_to_internal msgs0 new_msgs_tl + let (i, m) := new_msg + let l ← betree.Node.apply_to_internal msgs i m + betree.Node.apply_messages_to_internal l new_msgs_tl | betree.List.Nil => Result.ret msgs -/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: forward function +/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: Source: 'src/betree.rs', lines 653:4-656:32 -/ divergent def betree.Node.lookup_mut_in_bindings (key : U64) (bindings : betree.List (U64 × U64)) : - Result (betree.List (U64 × U64)) + Result ((betree.List (U64 × U64)) × (betree.List (U64 × U64) → Result + (betree.List (U64 × U64)))) := match bindings with | betree.List.Cons hd tl => - let (i, i0) := hd + let (i, i1) := hd if i >= key - then Result.ret (betree.List.Cons (i, i0) tl) - else betree.Node.lookup_mut_in_bindings key tl - | betree.List.Nil => Result.ret betree.List.Nil - -/- [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: backward function 0 - Source: 'src/betree.rs', lines 653:4-656:32 -/ -divergent def betree.Node.lookup_mut_in_bindings_back - (key : U64) (bindings : betree.List (U64 × U64)) - (ret : betree.List (U64 × U64)) : - Result (betree.List (U64 × U64)) - := - match bindings with - | betree.List.Cons hd tl => - let (i, i0) := hd - if i >= key - then Result.ret ret + then + let back_'a := fun ret => Result.ret ret + Result.ret (betree.List.Cons (i, i1) tl, back_'a) else do - let tl0 ← betree.Node.lookup_mut_in_bindings_back key tl ret - Result.ret (betree.List.Cons (i, i0) tl0) - | betree.List.Nil => Result.ret ret - -/- [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 ()) + let (l, lookup_mut_in_bindings_back) ← + betree.Node.lookup_mut_in_bindings key tl + let back_'a := + fun ret => + do + let tl1 ← lookup_mut_in_bindings_back ret + Result.ret (betree.List.Cons (i, i1) tl1) + Result.ret (l, back_'a) + | betree.List.Nil => + let back_'a := fun ret => Result.ret ret + Result.ret (betree.List.Nil, back_'a) + +/- [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: Source: 'src/betree.rs', lines 460:4-460:87 -/ def betree.Node.apply_to_leaf (bindings : betree.List (U64 × U64)) (key : U64) (new_msg : betree.Message) @@ -681,49 +503,39 @@ def betree.Node.apply_to_leaf Result (betree.List (U64 × U64)) := do - let bindings0 ← betree.Node.lookup_mut_in_bindings key bindings - let b ← betree.ListTupleU64T.head_has_key U64 bindings0 key - if b - then + let (bindings1, lookup_mut_in_bindings_back) ← + betree.Node.lookup_mut_in_bindings key bindings + let b ← betree.ListTupleU64T.head_has_key U64 bindings1 key + if b + then + do + let (hd, l) ← betree.List.pop_front (U64 × U64) bindings1 + match new_msg with + | betree.Message.Insert v => do - let hd ← betree.List.pop_front (U64 × U64) bindings0 - match new_msg with - | betree.Message.Insert v => - do - let bindings1 ← betree.List.pop_front_back (U64 × U64) bindings0 - let bindings2 ← - betree.List.push_front (U64 × U64) bindings1 (key, v) - betree.Node.lookup_mut_in_bindings_back key bindings bindings2 - | betree.Message.Delete => - do - let bindings1 ← betree.List.pop_front_back (U64 × U64) bindings0 - betree.Node.lookup_mut_in_bindings_back key bindings bindings1 - | betree.Message.Upsert s => - do - let (_, i) := hd - let v ← betree.upsert_update (some i) s - let bindings1 ← betree.List.pop_front_back (U64 × U64) bindings0 - let bindings2 ← - betree.List.push_front (U64 × U64) bindings1 (key, v) - betree.Node.lookup_mut_in_bindings_back key bindings bindings2 - else - match new_msg with - | betree.Message.Insert v => - do - let bindings1 ← - betree.List.push_front (U64 × U64) bindings0 (key, v) - betree.Node.lookup_mut_in_bindings_back key bindings bindings1 - | betree.Message.Delete => - betree.Node.lookup_mut_in_bindings_back key bindings bindings0 - | betree.Message.Upsert s => - do - let v ← betree.upsert_update none s - let bindings1 ← - betree.List.push_front (U64 × U64) bindings0 (key, v) - betree.Node.lookup_mut_in_bindings_back key bindings bindings1 + let l1 ← betree.List.push_front (U64 × U64) l (key, v) + lookup_mut_in_bindings_back l1 + | betree.Message.Delete => lookup_mut_in_bindings_back l + | betree.Message.Upsert s => + do + let (_, i) := hd + let v ← betree.upsert_update (some i) s + let l1 ← betree.List.push_front (U64 × U64) l (key, v) + lookup_mut_in_bindings_back l1 + else + match new_msg with + | betree.Message.Insert v => + do + let l ← betree.List.push_front (U64 × U64) bindings1 (key, v) + lookup_mut_in_bindings_back l + | betree.Message.Delete => lookup_mut_in_bindings_back bindings1 + | betree.Message.Upsert s => + do + let v ← betree.upsert_update none s + let l ← betree.List.push_front (U64 × U64) bindings1 (key, v) + lookup_mut_in_bindings_back l -/- [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 ()) +/- [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_leaf]: Source: 'src/betree.rs', lines 444:4-447:5 -/ divergent def betree.Node.apply_messages_to_leaf (bindings : betree.List (U64 × U64)) @@ -733,337 +545,183 @@ divergent def betree.Node.apply_messages_to_leaf match new_msgs with | betree.List.Cons new_msg new_msgs_tl => do - let (i, m) := new_msg - let bindings0 ← betree.Node.apply_to_leaf bindings i m - betree.Node.apply_messages_to_leaf bindings0 new_msgs_tl + let (i, m) := new_msg + let l ← betree.Node.apply_to_leaf bindings i m + betree.Node.apply_messages_to_leaf l new_msgs_tl | betree.List.Nil => Result.ret bindings -/- [betree_main::betree::{betree_main::betree::Internal#4}::flush]: forward function +/- [betree_main::betree::{betree_main::betree::Internal#4}::flush]: Source: 'src/betree.rs', lines 410:4-415:26 -/ mutual divergent def betree.Internal.flush (self : betree.Internal) (params : betree.Params) (node_id_cnt : betree.NodeIdCounter) (content : betree.List (U64 × betree.Message)) (st : State) : - Result (State × (betree.List (U64 × betree.Message))) - := - do - let ⟨ _, i, n, n0 ⟩ := self - let p ← betree.ListTupleU64T.partition_at_pivot betree.Message content i - let (msgs_left, msgs_right) := p - let len_left ← betree.List.len (U64 × betree.Message) msgs_left - if len_left >= params.min_flush_size - then - do - let (st0, _) ← - betree.Node.apply_messages n params node_id_cnt msgs_left st - let (_, node_id_cnt0) ← - betree.Node.apply_messages_back n params node_id_cnt msgs_left st - let len_right ← betree.List.len (U64 × betree.Message) msgs_right - if len_right >= params.min_flush_size - then - do - let (st1, _) ← - betree.Node.apply_messages n0 params node_id_cnt0 msgs_right st0 - let _ ← - betree.Node.apply_messages_back n0 params node_id_cnt0 msgs_right - st0 - Result.ret (st1, betree.List.Nil) - else Result.ret (st0, msgs_right) - else - do - let (st0, _) ← - betree.Node.apply_messages n0 params node_id_cnt msgs_right st - let _ ← - betree.Node.apply_messages_back n0 params node_id_cnt msgs_right st - Result.ret (st0, msgs_left) - -/- [betree_main::betree::{betree_main::betree::Internal#4}::flush]: backward function 0 - Source: 'src/betree.rs', lines 410:4-415:26 -/ -divergent def betree.Internal.flush_back - (self : betree.Internal) (params : betree.Params) - (node_id_cnt : betree.NodeIdCounter) - (content : betree.List (U64 × betree.Message)) (st : State) : - Result (betree.Internal × betree.NodeIdCounter) + Result (State × ((betree.List (U64 × betree.Message)) × (betree.Internal + × betree.NodeIdCounter))) := do - let ⟨ i, i0, n, n0 ⟩ := self - let p ← betree.ListTupleU64T.partition_at_pivot betree.Message content i0 - let (msgs_left, msgs_right) := p - let len_left ← betree.List.len (U64 × betree.Message) msgs_left - if len_left >= params.min_flush_size + let ⟨ i, i1, n, n1 ⟩ := self + let p ← betree.ListTupleU64T.partition_at_pivot betree.Message content i1 + let (msgs_left, msgs_right) := p + let len_left ← betree.List.len (U64 × betree.Message) msgs_left + if len_left >= params.min_flush_size + then + do + let (st1, p1) ← + betree.Node.apply_messages n params node_id_cnt msgs_left st + let (n2, node_id_cnt1) := p1 + let len_right ← betree.List.len (U64 × betree.Message) msgs_right + if len_right >= params.min_flush_size then do - let (st0, _) ← - betree.Node.apply_messages 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 (U64 × betree.Message) msgs_right - if len_right >= params.min_flush_size - then - do - let (n2, node_id_cnt1) ← - betree.Node.apply_messages_back n0 params node_id_cnt0 msgs_right - st0 - Result.ret (betree.Internal.mk i i0 n1 n2, node_id_cnt1) - else Result.ret (betree.Internal.mk i i0 n1 n0, node_id_cnt0) + let (st2, p2) ← + betree.Node.apply_messages n1 params node_id_cnt1 msgs_right st1 + let (n3, node_id_cnt2) := p2 + Result.ret (st2, (betree.List.Nil, (betree.Internal.mk i i1 n2 n3, + node_id_cnt2))) else - do - let (n1, node_id_cnt0) ← - betree.Node.apply_messages_back n0 params node_id_cnt msgs_right st - Result.ret (betree.Internal.mk i i0 n n1, node_id_cnt0) - -/- [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: forward function - Source: 'src/betree.rs', lines 588:4-593:5 -/ -divergent def betree.Node.apply_messages - (self : betree.Node) (params : betree.Params) - (node_id_cnt : betree.NodeIdCounter) - (msgs : betree.List (U64 × betree.Message)) (st : State) : - Result (State × Unit) - := - match self with - | betree.Node.Internal node => - do - let ⟨ i, i0, n, n0 ⟩ := node - let (st0, content) ← betree.load_internal_node i st - let content0 ← betree.Node.apply_messages_to_internal content msgs - let num_msgs ← betree.List.len (U64 × betree.Message) content0 - if num_msgs >= params.min_flush_size - then - do - let (st1, content1) ← - betree.Internal.flush (betree.Internal.mk i i0 n n0) params - node_id_cnt content0 st0 - let (node0, _) ← - betree.Internal.flush_back (betree.Internal.mk i i0 n n0) params - node_id_cnt content0 st0 - let ⟨ i1, _, _, _ ⟩ := node0 - let (st2, _) ← betree.store_internal_node i1 content1 st1 - Result.ret (st2, ()) - else - do - let (st1, _) ← betree.store_internal_node i content0 st0 - Result.ret (st1, ()) - | betree.Node.Leaf node => + Result.ret (st1, (msgs_right, (betree.Internal.mk i i1 n2 n1, + node_id_cnt1))) + else do - let (st0, content) ← betree.load_leaf_node node.id st - let content0 ← betree.Node.apply_messages_to_leaf content msgs - let len ← betree.List.len (U64 × U64) content0 - let i ← 2#u64 * params.split_size - if len >= i - then - do - let (st1, _) ← - betree.Leaf.split node content0 params node_id_cnt st0 - let (st2, _) ← betree.store_leaf_node node.id betree.List.Nil st1 - Result.ret (st2, ()) - else - do - let (st1, _) ← betree.store_leaf_node node.id content0 st0 - Result.ret (st1, ()) + let (st1, p1) ← + betree.Node.apply_messages n1 params node_id_cnt msgs_right st + let (n2, node_id_cnt1) := p1 + Result.ret (st1, (msgs_left, (betree.Internal.mk i i1 n n2, node_id_cnt1))) -/- [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: backward function 0 +/- [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: Source: 'src/betree.rs', lines 588:4-593:5 -/ -divergent def betree.Node.apply_messages_back +divergent def betree.Node.apply_messages (self : betree.Node) (params : betree.Params) (node_id_cnt : betree.NodeIdCounter) (msgs : betree.List (U64 × betree.Message)) (st : State) : - Result (betree.Node × betree.NodeIdCounter) + Result (State × (betree.Node × betree.NodeIdCounter)) := match self with | betree.Node.Internal node => do - let ⟨ i, i0, n, n0 ⟩ := node - let (st0, content) ← betree.load_internal_node i st - let content0 ← betree.Node.apply_messages_to_internal content msgs - let num_msgs ← betree.List.len (U64 × betree.Message) content0 - if num_msgs >= params.min_flush_size - then - do - let (st1, content1) ← - betree.Internal.flush (betree.Internal.mk i i0 n n0) params - node_id_cnt content0 st0 - let (node0, node_id_cnt0) ← - betree.Internal.flush_back (betree.Internal.mk i i0 n n0) params - node_id_cnt content0 st0 - let ⟨ i1, i2, n1, n2 ⟩ := node0 - let _ ← betree.store_internal_node i1 content1 st1 - Result.ret (betree.Node.Internal (betree.Internal.mk i1 i2 n1 n2), - node_id_cnt0) - else - do - let _ ← betree.store_internal_node i content0 st0 - Result.ret (betree.Node.Internal (betree.Internal.mk i i0 n n0), - node_id_cnt) + let ⟨ i, i1, n, n1 ⟩ := node + let (st1, content) ← betree.load_internal_node i st + let l ← betree.Node.apply_messages_to_internal content msgs + let num_msgs ← betree.List.len (U64 × betree.Message) l + if num_msgs >= params.min_flush_size + then + do + let (st2, (content1, p)) ← + betree.Internal.flush (betree.Internal.mk i i1 n n1) params node_id_cnt + l st1 + let (node1, node_id_cnt1) := p + let ⟨ i2, i3, n2, n3 ⟩ := node1 + let (st3, _) ← betree.store_internal_node i2 content1 st2 + Result.ret (st3, (betree.Node.Internal (betree.Internal.mk i2 i3 n2 n3), + node_id_cnt1)) + else + do + let (st2, _) ← betree.store_internal_node i l st1 + Result.ret (st2, (betree.Node.Internal (betree.Internal.mk i i1 n n1), + node_id_cnt)) | betree.Node.Leaf node => do - let (st0, content) ← betree.load_leaf_node node.id st - let content0 ← betree.Node.apply_messages_to_leaf content msgs - let len ← betree.List.len (U64 × U64) content0 - let i ← 2#u64 * params.split_size - if len >= i - then - do - let (st1, new_node) ← - betree.Leaf.split node content0 params node_id_cnt st0 - let _ ← betree.store_leaf_node node.id betree.List.Nil st1 - let node_id_cnt0 ← - betree.Leaf.split_back node content0 params node_id_cnt st0 - Result.ret (betree.Node.Internal new_node, node_id_cnt0) - else - do - let _ ← betree.store_leaf_node node.id content0 st0 - Result.ret (betree.Node.Leaf { node with size := len }, node_id_cnt) + let (st1, content) ← betree.load_leaf_node node.id st + let l ← betree.Node.apply_messages_to_leaf content msgs + let len ← betree.List.len (U64 × U64) l + let i ← 2#u64 * params.split_size + if len >= i + then + do + let (st2, (new_node, nic)) ← + betree.Leaf.split node l params node_id_cnt st1 + let (st3, _) ← betree.store_leaf_node node.id betree.List.Nil st2 + Result.ret (st3, (betree.Node.Internal new_node, nic)) + else + do + let (st2, _) ← betree.store_leaf_node node.id l st1 + Result.ret (st2, (betree.Node.Leaf { node with size := len }, + node_id_cnt)) end -/- [betree_main::betree::{betree_main::betree::Node#5}::apply]: forward function +/- [betree_main::betree::{betree_main::betree::Node#5}::apply]: Source: 'src/betree.rs', lines 576:4-582:5 -/ def betree.Node.apply (self : betree.Node) (params : betree.Params) (node_id_cnt : betree.NodeIdCounter) (key : U64) (new_msg : betree.Message) (st : State) : - Result (State × Unit) + Result (State × (betree.Node × betree.NodeIdCounter)) := do - let l := betree.List.Nil - let (st0, _) ← - betree.Node.apply_messages self params node_id_cnt (betree.List.Cons - (key, new_msg) l) st - let _ ← - betree.Node.apply_messages_back self params node_id_cnt (betree.List.Cons - (key, new_msg) l) st - Result.ret (st0, ()) - -/- [betree_main::betree::{betree_main::betree::Node#5}::apply]: backward function 0 - Source: 'src/betree.rs', lines 576:4-582:5 -/ -def betree.Node.apply_back - (self : betree.Node) (params : betree.Params) - (node_id_cnt : betree.NodeIdCounter) (key : U64) (new_msg : betree.Message) - (st : State) : - Result (betree.Node × betree.NodeIdCounter) - := let l := betree.List.Nil - betree.Node.apply_messages_back self params node_id_cnt (betree.List.Cons - (key, new_msg) l) st + let (st1, p) ← + betree.Node.apply_messages self params node_id_cnt (betree.List.Cons (key, + new_msg) l) st + let (self1, node_id_cnt1) := p + Result.ret (st1, (self1, node_id_cnt1)) -/- [betree_main::betree::{betree_main::betree::BeTree#6}::new]: forward function +/- [betree_main::betree::{betree_main::betree::BeTree#6}::new]: Source: 'src/betree.rs', lines 849:4-849:60 -/ def betree.BeTree.new (min_flush_size : U64) (split_size : U64) (st : State) : Result (State × betree.BeTree) := do - let node_id_cnt ← betree.NodeIdCounter.new - let id ← betree.NodeIdCounter.fresh_id node_id_cnt - let (st0, _) ← betree.store_leaf_node id betree.List.Nil st - let node_id_cnt0 ← betree.NodeIdCounter.fresh_id_back node_id_cnt - Result.ret (st0, - { - params := - { min_flush_size := min_flush_size, split_size := split_size }, - node_id_cnt := node_id_cnt0, - root := (betree.Node.Leaf { id := id, size := 0#u64 }) - }) - -/- [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: forward function + let node_id_cnt ← betree.NodeIdCounter.new + let (id, nic) ← betree.NodeIdCounter.fresh_id node_id_cnt + let (st1, _) ← betree.store_leaf_node id betree.List.Nil st + Result.ret (st1, + { + params := { min_flush_size := min_flush_size, split_size := split_size }, + node_id_cnt := nic, + root := (betree.Node.Leaf { id := id, size := 0#u64 }) + }) + +/- [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: Source: 'src/betree.rs', lines 868:4-868:47 -/ def betree.BeTree.apply (self : betree.BeTree) (key : U64) (msg : betree.Message) (st : State) : - Result (State × Unit) - := - do - let (st0, _) ← - betree.Node.apply self.root self.params self.node_id_cnt key msg st - let _ ← - betree.Node.apply_back self.root self.params self.node_id_cnt key msg st - Result.ret (st0, ()) - -/- [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: backward function 0 - Source: 'src/betree.rs', lines 868:4-868:47 -/ -def betree.BeTree.apply_back - (self : betree.BeTree) (key : U64) (msg : betree.Message) (st : State) : - Result betree.BeTree + Result (State × betree.BeTree) := do - let (n, nic) ← - betree.Node.apply_back self.root self.params self.node_id_cnt key msg st - Result.ret { self with node_id_cnt := nic, root := n } + let (st1, p) ← + betree.Node.apply self.root self.params self.node_id_cnt key msg st + let (n, nic) := p + Result.ret (st1, { self with node_id_cnt := nic, root := n }) -/- [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: forward function +/- [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: Source: 'src/betree.rs', lines 874:4-874:52 -/ def betree.BeTree.insert (self : betree.BeTree) (key : U64) (value : U64) (st : State) : - Result (State × Unit) - := - do - let (st0, _) ← - betree.BeTree.apply self key (betree.Message.Insert value) st - let _ ← - betree.BeTree.apply_back self key (betree.Message.Insert value) st - Result.ret (st0, ()) - -/- [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: backward function 0 - Source: 'src/betree.rs', lines 874:4-874:52 -/ -def betree.BeTree.insert_back - (self : betree.BeTree) (key : U64) (value : U64) (st : State) : - Result betree.BeTree + Result (State × betree.BeTree) := - betree.BeTree.apply_back self key (betree.Message.Insert value) st + betree.BeTree.apply self key (betree.Message.Insert value) st -/- [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: forward function +/- [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: Source: 'src/betree.rs', lines 880:4-880:38 -/ def betree.BeTree.delete - (self : betree.BeTree) (key : U64) (st : State) : Result (State × Unit) := - do - let (st0, _) ← betree.BeTree.apply self key betree.Message.Delete st - let _ ← betree.BeTree.apply_back self key betree.Message.Delete st - Result.ret (st0, ()) - -/- [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: backward function 0 - Source: 'src/betree.rs', lines 880:4-880:38 -/ -def betree.BeTree.delete_back - (self : betree.BeTree) (key : U64) (st : State) : Result betree.BeTree := - 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 -/ -def betree.BeTree.upsert - (self : betree.BeTree) (key : U64) (upd : betree.UpsertFunState) (st : State) - : - Result (State × Unit) + (self : betree.BeTree) (key : U64) (st : State) : + Result (State × betree.BeTree) := - do - let (st0, _) ← - betree.BeTree.apply self key (betree.Message.Upsert upd) st - let _ ← betree.BeTree.apply_back self key (betree.Message.Upsert upd) st - Result.ret (st0, ()) + betree.BeTree.apply self key betree.Message.Delete st -/- [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: backward function 0 +/- [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: Source: 'src/betree.rs', lines 886:4-886:59 -/ -def betree.BeTree.upsert_back +def betree.BeTree.upsert (self : betree.BeTree) (key : U64) (upd : betree.UpsertFunState) (st : State) : - Result betree.BeTree + Result (State × betree.BeTree) := - betree.BeTree.apply_back self key (betree.Message.Upsert upd) st + betree.BeTree.apply self key (betree.Message.Upsert upd) st -/- [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: forward function +/- [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: Source: 'src/betree.rs', lines 895:4-895:62 -/ def betree.BeTree.lookup (self : betree.BeTree) (key : U64) (st : State) : - Result (State × (Option U64)) + Result (State × ((Option U64) × betree.BeTree)) := - 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 -/ -def betree.BeTree.lookup_back - (self : betree.BeTree) (key : U64) (st : State) : Result betree.BeTree := do - let n ← betree.Node.lookup_back self.root key st - Result.ret { self with root := n } + let (st1, (o, n)) ← betree.Node.lookup self.root key st + Result.ret (st1, (o, { self with root := n })) -/- [betree_main::main]: forward function +/- [betree_main::main]: Source: 'src/betree_main.rs', lines 5:0-5:9 -/ def main : Result Unit := Result.ret () diff --git a/tests/lean/BetreeMain/FunsExternal_Template.lean b/tests/lean/BetreeMain/FunsExternal_Template.lean index 95f88873..eaa4b6c2 100644 --- a/tests/lean/BetreeMain/FunsExternal_Template.lean +++ b/tests/lean/BetreeMain/FunsExternal_Template.lean @@ -6,29 +6,29 @@ import BetreeMain.Types open Primitives open betree_main -/- [betree_main::betree_utils::load_internal_node]: forward function +/- [betree_main::betree_utils::load_internal_node]: Source: 'src/betree_utils.rs', lines 98:0-98:63 -/ axiom betree_utils.load_internal_node : U64 → State → Result (State × (betree.List (U64 × betree.Message))) -/- [betree_main::betree_utils::store_internal_node]: forward function +/- [betree_main::betree_utils::store_internal_node]: Source: 'src/betree_utils.rs', lines 115:0-115:71 -/ axiom betree_utils.store_internal_node : U64 → betree.List (U64 × betree.Message) → State → Result (State × Unit) -/- [betree_main::betree_utils::load_leaf_node]: forward function +/- [betree_main::betree_utils::load_leaf_node]: Source: 'src/betree_utils.rs', lines 132:0-132:55 -/ axiom betree_utils.load_leaf_node : U64 → State → Result (State × (betree.List (U64 × U64))) -/- [betree_main::betree_utils::store_leaf_node]: forward function +/- [betree_main::betree_utils::store_leaf_node]: Source: 'src/betree_utils.rs', lines 145:0-145:63 -/ axiom betree_utils.store_leaf_node : U64 → betree.List (U64 × U64) → State → Result (State × Unit) -/- [core::option::{core::option::Option}::unwrap]: forward function +/- [core::option::{core::option::Option}::unwrap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 -/ axiom core.option.Option.unwrap (T : Type) : Option T → State → Result (State × T) diff --git a/tests/lean/Bitwise.lean b/tests/lean/Bitwise.lean index c8538aa2..7c47e3dd 100644 --- a/tests/lean/Bitwise.lean +++ b/tests/lean/Bitwise.lean @@ -5,31 +5,31 @@ open Primitives namespace bitwise -/- [bitwise::shift_u32]: forward function +/- [bitwise::shift_u32]: Source: 'src/bitwise.rs', lines 3:0-3:31 -/ def shift_u32 (a : U32) : Result U32 := do - let t ← a >>> 16#usize - t <<< 16#usize + let t ← a >>> 16#usize + t <<< 16#usize -/- [bitwise::shift_i32]: forward function +/- [bitwise::shift_i32]: Source: 'src/bitwise.rs', lines 10:0-10:31 -/ def shift_i32 (a : I32) : Result I32 := do - let t ← a >>> 16#isize - t <<< 16#isize + let t ← a >>> 16#isize + t <<< 16#isize -/- [bitwise::xor_u32]: forward function +/- [bitwise::xor_u32]: Source: 'src/bitwise.rs', lines 17:0-17:37 -/ def xor_u32 (a : U32) (b : U32) : Result U32 := Result.ret (a ^^^ b) -/- [bitwise::or_u32]: forward function +/- [bitwise::or_u32]: Source: 'src/bitwise.rs', lines 21:0-21:36 -/ def or_u32 (a : U32) (b : U32) : Result U32 := Result.ret (a ||| b) -/- [bitwise::and_u32]: forward function +/- [bitwise::and_u32]: Source: 'src/bitwise.rs', lines 25:0-25:37 -/ def and_u32 (a : U32) (b : U32) : Result U32 := Result.ret (a &&& b) diff --git a/tests/lean/Constants.lean b/tests/lean/Constants.lean index 80864427..2912805f 100644 --- a/tests/lean/Constants.lean +++ b/tests/lean/Constants.lean @@ -20,7 +20,7 @@ def x1_c : U32 := eval_global x1_body (by simp) def x2_body : Result U32 := Result.ret 3#u32 def x2_c : U32 := eval_global x2_body (by simp) -/- [constants::incr]: forward function +/- [constants::incr]: Source: 'src/constants.rs', lines 17:0-17:32 -/ def incr (n : U32) : Result U32 := n + 1#u32 @@ -30,7 +30,7 @@ def incr (n : U32) : Result U32 := def x3_body : Result U32 := incr 32#u32 def x3_c : U32 := eval_global x3_body (by simp) -/- [constants::mk_pair0]: forward function +/- [constants::mk_pair0]: Source: 'src/constants.rs', lines 23:0-23:51 -/ def mk_pair0 (x : U32) (y : U32) : Result (U32 × U32) := Result.ret (x, y) @@ -41,7 +41,7 @@ structure Pair (T1 T2 : Type) where x : T1 y : T2 -/- [constants::mk_pair1]: forward function +/- [constants::mk_pair1]: Source: 'src/constants.rs', lines 27:0-27:55 -/ def mk_pair1 (x : U32) (y : U32) : Result (Pair U32 U32) := Result.ret { x := x, y := y } @@ -71,7 +71,7 @@ def p3_c : Pair U32 U32 := eval_global p3_body (by simp) structure Wrap (T : Type) where value : T -/- [constants::{constants::Wrap}::new]: forward function +/- [constants::{constants::Wrap}::new]: Source: 'src/constants.rs', lines 54:4-54:41 -/ def Wrap.new (T : Type) (value : T) : Result (Wrap T) := Result.ret { value := value } @@ -81,7 +81,7 @@ def Wrap.new (T : Type) (value : T) : Result (Wrap T) := def y_body : Result (Wrap I32) := Wrap.new I32 2#i32 def y_c : Wrap I32 := eval_global y_body (by simp) -/- [constants::unwrap_y]: forward function +/- [constants::unwrap_y]: Source: 'src/constants.rs', lines 43:0-43:30 -/ def unwrap_y : Result I32 := Result.ret y_c.value @@ -96,12 +96,12 @@ def yval_c : I32 := eval_global yval_body (by simp) def get_z1_z1_body : Result I32 := Result.ret 3#i32 def get_z1_z1_c : I32 := eval_global get_z1_z1_body (by simp) -/- [constants::get_z1]: forward function +/- [constants::get_z1]: Source: 'src/constants.rs', lines 61:0-61:28 -/ def get_z1 : Result I32 := Result.ret get_z1_z1_c -/- [constants::add]: forward function +/- [constants::add]: Source: 'src/constants.rs', lines 66:0-66:39 -/ def add (a : I32) (b : I32) : Result I32 := a + b @@ -121,13 +121,13 @@ def q2_c : I32 := eval_global q2_body (by simp) def q3_body : Result I32 := add q2_c 3#i32 def q3_c : I32 := eval_global q3_body (by simp) -/- [constants::get_z2]: forward function +/- [constants::get_z2]: Source: 'src/constants.rs', lines 70:0-70:28 -/ def get_z2 : Result I32 := do - let i ← get_z1 - let i0 ← add i q3_c - add q1_c i0 + let i ← get_z1 + let i1 ← add i q3_c + add q1_c i1 /- [constants::S1] Source: 'src/constants.rs', lines 80:0-80:18 -/ diff --git a/tests/lean/External/Funs.lean b/tests/lean/External/Funs.lean index 48ec6ad5..88ced82d 100644 --- a/tests/lean/External/Funs.lean +++ b/tests/lean/External/Funs.lean @@ -7,92 +7,59 @@ open Primitives namespace external -/- [external::swap]: forward function +/- [external::swap]: Source: 'src/external.rs', lines 6:0-6:46 -/ -def swap (T : Type) (x : T) (y : T) (st : State) : Result (State × Unit) := - do - let (st0, _) ← core.mem.swap T x y st - let (st1, _) ← core.mem.swap_back0 T x y st st0 - let (st2, _) ← core.mem.swap_back1 T x y st st1 - Result.ret (st2, ()) - -/- [external::swap]: backward function 0 - Source: 'src/external.rs', lines 6:0-6:46 -/ -def swap_back - (T : Type) (x : T) (y : T) (st : State) (st0 : State) : - Result (State × (T × T)) - := - do - let (st1, _) ← core.mem.swap T x y st - let (st2, x0) ← core.mem.swap_back0 T x y st st1 - let (_, y0) ← core.mem.swap_back1 T x y st st2 - Result.ret (st0, (x0, y0)) +def swap + (T : Type) (x : T) (y : T) (st : State) : Result (State × (T × T)) := + core.mem.swap T x y st -/- [external::test_new_non_zero_u32]: forward function +/- [external::test_new_non_zero_u32]: Source: 'src/external.rs', lines 11:0-11:60 -/ def test_new_non_zero_u32 (x : U32) (st : State) : Result (State × core.num.nonzero.NonZeroU32) := do - let (st0, o) ← core.num.nonzero.NonZeroU32.new x st - core.option.Option.unwrap core.num.nonzero.NonZeroU32 o st0 + let (st1, o) ← core.num.nonzero.NonZeroU32.new x st + core.option.Option.unwrap core.num.nonzero.NonZeroU32 o st1 -/- [external::test_vec]: forward function +/- [external::test_vec]: Source: 'src/external.rs', lines 17:0-17:17 -/ def test_vec : Result Unit := do - let v := alloc.vec.Vec.new U32 - let _ ← alloc.vec.Vec.push U32 v 0#u32 - Result.ret () + let v := alloc.vec.Vec.new U32 + let _ ← alloc.vec.Vec.push U32 v 0#u32 + Result.ret () /- Unit test for [external::test_vec] -/ #assert (test_vec == Result.ret ()) -/- [external::custom_swap]: forward function +/- [external::custom_swap]: Source: 'src/external.rs', lines 24:0-24:66 -/ def custom_swap - (T : Type) (x : T) (y : T) (st : State) : Result (State × T) := - do - let (st0, _) ← core.mem.swap T x y st - let (st1, x0) ← core.mem.swap_back0 T x y st st0 - let (st2, _) ← core.mem.swap_back1 T x y st st1 - Result.ret (st2, x0) - -/- [external::custom_swap]: backward function 0 - Source: 'src/external.rs', lines 24:0-24:66 -/ -def custom_swap_back - (T : Type) (x : T) (y : T) (st : State) (ret : T) (st0 : State) : - Result (State × (T × T)) + (T : Type) (x : T) (y : T) (st : State) : + Result (State × (T × (T → State → Result (State × (T × T))))) := do - let (st1, _) ← core.mem.swap T x y st - let (st2, _) ← core.mem.swap_back0 T x y st st1 - let (_, y0) ← core.mem.swap_back1 T x y st st2 - Result.ret (st0, (ret, y0)) + let (st1, (t, t1)) ← core.mem.swap T x y st + let back_'a := fun ret st2 => Result.ret (st2, (ret, t1)) + Result.ret (st1, (t, back_'a)) -/- [external::test_custom_swap]: forward function +/- [external::test_custom_swap]: Source: 'src/external.rs', lines 29:0-29:59 -/ def test_custom_swap - (x : U32) (y : U32) (st : State) : Result (State × Unit) := + (x : U32) (y : U32) (st : State) : Result (State × (U32 × U32)) := do - let (st0, _) ← custom_swap U32 x y st - Result.ret (st0, ()) - -/- [external::test_custom_swap]: backward function 0 - Source: 'src/external.rs', lines 29:0-29:59 -/ -def test_custom_swap_back - (x : U32) (y : U32) (st : State) (st0 : State) : - Result (State × (U32 × U32)) - := - custom_swap_back U32 x y st 1#u32 st0 + let (st1, (_, custom_swap_back)) ← custom_swap U32 x y st + let (_, (x1, y1)) ← custom_swap_back 1#u32 st1 + Result.ret (st1, (x1, y1)) -/- [external::test_swap_non_zero]: forward function +/- [external::test_swap_non_zero]: Source: 'src/external.rs', lines 35:0-35:44 -/ def test_swap_non_zero (x : U32) (st : State) : Result (State × U32) := do - let (st0, _) ← swap U32 x 0#u32 st - let (st1, (x0, _)) ← swap_back U32 x 0#u32 st st0 - if x0 = 0#u32 - then Result.fail .panic - else Result.ret (st1, x0) + let (st1, p) ← swap U32 x 0#u32 st + let (x1, _) := p + if x1 = 0#u32 + then Result.fail .panic + else Result.ret (st1, x1) end external diff --git a/tests/lean/External/FunsExternal_Template.lean b/tests/lean/External/FunsExternal_Template.lean index 55cd6bb5..7e237369 100644 --- a/tests/lean/External/FunsExternal_Template.lean +++ b/tests/lean/External/FunsExternal_Template.lean @@ -6,26 +6,17 @@ import External.Types open Primitives open external -/- [core::mem::swap]: forward function +/- [core::mem::swap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 -/ -axiom core.mem.swap (T : Type) : T → T → State → Result (State × Unit) +axiom core.mem.swap + (T : Type) : T → T → State → Result (State × (T × T)) -/- [core::mem::swap]: backward function 0 - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 -/ -axiom core.mem.swap_back0 - (T : Type) : T → T → State → State → Result (State × T) - -/- [core::mem::swap]: backward function 1 - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 -/ -axiom core.mem.swap_back1 - (T : Type) : T → T → State → State → Result (State × T) - -/- [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function +/- [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 -/ axiom core.num.nonzero.NonZeroU32.new : U32 → State → Result (State × (Option core.num.nonzero.NonZeroU32)) -/- [core::option::{core::option::Option}::unwrap]: forward function +/- [core::option::{core::option::Option}::unwrap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 -/ axiom core.option.Option.unwrap (T : Type) : Option T → State → Result (State × T) diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index e03981a2..32ed2b33 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -6,12 +6,12 @@ open Primitives namespace hashmap -/- [hashmap::hash_key]: forward function +/- [hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 -/ def hash_key (k : Usize) : Result Usize := Result.ret k -/- [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: forward function +/- [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 -/ divergent def HashMap.allocate_slots_loop (T : Type) (slots : alloc.vec.Vec (List T)) (n : Usize) : @@ -20,12 +20,12 @@ divergent def HashMap.allocate_slots_loop if n > 0#usize then do - let slots0 ← alloc.vec.Vec.push (List T) slots List.Nil - let n0 ← n - 1#usize - HashMap.allocate_slots_loop T slots0 n0 + let v ← alloc.vec.Vec.push (List T) slots List.Nil + let n1 ← n - 1#usize + HashMap.allocate_slots_loop T v n1 else Result.ret slots -/- [hashmap::{hashmap::HashMap}::allocate_slots]: forward function +/- [hashmap::{hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 -/ def HashMap.allocate_slots (T : Type) (slots : alloc.vec.Vec (List T)) (n : Usize) : @@ -33,7 +33,7 @@ def HashMap.allocate_slots := HashMap.allocate_slots_loop T slots n -/- [hashmap::{hashmap::HashMap}::new_with_capacity]: forward function +/- [hashmap::{hashmap::HashMap}::new_with_capacity]: Source: 'src/hashmap.rs', lines 59:4-63:13 -/ def HashMap.new_with_capacity (T : Type) (capacity : Usize) (max_load_dividend : Usize) @@ -41,252 +41,222 @@ def HashMap.new_with_capacity Result (HashMap T) := do - let v := alloc.vec.Vec.new (List T) - let slots ← HashMap.allocate_slots T v capacity - let i ← capacity * max_load_dividend - let i0 ← i / max_load_divisor - Result.ret - { - num_entries := 0#usize, - max_load_factor := (max_load_dividend, max_load_divisor), - max_load := i0, - slots := slots - } - -/- [hashmap::{hashmap::HashMap}::new]: forward function + let v := alloc.vec.Vec.new (List T) + let slots ← HashMap.allocate_slots T v capacity + let i ← capacity * max_load_dividend + let i1 ← i / max_load_divisor + Result.ret + { + num_entries := 0#usize, + max_load_factor := (max_load_dividend, max_load_divisor), + max_load := i1, + slots := slots + } + +/- [hashmap::{hashmap::HashMap}::new]: Source: 'src/hashmap.rs', lines 75:4-75:24 -/ def HashMap.new (T : Type) : Result (HashMap T) := HashMap.new_with_capacity T 32#usize 4#usize 5#usize -/- [hashmap::{hashmap::HashMap}::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap::{hashmap::HashMap}::clear]: loop 0: Source: 'src/hashmap.rs', lines 80:4-88:5 -/ divergent def HashMap.clear_loop (T : Type) (slots : alloc.vec.Vec (List T)) (i : Usize) : Result (alloc.vec.Vec (List T)) := - let i0 := alloc.vec.Vec.len (List T) slots - if i < i0 + let i1 := alloc.vec.Vec.len (List T) slots + if i < i1 then do - let i1 ← i + 1#usize - let slots0 ← - alloc.vec.Vec.index_mut_back (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) slots i - List.Nil - HashMap.clear_loop T slots0 i1 + let (_, index_mut_back) ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (List T)) slots i + let i2 ← i + 1#usize + let slots1 ← index_mut_back List.Nil + HashMap.clear_loop T slots1 i2 else Result.ret slots -/- [hashmap::{hashmap::HashMap}::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap::{hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 -/ def HashMap.clear (T : Type) (self : HashMap T) : Result (HashMap T) := do - let v ← HashMap.clear_loop T self.slots 0#usize - Result.ret { self with num_entries := 0#usize, slots := v } + let back ← HashMap.clear_loop T self.slots 0#usize + Result.ret { self with num_entries := 0#usize, slots := back } -/- [hashmap::{hashmap::HashMap}::len]: forward function +/- [hashmap::{hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 -/ def HashMap.len (T : Type) (self : HashMap T) : Result Usize := Result.ret self.num_entries -/- [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: forward function +/- [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 -/ divergent def HashMap.insert_in_list_loop - (T : Type) (key : Usize) (value : T) (ls : List T) : Result Bool := - match ls with - | List.Cons ckey cvalue tl => - if ckey = key - then Result.ret false - else HashMap.insert_in_list_loop T key value tl - | List.Nil => Result.ret true - -/- [hashmap::{hashmap::HashMap}::insert_in_list]: forward function - Source: 'src/hashmap.rs', lines 97:4-97:71 -/ -def HashMap.insert_in_list - (T : Type) (key : Usize) (value : T) (ls : List T) : Result Bool := - HashMap.insert_in_list_loop T key value ls - -/- [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 97:4-114:5 -/ -divergent def HashMap.insert_in_list_loop_back - (T : Type) (key : Usize) (value : T) (ls : List T) : Result (List T) := + (T : Type) (key : Usize) (value : T) (ls : List T) : + Result (Bool × (List T)) + := match ls with | List.Cons ckey cvalue tl => if ckey = key - then Result.ret (List.Cons ckey value tl) + then Result.ret (false, List.Cons ckey value tl) else do - let tl0 ← HashMap.insert_in_list_loop_back T key value tl - Result.ret (List.Cons ckey cvalue tl0) + let (b, back) ← HashMap.insert_in_list_loop T key value tl + Result.ret (b, List.Cons ckey cvalue back) | List.Nil => let l := List.Nil - Result.ret (List.Cons key value l) + Result.ret (true, List.Cons key value l) -/- [hashmap::{hashmap::HashMap}::insert_in_list]: backward function 0 +/- [hashmap::{hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 -/ -def HashMap.insert_in_list_back - (T : Type) (key : Usize) (value : T) (ls : List T) : Result (List T) := - HashMap.insert_in_list_loop_back T key value ls +def HashMap.insert_in_list + (T : Type) (key : Usize) (value : T) (ls : List T) : + Result (Bool × (List T)) + := + HashMap.insert_in_list_loop T key value ls -/- [hashmap::{hashmap::HashMap}::insert_no_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap::{hashmap::HashMap}::insert_no_resize]: Source: 'src/hashmap.rs', lines 117:4-117:54 -/ def HashMap.insert_no_resize (T : Type) (self : HashMap T) (key : Usize) (value : T) : Result (HashMap T) := do - let hash ← hash_key key - let i := alloc.vec.Vec.len (List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod - let inserted ← HashMap.insert_in_list T key value l - if inserted - then - do - let i0 ← self.num_entries + 1#usize - let l0 ← HashMap.insert_in_list_back T key value l - let v ← - alloc.vec.Vec.index_mut_back (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod l0 - Result.ret { self with num_entries := i0, slots := v } - else - do - let l0 ← HashMap.insert_in_list_back T key value l - let v ← - alloc.vec.Vec.index_mut_back (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod l0 - Result.ret { self with slots := v } - -/- [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) + let hash ← hash_key key + let i := alloc.vec.Vec.len (List T) self.slots + let hash_mod ← hash % i + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots hash_mod + let (inserted, l1) ← HashMap.insert_in_list T key value l + if inserted + then + do + let i1 ← self.num_entries + 1#usize + let v ← index_mut_back l1 + Result.ret { self with num_entries := i1, slots := v } + else do + let v ← index_mut_back l1 + Result.ret { self with slots := v } + +/- [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 -/ divergent def HashMap.move_elements_from_list_loop (T : Type) (ntable : HashMap T) (ls : List T) : Result (HashMap T) := match ls with | List.Cons k v tl => do - let ntable0 ← HashMap.insert_no_resize T ntable k v - HashMap.move_elements_from_list_loop T ntable0 tl + let hm ← HashMap.insert_no_resize T ntable k v + HashMap.move_elements_from_list_loop T hm tl | List.Nil => Result.ret ntable -/- [hashmap::{hashmap::HashMap}::move_elements_from_list]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap::{hashmap::HashMap}::move_elements_from_list]: Source: 'src/hashmap.rs', lines 183:4-183:72 -/ def HashMap.move_elements_from_list (T : Type) (ntable : HashMap T) (ls : List T) : Result (HashMap T) := HashMap.move_elements_from_list_loop T ntable ls -/- [hashmap::{hashmap::HashMap}::move_elements]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap::{hashmap::HashMap}::move_elements]: loop 0: Source: 'src/hashmap.rs', lines 171:4-180:5 -/ divergent def HashMap.move_elements_loop (T : Type) (ntable : HashMap T) (slots : alloc.vec.Vec (List T)) (i : Usize) : Result ((HashMap T) × (alloc.vec.Vec (List T))) := - let i0 := alloc.vec.Vec.len (List T) slots - if i < i0 + let i1 := alloc.vec.Vec.len (List T) slots + if i < i1 then do - let l ← - alloc.vec.Vec.index_mut (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) slots i - let ls := core.mem.replace (List T) l List.Nil - let ntable0 ← HashMap.move_elements_from_list T ntable ls - let i1 ← i + 1#usize - let l0 := core.mem.replace_back (List T) l List.Nil - let slots0 ← - alloc.vec.Vec.index_mut_back (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) slots i l0 - HashMap.move_elements_loop T ntable0 slots0 i1 + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (List T)) slots i + let (ls, l1) := core.mem.replace (List T) l List.Nil + let hm ← HashMap.move_elements_from_list T ntable ls + let i2 ← i + 1#usize + let slots1 ← index_mut_back l1 + let back_'a ← HashMap.move_elements_loop T hm slots1 i2 + let (hm1, v) := back_'a + Result.ret (hm1, v) else Result.ret (ntable, slots) -/- [hashmap::{hashmap::HashMap}::move_elements]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap::{hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 -/ def HashMap.move_elements (T : Type) (ntable : HashMap T) (slots : alloc.vec.Vec (List T)) (i : Usize) : Result ((HashMap T) × (alloc.vec.Vec (List T))) := - HashMap.move_elements_loop T ntable slots i + do + let back_'a ← HashMap.move_elements_loop T ntable slots i + let (hm, v) := back_'a + Result.ret (hm, v) -/- [hashmap::{hashmap::HashMap}::try_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap::{hashmap::HashMap}::try_resize]: Source: 'src/hashmap.rs', lines 140:4-140:28 -/ def HashMap.try_resize (T : Type) (self : HashMap T) : Result (HashMap T) := do - let max_usize ← Scalar.cast .Usize core_u32_max - let capacity := alloc.vec.Vec.len (List T) self.slots - let n1 ← max_usize / 2#usize - let (i, i0) := self.max_load_factor - let i1 ← n1 / i - if capacity <= i1 - then - do - let i2 ← capacity * 2#usize - let ntable ← HashMap.new_with_capacity T i2 i i0 - let (ntable0, _) ← HashMap.move_elements T ntable self.slots 0#usize - Result.ret - { - ntable0 - with - num_entries := self.num_entries, max_load_factor := (i, i0) - } - else Result.ret { self with max_load_factor := (i, i0) } - -/- [hashmap::{hashmap::HashMap}::insert]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) + let max_usize ← Scalar.cast .Usize core_u32_max + let capacity := alloc.vec.Vec.len (List T) self.slots + let n1 ← max_usize / 2#usize + let (i, i1) := self.max_load_factor + let i2 ← n1 / i + if capacity <= i2 + then + do + let i3 ← capacity * 2#usize + let ntable ← HashMap.new_with_capacity T i3 i i1 + let p ← HashMap.move_elements T ntable self.slots 0#usize + let (ntable1, _) := p + Result.ret + { + ntable1 + with + num_entries := self.num_entries, max_load_factor := (i, i1) + } + else Result.ret { self with max_load_factor := (i, i1) } + +/- [hashmap::{hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 -/ def HashMap.insert (T : Type) (self : HashMap T) (key : Usize) (value : T) : Result (HashMap T) := do - let self0 ← HashMap.insert_no_resize T self key value - let i ← HashMap.len T self0 - if i > self0.max_load - then HashMap.try_resize T self0 - else Result.ret self0 + let hm ← HashMap.insert_no_resize T self key value + let i ← HashMap.len T hm + if i > hm.max_load + then HashMap.try_resize T hm + else Result.ret hm -/- [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: forward function +/- [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 -/ divergent def HashMap.contains_key_in_list_loop (T : Type) (key : Usize) (ls : List T) : Result Bool := match ls with - | List.Cons ckey t tl => + | List.Cons ckey _ tl => if ckey = key then Result.ret true else HashMap.contains_key_in_list_loop T key tl | List.Nil => Result.ret false -/- [hashmap::{hashmap::HashMap}::contains_key_in_list]: forward function +/- [hashmap::{hashmap::HashMap}::contains_key_in_list]: Source: 'src/hashmap.rs', lines 206:4-206:68 -/ def HashMap.contains_key_in_list (T : Type) (key : Usize) (ls : List T) : Result Bool := HashMap.contains_key_in_list_loop T key ls -/- [hashmap::{hashmap::HashMap}::contains_key]: forward function +/- [hashmap::{hashmap::HashMap}::contains_key]: Source: 'src/hashmap.rs', lines 199:4-199:49 -/ def HashMap.contains_key (T : Type) (self : HashMap T) (key : Usize) : Result Bool := do - let hash ← hash_key key - let i := alloc.vec.Vec.len (List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod - HashMap.contains_key_in_list T key l - -/- [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: forward function + let hash ← hash_key key + let i := alloc.vec.Vec.len (List T) self.slots + let hash_mod ← hash % i + let l ← + alloc.vec.Vec.index (List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots hash_mod + HashMap.contains_key_in_list T key l + +/- [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: Source: 'src/hashmap.rs', lines 224:4-237:5 -/ divergent def HashMap.get_in_list_loop (T : Type) (key : Usize) (ls : List T) : Result T := @@ -297,231 +267,171 @@ divergent def HashMap.get_in_list_loop else HashMap.get_in_list_loop T key tl | List.Nil => Result.fail .panic -/- [hashmap::{hashmap::HashMap}::get_in_list]: forward function +/- [hashmap::{hashmap::HashMap}::get_in_list]: Source: 'src/hashmap.rs', lines 224:4-224:70 -/ def HashMap.get_in_list (T : Type) (key : Usize) (ls : List T) : Result T := HashMap.get_in_list_loop T key ls -/- [hashmap::{hashmap::HashMap}::get]: forward function +/- [hashmap::{hashmap::HashMap}::get]: Source: 'src/hashmap.rs', lines 239:4-239:55 -/ def HashMap.get (T : Type) (self : HashMap T) (key : Usize) : Result T := do - let hash ← hash_key key - let i := alloc.vec.Vec.len (List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod - HashMap.get_in_list T key l - -/- [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: forward function + let hash ← hash_key key + let i := alloc.vec.Vec.len (List T) self.slots + let hash_mod ← hash % i + let l ← + alloc.vec.Vec.index (List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots hash_mod + HashMap.get_in_list T key l + +/- [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: Source: 'src/hashmap.rs', lines 245:4-254:5 -/ divergent def HashMap.get_mut_in_list_loop - (T : Type) (ls : List T) (key : Usize) : Result T := - match ls with - | List.Cons ckey cvalue tl => - if ckey = key - then Result.ret cvalue - else HashMap.get_mut_in_list_loop T tl key - | List.Nil => Result.fail .panic - -/- [hashmap::{hashmap::HashMap}::get_mut_in_list]: forward function - Source: 'src/hashmap.rs', lines 245:4-245:86 -/ -def HashMap.get_mut_in_list - (T : Type) (ls : List T) (key : Usize) : Result T := - HashMap.get_mut_in_list_loop T ls key - -/- [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 245:4-254:5 -/ -divergent def HashMap.get_mut_in_list_loop_back - (T : Type) (ls : List T) (key : Usize) (ret : T) : Result (List T) := + (T : Type) (ls : List T) (key : Usize) : + Result (T × (T → Result (List T))) + := match ls with | List.Cons ckey cvalue tl => if ckey = key - then Result.ret (List.Cons ckey ret tl) + then + let back_'a := fun ret => Result.ret (List.Cons ckey ret tl) + Result.ret (cvalue, back_'a) else do - let tl0 ← HashMap.get_mut_in_list_loop_back T tl key ret - Result.ret (List.Cons ckey cvalue tl0) + let (t, back_'a) ← HashMap.get_mut_in_list_loop T tl key + let back_'a1 := + fun ret => + do + let tl1 ← back_'a ret + Result.ret (List.Cons ckey cvalue tl1) + Result.ret (t, back_'a1) | List.Nil => Result.fail .panic -/- [hashmap::{hashmap::HashMap}::get_mut_in_list]: backward function 0 +/- [hashmap::{hashmap::HashMap}::get_mut_in_list]: Source: 'src/hashmap.rs', lines 245:4-245:86 -/ -def HashMap.get_mut_in_list_back - (T : Type) (ls : List T) (key : Usize) (ret : T) : Result (List T) := - HashMap.get_mut_in_list_loop_back T ls key ret - -/- [hashmap::{hashmap::HashMap}::get_mut]: forward function - Source: 'src/hashmap.rs', lines 257:4-257:67 -/ -def HashMap.get_mut (T : Type) (self : HashMap T) (key : Usize) : Result T := +def HashMap.get_mut_in_list + (T : Type) (ls : List T) (key : Usize) : + Result (T × (T → Result (List T))) + := do - let hash ← hash_key key - let i := alloc.vec.Vec.len (List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod - HashMap.get_mut_in_list T l key + let (t, back_'a) ← HashMap.get_mut_in_list_loop T ls key + let back_'a1 := fun ret => back_'a ret + Result.ret (t, back_'a1) -/- [hashmap::{hashmap::HashMap}::get_mut]: backward function 0 +/- [hashmap::{hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 -/ -def HashMap.get_mut_back - (T : Type) (self : HashMap T) (key : Usize) (ret : T) : Result (HashMap T) := +def HashMap.get_mut + (T : Type) (self : HashMap T) (key : Usize) : + Result (T × (T → Result (HashMap T))) + := do - let hash ← hash_key key - let i := alloc.vec.Vec.len (List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod - let l0 ← HashMap.get_mut_in_list_back T l key ret - let v ← - alloc.vec.Vec.index_mut_back (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod l0 - Result.ret { self with slots := v } - -/- [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: forward function - Source: 'src/hashmap.rs', lines 265:4-291:5 -/ -divergent def HashMap.remove_from_list_loop - (T : Type) (key : Usize) (ls : List T) : Result (Option T) := - match ls with - | List.Cons ckey t tl => - if ckey = key - then - let mv_ls := core.mem.replace (List T) (List.Cons ckey t tl) List.Nil - match mv_ls with - | List.Cons i cvalue tl0 => Result.ret (some cvalue) - | List.Nil => Result.fail .panic - else HashMap.remove_from_list_loop T key tl - | List.Nil => Result.ret none - -/- [hashmap::{hashmap::HashMap}::remove_from_list]: forward function - Source: 'src/hashmap.rs', lines 265:4-265:69 -/ -def HashMap.remove_from_list - (T : Type) (key : Usize) (ls : List T) : Result (Option T) := - HashMap.remove_from_list_loop T key ls + let hash ← hash_key key + let i := alloc.vec.Vec.len (List T) self.slots + let hash_mod ← hash % i + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots hash_mod + let (t, get_mut_in_list_back) ← HashMap.get_mut_in_list T l key + let back_'a := + fun ret => + do + let l1 ← get_mut_in_list_back ret + let v ← index_mut_back l1 + Result.ret { self with slots := v } + Result.ret (t, back_'a) -/- [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: backward function 1 +/- [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 -/ -divergent def HashMap.remove_from_list_loop_back - (T : Type) (key : Usize) (ls : List T) : Result (List T) := +divergent def HashMap.remove_from_list_loop + (T : Type) (key : Usize) (ls : List T) : Result ((Option T) × (List T)) := match ls with | List.Cons ckey t tl => if ckey = key then - let mv_ls := core.mem.replace (List T) (List.Cons ckey t tl) List.Nil + let (mv_ls, _) := + core.mem.replace (List T) (List.Cons ckey t tl) List.Nil match mv_ls with - | List.Cons i cvalue tl0 => Result.ret tl0 + | List.Cons _ cvalue tl1 => Result.ret (some cvalue, tl1) | List.Nil => Result.fail .panic else do - let tl0 ← HashMap.remove_from_list_loop_back T key tl - Result.ret (List.Cons ckey t tl0) - | List.Nil => Result.ret List.Nil + let (o, back) ← HashMap.remove_from_list_loop T key tl + Result.ret (o, List.Cons ckey t back) + | List.Nil => Result.ret (none, List.Nil) -/- [hashmap::{hashmap::HashMap}::remove_from_list]: backward function 1 +/- [hashmap::{hashmap::HashMap}::remove_from_list]: Source: 'src/hashmap.rs', lines 265:4-265:69 -/ -def HashMap.remove_from_list_back - (T : Type) (key : Usize) (ls : List T) : Result (List T) := - HashMap.remove_from_list_loop_back T key ls +def HashMap.remove_from_list + (T : Type) (key : Usize) (ls : List T) : Result ((Option T) × (List T)) := + HashMap.remove_from_list_loop T key ls -/- [hashmap::{hashmap::HashMap}::remove]: forward function +/- [hashmap::{hashmap::HashMap}::remove]: Source: 'src/hashmap.rs', lines 294:4-294:52 -/ def HashMap.remove - (T : Type) (self : HashMap T) (key : Usize) : Result (Option T) := - do - let hash ← hash_key key - let i := alloc.vec.Vec.len (List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod - let x ← HashMap.remove_from_list T key l - match x with - | none => Result.ret none - | some x0 => do - let _ ← self.num_entries - 1#usize - Result.ret (some x0) - -/- [hashmap::{hashmap::HashMap}::remove]: backward function 0 - Source: 'src/hashmap.rs', lines 294:4-294:52 -/ -def HashMap.remove_back - (T : Type) (self : HashMap T) (key : Usize) : Result (HashMap T) := + (T : Type) (self : HashMap T) (key : Usize) : + Result ((Option T) × (HashMap T)) + := do - let hash ← hash_key key - let i := alloc.vec.Vec.len (List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod - let x ← HashMap.remove_from_list T key l - match x with - | none => - do - let l0 ← HashMap.remove_from_list_back T key l - let v ← - alloc.vec.Vec.index_mut_back (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod l0 - Result.ret { self with slots := v } - | some x0 => - do - let i0 ← self.num_entries - 1#usize - let l0 ← HashMap.remove_from_list_back T key l - let v ← - alloc.vec.Vec.index_mut_back (List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots - hash_mod l0 - Result.ret { self with num_entries := i0, slots := v } - -/- [hashmap::test1]: forward function + let hash ← hash_key key + let i := alloc.vec.Vec.len (List T) self.slots + let hash_mod ← hash % i + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots hash_mod + let (x, l1) ← HashMap.remove_from_list T key l + match x with + | none => + do + let v ← index_mut_back l1 + Result.ret (none, { self with slots := v }) + | some x1 => + do + let i1 ← self.num_entries - 1#usize + let v ← index_mut_back l1 + Result.ret (some x1, { self with num_entries := i1, slots := v }) + +/- [hashmap::test1]: Source: 'src/hashmap.rs', lines 315:0-315:10 -/ def test1 : Result Unit := do - let hm ← HashMap.new U64 - let hm0 ← HashMap.insert U64 hm 0#usize 42#u64 - let hm1 ← HashMap.insert U64 hm0 128#usize 18#u64 - let hm2 ← HashMap.insert U64 hm1 1024#usize 138#u64 - let hm3 ← HashMap.insert U64 hm2 1056#usize 256#u64 - let i ← HashMap.get U64 hm3 128#usize - if not (i = 18#u64) + let hm ← HashMap.new U64 + let hm1 ← HashMap.insert U64 hm 0#usize 42#u64 + let hm2 ← HashMap.insert U64 hm1 128#usize 18#u64 + let hm3 ← HashMap.insert U64 hm2 1024#usize 138#u64 + let hm4 ← HashMap.insert U64 hm3 1056#usize 256#u64 + let i ← HashMap.get U64 hm4 128#usize + if not (i = 18#u64) + then Result.fail .panic + else + do + let (_, get_mut_back) ← HashMap.get_mut U64 hm4 1024#usize + let hm5 ← get_mut_back 56#u64 + let i1 ← HashMap.get U64 hm5 1024#usize + if not (i1 = 56#u64) then Result.fail .panic else do - let hm4 ← HashMap.get_mut_back U64 hm3 1024#usize 56#u64 - let i0 ← HashMap.get U64 hm4 1024#usize - if not (i0 = 56#u64) + let (x, hm6) ← HashMap.remove U64 hm5 1024#usize + match x with + | none => Result.fail .panic + | some x1 => + if not (x1 = 56#u64) then Result.fail .panic else do - let x ← HashMap.remove U64 hm4 1024#usize - match x with - | none => Result.fail .panic - | some x0 => - if not (x0 = 56#u64) + let i2 ← HashMap.get U64 hm6 0#usize + if not (i2 = 42#u64) + then Result.fail .panic + else + do + let i3 ← HashMap.get U64 hm6 128#usize + if not (i3 = 18#u64) + then Result.fail .panic + else + do + let i4 ← HashMap.get U64 hm6 1056#usize + if not (i4 = 256#u64) then Result.fail .panic - else - do - let hm5 ← HashMap.remove_back U64 hm4 1024#usize - let i1 ← HashMap.get U64 hm5 0#usize - if not (i1 = 42#u64) - then Result.fail .panic - else - do - let i2 ← HashMap.get U64 hm5 128#usize - if not (i2 = 18#u64) - then Result.fail .panic - else - do - let i3 ← HashMap.get U64 hm5 1056#usize - if not (i3 = 256#u64) - then Result.fail .panic - else Result.ret () + else Result.ret () end hashmap diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index f87ad355..9bfb5070 100644 --- a/tests/lean/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -7,12 +7,12 @@ open Primitives namespace hashmap_main -/- [hashmap_main::hashmap::hash_key]: forward function +/- [hashmap_main::hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 -/ def hashmap.hash_key (k : Usize) : Result Usize := Result.ret k -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 -/ divergent def hashmap.HashMap.allocate_slots_loop (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (n : Usize) : @@ -21,12 +21,12 @@ divergent def hashmap.HashMap.allocate_slots_loop if n > 0#usize then do - let slots0 ← alloc.vec.Vec.push (hashmap.List T) slots hashmap.List.Nil - let n0 ← n - 1#usize - hashmap.HashMap.allocate_slots_loop T slots0 n0 + let v ← alloc.vec.Vec.push (hashmap.List T) slots hashmap.List.Nil + let n1 ← n - 1#usize + hashmap.HashMap.allocate_slots_loop T v n1 else Result.ret slots -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 -/ def hashmap.HashMap.allocate_slots (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (n : Usize) : @@ -34,7 +34,7 @@ def hashmap.HashMap.allocate_slots := hashmap.HashMap.allocate_slots_loop T slots n -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new_with_capacity]: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new_with_capacity]: Source: 'src/hashmap.rs', lines 59:4-63:13 -/ def hashmap.HashMap.new_with_capacity (T : Type) (capacity : Usize) (max_load_dividend : Usize) @@ -42,136 +42,106 @@ def hashmap.HashMap.new_with_capacity Result (hashmap.HashMap T) := do - let v := alloc.vec.Vec.new (hashmap.List T) - let slots ← hashmap.HashMap.allocate_slots T v capacity - let i ← capacity * max_load_dividend - let i0 ← i / max_load_divisor - Result.ret - { - num_entries := 0#usize, - max_load_factor := (max_load_dividend, max_load_divisor), - max_load := i0, - slots := slots - } - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new]: forward function + let v := alloc.vec.Vec.new (hashmap.List T) + let slots ← hashmap.HashMap.allocate_slots T v capacity + let i ← capacity * max_load_dividend + let i1 ← i / max_load_divisor + Result.ret + { + num_entries := 0#usize, + max_load_factor := (max_load_dividend, max_load_divisor), + max_load := i1, + slots := slots + } + +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::new]: Source: 'src/hashmap.rs', lines 75:4-75:24 -/ def hashmap.HashMap.new (T : Type) : Result (hashmap.HashMap T) := hashmap.HashMap.new_with_capacity T 32#usize 4#usize 5#usize -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: loop 0: Source: 'src/hashmap.rs', lines 80:4-88:5 -/ divergent def hashmap.HashMap.clear_loop (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : Result (alloc.vec.Vec (hashmap.List T)) := - let i0 := alloc.vec.Vec.len (hashmap.List T) slots - if i < i0 + let i1 := alloc.vec.Vec.len (hashmap.List T) slots + if i < i1 then do - let i1 ← i + 1#usize - let slots0 ← - alloc.vec.Vec.index_mut_back (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) slots i - hashmap.List.Nil - hashmap.HashMap.clear_loop T slots0 i1 + let (_, index_mut_back) ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) slots i + let i2 ← i + 1#usize + let slots1 ← index_mut_back hashmap.List.Nil + hashmap.HashMap.clear_loop T slots1 i2 else Result.ret slots -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 -/ def hashmap.HashMap.clear (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do - let v ← hashmap.HashMap.clear_loop T self.slots 0#usize - Result.ret { self with num_entries := 0#usize, slots := v } + let back ← hashmap.HashMap.clear_loop T self.slots 0#usize + Result.ret { self with num_entries := 0#usize, slots := back } -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 -/ def hashmap.HashMap.len (T : Type) (self : hashmap.HashMap T) : Result Usize := Result.ret self.num_entries -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 -/ divergent def hashmap.HashMap.insert_in_list_loop - (T : Type) (key : Usize) (value : T) (ls : hashmap.List T) : Result Bool := - match ls with - | hashmap.List.Cons ckey cvalue tl => - if ckey = key - then Result.ret false - else hashmap.HashMap.insert_in_list_loop T key value tl - | hashmap.List.Nil => Result.ret true - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: forward function - Source: 'src/hashmap.rs', lines 97:4-97:71 -/ -def hashmap.HashMap.insert_in_list - (T : Type) (key : Usize) (value : T) (ls : hashmap.List T) : Result Bool := - hashmap.HashMap.insert_in_list_loop T key value ls - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 97:4-114:5 -/ -divergent def hashmap.HashMap.insert_in_list_loop_back (T : Type) (key : Usize) (value : T) (ls : hashmap.List T) : - Result (hashmap.List T) + Result (Bool × (hashmap.List T)) := match ls with | hashmap.List.Cons ckey cvalue tl => if ckey = key - then Result.ret (hashmap.List.Cons ckey value tl) + then Result.ret (false, hashmap.List.Cons ckey value tl) else do - let tl0 ← hashmap.HashMap.insert_in_list_loop_back T key value tl - Result.ret (hashmap.List.Cons ckey cvalue tl0) + let (b, back) ← hashmap.HashMap.insert_in_list_loop T key value tl + Result.ret (b, hashmap.List.Cons ckey cvalue back) | hashmap.List.Nil => let l := hashmap.List.Nil - Result.ret (hashmap.List.Cons key value l) + Result.ret (true, hashmap.List.Cons key value l) -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: backward function 0 +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 -/ -def hashmap.HashMap.insert_in_list_back +def hashmap.HashMap.insert_in_list (T : Type) (key : Usize) (value : T) (ls : hashmap.List T) : - Result (hashmap.List T) + Result (Bool × (hashmap.List T)) := - hashmap.HashMap.insert_in_list_loop_back T key value ls + hashmap.HashMap.insert_in_list_loop T key value ls -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_no_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_no_resize]: Source: 'src/hashmap.rs', lines 117:4-117:54 -/ def hashmap.HashMap.insert_no_resize (T : Type) (self : hashmap.HashMap T) (key : Usize) (value : T) : Result (hashmap.HashMap T) := do - let hash ← hashmap.hash_key key - let i := alloc.vec.Vec.len (hashmap.List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod - let inserted ← hashmap.HashMap.insert_in_list T key value l - if inserted - then - do - let i0 ← self.num_entries + 1#usize - let l0 ← hashmap.HashMap.insert_in_list_back T key value l - let v ← - alloc.vec.Vec.index_mut_back (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod l0 - Result.ret { self with num_entries := i0, slots := v } - else - do - let l0 ← hashmap.HashMap.insert_in_list_back T key value l - let v ← - alloc.vec.Vec.index_mut_back (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod l0 - Result.ret { self with slots := v } - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) + let hash ← hashmap.hash_key key + let i := alloc.vec.Vec.len (hashmap.List T) self.slots + let hash_mod ← hash % i + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) self.slots + hash_mod + let (inserted, l1) ← hashmap.HashMap.insert_in_list T key value l + if inserted + then + do + let i1 ← self.num_entries + 1#usize + let v ← index_mut_back l1 + Result.ret { self with num_entries := i1, slots := v } + else do + let v ← index_mut_back l1 + Result.ret { self with slots := v } + +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 -/ divergent def hashmap.HashMap.move_elements_from_list_loop (T : Type) (ntable : hashmap.HashMap T) (ls : hashmap.List T) : @@ -180,12 +150,11 @@ divergent def hashmap.HashMap.move_elements_from_list_loop match ls with | hashmap.List.Cons k v tl => do - let ntable0 ← hashmap.HashMap.insert_no_resize T ntable k v - hashmap.HashMap.move_elements_from_list_loop T ntable0 tl + let hm ← hashmap.HashMap.insert_no_resize T ntable k v + hashmap.HashMap.move_elements_from_list_loop T hm tl | hashmap.List.Nil => Result.ret ntable -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: Source: 'src/hashmap.rs', lines 183:4-183:72 -/ def hashmap.HashMap.move_elements_from_list (T : Type) (ntable : hashmap.HashMap T) (ls : hashmap.List T) : @@ -193,114 +162,111 @@ def hashmap.HashMap.move_elements_from_list := hashmap.HashMap.move_elements_from_list_loop T ntable ls -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: loop 0: Source: 'src/hashmap.rs', lines 171:4-180:5 -/ divergent def hashmap.HashMap.move_elements_loop (T : Type) (ntable : hashmap.HashMap T) (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : Result ((hashmap.HashMap T) × (alloc.vec.Vec (hashmap.List T))) := - let i0 := alloc.vec.Vec.len (hashmap.List T) slots - if i < i0 + let i1 := alloc.vec.Vec.len (hashmap.List T) slots + if i < i1 then do - let l ← - alloc.vec.Vec.index_mut (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) slots i - let ls := core.mem.replace (hashmap.List T) l hashmap.List.Nil - let ntable0 ← hashmap.HashMap.move_elements_from_list T ntable ls - let i1 ← i + 1#usize - let l0 := core.mem.replace_back (hashmap.List T) l hashmap.List.Nil - let slots0 ← - alloc.vec.Vec.index_mut_back (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) slots i - l0 - hashmap.HashMap.move_elements_loop T ntable0 slots0 i1 + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) slots i + let (ls, l1) := core.mem.replace (hashmap.List T) l hashmap.List.Nil + let hm ← hashmap.HashMap.move_elements_from_list T ntable ls + let i2 ← i + 1#usize + let slots1 ← index_mut_back l1 + let back_'a ← hashmap.HashMap.move_elements_loop T hm slots1 i2 + let (hm1, v) := back_'a + Result.ret (hm1, v) else Result.ret (ntable, slots) -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 -/ def hashmap.HashMap.move_elements (T : Type) (ntable : hashmap.HashMap T) (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : Result ((hashmap.HashMap T) × (alloc.vec.Vec (hashmap.List T))) := - hashmap.HashMap.move_elements_loop T ntable slots i + do + let back_'a ← hashmap.HashMap.move_elements_loop T ntable slots i + let (hm, v) := back_'a + Result.ret (hm, v) -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::try_resize]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::try_resize]: Source: 'src/hashmap.rs', lines 140:4-140:28 -/ def hashmap.HashMap.try_resize (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do - let max_usize ← Scalar.cast .Usize core_u32_max - let capacity := alloc.vec.Vec.len (hashmap.List T) self.slots - let n1 ← max_usize / 2#usize - let (i, i0) := self.max_load_factor - let i1 ← n1 / i - if capacity <= i1 - then - do - let i2 ← capacity * 2#usize - let ntable ← hashmap.HashMap.new_with_capacity T i2 i i0 - let (ntable0, _) ← - hashmap.HashMap.move_elements T ntable self.slots 0#usize - Result.ret - { - ntable0 - with - num_entries := self.num_entries, max_load_factor := (i, i0) - } - else Result.ret { self with max_load_factor := (i, i0) } - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) + let max_usize ← Scalar.cast .Usize core_u32_max + let capacity := alloc.vec.Vec.len (hashmap.List T) self.slots + let n1 ← max_usize / 2#usize + let (i, i1) := self.max_load_factor + let i2 ← n1 / i + if capacity <= i2 + then + do + let i3 ← capacity * 2#usize + let ntable ← hashmap.HashMap.new_with_capacity T i3 i i1 + let p ← hashmap.HashMap.move_elements T ntable self.slots 0#usize + let (ntable1, _) := p + Result.ret + { + ntable1 + with + num_entries := self.num_entries, max_load_factor := (i, i1) + } + else Result.ret { self with max_load_factor := (i, i1) } + +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 -/ def hashmap.HashMap.insert (T : Type) (self : hashmap.HashMap T) (key : Usize) (value : T) : Result (hashmap.HashMap T) := do - let self0 ← hashmap.HashMap.insert_no_resize T self key value - let i ← hashmap.HashMap.len T self0 - if i > self0.max_load - then hashmap.HashMap.try_resize T self0 - else Result.ret self0 + let hm ← hashmap.HashMap.insert_no_resize T self key value + let i ← hashmap.HashMap.len T hm + if i > hm.max_load + then hashmap.HashMap.try_resize T hm + else Result.ret hm -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 -/ divergent def hashmap.HashMap.contains_key_in_list_loop (T : Type) (key : Usize) (ls : hashmap.List T) : Result Bool := match ls with - | hashmap.List.Cons ckey t tl => + | hashmap.List.Cons ckey _ tl => if ckey = key then Result.ret true else hashmap.HashMap.contains_key_in_list_loop T key tl | hashmap.List.Nil => Result.ret false -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: Source: 'src/hashmap.rs', lines 206:4-206:68 -/ def hashmap.HashMap.contains_key_in_list (T : Type) (key : Usize) (ls : hashmap.List T) : Result Bool := hashmap.HashMap.contains_key_in_list_loop T key ls -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key]: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key]: Source: 'src/hashmap.rs', lines 199:4-199:49 -/ def hashmap.HashMap.contains_key (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result Bool := do - let hash ← hashmap.hash_key key - let i := alloc.vec.Vec.len (hashmap.List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod - hashmap.HashMap.contains_key_in_list T key l - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: loop 0: forward function + let hash ← hashmap.hash_key key + let i := alloc.vec.Vec.len (hashmap.List T) self.slots + let hash_mod ← hash % i + let l ← + alloc.vec.Vec.index (hashmap.List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) self.slots + hash_mod + hashmap.HashMap.contains_key_in_list T key l + +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: loop 0: Source: 'src/hashmap.rs', lines 224:4-237:5 -/ divergent def hashmap.HashMap.get_in_list_loop (T : Type) (key : Usize) (ls : hashmap.List T) : Result T := @@ -311,259 +277,194 @@ divergent def hashmap.HashMap.get_in_list_loop else hashmap.HashMap.get_in_list_loop T key tl | hashmap.List.Nil => Result.fail .panic -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_in_list]: Source: 'src/hashmap.rs', lines 224:4-224:70 -/ def hashmap.HashMap.get_in_list (T : Type) (key : Usize) (ls : hashmap.List T) : Result T := hashmap.HashMap.get_in_list_loop T key ls -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get]: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get]: Source: 'src/hashmap.rs', lines 239:4-239:55 -/ def hashmap.HashMap.get (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result T := do - let hash ← hashmap.hash_key key - let i := alloc.vec.Vec.len (hashmap.List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod - hashmap.HashMap.get_in_list T key l - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: forward function + let hash ← hashmap.hash_key key + let i := alloc.vec.Vec.len (hashmap.List T) self.slots + let hash_mod ← hash % i + let l ← + alloc.vec.Vec.index (hashmap.List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) self.slots + hash_mod + hashmap.HashMap.get_in_list T key l + +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: Source: 'src/hashmap.rs', lines 245:4-254:5 -/ divergent def hashmap.HashMap.get_mut_in_list_loop - (T : Type) (ls : hashmap.List T) (key : Usize) : Result T := - match ls with - | hashmap.List.Cons ckey cvalue tl => - if ckey = key - then Result.ret cvalue - else hashmap.HashMap.get_mut_in_list_loop T tl key - | hashmap.List.Nil => Result.fail .panic - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: forward function - Source: 'src/hashmap.rs', lines 245:4-245:86 -/ -def hashmap.HashMap.get_mut_in_list - (T : Type) (ls : hashmap.List T) (key : Usize) : Result T := - hashmap.HashMap.get_mut_in_list_loop T ls key - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: loop 0: backward function 0 - Source: 'src/hashmap.rs', lines 245:4-254:5 -/ -divergent def hashmap.HashMap.get_mut_in_list_loop_back - (T : Type) (ls : hashmap.List T) (key : Usize) (ret : T) : - Result (hashmap.List T) + (T : Type) (ls : hashmap.List T) (key : Usize) : + Result (T × (T → Result (hashmap.List T))) := match ls with | hashmap.List.Cons ckey cvalue tl => if ckey = key - then Result.ret (hashmap.List.Cons ckey ret tl) + then + let back_'a := fun ret => Result.ret (hashmap.List.Cons ckey ret tl) + Result.ret (cvalue, back_'a) else do - let tl0 ← hashmap.HashMap.get_mut_in_list_loop_back T tl key ret - Result.ret (hashmap.List.Cons ckey cvalue tl0) + let (t, back_'a) ← hashmap.HashMap.get_mut_in_list_loop T tl key + let back_'a1 := + fun ret => + do + let tl1 ← back_'a ret + Result.ret (hashmap.List.Cons ckey cvalue tl1) + Result.ret (t, back_'a1) | hashmap.List.Nil => Result.fail .panic -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: backward function 0 +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: Source: 'src/hashmap.rs', lines 245:4-245:86 -/ -def hashmap.HashMap.get_mut_in_list_back - (T : Type) (ls : hashmap.List T) (key : Usize) (ret : T) : - Result (hashmap.List T) +def hashmap.HashMap.get_mut_in_list + (T : Type) (ls : hashmap.List T) (key : Usize) : + Result (T × (T → Result (hashmap.List T))) := - hashmap.HashMap.get_mut_in_list_loop_back T ls key ret - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: forward function - Source: 'src/hashmap.rs', lines 257:4-257:67 -/ -def hashmap.HashMap.get_mut - (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result T := do - let hash ← hashmap.hash_key key - let i := alloc.vec.Vec.len (hashmap.List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod - hashmap.HashMap.get_mut_in_list T l key + let (t, back_'a) ← hashmap.HashMap.get_mut_in_list_loop T ls key + let back_'a1 := fun ret => back_'a ret + Result.ret (t, back_'a1) -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: backward function 0 +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 -/ -def hashmap.HashMap.get_mut_back - (T : Type) (self : hashmap.HashMap T) (key : Usize) (ret : T) : - Result (hashmap.HashMap T) +def hashmap.HashMap.get_mut + (T : Type) (self : hashmap.HashMap T) (key : Usize) : + Result (T × (T → Result (hashmap.HashMap T))) := do - let hash ← hashmap.hash_key key - let i := alloc.vec.Vec.len (hashmap.List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod - let l0 ← hashmap.HashMap.get_mut_in_list_back T l key ret - let v ← - alloc.vec.Vec.index_mut_back (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod l0 - Result.ret { self with slots := v } - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: forward function - Source: 'src/hashmap.rs', lines 265:4-291:5 -/ -divergent def hashmap.HashMap.remove_from_list_loop - (T : Type) (key : Usize) (ls : hashmap.List T) : Result (Option T) := - match ls with - | hashmap.List.Cons ckey t tl => - if ckey = key - then - let mv_ls := - core.mem.replace (hashmap.List T) (hashmap.List.Cons ckey t tl) - hashmap.List.Nil - match mv_ls with - | hashmap.List.Cons i cvalue tl0 => Result.ret (some cvalue) - | hashmap.List.Nil => Result.fail .panic - else hashmap.HashMap.remove_from_list_loop T key tl - | hashmap.List.Nil => Result.ret none - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: forward function - Source: 'src/hashmap.rs', lines 265:4-265:69 -/ -def hashmap.HashMap.remove_from_list - (T : Type) (key : Usize) (ls : hashmap.List T) : Result (Option T) := - hashmap.HashMap.remove_from_list_loop T key ls + let hash ← hashmap.hash_key key + let i := alloc.vec.Vec.len (hashmap.List T) self.slots + let hash_mod ← hash % i + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) self.slots + hash_mod + let (t, get_mut_in_list_back) ← hashmap.HashMap.get_mut_in_list T l key + let back_'a := + fun ret => + do + let l1 ← get_mut_in_list_back ret + let v ← index_mut_back l1 + Result.ret { self with slots := v } + Result.ret (t, back_'a) -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: backward function 1 +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 -/ -divergent def hashmap.HashMap.remove_from_list_loop_back - (T : Type) (key : Usize) (ls : hashmap.List T) : Result (hashmap.List T) := +divergent def hashmap.HashMap.remove_from_list_loop + (T : Type) (key : Usize) (ls : hashmap.List T) : + Result ((Option T) × (hashmap.List T)) + := match ls with | hashmap.List.Cons ckey t tl => if ckey = key then - let mv_ls := + let (mv_ls, _) := core.mem.replace (hashmap.List T) (hashmap.List.Cons ckey t tl) hashmap.List.Nil match mv_ls with - | hashmap.List.Cons i cvalue tl0 => Result.ret tl0 + | hashmap.List.Cons _ cvalue tl1 => Result.ret (some cvalue, tl1) | hashmap.List.Nil => Result.fail .panic else do - let tl0 ← hashmap.HashMap.remove_from_list_loop_back T key tl - Result.ret (hashmap.List.Cons ckey t tl0) - | hashmap.List.Nil => Result.ret hashmap.List.Nil + let (o, back) ← hashmap.HashMap.remove_from_list_loop T key tl + Result.ret (o, hashmap.List.Cons ckey t back) + | hashmap.List.Nil => Result.ret (none, hashmap.List.Nil) -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: backward function 1 +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: Source: 'src/hashmap.rs', lines 265:4-265:69 -/ -def hashmap.HashMap.remove_from_list_back - (T : Type) (key : Usize) (ls : hashmap.List T) : Result (hashmap.List T) := - hashmap.HashMap.remove_from_list_loop_back T key ls +def hashmap.HashMap.remove_from_list + (T : Type) (key : Usize) (ls : hashmap.List T) : + Result ((Option T) × (hashmap.List T)) + := + hashmap.HashMap.remove_from_list_loop T key ls -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: forward function +/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: Source: 'src/hashmap.rs', lines 294:4-294:52 -/ def hashmap.HashMap.remove - (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result (Option T) := - do - let hash ← hashmap.hash_key key - let i := alloc.vec.Vec.len (hashmap.List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod - let x ← hashmap.HashMap.remove_from_list T key l - match x with - | none => Result.ret none - | some x0 => do - let _ ← self.num_entries - 1#usize - Result.ret (some x0) - -/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove]: backward function 0 - Source: 'src/hashmap.rs', lines 294:4-294:52 -/ -def hashmap.HashMap.remove_back (T : Type) (self : hashmap.HashMap T) (key : Usize) : - Result (hashmap.HashMap T) + Result ((Option T) × (hashmap.HashMap T)) := do - let hash ← hashmap.hash_key key - let i := alloc.vec.Vec.len (hashmap.List T) self.slots - let hash_mod ← hash % i - let l ← - alloc.vec.Vec.index_mut (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod - let x ← hashmap.HashMap.remove_from_list T key l - match x with - | none => - do - let l0 ← hashmap.HashMap.remove_from_list_back T key l - let v ← - alloc.vec.Vec.index_mut_back (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod l0 - Result.ret { self with slots := v } - | some x0 => - do - let i0 ← self.num_entries - 1#usize - let l0 ← hashmap.HashMap.remove_from_list_back T key l - let v ← - alloc.vec.Vec.index_mut_back (hashmap.List T) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) - self.slots hash_mod l0 - Result.ret { self with num_entries := i0, slots := v } - -/- [hashmap_main::hashmap::test1]: forward function + let hash ← hashmap.hash_key key + let i := alloc.vec.Vec.len (hashmap.List T) self.slots + let hash_mod ← hash % i + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) self.slots + hash_mod + let (x, l1) ← hashmap.HashMap.remove_from_list T key l + match x with + | none => + do + let v ← index_mut_back l1 + Result.ret (none, { self with slots := v }) + | some x1 => + do + let i1 ← self.num_entries - 1#usize + let v ← index_mut_back l1 + Result.ret (some x1, { self with num_entries := i1, slots := v }) + +/- [hashmap_main::hashmap::test1]: Source: 'src/hashmap.rs', lines 315:0-315:10 -/ def hashmap.test1 : Result Unit := do - let hm ← hashmap.HashMap.new U64 - let hm0 ← hashmap.HashMap.insert U64 hm 0#usize 42#u64 - let hm1 ← hashmap.HashMap.insert U64 hm0 128#usize 18#u64 - let hm2 ← hashmap.HashMap.insert U64 hm1 1024#usize 138#u64 - let hm3 ← hashmap.HashMap.insert U64 hm2 1056#usize 256#u64 - let i ← hashmap.HashMap.get U64 hm3 128#usize - if not (i = 18#u64) + let hm ← hashmap.HashMap.new U64 + let hm1 ← hashmap.HashMap.insert U64 hm 0#usize 42#u64 + let hm2 ← hashmap.HashMap.insert U64 hm1 128#usize 18#u64 + let hm3 ← hashmap.HashMap.insert U64 hm2 1024#usize 138#u64 + let hm4 ← hashmap.HashMap.insert U64 hm3 1056#usize 256#u64 + let i ← hashmap.HashMap.get U64 hm4 128#usize + if not (i = 18#u64) + then Result.fail .panic + else + do + let (_, get_mut_back) ← hashmap.HashMap.get_mut U64 hm4 1024#usize + let hm5 ← get_mut_back 56#u64 + let i1 ← hashmap.HashMap.get U64 hm5 1024#usize + if not (i1 = 56#u64) then Result.fail .panic else do - let hm4 ← hashmap.HashMap.get_mut_back U64 hm3 1024#usize 56#u64 - let i0 ← hashmap.HashMap.get U64 hm4 1024#usize - if not (i0 = 56#u64) + let (x, hm6) ← hashmap.HashMap.remove U64 hm5 1024#usize + match x with + | none => Result.fail .panic + | some x1 => + if not (x1 = 56#u64) then Result.fail .panic else do - let x ← hashmap.HashMap.remove U64 hm4 1024#usize - match x with - | none => Result.fail .panic - | some x0 => - if not (x0 = 56#u64) + let i2 ← hashmap.HashMap.get U64 hm6 0#usize + if not (i2 = 42#u64) + then Result.fail .panic + else + do + let i3 ← hashmap.HashMap.get U64 hm6 128#usize + if not (i3 = 18#u64) + then Result.fail .panic + else + do + let i4 ← hashmap.HashMap.get U64 hm6 1056#usize + if not (i4 = 256#u64) then Result.fail .panic - else - do - let hm5 ← hashmap.HashMap.remove_back U64 hm4 1024#usize - let i1 ← hashmap.HashMap.get U64 hm5 0#usize - if not (i1 = 42#u64) - then Result.fail .panic - else - do - let i2 ← hashmap.HashMap.get U64 hm5 128#usize - if not (i2 = 18#u64) - then Result.fail .panic - else - do - let i3 ← hashmap.HashMap.get U64 hm5 1056#usize - if not (i3 = 256#u64) - then Result.fail .panic - else Result.ret () - -/- [hashmap_main::insert_on_disk]: forward function + else Result.ret () + +/- [hashmap_main::insert_on_disk]: Source: 'src/hashmap_main.rs', lines 7:0-7:43 -/ def insert_on_disk (key : Usize) (value : U64) (st : State) : Result (State × Unit) := do - let (st0, hm) ← hashmap_utils.deserialize st - let hm0 ← hashmap.HashMap.insert U64 hm key value - let (st1, _) ← hashmap_utils.serialize hm0 st0 - Result.ret (st1, ()) + let (st1, hm) ← hashmap_utils.deserialize st + let hm1 ← hashmap.HashMap.insert U64 hm key value + let (st2, _) ← hashmap_utils.serialize hm1 st1 + Result.ret (st2, ()) -/- [hashmap_main::main]: forward function +/- [hashmap_main::main]: Source: 'src/hashmap_main.rs', lines 16:0-16:13 -/ def main : Result Unit := Result.ret () diff --git a/tests/lean/HashmapMain/FunsExternal_Template.lean b/tests/lean/HashmapMain/FunsExternal_Template.lean index 02ca5b0e..c09edbd2 100644 --- a/tests/lean/HashmapMain/FunsExternal_Template.lean +++ b/tests/lean/HashmapMain/FunsExternal_Template.lean @@ -6,12 +6,12 @@ import HashmapMain.Types open Primitives open hashmap_main -/- [hashmap_main::hashmap_utils::deserialize]: forward function +/- [hashmap_main::hashmap_utils::deserialize]: Source: 'src/hashmap_utils.rs', lines 10:0-10:43 -/ axiom hashmap_utils.deserialize : State → Result (State × (hashmap.HashMap U64)) -/- [hashmap_main::hashmap_utils::serialize]: forward function +/- [hashmap_main::hashmap_utils::serialize]: Source: 'src/hashmap_utils.rs', lines 5:0-5:42 -/ axiom hashmap_utils.serialize : hashmap.HashMap U64 → State → Result (State × Unit) diff --git a/tests/lean/Loops.lean b/tests/lean/Loops.lean index 08aa08a5..805ecabc 100644 --- a/tests/lean/Loops.lean +++ b/tests/lean/Loops.lean @@ -5,73 +5,72 @@ open Primitives namespace loops -/- [loops::sum]: loop 0: forward function +/- [loops::sum]: loop 0: Source: 'src/loops.rs', lines 4:0-14:1 -/ divergent def sum_loop (max : U32) (i : U32) (s : U32) : Result U32 := if i < max then do - let s0 ← s + i - let i0 ← i + 1#u32 - sum_loop max i0 s0 + let s1 ← s + i + let i1 ← i + 1#u32 + sum_loop max i1 s1 else s * 2#u32 -/- [loops::sum]: forward function +/- [loops::sum]: Source: 'src/loops.rs', lines 4:0-4:27 -/ def sum (max : U32) : Result U32 := sum_loop max 0#u32 0#u32 -/- [loops::sum_with_mut_borrows]: loop 0: forward function +/- [loops::sum_with_mut_borrows]: loop 0: Source: 'src/loops.rs', lines 19:0-31:1 -/ divergent def sum_with_mut_borrows_loop (max : U32) (mi : U32) (ms : U32) : Result U32 := if mi < max then do - let ms0 ← ms + mi - let mi0 ← mi + 1#u32 - sum_with_mut_borrows_loop max mi0 ms0 + let ms1 ← ms + mi + let mi1 ← mi + 1#u32 + sum_with_mut_borrows_loop max mi1 ms1 else ms * 2#u32 -/- [loops::sum_with_mut_borrows]: forward function +/- [loops::sum_with_mut_borrows]: Source: 'src/loops.rs', lines 19:0-19:44 -/ def sum_with_mut_borrows (max : U32) : Result U32 := sum_with_mut_borrows_loop max 0#u32 0#u32 -/- [loops::sum_with_shared_borrows]: loop 0: forward function +/- [loops::sum_with_shared_borrows]: loop 0: Source: 'src/loops.rs', lines 34:0-48:1 -/ divergent def sum_with_shared_borrows_loop (max : U32) (i : U32) (s : U32) : Result U32 := if i < max then do - let i0 ← i + 1#u32 - let s0 ← s + i0 - sum_with_shared_borrows_loop max i0 s0 + let i1 ← i + 1#u32 + let s1 ← s + i1 + sum_with_shared_borrows_loop max i1 s1 else s * 2#u32 -/- [loops::sum_with_shared_borrows]: forward function +/- [loops::sum_with_shared_borrows]: Source: 'src/loops.rs', lines 34:0-34:47 -/ def sum_with_shared_borrows (max : U32) : Result U32 := sum_with_shared_borrows_loop max 0#u32 0#u32 -/- [loops::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [loops::clear]: loop 0: Source: 'src/loops.rs', lines 52:0-58:1 -/ divergent def clear_loop (v : alloc.vec.Vec U32) (i : Usize) : Result (alloc.vec.Vec U32) := - let i0 := alloc.vec.Vec.len U32 v - if i < i0 + let i1 := alloc.vec.Vec.len U32 v + if i < i1 then do - let i1 ← i + 1#usize - let v0 ← - alloc.vec.Vec.index_mut_back U32 Usize - (core.slice.index.SliceIndexUsizeSliceTInst U32) v i 0#u32 - clear_loop v0 i1 + let (_, index_mut_back) ← + alloc.vec.Vec.index_mut U32 Usize + (core.slice.index.SliceIndexUsizeSliceTInst U32) v i + let i2 ← i + 1#usize + let v1 ← index_mut_back 0#u32 + clear_loop v1 i2 else Result.ret v -/- [loops::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [loops::clear]: Source: 'src/loops.rs', lines 52:0-52:30 -/ def clear (v : alloc.vec.Vec U32) : Result (alloc.vec.Vec U32) := clear_loop v 0#usize @@ -82,7 +81,7 @@ inductive List (T : Type) := | Cons : T → List T → List T | Nil : List T -/- [loops::list_mem]: loop 0: forward function +/- [loops::list_mem]: loop 0: Source: 'src/loops.rs', lines 66:0-75:1 -/ divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool := match ls with @@ -91,51 +90,42 @@ divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool := else list_mem_loop x tl | List.Nil => Result.ret false -/- [loops::list_mem]: forward function +/- [loops::list_mem]: Source: 'src/loops.rs', lines 66:0-66:52 -/ def list_mem (x : U32) (ls : List U32) : Result Bool := list_mem_loop x ls -/- [loops::list_nth_mut_loop]: loop 0: forward function +/- [loops::list_nth_mut_loop]: loop 0: Source: 'src/loops.rs', lines 78:0-88:1 -/ divergent def list_nth_mut_loop_loop - (T : Type) (ls : List T) (i : U32) : Result T := - match ls with - | List.Cons x tl => - if i = 0#u32 - then Result.ret x - else do - let i0 ← i - 1#u32 - list_nth_mut_loop_loop T tl i0 - | List.Nil => Result.fail .panic - -/- [loops::list_nth_mut_loop]: forward function - Source: 'src/loops.rs', lines 78:0-78:71 -/ -def list_nth_mut_loop (T : Type) (ls : List T) (i : U32) : Result T := - list_nth_mut_loop_loop T ls i - -/- [loops::list_nth_mut_loop]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 78:0-88:1 -/ -divergent def list_nth_mut_loop_loop_back - (T : Type) (ls : List T) (i : U32) (ret : T) : Result (List T) := + (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) := match ls with | List.Cons x tl => if i = 0#u32 - then Result.ret (List.Cons ret tl) + then + let back := fun ret => Result.ret (List.Cons ret tl) + Result.ret (x, back) else do - let i0 ← i - 1#u32 - let tl0 ← list_nth_mut_loop_loop_back T tl i0 ret - Result.ret (List.Cons x tl0) + let i1 ← i - 1#u32 + let (t, back) ← list_nth_mut_loop_loop T tl i1 + let back1 := + fun ret => do + let tl1 ← back ret + Result.ret (List.Cons x tl1) + Result.ret (t, back1) | List.Nil => Result.fail .panic -/- [loops::list_nth_mut_loop]: backward function 0 +/- [loops::list_nth_mut_loop]: Source: 'src/loops.rs', lines 78:0-78:71 -/ -def list_nth_mut_loop_back - (T : Type) (ls : List T) (i : U32) (ret : T) : Result (List T) := - list_nth_mut_loop_loop_back T ls i ret +def list_nth_mut_loop + (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) := + do + let (t, back) ← list_nth_mut_loop_loop T ls i + let back1 := fun ret => back ret + Result.ret (t, back1) -/- [loops::list_nth_shared_loop]: loop 0: forward function +/- [loops::list_nth_shared_loop]: loop 0: Source: 'src/loops.rs', lines 91:0-101:1 -/ divergent def list_nth_shared_loop_loop (T : Type) (ls : List T) (i : U32) : Result T := @@ -144,64 +134,54 @@ divergent def list_nth_shared_loop_loop if i = 0#u32 then Result.ret x else do - let i0 ← i - 1#u32 - list_nth_shared_loop_loop T tl i0 + let i1 ← i - 1#u32 + list_nth_shared_loop_loop T tl i1 | List.Nil => Result.fail .panic -/- [loops::list_nth_shared_loop]: forward function +/- [loops::list_nth_shared_loop]: Source: 'src/loops.rs', lines 91:0-91:66 -/ def list_nth_shared_loop (T : Type) (ls : List T) (i : U32) : Result T := list_nth_shared_loop_loop T ls i -/- [loops::get_elem_mut]: loop 0: forward function +/- [loops::get_elem_mut]: loop 0: Source: 'src/loops.rs', lines 103:0-117:1 -/ -divergent def get_elem_mut_loop (x : Usize) (ls : List Usize) : Result Usize := - match ls with - | List.Cons y tl => if y = x - then Result.ret y - else get_elem_mut_loop x tl - | List.Nil => Result.fail .panic - -/- [loops::get_elem_mut]: forward function - Source: 'src/loops.rs', lines 103:0-103:73 -/ -def get_elem_mut - (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := - do - let l ← - alloc.vec.Vec.index_mut (List Usize) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List Usize)) slots 0#usize - get_elem_mut_loop x l - -/- [loops::get_elem_mut]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 103:0-117:1 -/ -divergent def get_elem_mut_loop_back - (x : Usize) (ls : List Usize) (ret : Usize) : Result (List Usize) := +divergent def get_elem_mut_loop + (x : Usize) (ls : List Usize) : + Result (Usize × (Usize → Result (List Usize))) + := match ls with | List.Cons y tl => if y = x - then Result.ret (List.Cons ret tl) + then + let back := fun ret => Result.ret (List.Cons ret tl) + Result.ret (y, back) else do - let tl0 ← get_elem_mut_loop_back x tl ret - Result.ret (List.Cons y tl0) + let (i, back) ← get_elem_mut_loop x tl + let back1 := + fun ret => do + let tl1 ← back ret + Result.ret (List.Cons y tl1) + Result.ret (i, back1) | List.Nil => Result.fail .panic -/- [loops::get_elem_mut]: backward function 0 +/- [loops::get_elem_mut]: Source: 'src/loops.rs', lines 103:0-103:73 -/ -def get_elem_mut_back - (slots : alloc.vec.Vec (List Usize)) (x : Usize) (ret : Usize) : - Result (alloc.vec.Vec (List Usize)) +def get_elem_mut + (slots : alloc.vec.Vec (List Usize)) (x : Usize) : + Result (Usize × (Usize → Result (alloc.vec.Vec (List Usize)))) := do - let l ← - alloc.vec.Vec.index_mut (List Usize) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List Usize)) slots 0#usize - let l0 ← get_elem_mut_loop_back x l ret - alloc.vec.Vec.index_mut_back (List Usize) Usize + let (l, index_mut_back) ← + alloc.vec.Vec.index_mut (List Usize) Usize (core.slice.index.SliceIndexUsizeSliceTInst (List Usize)) slots 0#usize - l0 + let (i, back) ← get_elem_mut_loop x l + let back1 := fun ret => do + let l1 ← back ret + index_mut_back l1 + Result.ret (i, back1) -/- [loops::get_elem_shared]: loop 0: forward function +/- [loops::get_elem_shared]: loop 0: Source: 'src/loops.rs', lines 119:0-133:1 -/ divergent def get_elem_shared_loop (x : Usize) (ls : List Usize) : Result Usize := @@ -211,76 +191,64 @@ divergent def get_elem_shared_loop else get_elem_shared_loop x tl | List.Nil => Result.fail .panic -/- [loops::get_elem_shared]: forward function +/- [loops::get_elem_shared]: Source: 'src/loops.rs', lines 119:0-119:68 -/ def get_elem_shared (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := do - let l ← - alloc.vec.Vec.index (List Usize) Usize - (core.slice.index.SliceIndexUsizeSliceTInst (List Usize)) slots 0#usize - get_elem_shared_loop x l - -/- [loops::id_mut]: forward function - Source: 'src/loops.rs', lines 135:0-135:50 -/ -def id_mut (T : Type) (ls : List T) : Result (List T) := - Result.ret ls + let l ← + alloc.vec.Vec.index (List Usize) Usize + (core.slice.index.SliceIndexUsizeSliceTInst (List Usize)) slots 0#usize + get_elem_shared_loop x l -/- [loops::id_mut]: backward function 0 +/- [loops::id_mut]: Source: 'src/loops.rs', lines 135:0-135:50 -/ -def id_mut_back (T : Type) (ls : List T) (ret : List T) : Result (List T) := - Result.ret ret +def id_mut + (T : Type) (ls : List T) : + Result ((List T) × (List T → Result (List T))) + := + let back := fun ret => Result.ret ret + Result.ret (ls, back) -/- [loops::id_shared]: forward function +/- [loops::id_shared]: Source: 'src/loops.rs', lines 139:0-139:45 -/ def id_shared (T : Type) (ls : List T) : Result (List T) := Result.ret ls -/- [loops::list_nth_mut_loop_with_id]: loop 0: forward function +/- [loops::list_nth_mut_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 144:0-155:1 -/ divergent def list_nth_mut_loop_with_id_loop - (T : Type) (i : U32) (ls : List T) : Result T := + (T : Type) (i : U32) (ls : List T) : Result (T × (T → Result (List T))) := match ls with | List.Cons x tl => if i = 0#u32 - then Result.ret x - else do - let i0 ← i - 1#u32 - list_nth_mut_loop_with_id_loop T i0 tl - | List.Nil => Result.fail .panic - -/- [loops::list_nth_mut_loop_with_id]: forward function - Source: 'src/loops.rs', lines 144:0-144:75 -/ -def list_nth_mut_loop_with_id (T : Type) (ls : List T) (i : U32) : Result T := - do - let ls0 ← id_mut T ls - list_nth_mut_loop_with_id_loop T i ls0 - -/- [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 144:0-155:1 -/ -divergent def list_nth_mut_loop_with_id_loop_back - (T : Type) (i : U32) (ls : List T) (ret : T) : Result (List T) := - match ls with - | List.Cons x tl => - if i = 0#u32 - then Result.ret (List.Cons ret tl) + then + let back := fun ret => Result.ret (List.Cons ret tl) + Result.ret (x, back) else do - let i0 ← i - 1#u32 - let tl0 ← list_nth_mut_loop_with_id_loop_back T i0 tl ret - Result.ret (List.Cons x tl0) + let i1 ← i - 1#u32 + let (t, back) ← list_nth_mut_loop_with_id_loop T i1 tl + let back1 := + fun ret => do + let tl1 ← back ret + Result.ret (List.Cons x tl1) + Result.ret (t, back1) | List.Nil => Result.fail .panic -/- [loops::list_nth_mut_loop_with_id]: backward function 0 +/- [loops::list_nth_mut_loop_with_id]: Source: 'src/loops.rs', lines 144:0-144:75 -/ -def list_nth_mut_loop_with_id_back - (T : Type) (ls : List T) (i : U32) (ret : T) : Result (List T) := +def list_nth_mut_loop_with_id + (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) := do - let ls0 ← id_mut T ls - let l ← list_nth_mut_loop_with_id_loop_back T i ls0 ret - id_mut_back T ls l - -/- [loops::list_nth_shared_loop_with_id]: loop 0: forward function + let (ls1, id_mut_back) ← id_mut T ls + let (t, back) ← list_nth_mut_loop_with_id_loop T i ls1 + let back1 := fun ret => do + let l ← back ret + id_mut_back l + Result.ret (t, back1) + +/- [loops::list_nth_shared_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 158:0-169:1 -/ divergent def list_nth_shared_loop_with_id_loop (T : Type) (i : U32) (ls : List T) : Result T := @@ -289,97 +257,62 @@ divergent def list_nth_shared_loop_with_id_loop if i = 0#u32 then Result.ret x else do - let i0 ← i - 1#u32 - list_nth_shared_loop_with_id_loop T i0 tl + let i1 ← i - 1#u32 + list_nth_shared_loop_with_id_loop T i1 tl | List.Nil => Result.fail .panic -/- [loops::list_nth_shared_loop_with_id]: forward function +/- [loops::list_nth_shared_loop_with_id]: Source: 'src/loops.rs', lines 158:0-158:70 -/ def list_nth_shared_loop_with_id (T : Type) (ls : List T) (i : U32) : Result T := do - let ls0 ← id_shared T ls - list_nth_shared_loop_with_id_loop T i ls0 + let ls1 ← id_shared T ls + list_nth_shared_loop_with_id_loop T i ls1 -/- [loops::list_nth_mut_loop_pair]: loop 0: forward function +/- [loops::list_nth_mut_loop_pair]: loop 0: Source: 'src/loops.rs', lines 174:0-195:1 -/ divergent def list_nth_mut_loop_pair_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else do - let i0 ← i - 1#u32 - list_nth_mut_loop_pair_loop T tl0 tl1 i0 - | List.Nil => Result.fail .panic - | List.Nil => Result.fail .panic - -/- [loops::list_nth_mut_loop_pair]: forward function - Source: 'src/loops.rs', lines 174:0-178:27 -/ -def list_nth_mut_loop_pair - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_mut_loop_pair_loop T ls0 ls1 i - -/- [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 174:0-195:1 -/ -divergent def list_nth_mut_loop_pair_loop_back'a - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T)) × (T → Result (List T))) := match ls0 with | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => if i = 0#u32 - then Result.ret (List.Cons ret tl0) + then + let back_'a := fun ret => Result.ret (List.Cons ret tl0) + let back_'b := fun ret => Result.ret (List.Cons ret tl1) + Result.ret ((x0, x1), back_'a, back_'b) else do - let i0 ← i - 1#u32 - let tl00 ← list_nth_mut_loop_pair_loop_back'a T tl0 tl1 i0 ret - Result.ret (List.Cons x0 tl00) + let i1 ← i - 1#u32 + let (p, back_'a, back_'b) ← list_nth_mut_loop_pair_loop T tl0 tl1 i1 + let back_'a1 := + fun ret => do + let tl01 ← back_'a ret + Result.ret (List.Cons x0 tl01) + let back_'b1 := + fun ret => do + let tl11 ← back_'b ret + Result.ret (List.Cons x1 tl11) + Result.ret (p, back_'a1, back_'b1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic -/- [loops::list_nth_mut_loop_pair]: backward function 0 +/- [loops::list_nth_mut_loop_pair]: Source: 'src/loops.rs', lines 174:0-178:27 -/ -def list_nth_mut_loop_pair_back'a - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) - := - list_nth_mut_loop_pair_loop_back'a T ls0 ls1 i ret - -/- [loops::list_nth_mut_loop_pair]: loop 0: backward function 1 - Source: 'src/loops.rs', lines 174:0-195:1 -/ -divergent def list_nth_mut_loop_pair_loop_back'b - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) - := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (List.Cons ret tl1) - else - do - let i0 ← i - 1#u32 - let tl10 ← list_nth_mut_loop_pair_loop_back'b T tl0 tl1 i0 ret - Result.ret (List.Cons x1 tl10) - | List.Nil => Result.fail .panic - | List.Nil => Result.fail .panic - -/- [loops::list_nth_mut_loop_pair]: backward function 1 - Source: 'src/loops.rs', lines 174:0-178:27 -/ -def list_nth_mut_loop_pair_back'b - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) +def list_nth_mut_loop_pair + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T)) × (T → Result (List T))) := - list_nth_mut_loop_pair_loop_back'b T ls0 ls1 i ret + do + let (p, back_'a, back_'b) ← list_nth_mut_loop_pair_loop T ls0 ls1 i + let back_'a1 := fun ret => back_'a ret + let back_'b1 := fun ret => back_'b ret + Result.ret (p, back_'a1, back_'b1) -/- [loops::list_nth_shared_loop_pair]: loop 0: forward function +/- [loops::list_nth_shared_loop_pair]: loop 0: Source: 'src/loops.rs', lines 198:0-219:1 -/ divergent def list_nth_shared_loop_pair_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := @@ -390,71 +323,59 @@ divergent def list_nth_shared_loop_pair_loop if i = 0#u32 then Result.ret (x0, x1) else do - let i0 ← i - 1#u32 - list_nth_shared_loop_pair_loop T tl0 tl1 i0 + let i1 ← i - 1#u32 + list_nth_shared_loop_pair_loop T tl0 tl1 i1 | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic -/- [loops::list_nth_shared_loop_pair]: forward function +/- [loops::list_nth_shared_loop_pair]: Source: 'src/loops.rs', lines 198:0-202:19 -/ def list_nth_shared_loop_pair (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := list_nth_shared_loop_pair_loop T ls0 ls1 i -/- [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function +/- [loops::list_nth_mut_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 223:0-238:1 -/ divergent def list_nth_mut_loop_pair_merge_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_mut_loop_pair_merge_loop T tl0 tl1 i0 - | List.Nil => Result.fail .panic - | List.Nil => Result.fail .panic - -/- [loops::list_nth_mut_loop_pair_merge]: forward function - Source: 'src/loops.rs', lines 223:0-227:27 -/ -def list_nth_mut_loop_pair_merge - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_mut_loop_pair_merge_loop T ls0 ls1 i - -/- [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 223:0-238:1 -/ -divergent def list_nth_mut_loop_pair_merge_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : (T × T)) : - Result ((List T) × (List T)) + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × ((T × T) → Result ((List T) × (List T)))) := match ls0 with | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => if i = 0#u32 - then let (t, t0) := ret - Result.ret (List.Cons t tl0, List.Cons t0 tl1) + then + let back_'a := + fun ret => + let (t, t1) := ret + Result.ret (List.Cons t tl0, List.Cons t1 tl1) + Result.ret ((x0, x1), back_'a) else do - let i0 ← i - 1#u32 - let (tl00, tl10) ← - list_nth_mut_loop_pair_merge_loop_back T tl0 tl1 i0 ret - Result.ret (List.Cons x0 tl00, List.Cons x1 tl10) + let i1 ← i - 1#u32 + let (p, back_'a) ← list_nth_mut_loop_pair_merge_loop T tl0 tl1 i1 + let back_'a1 := + fun ret => + do + let (tl01, tl11) ← back_'a ret + Result.ret (List.Cons x0 tl01, List.Cons x1 tl11) + Result.ret (p, back_'a1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic -/- [loops::list_nth_mut_loop_pair_merge]: backward function 0 +/- [loops::list_nth_mut_loop_pair_merge]: Source: 'src/loops.rs', lines 223:0-227:27 -/ -def list_nth_mut_loop_pair_merge_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : (T × T)) : - Result ((List T) × (List T)) +def list_nth_mut_loop_pair_merge + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × ((T × T) → Result ((List T) × (List T)))) := - list_nth_mut_loop_pair_merge_loop_back T ls0 ls1 i ret + do + let (p, back_'a) ← list_nth_mut_loop_pair_merge_loop T ls0 ls1 i + let back_'a1 := fun ret => back_'a ret + Result.ret (p, back_'a1) -/- [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function +/- [loops::list_nth_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 241:0-256:1 -/ divergent def list_nth_shared_loop_pair_merge_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := @@ -466,221 +387,165 @@ divergent def list_nth_shared_loop_pair_merge_loop then Result.ret (x0, x1) else do - let i0 ← i - 1#u32 - list_nth_shared_loop_pair_merge_loop T tl0 tl1 i0 + let i1 ← i - 1#u32 + list_nth_shared_loop_pair_merge_loop T tl0 tl1 i1 | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic -/- [loops::list_nth_shared_loop_pair_merge]: forward function +/- [loops::list_nth_shared_loop_pair_merge]: Source: 'src/loops.rs', lines 241:0-245:19 -/ def list_nth_shared_loop_pair_merge (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := list_nth_shared_loop_pair_merge_loop T ls0 ls1 i -/- [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function +/- [loops::list_nth_mut_shared_loop_pair]: loop 0: Source: 'src/loops.rs', lines 259:0-274:1 -/ divergent def list_nth_mut_shared_loop_pair_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_mut_shared_loop_pair_loop T tl0 tl1 i0 - | List.Nil => Result.fail .panic - | List.Nil => Result.fail .panic - -/- [loops::list_nth_mut_shared_loop_pair]: forward function - Source: 'src/loops.rs', lines 259:0-263:23 -/ -def list_nth_mut_shared_loop_pair - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_mut_shared_loop_pair_loop T ls0 ls1 i - -/- [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 259:0-274:1 -/ -divergent def list_nth_mut_shared_loop_pair_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T))) := match ls0 with | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => if i = 0#u32 - then Result.ret (List.Cons ret tl0) + then + let back_'a := fun ret => Result.ret (List.Cons ret tl0) + Result.ret ((x0, x1), back_'a) else do - let i0 ← i - 1#u32 - let tl00 ← list_nth_mut_shared_loop_pair_loop_back T tl0 tl1 i0 ret - Result.ret (List.Cons x0 tl00) + let i1 ← i - 1#u32 + let (p, back_'a) ← list_nth_mut_shared_loop_pair_loop T tl0 tl1 i1 + let back_'a1 := + fun ret => do + let tl01 ← back_'a ret + Result.ret (List.Cons x0 tl01) + Result.ret (p, back_'a1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic -/- [loops::list_nth_mut_shared_loop_pair]: backward function 0 +/- [loops::list_nth_mut_shared_loop_pair]: Source: 'src/loops.rs', lines 259:0-263:23 -/ -def list_nth_mut_shared_loop_pair_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) +def list_nth_mut_shared_loop_pair + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T))) := - list_nth_mut_shared_loop_pair_loop_back T ls0 ls1 i ret + do + let (p, back_'a) ← list_nth_mut_shared_loop_pair_loop T ls0 ls1 i + let back_'a1 := fun ret => back_'a ret + Result.ret (p, back_'a1) -/- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function +/- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 278:0-293:1 -/ divergent def list_nth_mut_shared_loop_pair_merge_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_mut_shared_loop_pair_merge_loop T tl0 tl1 i0 - | List.Nil => Result.fail .panic - | List.Nil => Result.fail .panic - -/- [loops::list_nth_mut_shared_loop_pair_merge]: forward function - Source: 'src/loops.rs', lines 278:0-282:23 -/ -def list_nth_mut_shared_loop_pair_merge - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_mut_shared_loop_pair_merge_loop T ls0 ls1 i - -/- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 278:0-293:1 -/ -divergent def list_nth_mut_shared_loop_pair_merge_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T))) := match ls0 with | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => if i = 0#u32 - then Result.ret (List.Cons ret tl0) + then + let back_'a := fun ret => Result.ret (List.Cons ret tl0) + Result.ret ((x0, x1), back_'a) else do - let i0 ← i - 1#u32 - let tl00 ← - list_nth_mut_shared_loop_pair_merge_loop_back T tl0 tl1 i0 ret - Result.ret (List.Cons x0 tl00) + let i1 ← i - 1#u32 + let (p, back_'a) ← + list_nth_mut_shared_loop_pair_merge_loop T tl0 tl1 i1 + let back_'a1 := + fun ret => do + let tl01 ← back_'a ret + Result.ret (List.Cons x0 tl01) + Result.ret (p, back_'a1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic -/- [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 +/- [loops::list_nth_mut_shared_loop_pair_merge]: Source: 'src/loops.rs', lines 278:0-282:23 -/ -def list_nth_mut_shared_loop_pair_merge_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) +def list_nth_mut_shared_loop_pair_merge + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T))) := - list_nth_mut_shared_loop_pair_merge_loop_back T ls0 ls1 i ret + do + let (p, back_'a) ← list_nth_mut_shared_loop_pair_merge_loop T ls0 ls1 i + let back_'a1 := fun ret => back_'a ret + Result.ret (p, back_'a1) -/- [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function +/- [loops::list_nth_shared_mut_loop_pair]: loop 0: Source: 'src/loops.rs', lines 297:0-312:1 -/ divergent def list_nth_shared_mut_loop_pair_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_shared_mut_loop_pair_loop T tl0 tl1 i0 - | List.Nil => Result.fail .panic - | List.Nil => Result.fail .panic - -/- [loops::list_nth_shared_mut_loop_pair]: forward function - Source: 'src/loops.rs', lines 297:0-301:23 -/ -def list_nth_shared_mut_loop_pair - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_shared_mut_loop_pair_loop T ls0 ls1 i - -/- [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 - Source: 'src/loops.rs', lines 297:0-312:1 -/ -divergent def list_nth_shared_mut_loop_pair_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T))) := match ls0 with | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => if i = 0#u32 - then Result.ret (List.Cons ret tl1) + then + let back_'b := fun ret => Result.ret (List.Cons ret tl1) + Result.ret ((x0, x1), back_'b) else do - let i0 ← i - 1#u32 - let tl10 ← list_nth_shared_mut_loop_pair_loop_back T tl0 tl1 i0 ret - Result.ret (List.Cons x1 tl10) + let i1 ← i - 1#u32 + let (p, back_'b) ← list_nth_shared_mut_loop_pair_loop T tl0 tl1 i1 + let back_'b1 := + fun ret => do + let tl11 ← back_'b ret + Result.ret (List.Cons x1 tl11) + Result.ret (p, back_'b1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic -/- [loops::list_nth_shared_mut_loop_pair]: backward function 1 +/- [loops::list_nth_shared_mut_loop_pair]: Source: 'src/loops.rs', lines 297:0-301:23 -/ -def list_nth_shared_mut_loop_pair_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) +def list_nth_shared_mut_loop_pair + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T))) := - list_nth_shared_mut_loop_pair_loop_back T ls0 ls1 i ret + do + let (p, back_'b) ← list_nth_shared_mut_loop_pair_loop T ls0 ls1 i + let back_'b1 := fun ret => back_'b ret + Result.ret (p, back_'b1) -/- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function +/- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 316:0-331:1 -/ divergent def list_nth_shared_mut_loop_pair_merge_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_shared_mut_loop_pair_merge_loop T tl0 tl1 i0 - | List.Nil => Result.fail .panic - | List.Nil => Result.fail .panic - -/- [loops::list_nth_shared_mut_loop_pair_merge]: forward function - Source: 'src/loops.rs', lines 316:0-320:23 -/ -def list_nth_shared_mut_loop_pair_merge - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_shared_mut_loop_pair_merge_loop T ls0 ls1 i - -/- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 - Source: 'src/loops.rs', lines 316:0-331:1 -/ -divergent def list_nth_shared_mut_loop_pair_merge_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T))) := match ls0 with | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => if i = 0#u32 - then Result.ret (List.Cons ret tl1) + then + let back_'a := fun ret => Result.ret (List.Cons ret tl1) + Result.ret ((x0, x1), back_'a) else do - let i0 ← i - 1#u32 - let tl10 ← - list_nth_shared_mut_loop_pair_merge_loop_back T tl0 tl1 i0 ret - Result.ret (List.Cons x1 tl10) + let i1 ← i - 1#u32 + let (p, back_'a) ← + list_nth_shared_mut_loop_pair_merge_loop T tl0 tl1 i1 + let back_'a1 := + fun ret => do + let tl11 ← back_'a ret + Result.ret (List.Cons x1 tl11) + Result.ret (p, back_'a1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic -/- [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 +/- [loops::list_nth_shared_mut_loop_pair_merge]: Source: 'src/loops.rs', lines 316:0-320:23 -/ -def list_nth_shared_mut_loop_pair_merge_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret : T) : - Result (List T) +def list_nth_shared_mut_loop_pair_merge + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : + Result ((T × T) × (T → Result (List T))) := - list_nth_shared_mut_loop_pair_merge_loop_back T ls0 ls1 i ret + do + let (p, back_'a) ← list_nth_shared_mut_loop_pair_merge_loop T ls0 ls1 i + let back_'a1 := fun ret => back_'a ret + Result.ret (p, back_'a1) end loops diff --git a/tests/lean/Paper.lean b/tests/lean/Paper.lean index 08386bb7..015fec84 100644 --- a/tests/lean/Paper.lean +++ b/tests/lean/Paper.lean @@ -5,55 +5,51 @@ open Primitives namespace paper -/- [paper::ref_incr]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [paper::ref_incr]: Source: 'src/paper.rs', lines 4:0-4:28 -/ def ref_incr (x : I32) : Result I32 := x + 1#i32 -/- [paper::test_incr]: forward function +/- [paper::test_incr]: Source: 'src/paper.rs', lines 8:0-8:18 -/ def test_incr : Result Unit := do - let x ← ref_incr 0#i32 - if not (x = 1#i32) - then Result.fail .panic - else Result.ret () + let i ← ref_incr 0#i32 + if not (i = 1#i32) + then Result.fail .panic + else Result.ret () /- Unit test for [paper::test_incr] -/ #assert (test_incr == Result.ret ()) -/- [paper::choose]: forward function - Source: 'src/paper.rs', lines 15:0-15:70 -/ -def choose (T : Type) (b : Bool) (x : T) (y : T) : Result T := - if b - then Result.ret x - else Result.ret y - -/- [paper::choose]: backward function 0 +/- [paper::choose]: Source: 'src/paper.rs', lines 15:0-15:70 -/ -def choose_back - (T : Type) (b : Bool) (x : T) (y : T) (ret : T) : Result (T × T) := +def choose + (T : Type) (b : Bool) (x : T) (y : T) : + Result (T × (T → Result (T × T))) + := if b - then Result.ret (ret, y) - else Result.ret (x, ret) + then let back_'a := fun ret => Result.ret (ret, y) + Result.ret (x, back_'a) + else let back_'a := fun ret => Result.ret (x, ret) + Result.ret (y, back_'a) -/- [paper::test_choose]: forward function +/- [paper::test_choose]: Source: 'src/paper.rs', lines 23:0-23:20 -/ def test_choose : Result Unit := do - let z ← choose I32 true 0#i32 0#i32 - let z0 ← z + 1#i32 - if not (z0 = 1#i32) + let (z, choose_back) ← choose I32 true 0#i32 0#i32 + let z1 ← z + 1#i32 + if not (z1 = 1#i32) + then Result.fail .panic + else + do + let (x, y) ← choose_back z1 + if not (x = 1#i32) then Result.fail .panic - else - do - let (x, y) ← choose_back I32 true 0#i32 0#i32 z0 - if not (x = 1#i32) - then Result.fail .panic - else if not (y = 0#i32) - then Result.fail .panic - else Result.ret () + else if not (y = 0#i32) + then Result.fail .panic + else Result.ret () /- Unit test for [paper::test_choose] -/ #assert (test_choose == Result.ret ()) @@ -64,68 +60,63 @@ inductive List (T : Type) := | Cons : T → List T → List T | Nil : List T -/- [paper::list_nth_mut]: forward function +/- [paper::list_nth_mut]: Source: 'src/paper.rs', lines 42:0-42:67 -/ -divergent def list_nth_mut (T : Type) (l : List T) (i : U32) : Result T := +divergent def list_nth_mut + (T : Type) (l : List T) (i : U32) : Result (T × (T → Result (List T))) := match l with | List.Cons x tl => if i = 0#u32 - then Result.ret x - else do - let i0 ← i - 1#u32 - list_nth_mut T tl i0 - | List.Nil => Result.fail .panic - -/- [paper::list_nth_mut]: backward function 0 - Source: 'src/paper.rs', lines 42:0-42:67 -/ -divergent def list_nth_mut_back - (T : Type) (l : List T) (i : U32) (ret : T) : Result (List T) := - match l with - | List.Cons x tl => - if i = 0#u32 - then Result.ret (List.Cons ret tl) + then + let back_'a := fun ret => Result.ret (List.Cons ret tl) + Result.ret (x, back_'a) else do - let i0 ← i - 1#u32 - let tl0 ← list_nth_mut_back T tl i0 ret - Result.ret (List.Cons x tl0) + let i1 ← i - 1#u32 + let (t, list_nth_mut_back) ← list_nth_mut T tl i1 + let back_'a := + fun ret => + do + let tl1 ← list_nth_mut_back ret + Result.ret (List.Cons x tl1) + Result.ret (t, back_'a) | List.Nil => Result.fail .panic -/- [paper::sum]: forward function +/- [paper::sum]: Source: 'src/paper.rs', lines 57:0-57:32 -/ divergent def sum (l : List I32) : Result I32 := match l with | List.Cons x tl => do - let i ← sum tl - x + i + let i ← sum tl + x + i | List.Nil => Result.ret 0#i32 -/- [paper::test_nth]: forward function +/- [paper::test_nth]: Source: 'src/paper.rs', lines 68:0-68:17 -/ def test_nth : Result Unit := do - let l := List.Nil - let l0 := List.Cons 3#i32 l - let l1 := List.Cons 2#i32 l0 - let x ← list_nth_mut I32 (List.Cons 1#i32 l1) 2#u32 - let x0 ← x + 1#i32 - let l2 ← list_nth_mut_back I32 (List.Cons 1#i32 l1) 2#u32 x0 - let i ← sum l2 - if not (i = 7#i32) - then Result.fail .panic - else Result.ret () + let l := List.Nil + let l1 := List.Cons 3#i32 l + let l2 := List.Cons 2#i32 l1 + let (x, list_nth_mut_back) ← list_nth_mut I32 (List.Cons 1#i32 l2) 2#u32 + let x1 ← x + 1#i32 + let l3 ← list_nth_mut_back x1 + let i ← sum l3 + if not (i = 7#i32) + then Result.fail .panic + else Result.ret () /- Unit test for [paper::test_nth] -/ #assert (test_nth == Result.ret ()) -/- [paper::call_choose]: forward function +/- [paper::call_choose]: Source: 'src/paper.rs', lines 76:0-76:44 -/ def call_choose (p : (U32 × U32)) : Result U32 := do - let (px, py) := p - let pz ← choose U32 true px py - let pz0 ← pz + 1#u32 - let (px0, _) ← choose_back U32 true px py pz0 - Result.ret px0 + let (px, py) := p + let (pz, choose_back) ← choose U32 true px py + let pz1 ← pz + 1#u32 + let (px1, _) ← choose_back pz1 + Result.ret px1 end paper diff --git a/tests/lean/PoloniusList.lean b/tests/lean/PoloniusList.lean index 37f0dffb..a485adbe 100644 --- a/tests/lean/PoloniusList.lean +++ b/tests/lean/PoloniusList.lean @@ -11,28 +11,29 @@ inductive List (T : Type) := | Cons : T → List T → List T | Nil : List T -/- [polonius_list::get_list_at_x]: forward function +/- [polonius_list::get_list_at_x]: Source: 'src/polonius_list.rs', lines 13:0-13:76 -/ -divergent def get_list_at_x (ls : List U32) (x : U32) : Result (List U32) := +divergent def get_list_at_x + (ls : List U32) (x : U32) : + Result ((List U32) × (List U32 → Result (List U32))) + := match ls with | List.Cons hd tl => if hd = x - then Result.ret (List.Cons hd tl) - else get_list_at_x tl x - | List.Nil => Result.ret List.Nil - -/- [polonius_list::get_list_at_x]: backward function 0 - Source: 'src/polonius_list.rs', lines 13:0-13:76 -/ -divergent def get_list_at_x_back - (ls : List U32) (x : U32) (ret : List U32) : Result (List U32) := - match ls with - | List.Cons hd tl => - if hd = x - then Result.ret ret + then + let back_'a := fun ret => Result.ret ret + Result.ret (List.Cons hd tl, back_'a) else do - let tl0 ← get_list_at_x_back tl x ret - Result.ret (List.Cons hd tl0) - | List.Nil => Result.ret ret + let (l, get_list_at_x_back) ← get_list_at_x tl x + let back_'a := + fun ret => + do + let tl1 ← get_list_at_x_back ret + Result.ret (List.Cons hd tl1) + Result.ret (l, back_'a) + | List.Nil => + let back_'a := fun ret => Result.ret ret + Result.ret (List.Nil, back_'a) end polonius_list diff --git a/tests/lean/Traits.lean b/tests/lean/Traits.lean index 17118203..63d07d85 100644 --- a/tests/lean/Traits.lean +++ b/tests/lean/Traits.lean @@ -10,7 +10,7 @@ namespace traits structure BoolTrait (Self : Type) where get_bool : Self → Result Bool -/- [traits::{bool}::get_bool]: forward function +/- [traits::{bool}::get_bool]: Source: 'src/traits.rs', lines 12:4-12:30 -/ def Bool.get_bool (self : Bool) : Result Bool := Result.ret self @@ -21,27 +21,27 @@ def traits.BoolTraitBoolInst : BoolTrait Bool := { get_bool := Bool.get_bool } -/- [traits::BoolTrait::ret_true]: forward function +/- [traits::BoolTrait::ret_true]: Source: 'src/traits.rs', lines 6:4-6:30 -/ def BoolTrait.ret_true {Self : Type} (self_clause : BoolTrait Self) (self : Self) : Result Bool := Result.ret true -/- [traits::test_bool_trait_bool]: forward function +/- [traits::test_bool_trait_bool]: Source: 'src/traits.rs', lines 17:0-17:44 -/ def test_bool_trait_bool (x : Bool) : Result Bool := do - let b ← Bool.get_bool x - if b - then BoolTrait.ret_true traits.BoolTraitBoolInst x - else Result.ret false + let b ← Bool.get_bool x + if b + then BoolTrait.ret_true traits.BoolTraitBoolInst x + else Result.ret false -/- [traits::{core::option::Option#1}::get_bool]: forward function +/- [traits::{core::option::Option#1}::get_bool]: Source: 'src/traits.rs', lines 23:4-23:30 -/ def Option.get_bool (T : Type) (self : Option T) : Result Bool := match self with | none => Result.ret false - | some t => Result.ret true + | some _ => Result.ret true /- Trait implementation: [traits::{core::option::Option#1}] Source: 'src/traits.rs', lines 22:0-22:31 -/ @@ -50,16 +50,16 @@ def traits.BoolTraitcoreoptionOptionTInst (T : Type) : BoolTrait (Option T) get_bool := Option.get_bool T } -/- [traits::test_bool_trait_option]: forward function +/- [traits::test_bool_trait_option]: Source: 'src/traits.rs', lines 31:0-31:54 -/ def test_bool_trait_option (T : Type) (x : Option T) : Result Bool := do - let b ← Option.get_bool T x - if b - then BoolTrait.ret_true (traits.BoolTraitcoreoptionOptionTInst T) x - else Result.ret false + let b ← Option.get_bool T x + if b + then BoolTrait.ret_true (traits.BoolTraitcoreoptionOptionTInst T) x + else Result.ret false -/- [traits::test_bool_trait]: forward function +/- [traits::test_bool_trait]: Source: 'src/traits.rs', lines 35:0-35:50 -/ def test_bool_trait (T : Type) (BoolTraitTInst : BoolTrait T) (x : T) : Result Bool := @@ -70,7 +70,7 @@ def test_bool_trait structure ToU64 (Self : Type) where to_u64 : Self → Result U64 -/- [traits::{u64#2}::to_u64]: forward function +/- [traits::{u64#2}::to_u64]: Source: 'src/traits.rs', lines 44:4-44:26 -/ def U64.to_u64 (self : U64) : Result U64 := Result.ret self @@ -81,15 +81,15 @@ def traits.ToU64U64Inst : ToU64 U64 := { to_u64 := U64.to_u64 } -/- [traits::{(A, A)#3}::to_u64]: forward function +/- [traits::{(A, A)#3}::to_u64]: Source: 'src/traits.rs', lines 50:4-50:26 -/ def Pair.to_u64 (A : Type) (ToU64AInst : ToU64 A) (self : (A × A)) : Result U64 := do - let (t, t0) := self - let i ← ToU64AInst.to_u64 t - let i0 ← ToU64AInst.to_u64 t0 - i + i0 + let (t, t1) := self + let i ← ToU64AInst.to_u64 t + let i1 ← ToU64AInst.to_u64 t1 + i + i1 /- Trait implementation: [traits::{(A, A)#3}] Source: 'src/traits.rs', lines 49:0-49:31 -/ @@ -98,18 +98,18 @@ def traits.ToU64TupleAAInst (A : Type) (ToU64AInst : ToU64 A) : ToU64 (A × A) to_u64 := Pair.to_u64 A ToU64AInst } -/- [traits::f]: forward function +/- [traits::f]: Source: 'src/traits.rs', lines 55:0-55:36 -/ def f (T : Type) (ToU64TInst : ToU64 T) (x : (T × T)) : Result U64 := Pair.to_u64 T ToU64TInst x -/- [traits::g]: forward function +/- [traits::g]: Source: 'src/traits.rs', lines 59:0-61:18 -/ def g (T : Type) (ToU64TupleTTInst : ToU64 (T × T)) (x : (T × T)) : Result U64 := ToU64TupleTTInst.to_u64 x -/- [traits::h0]: forward function +/- [traits::h0]: Source: 'src/traits.rs', lines 66:0-66:24 -/ def h0 (x : U64) : Result U64 := U64.to_u64 x @@ -119,7 +119,7 @@ def h0 (x : U64) : Result U64 := structure Wrapper (T : Type) where x : T -/- [traits::{traits::Wrapper#4}::to_u64]: forward function +/- [traits::{traits::Wrapper#4}::to_u64]: Source: 'src/traits.rs', lines 75:4-75:26 -/ def Wrapper.to_u64 (T : Type) (ToU64TInst : ToU64 T) (self : Wrapper T) : Result U64 := @@ -132,12 +132,12 @@ def traits.ToU64traitsWrapperTInst (T : Type) (ToU64TInst : ToU64 T) : ToU64 to_u64 := Wrapper.to_u64 T ToU64TInst } -/- [traits::h1]: forward function +/- [traits::h1]: Source: 'src/traits.rs', lines 80:0-80:33 -/ def h1 (x : Wrapper U64) : Result U64 := Wrapper.to_u64 U64 traits.ToU64U64Inst x -/- [traits::h2]: forward function +/- [traits::h2]: Source: 'src/traits.rs', lines 84:0-84:41 -/ def h2 (T : Type) (ToU64TInst : ToU64 T) (x : Wrapper T) : Result U64 := Wrapper.to_u64 T ToU64TInst x @@ -147,7 +147,7 @@ def h2 (T : Type) (ToU64TInst : ToU64 T) (x : Wrapper T) : Result U64 := structure ToType (Self T : Type) where to_type : Self → Result T -/- [traits::{u64#5}::to_type]: forward function +/- [traits::{u64#5}::to_type]: Source: 'src/traits.rs', lines 93:4-93:28 -/ def U64.to_type (self : U64) : Result Bool := Result.ret (self > 0#u64) @@ -164,7 +164,7 @@ structure OfType (Self : Type) where of_type : forall (T : Type) (ToTypeTSelfInst : ToType T Self), T → Result Self -/- [traits::h3]: forward function +/- [traits::h3]: Source: 'src/traits.rs', lines 104:0-104:50 -/ def h3 (T1 T2 : Type) (OfTypeT1Inst : OfType T1) (ToTypeT2T1Inst : ToType T2 T1) @@ -179,7 +179,7 @@ structure OfTypeBis (Self T : Type) where ToTypeTSelfInst : ToType T Self of_type : T → Result Self -/- [traits::h4]: forward function +/- [traits::h4]: Source: 'src/traits.rs', lines 118:0-118:57 -/ def h4 (T1 T2 : Type) (OfTypeBisT1T2Inst : OfTypeBis T1 T2) (ToTypeT2T1Inst : ToType @@ -201,7 +201,7 @@ def h4 structure TestType.test.TestTrait (Self : Type) where test : Self → Result Bool -/- [traits::{traits::TestType#6}::test::{traits::{traits::TestType#6}::test::TestType1}::test]: forward function +/- [traits::{traits::TestType#6}::test::{traits::{traits::TestType#6}::test::TestType1}::test]: Source: 'src/traits.rs', lines 139:12-139:34 -/ def TestType.test.TestType1.test (self : TestType.test.TestType1) : Result Bool := @@ -214,23 +214,23 @@ def traits.TestType.test.TestTraittraitstraitsTestTypeTtestTestType1Inst : test := TestType.test.TestType1.test } -/- [traits::{traits::TestType#6}::test]: forward function +/- [traits::{traits::TestType#6}::test]: Source: 'src/traits.rs', lines 126:4-126:36 -/ def TestType.test (T : Type) (ToU64TInst : ToU64 T) (self : TestType T) (x : T) : Result Bool := do - let x0 ← ToU64TInst.to_u64 x - if x0 > 0#u64 - then TestType.test.TestType1.test 0#u64 - else Result.ret false + let x1 ← ToU64TInst.to_u64 x + if x1 > 0#u64 + then TestType.test.TestType1.test 0#u64 + else Result.ret false /- [traits::BoolWrapper] Source: 'src/traits.rs', lines 150:0-150:22 -/ @[reducible] def BoolWrapper := Bool -/- [traits::{traits::BoolWrapper#7}::to_type]: forward function +/- [traits::{traits::BoolWrapper#7}::to_type]: Source: 'src/traits.rs', lines 156:4-156:25 -/ def BoolWrapper.to_type (T : Type) (ToTypeBoolTInst : ToType Bool T) (self : BoolWrapper) : @@ -266,8 +266,7 @@ structure WithConstTy (Self : Type) (LEN : Usize) where def bool_len1_body : Result Usize := Result.ret 12#usize def bool_len1_c : Usize := eval_global bool_len1_body (by simp) -/- [traits::{bool#8}::f]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) +/- [traits::{bool#8}::f]: Source: 'src/traits.rs', lines 180:4-180:39 -/ def Bool.f (i : U64) (a : Array U8 32#usize) : Result U64 := Result.ret i @@ -283,7 +282,7 @@ def traits.WithConstTyBool32Inst : WithConstTy Bool 32#usize := { f := Bool.f } -/- [traits::use_with_const_ty1]: forward function +/- [traits::use_with_const_ty1]: Source: 'src/traits.rs', lines 183:0-183:75 -/ def use_with_const_ty1 (H : Type) (LEN : Usize) (WithConstTyHLENInst : WithConstTy H LEN) : @@ -292,7 +291,7 @@ def use_with_const_ty1 let i := WithConstTyHLENInst.LEN1 Result.ret i -/- [traits::use_with_const_ty2]: forward function +/- [traits::use_with_const_ty2]: Source: 'src/traits.rs', lines 187:0-187:73 -/ def use_with_const_ty2 (H : Type) (LEN : Usize) (WithConstTyHLENInst : WithConstTy H LEN) @@ -301,7 +300,7 @@ def use_with_const_ty2 := Result.ret () -/- [traits::use_with_const_ty3]: forward function +/- [traits::use_with_const_ty3]: Source: 'src/traits.rs', lines 189:0-189:80 -/ def use_with_const_ty3 (H : Type) (LEN : Usize) (WithConstTyHLENInst : WithConstTy H LEN) @@ -310,12 +309,12 @@ def use_with_const_ty3 := WithConstTyHLENInst.W_clause_0.to_u64 x -/- [traits::test_where1]: forward function +/- [traits::test_where1]: Source: 'src/traits.rs', lines 193:0-193:40 -/ def test_where1 (T : Type) (_x : T) : Result Unit := Result.ret () -/- [traits::test_where2]: forward function +/- [traits::test_where2]: Source: 'src/traits.rs', lines 194:0-194:57 -/ def test_where2 (T : Type) (WithConstTyT32Inst : WithConstTy T 32#usize) (_x : U32) : @@ -340,22 +339,30 @@ structure ChildTrait (Self : Type) where ParentTrait0SelfInst : ParentTrait0 Self ParentTrait1SelfInst : ParentTrait1 Self -/- [traits::test_child_trait1]: forward function - Source: 'src/traits.rs', lines 209:0-209:56 -/ +/- [traits::test_parent_trait0]: + Source: 'src/traits.rs', lines 208:0-208:57 -/ +def test_parent_trait0 + (T : Type) (ParentTrait0TInst : ParentTrait0 T) (x : T) : + Result ParentTrait0TInst.W + := + ParentTrait0TInst.get_w x + +/- [traits::test_child_trait1]: + Source: 'src/traits.rs', lines 213:0-213:56 -/ def test_child_trait1 (T : Type) (ChildTraitTInst : ChildTrait T) (x : T) : Result String := ChildTraitTInst.ParentTrait0SelfInst.get_name x -/- [traits::test_child_trait2]: forward function - Source: 'src/traits.rs', lines 213:0-213:54 -/ +/- [traits::test_child_trait2]: + Source: 'src/traits.rs', lines 217:0-217:54 -/ def test_child_trait2 (T : Type) (ChildTraitTInst : ChildTrait T) (x : T) : Result ChildTraitTInst.ParentTrait0SelfInst.W := ChildTraitTInst.ParentTrait0SelfInst.get_w x -/- [traits::order1]: forward function - Source: 'src/traits.rs', lines 219:0-219:59 -/ +/- [traits::order1]: + Source: 'src/traits.rs', lines 223:0-223:59 -/ def order1 (T U : Type) (ParentTrait0TInst : ParentTrait0 T) (ParentTrait0UInst : ParentTrait0 U) : @@ -364,28 +371,28 @@ def order1 Result.ret () /- Trait declaration: [traits::ChildTrait1] - Source: 'src/traits.rs', lines 222:0-222:35 -/ + Source: 'src/traits.rs', lines 226:0-226:35 -/ structure ChildTrait1 (Self : Type) where ParentTrait1SelfInst : ParentTrait1 Self /- Trait implementation: [traits::{usize#9}] - Source: 'src/traits.rs', lines 224:0-224:27 -/ + Source: 'src/traits.rs', lines 228:0-228:27 -/ def traits.ParentTrait1UsizeInst : ParentTrait1 Usize := { } /- Trait implementation: [traits::{usize#10}] - Source: 'src/traits.rs', lines 225:0-225:26 -/ + Source: 'src/traits.rs', lines 229:0-229:26 -/ def traits.ChildTrait1UsizeInst : ChildTrait1 Usize := { ParentTrait1SelfInst := traits.ParentTrait1UsizeInst } /- Trait declaration: [traits::Iterator] - Source: 'src/traits.rs', lines 229:0-229:18 -/ + Source: 'src/traits.rs', lines 233:0-233:18 -/ structure Iterator (Self : Type) where Item : Type /- Trait declaration: [traits::IntoIterator] - Source: 'src/traits.rs', lines 233:0-233:22 -/ + Source: 'src/traits.rs', lines 237:0-237:22 -/ structure IntoIterator (Self : Type) where Item : Type IntoIter : Type @@ -393,76 +400,86 @@ structure IntoIterator (Self : Type) where into_iter : Self → Result IntoIter /- Trait declaration: [traits::FromResidual] - Source: 'src/traits.rs', lines 250:0-250:21 -/ + Source: 'src/traits.rs', lines 254:0-254:21 -/ structure FromResidual (Self T : Type) where /- Trait declaration: [traits::Try] - Source: 'src/traits.rs', lines 246:0-246:48 -/ + Source: 'src/traits.rs', lines 250:0-250:48 -/ structure Try (Self : Type) where Residual : Type FromResidualSelftraitsTrySelfResidualInst : FromResidual Self Residual /- Trait declaration: [traits::WithTarget] - Source: 'src/traits.rs', lines 252:0-252:20 -/ + Source: 'src/traits.rs', lines 256:0-256:20 -/ structure WithTarget (Self : Type) where Target : Type /- Trait declaration: [traits::ParentTrait2] - Source: 'src/traits.rs', lines 256:0-256:22 -/ + Source: 'src/traits.rs', lines 260:0-260:22 -/ structure ParentTrait2 (Self : Type) where U : Type U_clause_0 : WithTarget U /- Trait declaration: [traits::ChildTrait2] - Source: 'src/traits.rs', lines 260:0-260:35 -/ + Source: 'src/traits.rs', lines 264:0-264:35 -/ structure ChildTrait2 (Self : Type) where ParentTrait2SelfInst : ParentTrait2 Self convert : ParentTrait2SelfInst.U → Result ParentTrait2SelfInst.U_clause_0.Target /- Trait implementation: [traits::{u32#11}] - Source: 'src/traits.rs', lines 264:0-264:23 -/ + Source: 'src/traits.rs', lines 268:0-268:23 -/ def traits.WithTargetU32Inst : WithTarget U32 := { Target := U32 } /- Trait implementation: [traits::{u32#12}] - Source: 'src/traits.rs', lines 268:0-268:25 -/ + Source: 'src/traits.rs', lines 272:0-272:25 -/ def traits.ParentTrait2U32Inst : ParentTrait2 U32 := { U := U32 U_clause_0 := traits.WithTargetU32Inst } -/- [traits::{u32#13}::convert]: forward function - Source: 'src/traits.rs', lines 273:4-273:29 -/ +/- [traits::{u32#13}::convert]: + Source: 'src/traits.rs', lines 277:4-277:29 -/ def U32.convert (x : U32) : Result U32 := Result.ret x /- Trait implementation: [traits::{u32#13}] - Source: 'src/traits.rs', lines 272:0-272:24 -/ + Source: 'src/traits.rs', lines 276:0-276:24 -/ def traits.ChildTrait2U32Inst : ChildTrait2 U32 := { ParentTrait2SelfInst := traits.ParentTrait2U32Inst convert := U32.convert } /- Trait declaration: [traits::CFnOnce] - Source: 'src/traits.rs', lines 286:0-286:23 -/ + Source: 'src/traits.rs', lines 290:0-290:23 -/ structure CFnOnce (Self Args : Type) where Output : Type call_once : Self → Args → Result Output /- Trait declaration: [traits::CFnMut] - Source: 'src/traits.rs', lines 292:0-292:37 -/ + Source: 'src/traits.rs', lines 296:0-296:37 -/ structure CFnMut (Self Args : Type) where CFnOnceSelfArgsInst : CFnOnce Self Args - call_mut : Self → Args → Result CFnOnceSelfArgsInst.Output - call_mut_back : Self → Args → CFnOnceSelfArgsInst.Output → Result Self + call_mut : Self → Args → Result (CFnOnceSelfArgsInst.Output × Self) /- Trait declaration: [traits::CFn] - Source: 'src/traits.rs', lines 296:0-296:33 -/ + Source: 'src/traits.rs', lines 300:0-300:33 -/ structure CFn (Self Args : Type) where CFnMutSelfArgsInst : CFnMut Self Args - call_mut : Self → Args → Result - CFnMutSelfArgsInst.CFnOnceSelfArgsInst.Output + call : Self → Args → Result CFnMutSelfArgsInst.CFnOnceSelfArgsInst.Output + +/- Trait declaration: [traits::GetTrait] + Source: 'src/traits.rs', lines 304:0-304:18 -/ +structure GetTrait (Self : Type) where + W : Type + get_w : Self → Result W + +/- [traits::test_get_trait]: + Source: 'src/traits.rs', lines 309:0-309:49 -/ +def test_get_trait + (T : Type) (GetTraitTInst : GetTrait T) (x : T) : Result GetTraitTInst.W := + GetTraitTInst.get_w x end traits -- cgit v1.2.3 From 091f9f0f49db3c581a33d29470323ab417744845 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 00:16:53 +0100 Subject: Update the proof of the hashmap in Lean --- tests/lean/Hashmap/Properties.lean | 144 ++++++++++++------------------------- 1 file changed, 44 insertions(+), 100 deletions(-) diff --git a/tests/lean/Hashmap/Properties.lean b/tests/lean/Hashmap/Properties.lean index e79c422d..7215e286 100644 --- a/tests/lean/Hashmap/Properties.lean +++ b/tests/lean/Hashmap/Properties.lean @@ -55,71 +55,6 @@ theorem match_lawful_beq [BEq α] [LawfulBEq α] [DecidableEq α] (x y : α) : (x == y) = (if x = y then true else false) := by split <;> simp_all -@[pspec] -theorem insert_in_list_spec0 {α : Type} (key: Usize) (value: α) (ls: List α) : - ∃ b, - insert_in_list α key value ls = ret b ∧ - (b ↔ ls.lookup key = none) - := match ls with - | .Nil => by simp [insert_in_list, insert_in_list_loop] - | .Cons k v tl => - if h: k = key then -- TODO: The order of k/key matters - by - simp [insert_in_list] - rw [insert_in_list_loop] - simp [h] - else - have ⟨ b, hi ⟩ := insert_in_list_spec0 key value tl - by - exists b - simp [insert_in_list] - rw [insert_in_list_loop] -- TODO: Using simp leads to infinite recursion - simp only [insert_in_list] at hi - simp [*] - --- Variation: use progress -theorem insert_in_list_spec1 {α : Type} (key: Usize) (value: α) (ls: List α) : - ∃ b, - insert_in_list α key value ls = ret b ∧ - (b ↔ ls.lookup key = none) - := match ls with - | .Nil => by simp [insert_in_list, insert_in_list_loop] - | .Cons k v tl => - if h: k = key then -- TODO: The order of k/key matters - by - simp [insert_in_list] - rw [insert_in_list_loop] - simp [h] - else - by - simp only [insert_in_list] - rw [insert_in_list_loop] - conv => rhs; ext; simp [*] - progress keep heq as ⟨ b, hi ⟩ - simp only [insert_in_list] at heq - exists b - --- Variation: use tactics from the beginning -theorem insert_in_list_spec2 {α : Type} (key: Usize) (value: α) (ls: List α) : - ∃ b, - insert_in_list α key value ls = ret b ∧ - (b ↔ (ls.lookup key = none)) - := by - induction ls - case Nil => simp [insert_in_list, insert_in_list_loop] - case Cons k v tl ih => - simp only [insert_in_list] - rw [insert_in_list_loop] - simp only - if h: k = key then - simp [h] - else - conv => rhs; ext; left; simp [h] -- TODO: Simplify - simp only [insert_in_list] at ih; - -- TODO: give the possibility of using underscores - progress as ⟨ b, h ⟩ - simp [*] - def distinct_keys (ls : Core.List (Usize × α)) := ls.pairwise_rel (λ x y => x.fst ≠ y.fst) def hash_mod_key (k : Usize) (l : Int) : Int := @@ -175,11 +110,16 @@ def inv (hm : HashMap α) : Prop := base_inv hm -- TODO: either the hashmap is not overloaded, or we can't resize it -theorem insert_in_list_back_spec_aux {α : Type} (l : Int) (key: Usize) (value: α) (l0: List α) +-- This rewriting lemma is problematic below +attribute [-simp] Bool.exists_bool + +theorem insert_in_list_spec_aux {α : Type} (l : Int) (key: Usize) (value: α) (l0: List α) (hinv : slot_s_inv_hash l (hash_mod_key key l) l0.v) (hdk : distinct_keys l0.v) : - ∃ l1, - insert_in_list_back α key value l0 = ret l1 ∧ + ∃ b l1, + insert_in_list α key value l0 = ret (b, l1) ∧ + -- The boolean is true ↔ we inserted a new binding + (b ↔ (l0.lookup key = none)) ∧ -- We update the binding l1.lookup key = value ∧ (∀ k, k ≠ key → l1.lookup k = l0.lookup k) ∧ @@ -193,16 +133,19 @@ theorem insert_in_list_back_spec_aux {α : Type} (l : Int) (key: Usize) (value: distinct_keys l1.v ∧ -- We need this auxiliary property to prove that the keys distinct properties is preserved (∀ k, k ≠ key → l0.v.allP (λ (k1, _) => k ≠ k1) → l1.v.allP (λ (k1, _) => k ≠ k1)) - := match l0 with - | .Nil => by checkpoint + := + match l0 with + | .Nil => by + exists true -- TODO: why do we need to do this? simp (config := {contextual := true}) - [insert_in_list_back, insert_in_list_loop_back, + [insert_in_list, insert_in_list_loop, List.v, slot_s_inv_hash, distinct_keys, List.pairwise_rel] | .Cons k v tl0 => - if h: k = key then by checkpoint - simp [insert_in_list_back] - rw [insert_in_list_loop_back] + if h: k = key then by + rw [insert_in_list] + rw [insert_in_list_loop] simp [h] + exists false; simp -- TODO: why do we need to do this? split_conjs . intros; simp [*] . simp [List.v, slot_s_inv_hash] at * @@ -210,17 +153,17 @@ theorem insert_in_list_back_spec_aux {α : Type} (l : Int) (key: Usize) (value: . simp [*, distinct_keys] at * apply hdk . tauto - else by checkpoint - simp [insert_in_list_back] - rw [insert_in_list_loop_back] + else by + rw [insert_in_list] + rw [insert_in_list_loop] simp [h] have : slot_s_inv_hash l (hash_mod_key key l) (List.v tl0) := by checkpoint simp_all [List.v, slot_s_inv_hash] have : distinct_keys (List.v tl0) := by checkpoint simp [distinct_keys] at hdk simp [hdk, distinct_keys] - progress keep heq as ⟨ tl1 .. ⟩ - simp only [insert_in_list_back] at heq + progress keep heq as ⟨ b, tl1 .. ⟩ + simp only [insert_in_list] at heq have : slot_s_inv_hash l (hash_mod_key key l) (List.v (List.Cons k v tl1)) := by checkpoint simp [List.v, slot_s_inv_hash] at * simp [*] @@ -228,14 +171,16 @@ theorem insert_in_list_back_spec_aux {α : Type} (l : Int) (key: Usize) (value: simp [distinct_keys] at * simp [*] -- TODO: canonize addition by default? + exists b simp_all [Int.add_assoc, Int.add_comm, Int.add_left_comm] @[pspec] -theorem insert_in_list_back_spec {α : Type} (l : Int) (key: Usize) (value: α) (l0: List α) +theorem insert_in_list_spec {α : Type} (l : Int) (key: Usize) (value: α) (l0: List α) (hinv : slot_s_inv_hash l (hash_mod_key key l) l0.v) (hdk : distinct_keys l0.v) : - ∃ l1, - insert_in_list_back α key value l0 = ret l1 ∧ + ∃ b l1, + insert_in_list α key value l0 = ret (b, l1) ∧ + (b ↔ (l0.lookup key = none)) ∧ -- We update the binding l1.lookup key = value ∧ (∀ k, k ≠ key → l1.lookup k = l0.lookup k) ∧ @@ -248,7 +193,8 @@ theorem insert_in_list_back_spec {α : Type} (l : Int) (key: Usize) (value: α) -- The keys are distinct distinct_keys l1.v := by - progress with insert_in_list_back_spec_aux as ⟨ l1 .. ⟩ + progress with insert_in_list_spec_aux as ⟨ b, l1 .. ⟩ + exists b exists l1 @[simp] @@ -286,7 +232,7 @@ set_option pp.coercions false -- do not print coercions with ↑ (this doesn't p -- The proof below is a bit expensive, so we need to increase the maximum number -- of heart beats -set_option maxHeartbeats 400000 +set_option maxHeartbeats 1000000 theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value : α) (hinv : hm.inv) (hnsat : hm.lookup key = none → hm.len_s < Usize.max) : @@ -315,9 +261,19 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value simp [hinv] -- TODO: we want to automate that simp [*, Int.emod_lt_of_pos] - progress as ⟨ l, h_leq ⟩ - -- TODO: make progress use the names written in the goal - progress as ⟨ inserted ⟩ + progress as ⟨ l, index_mut_back, h_leq, h_index_mut_back ⟩ + simp [h_index_mut_back] at *; clear h_index_mut_back index_mut_back + have h_slot : + slot_s_inv_hash hm.slots.length (hash_mod_key key hm.slots.length) l.v := by + simp [inv] at hinv + have h := (hinv.right.left hash_mod.val (by assumption) (by assumption)).right + simp [slot_t_inv, hhm] at h + simp [h, hhm, h_leq] + have hd : distinct_keys l.v := by + simp [inv, slots_t_inv, slot_t_inv] at hinv + have h := hinv.right.left hash_mod.val (by assumption) (by assumption) + simp [h, h_leq] + progress as ⟨ inserted, l0, _, _, _, _, hlen .. ⟩ rw [if_update_eq] -- TODO: necessary because we don't have a join -- TODO: progress to ... have hipost : @@ -336,20 +292,9 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value else simp [*, Pure.pure] progress as ⟨ i0 ⟩ - have h_slot : slot_s_inv_hash hm.slots.length (hash_mod_key key hm.slots.length) l.v - := by - simp [inv] at hinv - have h := (hinv.right.left hash_mod.val (by assumption) (by assumption)).right - simp [slot_t_inv, hhm] at h - simp [h, hhm, h_leq] - have hd : distinct_keys l.v := by checkpoint - simp [inv, slots_t_inv, slot_t_inv] at hinv - have h := hinv.right.left hash_mod.val (by assumption) (by assumption) - simp [h, h_leq] -- TODO: hide the variables and only keep the props -- TODO: allow providing terms to progress to instantiate the meta variables -- which are not propositions - progress as ⟨ l0, _, _, _, hlen .. ⟩ progress keep hv as ⟨ v, h_veq ⟩ -- TODO: update progress to automate that -- TODO: later I don't want to inline nhm - we need to control simp: deactivate @@ -428,8 +373,7 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value simp [*] else simp [*] - . -- TODO: simp[*] fails: "(deterministic) timeout at 'whnf'" - simp [hinv, h_veq, nhm_eq] + . simp [hinv, h_veq, nhm_eq] simp_all end HashMap -- cgit v1.2.3 From 6fd112a30d12cda6390ea3b856a81096d6bcedfe Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 00:17:07 +0100 Subject: Fix a minor issue in the Lean tests --- tests/lean/External/FunsExternal.lean | 17 +++-------------- 1 file changed, 3 insertions(+), 14 deletions(-) diff --git a/tests/lean/External/FunsExternal.lean b/tests/lean/External/FunsExternal.lean index aae11ba1..63830abc 100644 --- a/tests/lean/External/FunsExternal.lean +++ b/tests/lean/External/FunsExternal.lean @@ -8,22 +8,11 @@ open external /- [core::mem::swap] -/ def core.mem.swap - (T : Type) : T → T → State → Result (State × Unit) := - fun _x _y s => .ret (s, ()) - -/- [core::mem::swap] -/ -def core.mem.swap_back0 - (T : Type) : T → T → State → State → Result (State × T) := - fun _x y _s0 s1 => .ret (s1, y) - -/- [core::mem::swap] -/ -def core.mem.swap_back1 - (T : Type) : T → T → State → State → Result (State × T) := - fun x _y _s0 s1 => .ret (s1, x) + (T : Type) : T → T → State → Result (State × (T × T)) := + fun x y s => .ret (s, (y, x)) /- [core::num::nonzero::NonZeroU32::{14}::new] -/ -def core.num.nonzero.NonZeroU32.new - : +def core.num.nonzero.NonZeroU32.new : U32 → State → Result (State × (Option core_num_nonzero_non_zero_u32_t)) := fun _ _ => .fail .panic -- cgit v1.2.3 From aa5e25785738a779ca5fd89191c85d6ab828c142 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 00:19:08 +0100 Subject: Update the flake.nix and the ci.yml --- .github/workflows/ci.yml | 1 + flake.nix | 16 +++++++++++++++- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 6b5aacf0..2039e65d 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -14,6 +14,7 @@ jobs: - run: nix build -L .#aeneas - run: nix build -L .#checks.x86_64-linux.aeneas-tests - run: nix build -L .#checks.x86_64-linux.aeneas-verify-fstar + - run: nix build -L .#checks.x86_64-linux.aeneas-verify-fstar-split - run: nix build -L .#checks.x86_64-linux.aeneas-verify-coq - run: nix build -L .#checks.x86_64-linux.aeneas-verify-hol4 # Lean doesn't work with Nix diff --git a/flake.nix b/flake.nix index 8263174d..82179fcb 100644 --- a/flake.nix +++ b/flake.nix @@ -114,6 +114,18 @@ # The tests don't generate anything - TODO: actually they do installPhase = "touch $out"; }; + # Replay the F* proofs for the cases where we split the fwd/back functions. + aeneas-verify-fstar-split = pkgs.stdenv.mkDerivation { + name = "aeneas_verify_fstar_split"; + src = ./tests/fstar-split; + FSTAR_EXE = "${hacl-nix.packages.${system}.fstar}/bin/fstar.exe"; + buildPhase= '' + make prepare-projects + make verify -j $NIX_BUILD_CORES + ''; + # The tests don't generate anything - TODO: actually they do + installPhase = "touch $out"; + }; # Replay the Coq proofs. aeneas-verify-coq = pkgs.stdenv.mkDerivation { name = "aeneas_verify_coq"; @@ -170,6 +182,8 @@ inherit aeneas; default = aeneas; }; - checks = { inherit aeneas aeneas-tests aeneas-verify-fstar aeneas-verify-coq aeneas-verify-lean aeneas-verify-hol4; }; + checks = { + inherit aeneas aeneas-tests aeneas-verify-fstar aeneas-verify-fstar-split + aeneas-verify-coq aeneas-verify-lean aeneas-verify-hol4; }; }); } -- cgit v1.2.3 From b6ef8ee33802e75409c3bd2b82e7b5ad22f1d053 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 00:41:25 +0100 Subject: Improve the micro passes to eliminate pattern `let f := fun x => g x` --- compiler/PureMicroPasses.ml | 45 +++++++++++++++++++++++++++++++++++++++-- tests/coq/misc/Loops.v | 26 ++++++++---------------- tests/fstar/misc/Loops.Funs.fst | 25 ++++++++--------------- tests/lean/Loops.lean | 25 ++++++++--------------- 4 files changed, 67 insertions(+), 54 deletions(-) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index e7e9d5e1..fa025d93 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -684,6 +684,15 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl = let y1 = x1 in ... ]} + + Simplify arrows: + {[ + let f := fun x => g x in + ... + ~~> + let f := g in + ... + ]} *) let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = let obj = @@ -739,6 +748,23 @@ let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = super#visit_expression env e.e | _ -> super#visit_Let env monadic lv rv next else super#visit_Let env monadic lv rv next + | Lambda _ -> + if not monadic then + (* Arrow case *) + let pats, e = destruct_lambdas rv in + let g, args = destruct_apps e in + if List.length pats = List.length args then + (* Check if the arguments are exactly the lambdas *) + let check_pat_arg ((pat, arg) : typed_pattern * texpression) = + match (pat.value, arg.e) with + | PatVar (v, _), Var vid -> v.id = vid + | _ -> false + in + if List.for_all check_pat_arg (List.combine pats args) then + self#visit_Let env monadic lv g next + else super#visit_Let env monadic lv rv next + else super#visit_Let env monadic lv rv next + else super#visit_Let env monadic lv rv next | _ -> super#visit_Let env monadic lv rv next end in @@ -1934,9 +1960,10 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = (* Inline the useless variable reassignments *) let inline_named_vars = true in let inline_pure = true in - let def = - inline_useless_var_reassignments ctx inline_named_vars inline_pure def + let inline_useless_var_reassignments ctx = + inline_useless_var_reassignments ctx inline_named_vars inline_pure in + let def = inline_useless_var_reassignments ctx def in log#ldebug (lazy ("inline_useless_var_assignments:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); @@ -1982,6 +2009,20 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = log#ldebug (lazy ("simplify_aggregates:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + (* Simplify the let-bindings - some simplifications may have been unlocked by + the pass above (for instance, the lambda simplification) *) + let def = simplify_let_bindings ctx def in + log#ldebug + (lazy + ("simplify_let_bindings (pass 2):\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + + (* Inline the useless vars again *) + let def = inline_useless_var_reassignments ctx def in + log#ldebug + (lazy + ("inline_useless_var_assignments (pass 2):\n\n" + ^ fun_decl_to_string ctx def ^ "\n")); + (* Decompose the monadic let-bindings - used by Coq *) let def = if !Config.decompose_monadic_let_bindings then ( diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v index 313c2cfd..cc76f359 100644 --- a/tests/coq/misc/Loops.v +++ b/tests/coq/misc/Loops.v @@ -160,10 +160,7 @@ Definition list_nth_mut_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result (T * (T -> result (List_t T))) := - p <- list_nth_mut_loop_loop T n ls i; - let (t, back) := p in - let back1 := fun (ret : T) => back ret in - Return (t, back1) + p <- list_nth_mut_loop_loop T n ls i; let (t, back) := p in Return (t, back) . (** [loops::list_nth_shared_loop]: loop 0: @@ -265,7 +262,7 @@ Definition id_mut (T : Type) (ls : List_t T) : result ((List_t T) * (List_t T -> result (List_t T))) := - let back := fun (ret : List_t T) => Return ret in Return (ls, back) + Return (ls, Return) . (** [loops::id_shared]: @@ -382,9 +379,7 @@ Definition list_nth_mut_loop_pair := t <- list_nth_mut_loop_pair_loop T n ls0 ls1 i; let (p, back_'a, back_'b) := t in - let back_'a1 := fun (ret : T) => back_'a ret in - let back_'b1 := fun (ret : T) => back_'b ret in - Return (p, back_'a1, back_'b1) + Return (p, back_'a, back_'b) . (** [loops::list_nth_shared_loop_pair]: loop 0: @@ -465,8 +460,7 @@ Definition list_nth_mut_loop_pair_merge := p <- list_nth_mut_loop_pair_merge_loop T n ls0 ls1 i; let (p1, back_'a) := p in - let back_'a1 := fun (ret : (T * T)) => back_'a ret in - Return (p1, back_'a1) + Return (p1, back_'a) . (** [loops::list_nth_shared_loop_pair_merge]: loop 0: @@ -542,8 +536,7 @@ Definition list_nth_mut_shared_loop_pair := p <- list_nth_mut_shared_loop_pair_loop T n ls0 ls1 i; let (p1, back_'a) := p in - let back_'a1 := fun (ret : T) => back_'a ret in - Return (p1, back_'a1) + Return (p1, back_'a) . (** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: @@ -585,8 +578,7 @@ Definition list_nth_mut_shared_loop_pair_merge := p <- list_nth_mut_shared_loop_pair_merge_loop T n ls0 ls1 i; let (p1, back_'a) := p in - let back_'a1 := fun (ret : T) => back_'a ret in - Return (p1, back_'a1) + Return (p1, back_'a) . (** [loops::list_nth_shared_mut_loop_pair]: loop 0: @@ -628,8 +620,7 @@ Definition list_nth_shared_mut_loop_pair := p <- list_nth_shared_mut_loop_pair_loop T n ls0 ls1 i; let (p1, back_'b) := p in - let back_'b1 := fun (ret : T) => back_'b ret in - Return (p1, back_'b1) + Return (p1, back_'b) . (** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: @@ -671,8 +662,7 @@ Definition list_nth_shared_mut_loop_pair_merge := p <- list_nth_shared_mut_loop_pair_merge_loop T n ls0 ls1 i; let (p1, back_'a) := p in - let back_'a1 := fun (ret : T) => back_'a ret in - Return (p1, back_'a1) + Return (p1, back_'a) . End Loops. diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst index a047c170..88389300 100644 --- a/tests/fstar/misc/Loops.Funs.fst +++ b/tests/fstar/misc/Loops.Funs.fst @@ -121,9 +121,7 @@ let list_nth_mut_loop (t : Type0) (ls : list_t t) (i : u32) : result (t & (t -> result (list_t t))) = - let* (x, back) = list_nth_mut_loop_loop t ls i in - let back1 = fun ret -> back ret in - Return (x, back1) + let* (x, back) = list_nth_mut_loop_loop t ls i in Return (x, back) (** [loops::list_nth_shared_loop]: loop 0: Source: 'src/loops.rs', lines 91:0-101:1 *) @@ -201,7 +199,7 @@ let id_mut (t : Type0) (ls : list_t t) : result ((list_t t) & (list_t t -> result (list_t t))) = - let back = fun ret -> Return ret in Return (ls, back) + Return (ls, Return) (** [loops::id_shared]: Source: 'src/loops.rs', lines 139:0-139:45 *) @@ -296,9 +294,7 @@ let list_nth_mut_loop_pair result ((t & t) & (t -> result (list_t t)) & (t -> result (list_t t))) = let* (p, back_'a, back_'b) = list_nth_mut_loop_pair_loop t ls0 ls1 i in - let back_'a1 = fun ret -> back_'a ret in - let back_'b1 = fun ret -> back_'b ret in - Return (p, back_'a1, back_'b1) + Return (p, back_'a, back_'b) (** [loops::list_nth_shared_loop_pair]: loop 0: Source: 'src/loops.rs', lines 198:0-219:1 *) @@ -362,8 +358,7 @@ let list_nth_mut_loop_pair_merge result ((t & t) & ((t & t) -> result ((list_t t) & (list_t t)))) = let* (p, back_'a) = list_nth_mut_loop_pair_merge_loop t ls0 ls1 i in - let back_'a1 = fun ret -> back_'a ret in - Return (p, back_'a1) + Return (p, back_'a) (** [loops::list_nth_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 241:0-256:1 *) @@ -425,8 +420,7 @@ let list_nth_mut_shared_loop_pair result ((t & t) & (t -> result (list_t t))) = let* (p, back_'a) = list_nth_mut_shared_loop_pair_loop t ls0 ls1 i in - let back_'a1 = fun ret -> back_'a ret in - Return (p, back_'a1) + Return (p, back_'a) (** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 278:0-293:1 *) @@ -462,8 +456,7 @@ let list_nth_mut_shared_loop_pair_merge result ((t & t) & (t -> result (list_t t))) = let* (p, back_'a) = list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i in - let back_'a1 = fun ret -> back_'a ret in - Return (p, back_'a1) + Return (p, back_'a) (** [loops::list_nth_shared_mut_loop_pair]: loop 0: Source: 'src/loops.rs', lines 297:0-312:1 *) @@ -498,8 +491,7 @@ let list_nth_shared_mut_loop_pair result ((t & t) & (t -> result (list_t t))) = let* (p, back_'b) = list_nth_shared_mut_loop_pair_loop t ls0 ls1 i in - let back_'b1 = fun ret -> back_'b ret in - Return (p, back_'b1) + Return (p, back_'b) (** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 316:0-331:1 *) @@ -535,6 +527,5 @@ let list_nth_shared_mut_loop_pair_merge result ((t & t) & (t -> result (list_t t))) = let* (p, back_'a) = list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i in - let back_'a1 = fun ret -> back_'a ret in - Return (p, back_'a1) + Return (p, back_'a) diff --git a/tests/lean/Loops.lean b/tests/lean/Loops.lean index 805ecabc..fbb4616f 100644 --- a/tests/lean/Loops.lean +++ b/tests/lean/Loops.lean @@ -122,8 +122,7 @@ def list_nth_mut_loop (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) := do let (t, back) ← list_nth_mut_loop_loop T ls i - let back1 := fun ret => back ret - Result.ret (t, back1) + Result.ret (t, back) /- [loops::list_nth_shared_loop]: loop 0: Source: 'src/loops.rs', lines 91:0-101:1 -/ @@ -207,8 +206,7 @@ def id_mut (T : Type) (ls : List T) : Result ((List T) × (List T → Result (List T))) := - let back := fun ret => Result.ret ret - Result.ret (ls, back) + Result.ret (ls, Result.ret) /- [loops::id_shared]: Source: 'src/loops.rs', lines 139:0-139:45 -/ @@ -308,9 +306,7 @@ def list_nth_mut_loop_pair := do let (p, back_'a, back_'b) ← list_nth_mut_loop_pair_loop T ls0 ls1 i - let back_'a1 := fun ret => back_'a ret - let back_'b1 := fun ret => back_'b ret - Result.ret (p, back_'a1, back_'b1) + Result.ret (p, back_'a, back_'b) /- [loops::list_nth_shared_loop_pair]: loop 0: Source: 'src/loops.rs', lines 198:0-219:1 -/ @@ -372,8 +368,7 @@ def list_nth_mut_loop_pair_merge := do let (p, back_'a) ← list_nth_mut_loop_pair_merge_loop T ls0 ls1 i - let back_'a1 := fun ret => back_'a ret - Result.ret (p, back_'a1) + Result.ret (p, back_'a) /- [loops::list_nth_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 241:0-256:1 -/ @@ -432,8 +427,7 @@ def list_nth_mut_shared_loop_pair := do let (p, back_'a) ← list_nth_mut_shared_loop_pair_loop T ls0 ls1 i - let back_'a1 := fun ret => back_'a ret - Result.ret (p, back_'a1) + Result.ret (p, back_'a) /- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 278:0-293:1 -/ @@ -470,8 +464,7 @@ def list_nth_mut_shared_loop_pair_merge := do let (p, back_'a) ← list_nth_mut_shared_loop_pair_merge_loop T ls0 ls1 i - let back_'a1 := fun ret => back_'a ret - Result.ret (p, back_'a1) + Result.ret (p, back_'a) /- [loops::list_nth_shared_mut_loop_pair]: loop 0: Source: 'src/loops.rs', lines 297:0-312:1 -/ @@ -507,8 +500,7 @@ def list_nth_shared_mut_loop_pair := do let (p, back_'b) ← list_nth_shared_mut_loop_pair_loop T ls0 ls1 i - let back_'b1 := fun ret => back_'b ret - Result.ret (p, back_'b1) + Result.ret (p, back_'b) /- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: Source: 'src/loops.rs', lines 316:0-331:1 -/ @@ -545,7 +537,6 @@ def list_nth_shared_mut_loop_pair_merge := do let (p, back_'a) ← list_nth_shared_mut_loop_pair_merge_loop T ls0 ls1 i - let back_'a1 := fun ret => back_'a ret - Result.ret (p, back_'a1) + Result.ret (p, back_'a) end loops -- cgit v1.2.3 From ff9fe8aa1e13a7297f7c4f2c2554235361db038f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 00:58:35 +0100 Subject: Update the micro-passes --- compiler/PureMicroPasses.ml | 171 ++++++++++++++++++++++++-------------------- 1 file changed, 94 insertions(+), 77 deletions(-) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index fa025d93..ec64df21 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -800,8 +800,8 @@ let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = leave the let-bindings where they are, and eliminated them in a subsequent pass (if they are useless). *) -let inline_useless_var_reassignments (ctx : trans_ctx) (inline_named : bool) - (inline_pure : bool) (def : fun_decl) : fun_decl = +let inline_useless_var_reassignments (ctx : trans_ctx) ~(inline_named : bool) + ~(inline_const : bool) ~(inline_pure : bool) (def : fun_decl) : fun_decl = let obj = object (self) inherit [_] map_expression as super @@ -826,15 +826,31 @@ let inline_useless_var_reassignments (ctx : trans_ctx) (inline_named : bool) | _ -> false in (* And either: - * 2.1 the right-expression is a variable, a global or a const generic var *) + 2.1 the right-expression is a variable, a global or a const generic var *) let var_or_global = is_var re || is_cvar re || is_global re in (* Or: - * 2.2 the right-expression is a constant value, an ADT value, - * a projection or a primitive function call *and* the flag - * [inline_pure] is set *) + 2.2 the right-expression is a constant-value and we inline constant values, + *or* it is a qualif with no arguments (we consider this as a const) *) + let const_re = + inline_const + && + let is_const_adt = + let app, args = destruct_apps re in + if args = [] then + match app.e with + | Qualif _ -> true + | StructUpdate upd -> upd.updates = [] + | _ -> false + else false + in + is_const re || is_const_adt + in + (* Or: + 2.3 the right-expression is an ADT value, a projection or a + primitive function call *and* the flag [inline_pure] is set *) let pure_re = - is_const re - || + inline_pure + && let app, _ = destruct_apps re in match app.e with | Qualif qualif -> ( @@ -849,7 +865,7 @@ let inline_useless_var_reassignments (ctx : trans_ctx) (inline_named : bool) | _ -> false in let filter = - filter_left && (var_or_global || (inline_pure && pure_re)) + filter_left && (var_or_global || const_re || pure_re) in (* Update the rhs (we may perform substitutions inside, and it is @@ -1958,12 +1974,10 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = (lazy ("simplify_let_bindings:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* Inline the useless variable reassignments *) - let inline_named_vars = true in - let inline_pure = true in - let inline_useless_var_reassignments ctx = - inline_useless_var_reassignments ctx inline_named_vars inline_pure + let def = + inline_useless_var_reassignments ctx ~inline_named:true ~inline_const:true + ~inline_pure:true def in - let def = inline_useless_var_reassignments ctx def in log#ldebug (lazy ("inline_useless_var_assignments:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); @@ -2017,7 +2031,10 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = ("simplify_let_bindings (pass 2):\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* Inline the useless vars again *) - let def = inline_useless_var_reassignments ctx def in + let def = + inline_useless_var_reassignments ctx ~inline_named:true ~inline_const:true + ~inline_pure:false def + in log#ldebug (lazy ("inline_useless_var_assignments (pass 2):\n\n" @@ -2073,68 +2090,6 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = (* We are done *) def -(** Apply all the micro-passes to a function. - - As loops are initially directly integrated into the function definition, - {!apply_passes_to_def} extracts those loops definitions from the body; - it thus returns the pair: (function def, loop defs). See {!decompose_loops} - for more information. - - Will return [None] if the function is a backward function with no outputs. - - [ctx]: used only for printing. - *) -let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) : - fun_and_loops option = - (* Debug *) - log#ldebug - (lazy - ("PureMicroPasses.apply_passes_to_def: " ^ def.name ^ " (" - ^ Print.option_to_string T.RegionGroupId.to_string def.back_id - ^ ")")); - - log#ldebug (lazy ("original decl:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); - - (* First, find names for the variables which are unnamed *) - let def = compute_pretty_names def in - log#ldebug - (lazy ("compute_pretty_name:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); - - (* TODO: we might want to leverage more the assignment meta-data, for - * aggregates for instance. *) - - (* TODO: reorder the branches of the matches/switches *) - - (* The meta-information is now useless: remove it. - * Rk.: some passes below use the fact that we removed the meta-data - * (otherwise we would have to "unmeta" expressions before matching) *) - let def = remove_meta def in - log#ldebug (lazy ("remove_meta:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); - - (* Remove the backward functions with no outputs. - - Note that the *calls* to those functions should already have been removed, - when translating from symbolic to pure. Here, we remove the definitions - altogether, because they are now useless *) - let name = def.name ^ PrintPure.fun_suffix def.loop_id def.back_id in - let opt_def = filter_if_backward_with_no_outputs def in - - match opt_def with - | None -> - log#ldebug (lazy ("filtered (backward with no outputs): " ^ name ^ "\n")); - None - | Some def -> - log#ldebug - (lazy ("not filtered (not backward with no outputs): " ^ name ^ "\n")); - - (* Extract the loop definitions by removing the {!Loop} node *) - let def, loops = decompose_loops ctx def in - - (* Apply the remaining passes *) - let f = apply_end_passes_to_def ctx def in - let loops = List.map (apply_end_passes_to_def ctx) loops in - Some { f; loops } - (** Small utility for {!filter_loop_inputs} *) let filter_prefix (keep : bool list) (ls : 'a list) : 'a list = let ls0, ls1 = Collections.List.split_at ls (List.length keep) in @@ -2458,6 +2413,68 @@ let filter_loop_inputs (transl : pure_fun_translation list) : (* Return *) transl +(** Apply all the micro-passes to a function. + + As loops are initially directly integrated into the function definition, + {!apply_passes_to_def} extracts those loops definitions from the body; + it thus returns the pair: (function def, loop defs). See {!decompose_loops} + for more information. + + Will return [None] if the function is a backward function with no outputs. + + [ctx]: used only for printing. + *) +let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) : + fun_and_loops option = + (* Debug *) + log#ldebug + (lazy + ("PureMicroPasses.apply_passes_to_def: " ^ def.name ^ " (" + ^ Print.option_to_string T.RegionGroupId.to_string def.back_id + ^ ")")); + + log#ldebug (lazy ("original decl:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + + (* First, find names for the variables which are unnamed *) + let def = compute_pretty_names def in + log#ldebug + (lazy ("compute_pretty_name:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + + (* TODO: we might want to leverage more the assignment meta-data, for + * aggregates for instance. *) + + (* TODO: reorder the branches of the matches/switches *) + + (* The meta-information is now useless: remove it. + * Rk.: some passes below use the fact that we removed the meta-data + * (otherwise we would have to "unmeta" expressions before matching) *) + let def = remove_meta def in + log#ldebug (lazy ("remove_meta:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + + (* Remove the backward functions with no outputs. + + Note that the *calls* to those functions should already have been removed, + when translating from symbolic to pure. Here, we remove the definitions + altogether, because they are now useless *) + let name = def.name ^ PrintPure.fun_suffix def.loop_id def.back_id in + let opt_def = filter_if_backward_with_no_outputs def in + + match opt_def with + | None -> + log#ldebug (lazy ("filtered (backward with no outputs): " ^ name ^ "\n")); + None + | Some def -> + log#ldebug + (lazy ("not filtered (not backward with no outputs): " ^ name ^ "\n")); + + (* Extract the loop definitions by removing the {!Loop} node *) + let def, loops = decompose_loops ctx def in + + (* Apply the remaining passes *) + let f = apply_end_passes_to_def ctx def in + let loops = List.map (apply_end_passes_to_def ctx) loops in + Some { f; loops } + (** Apply the micro-passes to a list of forward/backward translations. This function also extracts the loop definitions from the function body -- cgit v1.2.3 From a4decc7654bc6f3301c0174124d21fdbc2dbc708 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 00:59:55 +0100 Subject: Regenerate the files --- tests/coq/array/Array.v | 18 ++++------ tests/coq/betree/BetreeMain_Funs.v | 40 ++++++---------------- tests/coq/hashmap/Hashmap_Funs.v | 8 ++--- tests/coq/hashmap_on_disk/HashmapMain_Funs.v | 10 +++--- tests/coq/misc/External_Funs.v | 4 +-- tests/coq/misc/NoNestedBorrows.v | 37 ++++++++------------ tests/coq/misc/Paper.v | 11 +++--- tests/coq/misc/PoloniusList.v | 8 ++--- tests/coq/traits/Traits.v | 2 +- tests/fstar-split/betree/BetreeMain.Funs.fst | 17 ++++----- tests/fstar-split/hashmap/Hashmap.Funs.fst | 6 ++-- .../hashmap_on_disk/HashmapMain.Funs.fst | 8 ++--- tests/fstar-split/misc/External.Funs.fst | 4 +-- tests/fstar-split/misc/NoNestedBorrows.fst | 26 ++++++-------- tests/fstar-split/misc/Paper.fst | 11 +++--- tests/fstar-split/traits/Traits.fst | 2 +- tests/fstar/array/Array.Funs.fst | 18 ++++------ tests/fstar/betree/BetreeMain.Funs.fst | 33 ++++++------------ .../fstar/betree_back_stateful/BetreeMain.Funs.fst | 33 ++++++------------ tests/fstar/hashmap/Hashmap.Funs.fst | 9 +++-- tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst | 10 +++--- tests/fstar/misc/External.Funs.fst | 4 +-- tests/fstar/misc/NoNestedBorrows.fst | 37 ++++++++------------ tests/fstar/misc/Paper.fst | 11 +++--- tests/fstar/misc/PoloniusList.fst | 6 ++-- tests/fstar/traits/Traits.fst | 2 +- tests/lean/Array.lean | 18 ++++------ tests/lean/BetreeMain/Funs.lean | 36 ++++++------------- tests/lean/External/Funs.lean | 3 +- tests/lean/Hashmap/Funs.lean | 9 ++--- tests/lean/HashmapMain/Funs.lean | 11 +++--- tests/lean/NoNestedBorrows.lean | 36 ++++++++----------- tests/lean/Paper.lean | 11 +++--- tests/lean/PoloniusList.lean | 8 ++--- tests/lean/Traits.lean | 3 +- 35 files changed, 183 insertions(+), 327 deletions(-) diff --git a/tests/coq/array/Array.v b/tests/coq/array/Array.v index faa0e92c..3a30413a 100644 --- a/tests/coq/array/Array.v +++ b/tests/coq/array/Array.v @@ -32,8 +32,7 @@ Definition array_to_mut_slice_ := p <- array_to_slice_mut T 32%usize s; let (s1, to_slice_mut_back) := p in - let back := fun (ret : slice T) => to_slice_mut_back ret in - Return (s1, back) + Return (s1, to_slice_mut_back) . (** [array::array_len]: @@ -81,8 +80,7 @@ Definition index_mut_array := p <- array_index_mut_usize T 32%usize s i; let (t, index_mut_back) := p in - let back := fun (ret : T) => index_mut_back ret in - Return (t, back) + Return (t, index_mut_back) . (** [array::index_slice]: @@ -99,8 +97,7 @@ Definition index_mut_slice := p <- slice_index_mut_usize T s i; let (t, index_mut_back) := p in - let back := fun (ret : T) => index_mut_back ret in - Return (t, back) + Return (t, index_mut_back) . (** [array::slice_subslice_shared_]: @@ -123,8 +120,7 @@ Definition slice_subslice_mut_ (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |}; let (s, index_mut_back) := p in - let back := fun (ret : slice u32) => index_mut_back ret in - Return (s, back) + Return (s, index_mut_back) . (** [array::array_to_slice_shared_]: @@ -142,8 +138,7 @@ Definition array_to_slice_mut_ := p <- array_to_slice_mut u32 32%usize x; let (s, to_slice_mut_back) := p in - let back := fun (ret : slice u32) => to_slice_mut_back ret in - Return (s, back) + Return (s, to_slice_mut_back) . (** [array::array_subslice_shared_]: @@ -168,8 +163,7 @@ Definition array_subslice_mut_ (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |}; let (s, index_mut_back) := p in - let back := fun (ret : slice u32) => index_mut_back ret in - Return (s, back) + Return (s, index_mut_back) . (** [array::index_slice_0]: diff --git a/tests/coq/betree/BetreeMain_Funs.v b/tests/coq/betree/BetreeMain_Funs.v index 516bc7b7..cefab0f4 100644 --- a/tests/coq/betree/BetreeMain_Funs.v +++ b/tests/coq/betree/BetreeMain_Funs.v @@ -123,8 +123,7 @@ Fixpoint betree_List_split_at i <- u64_sub n1 1%u64; p <- betree_List_split_at T n2 tl i; let (ls0, ls1) := p in - let l := ls0 in - Return (Betree_List_Cons hd l, ls1) + Return (Betree_List_Cons hd ls0, ls1) | Betree_List_Nil => Fail_ Failure end end @@ -135,8 +134,7 @@ Fixpoint betree_List_split_at Definition betree_List_push_front (T : Type) (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 - let l := tl in - Return (Betree_List_Cons x l) + Return (Betree_List_Cons x tl) . (** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: @@ -186,8 +184,7 @@ Fixpoint betree_ListTupleU64T_partition_at_pivot else ( p <- betree_ListTupleU64T_partition_at_pivot T n1 tl pivot; let (ls0, ls1) := p in - let l := ls0 in - Return (Betree_List_Cons (i, t) l, ls1)) + Return (Betree_List_Cons (i, t) ls0, ls1)) | Betree_List_Nil => Return (Betree_List_Nil, Betree_List_Nil) end end @@ -242,10 +239,7 @@ Fixpoint betree_Node_lookup_first_message_for_key | Betree_List_Cons x next_msgs => let (i, m) := x in if i s>= key - then - let back_'a := - fun (ret : betree_List_t (u64 * betree_Message_t)) => Return ret in - Return (Betree_List_Cons (i, m) next_msgs, back_'a) + then Return (Betree_List_Cons (i, m) next_msgs, Return) else ( p <- betree_Node_lookup_first_message_for_key n1 key next_msgs; let (l, lookup_first_message_for_key_back) := p in @@ -254,10 +248,7 @@ Fixpoint betree_Node_lookup_first_message_for_key next_msgs1 <- lookup_first_message_for_key_back ret; Return (Betree_List_Cons (i, m) next_msgs1) in Return (l, back_'a)) - | Betree_List_Nil => - let back_'a := - fun (ret : betree_List_t (u64 * betree_Message_t)) => Return ret in - Return (Betree_List_Nil, back_'a) + | Betree_List_Nil => Return (Betree_List_Nil, Return) end end . @@ -456,14 +447,8 @@ Fixpoint betree_Node_lookup_first_message_after_key next_msgs1 <- lookup_first_message_after_key_back ret; Return (Betree_List_Cons (k, m) next_msgs1) in Return (l, back_'a)) - else - let back_'a := - fun (ret : betree_List_t (u64 * betree_Message_t)) => Return ret in - Return (Betree_List_Cons (k, m) next_msgs, back_'a) - | Betree_List_Nil => - let back_'a := - fun (ret : betree_List_t (u64 * betree_Message_t)) => Return ret in - Return (Betree_List_Nil, back_'a) + else Return (Betree_List_Cons (k, m) next_msgs, Return) + | Betree_List_Nil => Return (Betree_List_Nil, Return) end end . @@ -562,9 +547,7 @@ Fixpoint betree_Node_lookup_mut_in_bindings | Betree_List_Cons hd tl => let (i, i1) := hd in if i s>= key - then - let back_'a := fun (ret : betree_List_t (u64 * u64)) => Return ret in - Return (Betree_List_Cons (i, i1) tl, back_'a) + then Return (Betree_List_Cons (i, i1) tl, Return) else ( p <- betree_Node_lookup_mut_in_bindings n1 key tl; let (l, lookup_mut_in_bindings_back) := p in @@ -573,9 +556,7 @@ Fixpoint betree_Node_lookup_mut_in_bindings tl1 <- lookup_mut_in_bindings_back ret; Return (Betree_List_Cons (i, i1) tl1) in Return (l, back_'a)) - | Betree_List_Nil => - let back_'a := fun (ret : betree_List_t (u64 * u64)) => Return ret in - Return (Betree_List_Nil, back_'a) + | Betree_List_Nil => Return (Betree_List_Nil, Return) end end . @@ -751,10 +732,9 @@ Definition betree_Node_apply (new_msg : betree_Message_t) (st : state) : result (state * (betree_Node_t * betree_NodeIdCounter_t)) := - let l := Betree_List_Nil in p <- betree_Node_apply_messages n self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st; + (key, new_msg) Betree_List_Nil) st; let (st1, p1) := p in let (self1, node_id_cnt1) := p1 in Return (st1, (self1, node_id_cnt1)) diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index 5cd9fe70..0478edbe 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -49,8 +49,7 @@ Definition hashMap_new_with_capacity (max_load_divisor : usize) : result (HashMap_t T) := - let v := alloc_vec_Vec_new (List_t T) in - slots <- hashMap_allocate_slots T n v capacity; + slots <- hashMap_allocate_slots T n (alloc_vec_Vec_new (List_t T)) capacity; i <- usize_mul capacity max_load_dividend; i1 <- usize_div i max_load_divisor; Return @@ -128,7 +127,7 @@ Fixpoint hashMap_insert_in_list_loop p <- hashMap_insert_in_list_loop T n1 key value tl; let (b, back) := p in Return (b, List_Cons ckey cvalue back)) - | List_Nil => let l := List_Nil in Return (true, List_Cons key value l) + | List_Nil => Return (true, List_Cons key value List_Nil) end end . @@ -401,8 +400,7 @@ Definition hashMap_get_mut_in_list := p <- hashMap_get_mut_in_list_loop T n ls key; let (t, back_'a) := p in - let back_'a1 := fun (ret : T) => back_'a ret in - Return (t, back_'a1) + Return (t, back_'a) . (** [hashmap::{hashmap::HashMap}::get_mut]: diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v index b74fa61a..6a7eeb2d 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v @@ -53,8 +53,9 @@ Definition hashmap_HashMap_new_with_capacity (max_load_divisor : usize) : result (hashmap_HashMap_t T) := - let v := alloc_vec_Vec_new (hashmap_List_t T) in - slots <- hashmap_HashMap_allocate_slots T n v capacity; + slots <- + hashmap_HashMap_allocate_slots T n (alloc_vec_Vec_new (hashmap_List_t T)) + capacity; i <- usize_mul capacity max_load_dividend; i1 <- usize_div i max_load_divisor; Return @@ -138,7 +139,7 @@ Fixpoint hashmap_HashMap_insert_in_list_loop let (b, back) := p in Return (b, Hashmap_List_Cons ckey cvalue back)) | Hashmap_List_Nil => - let l := Hashmap_List_Nil in Return (true, Hashmap_List_Cons key value l) + Return (true, Hashmap_List_Cons key value Hashmap_List_Nil) end end . @@ -424,8 +425,7 @@ Definition hashmap_HashMap_get_mut_in_list := p <- hashmap_HashMap_get_mut_in_list_loop T n ls key; let (t, back_'a) := p in - let back_'a1 := fun (ret : T) => back_'a ret in - Return (t, back_'a1) + Return (t, back_'a) . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: diff --git a/tests/coq/misc/External_Funs.v b/tests/coq/misc/External_Funs.v index 049f5d39..91ea88c9 100644 --- a/tests/coq/misc/External_Funs.v +++ b/tests/coq/misc/External_Funs.v @@ -31,9 +31,7 @@ Definition test_new_non_zero_u32 (** [external::test_vec]: Source: 'src/external.rs', lines 17:0-17:17 *) Definition test_vec : result unit := - let v := alloc_vec_Vec_new u32 in - _ <- alloc_vec_Vec_push u32 v 0%u32; - Return tt + _ <- alloc_vec_Vec_push u32 (alloc_vec_Vec_new u32) 0%u32; Return tt . (** Unit test for [external::test_vec] *) diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v index 081c65c3..8857d4b6 100644 --- a/tests/coq/misc/NoNestedBorrows.v +++ b/tests/coq/misc/NoNestedBorrows.v @@ -244,11 +244,10 @@ Check (test_list1 )%return. (** [no_nested_borrows::test_box1]: Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 *) Definition test_box1 : result unit := - let b := 0%i32 in - p <- alloc_boxed_Box_deref_mut i32 b; + p <- alloc_boxed_Box_deref_mut i32 0%i32; let (_, deref_mut_back) := p in - b1 <- deref_mut_back 1%i32; - x <- alloc_boxed_Box_deref i32 b1; + b <- deref_mut_back 1%i32; + x <- alloc_boxed_Box_deref i32 b; if negb (x s= 1%i32) then Fail_ Failure else Return tt . @@ -290,8 +289,7 @@ Definition is_cons (T : Type) (l : List_t T) : result bool := (** [no_nested_borrows::test_is_cons]: Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 *) Definition test_is_cons : result unit := - let l := List_Nil in - b <- is_cons i32 (List_Cons 0%i32 l); + b <- is_cons i32 (List_Cons 0%i32 List_Nil); if negb b then Fail_ Failure else Return tt . @@ -310,8 +308,7 @@ Definition split_list (T : Type) (l : List_t T) : result (T * (List_t T)) := (** [no_nested_borrows::test_split_list]: Source: 'src/no_nested_borrows.rs', lines 267:0-267:24 *) Definition test_split_list : result unit := - let l := List_Nil in - p <- split_list i32 (List_Cons 0%i32 l); + p <- split_list i32 (List_Cons 0%i32 List_Nil); let (hd, _) := p in if negb (hd s= 0%i32) then Fail_ Failure else Return tt . @@ -436,26 +433,25 @@ Definition list_rev (T : Type) (l : List_t T) : result (List_t T) := (** [no_nested_borrows::test_list_functions]: Source: 'src/no_nested_borrows.rs', lines 398:0-398:28 *) Definition test_list_functions : result unit := - let l := List_Nil in - let l1 := List_Cons 2%i32 l in - let l2 := List_Cons 1%i32 l1 in - i <- list_length i32 (List_Cons 0%i32 l2); + let l := List_Cons 2%i32 List_Nil in + let l1 := List_Cons 1%i32 l in + i <- list_length i32 (List_Cons 0%i32 l1); if negb (i s= 3%u32) then Fail_ Failure else ( - i1 <- list_nth_shared i32 (List_Cons 0%i32 l2) 0%u32; + i1 <- list_nth_shared i32 (List_Cons 0%i32 l1) 0%u32; if negb (i1 s= 0%i32) then Fail_ Failure else ( - i2 <- list_nth_shared i32 (List_Cons 0%i32 l2) 1%u32; + i2 <- list_nth_shared i32 (List_Cons 0%i32 l1) 1%u32; if negb (i2 s= 1%i32) then Fail_ Failure else ( - i3 <- list_nth_shared i32 (List_Cons 0%i32 l2) 2%u32; + i3 <- list_nth_shared i32 (List_Cons 0%i32 l1) 2%u32; if negb (i3 s= 2%i32) then Fail_ Failure else ( - p <- list_nth_mut i32 (List_Cons 0%i32 l2) 1%u32; + p <- list_nth_mut i32 (List_Cons 0%i32 l1) 1%u32; let (_, list_nth_mut_back) := p in ls <- list_nth_mut_back 3%i32; i4 <- list_nth_shared i32 ls 0%u32; @@ -502,9 +498,7 @@ Definition id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : result ((T1 * T2) * (T1 -> result T1) * (T2 -> result T2)) := - let back_'a := fun (ret : T1) => Return ret in - let back_'b := fun (ret : T2) => Return ret in - Return ((x, y), back_'a, back_'b) + Return ((x, y), Return, Return) . (** [no_nested_borrows::id_mut_pair4]: @@ -513,10 +507,7 @@ Definition id_mut_pair4 (T1 T2 : Type) (p : (T1 * T2)) : result ((T1 * T2) * (T1 -> result T1) * (T2 -> result T2)) := - let (t, t1) := p in - let back_'a := fun (ret : T1) => Return ret in - let back_'b := fun (ret : T2) => Return ret in - Return ((t, t1), back_'a, back_'b) + let (t, t1) := p in Return ((t, t1), Return, Return) . (** [no_nested_borrows::StructWithTuple] diff --git a/tests/coq/misc/Paper.v b/tests/coq/misc/Paper.v index e46df0ce..769cf34c 100644 --- a/tests/coq/misc/Paper.v +++ b/tests/coq/misc/Paper.v @@ -96,14 +96,13 @@ Fixpoint sum (l : List_t i32) : result i32 := (** [paper::test_nth]: Source: 'src/paper.rs', lines 68:0-68:17 *) Definition test_nth : result unit := - let l := List_Nil in - let l1 := List_Cons 3%i32 l in - let l2 := List_Cons 2%i32 l1 in - p <- list_nth_mut i32 (List_Cons 1%i32 l2) 2%u32; + let l := List_Cons 3%i32 List_Nil in + let l1 := List_Cons 2%i32 l in + p <- list_nth_mut i32 (List_Cons 1%i32 l1) 2%u32; let (x, list_nth_mut_back) := p in x1 <- i32_add x 1%i32; - l3 <- list_nth_mut_back x1; - i <- sum l3; + l2 <- list_nth_mut_back x1; + i <- sum l2; if negb (i s= 7%i32) then Fail_ Failure else Return tt . diff --git a/tests/coq/misc/PoloniusList.v b/tests/coq/misc/PoloniusList.v index 7e967855..8f403a8e 100644 --- a/tests/coq/misc/PoloniusList.v +++ b/tests/coq/misc/PoloniusList.v @@ -27,9 +27,7 @@ Fixpoint get_list_at_x match ls with | List_Cons hd tl => if hd s= x - then - let back_'a := fun (ret : List_t u32) => Return ret in - Return (List_Cons hd tl, back_'a) + then Return (List_Cons hd tl, Return) else ( p <- get_list_at_x tl x; let (l, get_list_at_x_back) := p in @@ -37,9 +35,7 @@ Fixpoint get_list_at_x fun (ret : List_t u32) => tl1 <- get_list_at_x_back ret; Return (List_Cons hd tl1) in Return (l, back_'a)) - | List_Nil => - let back_'a := fun (ret : List_t u32) => Return ret in - Return (List_Nil, back_'a) + | List_Nil => Return (List_Nil, Return) end . diff --git a/tests/coq/traits/Traits.v b/tests/coq/traits/Traits.v index 7055e25d..7abf2021 100644 --- a/tests/coq/traits/Traits.v +++ b/tests/coq/traits/Traits.v @@ -334,7 +334,7 @@ Definition use_with_const_ty1 (H : Type) (LEN : usize) (withConstTyHLENInst : WithConstTy_t H LEN) : result usize := - let i := withConstTyHLENInst.(WithConstTy_tWithConstTy_t_LEN1) in Return i + Return withConstTyHLENInst.(WithConstTy_tWithConstTy_t_LEN1) . (** [traits::use_with_const_ty2]: diff --git a/tests/fstar-split/betree/BetreeMain.Funs.fst b/tests/fstar-split/betree/BetreeMain.Funs.fst index 6890488a..33133236 100644 --- a/tests/fstar-split/betree/BetreeMain.Funs.fst +++ b/tests/fstar-split/betree/BetreeMain.Funs.fst @@ -113,8 +113,7 @@ let rec betree_List_split_at let* i = u64_sub n 1 in let* p = betree_List_split_at t tl i in let (ls0, ls1) = p in - let l = ls0 in - Return (Betree_List_Cons hd l, ls1) + Return (Betree_List_Cons hd ls0, ls1) | Betree_List_Nil -> Fail Failure end @@ -124,8 +123,7 @@ let rec betree_List_split_at 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 - let l = tl in - Return (Betree_List_Cons x l) + Return (Betree_List_Cons x tl) (** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: forward function Source: 'src/betree.rs', lines 306:4-306:32 *) @@ -178,8 +176,7 @@ let rec betree_ListTupleU64T_partition_at_pivot else let* p = betree_ListTupleU64T_partition_at_pivot t tl pivot in let (ls0, ls1) = p in - let l = ls0 in - Return (Betree_List_Cons (i, x) l, ls1) + Return (Betree_List_Cons (i, x) ls0, ls1) | Betree_List_Nil -> Return (Betree_List_Nil, Betree_List_Nil) end @@ -871,13 +868,12 @@ let betree_Node_apply (new_msg : betree_Message_t) (st : state) : result (state & unit) = - let l = Betree_List_Nil in let* (st1, _) = betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, - new_msg) l) st in + new_msg) Betree_List_Nil) st in let* _ = betree_Node_apply_messages_back self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st in + (key, new_msg) Betree_List_Nil) st in Return (st1, ()) (** [betree_main::betree::{betree_main::betree::Node#5}::apply]: backward function 0 @@ -888,9 +884,8 @@ let betree_Node_apply_back (new_msg : betree_Message_t) (st : state) : result (betree_Node_t & betree_NodeIdCounter_t) = - let l = Betree_List_Nil in betree_Node_apply_messages_back self params node_id_cnt (Betree_List_Cons - (key, new_msg) l) st + (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 *) diff --git a/tests/fstar-split/hashmap/Hashmap.Funs.fst b/tests/fstar-split/hashmap/Hashmap.Funs.fst index 79327183..290d49ee 100644 --- a/tests/fstar-split/hashmap/Hashmap.Funs.fst +++ b/tests/fstar-split/hashmap/Hashmap.Funs.fst @@ -41,8 +41,8 @@ let hashMap_new_with_capacity (max_load_divisor : usize) : result (hashMap_t t) = - let v = alloc_vec_Vec_new (list_t t) in - let* slots = hashMap_allocate_slots t v capacity in + let* slots = hashMap_allocate_slots t (alloc_vec_Vec_new (list_t t)) capacity + in let* i = usize_mul capacity max_load_dividend in let* i1 = usize_div i max_load_divisor in Return @@ -124,7 +124,7 @@ let rec hashMap_insert_in_list_loop_back else let* tl1 = hashMap_insert_in_list_loop_back t key value tl in Return (List_Cons ckey cvalue tl1) - | List_Nil -> let l = List_Nil in Return (List_Cons key value l) + | List_Nil -> Return (List_Cons key value List_Nil) end (** [hashmap::{hashmap::HashMap}::insert_in_list]: backward function 0 diff --git a/tests/fstar-split/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar-split/hashmap_on_disk/HashmapMain.Funs.fst index b2800e1e..2e2d54b8 100644 --- a/tests/fstar-split/hashmap_on_disk/HashmapMain.Funs.fst +++ b/tests/fstar-split/hashmap_on_disk/HashmapMain.Funs.fst @@ -43,8 +43,9 @@ let hashmap_HashMap_new_with_capacity (max_load_divisor : usize) : result (hashmap_HashMap_t t) = - let v = alloc_vec_Vec_new (hashmap_List_t t) in - let* slots = hashmap_HashMap_allocate_slots t v capacity in + let* slots = + hashmap_HashMap_allocate_slots t (alloc_vec_Vec_new (hashmap_List_t t)) + capacity in let* i = usize_mul capacity max_load_dividend in let* i1 = usize_div i max_load_divisor in Return @@ -128,8 +129,7 @@ let rec hashmap_HashMap_insert_in_list_loop_back else let* tl1 = hashmap_HashMap_insert_in_list_loop_back t key value tl in Return (Hashmap_List_Cons ckey cvalue tl1) - | Hashmap_List_Nil -> - let l = Hashmap_List_Nil in Return (Hashmap_List_Cons key value l) + | Hashmap_List_Nil -> Return (Hashmap_List_Cons key value Hashmap_List_Nil) end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: backward function 0 diff --git a/tests/fstar-split/misc/External.Funs.fst b/tests/fstar-split/misc/External.Funs.fst index 3b84697e..65382549 100644 --- a/tests/fstar-split/misc/External.Funs.fst +++ b/tests/fstar-split/misc/External.Funs.fst @@ -36,9 +36,7 @@ let test_new_non_zero_u32 (** [external::test_vec]: forward function Source: 'src/external.rs', lines 17:0-17:17 *) let test_vec : result unit = - let v = alloc_vec_Vec_new u32 in - let* _ = alloc_vec_Vec_push u32 v 0 in - Return () + let* _ = alloc_vec_Vec_push u32 (alloc_vec_Vec_new u32) 0 in Return () (** Unit test for [external::test_vec] *) let _ = assert_norm (test_vec = Return ()) diff --git a/tests/fstar-split/misc/NoNestedBorrows.fst b/tests/fstar-split/misc/NoNestedBorrows.fst index 41bb7a06..53e1d300 100644 --- a/tests/fstar-split/misc/NoNestedBorrows.fst +++ b/tests/fstar-split/misc/NoNestedBorrows.fst @@ -220,9 +220,8 @@ let _ = assert_norm (test_list1 = Return ()) (** [no_nested_borrows::test_box1]: forward function Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 *) let test_box1 : result unit = - let b = 0 in - let* b1 = alloc_boxed_Box_deref_mut_back i32 b 1 in - let* x = alloc_boxed_Box_deref i32 b1 in + let* b = alloc_boxed_Box_deref_mut_back i32 0 1 in + let* x = alloc_boxed_Box_deref i32 b in if not (x = 1) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_box1] *) @@ -262,8 +261,7 @@ let is_cons (t : Type0) (l : list_t t) : result bool = (** [no_nested_borrows::test_is_cons]: forward function Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 *) let test_is_cons : result unit = - let l = List_Nil in - let* b = is_cons i32 (List_Cons 0 l) in + let* b = is_cons i32 (List_Cons 0 List_Nil) in if not b then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_is_cons] *) @@ -280,8 +278,7 @@ let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = (** [no_nested_borrows::test_split_list]: forward function Source: 'src/no_nested_borrows.rs', lines 267:0-267:24 *) let test_split_list : result unit = - let l = List_Nil in - let* p = split_list i32 (List_Cons 0 l) in + let* p = split_list i32 (List_Cons 0 List_Nil) in let (hd, _) = p in if not (hd = 0) then Fail Failure else Return () @@ -393,26 +390,25 @@ let list_rev (t : Type0) (l : list_t t) : result (list_t t) = (** [no_nested_borrows::test_list_functions]: forward function Source: 'src/no_nested_borrows.rs', lines 398:0-398:28 *) let test_list_functions : result unit = - let l = List_Nil in - let l1 = List_Cons 2 l in - let l2 = List_Cons 1 l1 in - let* i = list_length i32 (List_Cons 0 l2) in + let l = List_Cons 2 List_Nil in + let l1 = List_Cons 1 l in + let* i = list_length i32 (List_Cons 0 l1) in if not (i = 3) then Fail Failure else - let* i1 = list_nth_shared i32 (List_Cons 0 l2) 0 in + let* i1 = list_nth_shared i32 (List_Cons 0 l1) 0 in if not (i1 = 0) then Fail Failure else - let* i2 = list_nth_shared i32 (List_Cons 0 l2) 1 in + let* i2 = list_nth_shared i32 (List_Cons 0 l1) 1 in if not (i2 = 1) then Fail Failure else - let* i3 = list_nth_shared i32 (List_Cons 0 l2) 2 in + let* i3 = list_nth_shared i32 (List_Cons 0 l1) 2 in if not (i3 = 2) then Fail Failure else - let* ls = list_nth_mut_back i32 (List_Cons 0 l2) 1 3 in + let* ls = list_nth_mut_back i32 (List_Cons 0 l1) 1 3 in let* i4 = list_nth_shared i32 ls 0 in if not (i4 = 0) then Fail Failure diff --git a/tests/fstar-split/misc/Paper.fst b/tests/fstar-split/misc/Paper.fst index 2dc804de..0c44d78b 100644 --- a/tests/fstar-split/misc/Paper.fst +++ b/tests/fstar-split/misc/Paper.fst @@ -87,13 +87,12 @@ let rec sum (l : list_t i32) : result i32 = (** [paper::test_nth]: forward function Source: 'src/paper.rs', lines 68:0-68:17 *) let test_nth : result unit = - let l = List_Nil in - let l1 = List_Cons 3 l in - let l2 = List_Cons 2 l1 in - let* x = list_nth_mut i32 (List_Cons 1 l2) 2 in + let l = List_Cons 3 List_Nil in + let l1 = List_Cons 2 l in + let* x = list_nth_mut i32 (List_Cons 1 l1) 2 in let* x1 = i32_add x 1 in - let* l3 = list_nth_mut_back i32 (List_Cons 1 l2) 2 x1 in - let* i = sum l3 in + let* l2 = list_nth_mut_back i32 (List_Cons 1 l1) 2 x1 in + let* i = sum l2 in if not (i = 7) then Fail Failure else Return () (** Unit test for [paper::test_nth] *) diff --git a/tests/fstar-split/traits/Traits.fst b/tests/fstar-split/traits/Traits.fst index 29a001b2..d3847590 100644 --- a/tests/fstar-split/traits/Traits.fst +++ b/tests/fstar-split/traits/Traits.fst @@ -274,7 +274,7 @@ let use_with_const_ty1 (h : Type0) (len : usize) (withConstTyHLENInst : withConstTy_t h len) : result usize = - let i = withConstTyHLENInst.cLEN1 in Return i + Return withConstTyHLENInst.cLEN1 (** [traits::use_with_const_ty2]: forward function Source: 'src/traits.rs', lines 187:0-187:73 *) diff --git a/tests/fstar/array/Array.Funs.fst b/tests/fstar/array/Array.Funs.fst index da4164bc..4193ba7d 100644 --- a/tests/fstar/array/Array.Funs.fst +++ b/tests/fstar/array/Array.Funs.fst @@ -24,8 +24,7 @@ let array_to_mut_slice_ result ((slice t) & (slice t -> result (array t 32))) = let* (s1, to_slice_mut_back) = array_to_slice_mut t 32 s in - let back = fun ret -> to_slice_mut_back ret in - Return (s1, back) + Return (s1, to_slice_mut_back) (** [array::array_len]: Source: 'src/array.rs', lines 25:0-25:40 *) @@ -64,8 +63,7 @@ let index_mut_array result (t & (t -> result (array t 32))) = let* (x, index_mut_back) = array_index_mut_usize t 32 s i in - let back = fun ret -> index_mut_back ret in - Return (x, back) + Return (x, index_mut_back) (** [array::index_slice]: Source: 'src/array.rs', lines 56:0-56:46 *) @@ -79,8 +77,7 @@ let index_mut_slice result (t & (t -> result (slice t))) = let* (x, index_mut_back) = slice_index_mut_usize t s i in - let back = fun ret -> index_mut_back ret in - Return (x, back) + Return (x, index_mut_back) (** [array::slice_subslice_shared_]: Source: 'src/array.rs', lines 64:0-64:70 *) @@ -100,8 +97,7 @@ let slice_subslice_mut_ core_slice_index_Slice_index_mut u32 (core_ops_range_Range usize) (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x { start = y; end_ = z } in - let back = fun ret -> index_mut_back ret in - Return (s, back) + Return (s, index_mut_back) (** [array::array_to_slice_shared_]: Source: 'src/array.rs', lines 72:0-72:54 *) @@ -115,8 +111,7 @@ let array_to_slice_mut_ result ((slice u32) & (slice u32 -> result (array u32 32))) = let* (s, to_slice_mut_back) = array_to_slice_mut u32 32 x in - let back = fun ret -> to_slice_mut_back ret in - Return (s, back) + Return (s, to_slice_mut_back) (** [array::array_subslice_shared_]: Source: 'src/array.rs', lines 80:0-80:74 *) @@ -138,8 +133,7 @@ let array_subslice_mut_ (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x { start = y; end_ = z } in - let back = fun ret -> index_mut_back ret in - Return (s, back) + Return (s, index_mut_back) (** [array::index_slice_0]: Source: 'src/array.rs', lines 88:0-88:38 *) diff --git a/tests/fstar/betree/BetreeMain.Funs.fst b/tests/fstar/betree/BetreeMain.Funs.fst index a3065f3d..196f120c 100644 --- a/tests/fstar/betree/BetreeMain.Funs.fst +++ b/tests/fstar/betree/BetreeMain.Funs.fst @@ -103,8 +103,7 @@ let rec betree_List_split_at let* i = u64_sub n 1 in let* p = betree_List_split_at t tl i in let (ls0, ls1) = p in - let l = ls0 in - Return (Betree_List_Cons hd l, ls1) + Return (Betree_List_Cons hd ls0, ls1) | Betree_List_Nil -> Fail Failure end @@ -113,8 +112,7 @@ let rec betree_List_split_at 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 - let l = tl in - Return (Betree_List_Cons x l) + Return (Betree_List_Cons x tl) (** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: Source: 'src/betree.rs', lines 306:4-306:32 *) @@ -158,8 +156,7 @@ let rec betree_ListTupleU64T_partition_at_pivot else let* p = betree_ListTupleU64T_partition_at_pivot t tl pivot in let (ls0, ls1) = p in - let l = ls0 in - Return (Betree_List_Cons (i, x) l, ls1) + Return (Betree_List_Cons (i, x) ls0, ls1) | Betree_List_Nil -> Return (Betree_List_Nil, Betree_List_Nil) end @@ -195,9 +192,7 @@ let rec betree_Node_lookup_first_message_for_key | Betree_List_Cons x next_msgs -> let (i, m) = x in if i >= key - then - let back_'a = fun ret -> Return ret in - Return (Betree_List_Cons (i, m) next_msgs, back_'a) + then Return (Betree_List_Cons (i, m) next_msgs, Return) else let* (l, lookup_first_message_for_key_back) = betree_Node_lookup_first_message_for_key key next_msgs in @@ -206,8 +201,7 @@ let rec betree_Node_lookup_first_message_for_key let* next_msgs1 = lookup_first_message_for_key_back ret in Return (Betree_List_Cons (i, m) next_msgs1) in Return (l, back_'a) - | Betree_List_Nil -> - let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) + | Betree_List_Nil -> Return (Betree_List_Nil, Return) end (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: @@ -362,11 +356,8 @@ let rec betree_Node_lookup_first_message_after_key let* next_msgs1 = lookup_first_message_after_key_back ret in Return (Betree_List_Cons (k, m) next_msgs1) in Return (l, back_'a) - else - let back_'a = fun ret -> Return ret in - Return (Betree_List_Cons (k, m) next_msgs, back_'a) - | Betree_List_Nil -> - let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) + else Return (Betree_List_Cons (k, m) next_msgs, Return) + | Betree_List_Nil -> Return (Betree_List_Nil, Return) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: @@ -455,9 +446,7 @@ let rec betree_Node_lookup_mut_in_bindings | Betree_List_Cons hd tl -> let (i, i1) = hd in if i >= key - then - let back_'a = fun ret -> Return ret in - Return (Betree_List_Cons (i, i1) tl, back_'a) + then Return (Betree_List_Cons (i, i1) tl, Return) else let* (l, lookup_mut_in_bindings_back) = betree_Node_lookup_mut_in_bindings key tl in @@ -466,8 +455,7 @@ let rec betree_Node_lookup_mut_in_bindings let* tl1 = lookup_mut_in_bindings_back ret in Return (Betree_List_Cons (i, i1) tl1) in Return (l, back_'a) - | Betree_List_Nil -> - let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) + | Betree_List_Nil -> Return (Betree_List_Nil, Return) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: @@ -608,10 +596,9 @@ let betree_Node_apply (new_msg : betree_Message_t) (st : state) : result (state & (betree_Node_t & betree_NodeIdCounter_t)) = - let l = Betree_List_Nil in let* (st1, p) = betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, - new_msg) l) st in + new_msg) Betree_List_Nil) st in let (self1, node_id_cnt1) = p in Return (st1, (self1, node_id_cnt1)) diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst index a3065f3d..196f120c 100644 --- a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst +++ b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst @@ -103,8 +103,7 @@ let rec betree_List_split_at let* i = u64_sub n 1 in let* p = betree_List_split_at t tl i in let (ls0, ls1) = p in - let l = ls0 in - Return (Betree_List_Cons hd l, ls1) + Return (Betree_List_Cons hd ls0, ls1) | Betree_List_Nil -> Fail Failure end @@ -113,8 +112,7 @@ let rec betree_List_split_at 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 - let l = tl in - Return (Betree_List_Cons x l) + Return (Betree_List_Cons x tl) (** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: Source: 'src/betree.rs', lines 306:4-306:32 *) @@ -158,8 +156,7 @@ let rec betree_ListTupleU64T_partition_at_pivot else let* p = betree_ListTupleU64T_partition_at_pivot t tl pivot in let (ls0, ls1) = p in - let l = ls0 in - Return (Betree_List_Cons (i, x) l, ls1) + Return (Betree_List_Cons (i, x) ls0, ls1) | Betree_List_Nil -> Return (Betree_List_Nil, Betree_List_Nil) end @@ -195,9 +192,7 @@ let rec betree_Node_lookup_first_message_for_key | Betree_List_Cons x next_msgs -> let (i, m) = x in if i >= key - then - let back_'a = fun ret -> Return ret in - Return (Betree_List_Cons (i, m) next_msgs, back_'a) + then Return (Betree_List_Cons (i, m) next_msgs, Return) else let* (l, lookup_first_message_for_key_back) = betree_Node_lookup_first_message_for_key key next_msgs in @@ -206,8 +201,7 @@ let rec betree_Node_lookup_first_message_for_key let* next_msgs1 = lookup_first_message_for_key_back ret in Return (Betree_List_Cons (i, m) next_msgs1) in Return (l, back_'a) - | Betree_List_Nil -> - let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) + | Betree_List_Nil -> Return (Betree_List_Nil, Return) end (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: @@ -362,11 +356,8 @@ let rec betree_Node_lookup_first_message_after_key let* next_msgs1 = lookup_first_message_after_key_back ret in Return (Betree_List_Cons (k, m) next_msgs1) in Return (l, back_'a) - else - let back_'a = fun ret -> Return ret in - Return (Betree_List_Cons (k, m) next_msgs, back_'a) - | Betree_List_Nil -> - let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) + else Return (Betree_List_Cons (k, m) next_msgs, Return) + | Betree_List_Nil -> Return (Betree_List_Nil, Return) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: @@ -455,9 +446,7 @@ let rec betree_Node_lookup_mut_in_bindings | Betree_List_Cons hd tl -> let (i, i1) = hd in if i >= key - then - let back_'a = fun ret -> Return ret in - Return (Betree_List_Cons (i, i1) tl, back_'a) + then Return (Betree_List_Cons (i, i1) tl, Return) else let* (l, lookup_mut_in_bindings_back) = betree_Node_lookup_mut_in_bindings key tl in @@ -466,8 +455,7 @@ let rec betree_Node_lookup_mut_in_bindings let* tl1 = lookup_mut_in_bindings_back ret in Return (Betree_List_Cons (i, i1) tl1) in Return (l, back_'a) - | Betree_List_Nil -> - let back_'a = fun ret -> Return ret in Return (Betree_List_Nil, back_'a) + | Betree_List_Nil -> Return (Betree_List_Nil, Return) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: @@ -608,10 +596,9 @@ let betree_Node_apply (new_msg : betree_Message_t) (st : state) : result (state & (betree_Node_t & betree_NodeIdCounter_t)) = - let l = Betree_List_Nil in let* (st1, p) = betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, - new_msg) l) st in + new_msg) Betree_List_Nil) st in let (self1, node_id_cnt1) = p in Return (st1, (self1, node_id_cnt1)) diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index 9fc5d8a0..447f9b49 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -41,8 +41,8 @@ let hashMap_new_with_capacity (max_load_divisor : usize) : result (hashMap_t t) = - let v = alloc_vec_Vec_new (list_t t) in - let* slots = hashMap_allocate_slots t v capacity in + let* slots = hashMap_allocate_slots t (alloc_vec_Vec_new (list_t t)) capacity + in let* i = usize_mul capacity max_load_dividend in let* i1 = usize_div i max_load_divisor in Return @@ -101,7 +101,7 @@ let rec hashMap_insert_in_list_loop else let* (b, back) = hashMap_insert_in_list_loop t key value tl in Return (b, List_Cons ckey cvalue back) - | List_Nil -> let l = List_Nil in Return (true, List_Cons key value l) + | List_Nil -> Return (true, List_Cons key value List_Nil) end (** [hashmap::{hashmap::HashMap}::insert_in_list]: @@ -309,8 +309,7 @@ let hashMap_get_mut_in_list result (t & (t -> result (list_t t))) = let* (x, back_'a) = hashMap_get_mut_in_list_loop t ls key in - let back_'a1 = fun ret -> back_'a ret in - Return (x, back_'a1) + Return (x, back_'a) (** [hashmap::{hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 *) diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst index 3a042678..b16dcada 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst @@ -42,8 +42,9 @@ let hashmap_HashMap_new_with_capacity (max_load_divisor : usize) : result (hashmap_HashMap_t t) = - let v = alloc_vec_Vec_new (hashmap_List_t t) in - let* slots = hashmap_HashMap_allocate_slots t v capacity in + let* slots = + hashmap_HashMap_allocate_slots t (alloc_vec_Vec_new (hashmap_List_t t)) + capacity in let* i = usize_mul capacity max_load_dividend in let* i1 = usize_div i max_load_divisor in Return @@ -106,7 +107,7 @@ let rec hashmap_HashMap_insert_in_list_loop let* (b, back) = hashmap_HashMap_insert_in_list_loop t key value tl in Return (b, Hashmap_List_Cons ckey cvalue back) | Hashmap_List_Nil -> - let l = Hashmap_List_Nil in Return (true, Hashmap_List_Cons key value l) + Return (true, Hashmap_List_Cons key value Hashmap_List_Nil) end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: @@ -324,8 +325,7 @@ let hashmap_HashMap_get_mut_in_list result (t & (t -> result (hashmap_List_t t))) = let* (x, back_'a) = hashmap_HashMap_get_mut_in_list_loop t ls key in - let back_'a1 = fun ret -> back_'a ret in - Return (x, back_'a1) + Return (x, back_'a) (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 *) diff --git a/tests/fstar/misc/External.Funs.fst b/tests/fstar/misc/External.Funs.fst index bb1b9a64..6672b523 100644 --- a/tests/fstar/misc/External.Funs.fst +++ b/tests/fstar/misc/External.Funs.fst @@ -22,9 +22,7 @@ let test_new_non_zero_u32 (** [external::test_vec]: Source: 'src/external.rs', lines 17:0-17:17 *) let test_vec : result unit = - let v = alloc_vec_Vec_new u32 in - let* _ = alloc_vec_Vec_push u32 v 0 in - Return () + let* _ = alloc_vec_Vec_push u32 (alloc_vec_Vec_new u32) 0 in Return () (** Unit test for [external::test_vec] *) let _ = assert_norm (test_vec = Return ()) diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index 0fd0c1dc..ffcc32f3 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -220,10 +220,9 @@ let _ = assert_norm (test_list1 = Return ()) (** [no_nested_borrows::test_box1]: Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 *) let test_box1 : result unit = - let b = 0 in - let* (_, deref_mut_back) = alloc_boxed_Box_deref_mut i32 b in - let* b1 = deref_mut_back 1 in - let* x = alloc_boxed_Box_deref i32 b1 in + let* (_, deref_mut_back) = alloc_boxed_Box_deref_mut i32 0 in + let* b = deref_mut_back 1 in + let* x = alloc_boxed_Box_deref i32 b in if not (x = 1) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_box1] *) @@ -263,8 +262,7 @@ let is_cons (t : Type0) (l : list_t t) : result bool = (** [no_nested_borrows::test_is_cons]: Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 *) let test_is_cons : result unit = - let l = List_Nil in - let* b = is_cons i32 (List_Cons 0 l) in + let* b = is_cons i32 (List_Cons 0 List_Nil) in if not b then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_is_cons] *) @@ -281,8 +279,7 @@ let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = (** [no_nested_borrows::test_split_list]: Source: 'src/no_nested_borrows.rs', lines 267:0-267:24 *) let test_split_list : result unit = - let l = List_Nil in - let* p = split_list i32 (List_Cons 0 l) in + let* p = split_list i32 (List_Cons 0 List_Nil) in let (hd, _) = p in if not (hd = 0) then Fail Failure else Return () @@ -388,26 +385,25 @@ let list_rev (t : Type0) (l : list_t t) : result (list_t t) = (** [no_nested_borrows::test_list_functions]: Source: 'src/no_nested_borrows.rs', lines 398:0-398:28 *) let test_list_functions : result unit = - let l = List_Nil in - let l1 = List_Cons 2 l in - let l2 = List_Cons 1 l1 in - let* i = list_length i32 (List_Cons 0 l2) in + let l = List_Cons 2 List_Nil in + let l1 = List_Cons 1 l in + let* i = list_length i32 (List_Cons 0 l1) in if not (i = 3) then Fail Failure else - let* i1 = list_nth_shared i32 (List_Cons 0 l2) 0 in + let* i1 = list_nth_shared i32 (List_Cons 0 l1) 0 in if not (i1 = 0) then Fail Failure else - let* i2 = list_nth_shared i32 (List_Cons 0 l2) 1 in + let* i2 = list_nth_shared i32 (List_Cons 0 l1) 1 in if not (i2 = 1) then Fail Failure else - let* i3 = list_nth_shared i32 (List_Cons 0 l2) 2 in + let* i3 = list_nth_shared i32 (List_Cons 0 l1) 2 in if not (i3 = 2) then Fail Failure else - let* (_, list_nth_mut_back) = list_nth_mut i32 (List_Cons 0 l2) 1 in + let* (_, list_nth_mut_back) = list_nth_mut i32 (List_Cons 0 l1) 1 in let* ls = list_nth_mut_back 3 in let* i4 = list_nth_shared i32 ls 0 in if not (i4 = 0) @@ -448,9 +444,7 @@ let id_mut_pair3 (t1 t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & (t1 -> result t1) & (t2 -> result t2)) = - let back_'a = fun ret -> Return ret in - let back_'b = fun ret -> Return ret in - Return ((x, y), back_'a, back_'b) + Return ((x, y), Return, Return) (** [no_nested_borrows::id_mut_pair4]: Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) @@ -458,10 +452,7 @@ let id_mut_pair4 (t1 t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & (t1 -> result t1) & (t2 -> result t2)) = - let (x, x1) = p in - let back_'a = fun ret -> Return ret in - let back_'b = fun ret -> Return ret in - Return ((x, x1), back_'a, back_'b) + let (x, x1) = p in Return ((x, x1), Return, Return) (** [no_nested_borrows::StructWithTuple] Source: 'src/no_nested_borrows.rs', lines 433:0-433:34 *) diff --git a/tests/fstar/misc/Paper.fst b/tests/fstar/misc/Paper.fst index c6082929..cf4dc454 100644 --- a/tests/fstar/misc/Paper.fst +++ b/tests/fstar/misc/Paper.fst @@ -80,13 +80,12 @@ let rec sum (l : list_t i32) : result i32 = (** [paper::test_nth]: Source: 'src/paper.rs', lines 68:0-68:17 *) let test_nth : result unit = - let l = List_Nil in - let l1 = List_Cons 3 l in - let l2 = List_Cons 2 l1 in - let* (x, list_nth_mut_back) = list_nth_mut i32 (List_Cons 1 l2) 2 in + let l = List_Cons 3 List_Nil in + let l1 = List_Cons 2 l in + let* (x, list_nth_mut_back) = list_nth_mut i32 (List_Cons 1 l1) 2 in let* x1 = i32_add x 1 in - let* l3 = list_nth_mut_back x1 in - let* i = sum l3 in + let* l2 = list_nth_mut_back x1 in + let* i = sum l2 in if not (i = 7) then Fail Failure else Return () (** Unit test for [paper::test_nth] *) diff --git a/tests/fstar/misc/PoloniusList.fst b/tests/fstar/misc/PoloniusList.fst index cbe7d6b8..b477802b 100644 --- a/tests/fstar/misc/PoloniusList.fst +++ b/tests/fstar/misc/PoloniusList.fst @@ -20,15 +20,13 @@ let rec get_list_at_x begin match ls with | List_Cons hd tl -> if hd = x - then - let back_'a = fun ret -> Return ret in Return (List_Cons hd tl, back_'a) + then Return (List_Cons hd tl, Return) else let* (l, get_list_at_x_back) = get_list_at_x tl x in let back_'a = fun ret -> let* tl1 = get_list_at_x_back ret in Return (List_Cons hd tl1) in Return (l, back_'a) - | List_Nil -> - let back_'a = fun ret -> Return ret in Return (List_Nil, back_'a) + | List_Nil -> Return (List_Nil, Return) end diff --git a/tests/fstar/traits/Traits.fst b/tests/fstar/traits/Traits.fst index 3543bd73..cb9c1654 100644 --- a/tests/fstar/traits/Traits.fst +++ b/tests/fstar/traits/Traits.fst @@ -273,7 +273,7 @@ let use_with_const_ty1 (h : Type0) (len : usize) (withConstTyHLENInst : withConstTy_t h len) : result usize = - let i = withConstTyHLENInst.cLEN1 in Return i + Return withConstTyHLENInst.cLEN1 (** [traits::use_with_const_ty2]: Source: 'src/traits.rs', lines 187:0-187:73 *) diff --git a/tests/lean/Array.lean b/tests/lean/Array.lean index 20f3425e..7785a208 100644 --- a/tests/lean/Array.lean +++ b/tests/lean/Array.lean @@ -30,8 +30,7 @@ def array_to_mut_slice_ := do let (s1, to_slice_mut_back) ← Array.to_slice_mut T 32#usize s - let back := fun ret => to_slice_mut_back ret - Result.ret (s1, back) + Result.ret (s1, to_slice_mut_back) /- [array::array_len]: Source: 'src/array.rs', lines 25:0-25:40 -/ @@ -79,8 +78,7 @@ def index_mut_array := do let (t, index_mut_back) ← Array.index_mut_usize T 32#usize s i - let back := fun ret => index_mut_back ret - Result.ret (t, back) + Result.ret (t, index_mut_back) /- [array::index_slice]: Source: 'src/array.rs', lines 56:0-56:46 -/ @@ -95,8 +93,7 @@ def index_mut_slice := do let (t, index_mut_back) ← Slice.index_mut_usize T s i - let back := fun ret => index_mut_back ret - Result.ret (t, back) + Result.ret (t, index_mut_back) /- [array::slice_subslice_shared_]: Source: 'src/array.rs', lines 64:0-64:70 -/ @@ -117,8 +114,7 @@ def slice_subslice_mut_ core.slice.index.Slice.index_mut U32 (core.ops.range.Range Usize) (core.slice.index.SliceIndexRangeUsizeSliceTInst U32) x { start := y, end_ := z } - let back := fun ret => index_mut_back ret - Result.ret (s, back) + Result.ret (s, index_mut_back) /- [array::array_to_slice_shared_]: Source: 'src/array.rs', lines 72:0-72:54 -/ @@ -133,8 +129,7 @@ def array_to_slice_mut_ := do let (s, to_slice_mut_back) ← Array.to_slice_mut U32 32#usize x - let back := fun ret => to_slice_mut_back ret - Result.ret (s, back) + Result.ret (s, to_slice_mut_back) /- [array::array_subslice_shared_]: Source: 'src/array.rs', lines 80:0-80:74 -/ @@ -157,8 +152,7 @@ def array_subslice_mut_ (core.ops.index.IndexMutSliceTIInst U32 (core.ops.range.Range Usize) (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x { start := y, end_ := z } - let back := fun ret => index_mut_back ret - Result.ret (s, back) + Result.ret (s, index_mut_back) /- [array::index_slice_0]: Source: 'src/array.rs', lines 88:0-88:38 -/ diff --git a/tests/lean/BetreeMain/Funs.lean b/tests/lean/BetreeMain/Funs.lean index 4e64d217..96daa197 100644 --- a/tests/lean/BetreeMain/Funs.lean +++ b/tests/lean/BetreeMain/Funs.lean @@ -107,8 +107,7 @@ divergent def betree.List.split_at let i ← n - 1#u64 let p ← betree.List.split_at T tl i let (ls0, ls1) := p - let l := ls0 - Result.ret (betree.List.Cons hd l, ls1) + Result.ret (betree.List.Cons hd ls0, ls1) | betree.List.Nil => Result.fail .panic /- [betree_main::betree::{betree_main::betree::List#1}::push_front]: @@ -116,8 +115,7 @@ divergent def betree.List.split_at def betree.List.push_front (T : Type) (self : betree.List T) (x : T) : Result (betree.List T) := let (tl, _) := core.mem.replace (betree.List T) self betree.List.Nil - let l := tl - Result.ret (betree.List.Cons x l) + Result.ret (betree.List.Cons x tl) /- [betree_main::betree::{betree_main::betree::List#1}::pop_front]: Source: 'src/betree.rs', lines 306:4-306:32 -/ @@ -159,8 +157,7 @@ divergent def betree.ListTupleU64T.partition_at_pivot do let p ← betree.ListTupleU64T.partition_at_pivot T tl pivot let (ls0, ls1) := p - let l := ls0 - Result.ret (betree.List.Cons (i, t) l, ls1) + Result.ret (betree.List.Cons (i, t) ls0, ls1) | betree.List.Nil => Result.ret (betree.List.Nil, betree.List.Nil) /- [betree_main::betree::{betree_main::betree::Leaf#3}::split]: @@ -194,9 +191,7 @@ divergent def betree.Node.lookup_first_message_for_key | betree.List.Cons x next_msgs => let (i, m) := x if i >= key - then - let back_'a := fun ret => Result.ret ret - Result.ret (betree.List.Cons (i, m) next_msgs, back_'a) + then Result.ret (betree.List.Cons (i, m) next_msgs, Result.ret) else do let (l, lookup_first_message_for_key_back) ← @@ -207,9 +202,7 @@ divergent def betree.Node.lookup_first_message_for_key let next_msgs1 ← lookup_first_message_for_key_back ret Result.ret (betree.List.Cons (i, m) next_msgs1) Result.ret (l, back_'a) - | betree.List.Nil => - let back_'a := fun ret => Result.ret ret - Result.ret (betree.List.Nil, back_'a) + | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) /- [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: Source: 'src/betree.rs', lines 636:4-636:80 -/ @@ -381,12 +374,8 @@ divergent def betree.Node.lookup_first_message_after_key let next_msgs1 ← lookup_first_message_after_key_back ret Result.ret (betree.List.Cons (k, m) next_msgs1) Result.ret (l, back_'a) - else - let back_'a := fun ret => Result.ret ret - Result.ret (betree.List.Cons (k, m) next_msgs, back_'a) - | betree.List.Nil => - let back_'a := fun ret => Result.ret ret - Result.ret (betree.List.Nil, back_'a) + else Result.ret (betree.List.Cons (k, m) next_msgs, Result.ret) + | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) /- [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: Source: 'src/betree.rs', lines 521:4-521:89 -/ @@ -478,9 +467,7 @@ divergent def betree.Node.lookup_mut_in_bindings | betree.List.Cons hd tl => let (i, i1) := hd if i >= key - then - let back_'a := fun ret => Result.ret ret - Result.ret (betree.List.Cons (i, i1) tl, back_'a) + then Result.ret (betree.List.Cons (i, i1) tl, Result.ret) else do let (l, lookup_mut_in_bindings_back) ← @@ -491,9 +478,7 @@ divergent def betree.Node.lookup_mut_in_bindings let tl1 ← lookup_mut_in_bindings_back ret Result.ret (betree.List.Cons (i, i1) tl1) Result.ret (l, back_'a) - | betree.List.Nil => - let back_'a := fun ret => Result.ret ret - Result.ret (betree.List.Nil, back_'a) + | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) /- [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: Source: 'src/betree.rs', lines 460:4-460:87 -/ @@ -650,10 +635,9 @@ def betree.Node.apply Result (State × (betree.Node × betree.NodeIdCounter)) := do - let l := betree.List.Nil let (st1, p) ← betree.Node.apply_messages self params node_id_cnt (betree.List.Cons (key, - new_msg) l) st + new_msg) betree.List.Nil) st let (self1, node_id_cnt1) := p Result.ret (st1, (self1, node_id_cnt1)) diff --git a/tests/lean/External/Funs.lean b/tests/lean/External/Funs.lean index 88ced82d..db15aacc 100644 --- a/tests/lean/External/Funs.lean +++ b/tests/lean/External/Funs.lean @@ -25,8 +25,7 @@ def test_new_non_zero_u32 Source: 'src/external.rs', lines 17:0-17:17 -/ def test_vec : Result Unit := do - let v := alloc.vec.Vec.new U32 - let _ ← alloc.vec.Vec.push U32 v 0#u32 + let _ ← alloc.vec.Vec.push U32 (alloc.vec.Vec.new U32) 0#u32 Result.ret () /- Unit test for [external::test_vec] -/ diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 32ed2b33..3978bfc7 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -41,8 +41,7 @@ def HashMap.new_with_capacity Result (HashMap T) := do - let v := alloc.vec.Vec.new (List T) - let slots ← HashMap.allocate_slots T v capacity + let slots ← HashMap.allocate_slots T (alloc.vec.Vec.new (List T)) capacity let i ← capacity * max_load_dividend let i1 ← i / max_load_divisor Result.ret @@ -102,8 +101,7 @@ divergent def HashMap.insert_in_list_loop do let (b, back) ← HashMap.insert_in_list_loop T key value tl Result.ret (b, List.Cons ckey cvalue back) - | List.Nil => let l := List.Nil - Result.ret (true, List.Cons key value l) + | List.Nil => Result.ret (true, List.Cons key value List.Nil) /- [hashmap::{hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 -/ @@ -315,8 +313,7 @@ def HashMap.get_mut_in_list := do let (t, back_'a) ← HashMap.get_mut_in_list_loop T ls key - let back_'a1 := fun ret => back_'a ret - Result.ret (t, back_'a1) + Result.ret (t, back_'a) /- [hashmap::{hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 -/ diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index 9bfb5070..ebed2570 100644 --- a/tests/lean/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -42,8 +42,9 @@ def hashmap.HashMap.new_with_capacity Result (hashmap.HashMap T) := do - let v := alloc.vec.Vec.new (hashmap.List T) - let slots ← hashmap.HashMap.allocate_slots T v capacity + let slots ← + hashmap.HashMap.allocate_slots T (alloc.vec.Vec.new (hashmap.List T)) + capacity let i ← capacity * max_load_dividend let i1 ← i / max_load_divisor Result.ret @@ -105,8 +106,7 @@ divergent def hashmap.HashMap.insert_in_list_loop let (b, back) ← hashmap.HashMap.insert_in_list_loop T key value tl Result.ret (b, hashmap.List.Cons ckey cvalue back) | hashmap.List.Nil => - let l := hashmap.List.Nil - Result.ret (true, hashmap.List.Cons key value l) + Result.ret (true, hashmap.List.Cons key value hashmap.List.Nil) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 -/ @@ -328,8 +328,7 @@ def hashmap.HashMap.get_mut_in_list := do let (t, back_'a) ← hashmap.HashMap.get_mut_in_list_loop T ls key - let back_'a1 := fun ret => back_'a ret - Result.ret (t, back_'a1) + Result.ret (t, back_'a) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut]: Source: 'src/hashmap.rs', lines 257:4-257:67 -/ diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index cb0aac10..0dd29429 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -244,10 +244,9 @@ def test_list1 : Result Unit := Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 -/ def test_box1 : Result Unit := do - let b := 0#i32 - let (_, deref_mut_back) ← alloc.boxed.Box.deref_mut I32 b - let b1 ← deref_mut_back 1#i32 - let x ← alloc.boxed.Box.deref I32 b1 + let (_, deref_mut_back) ← alloc.boxed.Box.deref_mut I32 0#i32 + let b ← deref_mut_back 1#i32 + let x ← alloc.boxed.Box.deref I32 b if not (x = 1#i32) then Result.fail .panic else Result.ret () @@ -297,8 +296,7 @@ def is_cons (T : Type) (l : List T) : Result Bool := Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 -/ def test_is_cons : Result Unit := do - let l := List.Nil - let b ← is_cons I32 (List.Cons 0#i32 l) + let b ← is_cons I32 (List.Cons 0#i32 List.Nil) if not b then Result.fail .panic else Result.ret () @@ -317,8 +315,7 @@ def split_list (T : Type) (l : List T) : Result (T × (List T)) := Source: 'src/no_nested_borrows.rs', lines 267:0-267:24 -/ def test_split_list : Result Unit := do - let l := List.Nil - let p ← split_list I32 (List.Cons 0#i32 l) + let p ← split_list I32 (List.Cons 0#i32 List.Nil) let (hd, _) := p if not (hd = 0#i32) then Result.fail .panic @@ -441,31 +438,30 @@ def list_rev (T : Type) (l : List T) : Result (List T) := Source: 'src/no_nested_borrows.rs', lines 398:0-398:28 -/ def test_list_functions : Result Unit := do - let l := List.Nil - let l1 := List.Cons 2#i32 l - let l2 := List.Cons 1#i32 l1 - let i ← list_length I32 (List.Cons 0#i32 l2) + let l := List.Cons 2#i32 List.Nil + let l1 := List.Cons 1#i32 l + let i ← list_length I32 (List.Cons 0#i32 l1) if not (i = 3#u32) then Result.fail .panic else do - let i1 ← list_nth_shared I32 (List.Cons 0#i32 l2) 0#u32 + let i1 ← list_nth_shared I32 (List.Cons 0#i32 l1) 0#u32 if not (i1 = 0#i32) then Result.fail .panic else do - let i2 ← list_nth_shared I32 (List.Cons 0#i32 l2) 1#u32 + let i2 ← list_nth_shared I32 (List.Cons 0#i32 l1) 1#u32 if not (i2 = 1#i32) then Result.fail .panic else do - let i3 ← list_nth_shared I32 (List.Cons 0#i32 l2) 2#u32 + let i3 ← list_nth_shared I32 (List.Cons 0#i32 l1) 2#u32 if not (i3 = 2#i32) then Result.fail .panic else do let (_, list_nth_mut_back) ← - list_nth_mut I32 (List.Cons 0#i32 l2) 1#u32 + list_nth_mut I32 (List.Cons 0#i32 l1) 1#u32 let ls ← list_nth_mut_back 3#i32 let i4 ← list_nth_shared I32 ls 0#u32 if not (i4 = 0#i32) @@ -512,9 +508,7 @@ def id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : Result ((T1 × T2) × (T1 → Result T1) × (T2 → Result T2)) := - let back_'a := fun ret => Result.ret ret - let back_'b := fun ret => Result.ret ret - Result.ret ((x, y), back_'a, back_'b) + Result.ret ((x, y), Result.ret, Result.ret) /- [no_nested_borrows::id_mut_pair4]: Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 -/ @@ -523,9 +517,7 @@ def id_mut_pair4 Result ((T1 × T2) × (T1 → Result T1) × (T2 → Result T2)) := let (t, t1) := p - let back_'a := fun ret => Result.ret ret - let back_'b := fun ret => Result.ret ret - Result.ret ((t, t1), back_'a, back_'b) + Result.ret ((t, t1), Result.ret, Result.ret) /- [no_nested_borrows::StructWithTuple] Source: 'src/no_nested_borrows.rs', lines 433:0-433:34 -/ diff --git a/tests/lean/Paper.lean b/tests/lean/Paper.lean index 015fec84..a35c8db0 100644 --- a/tests/lean/Paper.lean +++ b/tests/lean/Paper.lean @@ -95,13 +95,12 @@ divergent def sum (l : List I32) : Result I32 := Source: 'src/paper.rs', lines 68:0-68:17 -/ def test_nth : Result Unit := do - let l := List.Nil - let l1 := List.Cons 3#i32 l - let l2 := List.Cons 2#i32 l1 - let (x, list_nth_mut_back) ← list_nth_mut I32 (List.Cons 1#i32 l2) 2#u32 + let l := List.Cons 3#i32 List.Nil + let l1 := List.Cons 2#i32 l + let (x, list_nth_mut_back) ← list_nth_mut I32 (List.Cons 1#i32 l1) 2#u32 let x1 ← x + 1#i32 - let l3 ← list_nth_mut_back x1 - let i ← sum l3 + let l2 ← list_nth_mut_back x1 + let i ← sum l2 if not (i = 7#i32) then Result.fail .panic else Result.ret () diff --git a/tests/lean/PoloniusList.lean b/tests/lean/PoloniusList.lean index a485adbe..59c557a0 100644 --- a/tests/lean/PoloniusList.lean +++ b/tests/lean/PoloniusList.lean @@ -20,9 +20,7 @@ divergent def get_list_at_x match ls with | List.Cons hd tl => if hd = x - then - let back_'a := fun ret => Result.ret ret - Result.ret (List.Cons hd tl, back_'a) + then Result.ret (List.Cons hd tl, Result.ret) else do let (l, get_list_at_x_back) ← get_list_at_x tl x @@ -32,8 +30,6 @@ divergent def get_list_at_x let tl1 ← get_list_at_x_back ret Result.ret (List.Cons hd tl1) Result.ret (l, back_'a) - | List.Nil => - let back_'a := fun ret => Result.ret ret - Result.ret (List.Nil, back_'a) + | List.Nil => Result.ret (List.Nil, Result.ret) end polonius_list diff --git a/tests/lean/Traits.lean b/tests/lean/Traits.lean index 63d07d85..35f9e5bf 100644 --- a/tests/lean/Traits.lean +++ b/tests/lean/Traits.lean @@ -288,8 +288,7 @@ def use_with_const_ty1 (H : Type) (LEN : Usize) (WithConstTyHLENInst : WithConstTy H LEN) : Result Usize := - let i := WithConstTyHLENInst.LEN1 - Result.ret i + Result.ret WithConstTyHLENInst.LEN1 /- [traits::use_with_const_ty2]: Source: 'src/traits.rs', lines 187:0-187:73 -/ -- cgit v1.2.3 From a52939b5119e2751570582533bf27828724c2e9f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 01:18:37 +0100 Subject: Fix an issue when deconstructing tuples in Coq --- compiler/Extract.ml | 10 ++++++++-- compiler/Main.ml | 3 --- tests/coq/misc/Loops.v | 4 ++-- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 30b76ceb..87dcb1fd 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -132,9 +132,15 @@ let extract_adt_g_value F.pp_print_string fmt "tt"; ctx) else - (* If there is exactly one value, we don't print the parentheses *) + (* If there is exactly one value, we don't print the parentheses. + Also, for Coq, we need the special syntax ['(...)] if we destruct + a tuple pattern in a let-binding and the tuple has > 2 values. + *) let lb, rb = - if List.length field_values = 1 then ("", "") else ("(", ")") + if List.length field_values = 1 then ("", "") + else if !backend = Coq && is_single_pat && List.length field_values > 2 + then ("'(", ")") + else ("(", ")") in F.pp_print_string fmt lb; let ctx = diff --git a/compiler/Main.ml b/compiler/Main.ml index abc27b46..0b8ec439 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -196,9 +196,6 @@ let () = let _ = match !backend with | FStar -> - (* Some patterns are not supported *) - decompose_monadic_let_bindings := false; - decompose_nested_let_patterns := false; (* F* can disambiguate the field names *) record_fields_short_names := true | Coq -> diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v index cc76f359..af920d41 100644 --- a/tests/coq/misc/Loops.v +++ b/tests/coq/misc/Loops.v @@ -358,7 +358,7 @@ Fixpoint list_nth_mut_loop_pair_loop else ( i1 <- u32_sub i 1%u32; t <- list_nth_mut_loop_pair_loop T n1 tl0 tl1 i1; - let (p, back_'a, back_'b) := t in + let '(p, back_'a, back_'b) := t in let back_'a1 := fun (ret : T) => tl01 <- back_'a ret; Return (List_Cons x0 tl01) in let back_'b1 := @@ -378,7 +378,7 @@ Definition list_nth_mut_loop_pair result ((T * T) * (T -> result (List_t T)) * (T -> result (List_t T))) := t <- list_nth_mut_loop_pair_loop T n ls0 ls1 i; - let (p, back_'a, back_'b) := t in + let '(p, back_'a, back_'b) := t in Return (p, back_'a, back_'b) . -- cgit v1.2.3 From d178a184142ad5edd9735149ecba385f6721c3bf Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 01:20:48 +0100 Subject: Fix an issue in External_FunsExternal.v --- tests/coq/misc/External_FunsExternal.v | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/tests/coq/misc/External_FunsExternal.v b/tests/coq/misc/External_FunsExternal.v index a8c5756a..e9655f57 100644 --- a/tests/coq/misc/External_FunsExternal.v +++ b/tests/coq/misc/External_FunsExternal.v @@ -10,22 +10,10 @@ Require Export External_Types. Include External_Types. Module External_FunsExternal. -(** [core::mem::swap]: forward function +(** [core::mem::swap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) -Axiom core_mem_swap : - forall(T : Type), T -> T -> state -> result (state * unit) -. - -(** [core::mem::swap]: backward function 0 - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) -Axiom core_mem_swap_back0 : - forall(T : Type), T -> T -> state -> state -> result (state * T) -. - -(** [core::mem::swap]: backward function 1 - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) -Axiom core_mem_swap_back1 : - forall(T : Type), T -> T -> state -> state -> result (state * T) +Definition core_mem_swap (T : Type) (x : T) (y : T) (s : state) := + Return (s, (y, x)) . (** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function -- cgit v1.2.3 From 802e3e4a9c306d4de421535a9a013e6d31f9c981 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 01:22:49 +0100 Subject: Update the flake.lock --- flake.lock | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/flake.lock b/flake.lock index f872fad8..2a3cf2c1 100644 --- a/flake.lock +++ b/flake.lock @@ -8,11 +8,11 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1702482915, - "narHash": "sha256-7m3O/qioAomxAq5C/MyFro6WqnKB++o881EGfLJIx1w=", + "lastModified": 1703290921, + "narHash": "sha256-Jbf7JETi3XHLV19pDz8AT/Gyu8PpEfZhxO7T4W94uws=", "owner": "aeneasverif", "repo": "charon", - "rev": "6fc644e4ffcac98b46fc8a361f13cc7d23338ed2", + "rev": "f91d9d16520f0615047ccdf98b654cf47a10b0ce", "type": "github" }, "original": { @@ -131,11 +131,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1702080800, - "narHash": "sha256-PbuXUutqI5iE0ZFCJPWjgfxYjonX9Pkw/qtpLMLwXuI=", + "lastModified": 1703180293, + "narHash": "sha256-zQPEPf1Q3Z4Wt86Bef9czyKfff8r8vr2LEsfR5qxoaU=", "owner": "fstarlang", "repo": "fstar", - "rev": "178e0f872b6a7540d6024b49c7c04ba451f7c4c7", + "rev": "0806a005a879f256ff5af6736fbea4d45ea6f6ca", "type": "github" }, "original": { @@ -164,11 +164,11 @@ ] }, "locked": { - "lastModified": 1701972757, - "narHash": "sha256-sfzmasc8uIc2COYC8xm1bchmNAV5+W8gkflUVzzBDms=", + "lastModified": 1703047078, + "narHash": "sha256-LbEoFtOMFB1LVAV4O4WvOvKNjT5QTQo44mkwbzTaA2A=", "owner": "hacl-star", "repo": "hacl-star", - "rev": "f280ff8fe0f285edcc25c35a811dea0c233e3482", + "rev": "1e571f77e1752449d48fe7361787cc7d01f93a49", "type": "github" }, "original": { @@ -194,11 +194,11 @@ ] }, "locked": { - "lastModified": 1702084487, - "narHash": "sha256-4P2DOWqCbx5lcMdU6gMskIs9gvOiO3ZpGBMeqNhrva0=", + "lastModified": 1703207646, + "narHash": "sha256-ZM7WeH5Inwottbxefjn0Acw3z6Q/iarkqldbTWt/2lQ=", "owner": "hacl-star", "repo": "hacl-nix", - "rev": "44aad8f5d2880e8b8fac54e4ba9cbdb315282751", + "rev": "31e836f69da3cddbc1d3324de40b4901a69de320", "type": "github" }, "original": { @@ -223,11 +223,11 @@ ] }, "locked": { - "lastModified": 1701984397, - "narHash": "sha256-uR77IRrczr80J7LyFIeTrfueh8+AfBecZDDo+Pfl/a4=", + "lastModified": 1702906344, + "narHash": "sha256-bfg18GolyW8/LcmUKh/bwryMjSQCR6GaGVuKmJIdBwQ=", "owner": "fstarlang", "repo": "karamel", - "rev": "ed6d9729569515ce55c683ebd10449543610624e", + "rev": "67b19d9a05f6578aec0b640fcb6e432ff18daa71", "type": "github" }, "original": { @@ -265,11 +265,11 @@ "nixpkgs": "nixpkgs_4" }, "locked": { - "lastModified": 1702475419, - "narHash": "sha256-2K+XqLUgXHuyibMuNkrRqPVTgrMAE3X7IiO00KPjaWE=", + "lastModified": 1703256773, + "narHash": "sha256-HuiHOhvfNVaJAOgpSMpUp24YcYxuRWMt7X77bT+sNAg=", "owner": "leanprover", "repo": "lean4", - "rev": "b5b664e570f8e6a112b8491bccf58b58fe2d916b", + "rev": "7c38649527c85116345df831254985afa2680dd0", "type": "github" }, "original": { @@ -318,11 +318,11 @@ "nixpkgs": "nixpkgs_7" }, "locked": { - "lastModified": 1702475419, - "narHash": "sha256-2K+XqLUgXHuyibMuNkrRqPVTgrMAE3X7IiO00KPjaWE=", + "lastModified": 1703256773, + "narHash": "sha256-HuiHOhvfNVaJAOgpSMpUp24YcYxuRWMt7X77bT+sNAg=", "owner": "leanprover", "repo": "lean4", - "rev": "b5b664e570f8e6a112b8491bccf58b58fe2d916b", + "rev": "7c38649527c85116345df831254985afa2680dd0", "type": "github" }, "original": { -- cgit v1.2.3 From 63ccbd914d5d44aa30dee38a6fcc019310ab640b Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 23 Dec 2023 01:31:14 +0100 Subject: Update the Makefile --- Makefile | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 3ea8cda3..8d49a200 100644 --- a/Makefile +++ b/Makefile @@ -330,7 +330,8 @@ thol4p-%: # Nix - TODO: add the lean tests .PHONY: nix -nix: nix-aeneas-tests nix-aeneas-verify-fstar nix-aeneas-verify-coq nix-aeneas-verify-hol4 +nix: + nix build && nix flake check .PHONY: nix-aeneas-tests nix-aeneas-tests: @@ -340,6 +341,10 @@ nix-aeneas-tests: nix-aeneas-verify-fstar: nix build .#checks.x86_64-linux.aeneas-verify-fstar --show-trace -L +.PHONY: nix-aeneas-verify-fstar-split +nix-aeneas-verify-fstar-split: + nix build .#checks.x86_64-linux.aeneas-verify-fstar-split --show-trace -L + .PHONY: nix-aeneas-verify-coq nix-aeneas-verify-coq: nix build .#checks.x86_64-linux.aeneas-verify-coq --show-trace -L -- cgit v1.2.3