From 99ac6bcd43a0c61d6d8b95b5684f06b4c0032960 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 10:10:09 +0000 Subject: [PATCH 01/29] Slightly simplify InterpreterBorrows.ml --- src/interp/InterpreterBorrows.ml | 41 +++++++++++--------------------- 1 file changed, 14 insertions(+), 27 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index c366c64d..6f5cf68d 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -26,13 +26,9 @@ let log = Logging.borrows_log allows us to use {!end_borrow_aux} as an auxiliary function for {!end_abstraction_aux} (we end all the borrows in the abstraction one by one before removing the abstraction from the context). - - [allow_inner_loans]: if [true], allow to end borrows containing inner - loans. This is used to merge borrows with abstractions, to compute loop - fixed points for instance. *) let end_borrow_get_borrow (span : Meta.span) - (allowed_abs : AbstractionId.id option) (allow_inner_loans : bool) - (l : BorrowId.id) (ctx : eval_ctx) : + (allowed_abs : AbstractionId.id option) (l : BorrowId.id) (ctx : eval_ctx) : ( eval_ctx * (AbstractionId.id option * g_borrow_content) option, priority_borrows_or_abs ) result = @@ -70,18 +66,16 @@ let end_borrow_get_borrow (span : Meta.span) | Some borrows -> raise (FoundPriority (OuterBorrows borrows)) | None -> ())); (* Then check if there are inner loans *) - if not allow_inner_loans then - match borrowed_value with - | None -> () - | Some v -> ( - match get_first_loan_in_value v with - | None -> () - | Some c -> ( - match c with - | VSharedLoan (bids, _) -> - raise (FoundPriority (InnerLoans (Borrows bids))) - | VMutLoan bid -> raise (FoundPriority (InnerLoans (Borrow bid)))) - ) + match borrowed_value with + | None -> () + | Some v -> ( + match get_first_loan_in_value v with + | None -> () + | Some c -> ( + match c with + | VSharedLoan (bids, _) -> + raise (FoundPriority (InnerLoans (Borrows bids))) + | VMutLoan bid -> raise (FoundPriority (InnerLoans (Borrow bid))))) in (* The environment is used to keep track of the outer loans *) @@ -907,8 +901,7 @@ let rec end_borrow_aux (config : config) (span : Meta.span) let ctx0 = ctx in let check = check_borrow_disappeared span "end borrow" l ctx0 in (* Start by ending the borrow itself (we lookup it up and replace it with [Bottom] *) - let allow_inner_loans = false in - match end_borrow_get_borrow span allowed_abs allow_inner_loans l ctx with + match end_borrow_get_borrow span allowed_abs l ctx with (* Two cases: - error: we found outer borrows (the borrow is inside a borrowed value) or inner loans (the borrow contains loans) @@ -1306,20 +1299,14 @@ and end_abstraction_borrows (config : config) (span : Meta.span) match bc with | VSharedBorrow bid -> ( (* Replace the shared borrow with bottom *) - let allow_inner_loans = false in - match - end_borrow_get_borrow span (Some abs_id) allow_inner_loans bid ctx - with + match end_borrow_get_borrow span (Some abs_id) bid ctx with | Error _ -> craise __FILE__ __LINE__ span "Unreachable" | Ok (ctx, _) -> (* Give back *) give_back_shared config span bid ctx) | VMutBorrow (bid, v) -> ( (* Replace the mut borrow with bottom *) - let allow_inner_loans = false in - match - end_borrow_get_borrow span (Some abs_id) allow_inner_loans bid ctx - with + match end_borrow_get_borrow span (Some abs_id) bid ctx with | Error _ -> craise __FILE__ __LINE__ span "Unreachable" | Ok (ctx, _) -> (* Give the value back - note that the mut borrow was below a From a7414e8fed434383fb0f04ede7ee10d8bbd0a6bf Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 10:44:45 +0000 Subject: [PATCH 02/29] Do more cleanup --- src/interp/InterpreterBorrows.ml | 44 +++++++++++++++------------- src/interp/InterpreterBorrowsCore.ml | 6 ++-- 2 files changed, 26 insertions(+), 24 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 6f5cf68d..14f9190d 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -26,6 +26,8 @@ let log = Logging.borrows_log allows us to use {!end_borrow_aux} as an auxiliary function for {!end_abstraction_aux} (we end all the borrows in the abstraction one by one before removing the abstraction from the context). + We use this to end shared borrows and mutable borrows inside of **shared values**; + the other borrows are taken care of differently. *) let end_borrow_get_borrow (span : Meta.span) (allowed_abs : AbstractionId.id option) (l : BorrowId.id) (ctx : eval_ctx) : @@ -78,8 +80,8 @@ let end_borrow_get_borrow (span : Meta.span) | VMutLoan bid -> raise (FoundPriority (InnerLoans (Borrow bid))))) in - (* The environment is used to keep track of the outer loans *) - let obj = + (* The environment in the visitor is used to keep track of the outer loans *) + let visitor = object inherit [_] map_eval_ctx as super @@ -231,7 +233,7 @@ let end_borrow_get_borrow (span : Meta.span) in (* Catch the exceptions - raised if there are outer borrows *) try - let ctx = obj#visit_eval_ctx (None, None) ctx in + let ctx = visitor#visit_eval_ctx (None, None) ctx in Ok (ctx, !replaced_bc) with FoundPriority outers -> Error outers @@ -294,7 +296,7 @@ let give_back_value (config : config) (span : Meta.span) (bid : BorrowId.id) match lc with | VSharedLoan (bids, v) -> (* We are giving back a value (i.e., the content of a *mutable* - * borrow): nothing special to do *) + borrow): nothing special to do *) VLoan (super#visit_VSharedLoan opt_abs bids v) | VMutLoan bid' -> (* Check if this is the loan we are looking for *) @@ -1013,10 +1015,10 @@ and end_abstraction_aux (config : config) (span : Meta.span) ^ "\n- original context:\n" ^ eval_ctx_to_string ~span:(Some span) ctx0)); - (* Lookup the abstraction - note that if we end a list of abstractions, - ending one abstraction may lead to the current abstraction having - preemptively been ended, so the abstraction might not be in the context - anymore. *) + (* Lookup the abstraction - note that if we end a list of abstractions [A1, A0], + ending the first abstraction A1 may require the last abstraction A0 to + end first, so when reaching the end of the list, A0 might not be in the + context anymore, meaning we have to simply ignore it. *) match ctx_lookup_abs_opt ctx abs_id with | None -> log#ldebug @@ -1155,21 +1157,21 @@ and end_abstraction_borrows (config : config) (span : Meta.span) initially replaced the ended mut borrows with ⊥). *) (* We explore in-depth and use exceptions. When exploring a borrow, if - * the exploration didn't trigger an exception, it means there are no - * inner borrows to end: we can thus trigger an exception for the current - * borrow. - * - * TODO: there should be a function in InterpreterBorrowsCore which does just - * that. - *) - let obj = + the exploration didn't trigger an exception, it means there are no + inner borrows to end: we can thus trigger an exception for the current + borrow. + + TODO: we should implement a function in InterpreterBorrowsCore to do + exactly that. + *) + let visitor = object inherit [_] iter_abs as super method! visit_aborrow_content env bc = (* In-depth exploration *) super#visit_aborrow_content env bc; - (* No exception was raise: we can raise an exception for the + (* No exception was raised: we can raise an exception for the * current borrow *) match bc with | AMutBorrow _ | ASharedBorrow _ -> @@ -1211,11 +1213,11 @@ and end_abstraction_borrows (config : config) (span : Meta.span) let abs = ctx_lookup_abs ctx abs_id in try (* Explore the abstraction, looking for borrows *) - obj#visit_abs () abs; + visitor#visit_abs () abs; (* No borrows: nothing to update *) (ctx, fun e -> e) with - (* There are concrete (i.e., not symbolic) borrows: end them, then reexplore *) + (* There are concrete (i.e., not symbolic) borrows: end them, then re-explore *) | FoundABorrowContent bc -> log#ldebug (lazy @@ -1228,7 +1230,7 @@ and end_abstraction_borrows (config : config) (span : Meta.span) (* First, convert the avalue to a (fresh symbolic) value *) let sv = convert_avalue_to_given_back_value span av in (* Replace the mut borrow to register the fact that we ended - * it and store with it the freshly generated given back value *) + it and store with it the freshly generated given back value *) let ended_borrow = ABorrow (AEndedMutBorrow (sv, av)) in let ctx = update_aborrow span ek_all bid ended_borrow ctx in (* Give the value back *) @@ -1252,7 +1254,7 @@ and end_abstraction_borrows (config : config) (span : Meta.span) asb in (* There should be at least one borrow identifier in the set, which we - * can use to identify the whole set *) + can use to identify the whole set *) let repr_bid = List.hd bids in (* Replace the shared borrow with Bottom *) let ctx = update_aborrow span ek_all repr_bid ABottom ctx in diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index 2b71f013..1485906b 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -563,13 +563,13 @@ let update_borrow (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) The borrow is referred to by a borrow id. - This is a helper function: it might break invariants. + This is a helper function: **it might break invariants**. *) let update_aborrow (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) (nv : avalue) (ctx : eval_ctx) : eval_ctx = (* We use a reference to check that we update exactly one borrow: when updating - * inside values, we check we don't update more than one borrow. Then, upon - * returning we check that we updated at least once. *) + inside values, we check we don't update more than one borrow. Then, upon + returning we check that we updated at least once. *) let r = ref false in let update () : avalue = sanity_check __FILE__ __LINE__ (not !r) span; From 4324c662a0ad4cee6dda01c46bbf39496096eaa4 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 14:19:47 +0000 Subject: [PATCH 03/29] Fix an issue in InterpreterStatements.pop_frame --- src/interp/InterpreterStatements.ml | 38 ++++++++++++++--------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/interp/InterpreterStatements.ml b/src/interp/InterpreterStatements.ml index 73748081..e9c91478 100644 --- a/src/interp/InterpreterStatements.ml +++ b/src/interp/InterpreterStatements.ml @@ -334,8 +334,26 @@ let pop_frame (config : config) (span : Meta.span) (pop_return_value : bool) ^ String.concat "," (List.map VarId.to_string locals) ^ "]")); + (* Drop the outer *loans* we find in the local variables *) + let ctx, cc = + (* Drop the loans *) + let locals = List.rev locals in + fold_left_apply_continuation + (fun lid ctx -> + drop_outer_loans_at_lplace config span + (mk_place_from_var_id ctx span lid) + ctx) + locals ctx + in + (* Debug *) + log#ldebug + (lazy + ("pop_frame: after dropping outer loans in local variables:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); + (* Move the return value out of the return variable *) - let v, ctx, cc = move_return_value config span pop_return_value ctx in + let v, ctx, cc1 = move_return_value config span pop_return_value ctx in + let cc = cc_comp cc cc1 in let _ = match v with | None -> () @@ -345,24 +363,6 @@ let pop_frame (config : config) (span : Meta.span) (pop_return_value : bool) span in - (* Drop the outer *loans* we find in the local variables *) - let ctx, cc = - comp cc - ((* Drop the loans *) - let locals = List.rev locals in - fold_left_apply_continuation - (fun lid ctx -> - drop_outer_loans_at_lplace config span - (mk_place_from_var_id ctx span lid) - ctx) - locals ctx) - in - (* Debug *) - log#ldebug - (lazy - ("pop_frame: after dropping outer loans in local variables:\n" - ^ eval_ctx_to_string ~span:(Some span) ctx)); - (* Pop the frame - we remove the [Frame] delimiter, and reintroduce all * the local variables (which may still contain borrow permissions - but * no outer loans) as dummy variables in the caller frame *) From 7560e966cdf2fa09fb2c4acbf0185fa18fb63d16 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 14:20:26 +0000 Subject: [PATCH 04/29] Update the handling of borrow and loan projectors --- src/interp/InterpreterBorrows.ml | 152 +++++++++++++++++++++------ src/interp/InterpreterBorrowsCore.ml | 152 +++++++++++++++------------ src/interp/InterpreterExpansion.ml | 35 ++++-- src/interp/InterpreterProjectors.ml | 2 +- src/interp/InterpreterUtils.ml | 11 +- src/interp/Invariants.ml | 12 +-- src/llbc/Print.ml | 20 +++- src/llbc/Values.ml | 29 +++-- src/symbolic/SymbolicToPure.ml | 13 ++- 9 files changed, 289 insertions(+), 137 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 14f9190d..75ced7ad 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -448,9 +448,75 @@ let give_back_value (config : config) (span : Meta.span) (bid : BorrowId.id) (* Apply the reborrows *) apply_registered_reborrows ctx +(** Update the borrow projectors upon ending some regions in a symbolic value. + + Because doing this introduces a fresh symbolic value which may contain + borrows, we may need to update the proj_borrows to introduce loan projectors + over those borrows. + *) +let end_aproj_borrows (span : Meta.span) (ended_regions : RegionId.Set.t) + (proj_ty : rty) (sv : symbolic_value) (nsv : symbolic_value) + (ctx : eval_ctx) : eval_ctx = + (* Sanity checks *) + sanity_check __FILE__ __LINE__ + (sv.sv_id <> nsv.sv_id && ty_is_rty proj_ty) + span; + (* Store the given-back value as a meta-value for synthesis purposes *) + let mv = nsv in + (* Substitution functions, to replace the borrow projectors over symbolic values *) + (* We need to handle two cases: + - If the regions ended in the symbolic value intersect with the owned + regions of the abstraction (not the ancestor ones): we can simply end the + borrow projector, there is nothing left to track anymore. + + Ex.: we are ending abs1 below: + {[ + abs0 {'a} { AProjLoans (s0 : &'a mut T) [] } + abs1 {'b} { AProjBorrows (s0 : &'a mut T <: &'b mut T) } + ]} + - if the regions ended in the symbolic value intersect with the ancestors + regions of the abstraction, we have to introduce a projection + (because it means we ended ancestor "outer" borrows, and so we need + to project the given back inner loans into the abstraction). + + Ex.: we are ending abs2 below, and considering abs1: we have to project + the inner loans inside of abs3. However we do not project anything + into abs2 (see the case above). + {[ + abs0 {'a} { AProjLoans (s0 : &'a mut &'b mut T) [] } + abs1 {'b} { AProjLoans (s0 : &'a mut &'b mut T) [] } + abs2 {'c} { AProjBorrows (s0 : &'a mut &'b mut T <: &'c mut T &'d mut T) } + abs3 {'d} { AProjBorrows (s0 : &'a mut &'b mut T <: &'c mut T &'d mut T) } + ]} + + We proceed in two steps: + - we first update when intersecting with ancestors regions + - then we update when intersecting with owned regions + *) + let update_ancestors (_abs : abs) (abs_sv : symbolic_value) + (abs_proj_ty : rty) (local_given_back : (msymbolic_value * aproj) list) : + aproj = + (* Compute the projection over the given back value *) + let child_proj = AProjLoans (nsv, []) in + AProjBorrows (abs_sv, abs_proj_ty, (mv, child_proj) :: local_given_back) + in + let ctx = + update_intersecting_aproj_borrows span ~include_ancestors:true + ~include_owned:false ~update_shared:None ~update_mut:update_ancestors + ended_regions sv ctx + in + let update_owned (_abs : abs) (_abs_sv : symbolic_value) (_abs_proj_ty : rty) + (local_given_back : (msymbolic_value * aproj) list) : aproj = + (* There is nothing to project *) + AEndedProjBorrows (mv, local_given_back) + in + update_intersecting_aproj_borrows span ~include_ancestors:false + ~include_owned:true ~update_shared:None ~update_mut:update_owned + ended_regions sv ctx + (** Give back a *modified* symbolic value. *) let give_back_symbolic_value (_config : config) (span : Meta.span) - (proj_regions : RegionId.Set.t) (proj_ty : rty) (sv : symbolic_value) + (ended_regions : RegionId.Set.t) (proj_ty : rty) (sv : symbolic_value) (nsv : symbolic_value) (ctx : eval_ctx) : eval_ctx = (* Sanity checks *) sanity_check __FILE__ __LINE__ @@ -458,30 +524,53 @@ let give_back_symbolic_value (_config : config) (span : Meta.span) span; (* Store the given-back value as a meta-value for synthesis purposes *) let mv = nsv in - (* Substitution function, to replace the borrow projectors over symbolic values *) - let subst (_abs : abs) local_given_back = - (* See the below comments: there is something wrong here *) - let _ = raise Utils.Unimplemented in + (* Substitution functions, to replace the borrow projectors over symbolic values *) + (* We need to handle two cases: + - If the regions ended in the symbolic value intersect with the owned + regions of the abstraction (not the ancestor ones): we can simply end the + loan, there is nothing left to track anymore. + + Ex.: we are ending abs1 below: + {[ + abs0 {'a} { AProjLoans (s0 : &'a mut T) [] } + abs1 {'b} { AProjBorrows (s0 : &'a mut T <: &'b mut T) } + ]} + - if the regions ended in the symbolic value intersect with the ancestors + regions of the abstraction, we have to introduce a projection + (because it means we ended ancestor "outer" borrows, and so we need + to project the given back inner borrows into the abstraction). + + + Ex.: we are ending abs2 below, and considering abs1: we have to project + the inner borrows inside of abs1. However we do not project anything + into abs0 (see the case above). + {[ + abs0 {'a} { AProjLoans (s0 : &'a mut &'b mut T) [] } + abs1 {'b} { AProjLoans (s0 : &'a mut &'b mut T) [] } + abs2 {'c} { AProjBorrows (s0 : &'a mut &'b mut T <: &'c mut T &'d mut T) } + abs3 {'d} { AProjBorrows (s0 : &'a mut &'b mut T <: &'c mut T &'d mut T) } + ]} + + We proceed in two steps: + - we first update when intersecting with ancestors regions + - then we update when intersecting with owned regions + *) + let subst_ancestors (_abs : abs) local_given_back = (* Compute the projection over the given back value *) - let child_proj = - (* TODO: there is something wrong here. - Consider this: - {[ - abs0 {'a} { AProjLoans (s0 : &'a mut T) [] } - abs1 {'b} { AProjBorrows (s0 : &'a mut T <: &'b mut T) } - ]} - - Upon ending abs1, we give back some fresh symbolic value [s1], - that we reinsert where the loan for [s0] is. However, the mutable - borrow in the type [&'a mut T] was ended: we give back a value of - type [T]! We thus *mustn't* introduce a projector here. - *) - (* AProjBorrows (nsv, sv.sv_ty) *) - internal_error __FILE__ __LINE__ span - in + let child_proj = AProjBorrows (nsv, sv.sv_ty, []) in + AProjLoans (sv, (mv, child_proj) :: local_given_back) + in + let ctx = + update_intersecting_aproj_loans span ~include_ancestors:true + ~include_owned:false ended_regions proj_ty sv subst_ancestors ctx + in + let subst_owned (_abs : abs) local_given_back = + (* There is nothing to project *) + let child_proj = AEmpty in AProjLoans (sv, (mv, child_proj) :: local_given_back) in - update_intersecting_aproj_loans span proj_regions proj_ty sv subst ctx + update_intersecting_aproj_loans span ~include_ancestors:false + ~include_owned:true ended_regions proj_ty sv subst_owned ctx (** Auxiliary function to end borrows. See {!give_back}. @@ -1198,8 +1287,9 @@ and end_abstraction_borrows (config : config) (span : Meta.span) method! visit_aproj env sproj = (match sproj with | AProjLoans _ -> craise __FILE__ __LINE__ span "Unexpected" - | AProjBorrows (sv, proj_ty) -> raise (FoundAProjBorrows (sv, proj_ty)) - | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); + | AProjBorrows (sv, proj_ty, given_back) -> + raise (FoundAProjBorrows (sv, proj_ty, given_back)) + | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj env sproj (** We may need to end borrows in "regular" values, because of shared values *) @@ -1274,16 +1364,15 @@ and end_abstraction_borrows (config : config) (span : Meta.span) (* Reexplore *) end_abstraction_borrows config span chain abs_id ctx (* There are symbolic borrows: end them, then reexplore *) - | FoundAProjBorrows (sv, proj_ty) -> + | FoundAProjBorrows (sv, proj_ty, given_back) -> log#ldebug (lazy ("end_abstraction_borrows: found aproj borrows: " - ^ aproj_to_string ctx (AProjBorrows (sv, proj_ty)))); + ^ aproj_to_string ctx (AProjBorrows (sv, proj_ty, given_back)))); (* Generate a fresh symbolic value *) let nsv = mk_fresh_symbolic_value span proj_ty in (* Replace the proj_borrows - there should be exactly one *) - let ended_borrow = AEndedProjBorrows nsv in - let ctx = update_aproj_borrows span abs.abs_id sv ended_borrow ctx in + let ctx = end_aproj_borrows span abs.regions.owned proj_ty sv nsv ctx in (* Give back the symbolic value *) let ctx = give_back_symbolic_value config span abs.regions.owned proj_ty sv nsv @@ -1329,7 +1418,7 @@ and end_abstraction_remove_from_context (_config : config) (span : Meta.span) (ctx, SynthesizeSymbolic.synthesize_end_abstraction ctx abs) (** End a proj_loan over a symbolic value by ending the proj_borrows which - intersect this proj_loans. + intersect this proj_loan. Rk.: - if this symbolic value is primitively copiable, then: @@ -1407,7 +1496,8 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) let ctx = (* All the proj_borrows are owned: simply erase them *) let ctx = - remove_intersecting_aproj_borrows_shared span regions sv ctx + remove_intersecting_aproj_borrows_shared span ~include_ancestors:false + ~include_owned:true regions sv ctx in (* End the loan itself *) update_aproj_loans_to_ended span abs_id sv ctx @@ -1438,7 +1528,7 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) *) (* End the projector of borrows - TODO: not completely sure what to * replace it with... Maybe we should introduce an ABottomProj? *) - let ctx = update_aproj_borrows span abs_id sv AIgnoredProjBorrows ctx in + let ctx = update_aproj_borrows span abs_id sv AEmpty ctx in (* Sanity check: no other occurrence of an intersecting projector of borrows *) sanity_check __FILE__ __LINE__ (Option.is_none diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index 1485906b..a9ccdf07 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -768,11 +768,8 @@ let lookup_intersecting_aproj_borrows_opt (span : Meta.span) method! visit_aproj abs sproj = (let abs = Option.get abs in match sproj with - | AProjLoans _ - | AEndedProjLoans _ - | AEndedProjBorrows _ - | AIgnoredProjBorrows -> () - | AProjBorrows (sv', proj_rty) -> + | AProjLoans _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> () + | AProjBorrows (sv', proj_rty, _) -> let is_shared = false in check_add_proj_borrows is_shared abs sv' proj_rty); super#visit_aproj abs sproj @@ -807,14 +804,21 @@ let lookup_intersecting_aproj_borrows_not_shared_opt (span : Meta.span) (** Similar to {!lookup_intersecting_aproj_borrows_opt}, but updates the values. - This is a helper function: it might break invariants. + This is a helper function: **it might break invariants**. + + [include_ancestors]: when exploring an abstraction and computing projection + intersections, use the ancestor regions. + [include_owned]: when exploring an abstraction and computing projection + intersections, use the owned regions. *) let update_intersecting_aproj_borrows (span : Meta.span) - (can_update_shared : bool) - (update_shared : AbstractionId.id -> rty -> abstract_shared_borrows) - (update_non_shared : AbstractionId.id -> rty -> aproj) - (regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : eval_ctx - = + ~(include_ancestors : bool) ~(include_owned : bool) + ~(update_shared : + (abs -> symbolic_value -> rty -> abstract_shared_borrows) option) + ~(update_mut : + abs -> symbolic_value -> rty -> (msymbolic_value * aproj) list -> aproj) + (proj_regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : + eval_ctx = (* Small helpers for sanity checks *) let shared = ref None in let add_shared () = @@ -830,10 +834,18 @@ let update_intersecting_aproj_borrows (span : Meta.span) "Found unexpected intersecting proj_borrows" in let check_proj_borrows is_shared abs sv' proj_ty = + let intersect_regions = + let intersect_regions = + if include_ancestors then abs.regions.ancestors else RegionId.Set.empty + in + if include_owned then + RegionId.Set.union abs.regions.owned intersect_regions + else intersect_regions + in if proj_borrows_intersects_proj_loans span - (abs.regions.owned, sv', proj_ty) - (regions, sv) + (intersect_regions, sv', proj_ty) + (proj_regions, sv) then ( if is_shared then add_shared () else set_non_shared (); true) @@ -851,31 +863,31 @@ let update_intersecting_aproj_borrows (span : Meta.span) | Some b -> sanity_check __FILE__ __LINE__ b span | _ -> ()); (* Explore *) - if can_update_shared then - let abs = Option.get abs in - let update (asb : abstract_shared_borrow) : abstract_shared_borrows = - match asb with - | AsbBorrow _ -> [ asb ] - | AsbProjReborrows (sv', proj_ty) -> - let is_shared = true in - if check_proj_borrows is_shared abs sv' proj_ty then - update_shared abs.abs_id proj_ty - else [ asb ] - in - List.concat (List.map update asb) - else asb + match update_shared with + | Some update_shared -> + let abs = Option.get abs in + let update (asb : abstract_shared_borrow) : abstract_shared_borrows + = + match asb with + | AsbBorrow _ -> [ asb ] + | AsbProjReborrows (sv', proj_ty) -> + let is_shared = true in + if check_proj_borrows is_shared abs sv' proj_ty then + update_shared abs sv' proj_ty + else [ asb ] + in + List.concat (List.map update asb) + | _ -> asb method! visit_aproj abs sproj = match sproj with - | AProjLoans _ - | AEndedProjLoans _ - | AEndedProjBorrows _ - | AIgnoredProjBorrows -> super#visit_aproj abs sproj - | AProjBorrows (sv', proj_rty) -> + | AProjLoans _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> + super#visit_aproj abs sproj + | AProjBorrows (sv', proj_rty, given_back) -> let abs = Option.get abs in let is_shared = true in if check_proj_borrows is_shared abs sv' proj_rty then - update_non_shared abs.abs_id proj_rty + update_mut abs sv' proj_rty given_back else super#visit_aproj (Some abs) sproj end in @@ -894,22 +906,21 @@ let update_intersecting_aproj_borrows (span : Meta.span) This is a helper function: it might break invariants. *) -let update_intersecting_aproj_borrows_non_shared (span : Meta.span) - (regions : RegionId.Set.t) (sv : symbolic_value) (nv : aproj) +let update_intersecting_aproj_borrows_mut (span : Meta.span) + ~(include_ancestors : bool) ~(include_owned : bool) + (proj_regions : RegionId.Set.t) (sv : symbolic_value) (nv : aproj) (ctx : eval_ctx) : eval_ctx = (* Small helpers *) - let can_update_shared = false in - let update_shared _ _ = craise __FILE__ __LINE__ span "Unexpected" in let updated = ref false in - let update_non_shared _ _ = + let update_mut _ _ _ _ = (* We can update more than one borrow! *) updated := true; nv in (* Update *) let ctx = - update_intersecting_aproj_borrows span can_update_shared update_shared - update_non_shared regions sv ctx + update_intersecting_aproj_borrows span ~include_ancestors ~include_owned + ~update_shared:None ~update_mut proj_regions sv ctx in (* Check that we updated at least once *) sanity_check __FILE__ __LINE__ !updated span; @@ -922,15 +933,15 @@ let update_intersecting_aproj_borrows_non_shared (span : Meta.span) This is a helper function: it might break invariants. *) let remove_intersecting_aproj_borrows_shared (span : Meta.span) + ~(include_ancestors : bool) ~(include_owned : bool) (regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : eval_ctx = (* Small helpers *) - let can_update_shared = true in - let update_shared _ _ = [] in - let update_non_shared _ _ = craise __FILE__ __LINE__ span "Unexpected" in + let update_shared = Some (fun _ _ _ -> []) in + let update_mut _ _ = craise __FILE__ __LINE__ span "Unexpected" in (* Update *) - update_intersecting_aproj_borrows span can_update_shared update_shared - update_non_shared regions sv ctx + update_intersecting_aproj_borrows span ~include_ancestors ~include_owned + ~update_shared ~update_mut regions sv ctx (** Updates the proj_loans intersecting some projection. @@ -962,8 +973,14 @@ let remove_intersecting_aproj_borrows_shared (span : Meta.span) loans where we perform the substitution (see the fields in {!Values.AProjLoans}). Note that the symbolic value at this place is necessarily equal to [sv], which is why we don't give it as parameters. + + [include_ancestors]: when exploring an abstraction and computing projection + intersections, use the ancestor regions. + [include_owned]: when exploring an abstraction and computing projection + intersections, use the owned regions. *) let update_intersecting_aproj_loans (span : Meta.span) + ~(include_ancestors : bool) ~(include_owned : bool) (proj_regions : RegionId.Set.t) (proj_ty : rty) (sv : symbolic_value) (subst : abs -> (msymbolic_value * aproj) list -> aproj) (ctx : eval_ctx) : eval_ctx = @@ -984,17 +1001,26 @@ let update_intersecting_aproj_loans (span : Meta.span) method! visit_aproj abs sproj = match sproj with - | AProjBorrows _ - | AEndedProjLoans _ - | AEndedProjBorrows _ - | AIgnoredProjBorrows -> super#visit_aproj abs sproj + | AProjBorrows _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> + super#visit_aproj abs sproj | AProjLoans (sv', given_back) -> let abs = Option.get abs in if same_symbolic_id sv sv' then ( sanity_check __FILE__ __LINE__ (sv.sv_ty = sv'.sv_ty) span; + let regions = RegionId.Set.empty in + let regions = + if include_ancestors then + RegionId.Set.union abs.regions.ancestors regions + else regions + in + let regions = + if include_owned then + RegionId.Set.union abs.regions.owned regions + else regions + in if projections_intersect span proj_ty proj_regions sv'.sv_ty - abs.regions.owned + regions then update abs given_back else super#visit_aproj (Some abs) sproj) else super#visit_aproj (Some abs) sproj @@ -1036,10 +1062,8 @@ let lookup_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) method! visit_aproj (abs : abs option) sproj = (match sproj with - | AProjBorrows _ - | AEndedProjLoans _ - | AEndedProjBorrows _ - | AIgnoredProjBorrows -> super#visit_aproj abs sproj + | AProjBorrows _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> + super#visit_aproj abs sproj | AProjLoans (sv', given_back) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; @@ -1083,10 +1107,8 @@ let update_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) method! visit_aproj (abs : abs option) sproj = match sproj with - | AProjBorrows _ - | AEndedProjLoans _ - | AEndedProjBorrows _ - | AIgnoredProjBorrows -> super#visit_aproj abs sproj + | AProjBorrows _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> + super#visit_aproj abs sproj | AProjLoans (sv', _) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; @@ -1133,11 +1155,9 @@ let update_aproj_borrows (span : Meta.span) (abs_id : AbstractionId.id) method! visit_aproj (abs : abs option) sproj = match sproj with - | AProjLoans _ - | AEndedProjLoans _ - | AEndedProjBorrows _ - | AIgnoredProjBorrows -> super#visit_aproj abs sproj - | AProjBorrows (sv', _proj_ty) -> + | AProjLoans _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> + super#visit_aproj abs sproj + | AProjBorrows (sv', _proj_ty, _given_back) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; if sv'.sv_id = sv.sv_id then ( @@ -1178,8 +1198,8 @@ let no_aproj_over_symbolic_in_context (span : Meta.span) (sv : symbolic_value) method! visit_aproj env sproj = (match sproj with - | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> () - | AProjLoans (sv', _) | AProjBorrows (sv', _) -> + | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> () + | AProjLoans (sv', _) | AProjBorrows (sv', _, _) -> if sv'.sv_id = sv.sv_id then raise Found else ()); super#visit_aproj env sproj end @@ -1235,8 +1255,8 @@ let get_first_non_ignored_aloan_in_abstraction (span : Meta.span) (abs : abs) : method! visit_aproj env sproj = (match sproj with - | AProjBorrows (_, _) - | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> () + | AProjBorrows (_, _, _) + | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> () | AProjLoans (sv, _) -> raise (ValuesUtils.FoundSymbolicValue sv)); super#visit_aproj env sproj end diff --git a/src/interp/InterpreterExpansion.ml b/src/interp/InterpreterExpansion.ml index e3ada531..b0334e93 100644 --- a/src/interp/InterpreterExpansion.ml +++ b/src/interp/InterpreterExpansion.ml @@ -77,11 +77,11 @@ let apply_symbolic_expansion_to_target_avalues (config : config) *) method! visit_aproj current_abs aproj = (match aproj with - | AProjLoans (sv, _) | AProjBorrows (sv, _) -> + | AProjLoans (sv, _) | AProjBorrows (sv, _, _) -> sanity_check __FILE__ __LINE__ (not (same_symbolic_id sv original_sv)) span - | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); + | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj current_abs aproj method! visit_ASymbolic current_abs aproj = @@ -111,7 +111,13 @@ let apply_symbolic_expansion_to_target_avalues (config : config) else (* Not the searched symbolic value: nothing to do *) super#visit_ASymbolic (Some current_abs) aproj - | AProjBorrows (sv, proj_ty), BorrowProj -> + | AProjBorrows (sv, proj_ty, given_back), BorrowProj -> + (* We should never expand a symbolic value which has consumed given + back values (because then it means the symbolic value was consumed + by region abstractions, and is thus inaccessible: such a value can't + be expanded) + *) + cassert __FILE__ __LINE__ (given_back = []) span "Unreachable"; (* Check if this is the symbolic value we are looking for *) if same_symbolic_id sv original_sv then (* Convert the symbolic expansion to a value on which we can @@ -135,8 +141,8 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (* Not the searched symbolic value: nothing to do *) super#visit_ASymbolic (Some current_abs) aproj | AProjLoans _, BorrowProj - | AProjBorrows (_, _), LoanProj - | AIgnoredProjBorrows, _ -> + | AProjBorrows (_, _, _), LoanProj + | AEmpty, _ -> (* Nothing to do *) ASymbolic aproj end @@ -359,21 +365,27 @@ let expand_symbolic_value_shared_borrow (config : config) (span : Meta.span) *) method! visit_aproj proj_regions aproj = (match aproj with - | AProjLoans (sv, _) | AProjBorrows (sv, _) -> + | AProjLoans (sv, _) | AProjBorrows (sv, _, _) -> sanity_check __FILE__ __LINE__ (not (same_symbolic_id sv original_sv)) span - | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); + | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj proj_regions aproj method! visit_ASymbolic proj_regions aproj = match aproj with - | AEndedProjBorrows _ | AIgnoredProjBorrows -> + | AEndedProjBorrows _ | AEmpty -> (* We ignore borrows *) ASymbolic aproj | AProjLoans _ -> (* Loans are handled later *) ASymbolic aproj - | AProjBorrows (sv, proj_ty) -> ( + | AProjBorrows (sv, proj_ty, given_back) -> ( + (* We should never expand a symbolic value which has consumed given + back values (because then it means the symbolic value was consumed + by region abstractions, and is thus inaccessible: such a value can't + be expanded) + *) + cassert __FILE__ __LINE__ (given_back = []) span "Unreachable"; (* Check if we need to reborrow *) match reborrow_ashared (Option.get proj_regions) sv proj_ty with | None -> super#visit_ASymbolic proj_regions aproj @@ -609,7 +621,10 @@ let greedy_expand_symbolics_with_borrows (config : config) (span : Meta.span) : method! visit_VSymbolic _ sv = if ty_has_borrows (Some span) ctx.type_ctx.type_infos sv.sv_ty then - raise (FoundSymbolicValue sv) + (* Ignore arrays and slices, as we can't expand them *) + match sv.sv_ty with + | TAdt (TBuiltin (TArray | TSlice), _) -> () + | _ -> raise (FoundSymbolicValue sv) else () (** Don't enter abstractions *) diff --git a/src/interp/InterpreterProjectors.ml b/src/interp/InterpreterProjectors.ml index f10a4dbf..07956494 100644 --- a/src/interp/InterpreterProjectors.ml +++ b/src/interp/InterpreterProjectors.ml @@ -216,7 +216,7 @@ let rec apply_proj_borrows (span : Meta.span) (check_symbolic_no_ended : bool) sanity_check __FILE__ __LINE__ (not (projections_intersect span ty1 rset1 ty2 rset2)) span); - ASymbolic (AProjBorrows (s, ty)) + ASymbolic (AProjBorrows (s, ty, [])) | _ -> log#ltrace (lazy diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index d2b5ac30..1c68c8df 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -140,8 +140,8 @@ let mk_aproj_borrows_from_symbolic_value (span : Meta.span) aproj = sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) span; if ty_has_regions_in_set proj_regions proj_ty then - AProjBorrows (svalue, proj_ty) - else AIgnoredProjBorrows + AProjBorrows (svalue, proj_ty, []) + else AEmpty (** TODO: move *) let borrow_is_asb (bid : BorrowId.id) (asb : abstract_shared_borrow) : bool = @@ -207,7 +207,8 @@ exception FoundGBorrowContent of g_borrow_content exception FoundGLoanContent of g_loan_content (** Utility exception *) -exception FoundAProjBorrows of symbolic_value * ty +exception + FoundAProjBorrows of symbolic_value * ty * (msymbolic_value * aproj) list let symbolic_value_id_in_ctx (sv_id : SymbolicValueId.id) (ctx : eval_ctx) : bool = @@ -220,9 +221,9 @@ let symbolic_value_id_in_ctx (sv_id : SymbolicValueId.id) (ctx : eval_ctx) : method! visit_aproj env aproj = (match aproj with - | AProjLoans (sv, _) | AProjBorrows (sv, _) -> + | AProjLoans (sv, _) | AProjBorrows (sv, _, _) -> if sv.sv_id = sv_id then raise Found else () - | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); + | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj env aproj method! visit_abstract_shared_borrows _ asb = diff --git a/src/interp/Invariants.ml b/src/interp/Invariants.ml index 3f5c2f9f..a996b51f 100644 --- a/src/interp/Invariants.ml +++ b/src/interp/Invariants.ml @@ -697,7 +697,7 @@ let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = sanity_check __FILE__ __LINE__ (ty_has_regions_in_set abs.regions.owned sv.sv_ty) span - | AProjBorrows (sv, proj_ty) -> + | AProjBorrows (sv, proj_ty, _) -> let ty2 = Substitute.erase_regions sv.sv_ty in sanity_check __FILE__ __LINE__ (ty1 = ty2) span; (* Also check that the symbolic values contain regions of interest - @@ -710,12 +710,12 @@ let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = List.iter (fun (_, proj) -> match proj with - | AProjBorrows (_sv, ty') -> + | AProjBorrows (_sv, ty', _) -> sanity_check __FILE__ __LINE__ (ty' = ty) span - | AEndedProjBorrows _ | AIgnoredProjBorrows -> () + | AEndedProjBorrows _ | AEmpty -> () | _ -> craise __FILE__ __LINE__ span "Unexpected") given_back_ls - | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()) + | AEndedProjBorrows _ | AEmpty -> ()) | AIgnored _, _ -> () | _ -> log#ltrace @@ -812,9 +812,9 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = (let abs = Option.get abs in match aproj with | AProjLoans (sv, _) -> add_aproj_loans sv abs.abs_id abs.regions.owned - | AProjBorrows (sv, proj_ty) -> + | AProjBorrows (sv, proj_ty, _) -> add_aproj_borrows sv abs.abs_id abs.regions.owned proj_ty false - | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); + | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj abs aproj end in diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index 657b4d2f..d9c06835 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -136,16 +136,28 @@ module Values = struct " (" ^ String.concat "," given_back ^ ") " in "⌊" ^ symbolic_value_to_string env sv ^ given_back ^ "⌋" - | AProjBorrows (sv, rty) -> - "(" ^ symbolic_value_proj_to_string env sv rty ^ ")" + | AProjBorrows (sv, rty, given_back) -> + let given_back = + if given_back = [] then "" + else + let given_back = List.map snd given_back in + let given_back = List.map (aproj_to_string env) given_back in + " (" ^ String.concat "," given_back ^ ") " + in + "(" ^ symbolic_value_proj_to_string env sv rty ^ given_back ^ ")" | AEndedProjLoans (_, given_back) -> if given_back = [] then "_" else let given_back = List.map snd given_back in let given_back = List.map (aproj_to_string env) given_back in "ended_aproj_loans (" ^ String.concat "," given_back ^ ")" - | AEndedProjBorrows _mv -> "_" - | AIgnoredProjBorrows -> "_" + | AEndedProjBorrows (_, given_back) -> + if given_back = [] then "_" + else + let given_back = List.map snd given_back in + let given_back = List.map (aproj_to_string env) given_back in + "ended_aproj_borrows (" ^ String.concat "," given_back ^ ")" + | AEmpty -> "_" (** Wrap a value inside its marker, if there is one *) let add_proj_marker (pm : proj_marker) (s : string) : string = diff --git a/src/llbc/Values.ml b/src/llbc/Values.ml index e94545d7..275a9e1b 100644 --- a/src/llbc/Values.ml +++ b/src/llbc/Values.ml @@ -273,7 +273,7 @@ and abstract_shared_borrows = abstract_shared_borrow list and aproj = | AProjLoans of symbolic_value * (msymbolic_value * aproj) list (** A projector of loans over a symbolic value. - + Whenever we call a function, we introduce a symbolic value for the returned value. We insert projectors of loans over this symbolic value in the abstractions introduced by this function @@ -293,10 +293,10 @@ and aproj = g(move p); // Symbolic context after the call to g: - // abs'a {'a} { [s@0 <: (&'a mut u32, &'a mut u32)] } + // abs'a {'a} { proj_loans [s@0 <: (&'a mut u32, &'a mut u32)] } // - // abs'b {'b} { (s@0 <: (&'b mut u32, &'c mut u32)) } - // abs'c {'c} { (s@0 <: (&'b mut u32, &'c mut u32)) } + // abs'b {'b} { proj_borrows (s@0 <: (&'b mut u32, &'c mut u32)) } + // abs'c {'c} { proj_borrows (s@0 <: (&'b mut u32, &'c mut u32)) } ]} Upon evaluating the call to [f], we introduce a symbolic value [s@0] @@ -311,13 +311,28 @@ and aproj = anywhere in the context below a projector of borrows which intersects this projector of loans. *) - | AProjBorrows of symbolic_value * ty + | AProjBorrows of symbolic_value * ty * (msymbolic_value * aproj) list (** Note that an AProjBorrows only operates on a value which is not below a shared loan: under a shared loan, we use {!abstract_shared_borrow}. Also note that once given to a borrow projection, a symbolic value can't get updated/expanded: this means that we don't need to save any meta-value here. + + Finally, we have the same problem as with loans, that is we may + need to reproject loans coming from several abstractions. Consider + for instance what happens if we end abs1 and abs2 below: the borrow + projector inside of abs0 will receive parts of their given back symbolic + values: + {[ + ... + abs0 {'c} { proj_borrows (s@0 : (&'a mut &'c mut u32, &'b mut &'c mut u32)) } + ... + + abs1 {'a} { proj_loans (&'a mut &'c mut u32, &'b mut &'c mut u32)) } + abs2 {'b} { proj_loans (&'a mut &'c mut u32, &'b mut &'c mut u32)) } + ... + ]} *) | AEndedProjLoans of msymbolic_value * (msymbolic_value * aproj) list (** An ended projector of loans over a symbolic value. @@ -326,12 +341,12 @@ and aproj = Note that we keep the original symbolic value as a meta-value. *) - | AEndedProjBorrows of msymbolic_value + | AEndedProjBorrows of msymbolic_value * (msymbolic_value * aproj) list (** The only purpose of {!AEndedProjBorrows} is to store, for synthesis purposes, the symbolic value which was generated and given back upon ending the borrow. *) - | AIgnoredProjBorrows + | AEmpty (** Nothing to project (because there are no borrows, etc.) *) (** Abstraction values are used inside of abstractions to properly model borrowing relations introduced by function calls. diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 3c3fd616..34606343 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -1860,7 +1860,7 @@ let compute_typed_avalue_proj_kind span (av : V.typed_avalue) : has_loans := true; (* Continue exploring (same reasons as above) *) super#visit_ASymbolic env aproj - | AEndedProjBorrows _ | AIgnoredProjBorrows | AProjBorrows (_, _) -> + | AEndedProjBorrows _ | AEmpty | AProjBorrows (_, _, _) -> has_borrows := true; (* Continue exploring (same reasons as above) *) super#visit_ASymbolic env aproj @@ -2047,9 +2047,7 @@ and aproj_to_consumed_aux (ctx : bs_ctx) (aproj : V.aproj) : texpression option (* The symbolic value was left unchanged *) Some (symbolic_value_to_texpression ctx msv) | V.AEndedProjLoans (_, [ (mnv, child_aproj) ]) -> - sanity_check __FILE__ __LINE__ - (child_aproj = AIgnoredProjBorrows) - ctx.span; + sanity_check __FILE__ __LINE__ (child_aproj = AEmpty) ctx.span; (* The symbolic value was updated *) Some (symbolic_value_to_texpression ctx mnv) | V.AEndedProjLoans (_, _) -> @@ -2060,7 +2058,7 @@ and aproj_to_consumed_aux (ctx : bs_ctx) (aproj : V.aproj) : texpression option (* The value should have been introduced by a loan projector, and should not contain nested borrows, so we can't get there *) craise __FILE__ __LINE__ ctx.span "Unreachable" - | AIgnoredProjBorrows | AProjLoans (_, _) | AProjBorrows (_, _) -> + | AEmpty | AProjLoans (_, _) | AProjBorrows (_, _, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" let typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) @@ -2263,11 +2261,12 @@ and aproj_to_given_back_aux (mp : mplace option) (aproj : V.aproj) (ctx : bs_ctx) : bs_ctx * typed_pattern option = match aproj with | V.AEndedProjLoans (_, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" - | AEndedProjBorrows mv -> + | AEndedProjBorrows (mv, given_back) -> + cassert __FILE__ __LINE__ (given_back = []) ctx.span "Unreachable"; (* Return the meta-value *) let ctx, var = fresh_var_for_symbolic_value mv ctx in (ctx, Some (mk_typed_pattern_from_var var mp)) - | AIgnoredProjBorrows | AProjLoans (_, _) | AProjBorrows (_, _) -> + | AEmpty | AProjLoans (_, _) | AProjBorrows (_, _, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" let typed_avalue_to_given_back (mp : mplace option) (v : V.typed_avalue) From 6ea9597e0dbfa6133ef1d184bc9c0f3877fae1b8 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 18:06:49 +0000 Subject: [PATCH 05/29] Add projection types to the loan projectors --- src/interp/Interpreter.ml | 19 ++-- src/interp/InterpreterBorrows.ml | 75 ++++++++------- src/interp/InterpreterBorrowsCore.ml | 134 ++++++++++++++------------- src/interp/InterpreterExpansion.ml | 8 +- src/interp/InterpreterExpressions.ml | 4 +- src/interp/InterpreterProjectors.ml | 29 ++++-- src/interp/InterpreterProjectors.mli | 4 + src/interp/InterpreterStatements.ml | 3 +- src/interp/InterpreterUtils.ml | 14 ++- src/interp/Invariants.ml | 19 ++-- src/llbc/AssociatedTypes.ml | 23 +++-- src/llbc/Contexts.ml | 14 ++- src/llbc/Print.ml | 7 +- src/llbc/Values.ml | 2 +- src/symbolic/SymbolicToPure.ml | 6 +- 15 files changed, 210 insertions(+), 151 deletions(-) diff --git a/src/interp/Interpreter.ml b/src/interp/Interpreter.ml index 589cf976..7f5cf866 100644 --- a/src/interp/Interpreter.ml +++ b/src/interp/Interpreter.ml @@ -210,7 +210,8 @@ let initialize_symbolic_context_for_fun (ctx : decls_ctx) (fdef : fun_decl) : (* Project over the values - we use *loan* projectors, as explained above *) let avalues = List.map - (mk_aproj_loans_value_from_symbolic_value abs.regions.owned) + (fun (sv : symbolic_value) -> + mk_aproj_loans_value_from_symbolic_value abs.regions.owned sv sv.sv_ty) input_svs in (ctx, avalues) @@ -286,9 +287,9 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) let ret_value, ctx, cc = pop_frame config span pop_return_value ctx in (* We need to find the parents regions/abstractions of the region we - * will end - this will allow us to, first, mark the other return - * regions as non-endable, and, second, end those parent regions in - * proper order. *) + will end - this will allow us to, first, mark the other return + regions as non-endable, and, second, end those parent regions in + proper order. *) let parent_rgs = list_ancestor_region_groups regions_hierarchy back_id in let parent_input_abs_ids = RegionGroupId.mapi @@ -317,11 +318,11 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) in (* Initialize and insert the abstractions in the context. - * - * We take care of allowing to end only the regions which should end (note - * that this is important for soundness: this is part of the borrow checking). - * Also see the documentation of the [can_end] field of [abs] for more - * information. *) + + We take care of allowing to end only the regions which should end (note + that this is important for soundness: this is part of the borrow checking). + Also see the documentation of the [can_end] field of [abs] for more + information. *) let parent_and_current_rgs = RegionGroupId.Set.add back_id parent_rgs in let region_can_end rid = RegionGroupId.Set.mem rid parent_and_current_rgs diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 75ced7ad..8489de3c 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -322,13 +322,16 @@ let give_back_value (config : config) (span : Meta.span) (bid : BorrowId.id) | ALoan lc -> let value = self#visit_typed_ALoan opt_abs av.ty lc in ({ av with value } : typed_avalue) + | ABorrow bc -> + let value = self#visit_typed_ABorrow opt_abs av.ty bc in + ({ av with value } : typed_avalue) | _ -> super#visit_typed_avalue opt_abs av (** We need to inspect ignored mutable borrows, to insert loan projectors if necessary. *) - method! visit_ABorrow (opt_abs : abs option) (bc : aborrow_content) - : avalue = + method visit_typed_ABorrow (opt_abs : abs option) (ty : rty) + (bc : aborrow_content) : avalue = match bc with | AIgnoredMutBorrow (bid', child) -> if bid' = Some bid then @@ -343,9 +346,10 @@ let give_back_value (config : config) (span : Meta.span) (bid : BorrowId.id) * the value... Think about a more elegant way. *) let given_back_meta = as_symbolic span nv.value in (* The loan projector *) + let _, ty, _ = ty_as_ref ty in let given_back = mk_aproj_loans_value_from_symbolic_value abs.regions.owned - sv + sv ty in (* Continue giving back in the child value *) let child = super#visit_typed_avalue opt_abs child in @@ -461,8 +465,15 @@ let end_aproj_borrows (span : Meta.span) (ended_regions : RegionId.Set.t) sanity_check __FILE__ __LINE__ (sv.sv_id <> nsv.sv_id && ty_is_rty proj_ty) span; - (* Store the given-back value as a meta-value for synthesis purposes *) - let mv = nsv in + log#ldebug + (lazy + ("end_aproj_borrows:" ^ "\n- ended regions: " + ^ RegionId.Set.to_string None ended_regions + ^ "\n- projection type: " ^ ty_to_string ctx proj_ty ^ "\n- sv: " + ^ symbolic_value_to_string ctx sv + ^ "\n- nsv: " + ^ symbolic_value_to_string ctx nsv + ^ "\n- ctx: " ^ eval_ctx_to_string ctx)); (* Substitution functions, to replace the borrow projectors over symbolic values *) (* We need to handle two cases: - If the regions ended in the symbolic value intersect with the owned @@ -497,22 +508,22 @@ let end_aproj_borrows (span : Meta.span) (ended_regions : RegionId.Set.t) (abs_proj_ty : rty) (local_given_back : (msymbolic_value * aproj) list) : aproj = (* Compute the projection over the given back value *) - let child_proj = AProjLoans (nsv, []) in - AProjBorrows (abs_sv, abs_proj_ty, (mv, child_proj) :: local_given_back) + let child_proj = AProjLoans (nsv, abs_proj_ty, []) in + AProjBorrows (abs_sv, abs_proj_ty, (sv, child_proj) :: local_given_back) in let ctx = - update_intersecting_aproj_borrows span ~include_ancestors:true - ~include_owned:false ~update_shared:None ~update_mut:update_ancestors - ended_regions sv ctx + update_intersecting_aproj_borrows span ~fail_if_unchanged:false + ~include_ancestors:true ~include_owned:false ~update_shared:None + ~update_mut:update_ancestors ended_regions sv proj_ty ctx in let update_owned (_abs : abs) (_abs_sv : symbolic_value) (_abs_proj_ty : rty) (local_given_back : (msymbolic_value * aproj) list) : aproj = (* There is nothing to project *) - AEndedProjBorrows (mv, local_given_back) + AEndedProjBorrows (nsv, local_given_back) in - update_intersecting_aproj_borrows span ~include_ancestors:false - ~include_owned:true ~update_shared:None ~update_mut:update_owned - ended_regions sv ctx + update_intersecting_aproj_borrows span ~fail_if_unchanged:true + ~include_ancestors:false ~include_owned:true ~update_shared:None + ~update_mut:update_owned ended_regions sv proj_ty ctx (** Give back a *modified* symbolic value. *) let give_back_symbolic_value (_config : config) (span : Meta.span) @@ -522,8 +533,6 @@ let give_back_symbolic_value (_config : config) (span : Meta.span) sanity_check __FILE__ __LINE__ (sv.sv_id <> nsv.sv_id && ty_is_rty proj_ty) span; - (* Store the given-back value as a meta-value for synthesis purposes *) - let mv = nsv in (* Substitution functions, to replace the borrow projectors over symbolic values *) (* We need to handle two cases: - If the regions ended in the symbolic value intersect with the owned @@ -555,22 +564,24 @@ let give_back_symbolic_value (_config : config) (span : Meta.span) - we first update when intersecting with ancestors regions - then we update when intersecting with owned regions *) - let subst_ancestors (_abs : abs) local_given_back = + let subst_ancestors (_abs : abs) abs_sv abs_proj_ty local_given_back = (* Compute the projection over the given back value *) let child_proj = AProjBorrows (nsv, sv.sv_ty, []) in - AProjLoans (sv, (mv, child_proj) :: local_given_back) + AProjLoans (abs_sv, abs_proj_ty, (sv, child_proj) :: local_given_back) in let ctx = - update_intersecting_aproj_loans span ~include_ancestors:true - ~include_owned:false ended_regions proj_ty sv subst_ancestors ctx + update_intersecting_aproj_loans span ~fail_if_unchanged:false + ~include_ancestors:true ~include_owned:false ended_regions proj_ty sv + subst_ancestors ctx in - let subst_owned (_abs : abs) local_given_back = + let subst_owned (_abs : abs) abs_sv _abs_proj_ty local_given_back = (* There is nothing to project *) let child_proj = AEmpty in - AProjLoans (sv, (mv, child_proj) :: local_given_back) + AEndedProjLoans (abs_sv, (nsv, child_proj) :: local_given_back) in - update_intersecting_aproj_loans span ~include_ancestors:false - ~include_owned:true ended_regions proj_ty sv subst_owned ctx + update_intersecting_aproj_loans span ~fail_if_unchanged:true + ~include_ancestors:false ~include_owned:true ended_regions proj_ty sv + subst_owned ctx (** Auxiliary function to end borrows. See {!give_back}. @@ -1220,12 +1231,12 @@ and end_abstraction_loans (config : config) (span : Meta.span) in (* Reexplore, looking for loans *) comp cc (end_abstraction_loans config span chain abs_id ctx) - | Some (SymbolicValue sv) -> + | Some (SymbolicValue (sv, proj_ty)) -> (* There is a proj_loans over a symbolic value: end the proj_borrows which intersect this proj_loans, then end the proj_loans itself *) let ctx, cc = end_proj_loans_symbolic config span chain abs_id abs.regions.owned sv - ctx + proj_ty ctx in (* Reexplore, looking for loans *) comp cc (end_abstraction_loans config span chain abs_id ctx) @@ -1433,14 +1444,15 @@ and end_abstraction_remove_from_context (_config : config) (span : Meta.span) *) and end_proj_loans_symbolic (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_id : AbstractionId.id) - (regions : RegionId.Set.t) (sv : symbolic_value) : cm_fun = + (regions : RegionId.Set.t) (sv : symbolic_value) (proj_ty : rty) : cm_fun = fun ctx -> (* Small helpers for sanity checks *) let check ctx = no_aproj_over_symbolic_in_context span sv ctx in (* Find the first proj_borrows which intersects the proj_loans *) let explore_shared = true in match - lookup_intersecting_aproj_borrows_opt span explore_shared regions sv ctx + lookup_intersecting_aproj_borrows_opt span explore_shared regions sv proj_ty + ctx with | None -> (* We couldn't find any in the context: it means that the symbolic value @@ -1497,7 +1509,7 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) (* All the proj_borrows are owned: simply erase them *) let ctx = remove_intersecting_aproj_borrows_shared span ~include_ancestors:false - ~include_owned:true regions sv ctx + ~include_owned:true regions sv proj_ty ctx in (* End the loan itself *) update_aproj_loans_to_ended span abs_id sv ctx @@ -1533,7 +1545,7 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) sanity_check __FILE__ __LINE__ (Option.is_none (lookup_intersecting_aproj_borrows_opt span explore_shared regions - sv ctx)) + sv proj_ty ctx)) span; (* End the projector of loans *) let ctx = update_aproj_loans_to_ended span abs_id sv ctx in @@ -1547,7 +1559,8 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) (* Retry ending the projector of loans *) let ctx, cc = comp cc - (end_proj_loans_symbolic config span chain abs_id regions sv ctx) + (end_proj_loans_symbolic config span chain abs_id regions sv proj_ty + ctx) in (* Sanity check *) check ctx; diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index a9ccdf07..a5372807 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -35,9 +35,9 @@ let ek_all : exploration_kind = type borrow_ids = Borrows of BorrowId.Set.t | Borrow of BorrowId.id [@@deriving show] -type borrow_ids_or_symbolic_value = +type borrow_ids_or_proj_symbolic_value = | BorrowIds of borrow_ids - | SymbolicValue of symbolic_value + | SymbolicValue of symbolic_value * rty [@@deriving show] exception FoundBorrowIds of borrow_ids @@ -688,11 +688,11 @@ let get_first_outer_loan_or_borrow_in_value (with_borrows : bool) let proj_borrows_intersects_proj_loans (span : Meta.span) (proj_borrows : RegionId.Set.t * symbolic_value * rty) - (proj_loans : RegionId.Set.t * symbolic_value) : bool = + (proj_loans : RegionId.Set.t * symbolic_value * rty) : bool = let b_regions, b_sv, b_ty = proj_borrows in - let l_regions, l_sv = proj_loans in + let l_regions, l_sv, l_ty = proj_loans in if same_symbolic_id b_sv l_sv then - projections_intersect span l_sv.sv_ty l_regions b_ty b_regions + projections_intersect span l_ty l_regions b_ty b_regions else false (** Result of looking up aproj_borrows which intersect a given aproj_loans in @@ -722,7 +722,7 @@ type looked_up_aproj_borrows = *) let lookup_intersecting_aproj_borrows_opt (span : Meta.span) (lookup_shared : bool) (regions : RegionId.Set.t) (sv : symbolic_value) - (ctx : eval_ctx) : looked_up_aproj_borrows option = + (proj_ty : rty) (ctx : eval_ctx) : looked_up_aproj_borrows option = let found : looked_up_aproj_borrows option ref = ref None in let set_non_shared ((id, ty) : AbstractionId.id * rty) : unit = match !found with @@ -735,11 +735,11 @@ let lookup_intersecting_aproj_borrows_opt (span : Meta.span) | Some (SharedProjs pl) -> found := Some (SharedProjs (x :: pl)) | Some (NonSharedProj _) -> craise __FILE__ __LINE__ span "Unreachable" in - let check_add_proj_borrows (is_shared : bool) abs sv' proj_ty = + let check_add_proj_borrows (is_shared : bool) abs sv' proj_ty' = if proj_borrows_intersects_proj_loans span - (abs.regions.owned, sv', proj_ty) - (regions, sv) + (abs.regions.owned, sv', proj_ty') + (regions, sv, proj_ty) then let x = (abs.abs_id, proj_ty) in if is_shared then add_shared x else set_non_shared x @@ -791,11 +791,12 @@ let lookup_intersecting_aproj_borrows_opt (span : Meta.span) this abstraction. *) let lookup_intersecting_aproj_borrows_not_shared_opt (span : Meta.span) - (regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : - (AbstractionId.id * rty) option = + (regions : RegionId.Set.t) (sv : symbolic_value) (proj_ty : rty) + (ctx : eval_ctx) : (AbstractionId.id * rty) option = let lookup_shared = false in match - lookup_intersecting_aproj_borrows_opt span lookup_shared regions sv ctx + lookup_intersecting_aproj_borrows_opt span lookup_shared regions sv proj_ty + ctx with | None -> None | Some (NonSharedProj (abs_id, rty)) -> Some (abs_id, rty) @@ -812,13 +813,14 @@ let lookup_intersecting_aproj_borrows_not_shared_opt (span : Meta.span) intersections, use the owned regions. *) let update_intersecting_aproj_borrows (span : Meta.span) - ~(include_ancestors : bool) ~(include_owned : bool) + ~(fail_if_unchanged : bool) ~(include_ancestors : bool) + ~(include_owned : bool) ~(update_shared : (abs -> symbolic_value -> rty -> abstract_shared_borrows) option) ~(update_mut : abs -> symbolic_value -> rty -> (msymbolic_value * aproj) list -> aproj) - (proj_regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : - eval_ctx = + (proj_regions : RegionId.Set.t) (sv : symbolic_value) (proj_ty : rty) + (ctx : eval_ctx) : eval_ctx = (* Small helpers for sanity checks *) let shared = ref None in let add_shared () = @@ -833,7 +835,7 @@ let update_intersecting_aproj_borrows (span : Meta.span) craise __FILE__ __LINE__ span "Found unexpected intersecting proj_borrows" in - let check_proj_borrows is_shared abs sv' proj_ty = + let check_proj_borrows is_shared abs sv' proj_ty' = let intersect_regions = let intersect_regions = if include_ancestors then abs.regions.ancestors else RegionId.Set.empty @@ -844,8 +846,8 @@ let update_intersecting_aproj_borrows (span : Meta.span) in if proj_borrows_intersects_proj_loans span - (intersect_regions, sv', proj_ty) - (proj_regions, sv) + (intersect_regions, sv', proj_ty') + (proj_regions, sv, proj_ty) then ( if is_shared then add_shared () else set_non_shared (); true) @@ -894,8 +896,9 @@ let update_intersecting_aproj_borrows (span : Meta.span) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Check that we updated the context at least once *) - cassert __FILE__ __LINE__ (Option.is_some !shared) span - "Context was not updated"; + cassert __FILE__ __LINE__ + ((not fail_if_unchanged) || Option.is_some !shared) + span "Context was not updated"; (* Return *) ctx @@ -908,8 +911,8 @@ let update_intersecting_aproj_borrows (span : Meta.span) *) let update_intersecting_aproj_borrows_mut (span : Meta.span) ~(include_ancestors : bool) ~(include_owned : bool) - (proj_regions : RegionId.Set.t) (sv : symbolic_value) (nv : aproj) - (ctx : eval_ctx) : eval_ctx = + (proj_regions : RegionId.Set.t) (sv : symbolic_value) (proj_ty : rty) + (nv : aproj) (ctx : eval_ctx) : eval_ctx = (* Small helpers *) let updated = ref false in let update_mut _ _ _ _ = @@ -919,8 +922,9 @@ let update_intersecting_aproj_borrows_mut (span : Meta.span) in (* Update *) let ctx = - update_intersecting_aproj_borrows span ~include_ancestors ~include_owned - ~update_shared:None ~update_mut proj_regions sv ctx + update_intersecting_aproj_borrows span ~fail_if_unchanged:true + ~include_ancestors ~include_owned ~update_shared:None ~update_mut + proj_regions sv proj_ty ctx in (* Check that we updated at least once *) sanity_check __FILE__ __LINE__ !updated span; @@ -934,14 +938,15 @@ let update_intersecting_aproj_borrows_mut (span : Meta.span) *) let remove_intersecting_aproj_borrows_shared (span : Meta.span) ~(include_ancestors : bool) ~(include_owned : bool) - (regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : eval_ctx - = + (regions : RegionId.Set.t) (sv : symbolic_value) (proj_ty : rty) + (ctx : eval_ctx) : eval_ctx = (* Small helpers *) let update_shared = Some (fun _ _ _ -> []) in let update_mut _ _ = craise __FILE__ __LINE__ span "Unexpected" in (* Update *) - update_intersecting_aproj_borrows span ~include_ancestors ~include_owned - ~update_shared ~update_mut regions sv ctx + update_intersecting_aproj_borrows span ~fail_if_unchanged:true + ~include_ancestors ~include_owned ~update_shared ~update_mut regions sv + proj_ty ctx (** Updates the proj_loans intersecting some projection. @@ -980,18 +985,20 @@ let remove_intersecting_aproj_borrows_shared (span : Meta.span) intersections, use the owned regions. *) let update_intersecting_aproj_loans (span : Meta.span) - ~(include_ancestors : bool) ~(include_owned : bool) - (proj_regions : RegionId.Set.t) (proj_ty : rty) (sv : symbolic_value) - (subst : abs -> (msymbolic_value * aproj) list -> aproj) (ctx : eval_ctx) : - eval_ctx = + ~(fail_if_unchanged : bool) ~(include_ancestors : bool) + ~(include_owned : bool) (proj_regions : RegionId.Set.t) (proj_ty : rty) + (sv : symbolic_value) + (subst : + abs -> symbolic_value -> rty -> (msymbolic_value * aproj) list -> aproj) + (ctx : eval_ctx) : eval_ctx = (* *) sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) span; (* Small helpers for sanity checks *) let updated = ref false in - let update abs local_given_back : aproj = + let update abs abs_sv abs_proj_ty local_given_back : aproj = (* Note that we can update more than once! *) updated := true; - subst abs local_given_back + subst abs abs_sv abs_proj_ty local_given_back in (* The visitor *) let obj = @@ -1003,25 +1010,25 @@ let update_intersecting_aproj_loans (span : Meta.span) match sproj with | AProjBorrows _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> super#visit_aproj abs sproj - | AProjLoans (sv', given_back) -> + | AProjLoans (abs_sv, abs_proj_ty, given_back) -> let abs = Option.get abs in - if same_symbolic_id sv sv' then ( - sanity_check __FILE__ __LINE__ (sv.sv_ty = sv'.sv_ty) span; - let regions = RegionId.Set.empty in - let regions = + if same_symbolic_id sv abs_sv then ( + sanity_check __FILE__ __LINE__ (sv.sv_ty = abs_sv.sv_ty) span; + let abs_regions = RegionId.Set.empty in + let abs_regions = if include_ancestors then - RegionId.Set.union abs.regions.ancestors regions - else regions + RegionId.Set.union abs.regions.ancestors abs_regions + else abs_regions in - let regions = + let abs_regions = if include_owned then - RegionId.Set.union abs.regions.owned regions - else regions + RegionId.Set.union abs.regions.owned abs_regions + else abs_regions in if - projections_intersect span proj_ty proj_regions sv'.sv_ty - regions - then update abs given_back + projections_intersect span proj_ty proj_regions abs_proj_ty + abs_regions + then update abs abs_sv abs_proj_ty given_back else super#visit_aproj (Some abs) sproj) else super#visit_aproj (Some abs) sproj end @@ -1029,7 +1036,7 @@ let update_intersecting_aproj_loans (span : Meta.span) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Check that we updated the context at least once *) - sanity_check __FILE__ __LINE__ !updated span; + sanity_check __FILE__ __LINE__ ((not fail_if_unchanged) || !updated) span; (* Return *) ctx @@ -1064,11 +1071,11 @@ let lookup_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) (match sproj with | AProjBorrows _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> super#visit_aproj abs sproj - | AProjLoans (sv', given_back) -> + | AProjLoans (abs_sv, _, given_back) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; - if sv'.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (sv' = sv) span; + if abs_sv.sv_id = sv.sv_id then ( + sanity_check __FILE__ __LINE__ (abs_sv = sv) span; set_found given_back) else ()); super#visit_aproj abs sproj @@ -1109,11 +1116,11 @@ let update_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) match sproj with | AProjBorrows _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> super#visit_aproj abs sproj - | AProjLoans (sv', _) -> + | AProjLoans (abs_sv, _, _) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; - if sv'.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (sv' = sv) span; + if abs_sv.sv_id = sv.sv_id then ( + sanity_check __FILE__ __LINE__ (abs_sv = sv) span; update ()) else super#visit_aproj (Some abs) sproj end @@ -1157,11 +1164,11 @@ let update_aproj_borrows (span : Meta.span) (abs_id : AbstractionId.id) match sproj with | AProjLoans _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> super#visit_aproj abs sproj - | AProjBorrows (sv', _proj_ty, _given_back) -> + | AProjBorrows (abs_sv, _proj_ty, _given_back) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; - if sv'.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (sv' = sv) span; + if abs_sv.sv_id = sv.sv_id then ( + sanity_check __FILE__ __LINE__ (abs_sv = sv) span; update ()) else super#visit_aproj (Some abs) sproj end @@ -1199,8 +1206,8 @@ let no_aproj_over_symbolic_in_context (span : Meta.span) (sv : symbolic_value) method! visit_aproj env sproj = (match sproj with | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> () - | AProjLoans (sv', _) | AProjBorrows (sv', _, _) -> - if sv'.sv_id = sv.sv_id then raise Found else ()); + | AProjLoans (abs_sv, _, _) | AProjBorrows (abs_sv, _, _) -> + if abs_sv.sv_id = sv.sv_id then raise Found else ()); super#visit_aproj env sproj end in @@ -1217,7 +1224,7 @@ let no_aproj_over_symbolic_in_context (span : Meta.span) (sv : symbolic_value) **Remark:** we don't take the *ignored* mut/shared loans into account. *) let get_first_non_ignored_aloan_in_abstraction (span : Meta.span) (abs : abs) : - borrow_ids_or_symbolic_value option = + borrow_ids_or_proj_symbolic_value option = (* Explore to find a loan *) let obj = object @@ -1257,7 +1264,8 @@ let get_first_non_ignored_aloan_in_abstraction (span : Meta.span) (abs : abs) : (match sproj with | AProjBorrows (_, _, _) | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> () - | AProjLoans (sv, _) -> raise (ValuesUtils.FoundSymbolicValue sv)); + | AProjLoans (sv, ty, given_back) -> + raise (FoundAProjLoans (sv, ty, given_back))); super#visit_aproj env sproj end in @@ -1269,9 +1277,9 @@ let get_first_non_ignored_aloan_in_abstraction (span : Meta.span) (abs : abs) : with (* There are loans *) | FoundBorrowIds bids -> Some (BorrowIds bids) - | ValuesUtils.FoundSymbolicValue sv -> + | FoundAProjLoans (sv, proj_ty, _) -> (* There are loan projections over symbolic values *) - Some (SymbolicValue sv) + Some (SymbolicValue (sv, proj_ty)) let lookup_shared_value_opt (span : Meta.span) (ctx : eval_ctx) (bid : BorrowId.id) : typed_value option = diff --git a/src/interp/InterpreterExpansion.ml b/src/interp/InterpreterExpansion.ml index b0334e93..b8e2545f 100644 --- a/src/interp/InterpreterExpansion.ml +++ b/src/interp/InterpreterExpansion.ml @@ -77,7 +77,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) *) method! visit_aproj current_abs aproj = (match aproj with - | AProjLoans (sv, _) | AProjBorrows (sv, _, _) -> + | AProjLoans (sv, _, _) | AProjBorrows (sv, _, _) -> sanity_check __FILE__ __LINE__ (not (same_symbolic_id sv original_sv)) span @@ -96,7 +96,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (* Explore the given back values to make sure we don't have to expand * anything in there *) ASymbolic (self#visit_aproj (Some current_abs) aproj) - | AProjLoans (sv, given_back), LoanProj -> + | AProjLoans (sv, proj_ty, given_back), LoanProj -> (* Check if this is the symbolic value we are looking for *) if same_symbolic_id sv original_sv then ( (* There mustn't be any given back values *) @@ -104,7 +104,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (* Apply the projector *) let projected_value = apply_proj_loans_on_symbolic_expansion span proj_regions - ancestors_regions expansion original_sv.sv_ty + ancestors_regions expansion original_sv.sv_ty proj_ty ctx in (* Replace *) projected_value.value) @@ -365,7 +365,7 @@ let expand_symbolic_value_shared_borrow (config : config) (span : Meta.span) *) method! visit_aproj proj_regions aproj = (match aproj with - | AProjLoans (sv, _) | AProjBorrows (sv, _, _) -> + | AProjLoans (sv, _, _) | AProjBorrows (sv, _, _) -> sanity_check __FILE__ __LINE__ (not (same_symbolic_id sv original_sv)) span diff --git a/src/interp/InterpreterExpressions.ml b/src/interp/InterpreterExpressions.ml index d84241ef..7cf47474 100644 --- a/src/interp/InterpreterExpressions.ml +++ b/src/interp/InterpreterExpressions.ml @@ -801,8 +801,8 @@ let eval_rvalue_aggregate (config : config) (span : Meta.span) = List.length generics.regions) span; let expected_field_types = - AssociatedTypes.ctx_adt_get_inst_norm_field_etypes span ctx def_id - opt_variant_id generics + AssociatedTypes.ctx_type_get_inst_norm_field_etypes span ctx + def_id opt_variant_id generics in sanity_check __FILE__ __LINE__ (expected_field_types diff --git a/src/interp/InterpreterProjectors.ml b/src/interp/InterpreterProjectors.ml index 07956494..458025ba 100644 --- a/src/interp/InterpreterProjectors.ml +++ b/src/interp/InterpreterProjectors.ml @@ -27,7 +27,7 @@ let rec apply_proj_borrows_on_shared_borrow (span : Meta.span) (ctx : eval_ctx) | VAdt adt, TAdt (id, generics) -> (* Retrieve the types of the fields *) let field_types = - Assoc.ctx_adt_value_get_inst_norm_field_rtypes span ctx adt id + Assoc.ctx_adt_get_inst_norm_field_rtypes span ctx id adt.variant_id generics in @@ -109,7 +109,7 @@ let rec apply_proj_borrows (span : Meta.span) (check_symbolic_no_ended : bool) | VAdt adt, TAdt (id, generics) -> (* Retrieve the types of the fields *) let field_types = - Assoc.ctx_adt_value_get_inst_norm_field_rtypes span ctx adt id + Assoc.ctx_adt_get_inst_norm_field_rtypes span ctx id adt.variant_id generics in (* Project over the field values *) @@ -258,11 +258,14 @@ let symbolic_expansion_non_shared_borrow_to_value (span : Meta.span) (** Apply (and reduce) a projector over loans to a value. + Remark: we need the evaluation context only to access the type declarations. + TODO: detailed comments. See [apply_proj_borrows] *) let apply_proj_loans_on_symbolic_expansion (span : Meta.span) (regions : RegionId.Set.t) (ancestors_regions : RegionId.Set.t) - (see : symbolic_expansion) (original_sv_ty : rty) : typed_avalue = + (see : symbolic_expansion) (original_sv_ty : rty) (proj_ty : rty) + (ctx : eval_ctx) : typed_avalue = (* Sanity check: if we have a proj_loans over a symbolic value, it should * contain regions which we will project *) sanity_check __FILE__ __LINE__ @@ -270,23 +273,29 @@ let apply_proj_loans_on_symbolic_expansion (span : Meta.span) span; (* Match *) let (value, ty) : avalue * ty = - match (see, original_sv_ty) with + match (see, proj_ty) with | SeLiteral lit, TLiteral _ -> ( AIgnored (Some { value = VLiteral lit; ty = original_sv_ty }), original_sv_ty ) - | SeAdt (variant_id, field_values), TAdt (_id, _generics) -> + | SeAdt (variant_id, field_values), TAdt (adt_id, generics) -> (* Project over the field values *) + let field_types = + AssociatedTypes.ctx_adt_get_inst_norm_field_rtypes span ctx adt_id + variant_id generics + in let field_values = - List.map + List.map2 (mk_aproj_loans_value_from_symbolic_value regions) - field_values + field_values field_types in (AAdt { variant_id; field_values }, original_sv_ty) | SeMutRef (bid, spc), TRef (r, ref_ty, RMut) -> (* Sanity check *) sanity_check __FILE__ __LINE__ (spc.sv_ty = ref_ty) span; (* Apply the projector to the borrowed value *) - let child_av = mk_aproj_loans_value_from_symbolic_value regions spc in + let child_av = + mk_aproj_loans_value_from_symbolic_value regions spc ref_ty + in (* Check if the region is in the set of projected regions (note that * we never project over static regions) *) if region_in_set r regions then @@ -304,7 +313,9 @@ let apply_proj_loans_on_symbolic_expansion (span : Meta.span) (* Sanity check *) sanity_check __FILE__ __LINE__ (spc.sv_ty = ref_ty) span; (* Apply the projector to the borrowed value *) - let child_av = mk_aproj_loans_value_from_symbolic_value regions spc in + let child_av = + mk_aproj_loans_value_from_symbolic_value regions spc ref_ty + in (* Check if the region is in the set of projected regions (note that * we never project over static regions) *) if region_in_set r regions then diff --git a/src/interp/InterpreterProjectors.mli b/src/interp/InterpreterProjectors.mli index 43cdc09d..4b19e309 100644 --- a/src/interp/InterpreterProjectors.mli +++ b/src/interp/InterpreterProjectors.mli @@ -13,6 +13,8 @@ open Contexts [ancestor_regions] [see] [original_sv_ty]: shouldn't have erased regions + [proj_ty]: shouldn't have erased regions + [eval_ctx] *) val apply_proj_loans_on_symbolic_expansion : Meta.span -> @@ -20,6 +22,8 @@ val apply_proj_loans_on_symbolic_expansion : RegionId.Set.t -> symbolic_expansion -> rty -> + rty -> + eval_ctx -> typed_avalue (** Convert a symbolic expansion *which is not a borrow* to a value *) diff --git a/src/interp/InterpreterStatements.ml b/src/interp/InterpreterStatements.ml index e9c91478..22dcac33 100644 --- a/src/interp/InterpreterStatements.ml +++ b/src/interp/InterpreterStatements.ml @@ -354,6 +354,7 @@ let pop_frame (config : config) (span : Meta.span) (pop_return_value : bool) (* Move the return value out of the return variable *) let v, ctx, cc1 = move_return_value config span pop_return_value ctx in let cc = cc_comp cc cc1 in + (* Check that the return value is valid (i.e., it doesn't contain the bottom value) *) let _ = match v with | None -> () @@ -1397,7 +1398,7 @@ and eval_function_call_symbolic_from_inst_sig (config : config) let ret_spc = mk_fresh_symbolic_value span ret_sv_ty in let ret_value = mk_typed_value_from_symbolic_value ret_spc in let ret_av regions = - mk_aproj_loans_value_from_symbolic_value regions ret_spc + mk_aproj_loans_value_from_symbolic_value regions ret_spc ret_sv_ty in let args_places = List.map (fun p -> S.mk_opt_place_from_op span p ctx) args diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index 1c68c8df..fc2452f0 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -122,10 +122,10 @@ let mk_typed_value_from_symbolic_value (svalue : symbolic_value) : typed_value = TODO: update to handle 'static *) -let mk_aproj_loans_value_from_symbolic_value (regions : RegionId.Set.t) - (svalue : symbolic_value) : typed_avalue = - if ty_has_regions_in_set regions svalue.sv_ty then - let av = ASymbolic (AProjLoans (svalue, [])) in +let mk_aproj_loans_value_from_symbolic_value (proj_regions : RegionId.Set.t) + (svalue : symbolic_value) (proj_ty : ty) : typed_avalue = + if ty_has_regions_in_set proj_regions proj_ty then + let av = ASymbolic (AProjLoans (svalue, proj_ty, [])) in let av : typed_avalue = { value = av; ty = svalue.sv_ty } in av else @@ -210,6 +210,10 @@ exception FoundGLoanContent of g_loan_content exception FoundAProjBorrows of symbolic_value * ty * (msymbolic_value * aproj) list +(** Utility exception *) +exception + FoundAProjLoans of symbolic_value * ty * (msymbolic_value * aproj) list + let symbolic_value_id_in_ctx (sv_id : SymbolicValueId.id) (ctx : eval_ctx) : bool = let obj = @@ -221,7 +225,7 @@ let symbolic_value_id_in_ctx (sv_id : SymbolicValueId.id) (ctx : eval_ctx) : method! visit_aproj env aproj = (match aproj with - | AProjLoans (sv, _) | AProjBorrows (sv, _, _) -> + | AProjLoans (sv, _, _) | AProjBorrows (sv, _, _) -> if sv.sv_id = sv_id then raise Found else () | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj env aproj diff --git a/src/interp/Invariants.ml b/src/interp/Invariants.ml index a996b51f..4d179608 100644 --- a/src/interp/Invariants.ml +++ b/src/interp/Invariants.ml @@ -688,14 +688,14 @@ let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = | ASymbolic aproj, ty -> ( let ty1 = Substitute.erase_regions ty in match aproj with - | AProjLoans (sv, _) -> + | AProjLoans (sv, proj_ty, _) -> let ty2 = Substitute.erase_regions sv.sv_ty in sanity_check __FILE__ __LINE__ (ty1 = ty2) span; (* Also check that the symbolic values contain regions of interest - * otherwise they should have been reduced to [_] *) let abs = Option.get info in sanity_check __FILE__ __LINE__ - (ty_has_regions_in_set abs.regions.owned sv.sv_ty) + (ty_has_regions_in_set abs.regions.owned proj_ty) span | AProjBorrows (sv, proj_ty, _) -> let ty2 = Substitute.erase_regions sv.sv_ty in @@ -739,7 +739,11 @@ type proj_borrows_info = { } [@@deriving show] -type proj_loans_info = { abs_id : AbstractionId.id; regions : RegionId.Set.t } +type proj_loans_info = { + abs_id : AbstractionId.id; + regions : RegionId.Set.t; + proj_ty : rty; +} [@@deriving show] type sv_info = { @@ -788,9 +792,9 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = let info = { info with aproj_borrows = binfo :: info.aproj_borrows } in update_info sv info in - let add_aproj_loans (sv : symbolic_value) abs_id regions : unit = + let add_aproj_loans (sv : symbolic_value) proj_ty abs_id regions : unit = let info = lookup_info sv in - let linfo = { abs_id; regions } in + let linfo = { abs_id; regions; proj_ty } in let info = { info with aproj_loans = linfo :: info.aproj_loans } in update_info sv info in @@ -811,7 +815,8 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = method! visit_aproj abs aproj = (let abs = Option.get abs in match aproj with - | AProjLoans (sv, _) -> add_aproj_loans sv abs.abs_id abs.regions.owned + | AProjLoans (sv, proj_ty, _) -> + add_aproj_loans sv proj_ty abs.abs_id abs.regions.owned | AProjBorrows (sv, proj_ty, _) -> add_aproj_borrows sv abs.abs_id abs.regions.owned proj_ty false | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); @@ -868,7 +873,7 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = in (* Check that the union of the loan projectors contains the borrow projections. *) List.iter - (fun binfo -> + (fun (binfo : proj_borrows_info) -> sanity_check __FILE__ __LINE__ (projection_contains span info.ty loan_regions binfo.proj_ty binfo.regions) diff --git a/src/llbc/AssociatedTypes.ml b/src/llbc/AssociatedTypes.ml index e18bafa0..fe9c5e5b 100644 --- a/src/llbc/AssociatedTypes.ml +++ b/src/llbc/AssociatedTypes.ml @@ -467,10 +467,11 @@ let type_decl_get_inst_norm_field_rtypes (span : Meta.span) (ctx : eval_ctx) List.map (ctx_normalize_ty (Some span) ctx) types (** Same as [ctx_adt_value_get_instantiated_field_rtypes] but normalizes the types *) -let ctx_adt_value_get_inst_norm_field_rtypes (span : Meta.span) (ctx : eval_ctx) - (adt : adt_value) (id : type_id) (generics : generic_args) : ty list = +let ctx_adt_get_inst_norm_field_rtypes (span : Meta.span) (ctx : eval_ctx) + (id : type_id) (variant_id : variant_id option) (generics : generic_args) : + ty list = let types = - ctx_adt_value_get_instantiated_field_types span ctx adt id generics + ctx_adt_get_instantiated_field_types span ctx id variant_id generics in List.map (ctx_normalize_ty (Some span) ctx) types @@ -485,15 +486,23 @@ let type_decl_get_inst_norm_field_etypes (span : Meta.span) (ctx : eval_ctx) let types = List.map (ctx_normalize_ty (Some span) ctx) types in List.map erase_regions types -(** Same as [ctx_adt_get_instantiated_field_types] but normalizes the types and +(** Same as [ctx_type_get_instantiated_field_types] but normalizes the types. *) +let ctx_type_get_inst_norm_field_rtypes (span : Meta.span) (ctx : eval_ctx) + (def_id : TypeDeclId.id) (opt_variant_id : VariantId.id option) + (generics : generic_args) : ty list = + let types = + ctx_type_get_instantiated_field_types ctx def_id opt_variant_id generics + in + List.map (ctx_normalize_ty (Some span) ctx) types + +(** Same as [ctx_type_get_instantiated_field_types] but normalizes the types and erases the regions. *) -let ctx_adt_get_inst_norm_field_etypes (span : Meta.span) (ctx : eval_ctx) +let ctx_type_get_inst_norm_field_etypes (span : Meta.span) (ctx : eval_ctx) (def_id : TypeDeclId.id) (opt_variant_id : VariantId.id option) (generics : generic_args) : ty list = let types = - ctx_adt_get_instantiated_field_types ctx def_id opt_variant_id generics + ctx_type_get_inst_norm_field_rtypes span ctx def_id opt_variant_id generics in - let types = List.map (ctx_normalize_ty (Some span) ctx) types in List.map erase_regions types (** Same as [substitute_signature] but normalizes the types *) diff --git a/src/llbc/Contexts.ml b/src/llbc/Contexts.ml index bfe9f99e..a53fa2b4 100644 --- a/src/llbc/Contexts.ml +++ b/src/llbc/Contexts.ml @@ -488,7 +488,7 @@ let env_filter_abs (f : abs -> bool) (env : env) : env = **IMPORTANT**: this function doesn't normalize the types, you may want to use the [AssociatedTypes] equivalent instead. *) -let ctx_adt_get_instantiated_field_types (ctx : eval_ctx) +let ctx_type_get_instantiated_field_types (ctx : eval_ctx) (def_id : TypeDeclId.id) (opt_variant_id : VariantId.id option) (generics : generic_args) : ty list = let def = ctx_lookup_type_decl ctx def_id in @@ -500,20 +500,24 @@ let ctx_adt_get_instantiated_field_types (ctx : eval_ctx) **IMPORTANT**: this function doesn't normalize the types, you may want to use the [AssociatedTypes] equivalent instead. *) -let ctx_adt_value_get_instantiated_field_types (span : Meta.span) - (ctx : eval_ctx) (adt : adt_value) (id : type_id) (generics : generic_args) - : ty list = +let ctx_adt_get_instantiated_field_types (span : Meta.span) (ctx : eval_ctx) + (id : type_id) (variant_id : variant_id option) (generics : generic_args) : + ty list = match id with | TAdtId id -> (* Retrieve the types of the fields *) - ctx_adt_get_instantiated_field_types ctx id adt.variant_id generics + ctx_type_get_instantiated_field_types ctx id variant_id generics | TTuple -> + cassert __FILE__ __LINE__ (variant_id = None) span + "Tuples don't have variants"; cassert __FILE__ __LINE__ (generics.regions = []) span "Tuples don't have region parameters"; generics.types | TBuiltin aty -> ( match aty with | TBox -> + cassert __FILE__ __LINE__ (variant_id = None) span + "Boxes don't have variants"; sanity_check __FILE__ __LINE__ (generics.regions = []) span; sanity_check __FILE__ __LINE__ (List.length generics.types = 1) span; sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index d9c06835..bd9f4358 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -36,8 +36,7 @@ module Values = struct let symbolic_value_proj_to_string (env : fmt_env) (sv : symbolic_value) (rty : ty) : string = - symbolic_value_id_to_pretty_string sv.sv_id - ^ " : " ^ ty_to_string env sv.sv_ty ^ " <: " ^ ty_to_string env rty + symbolic_value_id_to_pretty_string sv.sv_id ^ " <: " ^ ty_to_string env rty (* TODO: it may be a good idea to try to factorize this function with * typed_avalue_to_string. At some point we had done it, because [typed_value] @@ -127,7 +126,7 @@ module Values = struct let rec aproj_to_string (env : fmt_env) (pv : aproj) : string = match pv with - | AProjLoans (sv, given_back) -> + | AProjLoans (sv, rty, given_back) -> let given_back = if given_back = [] then "" else @@ -135,7 +134,7 @@ module Values = struct let given_back = List.map (aproj_to_string env) given_back in " (" ^ String.concat "," given_back ^ ") " in - "⌊" ^ symbolic_value_to_string env sv ^ given_back ^ "⌋" + "⌊" ^ symbolic_value_proj_to_string env sv rty ^ given_back ^ "⌋" | AProjBorrows (sv, rty, given_back) -> let given_back = if given_back = [] then "" diff --git a/src/llbc/Values.ml b/src/llbc/Values.ml index 275a9e1b..a93b7407 100644 --- a/src/llbc/Values.ml +++ b/src/llbc/Values.ml @@ -271,7 +271,7 @@ type abstract_shared_borrow = and abstract_shared_borrows = abstract_shared_borrow list and aproj = - | AProjLoans of symbolic_value * (msymbolic_value * aproj) list + | AProjLoans of symbolic_value * ty * (msymbolic_value * aproj) list (** A projector of loans over a symbolic value. Whenever we call a function, we introduce a symbolic value for diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 34606343..57b715b9 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -1856,7 +1856,7 @@ let compute_typed_avalue_proj_kind span (av : V.typed_avalue) : method! visit_ASymbolic env aproj = match aproj with - | V.AEndedProjLoans (_, _) | AProjLoans (_, _) -> + | V.AEndedProjLoans (_, _) | AProjLoans (_, _, _) -> has_loans := true; (* Continue exploring (same reasons as above) *) super#visit_ASymbolic env aproj @@ -2058,7 +2058,7 @@ and aproj_to_consumed_aux (ctx : bs_ctx) (aproj : V.aproj) : texpression option (* The value should have been introduced by a loan projector, and should not contain nested borrows, so we can't get there *) craise __FILE__ __LINE__ ctx.span "Unreachable" - | AEmpty | AProjLoans (_, _) | AProjBorrows (_, _, _) -> + | AEmpty | AProjLoans (_, _, _) | AProjBorrows (_, _, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" let typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) @@ -2266,7 +2266,7 @@ and aproj_to_given_back_aux (mp : mplace option) (aproj : V.aproj) (* Return the meta-value *) let ctx, var = fresh_var_for_symbolic_value mv ctx in (ctx, Some (mk_typed_pattern_from_var var mp)) - | AEmpty | AProjLoans (_, _) | AProjBorrows (_, _, _) -> + | AEmpty | AProjLoans (_, _, _) | AProjBorrows (_, _, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" let typed_avalue_to_given_back (mp : mplace option) (v : V.typed_avalue) From e868c90abc53813f16cc2e82147dfa87748a30d9 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 18:34:20 +0000 Subject: [PATCH 06/29] Fix minor issues --- src/interp/InterpreterBorrows.ml | 100 +++++++++++++++++---------- src/interp/InterpreterBorrowsCore.ml | 38 ++++++---- 2 files changed, 88 insertions(+), 50 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 8489de3c..534da2e6 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -1211,6 +1211,11 @@ and end_abstractions_aux (config : config) (span : Meta.span) and end_abstraction_loans (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_id : AbstractionId.id) : cm_fun = fun ctx -> + log#ldebug + (lazy + ("end_abstraction_loans:" ^ "\n- abs_id: " + ^ AbstractionId.to_string abs_id + ^ "\n- ctx:\n" ^ eval_ctx_to_string ctx)); (* Lookup the abstraction *) let abs = ctx_lookup_abs ctx abs_id in (* End the first loan we find. @@ -1441,11 +1446,29 @@ and end_abstraction_remove_from_context (_config : config) (span : Meta.span) - if we put aside the proj_borrows_shared, there should be exactly one intersecting proj_borrows, either in the concrete context or in an abstraction + + Note that we may get recursively get here after a sequence of updates which + look like this: + - attempt ending a loan projector + - end a borrow projector before, and by doing this actually end the loan projector + - retry ending the loan projector + We thus have to be careful about the fact that maybe the loan projector actually + doesn't exist anymore when we get here. *) and end_proj_loans_symbolic (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_id : AbstractionId.id) (regions : RegionId.Set.t) (sv : symbolic_value) (proj_ty : rty) : cm_fun = fun ctx -> + log#ldebug + (lazy + ("end_proj_loans_symbolic:" ^ "\n- abs_id: " + ^ AbstractionId.to_string abs_id + ^ "\n- regions: " + ^ RegionId.Set.to_string None regions + ^ "\n- sv: " + ^ symbolic_value_to_string ctx sv + ^ "\n- projection type: " ^ ty_to_string ctx proj_ty ^ "\n- ctx:\n" + ^ eval_ctx_to_string ctx)); (* Small helpers for sanity checks *) let check ctx = no_aproj_over_symbolic_in_context span sv ctx in (* Find the first proj_borrows which intersects the proj_loans *) @@ -1456,9 +1479,10 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) with | None -> (* We couldn't find any in the context: it means that the symbolic value - * is in the concrete environment (or that we dropped it, in which case - * it is completely absent). We thus simply need to replace the loans - * projector with an ended projector. *) + is in the concrete environment (or that we dropped it, in which case + it is completely absent). We thus simply need to replace the loans + projector with an ended projector. + *) let ctx = update_aproj_loans_to_ended span abs_id sv ctx in (* Sanity check *) check ctx; @@ -1519,40 +1543,42 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) (ctx, cc) | Some (NonSharedProj (abs_id', _proj_ty)) -> (* We found one projector of borrows in an abstraction: if it comes - * from this abstraction, we can end it directly, otherwise we need - * to end the abstraction where it came from first *) - if abs_id' = abs_id then ( - (* Note that it happens when a function returns a [&mut ...] which gets - expanded to [mut_borrow l s], and we end the borrow [l] (so [s] gets - reinjected in the parent abstraction without having been modified). - - The context looks like this: - {[ - abs'0 { - [s <: ...] - (s <: ...) - } - - // Note that [s] can't appear in other abstractions or in the - // regular environment (because we forbid the duplication of - // symbolic values which contain borrows). - ]} - *) - (* End the projector of borrows - TODO: not completely sure what to - * replace it with... Maybe we should introduce an ABottomProj? *) - let ctx = update_aproj_borrows span abs_id sv AEmpty ctx in - (* Sanity check: no other occurrence of an intersecting projector of borrows *) - sanity_check __FILE__ __LINE__ - (Option.is_none - (lookup_intersecting_aproj_borrows_opt span explore_shared regions - sv proj_ty ctx)) - span; - (* End the projector of loans *) - let ctx = update_aproj_loans_to_ended span abs_id sv ctx in - (* Sanity check *) - check ctx; - (* Continue *) - (ctx, fun e -> e)) + from this abstraction, we can end it directly, otherwise we need + to end the abstraction where it came from first *) + if abs_id' = abs_id then + (* TODO: what is below is wrong *) + raise (Failure "Unimplemented") + (* (* Note that it happens when a function returns a [&mut ...] which gets + expanded to [mut_borrow l s], and we end the borrow [l] (so [s] gets + reinjected in the parent abstraction without having been modified). + + The context looks like this: + {[ + abs'0 { + [s <: ...] + (s <: ...) + } + + // Note that [s] can't appear in other abstractions or in the + // regular environment (because we forbid the duplication of + // symbolic values which contain borrows). + ]} + *) + (* End the projector of borrows - TODO: not completely sure what to + * replace it with... Maybe we should introduce an ABottomProj? *) + let ctx = update_aproj_borrows span abs_id sv AEmpty ctx in + (* Sanity check: no other occurrence of an intersecting projector of borrows *) + sanity_check __FILE__ __LINE__ + (Option.is_none + (lookup_intersecting_aproj_borrows_opt span explore_shared regions + sv proj_ty ctx)) + span; + (* End the projector of loans *) + let ctx = update_aproj_loans_to_ended span abs_id sv ctx in + (* Sanity check *) + check ctx; + (* Continue *) + (ctx, fun e -> e) *) else (* The borrows proj comes from a different abstraction: end it. *) let ctx, cc = end_abstraction_aux config span chain abs_id' ctx in diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index a5372807..a9168fef 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -1047,11 +1047,12 @@ let update_intersecting_aproj_loans (span : Meta.span) fields in {!constructor:Values.aproj.AProjLoans} (we don't return the symbolic value, because it is equal to [sv]). - Sanity check: we check that there is exactly one projector which corresponds + Sanity check: we check that there is not more than one projector which corresponds to the couple (abstraction id, symbolic value). *) -let lookup_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) - (sv : symbolic_value) (ctx : eval_ctx) : (msymbolic_value * aproj) list = +let lookup_aproj_loans_opt (span : Meta.span) (abs_id : AbstractionId.id) + (sv : symbolic_value) (ctx : eval_ctx) : + (msymbolic_value * aproj) list option = (* Small helpers for sanity checks *) let found = ref None in let set_found x = @@ -1084,7 +1085,11 @@ let lookup_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) (* Apply *) obj#visit_eval_ctx None ctx; (* Return *) - Option.get !found + !found + +let lookup_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) + (sv : symbolic_value) (ctx : eval_ctx) : (msymbolic_value * aproj) list = + Option.get (lookup_aproj_loans_opt span abs_id sv ctx) (** Helper function: might break invariants. @@ -1182,19 +1187,26 @@ let update_aproj_borrows (span : Meta.span) (abs_id : AbstractionId.id) (** Helper function: might break invariants. - Converts an {!Values.aproj.AProjLoans} to an {!Values.aproj.AEndedProjLoans}. The projector is identified - by a symbolic value and an abstraction id. + Converts an {!Values.aproj.AProjLoans} to an {!Values.aproj.AEndedProjLoans}. The + projector is identified by a symbolic value and an abstraction id. + + **Remark:** the loan projector is allowed not to exist in the context anymore, + in which case this function does nothing. *) let update_aproj_loans_to_ended (span : Meta.span) (abs_id : AbstractionId.id) (sv : symbolic_value) (ctx : eval_ctx) : eval_ctx = (* Lookup the projector of loans *) - let given_back = lookup_aproj_loans span abs_id sv ctx in - (* Create the new value for the projector *) - let nproj = AEndedProjLoans (sv, given_back) in - (* Insert it *) - let ctx = update_aproj_loans span abs_id sv nproj ctx in - (* Return *) - ctx + match lookup_aproj_loans_opt span abs_id sv ctx with + | Some given_back -> + (* Create the new value for the projector *) + let nproj = AEndedProjLoans (sv, given_back) in + (* Insert it *) + let ctx = update_aproj_loans span abs_id sv nproj ctx in + (* Return *) + ctx + | _ -> + (* The loan projector doesn't exist anymore: we have nothing to do *) + ctx let no_aproj_over_symbolic_in_context (span : Meta.span) (sv : symbolic_value) (ctx : eval_ctx) : unit = From d3dd15ec299ed0102f896ff51adb8110c1162f15 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 19:15:21 +0000 Subject: [PATCH 07/29] Update the extraction --- src/llbc/Print.ml | 4 +- src/llbc/Values.ml | 6 ++ src/symbolic/SymbolicToPure.ml | 142 ++++++++++++++++++++++++--------- 3 files changed, 114 insertions(+), 38 deletions(-) diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index bd9f4358..a78fcb3c 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -145,13 +145,13 @@ module Values = struct in "(" ^ symbolic_value_proj_to_string env sv rty ^ given_back ^ ")" | AEndedProjLoans (_, given_back) -> - if given_back = [] then "_" + if given_back = [] then "ended_aproj_loans _" else let given_back = List.map snd given_back in let given_back = List.map (aproj_to_string env) given_back in "ended_aproj_loans (" ^ String.concat "," given_back ^ ")" | AEndedProjBorrows (_, given_back) -> - if given_back = [] then "_" + if given_back = [] then "ended_aproj_borrows _" else let given_back = List.map snd given_back in let given_back = List.map (aproj_to_string env) given_back in diff --git a/src/llbc/Values.ml b/src/llbc/Values.ml index a93b7407..a436c953 100644 --- a/src/llbc/Values.ml +++ b/src/llbc/Values.ml @@ -310,6 +310,9 @@ and aproj = We can later end the projector of loans if [s@0] is not referenced anywhere in the context below a projector of borrows which intersects this projector of loans. + + TODO: the projection type is redundant with the type of the avalue + TODO: we shouldn't use a symbolic value but rather a symbolic value id *) | AProjBorrows of symbolic_value * ty * (msymbolic_value * aproj) list (** Note that an AProjBorrows only operates on a value which is not below @@ -333,6 +336,9 @@ and aproj = abs2 {'b} { proj_loans (&'a mut &'c mut u32, &'b mut &'c mut u32)) } ... ]} + + TODO: the projection type is redundant with the type of the avalue + TODO: we shouldn't use a symbolic value but rather a symbolic value id *) | AEndedProjLoans of msymbolic_value * (msymbolic_value * aproj) list (** An ended projector of loans over a symbolic value. diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 57b715b9..a6cda708 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -1816,16 +1816,25 @@ type typed_avalue_kind = | UnknownProj (** No borrows, loans or projections inside the value so we can't know for sure *) -let compute_typed_avalue_proj_kind span (av : V.typed_avalue) : - typed_avalue_kind = +let compute_typed_avalue_proj_kind span type_infos + (abs_regions : T.RegionId.Set.t) (av : V.typed_avalue) : typed_avalue_kind = let has_borrows = ref false in let has_mut_borrows = ref false in let has_loans = ref false in let has_mut_loans = ref false in + let keep_region (r : T.region) = + match r with + | T.RVar (Free rid) -> T.RegionId.Set.mem rid abs_regions + | _ -> false + in let visitor = object inherit [_] V.iter_typed_avalue as super + method! visit_typed_avalue _ av = + (* Remember the type of the current value *) + super#visit_typed_avalue av.ty av + method! visit_ALoan env lc = has_loans := true; begin @@ -1854,19 +1863,42 @@ let compute_typed_avalue_proj_kind span (av : V.typed_avalue) : (* Continue exploring as a sanity check: we want to make sure we don't find loans *) super#visit_ABorrow env bc - method! visit_ASymbolic env aproj = + method! visit_ASymbolic ty aproj = match aproj with - | V.AEndedProjLoans (_, _) | AProjLoans (_, _, _) -> + | V.AEndedProjLoans (_, _) -> + has_loans := true; + (* We need to check wether the projected loans are mutable or not *) + if + TypesUtils.ty_has_mut_borrow_for_region_in_pred type_infos + keep_region ty + then has_mut_loans := true; + (* Continue exploring (same reasons as above) *) + super#visit_ASymbolic ty aproj + | AProjLoans (_, _, _) -> + (* TODO: we should probably fail here *) has_loans := true; (* Continue exploring (same reasons as above) *) - super#visit_ASymbolic env aproj - | AEndedProjBorrows _ | AEmpty | AProjBorrows (_, _, _) -> + super#visit_ASymbolic ty aproj + | AEndedProjBorrows _ -> + has_borrows := true; + (* We need to check wether the projected borrows are mutable or not *) + if + TypesUtils.ty_has_mut_borrow_for_region_in_pred type_infos + keep_region ty + then has_mut_borrows := true; + (* Continue exploring (same reasons as above) *) + super#visit_ASymbolic ty aproj + | AProjBorrows (_, _, _) -> + (* TODO: we should probably fail here *) has_borrows := true; (* Continue exploring (same reasons as above) *) - super#visit_ASymbolic env aproj + super#visit_ASymbolic ty aproj + | AEmpty -> + (* Continue exploring (same reasons as above) *) + super#visit_ASymbolic ty aproj end in - visitor#visit_typed_avalue () av; + visitor#visit_typed_avalue av.ty av; cassert __FILE__ __LINE__ ((not !has_borrows) || not !has_loans) span "Unreachable"; @@ -1892,18 +1924,20 @@ let compute_typed_avalue_proj_kind span (av : V.typed_avalue) : ]} *) let rec typed_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) - (ectx : C.eval_ctx) (av : V.typed_avalue) : texpression option = + (ectx : C.eval_ctx) (abs_regions : T.RegionId.Set.t) (av : V.typed_avalue) : + texpression option = let value = match av.value with - | AAdt adt_v -> adt_avalue_to_consumed_aux ~filter ctx ectx av adt_v + | AAdt adt_v -> + adt_avalue_to_consumed_aux ~filter ctx ectx abs_regions av adt_v | ABottom -> craise __FILE__ __LINE__ ctx.span "Unreachable" - | ALoan lc -> aloan_content_to_consumed_aux ~filter ctx ectx lc + | ALoan lc -> aloan_content_to_consumed_aux ~filter ctx ectx abs_regions lc | ABorrow _ -> (* This value should have been generated by a loan projector: there can't be aborrows unless there are nested borrows, which are not supported yet. *) craise __FILE__ __LINE__ ctx.span "Unreachable" - | ASymbolic aproj -> aproj_to_consumed_aux ctx aproj + | ASymbolic aproj -> aproj_to_consumed_aux ctx abs_regions aproj | AIgnored mv -> ( if filter then None else @@ -1925,13 +1959,16 @@ let rec typed_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) value and adt_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) - (ectx : C.eval_ctx) (av : V.typed_avalue) (adt_v : V.adt_avalue) : - texpression option = + (ectx : C.eval_ctx) (abs_regions : T.RegionId.Set.t) (av : V.typed_avalue) + (adt_v : V.adt_avalue) : texpression option = (* We do not do the same thing depending on whether we visit a tuple or a "regular" ADT *) let adt_id, _ = TypesUtils.ty_as_adt av.ty in (* Check if the ADT contains borrows *) - match compute_typed_avalue_proj_kind ctx.span av with + match + compute_typed_avalue_proj_kind ctx.span ctx.type_ctx.type_infos abs_regions + av + with | BorrowProj _ -> craise __FILE__ __LINE__ ctx.span "Unreachable" | UnknownProj -> (* If we filter: ignore the value. @@ -1940,7 +1977,7 @@ and adt_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) else let fields = List.map - (typed_avalue_to_consumed_aux ~filter ctx ectx) + (typed_avalue_to_consumed_aux ~filter ctx ectx abs_regions) adt_v.field_values in let fields = List.map Option.get fields in @@ -1964,7 +2001,7 @@ and adt_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) | TBuiltin _ | TAdtId _ -> borrow_kind = BShared in List.map - (typed_avalue_to_consumed_aux ~filter ctx ectx) + (typed_avalue_to_consumed_aux ~filter ctx ectx abs_regions) adt_v.field_values in match adt_id with @@ -2008,7 +2045,8 @@ and adt_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) end and aloan_content_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) - (ectx : C.eval_ctx) (lc : V.aloan_content) : texpression option = + (ectx : C.eval_ctx) (abs_regions : T.RegionId.Set.t) (lc : V.aloan_content) + : texpression option = match lc with | AMutLoan (_, _, _) | ASharedLoan (_, _, _, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" @@ -2040,8 +2078,8 @@ and aloan_content_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) (* This case only happens with nested borrows *) craise __FILE__ __LINE__ ctx.span "Unimplemented" -and aproj_to_consumed_aux (ctx : bs_ctx) (aproj : V.aproj) : texpression option - = +and aproj_to_consumed_aux (ctx : bs_ctx) (abs_regions : T.RegionId.Set.t) + (aproj : V.aproj) : texpression option = match aproj with | V.AEndedProjLoans (msv, []) -> (* The symbolic value was left unchanged *) @@ -2062,17 +2100,31 @@ and aproj_to_consumed_aux (ctx : bs_ctx) (aproj : V.aproj) : texpression option craise __FILE__ __LINE__ ctx.span "Unreachable" let typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) - (av : V.typed_avalue) : texpression option = + (abs_regions : T.RegionId.Set.t) (av : V.typed_avalue) : texpression option + = (* Check if the value was generated from a loan projector: if yes, and if it contains mutable loans, then we generate a consumed value (because upon ending the borrow we consumed a value). Otherwise we ignore it. *) - match compute_typed_avalue_proj_kind ctx.span av with - | LoanProj BMut -> typed_avalue_to_consumed_aux ~filter:true ctx ectx av + log#ldebug + (lazy ("typed_avalue_to_consumed: " ^ typed_avalue_to_string ectx av)); + match + compute_typed_avalue_proj_kind ctx.span ctx.type_ctx.type_infos abs_regions + av + with + | LoanProj BMut -> + log#ldebug + (lazy + "typed_avalue_to_consumed: the value contains mutable loan projectors"); + typed_avalue_to_consumed_aux ~filter:true ctx ectx abs_regions av | LoanProj BShared | BorrowProj _ | UnknownProj -> (* If it is a borrow proj we ignore it. If it is an unknown projection, it means the value doesn't contain loans nor borrows, so nothing is consumed upon ending the abstraction: we can ignore it as well. *) + log#ldebug + (lazy + "typed_avalue_to_consumed: the value doesn't contains mutable loan \ + projectors (ignoring it)"); None (** Convert the abstraction values in an abstraction to consumed values. @@ -2081,9 +2133,14 @@ let typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) *) let abs_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) (abs : V.abs) : texpression list = - log#ldebug (lazy ("abs_to_consumed:\n" ^ abs_to_string ctx abs)); + log#ldebug + (lazy + ("abs_to_consumed:\n" ^ abs_to_string ctx abs ^ "\n- raw: " + ^ V.show_abs abs)); let values = - List.filter_map (typed_avalue_to_consumed ctx ectx) abs.avalues + List.filter_map + (typed_avalue_to_consumed ctx ectx abs.regions.owned) + abs.avalues in log#ldebug (lazy @@ -2131,11 +2188,13 @@ let translate_opt_mplace (p : S.mplace option) : mplace option = - [under_mut]: if [true] it means we are below a mutable borrow. This influences whether we filter values or not. *) -let rec typed_avalue_to_given_back_aux ~(filter : bool) (mp : mplace option) - (av : V.typed_avalue) (ctx : bs_ctx) : bs_ctx * typed_pattern option = +let rec typed_avalue_to_given_back_aux ~(filter : bool) + (abs_regions : T.RegionId.Set.t) (mp : mplace option) (av : V.typed_avalue) + (ctx : bs_ctx) : bs_ctx * typed_pattern option = let (ctx, value) : _ * typed_pattern option = match av.value with - | AAdt adt_v -> adt_avalue_to_given_back_aux ~filter av adt_v ctx + | AAdt adt_v -> + adt_avalue_to_given_back_aux ~filter abs_regions av adt_v ctx | ABottom -> craise __FILE__ __LINE__ ctx.span "Unreachable" | ALoan _ -> (* The avalue should have been generated by a borrow projector: this case is unreachable *) @@ -2159,10 +2218,14 @@ let rec typed_avalue_to_given_back_aux ~(filter : bool) (mp : mplace option) (* Return *) (ctx, value) -and adt_avalue_to_given_back_aux ~(filter : bool) (av : V.typed_avalue) +and adt_avalue_to_given_back_aux ~(filter : bool) + (abs_regions : T.RegionId.Set.t) (av : V.typed_avalue) (adt_v : V.adt_avalue) (ctx : bs_ctx) : bs_ctx * typed_pattern option = (* Check if the ADT contains borrows *) - match compute_typed_avalue_proj_kind ctx.span av with + match + compute_typed_avalue_proj_kind ctx.span ctx.type_ctx.type_infos abs_regions + av + with | LoanProj _ -> craise __FILE__ __LINE__ ctx.span "Unreachable" | UnknownProj -> (* If we filter: ignore the pattern. @@ -2191,7 +2254,8 @@ and adt_avalue_to_given_back_aux ~(filter : bool) (av : V.typed_avalue) | TBuiltin _ | TAdtId _ -> borrow_kind = BShared in List.fold_left_map - (fun ctx fv -> typed_avalue_to_given_back_aux ~filter mp fv ctx) + (fun ctx fv -> + typed_avalue_to_given_back_aux ~filter abs_regions mp fv ctx) ctx adt_v.field_values in match adt_id with @@ -2269,14 +2333,19 @@ and aproj_to_given_back_aux (mp : mplace option) (aproj : V.aproj) | AEmpty | AProjLoans (_, _, _) | AProjBorrows (_, _, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" -let typed_avalue_to_given_back (mp : mplace option) (v : V.typed_avalue) - (ctx : bs_ctx) : bs_ctx * typed_pattern option = +let typed_avalue_to_given_back (abs_regions : T.RegionId.Set.t) + (mp : mplace option) (v : V.typed_avalue) (ctx : bs_ctx) : + bs_ctx * typed_pattern option = (* Check if the value was generated from a borrow projector: if yes, and if it contains mutable borrows we generate a given back pattern (because upon ending the borrow the abstraction gave back a value). Otherwise we ignore it. *) - match compute_typed_avalue_proj_kind ctx.span v with - | BorrowProj BMut -> typed_avalue_to_given_back_aux mp ~filter:true v ctx + match + compute_typed_avalue_proj_kind ctx.span ctx.type_ctx.type_infos abs_regions + v + with + | BorrowProj BMut -> + typed_avalue_to_given_back_aux abs_regions mp ~filter:true v ctx | BorrowProj BShared | LoanProj _ | UnknownProj -> (* If it is a loan proj we ignore it. If it is an unknown projection, it means the value doesn't contain loans nor borrows, so nothing @@ -2296,7 +2365,8 @@ let abs_to_given_back (mpl : mplace option list option) (abs : V.abs) in let ctx, values = List.fold_left_map - (fun ctx (mp, av) -> typed_avalue_to_given_back mp av ctx) + (fun ctx (mp, av) -> + typed_avalue_to_given_back abs.regions.owned mp av ctx) ctx avalues in let values = List.filter_map (fun x -> x) values in From c8c09ee1423aec2310e1fdcc94104cf5ef39223e Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 19:42:26 +0000 Subject: [PATCH 08/29] Fix minor issues with non-expandable svalues containing shared borrows --- src/interp/InterpreterExpansion.ml | 9 +++--- src/interp/InterpreterExpressions.ml | 42 +++++++++++++--------------- src/llbc/ValuesUtils.ml | 14 ++++++++-- src/symbolic/SymbolicToPure.ml | 11 -------- 4 files changed, 34 insertions(+), 42 deletions(-) diff --git a/src/interp/InterpreterExpansion.ml b/src/interp/InterpreterExpansion.ml index b8e2545f..b1fc6d0d 100644 --- a/src/interp/InterpreterExpansion.ml +++ b/src/interp/InterpreterExpansion.ml @@ -620,11 +620,10 @@ let greedy_expand_symbolics_with_borrows (config : config) (span : Meta.span) : inherit [_] iter_eval_ctx method! visit_VSymbolic _ sv = - if ty_has_borrows (Some span) ctx.type_ctx.type_infos sv.sv_ty then - (* Ignore arrays and slices, as we can't expand them *) - match sv.sv_ty with - | TAdt (TBuiltin (TArray | TSlice), _) -> () - | _ -> raise (FoundSymbolicValue sv) + if + ValuesUtils.symbolic_value_is_greedily_expandable (Some span) + ctx.type_ctx.type_infos sv + then raise (FoundSymbolicValue sv) else () (** Don't enter abstractions *) diff --git a/src/interp/InterpreterExpressions.ml b/src/interp/InterpreterExpressions.ml index 7cf47474..4da120c9 100644 --- a/src/interp/InterpreterExpressions.ml +++ b/src/interp/InterpreterExpressions.ml @@ -17,14 +17,14 @@ open Errors let log = Logging.expressions_log (** As long as there are symbolic values at a given place (potentially in subvalues) - which contain borrows and are primitively copyable, expand them. + which contain borrows and are expandable, expand them. We use this function before copying values. Note that the place should have been prepared so that there are no remaining loans. *) -let expand_primitively_copyable_at_place (config : config) (span : Meta.span) +let expand_if_borrows_at_place (config : config) (span : Meta.span) (access : access_kind) (p : place) : cm_fun = fun ctx -> (* Small helper *) @@ -32,8 +32,8 @@ let expand_primitively_copyable_at_place (config : config) (span : Meta.span) fun ctx -> let v = read_place span access p ctx in match - find_first_primitively_copyable_sv_with_borrows (Some span) - ctx.type_ctx.type_infos v + find_first_expandable_sv_with_borrows (Some span) ctx.type_ctx.type_infos + v with | None -> (ctx, fun e -> e) | Some sv -> @@ -67,8 +67,7 @@ let read_place_check (span : Meta.span) (access : access_kind) (p : place) v let access_rplace_reorganize_and_read (config : config) (span : Meta.span) - (expand_prim_copy : bool) (access : access_kind) (p : place) - (ctx : eval_ctx) : + (greedy_expand : bool) (access : access_kind) (p : place) (ctx : eval_ctx) : typed_value * eval_ctx * (SymbolicAst.expression -> SymbolicAst.expression) = (* Make sure we can evaluate the path *) @@ -79,8 +78,7 @@ let access_rplace_reorganize_and_read (config : config) (span : Meta.span) * borrows) *) let ctx, cc = comp cc - (if expand_prim_copy then - expand_primitively_copyable_at_place config span access p ctx + (if greedy_expand then expand_if_borrows_at_place config span access p ctx else (ctx, fun e -> e)) in (* Read the place - note that this checks that the value doesn't contain bottoms *) @@ -89,10 +87,10 @@ let access_rplace_reorganize_and_read (config : config) (span : Meta.span) (ty_value, ctx, cc) let access_rplace_reorganize (config : config) (span : Meta.span) - (expand_prim_copy : bool) (access : access_kind) (p : place) : cm_fun = + (greedy_expand : bool) (access : access_kind) (p : place) : cm_fun = fun ctx -> let _, ctx, f = - access_rplace_reorganize_and_read config span expand_prim_copy access p ctx + access_rplace_reorganize_and_read config span greedy_expand access p ctx in (ctx, f) @@ -256,13 +254,13 @@ let prepare_eval_operand_reorganize (config : config) (span : Meta.span) (* Access the value *) let access = Read in (* Expand the symbolic values, if necessary *) - let expand_prim_copy = true in - access_rplace_reorganize config span expand_prim_copy access p ctx + let greedy_expand = true in + access_rplace_reorganize config span greedy_expand access p ctx | Move p -> (* Access the value *) let access = Move in - let expand_prim_copy = false in - access_rplace_reorganize config span expand_prim_copy access p ctx + let greedy_expand = false in + access_rplace_reorganize config span greedy_expand access p ctx (** Evaluate an operand, without reorganizing the context before *) let eval_operand_no_reorganize (config : config) (span : Meta.span) @@ -347,7 +345,7 @@ let eval_operand_no_reorganize (config : config) (span : Meta.span) span "Can not copy a value containing bottom"; sanity_check __FILE__ __LINE__ (Option.is_none - (find_first_primitively_copyable_sv_with_borrows (Some span) + (find_first_expandable_sv_with_borrows (Some span) ctx.type_ctx.type_infos v)) span; (* Copy the value *) @@ -709,10 +707,9 @@ let eval_rvalue_ref (config : config) (span : Meta.span) (p : place) | _ -> craise __FILE__ __LINE__ span "Unreachable" in - let expand_prim_copy = false in + let greedy_expand = false in let v, ctx, cc = - access_rplace_reorganize_and_read config span expand_prim_copy access p - ctx + access_rplace_reorganize_and_read config span greedy_expand access p ctx in (* Generate the fresh borrow id *) let bid = fresh_borrow_id () in @@ -754,10 +751,9 @@ let eval_rvalue_ref (config : config) (span : Meta.span) (p : place) | BMut -> (* Access the value *) let access = Write in - let expand_prim_copy = false in + let greedy_expand = false in let v, ctx, cc = - access_rplace_reorganize_and_read config span expand_prim_copy access p - ctx + access_rplace_reorganize_and_read config span greedy_expand access p ctx in (* Compute the rvalue - wrap the value in a mutable borrow with a fresh id *) let bid = fresh_borrow_id () in @@ -875,9 +871,9 @@ let eval_rvalue_not_global (config : config) (span : Meta.span) let eval_fake_read (config : config) (span : Meta.span) (p : place) : cm_fun = fun ctx -> - let expand_prim_copy = false in + let greedy_expand = false in let v, ctx, cc = - access_rplace_reorganize_and_read config span expand_prim_copy Read p ctx + access_rplace_reorganize_and_read config span greedy_expand Read p ctx in cassert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions v)) diff --git a/src/llbc/ValuesUtils.ml b/src/llbc/ValuesUtils.ml index 147ef962..f4ff026f 100644 --- a/src/llbc/ValuesUtils.ml +++ b/src/llbc/ValuesUtils.ml @@ -164,7 +164,16 @@ let outer_loans_in_value (v : typed_value) : bool = false with Found -> true -let find_first_primitively_copyable_sv_with_borrows span +let symbolic_value_is_greedily_expandable (span : Meta.span option) + (type_infos : TypesAnalysis.type_infos) (sv : symbolic_value) : bool = + if ty_has_borrows span type_infos sv.sv_ty then + (* Ignore arrays and slices, as we can't expand them *) + match sv.sv_ty with + | TAdt (TBuiltin (TArray | TSlice), _) -> false + | _ -> true + else false + +let find_first_expandable_sv_with_borrows (span : Meta.span option) (type_infos : TypesAnalysis.type_infos) (v : typed_value) : symbolic_value option = (* The visitor *) @@ -173,8 +182,7 @@ let find_first_primitively_copyable_sv_with_borrows span inherit [_] iter_typed_value method! visit_VSymbolic _ sv = - let ty = sv.sv_ty in - if ty_is_copyable ty && ty_has_borrows span type_infos ty then + if symbolic_value_is_greedily_expandable span type_infos sv then raise (FoundSymbolicValue sv) else () end diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index a6cda708..51a05057 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -722,13 +722,6 @@ let rec translate_fwd_ty (span : Meta.span option) (type_infos : type_infos) mk_simpl_tuple_ty t_generics.types | TBuiltin TBox -> ( (* We eliminate boxes *) - (* No general parametricity for now *) - cassert_opt_span __FILE__ __LINE__ - (not - (List.exists - (TypesUtils.ty_has_borrows span type_infos) - generics.types)) - span "ADTs containing borrows are not supported yet"; match t_generics.types with | [ bty ] -> bty | _ -> @@ -821,10 +814,6 @@ let rec translate_back_ty (span : Meta.span option) (type_infos : type_infos) Some (TAdt (type_id, generics)) else None | TBuiltin TBox -> ( - (* Don't accept ADTs (which are not tuples) with borrows for now *) - cassert_opt_span __FILE__ __LINE__ - (not (TypesUtils.ty_has_borrows span type_infos ty)) - span "ADTs containing borrows are not supported yet"; (* Eliminate the box *) match generics.types with | [ bty ] -> translate bty From 4e5f706f680b319b739d592cdc60e919caa101f4 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Dec 2024 19:43:50 +0000 Subject: [PATCH 09/29] Add some tests --- tests/coq/misc/AdtBorrows.v | 29 +++++++++++++++++++++++++++++ tests/fstar/misc/AdtBorrows.fst | 24 ++++++++++++++++++++++++ tests/lean/AdtBorrows.lean | 26 ++++++++++++++++++++++++++ tests/src/adt-borrows.rs | 23 +++++++++++++++++++++++ 4 files changed, 102 insertions(+) diff --git a/tests/coq/misc/AdtBorrows.v b/tests/coq/misc/AdtBorrows.v index 75ad9ebe..a857afd1 100644 --- a/tests/coq/misc/AdtBorrows.v +++ b/tests/coq/misc/AdtBorrows.v @@ -232,4 +232,33 @@ Definition use_mut_wrapper2 : result unit := massert (y s= 11%i32) . +(** [adt_borrows::array_shared_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 143:0-145:1 *) +Definition array_shared_borrow + {N : usize} (x : array u32 N) : result (array u32 N) := + Ok x +. + +(** [adt_borrows::array_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 147:0-149:1 *) +Definition array_mut_borrow + {N : usize} (x : array u32 N) : + result ((array u32 N) * (array u32 N -> array u32 N)) + := + let back := fun (ret : array u32 N) => ret in Ok (x, back) +. + +(** [adt_borrows::boxed_slice_shared_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 151:0-153:1 *) +Definition boxed_slice_shared_borrow (x : slice u32) : result (slice u32) := + Ok x +. + +(** [adt_borrows::boxed_slice_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 155:0-157:1 *) +Definition boxed_slice_mut_borrow + (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := + let back := fun (ret : slice u32) => ret in Ok (x, back) +. + End AdtBorrows. diff --git a/tests/fstar/misc/AdtBorrows.fst b/tests/fstar/misc/AdtBorrows.fst index 9fadfa49..43cf247c 100644 --- a/tests/fstar/misc/AdtBorrows.fst +++ b/tests/fstar/misc/AdtBorrows.fst @@ -160,3 +160,27 @@ let use_mut_wrapper2 : result unit = if y = 11 then Ok () else Fail Failure else Fail Failure +(** [adt_borrows::array_shared_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 143:0-145:1 *) +let array_shared_borrow (#n : usize) (x : array u32 n) : result (array u32 n) = + Ok x + +(** [adt_borrows::array_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 147:0-149:1 *) +let array_mut_borrow + (#n : usize) (x : array u32 n) : + result ((array u32 n) & (array u32 n -> array u32 n)) + = + let back = fun ret -> ret in Ok (x, back) + +(** [adt_borrows::boxed_slice_shared_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 151:0-153:1 *) +let boxed_slice_shared_borrow (x : slice u32) : result (slice u32) = + Ok x + +(** [adt_borrows::boxed_slice_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 155:0-157:1 *) +let boxed_slice_mut_borrow + (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = + let back = fun ret -> ret in Ok (x, back) + diff --git a/tests/lean/AdtBorrows.lean b/tests/lean/AdtBorrows.lean index 473d5cc6..430412a7 100644 --- a/tests/lean/AdtBorrows.lean +++ b/tests/lean/AdtBorrows.lean @@ -178,4 +178,30 @@ def use_mut_wrapper2 : Result Unit := let y := create_back1 { w with y := (unwrap_back1 py1).y } massert (y = 11#i32) +/- [adt_borrows::array_shared_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 143:0-145:1 -/ +def array_shared_borrow {N : Usize} (x : Array U32 N) : Result (Array U32 N) := + Result.ok x + +/- [adt_borrows::array_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 147:0-149:1 -/ +def array_mut_borrow + {N : Usize} (x : Array U32 N) : + Result ((Array U32 N) × (Array U32 N → Array U32 N)) + := + let back := fun ret => ret + Result.ok (x, back) + +/- [adt_borrows::boxed_slice_shared_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 151:0-153:1 -/ +def boxed_slice_shared_borrow (x : Slice U32) : Result (Slice U32) := + Result.ok x + +/- [adt_borrows::boxed_slice_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 155:0-157:1 -/ +def boxed_slice_mut_borrow + (x : Slice U32) : Result ((Slice U32) × (Slice U32 → Slice U32)) := + let back := fun ret => ret + Result.ok (x, back) + end adt_borrows diff --git a/tests/src/adt-borrows.rs b/tests/src/adt-borrows.rs index 73e71bbc..645550ff 100644 --- a/tests/src/adt-borrows.rs +++ b/tests/src/adt-borrows.rs @@ -132,3 +132,26 @@ fn use_mut_wrapper2() { assert!(x == 1); assert!(y == 11); } + +// +// Arrays/slices containing borrows +// +// Those have the peculiarity of requiring the manipulation of non-expandable +// symbolic values containing borrows. +// + +fn array_shared_borrow<'a, const N: usize>(x: [&'a u32; N]) -> [&'a u32; N] { + x +} + +fn array_mut_borrow<'a, const N: usize>(x: [&'a mut u32; N]) -> [&'a mut u32; N] { + x +} + +fn boxed_slice_shared_borrow(x : Box<[&u32]>) -> Box<[&u32]> { + x +} + +fn boxed_slice_mut_borrow(x : Box<[&mut u32]>) -> Box<[&mut u32]> { + x +} From b18a3dffd33d15e1a35a25555486f5fdd9186f8b Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 16 Dec 2024 08:17:43 +0100 Subject: [PATCH 10/29] Add a comment to adt-borrows.rs --- tests/coq/misc/AdtBorrows.v | 56 ++++++++++++++++----------------- tests/fstar/misc/AdtBorrows.fst | 56 ++++++++++++++++----------------- tests/lean/AdtBorrows.lean | 56 ++++++++++++++++----------------- tests/src/adt-borrows.rs | 3 ++ 4 files changed, 87 insertions(+), 84 deletions(-) diff --git a/tests/coq/misc/AdtBorrows.v b/tests/coq/misc/AdtBorrows.v index a857afd1..15cd9468 100644 --- a/tests/coq/misc/AdtBorrows.v +++ b/tests/coq/misc/AdtBorrows.v @@ -9,25 +9,25 @@ Local Open Scope Primitives_scope. Module AdtBorrows. (** [adt_borrows::SharedWrapper] - Source: 'tests/src/adt-borrows.rs', lines 4:0-4:35 *) + Source: 'tests/src/adt-borrows.rs', lines 7:0-7:35 *) Definition SharedWrapper_t (T : Type) : Type := T. (** [adt_borrows::{adt_borrows::SharedWrapper<'a, T>}::create]: - Source: 'tests/src/adt-borrows.rs', lines 7:4-9:5 *) + Source: 'tests/src/adt-borrows.rs', lines 10:4-12:5 *) Definition sharedWrapper_create {T : Type} (x : T) : result (SharedWrapper_t T) := Ok x . (** [adt_borrows::{adt_borrows::SharedWrapper<'a, T>}::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 11:4-13:5 *) + Source: 'tests/src/adt-borrows.rs', lines 14:4-16:5 *) Definition sharedWrapper_unwrap {T : Type} (self : SharedWrapper_t T) : result T := Ok self . (** [adt_borrows::use_shared_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 16:0-21:1 *) + Source: 'tests/src/adt-borrows.rs', lines 19:0-24:1 *) Definition use_shared_wrapper : result unit := w <- sharedWrapper_create 0%i32; p <- sharedWrapper_unwrap w; @@ -35,7 +35,7 @@ Definition use_shared_wrapper : result unit := . (** [adt_borrows::SharedWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 23:0-25:1 *) + Source: 'tests/src/adt-borrows.rs', lines 26:0-28:1 *) Record SharedWrapper1_t (T : Type) := mkSharedWrapper1_t { sharedWrapper1_x : T; @@ -46,21 +46,21 @@ Arguments mkSharedWrapper1_t { _ }. Arguments sharedWrapper1_x { _ }. (** [adt_borrows::{adt_borrows::SharedWrapper1<'a, T>}#1::create]: - Source: 'tests/src/adt-borrows.rs', lines 28:4-30:5 *) + Source: 'tests/src/adt-borrows.rs', lines 31:4-33:5 *) Definition sharedWrapper1_create {T : Type} (x : T) : result (SharedWrapper1_t T) := Ok {| sharedWrapper1_x := x |} . (** [adt_borrows::{adt_borrows::SharedWrapper1<'a, T>}#1::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 32:4-34:5 *) + Source: 'tests/src/adt-borrows.rs', lines 35:4-37:5 *) Definition sharedWrapper1_unwrap {T : Type} (self : SharedWrapper1_t T) : result T := Ok self.(sharedWrapper1_x) . (** [adt_borrows::use_shared_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 37:0-42:1 *) + Source: 'tests/src/adt-borrows.rs', lines 40:0-45:1 *) Definition use_shared_wrapper1 : result unit := w <- sharedWrapper1_create 0%i32; p <- sharedWrapper1_unwrap w; @@ -68,7 +68,7 @@ Definition use_shared_wrapper1 : result unit := . (** [adt_borrows::SharedWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 44:0-47:1 *) + Source: 'tests/src/adt-borrows.rs', lines 47:0-50:1 *) Record SharedWrapper2_t (T : Type) := mkSharedWrapper2_t { sharedWrapper2_x : T; sharedWrapper2_y : T; @@ -80,21 +80,21 @@ Arguments sharedWrapper2_x { _ }. Arguments sharedWrapper2_y { _ }. (** [adt_borrows::{adt_borrows::SharedWrapper2<'a, 'b, T>}#2::create]: - Source: 'tests/src/adt-borrows.rs', lines 50:4-52:5 *) + Source: 'tests/src/adt-borrows.rs', lines 53:4-55:5 *) Definition sharedWrapper2_create {T : Type} (x : T) (y : T) : result (SharedWrapper2_t T) := Ok {| sharedWrapper2_x := x; sharedWrapper2_y := y |} . (** [adt_borrows::{adt_borrows::SharedWrapper2<'a, 'b, T>}#2::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 54:4-56:5 *) + Source: 'tests/src/adt-borrows.rs', lines 57:4-59:5 *) Definition sharedWrapper2_unwrap {T : Type} (self : SharedWrapper2_t T) : result (T * T) := Ok (self.(sharedWrapper2_x), self.(sharedWrapper2_y)) . (** [adt_borrows::use_shared_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 59:0-66:1 *) + Source: 'tests/src/adt-borrows.rs', lines 62:0-69:1 *) Definition use_shared_wrapper2 : result unit := w <- sharedWrapper2_create 0%i32 1%i32; p <- sharedWrapper2_unwrap w; @@ -104,25 +104,25 @@ Definition use_shared_wrapper2 : result unit := . (** [adt_borrows::MutWrapper] - Source: 'tests/src/adt-borrows.rs', lines 68:0-68:36 *) + Source: 'tests/src/adt-borrows.rs', lines 71:0-71:36 *) Definition MutWrapper_t (T : Type) : Type := T. (** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::create]: - Source: 'tests/src/adt-borrows.rs', lines 71:4-73:5 *) + Source: 'tests/src/adt-borrows.rs', lines 74:4-76:5 *) Definition mutWrapper_create {T : Type} (x : T) : result ((MutWrapper_t T) * (MutWrapper_t T -> T)) := let back := fun (ret : MutWrapper_t T) => ret in Ok (x, back) . (** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 75:4-77:5 *) + Source: 'tests/src/adt-borrows.rs', lines 78:4-80:5 *) Definition mutWrapper_unwrap {T : Type} (self : MutWrapper_t T) : result (T * (T -> MutWrapper_t T)) := let back := fun (ret : T) => ret in Ok (self, back) . (** [adt_borrows::use_mut_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 80:0-86:1 *) + Source: 'tests/src/adt-borrows.rs', lines 83:0-89:1 *) Definition use_mut_wrapper : result unit := p <- mutWrapper_create 0%i32; let (w, create_back) := p in @@ -134,14 +134,14 @@ Definition use_mut_wrapper : result unit := . (** [adt_borrows::MutWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 88:0-90:1 *) + Source: 'tests/src/adt-borrows.rs', lines 91:0-93:1 *) Record MutWrapper1_t (T : Type) := mkMutWrapper1_t { mutWrapper1_x : T; }. Arguments mkMutWrapper1_t { _ }. Arguments mutWrapper1_x { _ }. (** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::create]: - Source: 'tests/src/adt-borrows.rs', lines 93:4-95:5 *) + Source: 'tests/src/adt-borrows.rs', lines 96:4-98:5 *) Definition mutWrapper1_create {T : Type} (x : T) : result ((MutWrapper1_t T) * (MutWrapper1_t T -> T)) := let back := fun (ret : MutWrapper1_t T) => ret.(mutWrapper1_x) in @@ -149,7 +149,7 @@ Definition mutWrapper1_create . (** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 97:4-99:5 *) + Source: 'tests/src/adt-borrows.rs', lines 100:4-102:5 *) Definition mutWrapper1_unwrap {T : Type} (self : MutWrapper1_t T) : result (T * (T -> MutWrapper1_t T)) := let back := fun (ret : T) => {| mutWrapper1_x := ret |} in @@ -157,7 +157,7 @@ Definition mutWrapper1_unwrap . (** [adt_borrows::use_mut_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 102:0-108:1 *) + Source: 'tests/src/adt-borrows.rs', lines 105:0-111:1 *) Definition use_mut_wrapper1 : result unit := p <- mutWrapper1_create 0%i32; let (w, create_back) := p in @@ -169,7 +169,7 @@ Definition use_mut_wrapper1 : result unit := . (** [adt_borrows::MutWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 110:0-113:1 *) + Source: 'tests/src/adt-borrows.rs', lines 113:0-116:1 *) Record MutWrapper2_t (T : Type) := mkMutWrapper2_t { mutWrapper2_x : T; mutWrapper2_y : T; @@ -181,7 +181,7 @@ Arguments mutWrapper2_x { _ }. Arguments mutWrapper2_y { _ }. (** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::create]: - Source: 'tests/src/adt-borrows.rs', lines 116:4-118:5 *) + Source: 'tests/src/adt-borrows.rs', lines 119:4-121:5 *) Definition mutWrapper2_create {T : Type} (x : T) (y : T) : result ((MutWrapper2_t T) * (MutWrapper2_t T -> T) * (MutWrapper2_t T -> T)) @@ -192,7 +192,7 @@ Definition mutWrapper2_create . (** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 120:4-122:5 *) + Source: 'tests/src/adt-borrows.rs', lines 123:4-125:5 *) Definition mutWrapper2_unwrap {T : Type} (self : MutWrapper2_t T) : result ((T * T) * (T -> MutWrapper2_t T) * (T -> MutWrapper2_t T)) @@ -207,7 +207,7 @@ Definition mutWrapper2_unwrap . (** [adt_borrows::use_mut_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 125:0-134:1 *) + Source: 'tests/src/adt-borrows.rs', lines 128:0-137:1 *) Definition use_mut_wrapper2 : result unit := t <- mutWrapper2_create 0%i32 10%i32; let '(w, create_back, create_back1) := t in @@ -233,14 +233,14 @@ Definition use_mut_wrapper2 : result unit := . (** [adt_borrows::array_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 143:0-145:1 *) + Source: 'tests/src/adt-borrows.rs', lines 146:0-148:1 *) Definition array_shared_borrow {N : usize} (x : array u32 N) : result (array u32 N) := Ok x . (** [adt_borrows::array_mut_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 147:0-149:1 *) + Source: 'tests/src/adt-borrows.rs', lines 150:0-152:1 *) Definition array_mut_borrow {N : usize} (x : array u32 N) : result ((array u32 N) * (array u32 N -> array u32 N)) @@ -249,13 +249,13 @@ Definition array_mut_borrow . (** [adt_borrows::boxed_slice_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 151:0-153:1 *) + Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 *) Definition boxed_slice_shared_borrow (x : slice u32) : result (slice u32) := Ok x . (** [adt_borrows::boxed_slice_mut_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 155:0-157:1 *) + Source: 'tests/src/adt-borrows.rs', lines 158:0-160:1 *) Definition boxed_slice_mut_borrow (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := let back := fun (ret : slice u32) => ret in Ok (x, back) diff --git a/tests/fstar/misc/AdtBorrows.fst b/tests/fstar/misc/AdtBorrows.fst index 43cf247c..234e72b7 100644 --- a/tests/fstar/misc/AdtBorrows.fst +++ b/tests/fstar/misc/AdtBorrows.fst @@ -6,65 +6,65 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [adt_borrows::SharedWrapper] - Source: 'tests/src/adt-borrows.rs', lines 4:0-4:35 *) + Source: 'tests/src/adt-borrows.rs', lines 7:0-7:35 *) type sharedWrapper_t (t : Type0) = t (** [adt_borrows::{adt_borrows::SharedWrapper<'a, T>}::create]: - Source: 'tests/src/adt-borrows.rs', lines 7:4-9:5 *) + Source: 'tests/src/adt-borrows.rs', lines 10:4-12:5 *) let sharedWrapper_create (#t : Type0) (x : t) : result (sharedWrapper_t t) = Ok x (** [adt_borrows::{adt_borrows::SharedWrapper<'a, T>}::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 11:4-13:5 *) + Source: 'tests/src/adt-borrows.rs', lines 14:4-16:5 *) let sharedWrapper_unwrap (#t : Type0) (self : sharedWrapper_t t) : result t = Ok self (** [adt_borrows::use_shared_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 16:0-21:1 *) + Source: 'tests/src/adt-borrows.rs', lines 19:0-24:1 *) let use_shared_wrapper : result unit = let* w = sharedWrapper_create 0 in let* p = sharedWrapper_unwrap w in if 0 = p then Ok () else Fail Failure (** [adt_borrows::SharedWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 23:0-25:1 *) + Source: 'tests/src/adt-borrows.rs', lines 26:0-28:1 *) type sharedWrapper1_t (t : Type0) = { x : t; } (** [adt_borrows::{adt_borrows::SharedWrapper1<'a, T>}#1::create]: - Source: 'tests/src/adt-borrows.rs', lines 28:4-30:5 *) + Source: 'tests/src/adt-borrows.rs', lines 31:4-33:5 *) let sharedWrapper1_create (#t : Type0) (x : t) : result (sharedWrapper1_t t) = Ok { x } (** [adt_borrows::{adt_borrows::SharedWrapper1<'a, T>}#1::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 32:4-34:5 *) + Source: 'tests/src/adt-borrows.rs', lines 35:4-37:5 *) let sharedWrapper1_unwrap (#t : Type0) (self : sharedWrapper1_t t) : result t = Ok self.x (** [adt_borrows::use_shared_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 37:0-42:1 *) + Source: 'tests/src/adt-borrows.rs', lines 40:0-45:1 *) let use_shared_wrapper1 : result unit = let* w = sharedWrapper1_create 0 in let* p = sharedWrapper1_unwrap w in if 0 = p then Ok () else Fail Failure (** [adt_borrows::SharedWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 44:0-47:1 *) + Source: 'tests/src/adt-borrows.rs', lines 47:0-50:1 *) type sharedWrapper2_t (t : Type0) = { x : t; y : t; } (** [adt_borrows::{adt_borrows::SharedWrapper2<'a, 'b, T>}#2::create]: - Source: 'tests/src/adt-borrows.rs', lines 50:4-52:5 *) + Source: 'tests/src/adt-borrows.rs', lines 53:4-55:5 *) let sharedWrapper2_create (#t : Type0) (x : t) (y : t) : result (sharedWrapper2_t t) = Ok { x; y } (** [adt_borrows::{adt_borrows::SharedWrapper2<'a, 'b, T>}#2::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 54:4-56:5 *) + Source: 'tests/src/adt-borrows.rs', lines 57:4-59:5 *) let sharedWrapper2_unwrap (#t : Type0) (self : sharedWrapper2_t t) : result (t & t) = Ok (self.x, self.y) (** [adt_borrows::use_shared_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 59:0-66:1 *) + Source: 'tests/src/adt-borrows.rs', lines 62:0-69:1 *) let use_shared_wrapper2 : result unit = let* w = sharedWrapper2_create 0 1 in let* p = sharedWrapper2_unwrap w in @@ -72,23 +72,23 @@ let use_shared_wrapper2 : result unit = if 0 = px then if 1 = py then Ok () else Fail Failure else Fail Failure (** [adt_borrows::MutWrapper] - Source: 'tests/src/adt-borrows.rs', lines 68:0-68:36 *) + Source: 'tests/src/adt-borrows.rs', lines 71:0-71:36 *) type mutWrapper_t (t : Type0) = t (** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::create]: - Source: 'tests/src/adt-borrows.rs', lines 71:4-73:5 *) + Source: 'tests/src/adt-borrows.rs', lines 74:4-76:5 *) let mutWrapper_create (#t : Type0) (x : t) : result ((mutWrapper_t t) & (mutWrapper_t t -> t)) = let back = fun ret -> ret in Ok (x, back) (** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 75:4-77:5 *) + Source: 'tests/src/adt-borrows.rs', lines 78:4-80:5 *) let mutWrapper_unwrap (#t : Type0) (self : mutWrapper_t t) : result (t & (t -> mutWrapper_t t)) = let back = fun ret -> ret in Ok (self, back) (** [adt_borrows::use_mut_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 80:0-86:1 *) + Source: 'tests/src/adt-borrows.rs', lines 83:0-89:1 *) let use_mut_wrapper : result unit = let* (w, create_back) = mutWrapper_create 0 in let* (p, unwrap_back) = mutWrapper_unwrap w in @@ -97,23 +97,23 @@ let use_mut_wrapper : result unit = if x = 1 then Ok () else Fail Failure (** [adt_borrows::MutWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 88:0-90:1 *) + Source: 'tests/src/adt-borrows.rs', lines 91:0-93:1 *) type mutWrapper1_t (t : Type0) = { x : t; } (** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::create]: - Source: 'tests/src/adt-borrows.rs', lines 93:4-95:5 *) + Source: 'tests/src/adt-borrows.rs', lines 96:4-98:5 *) let mutWrapper1_create (#t : Type0) (x : t) : result ((mutWrapper1_t t) & (mutWrapper1_t t -> t)) = let back = fun ret -> ret.x in Ok ({ x }, back) (** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 97:4-99:5 *) + Source: 'tests/src/adt-borrows.rs', lines 100:4-102:5 *) let mutWrapper1_unwrap (#t : Type0) (self : mutWrapper1_t t) : result (t & (t -> mutWrapper1_t t)) = let back = fun ret -> { x = ret } in Ok (self.x, back) (** [adt_borrows::use_mut_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 102:0-108:1 *) + Source: 'tests/src/adt-borrows.rs', lines 105:0-111:1 *) let use_mut_wrapper1 : result unit = let* (w, create_back) = mutWrapper1_create 0 in let* (p, unwrap_back) = mutWrapper1_unwrap w in @@ -122,11 +122,11 @@ let use_mut_wrapper1 : result unit = if x = 1 then Ok () else Fail Failure (** [adt_borrows::MutWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 110:0-113:1 *) + Source: 'tests/src/adt-borrows.rs', lines 113:0-116:1 *) type mutWrapper2_t (t : Type0) = { x : t; y : t; } (** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::create]: - Source: 'tests/src/adt-borrows.rs', lines 116:4-118:5 *) + Source: 'tests/src/adt-borrows.rs', lines 119:4-121:5 *) let mutWrapper2_create (#t : Type0) (x : t) (y : t) : result ((mutWrapper2_t t) & (mutWrapper2_t t -> t) & (mutWrapper2_t t -> t)) @@ -136,7 +136,7 @@ let mutWrapper2_create Ok ({ x; y }, back'a, back'b) (** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 120:4-122:5 *) + Source: 'tests/src/adt-borrows.rs', lines 123:4-125:5 *) let mutWrapper2_unwrap (#t : Type0) (self : mutWrapper2_t t) : result ((t & t) & (t -> mutWrapper2_t t) & (t -> mutWrapper2_t t)) @@ -146,7 +146,7 @@ let mutWrapper2_unwrap Ok ((self.x, self.y), back'a, back'b) (** [adt_borrows::use_mut_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 125:0-134:1 *) + Source: 'tests/src/adt-borrows.rs', lines 128:0-137:1 *) let use_mut_wrapper2 : result unit = let* (w, create_back, create_back1) = mutWrapper2_create 0 10 in let* (p, unwrap_back, unwrap_back1) = mutWrapper2_unwrap w in @@ -161,12 +161,12 @@ let use_mut_wrapper2 : result unit = else Fail Failure (** [adt_borrows::array_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 143:0-145:1 *) + Source: 'tests/src/adt-borrows.rs', lines 146:0-148:1 *) let array_shared_borrow (#n : usize) (x : array u32 n) : result (array u32 n) = Ok x (** [adt_borrows::array_mut_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 147:0-149:1 *) + Source: 'tests/src/adt-borrows.rs', lines 150:0-152:1 *) let array_mut_borrow (#n : usize) (x : array u32 n) : result ((array u32 n) & (array u32 n -> array u32 n)) @@ -174,12 +174,12 @@ let array_mut_borrow let back = fun ret -> ret in Ok (x, back) (** [adt_borrows::boxed_slice_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 151:0-153:1 *) + Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 *) let boxed_slice_shared_borrow (x : slice u32) : result (slice u32) = Ok x (** [adt_borrows::boxed_slice_mut_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 155:0-157:1 *) + Source: 'tests/src/adt-borrows.rs', lines 158:0-160:1 *) let boxed_slice_mut_borrow (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = let back = fun ret -> ret in Ok (x, back) diff --git a/tests/lean/AdtBorrows.lean b/tests/lean/AdtBorrows.lean index 430412a7..2d061780 100644 --- a/tests/lean/AdtBorrows.lean +++ b/tests/lean/AdtBorrows.lean @@ -9,21 +9,21 @@ set_option linter.unusedVariables false namespace adt_borrows /- [adt_borrows::SharedWrapper] - Source: 'tests/src/adt-borrows.rs', lines 4:0-4:35 -/ + Source: 'tests/src/adt-borrows.rs', lines 7:0-7:35 -/ @[reducible] def SharedWrapper (T : Type) := T /- [adt_borrows::{adt_borrows::SharedWrapper<'a, T>}::create]: - Source: 'tests/src/adt-borrows.rs', lines 7:4-9:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 10:4-12:5 -/ def SharedWrapper.create {T : Type} (x : T) : Result (SharedWrapper T) := Result.ok x /- [adt_borrows::{adt_borrows::SharedWrapper<'a, T>}::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 11:4-13:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 14:4-16:5 -/ def SharedWrapper.unwrap {T : Type} (self : SharedWrapper T) : Result T := Result.ok self /- [adt_borrows::use_shared_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 16:0-21:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 19:0-24:1 -/ def use_shared_wrapper : Result Unit := do let w ← SharedWrapper.create 0#i32 @@ -31,22 +31,22 @@ def use_shared_wrapper : Result Unit := massert (0#i32 = p) /- [adt_borrows::SharedWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 23:0-25:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 26:0-28:1 -/ structure SharedWrapper1 (T : Type) where x : T /- [adt_borrows::{adt_borrows::SharedWrapper1<'a, T>}#1::create]: - Source: 'tests/src/adt-borrows.rs', lines 28:4-30:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 31:4-33:5 -/ def SharedWrapper1.create {T : Type} (x : T) : Result (SharedWrapper1 T) := Result.ok { x } /- [adt_borrows::{adt_borrows::SharedWrapper1<'a, T>}#1::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 32:4-34:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 35:4-37:5 -/ def SharedWrapper1.unwrap {T : Type} (self : SharedWrapper1 T) : Result T := Result.ok self.x /- [adt_borrows::use_shared_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 37:0-42:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 40:0-45:1 -/ def use_shared_wrapper1 : Result Unit := do let w ← SharedWrapper1.create 0#i32 @@ -54,25 +54,25 @@ def use_shared_wrapper1 : Result Unit := massert (0#i32 = p) /- [adt_borrows::SharedWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 44:0-47:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 47:0-50:1 -/ structure SharedWrapper2 (T : Type) where x : T y : T /- [adt_borrows::{adt_borrows::SharedWrapper2<'a, 'b, T>}#2::create]: - Source: 'tests/src/adt-borrows.rs', lines 50:4-52:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 53:4-55:5 -/ def SharedWrapper2.create {T : Type} (x : T) (y : T) : Result (SharedWrapper2 T) := Result.ok { x, y } /- [adt_borrows::{adt_borrows::SharedWrapper2<'a, 'b, T>}#2::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 54:4-56:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 57:4-59:5 -/ def SharedWrapper2.unwrap {T : Type} (self : SharedWrapper2 T) : Result (T × T) := Result.ok (self.x, self.y) /- [adt_borrows::use_shared_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 59:0-66:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 62:0-69:1 -/ def use_shared_wrapper2 : Result Unit := do let w ← SharedWrapper2.create 0#i32 1#i32 @@ -82,25 +82,25 @@ def use_shared_wrapper2 : Result Unit := massert (1#i32 = py) /- [adt_borrows::MutWrapper] - Source: 'tests/src/adt-borrows.rs', lines 68:0-68:36 -/ + Source: 'tests/src/adt-borrows.rs', lines 71:0-71:36 -/ @[reducible] def MutWrapper (T : Type) := T /- [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::create]: - Source: 'tests/src/adt-borrows.rs', lines 71:4-73:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 74:4-76:5 -/ def MutWrapper.create {T : Type} (x : T) : Result ((MutWrapper T) × (MutWrapper T → T)) := let back := fun ret => ret Result.ok (x, back) /- [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 75:4-77:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 78:4-80:5 -/ def MutWrapper.unwrap {T : Type} (self : MutWrapper T) : Result (T × (T → MutWrapper T)) := let back := fun ret => ret Result.ok (self, back) /- [adt_borrows::use_mut_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 80:0-86:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 83:0-89:1 -/ def use_mut_wrapper : Result Unit := do let (w, create_back) ← MutWrapper.create 0#i32 @@ -110,26 +110,26 @@ def use_mut_wrapper : Result Unit := massert (x = 1#i32) /- [adt_borrows::MutWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 88:0-90:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 91:0-93:1 -/ structure MutWrapper1 (T : Type) where x : T /- [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::create]: - Source: 'tests/src/adt-borrows.rs', lines 93:4-95:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 96:4-98:5 -/ def MutWrapper1.create {T : Type} (x : T) : Result ((MutWrapper1 T) × (MutWrapper1 T → T)) := let back := fun ret => ret.x Result.ok ({ x }, back) /- [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 97:4-99:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 100:4-102:5 -/ def MutWrapper1.unwrap {T : Type} (self : MutWrapper1 T) : Result (T × (T → MutWrapper1 T)) := let back := fun ret => { x := ret } Result.ok (self.x, back) /- [adt_borrows::use_mut_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 102:0-108:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 105:0-111:1 -/ def use_mut_wrapper1 : Result Unit := do let (w, create_back) ← MutWrapper1.create 0#i32 @@ -139,13 +139,13 @@ def use_mut_wrapper1 : Result Unit := massert (x = 1#i32) /- [adt_borrows::MutWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 110:0-113:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 113:0-116:1 -/ structure MutWrapper2 (T : Type) where x : T y : T /- [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::create]: - Source: 'tests/src/adt-borrows.rs', lines 116:4-118:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 119:4-121:5 -/ def MutWrapper2.create {T : Type} (x : T) (y : T) : Result ((MutWrapper2 T) × (MutWrapper2 T → T) × (MutWrapper2 T → T)) @@ -155,7 +155,7 @@ def MutWrapper2.create Result.ok ({ x, y }, back'a, back'b) /- [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 120:4-122:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 123:4-125:5 -/ def MutWrapper2.unwrap {T : Type} (self : MutWrapper2 T) : Result ((T × T) × (T → MutWrapper2 T) × (T → MutWrapper2 T)) @@ -165,7 +165,7 @@ def MutWrapper2.unwrap Result.ok ((self.x, self.y), back'a, back'b) /- [adt_borrows::use_mut_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 125:0-134:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 128:0-137:1 -/ def use_mut_wrapper2 : Result Unit := do let (w, create_back, create_back1) ← MutWrapper2.create 0#i32 10#i32 @@ -179,12 +179,12 @@ def use_mut_wrapper2 : Result Unit := massert (y = 11#i32) /- [adt_borrows::array_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 143:0-145:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 146:0-148:1 -/ def array_shared_borrow {N : Usize} (x : Array U32 N) : Result (Array U32 N) := Result.ok x /- [adt_borrows::array_mut_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 147:0-149:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 150:0-152:1 -/ def array_mut_borrow {N : Usize} (x : Array U32 N) : Result ((Array U32 N) × (Array U32 N → Array U32 N)) @@ -193,12 +193,12 @@ def array_mut_borrow Result.ok (x, back) /- [adt_borrows::boxed_slice_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 151:0-153:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 -/ def boxed_slice_shared_borrow (x : Slice U32) : Result (Slice U32) := Result.ok x /- [adt_borrows::boxed_slice_mut_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 155:0-157:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 158:0-160:1 -/ def boxed_slice_mut_borrow (x : Slice U32) : Result ((Slice U32) × (Slice U32 → Slice U32)) := let back := fun ret => ret diff --git a/tests/src/adt-borrows.rs b/tests/src/adt-borrows.rs index 645550ff..d68bdaa7 100644 --- a/tests/src/adt-borrows.rs +++ b/tests/src/adt-borrows.rs @@ -1,6 +1,9 @@ //@ [coq,fstar] subdir=misc //! This file contains tests with ADTs containing borrows. +// +// Structures with borrows +// struct SharedWrapper<'a, T>(&'a T); impl<'a, T> SharedWrapper<'a, T> { From 9cce19c106b6eb49d8c22a78a06bb1647c59b27f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 16 Dec 2024 12:00:04 +0000 Subject: [PATCH 11/29] Start adding support for instantiating type parameters with borrows --- src/interp/InterpreterExpansion.ml | 2 +- src/interp/InterpreterExpressions.ml | 6 +- src/interp/InterpreterStatements.ml | 95 ++++++++++---- src/interp/InterpreterUtils.ml | 187 ++++++++++++++++++++++++++- src/llbc/Print.ml | 9 +- src/llbc/ValuesUtils.ml | 18 ++- 6 files changed, 277 insertions(+), 40 deletions(-) diff --git a/src/interp/InterpreterExpansion.ml b/src/interp/InterpreterExpansion.ml index b1fc6d0d..8f5fc71b 100644 --- a/src/interp/InterpreterExpansion.ml +++ b/src/interp/InterpreterExpansion.ml @@ -622,7 +622,7 @@ let greedy_expand_symbolics_with_borrows (config : config) (span : Meta.span) : method! visit_VSymbolic _ sv = if ValuesUtils.symbolic_value_is_greedily_expandable (Some span) - ctx.type_ctx.type_infos sv + ctx.type_ctx.type_decls ctx.type_ctx.type_infos sv then raise (FoundSymbolicValue sv) else () diff --git a/src/interp/InterpreterExpressions.ml b/src/interp/InterpreterExpressions.ml index 4da120c9..a1adc3f2 100644 --- a/src/interp/InterpreterExpressions.ml +++ b/src/interp/InterpreterExpressions.ml @@ -32,8 +32,8 @@ let expand_if_borrows_at_place (config : config) (span : Meta.span) fun ctx -> let v = read_place span access p ctx in match - find_first_expandable_sv_with_borrows (Some span) ctx.type_ctx.type_infos - v + find_first_expandable_sv_with_borrows (Some span) ctx.type_ctx.type_decls + ctx.type_ctx.type_infos v with | None -> (ctx, fun e -> e) | Some sv -> @@ -346,7 +346,7 @@ let eval_operand_no_reorganize (config : config) (span : Meta.span) sanity_check __FILE__ __LINE__ (Option.is_none (find_first_expandable_sv_with_borrows (Some span) - ctx.type_ctx.type_infos v)) + ctx.type_ctx.type_decls ctx.type_ctx.type_infos v)) span; (* Copy the value *) let allow_adt_copy = false in diff --git a/src/interp/InterpreterStatements.ml b/src/interp/InterpreterStatements.ml index 22dcac33..84add5d2 100644 --- a/src/interp/InterpreterStatements.ml +++ b/src/interp/InterpreterStatements.ml @@ -1242,7 +1242,8 @@ and eval_function_call_symbolic (config : config) (span : Meta.span) | FunId (FRegular _) | TraitMethod _ -> eval_transparent_function_call_symbolic config span call | FunId (FBuiltin fid) -> - eval_builtin_function_call_symbolic config span fid call func) + eval_builtin_function_call_symbolic config span fid func call.args + call.dest) (** Evaluate a local (i.e., non-builtin) function call in concrete mode *) and eval_transparent_function_call_concrete (config : config) (span : Meta.span) @@ -1523,35 +1524,75 @@ and eval_function_call_symbolic_from_inst_sig (config : config) (** Evaluate a non-local function call in symbolic mode *) and eval_builtin_function_call_symbolic (config : config) (span : Meta.span) - (fid : builtin_fun_id) (call : call) (func : fn_ptr) : stl_cm_fun = + (fid : builtin_fun_id) (func : fn_ptr) (args : operand list) (dest : place) + : stl_cm_fun = fun ctx -> - let generics = func.generics in - let args = call.args in - let dest = call.dest in - (* Sanity check: make sure the type parameters don't contain regions - - * this is a current limitation of our synthesis *) - sanity_check __FILE__ __LINE__ - (List.for_all - (fun ty -> not (ty_has_borrows (Some span) ctx.type_ctx.type_infos ty)) - generics.types) - span; - - (* 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 regions_hierarchy = - LlbcAstUtils.FunIdMap.find (FBuiltin fid) ctx.fun_ctx.regions_hierarchies - in - (* There shouldn't be any reference to Self *) - let tr_self = UnknownTrait __FUNCTION__ in + (* In symbolic mode, the behavior 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 sg = Builtin.get_builtin_fun_sig fid in - let inst_sig = - instantiate_fun_sig span ctx generics tr_self sg regions_hierarchy - in + if fid = BoxNew then begin + (* Special case: Box::new: we allow instantiating the type parameters with + types containing borrows. + + TODO: this is a hack. + *) + (* Sanity check: check that we are not using nested borrows *) + classert __FILE__ __LINE__ + (List.for_all + (fun ty -> + not (ty_has_nested_borrows (Some span) ctx.type_ctx.type_infos ty)) + func.generics.types) + span + (lazy + ("Instantiating [Box::new] with nested borrows is not allowed for now (" + ^ fn_ptr_to_string ctx func ^ ")")); + + (* As we allow instantiating type parameters with types containing regions, + we have to recompute the regions hierarchy. *) + let fun_name = Print.Expressions.builtin_fun_id_to_string fid in + let regions_hierarchy, inst_sig = + compute_regions_hierarchy_for_fun_call (Some span) ctx.type_ctx.type_decls + ctx.fun_ctx.fun_decls ctx.global_ctx.global_decls + ctx.trait_decls_ctx.trait_decls ctx.trait_impls_ctx.trait_impls fun_name + ctx.type_vars ctx.const_generic_vars func.generics sg + in + log#ldebug + (lazy + ("eval_builtin_function_call_symbolic: special case:" ^ "\n- inst_sig:" + ^ inst_fun_sig_to_string ctx inst_sig)); + + (* Evaluate the function call *) + eval_function_call_symbolic_from_inst_sig config span (FunId (FBuiltin fid)) + sg regions_hierarchy inst_sig func.generics None args dest ctx + end + else begin + (* Sanity check: make sure the type parameters don't contain regions - + this is a current limitation of our synthesis. + *) + classert __FILE__ __LINE__ + (List.for_all + (fun ty -> not (ty_has_borrows (Some span) ctx.type_ctx.type_infos ty)) + func.generics.types) + span + (lazy + ("Instantiating the type parameters of a function with types \ + containing borrows is not allowed for now (" + ^ fn_ptr_to_string ctx func ^ ")")); + let regions_hierarchy = + LlbcAstUtils.FunIdMap.find (FBuiltin fid) ctx.fun_ctx.regions_hierarchies + in - (* Evaluate the function call *) - eval_function_call_symbolic_from_inst_sig config span (FunId (FBuiltin fid)) - sg regions_hierarchy inst_sig generics None args dest ctx + (* There shouldn't be any reference to Self *) + let tr_self = UnknownTrait __FUNCTION__ in + let inst_sig = + instantiate_fun_sig span ctx func.generics tr_self sg regions_hierarchy + in + + (* Evaluate the function call *) + eval_function_call_symbolic_from_inst_sig config span (FunId (FBuiltin fid)) + sg regions_hierarchy inst_sig func.generics None args dest ctx + end (** Evaluate a statement seen as a function body *) and eval_function_body (config : config) (body : statement) : stl_cm_fun = diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index fc2452f0..8f66302b 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -34,6 +34,10 @@ let generic_args_to_string = Print.EvalCtx.generic_args_to_string let trait_ref_to_string = Print.EvalCtx.trait_ref_to_string let trait_decl_ref_to_string = Print.EvalCtx.trait_decl_ref_to_string +let fn_ptr_to_string (ctx : eval_ctx) (fn_ptr : fn_ptr) : string = + let env = Print.Contexts.eval_ctx_to_fmt_env ctx in + Print.Expressions.fn_ptr_to_string env fn_ptr + let trait_decl_ref_region_binder_to_string = Print.EvalCtx.trait_decl_ref_region_binder_to_string @@ -528,12 +532,7 @@ let instantiate_fun_sig (span : Meta.span) (ctx : eval_ctx) Substitute.fresh_regions_with_substs_from_vars sg.generics.regions fresh_region_id in - (* Generate the type substitution - Note that for now we don't support instantiating the type parameters with - types containing regions. *) - sanity_check __FILE__ __LINE__ - (List.for_all TypesUtils.ty_no_regions generics.types) - span; + (* Generate the type substitution. *) sanity_check __FILE__ __LINE__ (TypesUtils.trait_instance_id_no_regions tr_self) span; @@ -555,3 +554,179 @@ let instantiate_fun_sig (span : Meta.span) (ctx : eval_ctx) in (* Return *) inst_sig + +(** Compute the regions hierarchy of an instantiated function call - + i.e., a function call instantiated with type parameters which might + contain borrows. + We do so by computing a "fake" function signature and by computing the regions + hierarchy for this signature. We return both the fake signature and the + regions hierarchy. + + - [type_vars]: the type variables currently in the context + - [const_generic_vars]: the const generics currently in the context + - [generic_args]: the generic arguments given to the function + - [sg]: the original, uninstantiated signature (we need to retrieve, for + instance, the region outlives constraints) + *) +let compute_regions_hierarchy_for_fun_call (span : Meta.span option) + (type_decls : type_decl TypeDeclId.Map.t) + (fun_decls : fun_decl FunDeclId.Map.t) + (global_decls : global_decl GlobalDeclId.Map.t) + (trait_decls : trait_decl TraitDeclId.Map.t) + (trait_impls : trait_impl TraitImplId.Map.t) (fun_name : string) + (type_vars : type_var list) (const_generic_vars : const_generic_var list) + (generic_args : generic_args) (sg : fun_sig) : + region_var_groups * inst_fun_sig = + (* We simply put everything into a "fake" signature, then call + [compute_regions_hierarchy_for_sig]. + + The important point is that we need to introduce fresh regions for + the erased regions. When doing so, in order to make sure there are + no collisions, we also refresh the other regions. *) + (* Decompose the signature *) + let { is_unsafe; is_closure; closure_info; generics; inputs; output } = sg in + (* Introduce the fresh regions *) + let region_map = ref RegionId.Map.empty in + let fresh_regions = ref RegionId.Set.empty in + let _, fresh_region_id = RegionId.fresh_stateful_generator () in + let get_region rid = + match RegionId.Map.find_opt rid !region_map with + | Some rid -> rid + | None -> + let nrid = fresh_region_id () in + fresh_regions := RegionId.Set.add nrid !fresh_regions; + region_map := RegionId.Map.add rid nrid !region_map; + nrid + in + let visitor = + object (_self : 'self) + inherit [_] map_ty + + method! visit_region_id _ _ = + craise_opt_span __FILE__ __LINE__ None + "Region ids should not be visited directly; the visitor should catch \ + cases that contain region ids earlier." + + method! visit_RVar _ var = + match var with + | Free rid -> RVar (Free (get_region rid)) + | Bound _ -> RVar var + + method! visit_RErased _ = + (* Introduce a fresh region *) + let nrid = fresh_region_id () in + fresh_regions := RegionId.Set.add nrid !fresh_regions; + RVar (Free nrid) + end + in + (* Explore the types to generate the fresh regions *) + let generic_types = List.map (visitor#visit_ty ()) generic_args.types in + + (* Reconstruct the generics *) + let fresh_regions = RegionId.Set.elements !fresh_regions in + let fresh_region_vars : region_var list = + List.map (fun index -> { Types.index; name = None }) fresh_regions + in + let fresh_regions = List.map (fun rid -> RVar (Free rid)) fresh_regions in + let subst = + let { regions = _; types = _; const_generics; trait_refs } = generic_args in + let generic_args = + { + regions = fresh_regions; + types = generic_types; + const_generics; + trait_refs + (* Keeping the same trait refs: it shouldn't have an impact *); + } + in + let tr_self : trait_instance_id = UnknownTrait __FUNCTION__ in + Substitute.make_subst_from_generics + { sg.generics with regions = fresh_region_vars } + generic_args tr_self + in + + (* Substitute the inputs and outputs *) + let open Substitute in + let inputs = List.map (st_substitute_visitor#visit_ty subst) inputs in + let output = st_substitute_visitor#visit_ty subst output in + + (* Compute the regions hierarchy *) + let trait_type_constraints, regions_hierarchy = + let generics : generic_params = + let { + regions = _; + types = _; + const_generics = _; + trait_clauses; + regions_outlive; + types_outlive; + trait_type_constraints; + } = + generics + in + let open Substitute in + let trait_clauses = + List.map (st_substitute_visitor#visit_trait_clause subst) trait_clauses + in + let regions_outlive = + List.map + (st_substitute_visitor#visit_region_binder + (st_substitute_visitor#visit_outlives_pred + st_substitute_visitor#visit_region + st_substitute_visitor#visit_region) + subst) + regions_outlive + in + let types_outlive = + List.map + (st_substitute_visitor#visit_region_binder + (st_substitute_visitor#visit_outlives_pred + st_substitute_visitor#visit_ty + st_substitute_visitor#visit_region) + subst) + types_outlive + in + { + regions = fresh_region_vars; + types = type_vars; + const_generics = const_generic_vars; + trait_clauses; + regions_outlive; + types_outlive; + trait_type_constraints; + } + in + + let sg = + { is_unsafe; is_closure; closure_info; generics; inputs; output } + in + let regions_hierarchy = + RegionsHierarchy.compute_regions_hierarchy_for_sig span type_decls + fun_decls global_decls trait_decls trait_impls fun_name sg + in + (generics.trait_type_constraints, regions_hierarchy) + in + + let inst_sig = + (* Generate fresh abstraction ids and create a substitution from region + group ids to abstraction ids *) + let asubst_map : AbstractionId.id RegionGroupId.Map.t = + RegionGroupId.Map.of_list + (List.map + (fun rg -> (rg.id, fresh_abstraction_id ())) + regions_hierarchy) + in + let asubst (rg_id : RegionGroupId.id) : AbstractionId.id = + RegionGroupId.Map.find rg_id asubst_map + in + let subst_region_group (rg : region_var_group) : abs_region_group = + let id = asubst rg.id in + let parents = List.map asubst rg.parents in + ({ id; regions = rg.regions; parents } : abs_region_group) + in + let regions_hierarchy = List.map subst_region_group regions_hierarchy in + { regions_hierarchy; trait_type_constraints; inputs; output } + in + + (* Compute the instantiated function signature *) + (regions_hierarchy, inst_sig) diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index a78fcb3c..574dd394 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -328,6 +328,12 @@ module Values = struct ^ RegionId.Set.to_string None abs.regions.owned ^ "}" ^ can_end ^ " {\n" ^ avs ^ "\n" ^ indent ^ "}" + let abs_region_group_to_string (gr : abs_region_group) : string = + g_region_group_to_string RegionId.to_string AbstractionId.to_string gr + + let abs_region_groups_to_string (gl : abs_region_groups) : string = + String.concat "\n" (List.map abs_region_group_to_string gl) + let inst_fun_sig_to_string (env : fmt_env) (sg : LlbcAst.inst_fun_sig) : string = (* TODO: print the trait type constraints? *) @@ -337,7 +343,8 @@ module Values = struct "(" ^ String.concat ", " (List.map ty_to_string sg.inputs) ^ ")" in let output = ty_to_string sg.output in - inputs ^ " -> " ^ output + inputs ^ " -> " ^ output ^ "\n- Regions_hierarchy:\n" + ^ abs_region_groups_to_string sg.regions_hierarchy end (** Pretty-printing for contexts *) diff --git a/src/llbc/ValuesUtils.ml b/src/llbc/ValuesUtils.ml index f4ff026f..eb92a96e 100644 --- a/src/llbc/ValuesUtils.ml +++ b/src/llbc/ValuesUtils.ml @@ -165,15 +165,29 @@ let outer_loans_in_value (v : typed_value) : bool = with Found -> true let symbolic_value_is_greedily_expandable (span : Meta.span option) + (type_decls : type_decl TypeDeclId.Map.t) (type_infos : TypesAnalysis.type_infos) (sv : symbolic_value) : bool = if ty_has_borrows span type_infos sv.sv_ty then (* Ignore arrays and slices, as we can't expand them *) match sv.sv_ty with | TAdt (TBuiltin (TArray | TSlice), _) -> false + | TAdt (TAdtId id, _) -> + (* Lookup the type of the ADT to check if we can expand it *) + let def = TypeDeclId.Map.find id type_decls in + begin + match def.kind with + | Struct _ | Enum ([] | [ _ ]) -> + (* Structure or enumeration with <= 1 variant *) + true + | Enum (_ :: _) | Alias _ | Opaque | TError _ | Union _ -> + (* Enumeration with > 1 variants *) + false + end | _ -> true else false let find_first_expandable_sv_with_borrows (span : Meta.span option) + (type_decls : type_decl TypeDeclId.Map.t) (type_infos : TypesAnalysis.type_infos) (v : typed_value) : symbolic_value option = (* The visitor *) @@ -182,8 +196,8 @@ let find_first_expandable_sv_with_borrows (span : Meta.span option) inherit [_] iter_typed_value method! visit_VSymbolic _ sv = - if symbolic_value_is_greedily_expandable span type_infos sv then - raise (FoundSymbolicValue sv) + if symbolic_value_is_greedily_expandable span type_decls type_infos sv + then raise (FoundSymbolicValue sv) else () end in From a58c0f7ee001414457c7f3749cce6b187d4ea461 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 16 Dec 2024 14:09:31 +0000 Subject: [PATCH 12/29] Update Errors.save_error --- src/Errors.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Errors.ml b/src/Errors.ml index 36d066d3..a3a5e261 100644 --- a/src/Errors.ml +++ b/src/Errors.ml @@ -36,10 +36,10 @@ let push_error (span : Meta.span option) (msg : string) = error_list := (span, msg) :: !error_list (** Register an error, and throw an exception if [throw] is true *) -let save_error (file : string) (line : int) ?(throw : bool = false) - (span : Meta.span option) (msg : string) = +let save_error (file : string) (line : int) (span : Meta.span option) + (msg : string) = push_error span msg; - if !Config.fail_hard && throw then ( + if !Config.fail_hard then ( let msg = format_error_message_with_file_line file line span msg in log#serror (msg ^ "\n"); raise (Failure msg)) From eea5cd330f5016519edc43b9806cd2e1905145f5 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 16 Dec 2024 16:31:12 +0000 Subject: [PATCH 13/29] Use inst_fun_sig instead of fun_sig more in SymbolicToPure --- src/interp/Interpreter.ml | 21 ++- src/interp/InterpreterStatements.ml | 9 +- src/interp/InterpreterUtils.ml | 41 +++-- src/llbc/AssociatedTypes.ml | 25 ++- src/llbc/LlbcAst.ml | 5 +- src/llbc/Print.ml | 6 +- src/llbc/Substitute.ml | 19 +- src/pure/Pure.ml | 34 ++-- src/symbolic/SymbolicAst.ml | 9 +- src/symbolic/SymbolicToPure.ml | 274 ++++++++++++++++------------ src/symbolic/SynthesizeSymbolic.ml | 23 ++- 11 files changed, 291 insertions(+), 175 deletions(-) diff --git a/src/interp/Interpreter.ml b/src/interp/Interpreter.ml index 7f5cf866..dfa2285c 100644 --- a/src/interp/Interpreter.ml +++ b/src/interp/Interpreter.ml @@ -102,7 +102,15 @@ let compute_contexts (m : crate) : decls_ctx = *) let normalize_inst_fun_sig (span : Meta.span) (ctx : eval_ctx) (sg : inst_fun_sig) : inst_fun_sig = - let { regions_hierarchy = _; trait_type_constraints; inputs; output } = sg in + let { + regions_hierarchy = _; + abs_regions_hierarchy = _; + trait_type_constraints; + inputs; + output; + } = + sg + in cassert_warn __FILE__ __LINE__ (trait_type_constraints = []) span @@ -220,7 +228,7 @@ let initialize_symbolic_context_for_fun (ctx : decls_ctx) (fdef : fun_decl) : let ctx = create_push_abstractions_from_abs_region_groups (fun rg_id -> SynthInput rg_id) - inst_sg.regions_hierarchy region_can_end compute_abs_avalues ctx + inst_sg.abs_regions_hierarchy region_can_end compute_abs_avalues ctx in (* Split the variables between return var, inputs and remaining locals *) let body = Option.get fdef.body in @@ -295,7 +303,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) RegionGroupId.mapi (fun rg_id rg -> if RegionGroupId.Set.mem rg_id parent_rgs then Some rg.id else None) - inst_sg.regions_hierarchy + inst_sg.abs_regions_hierarchy in let parent_input_abs_ids = List.filter_map (fun x -> x) parent_input_abs_ids @@ -331,7 +339,8 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) let ctx = create_push_abstractions_from_abs_region_groups (fun rg_id -> SynthRet rg_id) - ret_inst_sg.regions_hierarchy region_can_end compute_abs_avalues ctx + ret_inst_sg.abs_regions_hierarchy region_can_end compute_abs_avalues + ctx in ctx) else ctx @@ -356,7 +365,9 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) * we are evaluating an [EndContinue]) or not. *) let current_abs_id, end_fun_synth_input = - let fun_abs_id = (RegionGroupId.nth inst_sg.regions_hierarchy back_id).id in + let fun_abs_id = + (RegionGroupId.nth inst_sg.abs_regions_hierarchy back_id).id + in if not inside_loop then (Some fun_abs_id, true) else (* We are inside a loop *) diff --git a/src/interp/InterpreterStatements.ml b/src/interp/InterpreterStatements.ml index 84add5d2..19d10d8e 100644 --- a/src/interp/InterpreterStatements.ml +++ b/src/interp/InterpreterStatements.ml @@ -1410,7 +1410,7 @@ and eval_function_call_symbolic_from_inst_sig (config : config) let args, ctx, cc = eval_operands config span args ctx in (* Generate the abstractions and insert them in the context *) - let abs_ids = List.map (fun rg -> rg.id) inst_sg.regions_hierarchy in + let abs_ids = List.map (fun rg -> rg.id) inst_sg.abs_regions_hierarchy in let args_with_rtypes = List.combine args inst_sg.inputs in (* Check the type of the input arguments *) @@ -1456,14 +1456,13 @@ and eval_function_call_symbolic_from_inst_sig (config : config) let ctx = create_push_abstractions_from_abs_region_groups (fun rg_id -> FunCall (call_id, rg_id)) - inst_sg.regions_hierarchy region_can_end compute_abs_avalues ctx + inst_sg.abs_regions_hierarchy region_can_end compute_abs_avalues ctx in (* Synthesize the symbolic AST *) let cc = cc_comp cc - (S.synthesize_regular_function_call fid call_id ctx sg regions_hierarchy - abs_ids generics trait_method_generics args args_places ret_spc - dest_place) + (S.synthesize_regular_function_call fid call_id ctx sg inst_sg abs_ids + generics trait_method_generics args args_places ret_spc dest_place) in (* Move the return value to its destination *) diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index 8f66302b..8a10394d 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -619,20 +619,21 @@ let compute_regions_hierarchy_for_fun_call (span : Meta.span option) RVar (Free nrid) end in + (* We want to make sure that we numerotate the region parameters, even the erased + ones, in order, before introducing fresh regions for the erased regions which + appear in the types parameters *) + let generic_regions = + List.map (visitor#visit_region ()) generic_args.regions + in (* Explore the types to generate the fresh regions *) let generic_types = List.map (visitor#visit_ty ()) generic_args.types in (* Reconstruct the generics *) - let fresh_regions = RegionId.Set.elements !fresh_regions in - let fresh_region_vars : region_var list = - List.map (fun index -> { Types.index; name = None }) fresh_regions - in - let fresh_regions = List.map (fun rid -> RVar (Free rid)) fresh_regions in let subst = let { regions = _; types = _; const_generics; trait_refs } = generic_args in let generic_args = { - regions = fresh_regions; + regions = generic_regions; types = generic_types; const_generics; trait_refs @@ -640,9 +641,7 @@ let compute_regions_hierarchy_for_fun_call (span : Meta.span option) } in let tr_self : trait_instance_id = UnknownTrait __FUNCTION__ in - Substitute.make_subst_from_generics - { sg.generics with regions = fresh_region_vars } - generic_args tr_self + Substitute.make_subst_from_generics sg.generics generic_args tr_self in (* Substitute the inputs and outputs *) @@ -664,6 +663,10 @@ let compute_regions_hierarchy_for_fun_call (span : Meta.span option) } = generics in + let fresh_regions = RegionId.Set.elements !fresh_regions in + let fresh_region_vars : region_var list = + List.map (fun index -> { Types.index; name = None }) fresh_regions + in let open Substitute in let trait_clauses = List.map (st_substitute_visitor#visit_trait_clause subst) trait_clauses @@ -709,7 +712,11 @@ let compute_regions_hierarchy_for_fun_call (span : Meta.span option) let inst_sig = (* Generate fresh abstraction ids and create a substitution from region - group ids to abstraction ids *) + group ids to abstraction ids. + + Remark: the region ids used here are fresh (we generated them + just above). + *) let asubst_map : AbstractionId.id RegionGroupId.Map.t = RegionGroupId.Map.of_list (List.map @@ -719,13 +726,21 @@ let compute_regions_hierarchy_for_fun_call (span : Meta.span option) let asubst (rg_id : RegionGroupId.id) : AbstractionId.id = RegionGroupId.Map.find rg_id asubst_map in - let subst_region_group (rg : region_var_group) : abs_region_group = + let subst_abs_region_group (rg : region_var_group) : abs_region_group = let id = asubst rg.id in let parents = List.map asubst rg.parents in ({ id; regions = rg.regions; parents } : abs_region_group) in - let regions_hierarchy = List.map subst_region_group regions_hierarchy in - { regions_hierarchy; trait_type_constraints; inputs; output } + let abs_regions_hierarchy = + List.map subst_abs_region_group regions_hierarchy + in + { + regions_hierarchy; + abs_regions_hierarchy; + trait_type_constraints; + inputs; + output; + } in (* Compute the instantiated function signature *) diff --git a/src/llbc/AssociatedTypes.ml b/src/llbc/AssociatedTypes.ml index fe9c5e5b..51d28dfc 100644 --- a/src/llbc/AssociatedTypes.ml +++ b/src/llbc/AssociatedTypes.ml @@ -440,12 +440,11 @@ let ctx_normalize_erase_ty (span : Meta.span) (ctx : eval_ctx) (ty : ty) : ty = let ty = ctx_normalize_ty (Some span) ctx ty in erase_regions ty -let ctx_normalize_trait_type_constraint_region_binder (span : Meta.span) +let ctx_normalize_trait_type_constraint_region_binder (span : Meta.span option) (ctx : eval_ctx) (ttc : trait_type_constraint region_binder) : trait_type_constraint region_binder = norm_ctx_normalize_region_binder norm_ctx_normalize_trait_type_constraint - (mk_norm_ctx (Some span) ctx) - ttc + (mk_norm_ctx span ctx) ttc (** Same as [type_decl_get_instantiated_variants_fields_types] but normalizes the types *) let type_decl_get_inst_norm_variants_fields_rtypes (span : Meta.span) @@ -517,12 +516,26 @@ let ctx_subst_norm_signature (span : Meta.span) (ctx : eval_ctx) substitute_signature asubst r_subst ty_subst cg_subst tr_subst tr_self sg regions_hierarchy in - let { regions_hierarchy; inputs; output; trait_type_constraints } = sg in + let { + regions_hierarchy; + abs_regions_hierarchy; + inputs; + output; + trait_type_constraints; + } = + sg + in let inputs = List.map (ctx_normalize_ty (Some span) ctx) inputs in let output = ctx_normalize_ty (Some span) ctx output in let trait_type_constraints = List.map - (ctx_normalize_trait_type_constraint_region_binder span ctx) + (ctx_normalize_trait_type_constraint_region_binder (Some span) ctx) trait_type_constraints in - { regions_hierarchy; inputs; output; trait_type_constraints } + { + regions_hierarchy; + abs_regions_hierarchy; + inputs; + output; + trait_type_constraints; + } diff --git a/src/llbc/LlbcAst.ml b/src/llbc/LlbcAst.ml index c97fe93d..6d9afbc2 100644 --- a/src/llbc/LlbcAst.ml +++ b/src/llbc/LlbcAst.ml @@ -9,7 +9,10 @@ type abs_region_groups = abs_region_group list [@@deriving show] (** A function signature, after instantiation *) type inst_fun_sig = { - regions_hierarchy : abs_region_groups; + regions_hierarchy : region_var_groups; + (** **WARNING**: the region ids in those groups should have been + substituted with fresh regions. *) + abs_regions_hierarchy : abs_region_groups; trait_type_constraints : trait_type_constraint region_binder list; inputs : rty list; output : rty; diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index 574dd394..713a0d6a 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -343,8 +343,10 @@ module Values = struct "(" ^ String.concat ", " (List.map ty_to_string sg.inputs) ^ ")" in let output = ty_to_string sg.output in - inputs ^ " -> " ^ output ^ "\n- Regions_hierarchy:\n" - ^ abs_region_groups_to_string sg.regions_hierarchy + inputs ^ " -> " ^ output ^ "\n- regions_hierarchy:\n" + ^ region_var_groups_to_string sg.regions_hierarchy + ^ "\n- abs_regions_hierarchy:\n" + ^ abs_region_groups_to_string sg.abs_regions_hierarchy end (** Pretty-printing for contexts *) diff --git a/src/llbc/Substitute.ml b/src/llbc/Substitute.ml index 96bb79d8..9ccab890 100644 --- a/src/llbc/Substitute.ml +++ b/src/llbc/Substitute.ml @@ -50,12 +50,21 @@ let substitute_signature (asubst : RegionGroupId.id -> AbstractionId.id) in let inputs = List.map (ty_substitute subst) sg.inputs in let output = ty_substitute subst sg.output in - let subst_region_group (rg : region_var_group) : abs_region_group = + let subst_abs_region_group (rg : region_var_group) : abs_region_group = let id = asubst rg.id in let regions = List.map r_id_subst rg.regions in let parents = List.map asubst rg.parents in ({ id; regions; parents } : abs_region_group) in + let abs_regions_hierarchy = + List.map subst_abs_region_group regions_hierarchy + in + let subst_region_group (rg : region_var_group) : region_var_group = + let id = rg.id in + let regions = List.map r_id_subst rg.regions in + let parents = rg.parents in + ({ id; regions; parents } : region_var_group) + in let regions_hierarchy = List.map subst_region_group regions_hierarchy in let trait_type_constraints = List.map @@ -63,7 +72,13 @@ let substitute_signature (asubst : RegionGroupId.id -> AbstractionId.id) trait_type_constraint_substitute subst) sg.generics.trait_type_constraints in - { inputs; output; regions_hierarchy; trait_type_constraints } + { + inputs; + output; + regions_hierarchy; + abs_regions_hierarchy; + trait_type_constraints; + } type id_subst = { r_subst : RegionId.id -> RegionId.id; diff --git a/src/pure/Pure.ml b/src/pure/Pure.ml index 099bb219..7cb45dce 100644 --- a/src/pure/Pure.ml +++ b/src/pure/Pure.ml @@ -1112,17 +1112,11 @@ type back_sg_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; +(** A *decomposed* function type (without parameters). + + This is a helper type used by the translation. + *) +type decomposed_fun_type = { fwd_inputs : ty list; (** The types of the inputs of the forward function. @@ -1159,6 +1153,24 @@ type decomposed_fun_sig = { } [@@deriving show] +(** A *decomposed* function signature. + + This is a helper type used by the translation. + *) +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; + fun_ty : decomposed_fun_type; (** The type itself *) +} +[@@deriving show] + (** A function signature. We have the following cases: diff --git a/src/symbolic/SymbolicAst.ml b/src/symbolic/SymbolicAst.ml index bd5bd17c..9472cbb1 100644 --- a/src/symbolic/SymbolicAst.ml +++ b/src/symbolic/SymbolicAst.ml @@ -41,8 +41,13 @@ type call = { 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; + (** The un-instantiated function signature, if this is not a unop/binop. + + This is useful to retrieve the names of the inputs, to generate pretty + names in the translation. + *) + inst_sg : inst_fun_sig option; + (** The instantiated function signature, if this is not a unop/binop *) abstractions : AbstractionId.id list; (** The region abstractions introduced upon calling the function *) generics : generic_args; diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 51a05057..22b1ef67 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -387,9 +387,9 @@ let abs_to_string (ctx : bs_ctx) (abs : V.abs) : string = 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 + | None -> ctx.sg.fun_ty.fwd_info.effect_info | Some bid -> - let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in + let back_sg = RegionGroupId.Map.find bid ctx.sg.fun_ty.back_sg in back_sg.effect_info let ctx_get_effect_info (ctx : bs_ctx) : fun_effect_info = @@ -1047,8 +1047,9 @@ let get_fun_effect_info (ctx : bs_ctx) (fun_id : A.fun_id_or_trait_method_ref) 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 + | None -> dsg.fun_ty.fwd_info.effect_info + | Some gid -> + (RegionGroupId.Map.find gid dsg.fun_ty.back_sg).effect_info in { info with @@ -1070,7 +1071,7 @@ let get_fun_effect_info (ctx : bs_ctx) (fun_id : A.fun_id_or_trait_method_ref) | Some gid -> RegionGroupId.Map.find gid loop_info.back_effect_infos) | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") -(** Translate a function signature to a decomposed function signature. +(** Translate an instantiated 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 @@ -1078,42 +1079,33 @@ let get_fun_effect_info (ctx : bs_ctx) (fun_id : A.fun_id_or_trait_method_ref) 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. + Remark: as we take as input an instantiated function signature, we assume + the types have already been normalized. + + - [generic_args]: the generic arguments with which the uninstantiated + signature was instantiated, leading to the current [sg] *) -let translate_fun_sig_with_regions_hierarchy_to_decomposed - (span : Meta.span option) (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 translate_inst_fun_sig_to_decomposed_fun_type (span : Meta.span option) + (decls_ctx : C.decls_ctx) (fun_id : A.fun_id_or_trait_method_ref) + (sg : A.inst_fun_sig) (input_names : string option list) : + decomposed_fun_type = + log#ldebug + (lazy + (let ctx = Print.Contexts.decls_ctx_to_fmt_env decls_ctx in + "translate_inst_fun_sig_with_regions_hierarchy_to_decomposed_fun_type: " + ^ "\n- sg.regions_hierarchy: " + ^ Print.Values.abs_region_groups_to_string sg.abs_regions_hierarchy + ^ "\n- inst_sg (inputs, output): " + ^ Print.Values.inst_fun_sig_to_string ctx sg + ^ "\n")); + let fun_infos = decls_ctx.fun_ctx.fun_infos in let type_infos = decls_ctx.type_ctx.type_infos 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 is a known impl). *) - (* Create the context *) - let ctx = - let region_groups = - List.map (fun (g : T.region_var_group) -> g.id) regions_hierarchy - in - let ctx = - InterpreterUtils.initialize_eval_ctx span 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 *) - AssociatedTypes.ctx_add_norm_trait_types_from_preds span ctx - sg.generics.trait_type_constraints - in - - (* Normalize the signature *) - let sg = - let ({ A.inputs; output; _ } : A.fun_sig) = sg in - let norm = AssociatedTypes.ctx_normalize_ty span ctx in - let inputs = List.map norm inputs in - let output = norm output in - { sg with A.inputs; output } - in (* Is the forward function stateful, and can it fail? *) let fwd_effect_info = @@ -1140,7 +1132,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (* Small helper to translate types for backward functions *) let translate_back_ty_for_gid (gid : T.RegionGroupId.id) (ty : T.ty) : ty option = - let rg = T.RegionGroupId.nth regions_hierarchy gid in + let rg = T.RegionGroupId.nth sg.regions_hierarchy gid in (* Compute the set of regions belonging to this group *) let gr_regions = T.RegionId.Set.of_list rg.regions in let keep_region r = @@ -1161,7 +1153,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed let translate_back_inputs_for_gid (gid : T.RegionGroupId.id) : ty list = (* For now we don't support nested borrows, so we check that there aren't parent regions *) - let parents = list_ancestor_region_groups regions_hierarchy gid in + let parents = list_ancestor_region_groups sg.regions_hierarchy gid in classert_opt_span __FILE__ __LINE__ (T.RegionGroupId.Set.is_empty parents) span @@ -1301,7 +1293,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed in let back_sg = RegionGroupId.Map.of_list - (List.map compute_back_info_for_group regions_hierarchy) + (List.map compute_back_info_for_group sg.regions_hierarchy) in (* The additional information about the forward function *) @@ -1337,19 +1329,77 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed info in + (* Return *) + { fwd_inputs; fwd_output; back_sg; fwd_info } + +let translate_fun_sig_with_regions_hierarchy_to_decomposed (span : span option) + (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 = + (* We need to normalize the signature *) + let inst_sg : LlbcAst.inst_fun_sig = + (* Create the context *) + let ctx = + let region_groups = + List.map (fun (g : T.region_var_group) -> g.id) regions_hierarchy + in + let ctx = + InterpreterUtils.initialize_eval_ctx span 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 *) + AssociatedTypes.ctx_add_norm_trait_types_from_preds span ctx + sg.generics.trait_type_constraints + in + + (* Normalize the signature *) + let ({ A.inputs; output; _ } : A.fun_sig) = sg in + let norm = AssociatedTypes.ctx_normalize_ty span ctx in + let inputs = List.map norm inputs in + let output = norm output in + let trait_type_constraints = + List.map + (AssociatedTypes.ctx_normalize_trait_type_constraint_region_binder span + ctx) + sg.generics.trait_type_constraints + in + + let _, fresh_abs_id = V.AbstractionId.fresh_stateful_generator () in + let region_gr_id_abs_id_list = + List.map + (fun (rg : T.region_var_group) -> (rg.id, fresh_abs_id ())) + regions_hierarchy + in + let region_gr_id_to_abs = + RegionGroupId.Map.of_list region_gr_id_abs_id_list + in + let region_id_to_abs id = RegionGroupId.Map.find id region_gr_id_to_abs in + let abs_regions_hierarchy = + List.map + (fun (rg : T.region_var_group) -> + let id = region_id_to_abs rg.id in + let parents = List.map region_id_to_abs rg.parents in + { T.id; parents; regions = rg.regions }) + regions_hierarchy + in + (* We need to introduce region abstraction ids *) + { + regions_hierarchy; + abs_regions_hierarchy; + trait_type_constraints; + inputs; + output; + } + in + (* Generic parameters *) let generics, preds = translate_generic_params span sg.generics in - (* Return *) - { - generics; - llbc_generics = sg.generics; - preds; - fwd_inputs; - fwd_output; - back_sg; - fwd_info; - } + let fun_ty = + translate_inst_fun_sig_to_decomposed_fun_type span decls_ctx fun_id inst_sg + input_names + in + { generics; llbc_generics = sg.generics; preds; fun_ty } let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) (fun_id : FunDeclId.id) (sg : A.fun_sig) (input_names : string option list) @@ -1361,6 +1411,7 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) let span = (FunDeclId.Map.find fun_id decls_ctx.fun_ctx.fun_decls).item_meta.span in + translate_fun_sig_with_regions_hierarchy_to_decomposed (Some span) decls_ctx (FunId (FRegular fun_id)) regions_hierarchy sg input_names @@ -1408,10 +1459,9 @@ let mk_back_output_ty_from_effect_info (effect_info : fun_effect_info) parent function region groups can be linked to a region abstraction introduced by the loop. *) -let compute_back_tys_with_info (dsg : Pure.decomposed_fun_sig) - ?(keep_rg_ids : RegionGroupId.Set.t option = None) - (subst : (generic_args * trait_instance_id) option) : - (back_sg_info * ty) option list = +let compute_back_tys_with_info (dsg : Pure.decomposed_fun_type) + (keep_rg_ids : RegionGroupId.Set.t option) : (back_sg_info * ty) option list + = let keep_rg_id = match keep_rg_ids with | None -> fun _ -> true @@ -1433,30 +1483,19 @@ let compute_back_tys_with_info (dsg : Pure.decomposed_fun_sig) mk_back_output_ty_from_effect_info effect_info inputs 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 (back_sg, ty) else (* We ignore this region group *) None) (RegionGroupId.Map.bindings dsg.back_sg) -let compute_back_tys (dsg : Pure.decomposed_fun_sig) - ?(keep_rg_ids : RegionGroupId.Set.t option = None) - (subst : (generic_args * trait_instance_id) option) : ty option list = - List.map (Option.map snd) (compute_back_tys_with_info dsg ~keep_rg_ids subst) +let compute_back_tys (dsg : Pure.decomposed_fun_type) + (keep_rg_ids : RegionGroupId.Set.t option) : ty option list = + List.map (Option.map snd) (compute_back_tys_with_info dsg keep_rg_ids) (** Compute the output type of a function, from a decomposed signature (the output type contains the type of the value returned by the forward function as well as the types of the returned backward functions). *) -let compute_output_ty_from_decomposed (dsg : Pure.decomposed_fun_sig) : ty = +let compute_output_ty_from_decomposed (dsg : Pure.decomposed_fun_type) : ty = (* 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 *) @@ -1478,17 +1517,17 @@ let translate_fun_sig_from_decomposed (dsg : Pure.decomposed_fun_sig) : fun_sig let llbc_generics = dsg.llbc_generics in let preds = dsg.preds in (* Compute the effects info *) - let fwd_info = dsg.fwd_info in + let fwd_info = dsg.fun_ty.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)) + (RegionGroupId.Map.bindings dsg.fun_ty.back_sg)) in let inputs, output = - let output = compute_output_ty_from_decomposed dsg in - let inputs = dsg.fwd_inputs in + let output = compute_output_ty_from_decomposed dsg.fun_ty in + let inputs = dsg.fun_ty.fwd_inputs in (inputs, output) in (* Compute which input type parameters are explicit/implicit *) @@ -1618,10 +1657,10 @@ let fresh_back_vars_for_current_fun (ctx : bs_ctx) ^ String.concat "" (List.filter_map (fun x -> x) region_names) in Some name) - (RegionGroupId.Map.bindings ctx.sg.back_sg) + (RegionGroupId.Map.bindings ctx.sg.fun_ty.back_sg) in let back_vars = - List.combine back_var_names (compute_back_tys ctx.sg ~keep_rg_ids None) + List.combine back_var_names (compute_back_tys ctx.sg.fun_ty keep_rg_ids) in let back_vars = List.map @@ -2535,7 +2574,10 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : ("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)); + ^ ctx_generic_args_to_string ctx call.generics + ^ "\n\n- call.inst_sg:\n" + ^ Print.option_to_string (inst_fun_sig_to_string call.ctx) call.inst_sg + ^ "\n")); (* Translate the function call *) let generics = ctx_translate_fwd_generic_args ctx call.generics in let args = @@ -2547,7 +2589,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in let dest_mplace = translate_opt_mplace call.dest_place in (* Retrieve the function id, and register the function call in the context - * if necessary. *) + if necessary. *) let ctx, fun_id, effect_info, args, dest_v = match call.call_id with | S.Fun (fid, call_id) -> @@ -2575,30 +2617,20 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx, ignore_fwd_output, back_funs_map, back_funs = (* We need to compute the signatures of the backward functions. *) let sg = Option.get call.sg in + let inst_sg = Option.get call.inst_sg in let decls_ctx = ctx.decls_ctx in let dsg = - translate_fun_sig_with_regions_hierarchy_to_decomposed - (Some ctx.span) decls_ctx fid call.regions_hierarchy sg + translate_inst_fun_sig_to_decomposed_fun_type (Some ctx.span) + decls_ctx fid inst_sg (List.map (fun _ -> None) sg.inputs) in + let back_tys = compute_back_tys_with_info dsg None 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 (Some ctx.span) - ctx.type_ctx.type_infos tr_self - in - (tr_self, all_generics) - in - let back_tys = - compute_back_tys_with_info dsg (Some (all_generics, tr_self)) - in + (lazy + ("back_tys:\n " + ^ String.concat "\n" + (List.map (pure_ty_to_string ctx) + (List.map snd (List.filter_map (fun x -> x) back_tys))))); (* Introduce variables for the backward functions *) (* Compute a proper basename for the variables *) let back_fun_name = @@ -2663,7 +2695,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let gids = List.map (fun (g : T.region_var_group) -> g.id) - call.regions_hierarchy + inst_sg.regions_hierarchy in let back_vars = List.map (Option.map mk_texpression_from_var) back_vars @@ -2678,7 +2710,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : 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 + of the forward function (because it translates to unit) we do NOT 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 @@ -2863,7 +2895,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) List.map (fun ty -> (None, ty)) tys else (* Regular function body *) - let back_sg = RegionGroupId.Map.find bid ctx.sg.back_sg in + let back_sg = RegionGroupId.Map.find bid ctx.sg.fun_ty.back_sg in List.combine back_sg.output_names back_sg.outputs in let ctx, vars = fresh_vars vars ctx in @@ -2952,7 +2984,7 @@ 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.Arith_status *) + if necessary. *) let ctx, func = bs_ctx_register_backward_call abs call_id rg_id back_inputs ctx in @@ -2966,7 +2998,7 @@ 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 - (* The backward function might have been filtered it does nothing + (* The backward function might have been filtered if it does nothing (consumes unit and returns unit). *) match func with | None -> next_e @@ -3456,7 +3488,7 @@ and translate_forward_end (ectx : C.eval_ctx) 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 back_sg = RegionGroupId.Map.find bid ctx.sg.fun_ty.back_sg in let ctx, backward_inputs_no_state = fresh_vars back_sg.inputs_no_state ctx in @@ -3507,7 +3539,7 @@ and translate_forward_end (ectx : C.eval_ctx) in let output = mk_simpl_tuple_ty - (RegionGroupId.Map.find bid ctx.sg.back_sg).outputs + (RegionGroupId.Map.find bid ctx.sg.fun_ty.back_sg).outputs in mk_output output in @@ -3548,8 +3580,8 @@ and translate_forward_end (ectx : C.eval_ctx) *) let translate_end ctx = (* Compute the output of the forward function *) - let fwd_effect_info = ctx.sg.fwd_info.effect_info in - let ctx, pure_fwd_var = fresh_var None ctx.sg.fwd_output ctx in + let fwd_effect_info = ctx.sg.fun_ty.fwd_info.effect_info in + let ctx, pure_fwd_var = fresh_var None ctx.sg.fun_ty.fwd_output ctx in let fwd_e = translate_one_end ctx None in (* If we reached a loop: if we are *inside* a loop, we need to ignore the @@ -3577,7 +3609,7 @@ and translate_forward_end (ectx : C.eval_ctx) (fun ((gid, _) : RegionGroupId.id * back_sg_info) -> if keep_rg_id gid then Some (translate_one_end ctx (Some gid)) else None) - (RegionGroupId.Map.bindings ctx.sg.back_sg) + (RegionGroupId.Map.bindings ctx.sg.fun_ty.back_sg) in (* Compute whether the backward expressions should be evaluated straight @@ -3593,7 +3625,7 @@ and translate_forward_end (ectx : C.eval_ctx) sg.inputs = [] && sg.effect_info.can_fail else false) else None) - (RegionGroupId.Map.bindings ctx.sg.back_sg) + (RegionGroupId.Map.bindings ctx.sg.fun_ty.back_sg) in (* Introduce variables for the backward functions. @@ -3604,7 +3636,7 @@ and translate_forward_end (ectx : C.eval_ctx) (* Create the return expressions *) let vars = let back_vars = List.filter_map (fun x -> x) back_vars in - if ctx.sg.fwd_info.ignore_output then back_vars + if ctx.sg.fun_ty.fwd_info.ignore_output then back_vars else pure_fwd_var :: back_vars in let vars = List.map mk_texpression_from_var vars in @@ -3699,14 +3731,14 @@ and translate_forward_end (ectx : C.eval_ctx) (* Introduce a fresh output value for the forward function *) let ctx, fwd_output, output_pat = - if ctx.sg.fwd_info.ignore_output then + if ctx.sg.fun_ty.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 + let ctx, output_var = fresh_var None ctx.sg.fun_ty.fwd_output ctx in ( ctx, mk_texpression_from_var output_var, [ mk_typed_pattern_from_var output_var None ] ) @@ -3736,7 +3768,7 @@ and translate_forward_end (ectx : C.eval_ctx) | Some v -> Some (mk_typed_pattern_from_var v None)) back_vars in - let gids = RegionGroupId.Map.keys ctx.sg.back_sg in + let gids = RegionGroupId.Map.keys ctx.sg.fun_ty.back_sg in let back_funs_map = RegionGroupId.Map.of_list (List.combine gids @@ -3882,13 +3914,15 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = in (* The output type of the loop function *) - let fwd_effect_info = { ctx.sg.fwd_info.effect_info with is_rec = true } in + let fwd_effect_info = + { ctx.sg.fun_ty.fwd_info.effect_info with is_rec = true } + in let back_effect_infos, output_ty = (* The loop backward functions consume the same additional inputs as the parent function, but have custom outputs *) log#ldebug (lazy - (let back_sgs = RegionGroupId.Map.bindings ctx.sg.back_sg in + (let back_sgs = RegionGroupId.Map.bindings ctx.sg.fun_ty.back_sg in "translate_loop:" ^ "\n- back_sgs: " ^ (Print.list_to_string (Print.pair_to_string RegionGroupId.to_string show_back_sg_info)) @@ -3903,7 +3937,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (fun ((rg_id, given_back) : RegionGroupId.id * ty list) -> (* Lookup the effect information about the parent function region group associated to this loop region abstraction *) - let back_sg = RegionGroupId.Map.find rg_id ctx.sg.back_sg in + let back_sg = RegionGroupId.Map.find rg_id ctx.sg.fun_ty.back_sg in (* 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 @@ -3935,11 +3969,11 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = let back_tys = List.filter_map snd back_info_tys in let output = let output = - if ctx.sg.fwd_info.ignore_output then back_tys - else ctx.sg.fwd_output :: back_tys + if ctx.sg.fun_ty.fwd_info.ignore_output then back_tys + else ctx.sg.fun_ty.fwd_output :: back_tys in let output = mk_simpl_tuple_ty output in - let effect_info = ctx.sg.fwd_info.effect_info in + let effect_info = ctx.sg.fun_ty.fwd_info.effect_info in let output = if effect_info.stateful then mk_simpl_tuple_ty [ mk_state_ty; output ] else output @@ -3982,11 +4016,11 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = let mk_panic = (* Note that we reuse the effect information from the parent function *) let effect_info = ctx_get_effect_info ctx in - let back_tys = compute_back_tys ctx.sg None in + let back_tys = compute_back_tys ctx.sg.fun_ty None in let back_tys = List.filter_map (fun x -> x) back_tys in let tys = - if ctx.sg.fwd_info.ignore_output then back_tys - else ctx.sg.fwd_output :: back_tys + if ctx.sg.fun_ty.fwd_info.ignore_output then back_tys + else ctx.sg.fun_ty.fwd_output :: back_tys in let output_ty = mk_simpl_tuple_ty tys in if effect_info.stateful then @@ -4250,11 +4284,11 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = mk_result_fail_texpression_with_error_id ctx.span error_failure_id output_ty in - let back_tys = compute_back_tys ctx.sg None in + let back_tys = compute_back_tys ctx.sg.fun_ty None in let back_tys = List.filter_map (fun x -> x) back_tys in let tys = - if ctx.sg.fwd_info.ignore_output then back_tys - else ctx.sg.fwd_output :: back_tys + if ctx.sg.fun_ty.fwd_info.ignore_output then back_tys + else ctx.sg.fun_ty.fwd_output :: back_tys in let output = mk_simpl_tuple_ty tys in mk_output output diff --git a/src/symbolic/SynthesizeSymbolic.ml b/src/symbolic/SynthesizeSymbolic.ml index 4ecc5285..65557b58 100644 --- a/src/symbolic/SynthesizeSymbolic.ml +++ b/src/symbolic/SynthesizeSymbolic.ml @@ -103,18 +103,23 @@ let synthesize_symbolic_expansion_no_branching (span : Meta.span) synthesize_symbolic_expansion span sv place [ Some see ] [ e ] let synthesize_function_call (call_id : call_id) (ctx : Contexts.eval_ctx) - (sg : fun_sig option) (regions_hierarchy : region_var_groups) + (sg : (fun_sig * inst_fun_sig) option) (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) : expression = + let sg, inst_sg = + match sg with + | Some (sg, inst_sg) -> (Some sg, Some inst_sg) + | None -> (None, None) + in let call = { call_id; ctx; sg; - regions_hierarchy; + inst_sg; abstractions; generics; trait_method_generics; @@ -132,22 +137,24 @@ let synthesize_global_eval (gref : global_decl_ref) (dest : symbolic_value) 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) + (inst_sg : inst_fun_sig) (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) : expression = synthesize_function_call (Fun (fun_id, call_id)) - ctx (Some sg) regions_hierarchy abstractions generics trait_method_generics - args args_places dest dest_place e + ctx + (Some (sg, inst_sg)) + 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) : expression = let generics = empty_generic_args in - synthesize_function_call (Unop unop) ctx None [] [] generics None [ 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) @@ -155,7 +162,7 @@ let synthesize_binary_op (ctx : Contexts.eval_ctx) (binop : binop) (arg1_place : mplace option) (dest : symbolic_value) (dest_place : mplace option) (e : expression) : expression = let generics = empty_generic_args in - synthesize_function_call (Binop binop) ctx None [] [] generics None + 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) From 63c504c0d75520173164b40922b9ac33f6147e99 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 16 Dec 2024 16:37:31 +0000 Subject: [PATCH 14/29] Add support for Box::new where the type instantiation uses mutable borrows --- src/symbolic/SymbolicToPure.ml | 45 +++++++++++++++++++++++++++++----- 1 file changed, 39 insertions(+), 6 deletions(-) diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 22b1ef67..5351816b 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -2590,7 +2590,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let dest_mplace = translate_opt_mplace call.dest_place in (* Retrieve the function id, and register the function call in the context if necessary. *) - let ctx, fun_id, effect_info, args, dest_v = + let ctx, fun_id, effect_info, args, dest_v, finish_next_e = match call.call_id with | S.Fun (fid, call_id) -> (* Regular function call *) @@ -2705,6 +2705,32 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in (ctx, dsg.fwd_info.ignore_output, Some back_funs_map, back_funs) in + (* This is a **hack** for [Box::new]: introduce backward functions + which are the identity if we instantiated [Box::new] with types + containing mutable borrows. + TODO: make this general. + *) + let ctx, back_funs, finish_next_e = + match fid with + | FunId (FBuiltin BoxNew) -> + let ctx, back_funs_bodies = + List.fold_left_map + (fun ctx (f : typed_pattern) -> + let ty, _ = dest_arrow_ty ctx.span f.ty in + let ctx, v = fresh_var (Some "back") ty ctx in + let pat = mk_typed_pattern_from_var v None in + (ctx, mk_lambda pat (mk_texpression_from_var v))) + ctx back_funs + in + let back_funs = List.combine back_funs back_funs_bodies in + let finish_next_e = + List.fold_right + (fun (pat, bound) next -> mk_let false pat bound next) + back_funs + in + (ctx, [], finish_next_e) + | _ -> (ctx, back_funs, fun e -> e) + 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 @@ -2732,7 +2758,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx = bs_ctx_register_forward_call call_id call args back_funs_map ctx in - (ctx, func, effect_info, args, dest) + (ctx, func, effect_info, args, dest, finish_next_e) | S.Unop E.Not -> ( match args with | [ arg ] -> @@ -2754,7 +2780,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in 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 ty), effect_info, args, dest) + (ctx, Unop (Not ty), effect_info, args, dest, fun e -> e) | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") | S.Unop E.Neg -> ( match args with @@ -2773,7 +2799,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in 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) + (ctx, Unop (Neg int_ty), effect_info, args, dest, fun e -> e) | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") | S.Unop (E.Cast cast_kind) -> begin match cast_kind with @@ -2790,7 +2816,12 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in 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) + ( ctx, + Unop (Cast (src_ty, tgt_ty)), + effect_info, + args, + dest, + fun e -> e ) | CastFnPtr _ -> craise __FILE__ __LINE__ ctx.span "TODO: function casts" | CastUnsize _ -> @@ -2820,7 +2851,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in 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) + (ctx, Binop (binop, int_ty0), effect_info, args, dest, fun e -> e) | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") in let func = { id = FunOrOp fun_id; generics } in @@ -2833,6 +2864,8 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let call = mk_apps ctx.span func args in (* Translate the next expression *) let next_e = translate_expression e ctx in + (* TODO: this is a hack for [Box::new]: introduce the backward functions *) + let next_e = finish_next_e next_e in (* Put together *) mk_let effect_info.can_fail dest_v call next_e From 130e82b4a16e3ed694808d3dcdb102e4414b9842 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 16 Dec 2024 17:12:32 +0000 Subject: [PATCH 15/29] Simplify the identity functions in the output code --- src/pure/PureMicroPasses.ml | 177 +++++++++++++++++++++++++----------- src/pure/PureUtils.ml | 8 ++ 2 files changed, 133 insertions(+), 52 deletions(-) diff --git a/src/pure/PureMicroPasses.ml b/src/pure/PureMicroPasses.ml index 25ce368d..5e480d45 100644 --- a/src/pure/PureMicroPasses.ml +++ b/src/pure/PureMicroPasses.ml @@ -1007,13 +1007,16 @@ let simplify_let_bindings (ctx : trans_ctx) (def : fun_decl) : fun_decl = a non-primitive function call (i.e.: inline the binops, ADT constructions, etc.). + [inline_identity]: if [true], inline the identity functions (i.e., lambda + functions of the shape [fun x -> x]). + TODO: we have a smallish issue which is that rvalues should be merged with expressions... For now, this forces us to substitute whenever we can, but leave the let-bindings where they are, and eliminated them in a subsequent pass (if they are useless). *) -let inline_useless_var_reassignments ~(inline_named : bool) - ~(inline_const : bool) ~(inline_pure : bool) (ctx : trans_ctx) +let inline_useless_var_assignments ~(inline_named : bool) ~(inline_const : bool) + ~(inline_pure : bool) ~(inline_identity : bool) (ctx : trans_ctx) (def : fun_decl) : fun_decl = let obj = object (self) @@ -1031,55 +1034,67 @@ let inline_useless_var_reassignments ~(inline_named : bool) *) match (monadic, lv.value) with | false, PatVar (lv_var, _) -> - (* We can filter if: *) - (* 1. the left variable is unnamed or [inline_named] is true *) - let filter_left = - match (inline_named, lv_var.basename) with - | true, _ | _, None -> true - | _ -> false - in - (* And either: - 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 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 + (* We can filter if: 1. *) + let filter_pure = + (* 1.1. the left variable is unnamed or [inline_named] is true *) + let filter_left = + match (inline_named, lv_var.basename) with + | true, _ | _, None -> true + | _ -> false in - is_const re || is_const_adt + (* And either: + 1.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: + 1.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: + 1.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 = + inline_pure + && + let app, _ = destruct_apps re in + match app.e with + | Qualif qualif -> ( + match qualif.id with + | AdtCons _ -> true (* ADT constructor *) + | Proj _ -> true (* Projector *) + | FunOrOp (Unop _ | Binop _) -> + true (* primitive function call *) + | FunOrOp (Fun _) -> false (* non-primitive function call *) + | _ -> false) + | StructUpdate _ -> true (* ADT constructor *) + | _ -> false + in + filter_left && (var_or_global || const_re || pure_re) 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 = - inline_pure + + (* Or if: 2. the let-binding bounds the identity function *) + let filter_id = + inline_identity && - let app, _ = destruct_apps re in - match app.e with - | Qualif qualif -> ( - match qualif.id with - | AdtCons _ -> true (* ADT constructor *) - | Proj _ -> true (* Projector *) - | FunOrOp (Unop _ | Binop _) -> - true (* primitive function call *) - | FunOrOp (Fun _) -> false (* non-primitive function call *) - | _ -> false) - | StructUpdate _ -> true (* ADT constructor *) + match re.e with + | Lambda ({ value = PatVar (v0, _); _ }, { e = Var v1; _ }) -> + v0.id = v1 | _ -> false in - let filter = - filter_left && (var_or_global || const_re || pure_re) - in + + let filter = filter_pure || filter_id in (* Update the rhs (we may perform substitutions inside, and it is * better to do them *before* we inline it *) @@ -2024,6 +2039,62 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl = let body = Some { body with body = obj#visit_texpression () body.body } in { def with body } +(** Simplify the lambdas by applying beta-reduction *) +let apply_beta_reduction (_ctx : trans_ctx) (def : fun_decl) : fun_decl = + (* The map visitor *) + let visitor = + object (self) + inherit [_] map_expression as super + + method! visit_Var env vid = + match VarId.Map.find_opt vid env with + | None -> Var vid + | Some e -> e.e + + method! visit_texpression env e = + let f, args = destruct_apps e in + let args = List.map (self#visit_texpression env) args in + let pats, body = destruct_lambdas f in + if args <> [] && pats <> [] then + (* Apply the beta-reduction + + First split the arguments/patterns between those that + will disappear and those we have to preserve. + *) + let min = Int.min (List.length args) (List.length pats) in + let pats, kept_pats = Collections.List.split_at pats min in + let args, kept_args = Collections.List.split_at args min in + (* Substitute *) + let vars = + List.map (fun v -> (fst (as_pat_var def.item_meta.span v)).id) pats + in + let body = + let env = VarId.Map.add_list (List.combine vars args) env in + super#visit_texpression env body + in + (* Reconstruct the term *) + mk_apps def.item_meta.span + (mk_lambdas kept_pats (super#visit_texpression env body)) + kept_args + else + mk_apps def.item_meta.span + (mk_lambdas pats (super#visit_texpression env body)) + args + end + in + (* Update the body *) + match def.body with + | None -> def + | Some body -> + let body = + Some + { + body with + body = visitor#visit_texpression VarId.Map.empty body.body; + } + in + { def with body } + (** This pass simplifies uses of array/slice index operations. We perform the following transformations: @@ -2351,10 +2422,12 @@ let end_passes : (* Inline the useless variable reassignments *) ( None, "inline_useless_var_assignments", - inline_useless_var_reassignments ~inline_named:true ~inline_const:true - ~inline_pure:true ); + inline_useless_var_assignments ~inline_named:true ~inline_const:true + ~inline_pure:true ~inline_identity:true ); + (* Simplify the lambdas by applying beta-reduction *) + (None, "apply_beta_reduction", apply_beta_reduction); (* Eliminate the box functions - note that the "box" types were eliminated - * during the symbolic to pure phase: see the comments for [eliminate_box_functions] *) + during the symbolic to pure phase: see the comments for [eliminate_box_functions] *) (None, "eliminate_box_functions", eliminate_box_functions); (* Filter the useless variables, assignments, function calls, etc. *) (None, "filter_useless", filter_useless); @@ -2392,9 +2465,9 @@ let end_passes : (None, "simplify_let_bindings", simplify_let_bindings); (* Inline the useless vars again *) ( None, - "inline_useless_var_reassignments", - inline_useless_var_reassignments ~inline_named:true ~inline_const:true - ~inline_pure:false ); + "inline_useless_var_assignments", + inline_useless_var_assignments ~inline_named:true ~inline_const:true + ~inline_pure:false ~inline_identity:true ); (* Filter the useless variables again *) (None, "filter_useless (pass 2)", filter_useless); (* Simplify the let-then return again (the lambda simplification may have diff --git a/src/pure/PureUtils.ml b/src/pure/PureUtils.ml index 8a8cc1d3..7dac890e 100644 --- a/src/pure/PureUtils.ml +++ b/src/pure/PureUtils.ml @@ -278,6 +278,11 @@ let is_cvar (e : texpression) : bool = | CVar _ -> true | _ -> false +let as_pat_var (span : Meta.span) (p : typed_pattern) : var * mplace option = + match p.value with + | PatVar (v, mp) -> (v, mp) + | _ -> craise __FILE__ __LINE__ span "Not a var" + let is_global (e : texpression) : bool = match e.e with | Qualif { id = Global _; _ } -> true @@ -848,6 +853,9 @@ let mk_lambda (x : typed_pattern) (e : texpression) : texpression = let e = Lambda (x, e) in { e; ty } +let mk_lambdas (xl : typed_pattern list) (e : texpression) : texpression = + List.fold_right mk_lambda xl e + let mk_lambda_from_var (var : var) (mp : mplace option) (e : texpression) : texpression = let pat = PatVar (var, mp) in From 768b9ea3bdf3c4d7330a9d814854c57ef4e4287a Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 09:53:52 +0000 Subject: [PATCH 16/29] Add some meta-information to AEndedProjBorrows --- src/interp/InterpreterBorrows.ml | 5 ++++- src/llbc/Values.ml | 21 ++++++++++++++++++--- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 534da2e6..0a607a0a 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -519,7 +519,10 @@ let end_aproj_borrows (span : Meta.span) (ended_regions : RegionId.Set.t) let update_owned (_abs : abs) (_abs_sv : symbolic_value) (_abs_proj_ty : rty) (local_given_back : (msymbolic_value * aproj) list) : aproj = (* There is nothing to project *) - AEndedProjBorrows (nsv, local_given_back) + let mvalues = + { consumed = mk_typed_value_from_symbolic_value sv; given_back = nsv } + in + AEndedProjBorrows (mvalues, local_given_back) in update_intersecting_aproj_borrows span ~fail_if_unchanged:true ~include_ancestors:false ~include_owned:true ~update_shared:None diff --git a/src/llbc/Values.ml b/src/llbc/Values.ml index a436c953..0f73e494 100644 --- a/src/llbc/Values.ml +++ b/src/llbc/Values.ml @@ -180,6 +180,9 @@ type proj_marker = PNone | PLeft | PRight [@@deriving show, ord] type marker_borrow_id = proj_marker * BorrowId.id [@@deriving show, ord] +type ended_borrow_mvalues = { consumed : mvalue; given_back : msymbolic_value } +[@@deriving show, ord] + module MarkerBorrowIdOrd = struct type t = marker_borrow_id @@ -225,6 +228,9 @@ class ['self] iter_typed_avalue_base = fun env ids -> AbstractionId.Set.iter (self#visit_abstraction_id env) ids method visit_proj_marker : 'env -> proj_marker -> unit = fun _ _ -> () + + method visit_ended_borrow_mvalues : 'env -> ended_borrow_mvalues -> unit = + fun _ _ -> () end (** Ancestor for {!typed_avalue} map visitor *) @@ -247,6 +253,10 @@ class ['self] map_typed_avalue_base = fun env ids -> AbstractionId.Set.map (self#visit_abstraction_id env) ids method visit_proj_marker : 'env -> proj_marker -> proj_marker = fun _ x -> x + + method visit_ended_borrow_mvalues + : 'env -> ended_borrow_mvalues -> ended_borrow_mvalues = + fun _ x -> x end (** When giving shared borrows to functions (i.e., inserting shared borrows inside @@ -347,10 +357,12 @@ and aproj = Note that we keep the original symbolic value as a meta-value. *) - | AEndedProjBorrows of msymbolic_value * (msymbolic_value * aproj) list + | AEndedProjBorrows of ended_borrow_mvalues * (msymbolic_value * aproj) list (** The only purpose of {!AEndedProjBorrows} is to store, for synthesis - purposes, the symbolic value which was generated and given back upon - ending the borrow. + purposes: + - the symbolic value which was consumed upon creating the projection + - the symbolic value which was generated and given back upon + ending the borrows *) | AEmpty (** Nothing to project (because there are no borrows, etc.) *) @@ -447,6 +459,9 @@ and aloan_content = there are nested borrows: ending a loan might consume borrows which need to be projected in the abstraction). + [given_back_meta]: stores the (meta-)value which was consumed upon + ending the loan. We use this for synthesis purposes. + Rk.: *DO NOT* use [visit_AEndedMutLoan]. If we update the order of the arguments and you forget to swap them at the level of [visit_AEndedMutLoan], you will not notice it. From 56983411758b0f7bcd82a92f7f42d94bf4a6b99e Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 16:22:54 +0000 Subject: [PATCH 17/29] Add support for enumerations containing mutable borrows --- src/Translate.ml | 2 + src/interp/Interpreter.ml | 8 +- src/interp/InterpreterBorrows.ml | 7 +- src/llbc/Values.ml | 31 ++- src/symbolic/SymbolicAst.ml | 35 +-- src/symbolic/SymbolicToPure.ml | 346 ++++++++++++++++++++++++++--- src/symbolic/SynthesizeSymbolic.ml | 5 - 7 files changed, 369 insertions(+), 65 deletions(-) diff --git a/src/Translate.ml b/src/Translate.ml index 6882fb3b..11296a97 100644 --- a/src/Translate.ml +++ b/src/Translate.ml @@ -164,6 +164,8 @@ let translate_function_to_pure_aux (trans_ctx : trans_ctx) loops = Pure.LoopId.Map.empty; mk_return = None; mk_panic = None; + mut_borrow_to_consumed = BorrowId.Map.empty; + var_id_to_default = Pure.VarId.Map.empty; } in diff --git a/src/interp/Interpreter.ml b/src/interp/Interpreter.ml index dfa2285c..06ce858b 100644 --- a/src/interp/Interpreter.ml +++ b/src/interp/Interpreter.ml @@ -549,14 +549,14 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) * abstractions up to the one in which we are interested. *) (* Forward translation: retrieve the returned value *) - let fwd_e = + let fwd_e, ctx_return, ret_value = (* Pop the frame and retrieve the returned value at the same time *) let pop_return_value = true in let ret_value, ctx, cc_pop = pop_frame config span pop_return_value ctx in (* Generate the Return node *) - cc_pop (SA.Return (ctx, ret_value)) + (cc_pop (SA.Return (ctx, ret_value)), ctx, Option.get ret_value) in (* Backward translation: introduce "return" abstractions to consume the return value, then end all the @@ -581,7 +581,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) in let back_el = RegionGroupId.Map.of_list back_el in (* Put everything together *) - synthesize_forward_end ctx0 None fwd_e back_el + SA.ForwardEnd (Some (ctx_return, ret_value), ctx0, None, fwd_e, back_el) | EndEnterLoop (loop_id, loop_input_values) | EndContinue (loop_id, loop_input_values) -> (* Similar to [Return]: we have to play different endings *) @@ -618,7 +618,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) in let back_el = RegionGroupId.Map.of_list back_el in (* Put everything together *) - synthesize_forward_end ctx0 (Some loop_input_values) fwd_e back_el + ForwardEnd (None, ctx0, Some loop_input_values, fwd_e, back_el) | Panic -> (* Note that as we explore all the execution branches, one of * the executions can lead to a panic *) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 0a607a0a..6dfe59e5 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -519,9 +519,7 @@ let end_aproj_borrows (span : Meta.span) (ended_regions : RegionId.Set.t) let update_owned (_abs : abs) (_abs_sv : symbolic_value) (_abs_proj_ty : rty) (local_given_back : (msymbolic_value * aproj) list) : aproj = (* There is nothing to project *) - let mvalues = - { consumed = mk_typed_value_from_symbolic_value sv; given_back = nsv } - in + let mvalues = { consumed = sv; given_back = nsv } in AEndedProjBorrows (mvalues, local_given_back) in update_intersecting_aproj_borrows span ~fail_if_unchanged:true @@ -1340,7 +1338,8 @@ and end_abstraction_borrows (config : config) (span : Meta.span) let sv = convert_avalue_to_given_back_value span av in (* Replace the mut borrow to register the fact that we ended it and store with it the freshly generated given back value *) - let ended_borrow = ABorrow (AEndedMutBorrow (sv, av)) in + let meta = { bid; given_back = sv } in + let ended_borrow = ABorrow (AEndedMutBorrow (meta, av)) in let ctx = update_aborrow span ek_all bid ended_borrow ctx in (* Give the value back *) let sv = mk_typed_value_from_symbolic_value sv in diff --git a/src/llbc/Values.ml b/src/llbc/Values.ml index 0f73e494..57cbc6b8 100644 --- a/src/llbc/Values.ml +++ b/src/llbc/Values.ml @@ -180,7 +180,13 @@ type proj_marker = PNone | PLeft | PRight [@@deriving show, ord] type marker_borrow_id = proj_marker * BorrowId.id [@@deriving show, ord] -type ended_borrow_mvalues = { consumed : mvalue; given_back : msymbolic_value } +type ended_proj_borrow_meta = { + consumed : msymbolic_value; + given_back : msymbolic_value; +} +[@@deriving show, ord] + +type ended_mut_borrow_meta = { bid : borrow_id; given_back : msymbolic_value } [@@deriving show, ord] module MarkerBorrowIdOrd = struct @@ -229,7 +235,11 @@ class ['self] iter_typed_avalue_base = method visit_proj_marker : 'env -> proj_marker -> unit = fun _ _ -> () - method visit_ended_borrow_mvalues : 'env -> ended_borrow_mvalues -> unit = + method visit_ended_proj_borrow_meta : 'env -> ended_proj_borrow_meta -> unit + = + fun _ _ -> () + + method visit_ended_mut_borrow_meta : 'env -> ended_mut_borrow_meta -> unit = fun _ _ -> () end @@ -254,8 +264,12 @@ class ['self] map_typed_avalue_base = method visit_proj_marker : 'env -> proj_marker -> proj_marker = fun _ x -> x - method visit_ended_borrow_mvalues - : 'env -> ended_borrow_mvalues -> ended_borrow_mvalues = + method visit_ended_proj_borrow_meta + : 'env -> ended_proj_borrow_meta -> ended_proj_borrow_meta = + fun _ x -> x + + method visit_ended_mut_borrow_meta + : 'env -> ended_mut_borrow_meta -> ended_mut_borrow_meta = fun _ x -> x end @@ -357,7 +371,7 @@ and aproj = Note that we keep the original symbolic value as a meta-value. *) - | AEndedProjBorrows of ended_borrow_mvalues * (msymbolic_value * aproj) list + | AEndedProjBorrows of ended_proj_borrow_meta * (msymbolic_value * aproj) list (** The only purpose of {!AEndedProjBorrows} is to store, for synthesis purposes: - the symbolic value which was consumed upon creating the projection @@ -686,9 +700,10 @@ and aborrow_content = id) and also remove the AEndedIgnoredMutBorrow variant. For now, we prefer to be more precise that required. *) - | AEndedMutBorrow of msymbolic_value * typed_avalue - (** The sole purpose of {!AEndedMutBorrow} is to store the (symbolic) value - that we gave back as a meta-value, to help with the synthesis. + | AEndedMutBorrow of ended_mut_borrow_meta * typed_avalue + (** The sole purpose of {!AEndedMutBorrow} is to store meta information for + the synthesis, with in particular the (symbolic) value that was given + back upon ending the borrow. *) | AEndedSharedBorrow (** We don't really need {!AEndedSharedBorrow}: we simply want to be diff --git a/src/symbolic/SymbolicAst.ml b/src/symbolic/SymbolicAst.ml index 9472cbb1..f92be2b3 100644 --- a/src/symbolic/SymbolicAst.ml +++ b/src/symbolic/SymbolicAst.ml @@ -182,31 +182,34 @@ type expression = value. It has the same purpose as for the {!Return} case. *) | ForwardEnd of - (Contexts.eval_ctx[@opaque]) + ((Contexts.eval_ctx[@opaque]) * typed_value) option + * (Contexts.eval_ctx[@opaque]) * typed_value symbolic_value_id_map option * expression * expression region_group_id_map (** We use this delimiter to indicate at which point we switch to the - generation of code specific to the backward function(s). This allows - us in particular to factor the work out: we don't need to replay the - symbolic execution up to this point, and can reuse it for the forward - function and all the backward functions. - - The first expression gives the end of the translation for the forward - function, the map from region group ids to expressions gives the end - of the translation for the backward functions. + generation of code specific to the backward function(s). - The optional map from symbolic values to input values are input values - for loops: upon entering a loop, in the translation we call the loop - translation function, which takes care of the end of the execution. - - The evaluation context is the context at the moment we introduce the - [ForwardEnd], and is used to translate the input values (see the - comments for the {!Return} variant). + The fields are: + - the evaluation context **after we evaluated the return value** + - the value consumed by the return variable + - the evaluation context at the moment we introduce the + [ForwardEnd]. We use it to translate the input values + (see the comments for the {!Return} variant). + - an optional map from symbolic values to input values. + We use this to compute the input values for loops: upon entering a loop, + in the translation we call the loop translation function, which takes + care of the end of the execution. + - the end of the translation for the forward function + - a map from region group ids to expressions that give the end + of the translation for the backward functions This case also handles the case where we (re-)enter a loop (once we enter a loop in symbolic mode, we don't get out: the loop is responsible for the end of the function). + + TODO: because we store the returned value, the Return case may + not be useful anymore? *) | Loop of loop (** Loop *) | ReturnWithLoop of loop_id * bool diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 5351816b..d1d11166 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -282,6 +282,71 @@ type bs_ctx = { We initialize this at [None]. *) + mut_borrow_to_consumed : texpression V.BorrowId.Map.t; + (** A map from mutable borrows consumed by region abstractions to + consumed values. + + We use this to compute default values during the translation. + We need them because of the following case: + {[ + fn wrap_in_option(x: &'a mut T) -> Option<&'a mut T> { + Some(x) + } + ]} + + The translation should look like so: + {[ + let wrap_in_option (x : T) : T & (Option T -> T) = + (x, fun x' => let Some x' = x' in x') + ]} + + The problem is that the backward function requires unwrapping the value + from the option, which should have the variant [Some]. This is however + not something we can easily enforce in the type system at the backend + side, which means we actually have to generate a match which might fail. + In particular, for the (unreachable) [None] branch we have to produce + some value for [x']: we use the original value of [x], like so (note + that we simplify the [let x' = match ... in ...] expression later in + a micro-pass): + {[ + let wrap_in_option (x : T) : T & (Option T -> T) = + let back x' = + let x' = + match x' with + | Some x' -> x' + | _ -> x + in + x' + (x, back) + ]} + + **Remarks:** + We attempted to do store the consumed values directly when doing + the symbolic execution. It proved cumbersome for the following reasons: + - the symbolic execution is already quite complex, and keeping track + of those consumed values is actually non trivial especially + in the context of the join operation (for instance: when we join + two mutable borrows, which default value should we use?). + Generally speaking, we want to keep the symbolic execution as + tight as possible because this is the core of the engine. + - when we store a value (as a meta-value for instance), we need + to store the evaluation context at the same time, otherwise we + cannot translate it to a pure expression in the presence of shared + borrows (we need the evaluation context to follow the borrow + indirections). Making this possible would have required an important + refactoring of the code, as the values would have been mutually + recursive with the evaluation contexts. + On the contrary, computing this information when transforming the + symbolic trace to a pure model may not be the most obvious way of + retrieving those consumed values but in practice it is quite + straightforward and easy to debug. + *) + var_id_to_default : texpression VarId.Map.t; + (** Map from the variable identifier of a given back value and introduced + when deconstructing an ended abstraction, to the default value that + we can use when introducing the otherwise branch of the deconstructing + match (see [mut_borrow_to_consumed]). + *) } [@@deriving show] @@ -403,6 +468,9 @@ let bs_ctx_lookup_llbc_fun_decl (id : A.FunDeclId.id) (ctx : bs_ctx) : A.fun_decl = A.FunDeclId.Map.find id ctx.fun_ctx.llbc_fun_decls +let bs_ctx_lookup_type_decl (id : TypeDeclId.id) (ctx : bs_ctx) : type_decl = + TypeDeclId.Map.find id ctx.type_ctx.type_decls + (* We simply ignore the bound regions *) let translate_region_binder (translate_value : 'a -> 'b) (rb : 'a T.region_binder) : 'b = @@ -2073,7 +2141,7 @@ and adt_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) end and aloan_content_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) - (ectx : C.eval_ctx) (abs_regions : T.RegionId.Set.t) (lc : V.aloan_content) + (ectx : C.eval_ctx) (_abs_regions : T.RegionId.Set.t) (lc : V.aloan_content) : texpression option = match lc with | AMutLoan (_, _, _) | ASharedLoan (_, _, _, _) -> @@ -2106,7 +2174,7 @@ and aloan_content_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) (* This case only happens with nested borrows *) craise __FILE__ __LINE__ ctx.span "Unimplemented" -and aproj_to_consumed_aux (ctx : bs_ctx) (abs_regions : T.RegionId.Set.t) +and aproj_to_consumed_aux (ctx : bs_ctx) (_abs_regions : T.RegionId.Set.t) (aproj : V.aproj) : texpression option = match aproj with | V.AEndedProjLoans (msv, []) -> @@ -2198,6 +2266,11 @@ let translate_opt_mplace (p : S.mplace option) : mplace option = | None -> None | Some p -> Some (translate_mplace p) +type borrow_or_symbolic_id = + | Borrow of V.BorrowId.id + | Symbolic of V.SymbolicValueId.id +[@@deriving show, ord] + (** Explore an abstraction value which we know **was generated by a borrow projection** (this means we won't find loans or loan projectors inside it) and convert it to a given back value by collecting all the meta-values from the ended *borrows*. @@ -2215,6 +2288,14 @@ let translate_opt_mplace (p : S.mplace option) : mplace option = - [under_mut]: if [true] it means we are below a mutable borrow. This influences whether we filter values or not. + + Note that we return: + - an updated context (because the patterns introduce fresh variables) + - a map from variable ids (introduced in the returned pattern) to either + the mutable borrow which gave back this value, or the projected symbolic + value which gave it back. We need this to compute default values (see + [bs_ctx.mut_borrow_to_consumed]). + - the pattern *) let rec typed_avalue_to_given_back_aux ~(filter : bool) (abs_regions : T.RegionId.Set.t) (mp : mplace option) (av : V.typed_avalue) @@ -2338,8 +2419,24 @@ and aborrow_content_to_given_back_aux ~(filter : bool) (mp : mplace option) craise __FILE__ __LINE__ ctx.span "Unreachable" | AEndedMutBorrow (msv, _) -> (* Return the meta symbolic-value *) - let ctx, var = fresh_var_for_symbolic_value msv ctx in - (ctx, Some (mk_typed_pattern_from_var var mp)) + let ctx, var = fresh_var_for_symbolic_value msv.given_back ctx in + let pat = mk_typed_pattern_from_var var mp in + (* Lookup the default value and update the [var_id_to_default] map. + Note that the default value might be missing, for instance for + abstractions which were not introduced because of function calls but + rather because of loops. + *) + let ctx = + match V.BorrowId.Map.find_opt msv.bid ctx.mut_borrow_to_consumed with + | None -> ctx + | Some e -> + { + ctx with + var_id_to_default = VarId.Map.add var.id e ctx.var_id_to_default; + } + in + (* *) + (ctx, Some pat) | AEndedIgnoredMutBorrow _ -> (* This happens with nested borrows: we need to dive in *) craise __FILE__ __LINE__ ctx.span "Unimplemented" @@ -2356,8 +2453,19 @@ and aproj_to_given_back_aux (mp : mplace option) (aproj : V.aproj) | AEndedProjBorrows (mv, given_back) -> cassert __FILE__ __LINE__ (given_back = []) ctx.span "Unreachable"; (* Return the meta-value *) - let ctx, var = fresh_var_for_symbolic_value mv ctx in - (ctx, Some (mk_typed_pattern_from_var var mp)) + let ctx, var = fresh_var_for_symbolic_value mv.given_back ctx in + let pat = mk_typed_pattern_from_var var mp in + (* Register the default value *) + let ctx = + { + ctx with + var_id_to_default = + VarId.Map.add var.id + (symbolic_value_to_texpression ctx mv.consumed) + ctx.var_id_to_default; + } + in + (ctx, Some pat) | AEmpty | AProjLoans (_, _, _) | AProjBorrows (_, _, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" @@ -2470,6 +2578,163 @@ let eval_ctx_to_symbolic_assignments_info (ctx : bs_ctx) let translate_error (span : Meta.span option) (msg : string) : texpression = { e = EError (span, msg); ty = Error } +(** Register the values consumed by a region abstraction through mutable borrows. + + We need this to compute default values for given back values - see the + explanations about [bs_ctx.mut_borrow_to_consumed]. +*) +let register_consumed_mut_borrows (ectx : C.eval_ctx) (ctx : bs_ctx) + (v : V.typed_value) : bs_ctx = + let ctx = ref ctx in + let visitor = + object + inherit [_] V.iter_typed_value as super + + method! visit_VMutBorrow env bid v = + let e = typed_value_to_texpression !ctx ectx v in + ctx := + { + !ctx with + mut_borrow_to_consumed = + V.BorrowId.Map.add bid e !ctx.mut_borrow_to_consumed; + }; + super#visit_VMutBorrow env bid v + end + in + visitor#visit_typed_value () v; + !ctx + +(** Small helper. + + We use this to properly deconstruct the values given back by backward + functions in the presence of enumerations. See [bs_ctx.mut_borrow_to_consumed]. + + This helper transforms a let-bound pattern and a bound expression + to properly introduce matches if necessary. + + For instance, we use it to transform this: + {[ + let Some x = e in + ^^^^^^ ^ + pat let-bound expression + ]} + into: + {[ + let x = match e with | Some x -> x | _ -> default_value in + ^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + new pat new let-bound expression + ]} + *) +let decompose_let_match (ctx : bs_ctx) + ((pat, bound) : typed_pattern * texpression) : + bs_ctx * (typed_pattern * texpression) = + log#ldebug + (lazy + ("decompose_let_match: " ^ "\n- pat: " + ^ typed_pattern_to_string ctx pat + ^ "\n- bound: " + ^ texpression_to_string ctx bound)); + + let found_enum = ref false in + (* We update the pattern if it deconstructs an enumeration with > 1 variants *) + let visitor = + object + inherit [_] reduce_expression as super + method zero : var list = [] + method plus vars0 vars1 = vars0 @ vars1 + method! visit_typed_pattern _ pat = super#visit_typed_pattern pat.ty pat + + method! visit_adt_pattern ty pat = + (* Lookup the type decl *) + let type_id, _ = ty_as_adt ctx.span ty in + match type_id with + | TAdtId id -> + let decl = bs_ctx_lookup_type_decl id ctx in + begin + match decl.kind with + | Struct _ | Opaque -> () + | Enum vl -> if List.length vl > 1 then found_enum := true else () + end; + super#visit_adt_pattern ty pat + | TTuple -> + (* ok *) + super#visit_adt_pattern ty pat + | TBuiltin _ -> + (* Shouldn't happen *) + craise __FILE__ __LINE__ ctx.span "Unreachable" + + method! visit_PatVar _ var _ = [ var ] + end + in + + (* Visit the pattern *) + let vars : var list = visitor#visit_typed_pattern pat.ty pat in + + (* *) + if !found_enum then + (* Found an enumeration with > 1 variants: we have to deconstruct + the pattern *) + (* First, refresh the variables - we will use fresh variables + in the patterns of the internal match *) + let (ctx, fresh_vars) : _ * var list = + List.fold_left_map + (fun ctx (var : var) -> fresh_var var.basename var.ty ctx) + ctx vars + in + (* Create the new pattern for the match, with the fresh variables *) + let subst = + VarId.Map.of_list + (List.map2 (fun (v0 : var) (v1 : var) -> (v0.id, v1)) vars fresh_vars) + in + let subst_visitor = + object + inherit [_] map_expression + method! visit_PatVar _ v mp = PatVar (VarId.Map.find v.id subst, mp) + end + in + (* Create the correct branch *) + let match_pat = subst_visitor#visit_typed_pattern () pat in + let match_e = List.map mk_texpression_from_var fresh_vars in + let match_e = mk_simpl_tuple_texpression ctx.span match_e in + let match_branch = { pat = match_pat; branch = match_e } in + (* Create the otherwise branch *) + let default_e = + List.map + (fun (v : var) -> + (* We need to lookup the default values corresponding to + each given back symbolic value *) + match VarId.Map.find_opt v.id ctx.var_id_to_default with + | Some e -> e + | None -> + (* This is a bug, but we might want to continue generating the model: + as an escape hatch, simply use the original variable (this will + lead to incorrect code of course) *) + save_error __FILE__ __LINE__ (Some ctx.span) + ("Internal error: could not find variable. Please report an \ + issue. Debugging information:" ^ "\n- v.id: " + ^ VarId.to_string v.id ^ "\n- ctx.var_id_to_default: " + ^ VarId.Map.to_string None + (texpression_to_string ctx) + ctx.var_id_to_default + ^ "\n"); + mk_texpression_from_var v) + vars + in + let default_e = mk_simpl_tuple_texpression ctx.span default_e in + let default_pat = mk_dummy_pattern pat.ty in + let default_branch = { pat = default_pat; branch = default_e } in + let switch_e = Switch (bound, Match [ match_branch; default_branch ]) in + let bound = { e = switch_e; ty = match_e.ty } in + (* Update the pattern itself *) + let pat = + mk_simpl_tuple_pattern + (List.map (fun v -> mk_typed_pattern_from_var v None) vars) + in + (* *) + (ctx, (pat, bound)) + else (* Nothing to do *) + (ctx, (pat, bound)) + let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = match e with | S.Return (ectx, opt_v) -> @@ -2489,12 +2754,12 @@ let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = | IntroSymbolic (ectx, p, sv, v, e) -> translate_intro_symbolic ectx p sv v e ctx | Meta (span, e) -> translate_espan span e ctx - | ForwardEnd (ectx, loop_input_values, e, back_e) -> + | ForwardEnd (return_value, ectx, loop_input_values, e, back_e) -> (* Translate the end of a function, or the end of a loop. The case where we (re-)enter a loop is handled here. *) - translate_forward_end ectx loop_input_values e back_e ctx + translate_forward_end return_value ectx loop_input_values e back_e ctx | Loop loop -> translate_loop loop ctx | Error (span, msg) -> translate_error span msg @@ -2578,6 +2843,10 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : ^ "\n\n- call.inst_sg:\n" ^ Print.option_to_string (inst_fun_sig_to_string call.ctx) call.inst_sg ^ "\n")); + (* Register the consumed mutable borrows to compute default values *) + let ctx = + List.fold_left (register_consumed_mut_borrows call.ctx) ctx call.args + in (* Translate the function call *) let generics = ctx_translate_fwd_generic_args ctx call.generics in let args = @@ -2952,15 +3221,19 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) consumed_values ^ "\n")); - (* Group the two lists *) + (* Prepare the let-bindings by introducing a match if necessary *) + let given_back_variables = + List.map (fun v -> mk_typed_pattern_from_var v None) given_back_variables + in let variables_values = List.combine given_back_variables consumed_values in + (* Sanity check: the two lists match (same types) *) (* TODO: normalize the types *) if !Config.type_check_pure_code then List.iter (fun (var, v) -> sanity_check __FILE__ __LINE__ - ((var : var).ty = (v : texpression).ty) + ((var : typed_pattern).ty = (v : texpression).ty) ctx.span) variables_values; (* Translate the next expression *) @@ -2968,8 +3241,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) (* Generate the assignemnts *) let monadic = false in List.fold_right - (fun (var, value) (e : texpression) -> - mk_let monadic (mk_typed_pattern_from_var var None) value e) + (fun (var, value) (e : texpression) -> mk_let monadic var value e) variables_values next_e and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) @@ -3022,7 +3294,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) bs_ctx_register_backward_call abs call_id rg_id back_inputs ctx in (* Translate the next expression *) - let next_e = translate_expression e ctx in + let next_e ctx = translate_expression e ctx in (* Put everything together *) let inputs = back_inputs in let args_mplaces = List.map (fun _ -> None) inputs in @@ -3034,7 +3306,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) (* The backward function might have been filtered if it does nothing (consumes unit and returns unit). *) match func with - | None -> next_e + | None -> next_e ctx | Some func -> log#ldebug (lazy @@ -3045,7 +3317,10 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) ^ pure_ty_to_string ctx func.ty ^ "\n\nargs:\n" ^ String.concat "\n" args)); let call = mk_apps ctx.span func args in - mk_let effect_info.can_fail output call next_e + (* Introduce a match if necessary *) + let ctx, (output, call) = decompose_let_match ctx (output, call) in + (* Translate the next expression and construct the let *) + mk_let effect_info.can_fail output call (next_e ctx) and translate_end_abstraction_identity (ectx : C.eval_ctx) (abs : V.abs) (e : S.expression) (ctx : bs_ctx) : texpression = @@ -3107,8 +3382,8 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) cassert __FILE__ __LINE__ (consumed = []) ctx.span "Nested borrows are not supported yet"; (* Retrieve the values given back upon ending this abstraction - note that - * we don't provide meta-place information, because those assignments will - * be inlined anyway... *) + we don't provide meta-place information, because those assignments will + be inlined anyway... *) log#ldebug (lazy ("abs: " ^ abs_to_string ctx abs)); let ctx, given_back = abs_to_given_back_no_mp abs ctx in log#ldebug @@ -3116,7 +3391,7 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) ("given back: " ^ Print.list_to_string (typed_pattern_to_string ctx) given_back)); (* Link the inputs to those given back values - note that this also - * checks we have the same number of values, of course *) + checks we have the same number of values, of course *) let given_back_inputs = List.combine given_back inputs in (* Sanity check *) List.iter @@ -3129,13 +3404,19 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) ^ pure_ty_to_string ctx input.ty)); sanity_check __FILE__ __LINE__ (given_back.ty = input.ty) ctx.span) given_back_inputs; + (* Prepare the let-bindings by introducing a match if necessary *) + let given_back_inputs = + List.map (fun (v, e) -> (v, mk_texpression_from_var e)) given_back_inputs + in + let ctx, given_back_inputs = + List.fold_left_map decompose_let_match ctx given_back_inputs + in (* Translate the next expression *) let next_e = translate_expression e ctx in (* Generate the assignments *) let monadic = false in List.fold_right - (fun (given_back, input_var) e -> - mk_let monadic given_back (mk_texpression_from_var input_var) e) + (fun (given_back, input_var) e -> mk_let monadic given_back input_var e) given_back_inputs next_e and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) @@ -3193,7 +3474,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) | Some nstate -> mk_simpl_tuple_pattern [ nstate; output ] in (* Translate the next expression *) - let next_e = translate_expression e ctx in + let next_e ctx = translate_expression e ctx in (* Put everything together *) let args_mplaces = List.map (fun _ -> None) inputs in let args = @@ -3212,7 +3493,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) (* We may have filtered the backward function elsewhere if it doesn't do anything (doesn't consume anything and doesn't return anything) *) match func with - | None -> next_e + | None -> next_e ctx | Some func -> let call = mk_apps ctx.span func args in (* Add meta-information - this is slightly hacky: we look at the @@ -3228,7 +3509,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) TODO: improve the heuristics, to give weight to the hints for instance. *) - let next_e = + let next_e ctx = if ctx.inside_loop then let consumed_values = abs_to_consumed ctx ectx abs in let var_values = List.combine outputs consumed_values in @@ -3241,12 +3522,13 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) var_values in let vars, values = List.split var_values in - mk_espan_symbolic_assignments vars values next_e - else next_e + mk_espan_symbolic_assignments vars values (next_e ctx) + else next_e ctx in - (* Create the let-binding *) - mk_let effect_info.can_fail output call next_e) + (* Create the let-binding - we may have to introduce a match *) + let ctx, (output, call) = decompose_let_match ctx (output, call) in + mk_let effect_info.can_fail output call (next_e ctx)) and translate_global_eval (gid : A.GlobalDeclId.id) (generics : T.generic_args) (sval : V.symbolic_value) (e : S.expression) (ctx : bs_ctx) : texpression = @@ -3496,10 +3778,18 @@ and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option) let var = mk_typed_pattern_from_var var mplace in mk_let monadic var v next_e -and translate_forward_end (ectx : C.eval_ctx) +and translate_forward_end (return_value : (C.eval_ctx * V.typed_value) option) + (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 = + (* Register the consumed mutable borrows to compute default values *) + let ctx = + match return_value with + | None -> ctx + | Some (ectx, v) -> register_consumed_mut_borrows ectx ctx v + in + 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 diff --git a/src/symbolic/SynthesizeSymbolic.ml b/src/symbolic/SynthesizeSymbolic.ml index 65557b58..11b19e98 100644 --- a/src/symbolic/SynthesizeSymbolic.ml +++ b/src/symbolic/SynthesizeSymbolic.ml @@ -178,11 +178,6 @@ let synthesize_assertion (ctx : Contexts.eval_ctx) (v : typed_value) (e : expression) = Assertion (ctx, v, e) -let synthesize_forward_end (ctx : Contexts.eval_ctx) - (loop_input_values : typed_value SymbolicValueId.Map.t option) - (e : expression) (el : expression RegionGroupId.Map.t) = - ForwardEnd (ctx, loop_input_values, e, el) - let synthesize_loop (loop_id : LoopId.id) (input_svalues : symbolic_value list) (fresh_svalues : SymbolicValueId.Set.t) (rg_to_given_back_tys : ty list RegionGroupId.Map.t) (end_expr : expression) From afb4873baa38d8a6f090afb98a066354c5411abf Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 16:23:47 +0000 Subject: [PATCH 18/29] Add examples in adt-borrows.rs --- tests/coq/misc/AdtBorrows.v | 153 ++++++++++++++++++- tests/fstar/misc/AdtBorrows.fst | 128 +++++++++++++++- tests/lean/AdtBorrows.lean | 138 ++++++++++++++++- tests/src/adt-borrows.rs | 80 ++++++++++ tests/src/mutually-recursive-traits.lean.out | 10 +- 5 files changed, 492 insertions(+), 17 deletions(-) diff --git a/tests/coq/misc/AdtBorrows.v b/tests/coq/misc/AdtBorrows.v index 15cd9468..d2261958 100644 --- a/tests/coq/misc/AdtBorrows.v +++ b/tests/coq/misc/AdtBorrows.v @@ -111,7 +111,7 @@ Definition MutWrapper_t (T : Type) : Type := T. Source: 'tests/src/adt-borrows.rs', lines 74:4-76:5 *) Definition mutWrapper_create {T : Type} (x : T) : result ((MutWrapper_t T) * (MutWrapper_t T -> T)) := - let back := fun (ret : MutWrapper_t T) => ret in Ok (x, back) + Ok (x, fun (ret : MutWrapper_t T) => ret) . (** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::unwrap]: @@ -245,7 +245,7 @@ Definition array_mut_borrow {N : usize} (x : array u32 N) : result ((array u32 N) * (array u32 N -> array u32 N)) := - let back := fun (ret : array u32 N) => ret in Ok (x, back) + Ok (x, fun (ret : array u32 N) => ret) . (** [adt_borrows::boxed_slice_shared_borrow]: @@ -258,7 +258,154 @@ Definition boxed_slice_shared_borrow (x : slice u32) : result (slice u32) := Source: 'tests/src/adt-borrows.rs', lines 158:0-160:1 *) Definition boxed_slice_mut_borrow (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := - let back := fun (ret : slice u32) => ret in Ok (x, back) + Ok (x, fun (ret : slice u32) => ret) +. + +(** [adt_borrows::SharedList] + Source: 'tests/src/adt-borrows.rs', lines 165:0-168:1 *) +Inductive SharedList_t (T : Type) := +| SharedList_Nil : SharedList_t T +| SharedList_Cons : T -> SharedList_t T -> SharedList_t T +. + +Arguments SharedList_Nil { _ }. +Arguments SharedList_Cons { _ }. + +(** [adt_borrows::{adt_borrows::SharedList<'a, T>}#6::push]: + Source: 'tests/src/adt-borrows.rs', lines 172:4-174:5 *) +Definition sharedList_push + {T : Type} (self : SharedList_t T) (x : T) : result (SharedList_t T) := + Ok (SharedList_Cons x self) +. + +(** [adt_borrows::{adt_borrows::SharedList<'a, T>}#6::pop]: + Source: 'tests/src/adt-borrows.rs', lines 176:4-182:5 *) +Definition sharedList_pop + {T : Type} (self : SharedList_t T) : result (T * (SharedList_t T)) := + match self with + | SharedList_Nil => Fail_ Failure + | SharedList_Cons hd tl => Ok (hd, tl) + end +. + +(** [adt_borrows::MutList] + Source: 'tests/src/adt-borrows.rs', lines 185:0-188:1 *) +Inductive MutList_t (T : Type) := +| MutList_Nil : MutList_t T +| MutList_Cons : T -> MutList_t T -> MutList_t T +. + +Arguments MutList_Nil { _ }. +Arguments MutList_Cons { _ }. + +(** [adt_borrows::{adt_borrows::MutList<'a, T>}#7::push]: + Source: 'tests/src/adt-borrows.rs', lines 192:4-194:5 *) +Definition mutList_push + {T : Type} (self : MutList_t T) (x : T) : + result ((MutList_t T) * (MutList_t T -> ((MutList_t T) * T))) + := + let back := + fun (ret : MutList_t T) => + let (x1, ml) := + match ret with | MutList_Cons t ml1 => (t, ml1) | _ => (x, self) end in + (ml, x1) in + Ok (MutList_Cons x self, back) +. + +(** [adt_borrows::{adt_borrows::MutList<'a, T>}#7::pop]: + Source: 'tests/src/adt-borrows.rs', lines 196:4-202:5 *) +Definition mutList_pop + {T : Type} (self : MutList_t T) : + result ((T * (MutList_t T)) * ((T * (MutList_t T)) -> MutList_t T)) + := + match self with + | MutList_Nil => Fail_ Failure + | MutList_Cons hd tl => + let back := + fun (ret : (T * (MutList_t T))) => + let (t, ml) := ret in MutList_Cons t ml in + Ok ((hd, tl), back) + end +. + +(** [adt_borrows::wrap_shared_in_option]: + Source: 'tests/src/adt-borrows.rs', lines 205:0-207:1 *) +Definition wrap_shared_in_option {T : Type} (x : T) : result (option T) := + Ok (Some x) +. + +(** [adt_borrows::wrap_mut_in_option]: + Source: 'tests/src/adt-borrows.rs', lines 209:0-211:1 *) +Definition wrap_mut_in_option + {T : Type} (x : T) : result ((option T) * (option T -> T)) := + let back := fun (ret : option T) => match ret with | Some t => t | _ => x end + in + Ok (Some x, back) +. + +(** [adt_borrows::List] + Source: 'tests/src/adt-borrows.rs', lines 213:0-216:1 *) +Inductive List_t (T : Type) := +| List_Cons : T -> List_t T -> List_t T +| List_Nil : List_t T +. + +Arguments List_Cons { _ }. +Arguments List_Nil { _ }. + +(** [adt_borrows::nth_shared]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 219:4-228:1 *) +Fixpoint nth_shared_loop + {T : Type} (ls : List_t T) (i : u32) : result (option T) := + match ls with + | List_Cons x tl => + if i s= 0%u32 + then Ok (Some x) + else (i1 <- u32_sub i 1%u32; nth_shared_loop tl i1) + | List_Nil => Ok None + end +. + +(** [adt_borrows::nth_shared]: + Source: 'tests/src/adt-borrows.rs', lines 218:0-228:1 *) +Definition nth_shared + {T : Type} (ls : List_t T) (i : u32) : result (option T) := + nth_shared_loop ls i +. + +(** [adt_borrows::nth_mut]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 231:4-240:1 *) +Fixpoint nth_mut_loop + {T : Type} (ls : List_t T) (i : u32) : + result ((option T) * (option T -> List_t T)) + := + match ls with + | List_Cons x tl => + if i s= 0%u32 + then + let back := + fun (ret : option T) => + let t := match ret with | Some t1 => t1 | _ => x end in + List_Cons t tl in + Ok (Some x, back) + else ( + i1 <- u32_sub i 1%u32; + p <- nth_mut_loop tl i1; + let (o, back) := p in + let back1 := + fun (ret : option T) => let tl1 := back ret in List_Cons x tl1 in + Ok (o, back1)) + | List_Nil => let back := fun (ret : option T) => List_Nil in Ok (None, back) + end +. + +(** [adt_borrows::nth_mut]: + Source: 'tests/src/adt-borrows.rs', lines 230:0-240:1 *) +Definition nth_mut + {T : Type} (ls : List_t T) (i : u32) : + result ((option T) * (option T -> List_t T)) + := + nth_mut_loop ls i . End AdtBorrows. diff --git a/tests/fstar/misc/AdtBorrows.fst b/tests/fstar/misc/AdtBorrows.fst index 234e72b7..7c7a58ce 100644 --- a/tests/fstar/misc/AdtBorrows.fst +++ b/tests/fstar/misc/AdtBorrows.fst @@ -79,7 +79,7 @@ type mutWrapper_t (t : Type0) = t Source: 'tests/src/adt-borrows.rs', lines 74:4-76:5 *) let mutWrapper_create (#t : Type0) (x : t) : result ((mutWrapper_t t) & (mutWrapper_t t -> t)) = - let back = fun ret -> ret in Ok (x, back) + Ok (x, fun ret -> ret) (** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::unwrap]: Source: 'tests/src/adt-borrows.rs', lines 78:4-80:5 *) @@ -171,7 +171,7 @@ let array_mut_borrow (#n : usize) (x : array u32 n) : result ((array u32 n) & (array u32 n -> array u32 n)) = - let back = fun ret -> ret in Ok (x, back) + Ok (x, fun ret -> ret) (** [adt_borrows::boxed_slice_shared_borrow]: Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 *) @@ -182,5 +182,127 @@ let boxed_slice_shared_borrow (x : slice u32) : result (slice u32) = Source: 'tests/src/adt-borrows.rs', lines 158:0-160:1 *) let boxed_slice_mut_borrow (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = - let back = fun ret -> ret in Ok (x, back) + Ok (x, fun ret -> ret) + +(** [adt_borrows::SharedList] + Source: 'tests/src/adt-borrows.rs', lines 165:0-168:1 *) +type sharedList_t (t : Type0) = +| SharedList_Nil : sharedList_t t +| SharedList_Cons : t -> sharedList_t t -> sharedList_t t + +(** [adt_borrows::{adt_borrows::SharedList<'a, T>}#6::push]: + Source: 'tests/src/adt-borrows.rs', lines 172:4-174:5 *) +let sharedList_push + (#t : Type0) (self : sharedList_t t) (x : t) : result (sharedList_t t) = + Ok (SharedList_Cons x self) + +(** [adt_borrows::{adt_borrows::SharedList<'a, T>}#6::pop]: + Source: 'tests/src/adt-borrows.rs', lines 176:4-182:5 *) +let sharedList_pop + (#t : Type0) (self : sharedList_t t) : result (t & (sharedList_t t)) = + begin match self with + | SharedList_Nil -> Fail Failure + | SharedList_Cons hd tl -> Ok (hd, tl) + end + +(** [adt_borrows::MutList] + Source: 'tests/src/adt-borrows.rs', lines 185:0-188:1 *) +type mutList_t (t : Type0) = +| MutList_Nil : mutList_t t +| MutList_Cons : t -> mutList_t t -> mutList_t t + +(** [adt_borrows::{adt_borrows::MutList<'a, T>}#7::push]: + Source: 'tests/src/adt-borrows.rs', lines 192:4-194:5 *) +let mutList_push + (#t : Type0) (self : mutList_t t) (x : t) : + result ((mutList_t t) & (mutList_t t -> ((mutList_t t) & t))) + = + let back = + fun ret -> + let (x1, ml) = + begin match ret with + | MutList_Cons x2 ml1 -> (x2, ml1) + | _ -> (x, self) + end in + (ml, x1) in + Ok (MutList_Cons x self, back) + +(** [adt_borrows::{adt_borrows::MutList<'a, T>}#7::pop]: + Source: 'tests/src/adt-borrows.rs', lines 196:4-202:5 *) +let mutList_pop + (#t : Type0) (self : mutList_t t) : + result ((t & (mutList_t t)) & ((t & (mutList_t t)) -> mutList_t t)) + = + begin match self with + | MutList_Nil -> Fail Failure + | MutList_Cons hd tl -> + let back = fun ret -> let (x, ml) = ret in MutList_Cons x ml in + Ok ((hd, tl), back) + end + +(** [adt_borrows::wrap_shared_in_option]: + Source: 'tests/src/adt-borrows.rs', lines 205:0-207:1 *) +let wrap_shared_in_option (#t : Type0) (x : t) : result (option t) = + Ok (Some x) + +(** [adt_borrows::wrap_mut_in_option]: + Source: 'tests/src/adt-borrows.rs', lines 209:0-211:1 *) +let wrap_mut_in_option + (#t : Type0) (x : t) : result ((option t) & (option t -> t)) = + let back = fun ret -> begin match ret with | Some x1 -> x1 | _ -> x end in + Ok (Some x, back) + +(** [adt_borrows::List] + Source: 'tests/src/adt-borrows.rs', lines 213:0-216:1 *) +type list_t (t : Type0) = +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t + +(** [adt_borrows::nth_shared]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 219:4-228:1 *) +let rec nth_shared_loop + (#t : Type0) (ls : list_t t) (i : u32) : result (option t) = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Ok (Some x) + else let* i1 = u32_sub i 1 in nth_shared_loop tl i1 + | List_Nil -> Ok None + end + +(** [adt_borrows::nth_shared]: + Source: 'tests/src/adt-borrows.rs', lines 218:0-228:1 *) +let nth_shared (#t : Type0) (ls : list_t t) (i : u32) : result (option t) = + nth_shared_loop ls i + +(** [adt_borrows::nth_mut]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 231:4-240:1 *) +let rec nth_mut_loop + (#t : Type0) (ls : list_t t) (i : u32) : + result ((option t) & (option t -> list_t t)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then + let back = + fun ret -> + let x1 = begin match ret with | Some x2 -> x2 | _ -> x end in + List_Cons x1 tl in + Ok (Some x, back) + else + let* i1 = u32_sub i 1 in + let* (o, back) = nth_mut_loop tl i1 in + let back1 = fun ret -> let tl1 = back ret in List_Cons x tl1 in + Ok (o, back1) + | List_Nil -> let back = fun ret -> List_Nil in Ok (None, back) + end + +(** [adt_borrows::nth_mut]: + Source: 'tests/src/adt-borrows.rs', lines 230:0-240:1 *) +let nth_mut + (#t : Type0) (ls : list_t t) (i : u32) : + result ((option t) & (option t -> list_t t)) + = + nth_mut_loop ls i diff --git a/tests/lean/AdtBorrows.lean b/tests/lean/AdtBorrows.lean index 2d061780..d3d42867 100644 --- a/tests/lean/AdtBorrows.lean +++ b/tests/lean/AdtBorrows.lean @@ -89,8 +89,7 @@ def use_shared_wrapper2 : Result Unit := Source: 'tests/src/adt-borrows.rs', lines 74:4-76:5 -/ def MutWrapper.create {T : Type} (x : T) : Result ((MutWrapper T) × (MutWrapper T → T)) := - let back := fun ret => ret - Result.ok (x, back) + Result.ok (x, fun ret => ret) /- [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::unwrap]: Source: 'tests/src/adt-borrows.rs', lines 78:4-80:5 -/ @@ -189,8 +188,7 @@ def array_mut_borrow {N : Usize} (x : Array U32 N) : Result ((Array U32 N) × (Array U32 N → Array U32 N)) := - let back := fun ret => ret - Result.ok (x, back) + Result.ok (x, fun ret => ret) /- [adt_borrows::boxed_slice_shared_borrow]: Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 -/ @@ -201,7 +199,135 @@ def boxed_slice_shared_borrow (x : Slice U32) : Result (Slice U32) := Source: 'tests/src/adt-borrows.rs', lines 158:0-160:1 -/ def boxed_slice_mut_borrow (x : Slice U32) : Result ((Slice U32) × (Slice U32 → Slice U32)) := - let back := fun ret => ret - Result.ok (x, back) + Result.ok (x, fun ret => ret) + +/- [adt_borrows::SharedList] + Source: 'tests/src/adt-borrows.rs', lines 165:0-168:1 -/ +inductive SharedList (T : Type) := +| Nil : SharedList T +| Cons : T → SharedList T → SharedList T + +/- [adt_borrows::{adt_borrows::SharedList<'a, T>}#6::push]: + Source: 'tests/src/adt-borrows.rs', lines 172:4-174:5 -/ +def SharedList.push + {T : Type} (self : SharedList T) (x : T) : Result (SharedList T) := + Result.ok (SharedList.Cons x self) + +/- [adt_borrows::{adt_borrows::SharedList<'a, T>}#6::pop]: + Source: 'tests/src/adt-borrows.rs', lines 176:4-182:5 -/ +def SharedList.pop + {T : Type} (self : SharedList T) : Result (T × (SharedList T)) := + match self with + | SharedList.Nil => Result.fail .panic + | SharedList.Cons hd tl => Result.ok (hd, tl) + +/- [adt_borrows::MutList] + Source: 'tests/src/adt-borrows.rs', lines 185:0-188:1 -/ +inductive MutList (T : Type) := +| Nil : MutList T +| Cons : T → MutList T → MutList T + +/- [adt_borrows::{adt_borrows::MutList<'a, T>}#7::push]: + Source: 'tests/src/adt-borrows.rs', lines 192:4-194:5 -/ +def MutList.push + {T : Type} (self : MutList T) (x : T) : + Result ((MutList T) × (MutList T → ((MutList T) × T))) + := + let back := + fun ret => + let (x1, ml) := + match ret with + | MutList.Cons t ml1 => (t, ml1) + | _ => (x, self) + (ml, x1) + Result.ok (MutList.Cons x self, back) + +/- [adt_borrows::{adt_borrows::MutList<'a, T>}#7::pop]: + Source: 'tests/src/adt-borrows.rs', lines 196:4-202:5 -/ +def MutList.pop + {T : Type} (self : MutList T) : + Result ((T × (MutList T)) × ((T × (MutList T)) → MutList T)) + := + match self with + | MutList.Nil => Result.fail .panic + | MutList.Cons hd tl => + let back := fun ret => let (t, ml) := ret + MutList.Cons t ml + Result.ok ((hd, tl), back) + +/- [adt_borrows::wrap_shared_in_option]: + Source: 'tests/src/adt-borrows.rs', lines 205:0-207:1 -/ +def wrap_shared_in_option {T : Type} (x : T) : Result (Option T) := + Result.ok (some x) + +/- [adt_borrows::wrap_mut_in_option]: + Source: 'tests/src/adt-borrows.rs', lines 209:0-211:1 -/ +def wrap_mut_in_option + {T : Type} (x : T) : Result ((Option T) × (Option T → T)) := + let back := fun ret => match ret with + | some t => t + | _ => x + Result.ok (some x, back) + +/- [adt_borrows::List] + Source: 'tests/src/adt-borrows.rs', lines 213:0-216:1 -/ +inductive List (T : Type) := +| Cons : T → List T → List T +| Nil : List T + +/- [adt_borrows::nth_shared]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 219:4-228:1 -/ +divergent def nth_shared_loop + {T : Type} (ls : List T) (i : U32) : Result (Option T) := + match ls with + | List.Cons x tl => + if i = 0#u32 + then Result.ok (some x) + else do + let i1 ← i - 1#u32 + nth_shared_loop tl i1 + | List.Nil => Result.ok none + +/- [adt_borrows::nth_shared]: + Source: 'tests/src/adt-borrows.rs', lines 218:0-228:1 -/ +@[reducible] +def nth_shared {T : Type} (ls : List T) (i : U32) : Result (Option T) := + nth_shared_loop ls i + +/- [adt_borrows::nth_mut]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 231:4-240:1 -/ +divergent def nth_mut_loop + {T : Type} (ls : List T) (i : U32) : + Result ((Option T) × (Option T → List T)) + := + match ls with + | List.Cons x tl => + if i = 0#u32 + then + let back := + fun ret => + let t := match ret with + | some t1 => t1 + | _ => x + List.Cons t tl + Result.ok (some x, back) + else + do + let i1 ← i - 1#u32 + let (o, back) ← nth_mut_loop tl i1 + let back1 := fun ret => let tl1 := back ret + List.Cons x tl1 + Result.ok (o, back1) + | List.Nil => let back := fun ret => List.Nil + Result.ok (none, back) + +/- [adt_borrows::nth_mut]: + Source: 'tests/src/adt-borrows.rs', lines 230:0-240:1 -/ +@[reducible] +def nth_mut + {T : Type} (ls : List T) (i : U32) : + Result ((Option T) × (Option T → List T)) + := + nth_mut_loop ls i end adt_borrows diff --git a/tests/src/adt-borrows.rs b/tests/src/adt-borrows.rs index d68bdaa7..f1c4da8f 100644 --- a/tests/src/adt-borrows.rs +++ b/tests/src/adt-borrows.rs @@ -158,3 +158,83 @@ fn boxed_slice_shared_borrow(x : Box<[&u32]>) -> Box<[&u32]> { fn boxed_slice_mut_borrow(x : Box<[&mut u32]>) -> Box<[&mut u32]> { x } + +// +// Enumerations with borrows +// +enum SharedList<'a, T> { + Nil, + Cons(&'a T, Box>), +} + +impl<'a, T> SharedList<'a, T> { + // We consume the list in order not to use nested borrows + pub fn push(self, x: &'a T) -> Self { + SharedList::Cons(x, Box::new(self)) + } + + pub fn pop(self) -> (&'a T, Self) { + use SharedList::*; + match self { + Nil => panic!(), + Cons(hd, tl) => (hd, *tl), + } + } +} + +enum MutList<'a, T> { + Nil, + Cons(&'a mut T, Box>), +} + +impl<'a, T> MutList<'a, T> { + // We consume the list in order not to use nested borrows + pub fn push(self, x: &'a mut T) -> Self { + MutList::Cons(x, Box::new(self)) + } + + pub fn pop(self) -> (&'a mut T, Self) { + use MutList::*; + match self { + Nil => panic!(), + Cons(hd, tl) => (hd, *tl), + } + } +} + +pub fn wrap_shared_in_option<'a, T>(x: &'a T) -> Option<&'a T> { + Option::Some(x) +} + +pub fn wrap_mut_in_option<'a, T>(x: &'a mut T) -> Option<&'a mut T> { + Option::Some(x) +} + +pub enum List { + Cons(T, Box>), + Nil, +} + +pub fn nth_shared(mut ls: &List, mut i: u32) -> Option<&T> { + while let List::Cons(x, tl) = ls { + if i == 0 { + return Some(x); + } else { + ls = tl; + i -= 1; + } + } + None +} + +pub fn nth_mut(mut ls: &mut List, mut i: u32) -> Option<&mut T> { + while let List::Cons(x, tl) = ls { + if i == 0 { + return Some(x); + } else { + ls = tl; + i -= 1; + } + } + None +} diff --git a/tests/src/mutually-recursive-traits.lean.out b/tests/src/mutually-recursive-traits.lean.out index a45c2bb0..934e762f 100644 --- a/tests/src/mutually-recursive-traits.lean.out +++ b/tests/src/mutually-recursive-traits.lean.out @@ -1,16 +1,16 @@ [Info ] Imported: tests/llbc/mutually_recursive_traits.llbc -[Error] In file Translate.ml, line 850: +[Error] In file Translate.ml, line 852: Mutually recursive trait declarations are not supported Uncaught exception: (Failure - "In file Translate.ml, line 850:\ + "In file Translate.ml, line 852:\ \nMutually recursive trait declarations are not supported") Raised at Aeneas__Errors.craise_opt_span in file "Errors.ml", line 52, characters 4-23 Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15 -Called from Aeneas__Translate.extract_definitions in file "Translate.ml", line 879, characters 2-52 -Called from Aeneas__Translate.extract_file in file "Translate.ml", line 1006, characters 2-36 -Called from Aeneas__Translate.translate_crate in file "Translate.ml", line 1576, characters 5-42 +Called from Aeneas__Translate.extract_definitions in file "Translate.ml", line 881, characters 2-52 +Called from Aeneas__Translate.extract_file in file "Translate.ml", line 1008, characters 2-36 +Called from Aeneas__Translate.translate_crate in file "Translate.ml", line 1578, characters 5-42 Called from Dune__exe__Main in file "Main.ml", line 509, characters 14-66 From 88d12ccdaba8c17835b47e8db2bfc6f6814fb259 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 16:26:58 +0000 Subject: [PATCH 19/29] Regenerate the other files --- tests/coq/arrays/Arrays.v | 18 ++++++------------ tests/coq/betree/Betree_Funs.v | 25 ++++++++----------------- tests/coq/demo/Demo.v | 3 +-- tests/coq/misc/Loops.v | 2 +- tests/coq/misc/NoNestedBorrows.v | 14 +++++--------- tests/coq/misc/PoloniusList.v | 5 ++--- tests/fstar/arrays/Arrays.Funs.fst | 16 ++++++---------- tests/fstar/betree/Betree.Funs.fst | 12 ++++++------ tests/fstar/demo/Demo.fst | 2 +- tests/fstar/misc/Loops.Funs.fst | 2 +- tests/fstar/misc/NoNestedBorrows.fst | 14 +++++--------- tests/fstar/misc/PoloniusList.fst | 4 ++-- tests/lean/Arrays.lean | 18 ++++++------------ tests/lean/Betree/Funs.lean | 21 ++++++--------------- tests/lean/Demo/Demo.lean | 3 +-- tests/lean/Loops.lean | 3 +-- tests/lean/NoNestedBorrows.lean | 17 +++++------------ tests/lean/PoloniusList.lean | 6 ++---- tests/lean/Tutorial/Tutorial.lean | 3 +-- 19 files changed, 66 insertions(+), 122 deletions(-) diff --git a/tests/coq/arrays/Arrays.v b/tests/coq/arrays/Arrays.v index 8cca932b..4ac36860 100644 --- a/tests/coq/arrays/Arrays.v +++ b/tests/coq/arrays/Arrays.v @@ -107,12 +107,9 @@ Definition slice_subslice_mut_ (x : slice u32) (y : usize) (z : usize) : result ((slice u32) * (slice u32 -> slice u32)) := - p <- - core_slice_index_Slice_index_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 - Ok (s, index_mut_back) + core_slice_index_Slice_index_mut + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . (** [arrays::array_to_slice_shared_]: @@ -146,12 +143,9 @@ Definition array_subslice_mut_ (x : array u32 32%usize) (y : usize) (z : usize) : result ((slice u32) * (slice u32 -> array u32 32%usize)) := - p <- - core_array_Array_index_mut (core_ops_index_IndexMutSliceTIInst - (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 - Ok (s, index_mut_back) + core_array_Array_index_mut (core_ops_index_IndexMutSliceTIInst + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . (** [arrays::index_slice_0]: diff --git a/tests/coq/betree/Betree_Funs.v b/tests/coq/betree/Betree_Funs.v index a11ffa49..c7c67fa4 100644 --- a/tests/coq/betree/Betree_Funs.v +++ b/tests/coq/betree/Betree_Funs.v @@ -289,10 +289,7 @@ Fixpoint betree_Node_lookup_first_message_for_key_loop | Betree_List_Cons x next_msgs => let (i, _) := x in if i s>= key - then - let back := fun (ret : betree_List_t (u64 * betree_Message_t)) => ret - in - Ok (msgs, back) + then Ok (msgs, fun (ret : betree_List_t (u64 * betree_Message_t)) => ret) else ( p <- betree_Node_lookup_first_message_for_key_loop n1 key next_msgs; let (l, back) := p in @@ -301,8 +298,8 @@ Fixpoint betree_Node_lookup_first_message_for_key_loop let next_msgs1 := back ret in Betree_List_Cons x next_msgs1 in Ok (l, back1)) | Betree_List_Nil => - let back := fun (ret : betree_List_t (u64 * betree_Message_t)) => ret in - Ok (Betree_List_Nil, back) + Ok (Betree_List_Nil, + fun (ret : betree_List_t (u64 * betree_Message_t)) => ret) end end . @@ -521,13 +518,10 @@ Fixpoint betree_Node_lookup_first_message_after_key_loop fun (ret : betree_List_t (u64 * betree_Message_t)) => let next_msgs1 := back ret in Betree_List_Cons p next_msgs1 in Ok (l, back1)) - else - let back := fun (ret : betree_List_t (u64 * betree_Message_t)) => ret - in - Ok (msgs, back) + else Ok (msgs, fun (ret : betree_List_t (u64 * betree_Message_t)) => ret) | Betree_List_Nil => - let back := fun (ret : betree_List_t (u64 * betree_Message_t)) => ret in - Ok (Betree_List_Nil, back) + Ok (Betree_List_Nil, + fun (ret : betree_List_t (u64 * betree_Message_t)) => ret) end end . @@ -636,9 +630,7 @@ Fixpoint betree_Node_lookup_mut_in_bindings_loop | Betree_List_Cons hd tl => let (i, _) := hd in if i s>= key - then - let back := fun (ret : betree_List_t (u64 * u64)) => ret in - Ok (bindings, back) + then Ok (bindings, fun (ret : betree_List_t (u64 * u64)) => ret) else ( p <- betree_Node_lookup_mut_in_bindings_loop n1 key tl; let (l, back) := p in @@ -647,8 +639,7 @@ Fixpoint betree_Node_lookup_mut_in_bindings_loop let tl1 := back ret in Betree_List_Cons hd tl1 in Ok (l, back1)) | Betree_List_Nil => - let back := fun (ret : betree_List_t (u64 * u64)) => ret in - Ok (Betree_List_Nil, back) + Ok (Betree_List_Nil, fun (ret : betree_List_t (u64 * u64)) => ret) end end . diff --git a/tests/coq/demo/Demo.v b/tests/coq/demo/Demo.v index 1fcb485f..9a376b30 100644 --- a/tests/coq/demo/Demo.v +++ b/tests/coq/demo/Demo.v @@ -143,8 +143,7 @@ Fixpoint list_tail fun (ret : CList_t T) => let tl1 := list_tail_back ret in CList_CCons t tl1 in Ok (c, back) - | CList_CNil => - let back := fun (ret : CList_t T) => ret in Ok (CList_CNil, back) + | CList_CNil => Ok (CList_CNil, fun (ret : CList_t T) => ret) end end . diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v index e054dea1..70a76c6b 100644 --- a/tests/coq/misc/Loops.v +++ b/tests/coq/misc/Loops.v @@ -277,7 +277,7 @@ Definition get_elem_shared Source: 'tests/src/loops.rs', lines 149:0-151:1 *) Definition id_mut {T : Type} (ls : List_t T) : result ((List_t T) * (List_t T -> List_t T)) := - let back := fun (ret : List_t T) => ret in Ok (ls, back) + Ok (ls, fun (ret : List_t T) => ret) . (** [loops::id_shared]: diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v index 39027a33..c36d2791 100644 --- a/tests/coq/misc/NoNestedBorrows.v +++ b/tests/coq/misc/NoNestedBorrows.v @@ -353,7 +353,7 @@ Definition id_mut_pair1 {T1 : Type} {T2 : Type} (x : T1) (y : T2) : result ((T1 * T2) * ((T1 * T2) -> (T1 * T2))) := - let back := fun (ret : (T1 * T2)) => ret in Ok ((x, y), back) + Ok ((x, y), fun (ret : (T1 * T2)) => ret) . (** [no_nested_borrows::id_mut_pair2]: @@ -362,7 +362,7 @@ Definition id_mut_pair2 {T1 : Type} {T2 : Type} (p : (T1 * T2)) : result ((T1 * T2) * ((T1 * T2) -> (T1 * T2))) := - let back := fun (ret : (T1 * T2)) => ret in Ok (p, back) + Ok (p, fun (ret : (T1 * T2)) => ret) . (** [no_nested_borrows::id_mut_pair3]: @@ -371,9 +371,7 @@ Definition id_mut_pair3 {T1 : Type} {T2 : Type} (x : T1) (y : T2) : result ((T1 * T2) * (T1 -> T1) * (T2 -> T2)) := - let back'a := fun (ret : T1) => ret in - let back'b := fun (ret : T2) => ret in - Ok ((x, y), back'a, back'b) + Ok ((x, y), fun (ret : T1) => ret, fun (ret : T2) => ret) . (** [no_nested_borrows::id_mut_pair4]: @@ -382,9 +380,7 @@ Definition id_mut_pair4 {T1 : Type} {T2 : Type} (p : (T1 * T2)) : result ((T1 * T2) * (T1 -> T1) * (T2 -> T2)) := - let back'a := fun (ret : T1) => ret in - let back'b := fun (ret : T2) => ret in - Ok (p, back'a, back'b) + Ok (p, fun (ret : T1) => ret, fun (ret : T2) => ret) . (** [no_nested_borrows::StructWithTuple] @@ -577,7 +573,7 @@ Definition borrow_mut_tuple {T : Type} {U : Type} (x : (T * U)) : result ((T * U) * ((T * U) -> (T * U))) := - let back := fun (ret : (T * U)) => ret in Ok (x, back) + Ok (x, fun (ret : (T * U)) => ret) . (** [no_nested_borrows::ExpandSimpliy::Wrapper] diff --git a/tests/coq/misc/PoloniusList.v b/tests/coq/misc/PoloniusList.v index be91bc7a..fddc7baa 100644 --- a/tests/coq/misc/PoloniusList.v +++ b/tests/coq/misc/PoloniusList.v @@ -27,7 +27,7 @@ Fixpoint get_list_at_x match ls with | List_Cons hd tl => if hd s= x - then let back := fun (ret : List_t u32) => ret in Ok (ls, back) + then Ok (ls, fun (ret : List_t u32) => ret) else ( p <- get_list_at_x tl x; let (l, get_list_at_x_back) := p in @@ -35,8 +35,7 @@ Fixpoint get_list_at_x fun (ret : List_t u32) => let tl1 := get_list_at_x_back ret in List_Cons hd tl1 in Ok (l, back)) - | List_Nil => - let back := fun (ret : List_t u32) => ret in Ok (List_Nil, back) + | List_Nil => Ok (List_Nil, fun (ret : List_t u32) => ret) end . diff --git a/tests/fstar/arrays/Arrays.Funs.fst b/tests/fstar/arrays/Arrays.Funs.fst index 7052d1cf..91351982 100644 --- a/tests/fstar/arrays/Arrays.Funs.fst +++ b/tests/fstar/arrays/Arrays.Funs.fst @@ -85,11 +85,9 @@ let slice_subslice_mut_ (x : slice u32) (y : usize) (z : usize) : result ((slice u32) & (slice u32 -> slice u32)) = - let* (s, index_mut_back) = - core_slice_index_Slice_index_mut - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x - { start = y; end_ = z } in - Ok (s, index_mut_back) + core_slice_index_Slice_index_mut + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x + { start = y; end_ = z } (** [arrays::array_to_slice_shared_]: Source: 'tests/src/arrays.rs', lines 75:0-77:1 *) @@ -116,11 +114,9 @@ let array_subslice_mut_ (x : array u32 32) (y : usize) (z : usize) : result ((slice u32) & (slice u32 -> array u32 32)) = - let* (s, index_mut_back) = - core_array_Array_index_mut (core_ops_index_IndexMutSliceTIInst - (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x - { start = y; end_ = z } in - Ok (s, index_mut_back) + core_array_Array_index_mut (core_ops_index_IndexMutSliceTIInst + (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x + { start = y; end_ = z } (** [arrays::index_slice_0]: Source: 'tests/src/arrays.rs', lines 91:0-93:1 *) diff --git a/tests/fstar/betree/Betree.Funs.fst b/tests/fstar/betree/Betree.Funs.fst index 95c135ce..add686dd 100644 --- a/tests/fstar/betree/Betree.Funs.fst +++ b/tests/fstar/betree/Betree.Funs.fst @@ -237,7 +237,7 @@ let rec betree_Node_lookup_first_message_for_key_loop | Betree_List_Cons x next_msgs -> let (i, _) = x in if i >= key - then let back = fun ret -> ret in Ok (msgs, back) + then Ok (msgs, fun ret -> ret) else let* (l, back) = betree_Node_lookup_first_message_for_key_loop key next_msgs in @@ -245,7 +245,7 @@ let rec betree_Node_lookup_first_message_for_key_loop fun ret -> let next_msgs1 = back ret in Betree_List_Cons x next_msgs1 in Ok (l, back1) - | Betree_List_Nil -> let back = fun ret -> ret in Ok (Betree_List_Nil, back) + | Betree_List_Nil -> Ok (Betree_List_Nil, fun ret -> ret) end (** [betree::betree::{betree::betree::Node}#5::lookup_first_message_for_key]: @@ -418,8 +418,8 @@ let rec betree_Node_lookup_first_message_after_key_loop fun ret -> let next_msgs1 = back ret in Betree_List_Cons p next_msgs1 in Ok (l, back1) - else let back = fun ret -> ret in Ok (msgs, back) - | Betree_List_Nil -> let back = fun ret -> ret in Ok (Betree_List_Nil, back) + else Ok (msgs, fun ret -> ret) + | Betree_List_Nil -> Ok (Betree_List_Nil, fun ret -> ret) end (** [betree::betree::{betree::betree::Node}#5::lookup_first_message_after_key]: @@ -518,12 +518,12 @@ let rec betree_Node_lookup_mut_in_bindings_loop | Betree_List_Cons hd tl -> let (i, _) = hd in if i >= key - then let back = fun ret -> ret in Ok (bindings, back) + then Ok (bindings, fun ret -> ret) else let* (l, back) = betree_Node_lookup_mut_in_bindings_loop key tl in let back1 = fun ret -> let tl1 = back ret in Betree_List_Cons hd tl1 in Ok (l, back1) - | Betree_List_Nil -> let back = fun ret -> ret in Ok (Betree_List_Nil, back) + | Betree_List_Nil -> Ok (Betree_List_Nil, fun ret -> ret) end (** [betree::betree::{betree::betree::Node}#5::lookup_mut_in_bindings]: diff --git a/tests/fstar/demo/Demo.fst b/tests/fstar/demo/Demo.fst index 7bc28302..eadc5a41 100644 --- a/tests/fstar/demo/Demo.fst +++ b/tests/fstar/demo/Demo.fst @@ -121,7 +121,7 @@ let rec list_tail let back = fun ret -> let tl1 = list_tail_back ret in CList_CCons x tl1 in Ok (c, back) - | CList_CNil -> let back = fun ret -> ret in Ok (CList_CNil, back) + | CList_CNil -> Ok (CList_CNil, fun ret -> ret) end (** Trait declaration: [demo::Counter] diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst index 3c5ae0ed..7ea130bc 100644 --- a/tests/fstar/misc/Loops.Funs.fst +++ b/tests/fstar/misc/Loops.Funs.fst @@ -214,7 +214,7 @@ let get_elem_shared Source: 'tests/src/loops.rs', lines 149:0-151:1 *) let id_mut (#t : Type0) (ls : list_t t) : result ((list_t t) & (list_t t -> list_t t)) = - let back = fun ret -> ret in Ok (ls, back) + Ok (ls, fun ret -> ret) (** [loops::id_shared]: Source: 'tests/src/loops.rs', lines 153:0-155:1 *) diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index 73e1d418..0b5461e0 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -318,7 +318,7 @@ let id_mut_pair1 (#t1 : Type0) (#t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & ((t1 & t2) -> (t1 & t2))) = - let back = fun ret -> ret in Ok ((x, y), back) + Ok ((x, y), fun ret -> ret) (** [no_nested_borrows::id_mut_pair2]: Source: 'tests/src/no_nested_borrows.rs', lines 351:0-353:1 *) @@ -326,7 +326,7 @@ let id_mut_pair2 (#t1 : Type0) (#t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & ((t1 & t2) -> (t1 & t2))) = - let back = fun ret -> ret in Ok (p, back) + Ok (p, fun ret -> ret) (** [no_nested_borrows::id_mut_pair3]: Source: 'tests/src/no_nested_borrows.rs', lines 355:0-357:1 *) @@ -334,9 +334,7 @@ let id_mut_pair3 (#t1 : Type0) (#t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & (t1 -> t1) & (t2 -> t2)) = - let back'a = fun ret -> ret in - let back'b = fun ret -> ret in - Ok ((x, y), back'a, back'b) + Ok ((x, y), fun ret -> ret, fun ret -> ret) (** [no_nested_borrows::id_mut_pair4]: Source: 'tests/src/no_nested_borrows.rs', lines 359:0-361:1 *) @@ -344,9 +342,7 @@ let id_mut_pair4 (#t1 : Type0) (#t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & (t1 -> t1) & (t2 -> t2)) = - let back'a = fun ret -> ret in - let back'b = fun ret -> ret in - Ok (p, back'a, back'b) + Ok (p, fun ret -> ret, fun ret -> ret) (** [no_nested_borrows::StructWithTuple] Source: 'tests/src/no_nested_borrows.rs', lines 366:0-368:1 *) @@ -510,7 +506,7 @@ let borrow_mut_tuple (#t : Type0) (#u : Type0) (x : (t & u)) : result ((t & u) & ((t & u) -> (t & u))) = - let back = fun ret -> ret in Ok (x, back) + Ok (x, fun ret -> ret) (** [no_nested_borrows::ExpandSimpliy::Wrapper] Source: 'tests/src/no_nested_borrows.rs', lines 538:4-538:32 *) diff --git a/tests/fstar/misc/PoloniusList.fst b/tests/fstar/misc/PoloniusList.fst index 233051a9..e5cb3e29 100644 --- a/tests/fstar/misc/PoloniusList.fst +++ b/tests/fstar/misc/PoloniusList.fst @@ -20,12 +20,12 @@ let rec get_list_at_x begin match ls with | List_Cons hd tl -> if hd = x - then let back = fun ret -> ret in Ok (ls, back) + then Ok (ls, fun ret -> ret) else let* (l, get_list_at_x_back) = get_list_at_x tl x in let back = fun ret -> let tl1 = get_list_at_x_back ret in List_Cons hd tl1 in Ok (l, back) - | List_Nil -> let back = fun ret -> ret in Ok (List_Nil, back) + | List_Nil -> Ok (List_Nil, fun ret -> ret) end diff --git a/tests/lean/Arrays.lean b/tests/lean/Arrays.lean index 4b03a45a..f326efa6 100644 --- a/tests/lean/Arrays.lean +++ b/tests/lean/Arrays.lean @@ -100,12 +100,9 @@ def slice_subslice_mut_ (x : Slice U32) (y : Usize) (z : Usize) : Result ((Slice U32) × (Slice U32 → Slice U32)) := - do - let (s, index_mut_back) ← - core.slice.index.Slice.index_mut - (core.slice.index.SliceIndexRangeUsizeSliceTInst U32) x - { start := y, end_ := z } - Result.ok (s, index_mut_back) + core.slice.index.Slice.index_mut + (core.slice.index.SliceIndexRangeUsizeSliceTInst U32) x + { start := y, end_ := z } /- [arrays::array_to_slice_shared_]: Source: 'tests/src/arrays.rs', lines 75:0-77:1 -/ @@ -134,12 +131,9 @@ def array_subslice_mut_ (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result ((Slice U32) × (Slice U32 → Array U32 32#usize)) := - do - let (s, index_mut_back) ← - core.array.Array.index_mut (core.ops.index.IndexMutSliceTIInst - (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x - { start := y, end_ := z } - Result.ok (s, index_mut_back) + core.array.Array.index_mut (core.ops.index.IndexMutSliceTIInst + (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x + { start := y, end_ := z } /- [arrays::index_slice_0]: Source: 'tests/src/arrays.rs', lines 91:0-93:1 -/ diff --git a/tests/lean/Betree/Funs.lean b/tests/lean/Betree/Funs.lean index 601ad1de..97bfbab9 100644 --- a/tests/lean/Betree/Funs.lean +++ b/tests/lean/Betree/Funs.lean @@ -236,8 +236,7 @@ divergent def betree.Node.lookup_first_message_for_key_loop | betree.List.Cons x next_msgs => let (i, _) := x if i >= key - then let back := fun ret => ret - Result.ok (msgs, back) + then Result.ok (msgs, fun ret => ret) else do let (l, back) ← @@ -246,9 +245,7 @@ divergent def betree.Node.lookup_first_message_for_key_loop fun ret => let next_msgs1 := back ret betree.List.Cons x next_msgs1 Result.ok (l, back1) - | betree.List.Nil => - let back := fun ret => ret - Result.ok (betree.List.Nil, back) + | betree.List.Nil => Result.ok (betree.List.Nil, fun ret => ret) /- [betree::betree::{betree::betree::Node}#5::lookup_first_message_for_key]: Source: 'src/betree.rs', lines 792:4-810:5 -/ @@ -425,11 +422,8 @@ divergent def betree.Node.lookup_first_message_after_key_loop fun ret => let next_msgs1 := back ret betree.List.Cons p next_msgs1 Result.ok (l, back1) - else let back := fun ret => ret - Result.ok (msgs, back) - | betree.List.Nil => - let back := fun ret => ret - Result.ok (betree.List.Nil, back) + else Result.ok (msgs, fun ret => ret) + | betree.List.Nil => Result.ok (betree.List.Nil, fun ret => ret) /- [betree::betree::{betree::betree::Node}#5::lookup_first_message_after_key]: Source: 'src/betree.rs', lines 694:4-706:5 -/ @@ -532,17 +526,14 @@ divergent def betree.Node.lookup_mut_in_bindings_loop | betree.List.Cons hd tl => let (i, _) := hd if i >= key - then let back := fun ret => ret - Result.ok (bindings, back) + then Result.ok (bindings, fun ret => ret) else do let (l, back) ← betree.Node.lookup_mut_in_bindings_loop key tl let back1 := fun ret => let tl1 := back ret betree.List.Cons hd tl1 Result.ok (l, back1) - | betree.List.Nil => - let back := fun ret => ret - Result.ok (betree.List.Nil, back) + | betree.List.Nil => Result.ok (betree.List.Nil, fun ret => ret) /- [betree::betree::{betree::betree::Node}#5::lookup_mut_in_bindings]: Source: 'src/betree.rs', lines 664:4-677:5 -/ diff --git a/tests/lean/Demo/Demo.lean b/tests/lean/Demo/Demo.lean index bc8d84ee..d4cf6a82 100644 --- a/tests/lean/Demo/Demo.lean +++ b/tests/lean/Demo/Demo.lean @@ -121,8 +121,7 @@ divergent def list_tail let back := fun ret => let tl1 := list_tail_back ret CList.CCons t tl1 Result.ok (c, back) - | CList.CNil => let back := fun ret => ret - Result.ok (CList.CNil, back) + | CList.CNil => Result.ok (CList.CNil, fun ret => ret) /- Trait declaration: [demo::Counter] Source: 'tests/src/demo.rs', lines 99:0-101:1 -/ diff --git a/tests/lean/Loops.lean b/tests/lean/Loops.lean index cf7396c1..dd038070 100644 --- a/tests/lean/Loops.lean +++ b/tests/lean/Loops.lean @@ -217,8 +217,7 @@ def get_elem_shared Source: 'tests/src/loops.rs', lines 149:0-151:1 -/ def id_mut {T : Type} (ls : List T) : Result ((List T) × (List T → List T)) := - let back := fun ret => ret - Result.ok (ls, back) + Result.ok (ls, fun ret => ret) /- [loops::id_shared]: Source: 'tests/src/loops.rs', lines 153:0-155:1 -/ diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index 22364efb..c7c202c4 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -346,8 +346,7 @@ def id_mut_pair1 {T1 : Type} {T2 : Type} (x : T1) (y : T2) : Result ((T1 × T2) × ((T1 × T2) → (T1 × T2))) := - let back := fun ret => ret - Result.ok ((x, y), back) + Result.ok ((x, y), fun ret => ret) /- [no_nested_borrows::id_mut_pair2]: Source: 'tests/src/no_nested_borrows.rs', lines 351:0-353:1 -/ @@ -355,8 +354,7 @@ def id_mut_pair2 {T1 : Type} {T2 : Type} (p : (T1 × T2)) : Result ((T1 × T2) × ((T1 × T2) → (T1 × T2))) := - let back := fun ret => ret - Result.ok (p, back) + Result.ok (p, fun ret => ret) /- [no_nested_borrows::id_mut_pair3]: Source: 'tests/src/no_nested_borrows.rs', lines 355:0-357:1 -/ @@ -364,9 +362,7 @@ def id_mut_pair3 {T1 : Type} {T2 : Type} (x : T1) (y : T2) : Result ((T1 × T2) × (T1 → T1) × (T2 → T2)) := - let back'a := fun ret => ret - let back'b := fun ret => ret - Result.ok ((x, y), back'a, back'b) + Result.ok ((x, y), fun ret => ret, fun ret => ret) /- [no_nested_borrows::id_mut_pair4]: Source: 'tests/src/no_nested_borrows.rs', lines 359:0-361:1 -/ @@ -374,9 +370,7 @@ def id_mut_pair4 {T1 : Type} {T2 : Type} (p : (T1 × T2)) : Result ((T1 × T2) × (T1 → T1) × (T2 → T2)) := - let back'a := fun ret => ret - let back'b := fun ret => ret - Result.ok (p, back'a, back'b) + Result.ok (p, fun ret => ret, fun ret => ret) /- [no_nested_borrows::StructWithTuple] Source: 'tests/src/no_nested_borrows.rs', lines 366:0-368:1 -/ @@ -552,8 +546,7 @@ def borrow_mut_tuple {T : Type} {U : Type} (x : (T × U)) : Result ((T × U) × ((T × U) → (T × U))) := - let back := fun ret => ret - Result.ok (x, back) + Result.ok (x, fun ret => ret) /- [no_nested_borrows::ExpandSimpliy::Wrapper] Source: 'tests/src/no_nested_borrows.rs', lines 538:4-538:32 -/ diff --git a/tests/lean/PoloniusList.lean b/tests/lean/PoloniusList.lean index ad8946ce..4c9c06b2 100644 --- a/tests/lean/PoloniusList.lean +++ b/tests/lean/PoloniusList.lean @@ -21,15 +21,13 @@ divergent def get_list_at_x match ls with | List.Cons hd tl => if hd = x - then let back := fun ret => ret - Result.ok (ls, back) + then Result.ok (ls, fun ret => ret) else do let (l, get_list_at_x_back) ← get_list_at_x tl x let back := fun ret => let tl1 := get_list_at_x_back ret List.Cons hd tl1 Result.ok (l, back) - | List.Nil => let back := fun ret => ret - Result.ok (List.Nil, back) + | List.Nil => Result.ok (List.Nil, fun ret => ret) end polonius_list diff --git a/tests/lean/Tutorial/Tutorial.lean b/tests/lean/Tutorial/Tutorial.lean index 0c750894..663d8e92 100644 --- a/tests/lean/Tutorial/Tutorial.lean +++ b/tests/lean/Tutorial/Tutorial.lean @@ -191,8 +191,7 @@ divergent def list_tail_loop let back1 := fun ret => let tl1 := back ret CList.CCons t tl1 Result.ok (c, back1) - | CList.CNil => let back := fun ret => ret - Result.ok (CList.CNil, back) + | CList.CNil => Result.ok (CList.CNil, fun ret => ret) /- [tutorial::list_tail]: Source: 'src/lib.rs', lines 134:0-139:1 -/ From 7f5638643e4ba26742db8657439f8bf04efeb1e9 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 23:05:13 +0000 Subject: [PATCH 20/29] Update the hashmap to use options of (mut) borrows --- tests/coq/hashmap/Hashmap_Funs.v | 155 +++++++++-------- .../hashmap/Hashmap_FunsExternal_Template.v | 8 + tests/coq/hashmap/Hashmap_Types.v | 12 +- .../hashmap/Hashmap.Clauses.Template.fst | 14 +- tests/fstar/hashmap/Hashmap.Funs.fst | 158 ++++++++---------- tests/fstar/hashmap/Hashmap.FunsExternal.fsti | 7 + tests/fstar/hashmap/Hashmap.Types.fst | 8 +- tests/lean/Hashmap/Funs.lean | 153 ++++++++--------- tests/lean/Hashmap/Types.lean | 10 +- tests/src/hashmap.rs | 60 +++---- 10 files changed, 301 insertions(+), 284 deletions(-) diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index 4ff7553f..aa262c08 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -17,8 +17,27 @@ Module Hashmap_Funs. Definition hash_key (k : usize) : result usize := Ok k. +(** [hashmap::{core::clone::Clone for hashmap::Fraction}#1::clone]: + Source: 'tests/src/hashmap.rs', lines 45:9-45:14 *) +Definition clonehashmapFraction_clone + (self : Fraction_t) : result Fraction_t := + Ok self +. + +(** Trait implementation: [hashmap::{core::clone::Clone for hashmap::Fraction}#1] + Source: 'tests/src/hashmap.rs', lines 45:9-45:14 *) +Definition core_clone_ClonehashmapFraction : core_clone_Clone Fraction_t := {| + core_clone_Clone_clone := clonehashmapFraction_clone; +|}. + +(** Trait implementation: [hashmap::{core::marker::Copy for hashmap::Fraction}#2] + Source: 'tests/src/hashmap.rs', lines 45:16-45:20 *) +Definition core_marker_CopyhashmapFraction : core_marker_Copy Fraction_t := {| + cloneInst := core_clone_ClonehashmapFraction; +|}. + (** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: - Source: 'tests/src/hashmap.rs', lines 64:8-67:9 *) + Source: 'tests/src/hashmap.rs', lines 70:8-73:9 *) Fixpoint hashMap_allocate_slots_loop {T : Type} (n : nat) (slots : alloc_vec_Vec (AList_t T)) (n1 : usize) : result (alloc_vec_Vec (AList_t T)) @@ -36,7 +55,7 @@ Fixpoint hashMap_allocate_slots_loop . (** [hashmap::{hashmap::HashMap}::allocate_slots]: - Source: 'tests/src/hashmap.rs', lines 63:4-69:5 *) + Source: 'tests/src/hashmap.rs', lines 69:4-75:5 *) Definition hashMap_allocate_slots {T : Type} (n : nat) (slots : alloc_vec_Vec (AList_t T)) (n1 : usize) : result (alloc_vec_Vec (AList_t T)) @@ -45,19 +64,18 @@ Definition hashMap_allocate_slots . (** [hashmap::{hashmap::HashMap}::new_with_capacity]: - Source: 'tests/src/hashmap.rs', lines 72:4-87:5 *) + Source: 'tests/src/hashmap.rs', lines 78:4-92:5 *) Definition hashMap_new_with_capacity - (T : Type) (n : nat) (capacity : usize) (max_load_dividend : usize) - (max_load_divisor : usize) : + (T : Type) (n : nat) (capacity : usize) (max_load_factor : Fraction_t) : result (HashMap_t T) := slots <- hashMap_allocate_slots n (alloc_vec_Vec_new (AList_t T)) capacity; - i <- usize_mul capacity max_load_dividend; - i1 <- usize_div i max_load_divisor; + i <- usize_mul capacity max_load_factor.(fraction_dividend); + i1 <- usize_div i max_load_factor.(fraction_divisor); Ok {| hashMap_num_entries := 0%usize; - hashMap_max_load_factor := (max_load_dividend, max_load_divisor); + hashMap_max_load_factor := max_load_factor; hashMap_max_load := i1; hashMap_saturated := false; hashMap_slots := slots @@ -65,13 +83,14 @@ Definition hashMap_new_with_capacity . (** [hashmap::{hashmap::HashMap}::new]: - Source: 'tests/src/hashmap.rs', lines 89:4-92:5 *) + Source: 'tests/src/hashmap.rs', lines 94:4-97:5 *) Definition hashMap_new (T : Type) (n : nat) : result (HashMap_t T) := - hashMap_new_with_capacity T n 32%usize 4%usize 5%usize + hashMap_new_with_capacity T n 32%usize + {| fraction_dividend := 4%usize; fraction_divisor := 5%usize |} . (** [hashmap::{hashmap::HashMap}::clear]: loop 0: - Source: 'tests/src/hashmap.rs', lines 98:8-101:9 *) + Source: 'tests/src/hashmap.rs', lines 103:8-106:9 *) Fixpoint hashMap_clear_loop {T : Type} (n : nat) (slots : alloc_vec_Vec (AList_t T)) (i : usize) : result (alloc_vec_Vec (AList_t T)) @@ -94,7 +113,7 @@ Fixpoint hashMap_clear_loop . (** [hashmap::{hashmap::HashMap}::clear]: - Source: 'tests/src/hashmap.rs', lines 94:4-102:5 *) + Source: 'tests/src/hashmap.rs', lines 99:4-107:5 *) Definition hashMap_clear {T : Type} (n : nat) (self : HashMap_t T) : result (HashMap_t T) := hm <- hashMap_clear_loop n self.(hashMap_slots) 0%usize; @@ -109,13 +128,13 @@ Definition hashMap_clear . (** [hashmap::{hashmap::HashMap}::len]: - Source: 'tests/src/hashmap.rs', lines 104:4-106:5 *) + Source: 'tests/src/hashmap.rs', lines 109:4-111:5 *) Definition hashMap_len {T : Type} (self : HashMap_t T) : result usize := Ok self.(hashMap_num_entries) . (** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-127:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-132:9 *) Fixpoint hashMap_insert_in_list_loop {T : Type} (n : nat) (key : usize) (value : T) (ls : AList_t T) : result (bool * (AList_t T)) @@ -137,7 +156,7 @@ Fixpoint hashMap_insert_in_list_loop . (** [hashmap::{hashmap::HashMap}::insert_in_list]: - Source: 'tests/src/hashmap.rs', lines 111:4-128:5 *) + Source: 'tests/src/hashmap.rs', lines 116:4-133:5 *) Definition hashMap_insert_in_list {T : Type} (n : nat) (key : usize) (value : T) (ls : AList_t T) : result (bool * (AList_t T)) @@ -146,7 +165,7 @@ Definition hashMap_insert_in_list . (** [hashmap::{hashmap::HashMap}::insert_no_resize]: - Source: 'tests/src/hashmap.rs', lines 131:4-139:5 *) + Source: 'tests/src/hashmap.rs', lines 136:4-144:5 *) Definition hashMap_insert_no_resize {T : Type} (n : nat) (self : HashMap_t T) (key : usize) (value : T) : result (HashMap_t T) @@ -185,7 +204,7 @@ Definition hashMap_insert_no_resize . (** [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 197:12-204:17 *) + Source: 'tests/src/hashmap.rs', lines 201:12-208:17 *) Fixpoint hashMap_move_elements_from_list_loop {T : Type} (n : nat) (ntable : HashMap_t T) (ls : AList_t T) : result (HashMap_t T) @@ -203,7 +222,7 @@ Fixpoint hashMap_move_elements_from_list_loop . (** [hashmap::{hashmap::HashMap}::move_elements_from_list]: - Source: 'tests/src/hashmap.rs', lines 194:4-207:5 *) + Source: 'tests/src/hashmap.rs', lines 198:4-211:5 *) Definition hashMap_move_elements_from_list {T : Type} (n : nat) (ntable : HashMap_t T) (ls : AList_t T) : result (HashMap_t T) @@ -212,7 +231,7 @@ Definition hashMap_move_elements_from_list . (** [hashmap::{hashmap::HashMap}::move_elements]: loop 0: - Source: 'tests/src/hashmap.rs', lines 183:8-190:9 *) + Source: 'tests/src/hashmap.rs', lines 187:8-194:9 *) Fixpoint hashMap_move_elements_loop {T : Type} (n : nat) (ntable : HashMap_t T) (slots : alloc_vec_Vec (AList_t T)) (i : usize) : @@ -238,7 +257,7 @@ Fixpoint hashMap_move_elements_loop . (** [hashmap::{hashmap::HashMap}::move_elements]: - Source: 'tests/src/hashmap.rs', lines 181:4-191:5 *) + Source: 'tests/src/hashmap.rs', lines 185:4-195:5 *) Definition hashMap_move_elements {T : Type} (n : nat) (ntable : HashMap_t T) (slots : alloc_vec_Vec (AList_t T)) : @@ -248,17 +267,16 @@ Definition hashMap_move_elements . (** [hashmap::{hashmap::HashMap}::try_resize]: - Source: 'tests/src/hashmap.rs', lines 154:4-177:5 *) + Source: 'tests/src/hashmap.rs', lines 159:4-181:5 *) Definition hashMap_try_resize {T : Type} (n : nat) (self : HashMap_t T) : result (HashMap_t T) := let capacity := alloc_vec_Vec_len self.(hashMap_slots) in n1 <- usize_div core_usize_max 2%usize; - let (i, i1) := self.(hashMap_max_load_factor) in - i2 <- usize_div n1 i; - if capacity s<= i2 + i <- usize_div n1 self.(hashMap_max_load_factor).(fraction_dividend); + if capacity s<= i then ( - i3 <- usize_mul capacity 2%usize; - ntable <- hashMap_new_with_capacity T n i3 i i1; + i1 <- usize_mul capacity 2%usize; + ntable <- hashMap_new_with_capacity T n i1 self.(hashMap_max_load_factor); p <- hashMap_move_elements n ntable self.(hashMap_slots); let (ntable1, _) := p in Ok @@ -281,7 +299,7 @@ Definition hashMap_try_resize . (** [hashmap::{hashmap::HashMap}::insert]: - Source: 'tests/src/hashmap.rs', lines 143:4-150:5 *) + Source: 'tests/src/hashmap.rs', lines 148:4-155:5 *) Definition hashMap_insert {T : Type} (n : nat) (self : HashMap_t T) (key : usize) (value : T) : result (HashMap_t T) @@ -313,7 +331,7 @@ Definition hashMap_insert . (** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-229:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-233:9 *) Fixpoint hashMap_contains_key_in_list_loop {T : Type} (n : nat) (key : usize) (ls : AList_t T) : result bool := match n with @@ -330,14 +348,14 @@ Fixpoint hashMap_contains_key_in_list_loop . (** [hashmap::{hashmap::HashMap}::contains_key_in_list]: - Source: 'tests/src/hashmap.rs', lines 217:4-230:5 *) + Source: 'tests/src/hashmap.rs', lines 221:4-234:5 *) Definition hashMap_contains_key_in_list {T : Type} (n : nat) (key : usize) (ls : AList_t T) : result bool := hashMap_contains_key_in_list_loop n key ls . (** [hashmap::{hashmap::HashMap}::contains_key]: - Source: 'tests/src/hashmap.rs', lines 210:4-214:5 *) + Source: 'tests/src/hashmap.rs', lines 214:4-218:5 *) Definition hashMap_contains_key {T : Type} (n : nat) (self : HashMap_t T) (key : usize) : result bool := hash <- hash_key key; @@ -350,31 +368,35 @@ Definition hashMap_contains_key . (** [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 236:8-248:5 *) + Source: 'tests/src/hashmap.rs', lines 240:8-248:5 *) Fixpoint hashMap_get_in_list_loop - {T : Type} (n : nat) (key : usize) (ls : AList_t T) : result T := + {T : Type} (n : nat) (key : usize) (ls : AList_t T) : result (option T) := match n with | O => Fail_ OutOfFuel | S n1 => match ls with | AList_Cons ckey cvalue tl => - if ckey s= key then Ok cvalue else hashMap_get_in_list_loop n1 key tl - | AList_Nil => Fail_ Failure + if ckey s= key + then Ok (Some cvalue) + else hashMap_get_in_list_loop n1 key tl + | AList_Nil => Ok None end end . (** [hashmap::{hashmap::HashMap}::get_in_list]: - Source: 'tests/src/hashmap.rs', lines 235:4-248:5 *) + Source: 'tests/src/hashmap.rs', lines 239:4-248:5 *) Definition hashMap_get_in_list - {T : Type} (n : nat) (key : usize) (ls : AList_t T) : result T := + {T : Type} (n : nat) (key : usize) (ls : AList_t T) : result (option T) := hashMap_get_in_list_loop n key ls . (** [hashmap::{hashmap::HashMap}::get]: Source: 'tests/src/hashmap.rs', lines 250:4-254:5 *) Definition hashMap_get - {T : Type} (n : nat) (self : HashMap_t T) (key : usize) : result T := + {T : Type} (n : nat) (self : HashMap_t T) (key : usize) : + result (option T) + := hash <- hash_key key; let i := alloc_vec_Vec_len self.(hashMap_slots) in hash_mod <- usize_rem hash i; @@ -388,7 +410,7 @@ Definition hashMap_get Source: 'tests/src/hashmap.rs', lines 257:8-265:5 *) Fixpoint hashMap_get_mut_in_list_loop {T : Type} (n : nat) (ls : AList_t T) (key : usize) : - result (T * (T -> AList_t T)) + result ((option T) * (option T -> AList_t T)) := match n with | O => Fail_ OutOfFuel @@ -397,15 +419,20 @@ Fixpoint hashMap_get_mut_in_list_loop | AList_Cons ckey cvalue tl => if ckey s= key then - let back := fun (ret : T) => AList_Cons ckey ret tl in - Ok (cvalue, back) + let back := + fun (ret : option T) => + let t := match ret with | Some t1 => t1 | _ => cvalue end in + AList_Cons ckey t tl in + Ok (Some cvalue, back) else ( p <- hashMap_get_mut_in_list_loop n1 tl key; - let (t, back) := p in + let (o, back) := p in let back1 := - fun (ret : T) => let tl1 := back ret in AList_Cons ckey cvalue tl1 in - Ok (t, back1)) - | AList_Nil => Fail_ Failure + fun (ret : option T) => + let tl1 := back ret in AList_Cons ckey cvalue tl1 in + Ok (o, back1)) + | AList_Nil => + let back := fun (ret : option T) => AList_Nil in Ok (None, back) end end . @@ -414,7 +441,7 @@ Fixpoint hashMap_get_mut_in_list_loop Source: 'tests/src/hashmap.rs', lines 256:4-265:5 *) Definition hashMap_get_mut_in_list {T : Type} (n : nat) (ls : AList_t T) (key : usize) : - result (T * (T -> AList_t T)) + result ((option T) * (option T -> AList_t T)) := hashMap_get_mut_in_list_loop n ls key . @@ -423,7 +450,7 @@ Definition hashMap_get_mut_in_list Source: 'tests/src/hashmap.rs', lines 268:4-272:5 *) Definition hashMap_get_mut {T : Type} (n : nat) (self : HashMap_t T) (key : usize) : - result (T * (T -> HashMap_t T)) + result ((option T) * (option T -> HashMap_t T)) := hash <- hash_key key; let i := alloc_vec_Vec_len self.(hashMap_slots) in @@ -433,9 +460,9 @@ Definition hashMap_get_mut (AList_t T)) self.(hashMap_slots) hash_mod; let (a, index_mut_back) := p in p1 <- hashMap_get_mut_in_list n a key; - let (t, get_mut_in_list_back) := p1 in + let (o, get_mut_in_list_back) := p1 in let back := - fun (ret : T) => + fun (ret : option T) => let a1 := get_mut_in_list_back ret in let v := index_mut_back a1 in {| @@ -445,7 +472,7 @@ Definition hashMap_get_mut hashMap_saturated := self.(hashMap_saturated); hashMap_slots := v |} in - Ok (t, back) + Ok (o, back) . (** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: @@ -534,34 +561,4 @@ Definition insert_on_disk utils_serialize hm1 st1 . -(** [hashmap::test1]: - Source: 'tests/src/hashmap.rs', lines 351:0-383:1 *) -Definition test1 (n : nat) : result unit := - hm <- hashMap_new u64 n; - hm1 <- hashMap_insert n hm 0%usize 42%u64; - hm2 <- hashMap_insert n hm1 128%usize 18%u64; - hm3 <- hashMap_insert n hm2 1024%usize 138%u64; - hm4 <- hashMap_insert n hm3 1056%usize 256%u64; - i <- hashMap_get n hm4 128%usize; - _ <- massert (i s= 18%u64); - p <- hashMap_get_mut n hm4 1024%usize; - let (_, get_mut_back) := p in - let hm5 := get_mut_back 56%u64 in - i1 <- hashMap_get n hm5 1024%usize; - _ <- massert (i1 s= 56%u64); - p1 <- hashMap_remove n hm5 1024%usize; - let (x, hm6) := p1 in - match x with - | None => Fail_ Failure - | Some x1 => - _ <- massert (x1 s= 56%u64); - i2 <- hashMap_get n hm6 0%usize; - _ <- massert (i2 s= 42%u64); - i3 <- hashMap_get n hm6 128%usize; - _ <- massert (i3 s= 18%u64); - i4 <- hashMap_get n hm6 1056%usize; - massert (i4 s= 256%u64) - end -. - End Hashmap_Funs. diff --git a/tests/coq/hashmap/Hashmap_FunsExternal_Template.v b/tests/coq/hashmap/Hashmap_FunsExternal_Template.v index 79483c91..d389498a 100644 --- a/tests/coq/hashmap/Hashmap_FunsExternal_Template.v +++ b/tests/coq/hashmap/Hashmap_FunsExternal_Template.v @@ -19,4 +19,12 @@ Axiom utils_deserialize : state -> result (state * (HashMap_t u64)). Source: 'tests/src/hashmap.rs', lines 326:4-328:5 *) Axiom utils_serialize : HashMap_t u64 -> state -> result (state * unit). +(** [core::clone::Clone::clone_from]: + Source: '/rustc/library/core/src/clone.rs', lines 174:4-174:43 + Name pattern: core::clone::Clone::clone_from *) +Axiom core_clone_Clone_clone_from : + forall{Self : Type} (self_clause : core_clone_Clone Self), + Self -> Self -> state -> result (state * Self) +. + End Hashmap_FunsExternal_Template. diff --git a/tests/coq/hashmap/Hashmap_Types.v b/tests/coq/hashmap/Hashmap_Types.v index e13fb97b..4cf9ccb4 100644 --- a/tests/coq/hashmap/Hashmap_Types.v +++ b/tests/coq/hashmap/Hashmap_Types.v @@ -20,12 +20,20 @@ Inductive AList_t (T : Type) := Arguments AList_Cons { _ }. Arguments AList_Nil { _ }. +(** [hashmap::Fraction] + Source: 'tests/src/hashmap.rs', lines 46:0-49:1 *) +Record Fraction_t := +mkFraction_t { + fraction_dividend : usize; fraction_divisor : usize; +} +. + (** [hashmap::HashMap] - Source: 'tests/src/hashmap.rs', lines 46:0-58:1 *) + Source: 'tests/src/hashmap.rs', lines 52:0-64:1 *) Record HashMap_t (T : Type) := mkHashMap_t { hashMap_num_entries : usize; - hashMap_max_load_factor : (usize * usize); + hashMap_max_load_factor : Fraction_t; hashMap_max_load : usize; hashMap_saturated : bool; hashMap_slots : alloc_vec_Vec (AList_t T); diff --git a/tests/fstar/hashmap/Hashmap.Clauses.Template.fst b/tests/fstar/hashmap/Hashmap.Clauses.Template.fst index a81bf3da..bb23295b 100644 --- a/tests/fstar/hashmap/Hashmap.Clauses.Template.fst +++ b/tests/fstar/hashmap/Hashmap.Clauses.Template.fst @@ -7,49 +7,49 @@ open Hashmap.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [hashmap::{hashmap::HashMap}::allocate_slots]: decreases clause - Source: 'tests/src/hashmap.rs', lines 64:8-67:9 *) + Source: 'tests/src/hashmap.rs', lines 70:8-73:9 *) unfold let hashMap_allocate_slots_loop_decreases (#t : Type0) (slots : alloc_vec_Vec (aList_t t)) (n : usize) : nat = admit () (** [hashmap::{hashmap::HashMap}::clear]: decreases clause - Source: 'tests/src/hashmap.rs', lines 98:8-101:9 *) + Source: 'tests/src/hashmap.rs', lines 103:8-106:9 *) unfold let hashMap_clear_loop_decreases (#t : Type0) (slots : alloc_vec_Vec (aList_t t)) (i : usize) : nat = admit () (** [hashmap::{hashmap::HashMap}::insert_in_list]: decreases clause - Source: 'tests/src/hashmap.rs', lines 1:0-127:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-132:9 *) unfold let hashMap_insert_in_list_loop_decreases (#t : Type0) (key : usize) (value : t) (ls : aList_t t) : nat = admit () (** [hashmap::{hashmap::HashMap}::move_elements_from_list]: decreases clause - Source: 'tests/src/hashmap.rs', lines 197:12-204:17 *) + Source: 'tests/src/hashmap.rs', lines 201:12-208:17 *) unfold let hashMap_move_elements_from_list_loop_decreases (#t : Type0) (ntable : hashMap_t t) (ls : aList_t t) : nat = admit () (** [hashmap::{hashmap::HashMap}::move_elements]: decreases clause - Source: 'tests/src/hashmap.rs', lines 183:8-190:9 *) + Source: 'tests/src/hashmap.rs', lines 187:8-194:9 *) unfold let hashMap_move_elements_loop_decreases (#t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (aList_t t)) (i : usize) : nat = admit () (** [hashmap::{hashmap::HashMap}::contains_key_in_list]: decreases clause - Source: 'tests/src/hashmap.rs', lines 1:0-229:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-233:9 *) unfold let hashMap_contains_key_in_list_loop_decreases (#t : Type0) (key : usize) (ls : aList_t t) : nat = admit () (** [hashmap::{hashmap::HashMap}::get_in_list]: decreases clause - Source: 'tests/src/hashmap.rs', lines 236:8-248:5 *) + Source: 'tests/src/hashmap.rs', lines 240:8-248:5 *) unfold let hashMap_get_in_list_loop_decreases (#t : Type0) (key : usize) (ls : aList_t t) : nat = diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index 26edb6a8..154dd7b8 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -13,8 +13,25 @@ include Hashmap.Clauses let hash_key (k : usize) : result usize = Ok k +(** [hashmap::{core::clone::Clone for hashmap::Fraction}#1::clone]: + Source: 'tests/src/hashmap.rs', lines 45:9-45:14 *) +let clonehashmapFraction_clone (self : fraction_t) : result fraction_t = + Ok self + +(** Trait implementation: [hashmap::{core::clone::Clone for hashmap::Fraction}#1] + Source: 'tests/src/hashmap.rs', lines 45:9-45:14 *) +let core_clone_ClonehashmapFraction : core_clone_Clone fraction_t = { + clone = clonehashmapFraction_clone; +} + +(** Trait implementation: [hashmap::{core::marker::Copy for hashmap::Fraction}#2] + Source: 'tests/src/hashmap.rs', lines 45:16-45:20 *) +let core_marker_CopyhashmapFraction : core_marker_Copy fraction_t = { + cloneInst = core_clone_ClonehashmapFraction; +} + (** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: - Source: 'tests/src/hashmap.rs', lines 64:8-67:9 *) + Source: 'tests/src/hashmap.rs', lines 70:8-73:9 *) let rec hashMap_allocate_slots_loop (#t : Type0) (slots : alloc_vec_Vec (aList_t t)) (n : usize) : Tot (result (alloc_vec_Vec (aList_t t))) @@ -28,7 +45,7 @@ let rec hashMap_allocate_slots_loop else Ok slots (** [hashmap::{hashmap::HashMap}::allocate_slots]: - Source: 'tests/src/hashmap.rs', lines 63:4-69:5 *) + Source: 'tests/src/hashmap.rs', lines 69:4-75:5 *) let hashMap_allocate_slots (#t : Type0) (slots : alloc_vec_Vec (aList_t t)) (n : usize) : result (alloc_vec_Vec (aList_t t)) @@ -36,32 +53,26 @@ let hashMap_allocate_slots hashMap_allocate_slots_loop slots n (** [hashmap::{hashmap::HashMap}::new_with_capacity]: - Source: 'tests/src/hashmap.rs', lines 72:4-87:5 *) + Source: 'tests/src/hashmap.rs', lines 78:4-92:5 *) let hashMap_new_with_capacity - (t : Type0) (capacity : usize) (max_load_dividend : usize) - (max_load_divisor : usize) : + (t : Type0) (capacity : usize) (max_load_factor : fraction_t) : result (hashMap_t t) = let* slots = hashMap_allocate_slots (alloc_vec_Vec_new (aList_t t)) capacity in - let* i = usize_mul capacity max_load_dividend in - let* i1 = usize_div i max_load_divisor in + let* i = usize_mul capacity max_load_factor.dividend in + let* i1 = usize_div i max_load_factor.divisor in Ok - { - num_entries = 0; - max_load_factor = (max_load_dividend, max_load_divisor); - max_load = i1; - saturated = false; - slots + { num_entries = 0; max_load_factor; max_load = i1; saturated = false; slots } (** [hashmap::{hashmap::HashMap}::new]: - Source: 'tests/src/hashmap.rs', lines 89:4-92:5 *) + Source: 'tests/src/hashmap.rs', lines 94:4-97:5 *) let hashMap_new (t : Type0) : result (hashMap_t t) = - hashMap_new_with_capacity t 32 4 5 + hashMap_new_with_capacity t 32 { dividend = 4; divisor = 5 } (** [hashmap::{hashmap::HashMap}::clear]: loop 0: - Source: 'tests/src/hashmap.rs', lines 98:8-101:9 *) + Source: 'tests/src/hashmap.rs', lines 103:8-106:9 *) let rec hashMap_clear_loop (#t : Type0) (slots : alloc_vec_Vec (aList_t t)) (i : usize) : Tot (result (alloc_vec_Vec (aList_t t))) @@ -79,18 +90,18 @@ let rec hashMap_clear_loop else Ok slots (** [hashmap::{hashmap::HashMap}::clear]: - Source: 'tests/src/hashmap.rs', lines 94:4-102:5 *) + Source: 'tests/src/hashmap.rs', lines 99:4-107:5 *) let hashMap_clear (#t : Type0) (self : hashMap_t t) : result (hashMap_t t) = let* hm = hashMap_clear_loop self.slots 0 in Ok { self with num_entries = 0; slots = hm } (** [hashmap::{hashmap::HashMap}::len]: - Source: 'tests/src/hashmap.rs', lines 104:4-106:5 *) + Source: 'tests/src/hashmap.rs', lines 109:4-111:5 *) let hashMap_len (#t : Type0) (self : hashMap_t t) : result usize = Ok self.num_entries (** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-127:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-132:9 *) let rec hashMap_insert_in_list_loop (#t : Type0) (key : usize) (value : t) (ls : aList_t t) : Tot (result (bool & (aList_t t))) @@ -107,7 +118,7 @@ let rec hashMap_insert_in_list_loop end (** [hashmap::{hashmap::HashMap}::insert_in_list]: - Source: 'tests/src/hashmap.rs', lines 111:4-128:5 *) + Source: 'tests/src/hashmap.rs', lines 116:4-133:5 *) let hashMap_insert_in_list (#t : Type0) (key : usize) (value : t) (ls : aList_t t) : result (bool & (aList_t t)) @@ -115,7 +126,7 @@ let hashMap_insert_in_list hashMap_insert_in_list_loop key value ls (** [hashmap::{hashmap::HashMap}::insert_no_resize]: - Source: 'tests/src/hashmap.rs', lines 131:4-139:5 *) + Source: 'tests/src/hashmap.rs', lines 136:4-144:5 *) let hashMap_insert_no_resize (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : result (hashMap_t t) @@ -135,7 +146,7 @@ let hashMap_insert_no_resize else let v = index_mut_back a1 in Ok { self with slots = v } (** [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 197:12-204:17 *) + Source: 'tests/src/hashmap.rs', lines 201:12-208:17 *) let rec hashMap_move_elements_from_list_loop (#t : Type0) (ntable : hashMap_t t) (ls : aList_t t) : Tot (result (hashMap_t t)) @@ -149,13 +160,13 @@ let rec hashMap_move_elements_from_list_loop end (** [hashmap::{hashmap::HashMap}::move_elements_from_list]: - Source: 'tests/src/hashmap.rs', lines 194:4-207:5 *) + Source: 'tests/src/hashmap.rs', lines 198:4-211:5 *) let hashMap_move_elements_from_list (#t : Type0) (ntable : hashMap_t t) (ls : aList_t t) : result (hashMap_t t) = hashMap_move_elements_from_list_loop ntable ls (** [hashmap::{hashmap::HashMap}::move_elements]: loop 0: - Source: 'tests/src/hashmap.rs', lines 183:8-190:9 *) + Source: 'tests/src/hashmap.rs', lines 187:8-194:9 *) let rec hashMap_move_elements_loop (#t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (aList_t t)) (i : usize) : @@ -176,7 +187,7 @@ let rec hashMap_move_elements_loop else Ok (ntable, slots) (** [hashmap::{hashmap::HashMap}::move_elements]: - Source: 'tests/src/hashmap.rs', lines 181:4-191:5 *) + Source: 'tests/src/hashmap.rs', lines 185:4-195:5 *) let hashMap_move_elements (#t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (aList_t t)) : result ((hashMap_t t) & (alloc_vec_Vec (aList_t t))) @@ -184,24 +195,23 @@ let hashMap_move_elements hashMap_move_elements_loop ntable slots 0 (** [hashmap::{hashmap::HashMap}::try_resize]: - Source: 'tests/src/hashmap.rs', lines 154:4-177:5 *) + Source: 'tests/src/hashmap.rs', lines 159:4-181:5 *) let hashMap_try_resize (#t : Type0) (self : hashMap_t t) : result (hashMap_t t) = let capacity = alloc_vec_Vec_len self.slots in let* n1 = usize_div core_usize_max 2 in - let (i, i1) = self.max_load_factor in - let* i2 = usize_div n1 i in - if capacity <= i2 + let* i = usize_div n1 self.max_load_factor.dividend in + if capacity <= i then - let* i3 = usize_mul capacity 2 in - let* ntable = hashMap_new_with_capacity t i3 i i1 in + let* i1 = usize_mul capacity 2 in + let* ntable = hashMap_new_with_capacity t i1 self.max_load_factor in let* p = hashMap_move_elements ntable self.slots in let (ntable1, _) = p in Ok { self with max_load = ntable1.max_load; slots = ntable1.slots } else Ok { self with saturated = true } (** [hashmap::{hashmap::HashMap}::insert]: - Source: 'tests/src/hashmap.rs', lines 143:4-150:5 *) + Source: 'tests/src/hashmap.rs', lines 148:4-155:5 *) let hashMap_insert (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : result (hashMap_t t) @@ -213,7 +223,7 @@ let hashMap_insert else Ok self1 (** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-229:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-233:9 *) let rec hashMap_contains_key_in_list_loop (#t : Type0) (key : usize) (ls : aList_t t) : Tot (result bool) @@ -226,13 +236,13 @@ let rec hashMap_contains_key_in_list_loop end (** [hashmap::{hashmap::HashMap}::contains_key_in_list]: - Source: 'tests/src/hashmap.rs', lines 217:4-230:5 *) + Source: 'tests/src/hashmap.rs', lines 221:4-234:5 *) let hashMap_contains_key_in_list (#t : Type0) (key : usize) (ls : aList_t t) : result bool = hashMap_contains_key_in_list_loop key ls (** [hashmap::{hashmap::HashMap}::contains_key]: - Source: 'tests/src/hashmap.rs', lines 210:4-214:5 *) + Source: 'tests/src/hashmap.rs', lines 214:4-218:5 *) let hashMap_contains_key (#t : Type0) (self : hashMap_t t) (key : usize) : result bool = let* hash = hash_key key in @@ -244,26 +254,28 @@ let hashMap_contains_key hashMap_contains_key_in_list key a (** [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 236:8-248:5 *) + Source: 'tests/src/hashmap.rs', lines 240:8-248:5 *) let rec hashMap_get_in_list_loop (#t : Type0) (key : usize) (ls : aList_t t) : - Tot (result t) (decreases (hashMap_get_in_list_loop_decreases key ls)) + Tot (result (option t)) + (decreases (hashMap_get_in_list_loop_decreases key ls)) = begin match ls with | AList_Cons ckey cvalue tl -> - if ckey = key then Ok cvalue else hashMap_get_in_list_loop key tl - | AList_Nil -> Fail Failure + if ckey = key then Ok (Some cvalue) else hashMap_get_in_list_loop key tl + | AList_Nil -> Ok None end (** [hashmap::{hashmap::HashMap}::get_in_list]: - Source: 'tests/src/hashmap.rs', lines 235:4-248:5 *) + Source: 'tests/src/hashmap.rs', lines 239:4-248:5 *) let hashMap_get_in_list - (#t : Type0) (key : usize) (ls : aList_t t) : result t = + (#t : Type0) (key : usize) (ls : aList_t t) : result (option t) = hashMap_get_in_list_loop key ls (** [hashmap::{hashmap::HashMap}::get]: Source: 'tests/src/hashmap.rs', lines 250:4-254:5 *) -let hashMap_get (#t : Type0) (self : hashMap_t t) (key : usize) : result t = +let hashMap_get + (#t : Type0) (self : hashMap_t t) (key : usize) : result (option t) = let* hash = hash_key key in let i = alloc_vec_Vec_len self.slots in let* hash_mod = usize_rem hash i in @@ -276,32 +288,39 @@ let hashMap_get (#t : Type0) (self : hashMap_t t) (key : usize) : result t = Source: 'tests/src/hashmap.rs', lines 257:8-265:5 *) let rec hashMap_get_mut_in_list_loop (#t : Type0) (ls : aList_t t) (key : usize) : - Tot (result (t & (t -> aList_t t))) + Tot (result ((option t) & (option t -> aList_t t))) (decreases (hashMap_get_mut_in_list_loop_decreases ls key)) = begin match ls with | AList_Cons ckey cvalue tl -> if ckey = key - then let back = fun ret -> AList_Cons ckey ret tl in Ok (cvalue, back) + then + let back = + fun ret -> + let x = begin match ret with | Some x1 -> x1 | _ -> cvalue end in + AList_Cons ckey x tl in + Ok (Some cvalue, back) else - let* (x, back) = hashMap_get_mut_in_list_loop tl key in + let* (o, back) = hashMap_get_mut_in_list_loop tl key in let back1 = fun ret -> let tl1 = back ret in AList_Cons ckey cvalue tl1 in - Ok (x, back1) - | AList_Nil -> Fail Failure + Ok (o, back1) + | AList_Nil -> let back = fun ret -> AList_Nil in Ok (None, back) end (** [hashmap::{hashmap::HashMap}::get_mut_in_list]: Source: 'tests/src/hashmap.rs', lines 256:4-265:5 *) let hashMap_get_mut_in_list - (#t : Type0) (ls : aList_t t) (key : usize) : result (t & (t -> aList_t t)) = + (#t : Type0) (ls : aList_t t) (key : usize) : + result ((option t) & (option t -> aList_t t)) + = hashMap_get_mut_in_list_loop ls key (** [hashmap::{hashmap::HashMap}::get_mut]: Source: 'tests/src/hashmap.rs', lines 268:4-272:5 *) let hashMap_get_mut (#t : Type0) (self : hashMap_t t) (key : usize) : - result (t & (t -> hashMap_t t)) + result ((option t) & (option t -> hashMap_t t)) = let* hash = hash_key key in let i = alloc_vec_Vec_len self.slots in @@ -309,13 +328,13 @@ let hashMap_get_mut let* (a, index_mut_back) = alloc_vec_Vec_index_mut (core_slice_index_SliceIndexUsizeSliceTInst (aList_t t)) self.slots hash_mod in - let* (x, get_mut_in_list_back) = hashMap_get_mut_in_list a key in + let* (o, get_mut_in_list_back) = hashMap_get_mut_in_list a key in let back = fun ret -> let a1 = get_mut_in_list_back ret in let v = index_mut_back a1 in { self with slots = v } in - Ok (x, back) + Ok (o, back) (** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'tests/src/hashmap.rs', lines 1:0-299:17 *) @@ -376,40 +395,3 @@ let insert_on_disk let* hm1 = hashMap_insert hm key value in utils_serialize hm1 st1 -(** [hashmap::test1]: - Source: 'tests/src/hashmap.rs', lines 351:0-383:1 *) -let test1 : result unit = - let* hm = hashMap_new u64 in - let* hm1 = hashMap_insert hm 0 42 in - let* hm2 = hashMap_insert hm1 128 18 in - let* hm3 = hashMap_insert hm2 1024 138 in - let* hm4 = hashMap_insert hm3 1056 256 in - let* i = hashMap_get hm4 128 in - if i = 18 - then - let* (_, get_mut_back) = hashMap_get_mut hm4 1024 in - let hm5 = get_mut_back 56 in - let* i1 = hashMap_get hm5 1024 in - if i1 = 56 - then - let* (x, hm6) = hashMap_remove hm5 1024 in - begin match x with - | None -> Fail Failure - | Some x1 -> - if x1 = 56 - then - let* i2 = hashMap_get hm6 0 in - if i2 = 42 - then - let* i3 = hashMap_get hm6 128 in - if i3 = 18 - then - let* i4 = hashMap_get hm6 1056 in - if i4 = 256 then Ok () else Fail Failure - else Fail Failure - else Fail Failure - else Fail Failure - end - else Fail Failure - else Fail Failure - diff --git a/tests/fstar/hashmap/Hashmap.FunsExternal.fsti b/tests/fstar/hashmap/Hashmap.FunsExternal.fsti index c7a3570a..e94419c5 100644 --- a/tests/fstar/hashmap/Hashmap.FunsExternal.fsti +++ b/tests/fstar/hashmap/Hashmap.FunsExternal.fsti @@ -14,3 +14,10 @@ val utils_deserialize : state -> result (state & (hashMap_t u64)) Source: 'tests/src/hashmap.rs', lines 326:4-328:5 *) val utils_serialize : hashMap_t u64 -> state -> result (state & unit) +(** [core::clone::Clone::clone_from]: + Source: '/rustc/library/core/src/clone.rs', lines 174:4-174:43 + Name pattern: core::clone::Clone::clone_from *) +val core_clone_Clone_clone_from + (#self : Type0) (self_clause : core_clone_Clone self) : + self -> self -> state -> result (state & self) + diff --git a/tests/fstar/hashmap/Hashmap.Types.fst b/tests/fstar/hashmap/Hashmap.Types.fst index 2831fed2..08a77823 100644 --- a/tests/fstar/hashmap/Hashmap.Types.fst +++ b/tests/fstar/hashmap/Hashmap.Types.fst @@ -12,12 +12,16 @@ type aList_t (t : Type0) = | AList_Cons : usize -> t -> aList_t t -> aList_t t | AList_Nil : aList_t t +(** [hashmap::Fraction] + Source: 'tests/src/hashmap.rs', lines 46:0-49:1 *) +type fraction_t = { dividend : usize; divisor : usize; } + (** [hashmap::HashMap] - Source: 'tests/src/hashmap.rs', lines 46:0-58:1 *) + Source: 'tests/src/hashmap.rs', lines 52:0-64:1 *) type hashMap_t (t : Type0) = { num_entries : usize; - max_load_factor : (usize & usize); + max_load_factor : fraction_t; max_load : usize; saturated : bool; slots : alloc_vec_Vec (aList_t t); diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 6baf0aed..0f312e73 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -15,8 +15,27 @@ namespace hashmap def hash_key (k : Usize) : Result Usize := Result.ok k +/- [hashmap::{core::clone::Clone for hashmap::Fraction}#1::clone]: + Source: 'tests/src/hashmap.rs', lines 45:9-45:14 -/ +def ClonehashmapFraction.clone (self : Fraction) : Result Fraction := + Result.ok self + +/- Trait implementation: [hashmap::{core::clone::Clone for hashmap::Fraction}#1] + Source: 'tests/src/hashmap.rs', lines 45:9-45:14 -/ +@[reducible] +def core.clone.ClonehashmapFraction : core.clone.Clone Fraction := { + clone := ClonehashmapFraction.clone +} + +/- Trait implementation: [hashmap::{core::marker::Copy for hashmap::Fraction}#2] + Source: 'tests/src/hashmap.rs', lines 45:16-45:20 -/ +@[reducible] +def core.marker.CopyhashmapFraction : core.marker.Copy Fraction := { + cloneInst := core.clone.ClonehashmapFraction +} + /- [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: - Source: 'tests/src/hashmap.rs', lines 64:8-67:9 -/ + Source: 'tests/src/hashmap.rs', lines 70:8-73:9 -/ divergent def HashMap.allocate_slots_loop {T : Type} (slots : alloc.vec.Vec (AList T)) (n : Usize) : Result (alloc.vec.Vec (AList T)) @@ -30,7 +49,7 @@ divergent def HashMap.allocate_slots_loop else Result.ok slots /- [hashmap::{hashmap::HashMap}::allocate_slots]: - Source: 'tests/src/hashmap.rs', lines 63:4-69:5 -/ + Source: 'tests/src/hashmap.rs', lines 69:4-75:5 -/ @[reducible] def HashMap.allocate_slots {T : Type} (slots : alloc.vec.Vec (AList T)) (n : Usize) : @@ -39,32 +58,32 @@ def HashMap.allocate_slots HashMap.allocate_slots_loop slots n /- [hashmap::{hashmap::HashMap}::new_with_capacity]: - Source: 'tests/src/hashmap.rs', lines 72:4-87:5 -/ + Source: 'tests/src/hashmap.rs', lines 78:4-92:5 -/ def HashMap.new_with_capacity - (T : Type) (capacity : Usize) (max_load_dividend : Usize) - (max_load_divisor : Usize) : + (T : Type) (capacity : Usize) (max_load_factor : Fraction) : Result (HashMap T) := do let slots ← HashMap.allocate_slots (alloc.vec.Vec.new (AList T)) capacity - let i ← capacity * max_load_dividend - let i1 ← i / max_load_divisor + let i ← capacity * max_load_factor.dividend + let i1 ← i / max_load_factor.divisor Result.ok { num_entries := 0#usize, - max_load_factor := (max_load_dividend, max_load_divisor), + max_load_factor, max_load := i1, saturated := false, slots } /- [hashmap::{hashmap::HashMap}::new]: - Source: 'tests/src/hashmap.rs', lines 89:4-92:5 -/ + Source: 'tests/src/hashmap.rs', lines 94:4-97:5 -/ def HashMap.new (T : Type) : Result (HashMap T) := - HashMap.new_with_capacity T 32#usize 4#usize 5#usize + HashMap.new_with_capacity T 32#usize + { dividend := 4#usize, divisor := 5#usize } /- [hashmap::{hashmap::HashMap}::clear]: loop 0: - Source: 'tests/src/hashmap.rs', lines 98:8-101:9 -/ + Source: 'tests/src/hashmap.rs', lines 103:8-106:9 -/ divergent def HashMap.clear_loop {T : Type} (slots : alloc.vec.Vec (AList T)) (i : Usize) : Result (alloc.vec.Vec (AList T)) @@ -82,19 +101,19 @@ divergent def HashMap.clear_loop else Result.ok slots /- [hashmap::{hashmap::HashMap}::clear]: - Source: 'tests/src/hashmap.rs', lines 94:4-102:5 -/ + Source: 'tests/src/hashmap.rs', lines 99:4-107:5 -/ def HashMap.clear {T : Type} (self : HashMap T) : Result (HashMap T) := do let hm ← HashMap.clear_loop self.slots 0#usize Result.ok { self with num_entries := 0#usize, slots := hm } /- [hashmap::{hashmap::HashMap}::len]: - Source: 'tests/src/hashmap.rs', lines 104:4-106:5 -/ + Source: 'tests/src/hashmap.rs', lines 109:4-111:5 -/ def HashMap.len {T : Type} (self : HashMap T) : Result Usize := Result.ok self.num_entries /- [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-127:9 -/ + Source: 'tests/src/hashmap.rs', lines 1:0-132:9 -/ divergent def HashMap.insert_in_list_loop {T : Type} (key : Usize) (value : T) (ls : AList T) : Result (Bool × (AList T)) @@ -110,7 +129,7 @@ divergent def HashMap.insert_in_list_loop | AList.Nil => Result.ok (true, AList.Cons key value AList.Nil) /- [hashmap::{hashmap::HashMap}::insert_in_list]: - Source: 'tests/src/hashmap.rs', lines 111:4-128:5 -/ + Source: 'tests/src/hashmap.rs', lines 116:4-133:5 -/ @[reducible] def HashMap.insert_in_list {T : Type} (key : Usize) (value : T) (ls : AList T) : @@ -119,7 +138,7 @@ def HashMap.insert_in_list HashMap.insert_in_list_loop key value ls /- [hashmap::{hashmap::HashMap}::insert_no_resize]: - Source: 'tests/src/hashmap.rs', lines 131:4-139:5 -/ + Source: 'tests/src/hashmap.rs', lines 136:4-144:5 -/ def HashMap.insert_no_resize {T : Type} (self : HashMap T) (key : Usize) (value : T) : Result (HashMap T) @@ -142,7 +161,7 @@ def HashMap.insert_no_resize Result.ok { self with slots := v } /- [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 197:12-204:17 -/ + Source: 'tests/src/hashmap.rs', lines 201:12-208:17 -/ divergent def HashMap.move_elements_from_list_loop {T : Type} (ntable : HashMap T) (ls : AList T) : Result (HashMap T) := match ls with @@ -153,14 +172,14 @@ divergent def HashMap.move_elements_from_list_loop | AList.Nil => Result.ok ntable /- [hashmap::{hashmap::HashMap}::move_elements_from_list]: - Source: 'tests/src/hashmap.rs', lines 194:4-207:5 -/ + Source: 'tests/src/hashmap.rs', lines 198:4-211:5 -/ @[reducible] def HashMap.move_elements_from_list {T : Type} (ntable : HashMap T) (ls : AList T) : Result (HashMap T) := HashMap.move_elements_from_list_loop ntable ls /- [hashmap::{hashmap::HashMap}::move_elements]: loop 0: - Source: 'tests/src/hashmap.rs', lines 183:8-190:9 -/ + Source: 'tests/src/hashmap.rs', lines 187:8-194:9 -/ divergent def HashMap.move_elements_loop {T : Type} (ntable : HashMap T) (slots : alloc.vec.Vec (AList T)) (i : Usize) : @@ -181,7 +200,7 @@ divergent def HashMap.move_elements_loop else Result.ok (ntable, slots) /- [hashmap::{hashmap::HashMap}::move_elements]: - Source: 'tests/src/hashmap.rs', lines 181:4-191:5 -/ + Source: 'tests/src/hashmap.rs', lines 185:4-195:5 -/ def HashMap.move_elements {T : Type} (ntable : HashMap T) (slots : alloc.vec.Vec (AList T)) : Result ((HashMap T) × (alloc.vec.Vec (AList T))) @@ -189,18 +208,17 @@ def HashMap.move_elements HashMap.move_elements_loop ntable slots 0#usize /- [hashmap::{hashmap::HashMap}::try_resize]: - Source: 'tests/src/hashmap.rs', lines 154:4-177:5 -/ + Source: 'tests/src/hashmap.rs', lines 159:4-181:5 -/ def HashMap.try_resize {T : Type} (self : HashMap T) : Result (HashMap T) := do let capacity := alloc.vec.Vec.len self.slots let n1 ← core_usize_max / 2#usize - let (i, i1) := self.max_load_factor - let i2 ← n1 / i - if capacity <= i2 + let i ← n1 / self.max_load_factor.dividend + if capacity <= i then do - let i3 ← capacity * 2#usize - let ntable ← HashMap.new_with_capacity T i3 i i1 + let i1 ← capacity * 2#usize + let ntable ← HashMap.new_with_capacity T i1 self.max_load_factor let p ← HashMap.move_elements ntable self.slots let (ntable1, _) := p Result.ok @@ -208,7 +226,7 @@ def HashMap.try_resize {T : Type} (self : HashMap T) : Result (HashMap T) := else Result.ok { self with saturated := true } /- [hashmap::{hashmap::HashMap}::insert]: - Source: 'tests/src/hashmap.rs', lines 143:4-150:5 -/ + Source: 'tests/src/hashmap.rs', lines 148:4-155:5 -/ def HashMap.insert {T : Type} (self : HashMap T) (key : Usize) (value : T) : Result (HashMap T) @@ -223,7 +241,7 @@ def HashMap.insert else Result.ok self1 /- [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-229:9 -/ + Source: 'tests/src/hashmap.rs', lines 1:0-233:9 -/ divergent def HashMap.contains_key_in_list_loop {T : Type} (key : Usize) (ls : AList T) : Result Bool := match ls with @@ -234,14 +252,14 @@ divergent def HashMap.contains_key_in_list_loop | AList.Nil => Result.ok false /- [hashmap::{hashmap::HashMap}::contains_key_in_list]: - Source: 'tests/src/hashmap.rs', lines 217:4-230:5 -/ + Source: 'tests/src/hashmap.rs', lines 221:4-234:5 -/ @[reducible] def HashMap.contains_key_in_list {T : Type} (key : Usize) (ls : AList T) : Result Bool := HashMap.contains_key_in_list_loop key ls /- [hashmap::{hashmap::HashMap}::contains_key]: - Source: 'tests/src/hashmap.rs', lines 210:4-214:5 -/ + Source: 'tests/src/hashmap.rs', lines 214:4-218:5 -/ def HashMap.contains_key {T : Type} (self : HashMap T) (key : Usize) : Result Bool := do @@ -254,25 +272,27 @@ def HashMap.contains_key HashMap.contains_key_in_list key a /- [hashmap::{hashmap::HashMap}::get_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 236:8-248:5 -/ + Source: 'tests/src/hashmap.rs', lines 240:8-248:5 -/ divergent def HashMap.get_in_list_loop - {T : Type} (key : Usize) (ls : AList T) : Result T := + {T : Type} (key : Usize) (ls : AList T) : Result (Option T) := match ls with | AList.Cons ckey cvalue tl => if ckey = key - then Result.ok cvalue + then Result.ok (some cvalue) else HashMap.get_in_list_loop key tl - | AList.Nil => Result.fail .panic + | AList.Nil => Result.ok none /- [hashmap::{hashmap::HashMap}::get_in_list]: - Source: 'tests/src/hashmap.rs', lines 235:4-248:5 -/ + Source: 'tests/src/hashmap.rs', lines 239:4-248:5 -/ @[reducible] -def HashMap.get_in_list {T : Type} (key : Usize) (ls : AList T) : Result T := +def HashMap.get_in_list + {T : Type} (key : Usize) (ls : AList T) : Result (Option T) := HashMap.get_in_list_loop key ls /- [hashmap::{hashmap::HashMap}::get]: Source: 'tests/src/hashmap.rs', lines 250:4-254:5 -/ -def HashMap.get {T : Type} (self : HashMap T) (key : Usize) : Result T := +def HashMap.get + {T : Type} (self : HashMap T) (key : Usize) : Result (Option T) := do let hash ← hash_key key let i := alloc.vec.Vec.len self.slots @@ -285,32 +305,43 @@ def HashMap.get {T : Type} (self : HashMap T) (key : Usize) : Result T := /- [hashmap::{hashmap::HashMap}::get_mut_in_list]: loop 0: Source: 'tests/src/hashmap.rs', lines 257:8-265:5 -/ divergent def HashMap.get_mut_in_list_loop - {T : Type} (ls : AList T) (key : Usize) : Result (T × (T → AList T)) := + {T : Type} (ls : AList T) (key : Usize) : + Result ((Option T) × (Option T → AList T)) + := match ls with | AList.Cons ckey cvalue tl => if ckey = key - then let back := fun ret => AList.Cons ckey ret tl - Result.ok (cvalue, back) + then + let back := + fun ret => + let t := match ret with + | some t1 => t1 + | _ => cvalue + AList.Cons ckey t tl + Result.ok (some cvalue, back) else do - let (t, back) ← HashMap.get_mut_in_list_loop tl key + let (o, back) ← HashMap.get_mut_in_list_loop tl key let back1 := fun ret => let tl1 := back ret AList.Cons ckey cvalue tl1 - Result.ok (t, back1) - | AList.Nil => Result.fail .panic + Result.ok (o, back1) + | AList.Nil => let back := fun ret => AList.Nil + Result.ok (none, back) /- [hashmap::{hashmap::HashMap}::get_mut_in_list]: Source: 'tests/src/hashmap.rs', lines 256:4-265:5 -/ @[reducible] def HashMap.get_mut_in_list - {T : Type} (ls : AList T) (key : Usize) : Result (T × (T → AList T)) := + {T : Type} (ls : AList T) (key : Usize) : + Result ((Option T) × (Option T → AList T)) + := HashMap.get_mut_in_list_loop ls key /- [hashmap::{hashmap::HashMap}::get_mut]: Source: 'tests/src/hashmap.rs', lines 268:4-272:5 -/ def HashMap.get_mut {T : Type} (self : HashMap T) (key : Usize) : - Result (T × (T → HashMap T)) + Result ((Option T) × (Option T → HashMap T)) := do let hash ← hash_key key @@ -319,13 +350,13 @@ def HashMap.get_mut let (a, index_mut_back) ← alloc.vec.Vec.index_mut (core.slice.index.SliceIndexUsizeSliceTInst (AList T)) self.slots hash_mod - let (t, get_mut_in_list_back) ← HashMap.get_mut_in_list a key + let (o, get_mut_in_list_back) ← HashMap.get_mut_in_list a key let back := fun ret => let a1 := get_mut_in_list_back ret let v := index_mut_back a1 { self with slots := v } - Result.ok (t, back) + Result.ok (o, back) /- [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'tests/src/hashmap.rs', lines 1:0-299:17 -/ @@ -385,32 +416,4 @@ def insert_on_disk let hm1 ← HashMap.insert hm key value utils.serialize hm1 st1 -/- [hashmap::test1]: - Source: 'tests/src/hashmap.rs', lines 351:0-383:1 -/ -def test1 : Result Unit := - do - let hm ← HashMap.new U64 - let hm1 ← HashMap.insert hm 0#usize 42#u64 - let hm2 ← HashMap.insert hm1 128#usize 18#u64 - let hm3 ← HashMap.insert hm2 1024#usize 138#u64 - let hm4 ← HashMap.insert hm3 1056#usize 256#u64 - let i ← HashMap.get hm4 128#usize - massert (i = 18#u64) - let (_, get_mut_back) ← HashMap.get_mut hm4 1024#usize - let hm5 := get_mut_back 56#u64 - let i1 ← HashMap.get hm5 1024#usize - massert (i1 = 56#u64) - let (x, hm6) ← HashMap.remove hm5 1024#usize - match x with - | none => Result.fail .panic - | some x1 => - do - massert (x1 = 56#u64) - let i2 ← HashMap.get hm6 0#usize - massert (i2 = 42#u64) - let i3 ← HashMap.get hm6 128#usize - massert (i3 = 18#u64) - let i4 ← HashMap.get hm6 1056#usize - massert (i4 = 256#u64) - end hashmap diff --git a/tests/lean/Hashmap/Types.lean b/tests/lean/Hashmap/Types.lean index 9d67c2f8..026bf798 100644 --- a/tests/lean/Hashmap/Types.lean +++ b/tests/lean/Hashmap/Types.lean @@ -15,11 +15,17 @@ inductive AList (T : Type) := | Cons : Usize → T → AList T → AList T | Nil : AList T +/- [hashmap::Fraction] + Source: 'tests/src/hashmap.rs', lines 46:0-49:1 -/ +structure Fraction where + dividend : Usize + divisor : Usize + /- [hashmap::HashMap] - Source: 'tests/src/hashmap.rs', lines 46:0-58:1 -/ + Source: 'tests/src/hashmap.rs', lines 52:0-64:1 -/ structure HashMap (T : Type) where num_entries : Usize - max_load_factor : (Usize × Usize) + max_load_factor : Fraction max_load : Usize saturated : Bool slots : alloc.vec.Vec (AList T) diff --git a/tests/src/hashmap.rs b/tests/src/hashmap.rs index 891969eb..81656fc2 100644 --- a/tests/src/hashmap.rs +++ b/tests/src/hashmap.rs @@ -42,12 +42,18 @@ pub fn hash_key(k: &Key) -> Hash { *k } +#[derive(Clone, Copy)] +struct Fraction { + dividend : usize, + divisor : usize, +} + /// A hash map from [u64] to values pub struct HashMap { /// The current number of entries in the table num_entries: usize, /// The max load factor, expressed as a fraction - max_load_factor: (usize, usize), + max_load_factor: Fraction, /// The max load factor applied to the current table length: /// gives the threshold at which to resize the table. max_load: usize, @@ -71,16 +77,15 @@ impl HashMap { /// Create a new table, with a given capacity fn new_with_capacity( capacity: usize, - max_load_dividend: usize, - max_load_divisor: usize, + max_load_factor : Fraction, ) -> Self { // TODO: better to use `Vec::with_capacity(capacity)` instead // of `Vec::new()` let slots = HashMap::allocate_slots(Vec::new(), capacity); HashMap { num_entries: 0, - max_load_factor: (max_load_dividend, max_load_divisor), - max_load: (capacity * max_load_dividend) / max_load_divisor, + max_load_factor, + max_load: (capacity * max_load_factor.dividend) / max_load_factor.divisor, saturated: false, slots, } @@ -88,7 +93,7 @@ impl HashMap { pub fn new() -> Self { // For now we create a table with 32 slots and a max load factor of 4/5 - HashMap::new_with_capacity(32, 4, 5) + HashMap::new_with_capacity(32, Fraction {dividend: 4, divisor:5}) } pub fn clear(&mut self) { @@ -157,12 +162,11 @@ impl HashMap { // Checking that there won't be overflows by using the fact that, if m > 0: // n * m <= p <==> n <= p / m let n1 = max_usize / 2; - if capacity <= n1 / self.max_load_factor.0 { + if capacity <= n1 / self.max_load_factor.dividend { // Create a new table with a higher capacity let mut ntable = HashMap::new_with_capacity( capacity * 2, - self.max_load_factor.0, - self.max_load_factor.1, + self.max_load_factor, ); // Move the elements to the new table @@ -232,40 +236,36 @@ impl HashMap { /// We don't support borrows inside of enumerations for now, so we /// can't return an option... /// TODO: add support for that - fn get_in_list<'a, 'k>(key: &'k Key, mut ls: &'a AList) -> &'a T { - loop { - match ls { - AList::Nil => panic!(), - AList::Cons(ckey, cvalue, tl) => { - if *ckey == *key { - return cvalue; - } else { - ls = tl; - } - } + fn get_in_list<'a, 'k>(key: &'k Key, mut ls: &'a AList) -> Option<&'a T> { + while let AList::Cons(ckey, cvalue, tl) = ls { + if *ckey == *key { + return Some(cvalue); + } else { + ls = tl; } } + None } - pub fn get<'a, 'k>(&'a self, key: &'k Key) -> &'a T { + pub fn get<'a, 'k>(&'a self, key: &'k Key) -> Option<&'a T> { let hash = hash_key(key); let hash_mod = hash % self.slots.len(); HashMap::get_in_list(key, &self.slots[hash_mod]) } - pub fn get_mut_in_list<'a, 'k>(mut ls: &'a mut AList, key: &'k Key) -> &'a mut T { + pub fn get_mut_in_list<'a, 'k>(mut ls: &'a mut AList, key: &'k Key) -> Option<&'a mut T> { while let AList::Cons(ckey, cvalue, tl) = ls { if *ckey == *key { - return cvalue; + return Some(cvalue); } else { ls = tl; } } - panic!() + None } /// Same remark as for [get]. - pub fn get_mut<'a, 'k>(&'a mut self, key: &'k Key) -> &'a mut T { + pub fn get_mut<'a, 'k>(&'a mut self, key: &'k Key) -> Option<&'a mut T> { let hash = hash_key(key); let hash_mod = hash % self.slots.len(); HashMap::get_mut_in_list(&mut self.slots[hash_mod], key) @@ -342,9 +342,11 @@ pub fn insert_on_disk(key: Key, value: u64) { utils::serialize(hm); } -/// I currently can't retrieve functions marked with the attribute #[test], -/// while I want to extract the unit tests and use the normalize on them, -/// so I have to define the test functions somewhere and call them from +/* +// FIXME +/// It is currently not possible to retrieve functions marked with the attribute #[test], +/// while we want to extract the unit tests and use the normalizer on them, +/// so we have to define the test functions somewhere and call them from /// a test function. /// TODO: find a way to do that. #[allow(dead_code)] @@ -385,4 +387,4 @@ fn test1() { #[test] fn tests() { test1(); -} +}*/ From 5f47ad33b565dc2d963e0aed6b0e95a4331bfce7 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 23:05:42 +0000 Subject: [PATCH 21/29] Update the hashmap proofs --- backends/lean/Base/List/List.lean | 9 + backends/lean/Base/Primitives/ArraySlice.lean | 10 + backends/lean/Base/Primitives/Vec.lean | 5 + tests/lean/Hashmap/Properties.lean | 180 ++++++++++++------ 4 files changed, 142 insertions(+), 62 deletions(-) diff --git a/backends/lean/Base/List/List.lean b/backends/lean/Base/List/List.lean index 507e99f9..2d46c88e 100644 --- a/backends/lean/Base/List/List.lean +++ b/backends/lean/Base/List/List.lean @@ -390,4 +390,13 @@ theorem lookup_not_none_imp_length_pos [BEq α] (l : List (α × β)) (key : α) end +@[simp] +theorem list_update_index_eq α [Inhabited α] (x : List α) (i : ℕ) : + x.update i (x.index i) = x := by + revert i + induction x + . simp + . intro i + dcases hi: 0 < i <;> simp_all + end List diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index 405734a0..e41e0b75 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -402,6 +402,16 @@ theorem Slice.update_subslice_spec {α : Type u} [Inhabited α] (a : Slice α) ( have := h2 i (by int_tac) (by int_tac) simp [*] +@[simp] +theorem Array.update_index_eq α n [Inhabited α] (x : Array α n) (i : Usize) : + x.update i (x.val.index i.toNat) = x := by + simp [Array, Subtype.eq_iff] + +@[simp] +theorem Slice.update_index_eq α [Inhabited α] (x : Slice α) (i : Usize) : + x.update i (x.val.index i.toNat) = x := by + simp [Slice, Subtype.eq_iff] + /- Trait declaration: [core::slice::index::private_slice_index::Sealed] -/ structure core.slice.index.private_slice_index.Sealed (Self : Type) where diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean index 49695c16..85587335 100644 --- a/backends/lean/Base/Primitives/Vec.lean +++ b/backends/lean/Base/Primitives/Vec.lean @@ -254,4 +254,9 @@ theorem alloc.vec.Vec.resize_spec {T} (cloneInst : core.clone.Clone T) . simp . simp [*] +@[simp] +theorem alloc.vec.Vec.update_index_eq α [Inhabited α] (x : alloc.vec.Vec α) (i : Usize) : + x.update i (x.val.index i.toNat) = x := by + simp [Vec, Subtype.eq_iff] + end Primitives diff --git a/tests/lean/Hashmap/Properties.lean b/tests/lean/Hashmap/Properties.lean index be078693..cfdc1b5a 100644 --- a/tests/lean/Hashmap/Properties.lean +++ b/tests/lean/Hashmap/Properties.lean @@ -111,9 +111,8 @@ attribute [coe] HashMap.v abbrev inv_load (hm : HashMap α) : Prop := let capacity : Int := hm.slots.val.length - -- TODO: let (dividend, divisor) := hm.max_load_factor introduces field notation .2, etc. - let dividend := hm.max_load_factor.1.val - let divisor := hm.max_load_factor.2.val + let dividend := hm.max_load_factor.dividend.val + let divisor := hm.max_load_factor.divisor.val 0 < dividend ∧ dividend < divisor ∧ capacity * dividend >= divisor ∧ hm.max_load = (capacity * dividend) / divisor @@ -213,14 +212,16 @@ theorem forall_nil_imp_flatten_len_zero (slots : List (List α)) @[pspec] theorem new_with_capacity_spec - (capacity : Usize) (max_load_dividend : Usize) (max_load_divisor : Usize) + (capacity : Usize) (max_load_factor : Fraction) (Hcapa : 0 < capacity.val) - (Hfactor : 0 < max_load_dividend.val ∧ max_load_dividend.val < max_load_divisor.val ∧ - capacity.val * max_load_dividend.val ≤ Usize.max ∧ - capacity.val * max_load_dividend.val ≥ max_load_divisor) - (Hdivid : 0 < max_load_divisor.val) : - ∃ hm, new_with_capacity α capacity max_load_dividend max_load_divisor = ok hm ∧ - hm.inv ∧ hm.len_s = 0 ∧ ∀ k, hm.lookup k = none := by + (Hfactor : 0 < max_load_factor.dividend.val ∧ + max_load_factor.dividend.val < max_load_factor.divisor.val ∧ + capacity.val * max_load_factor.dividend.val ≤ Usize.max ∧ + capacity.val * max_load_factor.dividend.val ≥ max_load_factor.divisor) + (Hdivid : 0 < max_load_factor.divisor.val) : + ∃ hm, new_with_capacity α capacity max_load_factor = ok hm ∧ + hm.inv ∧ hm.len_s = 0 ∧ hm.v.length = capacity.val ∧ hm.max_load_factor = max_load_factor ∧ + ∀ k, hm.lookup k = none := by rw [new_with_capacity] progress as ⟨ slots, Hnil ⟩ . simp [alloc.vec.Vec.new] at *; scalar_tac @@ -248,6 +249,7 @@ theorem new_with_capacity_spec . simp_all (config := {maxDischargeDepth := 1}) [alloc.vec.Vec.len, alloc.vec.Vec.new] . simp_all (config := {maxDischargeDepth := 1}) [alloc.vec.Vec.len, alloc.vec.Vec.new] . simp_all (config := {maxDischargeDepth := 1}) [al_v, Slots.al_v, v] + . simp_all [HashMap.v, length] . simp [lookup] intro k have : 0 ≤ k.val % slots.val.length ∧ k.val % slots.val.length < slots.val.length := by scalar_tac @@ -348,12 +350,20 @@ theorem if_update_eq := by split <;> simp [Pure.pure] +def frame_slots_params (hm1 hm2 : HashMap α) := + -- The max load factor is the same + hm2.max_load_factor = hm1.max_load_factor ∧ + -- The number of slots is the same + hm2.slots.val.length = hm1.slots.val.length + @[pspec] theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value : α) (hinv : hm.inv) (hnsat : hm.lookup key = none → hm.len_s < Usize.max) : ∃ nhm, hm.insert_no_resize key value = ok nhm ∧ -- We preserve the invariant nhm.inv ∧ + -- Frame information + frame_slots_params hm nhm ∧ -- We updated the binding for key nhm.lookup key = some value ∧ -- We left the other bindings unchanged @@ -442,6 +452,7 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value cases h_ieq : key.val % List.length hm.slots.val == i <;> simp_all (config := {maxDischargeDepth := 2}) [slot_s_inv] . simp [hinv] . simp_all (config := {maxDischargeDepth := 1}) [frame_load, inv_base, inv_load] + . simp_all [frame_slots_params] . simp [lookup] at * simp_all (config := {maxDischargeDepth := 2}) . simp [lookup] at * @@ -473,6 +484,7 @@ theorem move_elements_from_list_spec : ∃ ntable1, ntable.move_elements_from_list slot = ok ntable1 ∧ ntable1.inv ∧ + frame_slots_params ntable ntable1 ∧ (∀ key v, ntable1.lookup key = some v → ntable.lookup key = some v ∨ slot.lookup key = some v) ∧ (∀ key v, ntable.lookup key = some v → ntable1.lookup key = some v) ∧ (∀ key v, slot.lookup key = some v → ntable1.lookup key = some v) ∧ @@ -481,7 +493,7 @@ theorem move_elements_from_list_spec rw [move_elements_from_list]; rw [move_elements_from_list_loop] cases slot with | Nil => - simp [hinv] + simp [hinv, frame_slots_params] | Cons key value slot1 => simp have hLookupKey : ntable.lookup key = none := by @@ -490,7 +502,7 @@ theorem move_elements_from_list_spec have h := hDisjoint1 _ _ h simp_all (config := {maxDischargeDepth := 1}) have : ntable.lookup key = none → ntable.len_s < Usize.max := by simp_all (config := {maxDischargeDepth := 1}); scalar_tac - progress as ⟨ ntable1, _, hLookup11, hLookup12, hLength1 ⟩ + progress as ⟨ ntable1, _, _, hLookup11, hLookup12, hLength1 ⟩ simp [hLookupKey] at hLength1 have hTable1LookupImp : ∀ (key : Usize) (v : T), ntable1.lookup key = some v → slot1.lookup key = none := by intro key' v hLookup @@ -518,12 +530,13 @@ theorem move_elements_from_list_spec have : slot_t_inv l i slot1 := by simp [slot_t_inv] at hSlotInv simp [slot_t_inv, hSlotInv] - progress as ⟨ ntable2, hInv2, hLookup21, hLookup22, hLookup23, hLen1 ⟩ -- TODO: allow progress to receive instantiation hints + progress as ⟨ ntable2, hInv2, _, hLookup21, hLookup22, hLookup23, hLen1 ⟩ -- TODO: allow progress to receive instantiation hints -- The conclusion -- TODO: use aesop here split_conjs . simp [*] + . simp_all [frame_slots_params] . intro key' v hLookup have := hLookup21 key' v if h: key = key' then @@ -711,6 +724,7 @@ theorem move_elements_loop_spec : ∃ ntable1 slots1, ntable.move_elements_loop slots i = ok (ntable1, slots1) ∧ ntable1.inv ∧ + frame_slots_params ntable ntable1 ∧ ntable1.al_v.length = ntable.al_v.length + slots.al_v.length ∧ (∀ key v, ntable1.lookup key = some v → ntable.lookup key = some v ∨ slots.lookup key = some v) ∧ (∀ key v, slots.lookup key = some v → ntable1.lookup key = some v) ∧ @@ -744,7 +758,7 @@ theorem move_elements_loop_spec have : ntable.al_v.length + slot.v.length ≤ Usize.max := by have := slots_index_len_le_flatten_len slots.val i.toNat (by scalar_tac) simp_all (config := {maxDischargeDepth := 1}) [Slots.al_v]; scalar_tac - progress as ⟨ ntable1, _, hDisjointNtable1, hLookup11, hLookup12, hLen1 ⟩ + progress as ⟨ ntable1, _, _, hDisjointNtable1, hLookup11, hLookup12, hLen1 ⟩ . intro key v hLookup by_contra cases h : ntable.lookup key <;> simp_all (config := {maxDischargeDepth := 1}) @@ -776,7 +790,7 @@ theorem move_elements_loop_spec scalar_tac simp_all (config := {maxDischargeDepth := 2}) [Slots.lookup] - progress as ⟨ ntable2, slots2, _, _, hLookup2Rev, hLookup21, hLookup22, hIndexNil ⟩ + progress as ⟨ ntable2, slots2, _, _, _, hLookup2Rev, hLookup21, hLookup22, hIndexNil ⟩ . intro j h0 if h : j = i.toNat then simp_all (config := {maxDischargeDepth := 2}) @@ -803,6 +817,7 @@ theorem move_elements_loop_spec split_conjs . simp [*] + . simp_all (config := {maxDischargeDepth := 1}) [frame_slots_params] . simp_all (config := {maxDischargeDepth := 1}) [Slots.al_v] -- TODO scalar_tac_preprocess @@ -826,7 +841,7 @@ theorem move_elements_loop_spec have hNil : slots.al_v = [] := slots_forall_nil_imp_al_v_nil slots hEmpty have hLenNonZero : slots.val.length ≠ 0 := by simp [*] have hLookupEmpty := slots_forall_nil_imp_lookup_none slots hLenNonZero hEmpty - simp [hNil, hLookupEmpty] + simp [hNil, hLookupEmpty, frame_slots_params] apply hEmpty termination_by (slots.val.length - i.val).toNat decreasing_by scalar_decr_tac -- TODO: this is expensive @@ -844,11 +859,12 @@ theorem move_elements_spec : ∃ ntable1 slots1, ntable.move_elements slots = ok (ntable1, slots1) ∧ ntable1.inv ∧ + frame_slots_params ntable ntable1 ∧ ntable1.al_v.length = ntable.al_v.length + slots.al_v.length ∧ (∀ key v, ntable1.lookup key = some v ↔ slots.lookup key = some v) := by rw [move_elements] - have ⟨ ntable1, slots1, hEq, _, _, ntable1Lookup, slotsLookup, _, _ ⟩ := + have ⟨ ntable1, slots1, hEq, _, _, _, ntable1Lookup, slotsLookup, _, _ ⟩ := move_elements_loop_spec ntable slots 0#usize (by scalar_tac) hinv (by scalar_tac) hSlotsInv @@ -857,7 +873,10 @@ theorem move_elements_spec (by simp [*]) (by scalar_tac) simp [hEq]; clear hEq + have : frame_slots_params ntable ntable1 := by + simp_all [frame_slots_params] split_conjs <;> try assumption + -- intro key v have := ntable1Lookup key v have := slotsLookup key v @@ -866,6 +885,7 @@ theorem move_elements_spec @[pspec] theorem try_resize_spec {α : Type} (hm : HashMap α) (hInv : hm.inv): ∃ hm', hm.try_resize = ok hm' ∧ + hm'.inv ∧ (∀ key, hm'.lookup key = hm.lookup key) ∧ hm'.al_v.length = hm.al_v.length := by rw [try_resize] @@ -915,13 +935,17 @@ theorem try_resize_spec {α : Type} (hm : HashMap α) (hInv : hm.inv): . -- End of the proof have : slots_t_inv hm.slots := by simp_all (config := {maxDischargeDepth := 1}) [inv] -- TODO have : (Slots.al_v hm.slots).length ≤ Usize.max := by simp_all (config := {maxDischargeDepth := 1}) [inv, al_v, v, Slots.al_v]; scalar_tac - progress as ⟨ ntable2, slots1, _, _, hLookup ⟩ -- TODO: assumption is not powerful enough + progress as ⟨ ntable2, slots1, _, _, _, hLookup ⟩ -- TODO: assumption is not powerful enough simp_all (config := {maxDischargeDepth := 1}) [lookup, al_v, v, alloc.vec.Vec.len] - intro key - replace hLookup := hLookup key - cases h1: (ntable2.slots.val.index (key.val % ntable2.slots.val.length).toNat).v.lookup key <;> - cases h2: (hm.slots.val.index (key.val % hm.slots.val.length).toNat).v.lookup key <;> - simp_all (config := {maxDischargeDepth := 1}) [Slots.lookup] + split_conjs + . simp_all (config := {maxDischargeDepth := 1}) [inv, al_v, HashMap.v] + -- load invariant + simp_all [inv_load, frame_slots_params] + . intro key + replace hLookup := hLookup key + cases h1: (ntable2.slots.val.index (key.val % ntable2.slots.val.length).toNat).v.lookup key <;> + cases h2: (hm.slots.val.index (key.val % hm.slots.val.length).toNat).v.lookup key <;> + simp_all (config := {maxDischargeDepth := 1}) [Slots.lookup] else simp [hSmaller] tauto @@ -931,6 +955,7 @@ theorem insert_spec {α} (hm : HashMap α) (key : Usize) (value : α) (hInv : hm.inv) (hNotSat : hm.lookup key = none → hm.len_s < Usize.max) : ∃ hm1, insert hm key value = ok hm1 ∧ + hm1.inv ∧ -- hm1.lookup key = value ∧ (∀ key', key' ≠ key → hm1.lookup key' = hm.lookup key') ∧ @@ -950,36 +975,42 @@ theorem insert_spec {α} (hm : HashMap α) (key : Usize) (value : α) . simp_all (config := {maxDischargeDepth := 1}) @[pspec] -theorem get_in_list_spec {α} (key : Usize) (slot : AList α) (hLookup : slot.lookup key ≠ none) : - ∃ v, get_in_list key slot = ok v ∧ slot.lookup key = some v := by +theorem get_in_list_spec {α} (key : Usize) (slot : AList α) : + ∃ opt_v, get_in_list key slot = ok opt_v ∧ slot.lookup key = opt_v := by induction slot <;> rw [get_in_list, get_in_list_loop] <;> simp_all (config := {maxDischargeDepth := 1}) split <;> simp_all (config := {maxDischargeDepth := 2}) @[pspec] -theorem get_spec {α} (hm : HashMap α) (key : Usize) (hInv : hm.inv) (hLookup : hm.lookup key ≠ none) : - ∃ v, get hm key = ok v ∧ hm.lookup key = some v := by +theorem get_spec {α} (hm : HashMap α) (key : Usize) (hInv : hm.inv) : + ∃ opt_v, get hm key = ok opt_v ∧ hm.lookup key = opt_v := by rw [get] simp [hash_key, alloc.vec.Vec.len] progress as ⟨ hash_mod ⟩ -- TODO: decompose post by default simp at * progress as ⟨ slot ⟩ - progress as ⟨ v ⟩ <;> simp_all (config := {maxDischargeDepth := 1}) [lookup] + progress as ⟨ v ⟩ + simp_all (config := {maxDischargeDepth := 1}) [lookup] @[pspec] theorem get_mut_in_list_spec {α} (key : Usize) (slot : AList α) {l i : Int} - (hInv : slot_t_inv l i slot) - (hLookup : slot.lookup key ≠ none) : - ∃ v back, get_mut_in_list slot key = ok (v, back) ∧ - slot.lookup key = some v ∧ - ∀ v', ∃ slot', back v' = slot' ∧ - slot_t_inv l i slot' ∧ - slot'.lookup key = v' ∧ - (∀ key', key' ≠ key → slot'.lookup key' = slot.lookup key') ∧ - -- We need this strong post-condition for the recursive case - (∀ key', slot.v.allP (fun x => key' ≠ x.1) → slot'.v.allP (fun x => key' ≠ x.1)) + (hInv : slot_t_inv l i slot) : + ∃ opt_v back, get_mut_in_list slot key = ok (opt_v, back) ∧ + slot.lookup key = opt_v ∧ + -- Backward function + -- case: none + (opt_v = none → back none = slot) ∧ + -- case: some + (∀ v v', + opt_v = some v → + let slot' := back (some v') + slot_t_inv l i slot' ∧ + slot'.lookup key = v' ∧ + (∀ key', key' ≠ key → slot'.lookup key' = slot.lookup key') ∧ + -- We need this strong post-condition for the recursive case + (∀ key', slot.v.allP (fun x => key' ≠ x.1) → slot'.v.allP (fun x => key' ≠ x.1))) := by induction slot <;> rw [get_mut_in_list, get_mut_in_list_loop] <;> @@ -989,23 +1020,34 @@ theorem get_mut_in_list_spec {α} (key : Usize) (slot : AList α) simp_all (config := {maxDischargeDepth := 1}) [slot_t_inv] . -- Recursive case -- TODO: progress by - progress as ⟨ v, back, _, hBack ⟩ + progress as ⟨ opt_v, back, _, hBackNone, hBackSome ⟩ . simp_all (config := {maxDischargeDepth := 1}) [slot_t_inv] - . simp_all (config := {maxDischargeDepth := 2}) . simp [*] -- Proving the post-condition about back - intro v - constructor - . simp_all (config := {maxDischargeDepth := 1}) [slot_t_inv, slot_s_inv, slot_s_inv_hash] + -- Case disjunction on v + split_conjs . simp_all (config := {maxDischargeDepth := 1}) + . intro v v' heq + have := hBackSome v v' + split_conjs + . simp_all (config := {maxDischargeDepth := 1}) [slot_t_inv, slot_s_inv, slot_s_inv_hash] + . simp_all (config := {maxDischargeDepth := 1}) + . simp_all (config := {maxDischargeDepth := 1}) + . simp_all (config := {maxDischargeDepth := 1}) @[pspec] -theorem get_mut_spec {α} (hm : HashMap α) (key : Usize) (hInv : hm.inv) (hLookup : hm.lookup key ≠ none) : - ∃ v back, get_mut hm key = ok (v, back) ∧ - hm.lookup key = some v ∧ - ∀ v', ∃ hm', back v' = hm' ∧ - hm'.lookup key = v' ∧ - ∀ key', key' ≠ key → hm'.lookup key' = hm.lookup key' +theorem get_mut_spec {α} (hm : HashMap α) (key : Usize) (hInv : hm.inv) : + ∃ opt_v back, get_mut hm key = ok (opt_v, back) ∧ + hm.lookup key = opt_v ∧ + -- Backward function + -- case none: + (opt_v = none → back none = hm) ∧ + -- case some: + (∀ v v', + opt_v = some v → + let hm' := back (some v') + hm'.lookup key = some v' ∧ + ∀ key', key' ≠ key → hm'.lookup key' = hm.lookup key') := by rw [get_mut] simp [hash_key, alloc.vec.Vec.len] @@ -1017,22 +1059,36 @@ theorem get_mut_spec {α} (hm : HashMap α) (key : Usize) (hInv : hm.inv) (hLook simp_all (config := {maxDischargeDepth := 1}) [inv, slots_t_inv] have := hInv.right.left (key % (hm.slots.val.length : Int)).toNat simp_all (config := {maxDischargeDepth := 1}) - have : slot.lookup key ≠ none := by - simp_all (config := {maxDischargeDepth := 1}) [lookup] - progress as ⟨ v, back ⟩ + /-have : slot.lookup key ≠ none := by + simp_all (config := {maxDischargeDepth := 1}) [lookup]-/ + progress as ⟨ opt_v, back, _, hBackNone, hBackSome ⟩ simp [lookup, *] constructor - . simp_all (config := {maxDischargeDepth := 1}) + . simp_all (config := {maxDischargeDepth := 1}) [lookup] . -- Backward function - intro v' - simp_all (config := {maxDischargeDepth := 1}) - -- Last postcondition - intro key' hNotEq - -- TODO: simplify - have : 0 ≤ key'.val % hm.slots.val.length ∧ key'.val % hm.slots.val.length < hm.slots.val.length := by scalar_tac - -- We need to do a case disjunction - cases h: (key.val % hm.slots.val.length == key'.val % hm.slots.val.length) <;> - simp_all (config := {maxDischargeDepth := 2}) + split_conjs + . -- case: none + intro hEq + simp_all + -- TODO: tactic to automate this + have hSlotsEq : + hm.slots.update hash_mod ((hm.slots.val).index (key.val % (hm.slots.val).length).toNat) = hm.slots := by + simp_all [alloc.vec.Vec.update] + simp [hSlotsEq] + . -- case: some + intro v v' hVeq + simp_all (config := {maxDischargeDepth := 1}) + -- Last postcondition + replace hBackSome := hBackSome v v' (by simp) + have ⟨ _, _, _, _ ⟩ := hBackSome + clear hBackSome + simp [*] + intro key' hNotEq + -- TODO: simplify + have : 0 ≤ key'.val % hm.slots.val.length ∧ key'.val % hm.slots.val.length < hm.slots.val.length := by scalar_tac + -- We need to do a case disjunction + cases h: (key.val % hm.slots.val.length == key'.val % hm.slots.val.length) <;> + simp_all (config := {maxDischargeDepth := 2}) @[pspec] theorem remove_from_list_spec {α} (key : Usize) (slot : AList α) {l i} (hInv : slot_t_inv l i slot) : From 9adebc5a5c2fa0060d7b998080b6c8d2b2fe349f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 23:08:34 +0000 Subject: [PATCH 22/29] Update the Charon pin --- charon-pin | 2 +- flake.lock | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/charon-pin b/charon-pin index 29ec2632..87f09071 100644 --- a/charon-pin +++ b/charon-pin @@ -1,2 +1,2 @@ # This is the commit from https://github.com/AeneasVerif/charon that should be used with this version of aeneas. -c114a3aabc989b5ea3d72c3eccbde9869834460e +2909a3c23b1abbc780aad5dca76a0f101fedc6ea diff --git a/flake.lock b/flake.lock index 30627d90..808f06ac 100644 --- a/flake.lock +++ b/flake.lock @@ -9,11 +9,11 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1733929967, - "narHash": "sha256-RaCG23BtUsa6iCoFBgS5Uv7FdLzKQX8zPFHBDvl/v58=", + "lastModified": 1734440782, + "narHash": "sha256-ni2DPS9/JkAmD3dMh2tIpUTo7OiZplx3f/d0ySW8G5s=", "owner": "aeneasverif", "repo": "charon", - "rev": "c114a3aabc989b5ea3d72c3eccbde9869834460e", + "rev": "2909a3c23b1abbc780aad5dca76a0f101fedc6ea", "type": "github" }, "original": { @@ -177,11 +177,11 @@ ] }, "locked": { - "lastModified": 1733884434, - "narHash": "sha256-8GXR9kC07dyOIshAyfZhG11xfvBRSZzYghnZ2weOKJU=", + "lastModified": 1734402816, + "narHash": "sha256-cgQ8mjUJz7J3fp97lnvl0dSJ6vLt8yzUSmw3B7QKw94=", "owner": "oxalica", "repo": "rust-overlay", - "rev": "d0483df44ddf0fd1985f564abccbe568e020ddf2", + "rev": "e38fbd6e56e8cd1d61c65a21bbb7785e966707b4", "type": "github" }, "original": { From fde1f0c1f602628dd05d741a4633a05510e829f4 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 23:16:17 +0000 Subject: [PATCH 23/29] Fix some issues with the F* and Coq backends --- backends/coq/Primitives.v | 56 ++++++++++----------- backends/fstar/Primitives.fst | 26 +++++----- tests/coq/arrays/Primitives.v | 56 ++++++++++----------- tests/coq/betree/Primitives.v | 56 ++++++++++----------- tests/coq/demo/Primitives.v | 56 ++++++++++----------- tests/coq/hashmap/Primitives.v | 56 ++++++++++----------- tests/coq/misc/Primitives.v | 56 ++++++++++----------- tests/coq/misc/_CoqProject | 1 + tests/coq/rename_attribute/Primitives.v | 56 ++++++++++----------- tests/coq/traits/Primitives.v | 56 ++++++++++----------- tests/fstar/arrays/Primitives.fst | 26 +++++----- tests/fstar/betree/Primitives.fst | 26 +++++----- tests/fstar/demo/Primitives.fst | 26 +++++----- tests/fstar/hashmap/Primitives.fst | 26 +++++----- tests/fstar/misc/Primitives.fst | 26 +++++----- tests/fstar/rename_attribute/Primitives.fst | 26 +++++----- tests/fstar/traits/Primitives.fst | 26 +++++----- 17 files changed, 329 insertions(+), 328 deletions(-) diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index cc36ab25..a6578ff8 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -507,7 +507,7 @@ Axiom core_isize_max : isize. (** TODO *) (** Trait declaration: [core::clone::Clone] *) Record core_clone_Clone (self : Type) := { - clone : self -> result self + core_clone_Clone_clone : self -> result self }. Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. @@ -525,112 +525,112 @@ Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. Definition core_clone_CloneUsize : core_clone_Clone usize := {| - clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) |}. Definition core_clone_CloneU8 : core_clone_Clone u8 := {| - clone := fun x => Ok (core_clone_impls_CloneU8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU8_clone x) |}. Definition core_clone_CloneU16 : core_clone_Clone u16 := {| - clone := fun x => Ok (core_clone_impls_CloneU16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU16_clone x) |}. Definition core_clone_CloneU32 : core_clone_Clone u32 := {| - clone := fun x => Ok (core_clone_impls_CloneU32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU32_clone x) |}. Definition core_clone_CloneU64 : core_clone_Clone u64 := {| - clone := fun x => Ok (core_clone_impls_CloneU64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU64_clone x) |}. Definition core_clone_CloneU128 : core_clone_Clone u128 := {| - clone := fun x => Ok (core_clone_impls_CloneU128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU128_clone x) |}. Definition core_clone_CloneIsize : core_clone_Clone isize := {| - clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) |}. Definition core_clone_CloneI8 : core_clone_Clone i8 := {| - clone := fun x => Ok (core_clone_impls_CloneI8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI8_clone x) |}. Definition core_clone_CloneI16 : core_clone_Clone i16 := {| - clone := fun x => Ok (core_clone_impls_CloneI16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI16_clone x) |}. Definition core_clone_CloneI32 : core_clone_Clone i32 := {| - clone := fun x => Ok (core_clone_impls_CloneI32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI32_clone x) |}. Definition core_clone_CloneI64 : core_clone_Clone i64 := {| - clone := fun x => Ok (core_clone_impls_CloneI64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI64_clone x) |}. Definition core_clone_CloneI128 : core_clone_Clone i128 := {| - clone := fun x => Ok (core_clone_impls_CloneI128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI128_clone x) |}. Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. Definition core_clone_CloneBool : core_clone_Clone bool := {| - clone := fun b => Ok (core_clone_impls_CloneBool_clone b) + core_clone_Clone_clone := fun b => Ok (core_clone_impls_CloneBool_clone b) |}. Record core_marker_Copy (Self : Type) := mkcore_marker_Copy { - coreCloneInst : core_clone_Clone Self; + cloneInst : core_clone_Clone Self; }. Arguments mkcore_marker_Copy { _ }. -Arguments coreCloneInst { _ } _. +Arguments cloneInst { _ } _. Definition core_marker_CopyU8 : core_marker_Copy u8 := {| - coreCloneInst := core_clone_CloneU8; + cloneInst := core_clone_CloneU8; |}. Definition core_marker_CopyU16 : core_marker_Copy u16 := {| - coreCloneInst := core_clone_CloneU16; + cloneInst := core_clone_CloneU16; |}. Definition core_marker_CopyU32 : core_marker_Copy u32 := {| - coreCloneInst := core_clone_CloneU32; + cloneInst := core_clone_CloneU32; |}. Definition core_marker_CopyU64 : core_marker_Copy u64 := {| - coreCloneInst := core_clone_CloneU64; + cloneInst := core_clone_CloneU64; |}. Definition core_marker_CopyU128 : core_marker_Copy u128 := {| - coreCloneInst := core_clone_CloneU128; + cloneInst := core_clone_CloneU128; |}. Definition core_marker_CopyUsize : core_marker_Copy usize := {| - coreCloneInst := core_clone_CloneUsize; + cloneInst := core_clone_CloneUsize; |}. Definition core_marker_CopyI8 : core_marker_Copy i8 := {| - coreCloneInst := core_clone_CloneI8; + cloneInst := core_clone_CloneI8; |}. Definition core_marker_CopyI16 : core_marker_Copy i16 := {| - coreCloneInst := core_clone_CloneI16; + cloneInst := core_clone_CloneI16; |}. Definition core_marker_CopyI32 : core_marker_Copy i32 := {| - coreCloneInst := core_clone_CloneI32; + cloneInst := core_clone_CloneI32; |}. Definition core_marker_CopyI64 : core_marker_Copy i64 := {| - coreCloneInst := core_clone_CloneI64; + cloneInst := core_clone_CloneI64; |}. Definition core_marker_CopyI128 : core_marker_Copy i128 := {| - coreCloneInst := core_clone_CloneI128; + cloneInst := core_clone_CloneI128; |}. Definition core_marker_CopyIsize : core_marker_Copy isize := {| - coreCloneInst := core_clone_CloneIsize; + cloneInst := core_clone_CloneIsize; |}. (** [core::option::{core::option::Option}::unwrap] *) diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index a7a007f1..436c7f73 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -557,55 +557,55 @@ let core_clone_CloneI128 : core_clone_Clone i128 = { } noeq type core_marker_Copy (self : Type0) = { - cloneCloneInst : core_clone_Clone self; + cloneInst : core_clone_Clone self; } let core_marker_CopyU8 : core_marker_Copy u8 = { - cloneCloneInst = core_clone_CloneU8; + cloneInst = core_clone_CloneU8; } let core_marker_CopyU16 : core_marker_Copy u16 = { - cloneCloneInst = core_clone_CloneU16; + cloneInst = core_clone_CloneU16; } let core_marker_CopyU32 : core_marker_Copy u32 = { - cloneCloneInst = core_clone_CloneU32; + cloneInst = core_clone_CloneU32; } let core_marker_CopyU64 : core_marker_Copy u64 = { - cloneCloneInst = core_clone_CloneU64; + cloneInst = core_clone_CloneU64; } let core_marker_CopyU128 : core_marker_Copy u128 = { - cloneCloneInst = core_clone_CloneU128; + cloneInst = core_clone_CloneU128; } let core_marker_CopyUsize : core_marker_Copy usize = { - cloneCloneInst = core_clone_CloneUsize; + cloneInst = core_clone_CloneUsize; } let core_marker_CopyI8 : core_marker_Copy i8 = { - cloneCloneInst = core_clone_CloneI8; + cloneInst = core_clone_CloneI8; } let core_marker_CopyI16 : core_marker_Copy i16 = { - cloneCloneInst = core_clone_CloneI16; + cloneInst = core_clone_CloneI16; } let core_marker_CopyI32 : core_marker_Copy i32 = { - cloneCloneInst = core_clone_CloneI32; + cloneInst = core_clone_CloneI32; } let core_marker_CopyI64 : core_marker_Copy i64 = { - cloneCloneInst = core_clone_CloneI64; + cloneInst = core_clone_CloneI64; } let core_marker_CopyI128 : core_marker_Copy i128 = { - cloneCloneInst = core_clone_CloneI128; + cloneInst = core_clone_CloneI128; } let core_marker_CopyIsize : core_marker_Copy isize = { - cloneCloneInst = core_clone_CloneIsize; + cloneInst = core_clone_CloneIsize; } (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/coq/arrays/Primitives.v b/tests/coq/arrays/Primitives.v index cc36ab25..a6578ff8 100644 --- a/tests/coq/arrays/Primitives.v +++ b/tests/coq/arrays/Primitives.v @@ -507,7 +507,7 @@ Axiom core_isize_max : isize. (** TODO *) (** Trait declaration: [core::clone::Clone] *) Record core_clone_Clone (self : Type) := { - clone : self -> result self + core_clone_Clone_clone : self -> result self }. Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. @@ -525,112 +525,112 @@ Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. Definition core_clone_CloneUsize : core_clone_Clone usize := {| - clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) |}. Definition core_clone_CloneU8 : core_clone_Clone u8 := {| - clone := fun x => Ok (core_clone_impls_CloneU8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU8_clone x) |}. Definition core_clone_CloneU16 : core_clone_Clone u16 := {| - clone := fun x => Ok (core_clone_impls_CloneU16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU16_clone x) |}. Definition core_clone_CloneU32 : core_clone_Clone u32 := {| - clone := fun x => Ok (core_clone_impls_CloneU32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU32_clone x) |}. Definition core_clone_CloneU64 : core_clone_Clone u64 := {| - clone := fun x => Ok (core_clone_impls_CloneU64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU64_clone x) |}. Definition core_clone_CloneU128 : core_clone_Clone u128 := {| - clone := fun x => Ok (core_clone_impls_CloneU128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU128_clone x) |}. Definition core_clone_CloneIsize : core_clone_Clone isize := {| - clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) |}. Definition core_clone_CloneI8 : core_clone_Clone i8 := {| - clone := fun x => Ok (core_clone_impls_CloneI8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI8_clone x) |}. Definition core_clone_CloneI16 : core_clone_Clone i16 := {| - clone := fun x => Ok (core_clone_impls_CloneI16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI16_clone x) |}. Definition core_clone_CloneI32 : core_clone_Clone i32 := {| - clone := fun x => Ok (core_clone_impls_CloneI32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI32_clone x) |}. Definition core_clone_CloneI64 : core_clone_Clone i64 := {| - clone := fun x => Ok (core_clone_impls_CloneI64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI64_clone x) |}. Definition core_clone_CloneI128 : core_clone_Clone i128 := {| - clone := fun x => Ok (core_clone_impls_CloneI128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI128_clone x) |}. Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. Definition core_clone_CloneBool : core_clone_Clone bool := {| - clone := fun b => Ok (core_clone_impls_CloneBool_clone b) + core_clone_Clone_clone := fun b => Ok (core_clone_impls_CloneBool_clone b) |}. Record core_marker_Copy (Self : Type) := mkcore_marker_Copy { - coreCloneInst : core_clone_Clone Self; + cloneInst : core_clone_Clone Self; }. Arguments mkcore_marker_Copy { _ }. -Arguments coreCloneInst { _ } _. +Arguments cloneInst { _ } _. Definition core_marker_CopyU8 : core_marker_Copy u8 := {| - coreCloneInst := core_clone_CloneU8; + cloneInst := core_clone_CloneU8; |}. Definition core_marker_CopyU16 : core_marker_Copy u16 := {| - coreCloneInst := core_clone_CloneU16; + cloneInst := core_clone_CloneU16; |}. Definition core_marker_CopyU32 : core_marker_Copy u32 := {| - coreCloneInst := core_clone_CloneU32; + cloneInst := core_clone_CloneU32; |}. Definition core_marker_CopyU64 : core_marker_Copy u64 := {| - coreCloneInst := core_clone_CloneU64; + cloneInst := core_clone_CloneU64; |}. Definition core_marker_CopyU128 : core_marker_Copy u128 := {| - coreCloneInst := core_clone_CloneU128; + cloneInst := core_clone_CloneU128; |}. Definition core_marker_CopyUsize : core_marker_Copy usize := {| - coreCloneInst := core_clone_CloneUsize; + cloneInst := core_clone_CloneUsize; |}. Definition core_marker_CopyI8 : core_marker_Copy i8 := {| - coreCloneInst := core_clone_CloneI8; + cloneInst := core_clone_CloneI8; |}. Definition core_marker_CopyI16 : core_marker_Copy i16 := {| - coreCloneInst := core_clone_CloneI16; + cloneInst := core_clone_CloneI16; |}. Definition core_marker_CopyI32 : core_marker_Copy i32 := {| - coreCloneInst := core_clone_CloneI32; + cloneInst := core_clone_CloneI32; |}. Definition core_marker_CopyI64 : core_marker_Copy i64 := {| - coreCloneInst := core_clone_CloneI64; + cloneInst := core_clone_CloneI64; |}. Definition core_marker_CopyI128 : core_marker_Copy i128 := {| - coreCloneInst := core_clone_CloneI128; + cloneInst := core_clone_CloneI128; |}. Definition core_marker_CopyIsize : core_marker_Copy isize := {| - coreCloneInst := core_clone_CloneIsize; + cloneInst := core_clone_CloneIsize; |}. (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/coq/betree/Primitives.v b/tests/coq/betree/Primitives.v index cc36ab25..a6578ff8 100644 --- a/tests/coq/betree/Primitives.v +++ b/tests/coq/betree/Primitives.v @@ -507,7 +507,7 @@ Axiom core_isize_max : isize. (** TODO *) (** Trait declaration: [core::clone::Clone] *) Record core_clone_Clone (self : Type) := { - clone : self -> result self + core_clone_Clone_clone : self -> result self }. Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. @@ -525,112 +525,112 @@ Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. Definition core_clone_CloneUsize : core_clone_Clone usize := {| - clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) |}. Definition core_clone_CloneU8 : core_clone_Clone u8 := {| - clone := fun x => Ok (core_clone_impls_CloneU8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU8_clone x) |}. Definition core_clone_CloneU16 : core_clone_Clone u16 := {| - clone := fun x => Ok (core_clone_impls_CloneU16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU16_clone x) |}. Definition core_clone_CloneU32 : core_clone_Clone u32 := {| - clone := fun x => Ok (core_clone_impls_CloneU32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU32_clone x) |}. Definition core_clone_CloneU64 : core_clone_Clone u64 := {| - clone := fun x => Ok (core_clone_impls_CloneU64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU64_clone x) |}. Definition core_clone_CloneU128 : core_clone_Clone u128 := {| - clone := fun x => Ok (core_clone_impls_CloneU128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU128_clone x) |}. Definition core_clone_CloneIsize : core_clone_Clone isize := {| - clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) |}. Definition core_clone_CloneI8 : core_clone_Clone i8 := {| - clone := fun x => Ok (core_clone_impls_CloneI8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI8_clone x) |}. Definition core_clone_CloneI16 : core_clone_Clone i16 := {| - clone := fun x => Ok (core_clone_impls_CloneI16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI16_clone x) |}. Definition core_clone_CloneI32 : core_clone_Clone i32 := {| - clone := fun x => Ok (core_clone_impls_CloneI32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI32_clone x) |}. Definition core_clone_CloneI64 : core_clone_Clone i64 := {| - clone := fun x => Ok (core_clone_impls_CloneI64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI64_clone x) |}. Definition core_clone_CloneI128 : core_clone_Clone i128 := {| - clone := fun x => Ok (core_clone_impls_CloneI128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI128_clone x) |}. Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. Definition core_clone_CloneBool : core_clone_Clone bool := {| - clone := fun b => Ok (core_clone_impls_CloneBool_clone b) + core_clone_Clone_clone := fun b => Ok (core_clone_impls_CloneBool_clone b) |}. Record core_marker_Copy (Self : Type) := mkcore_marker_Copy { - coreCloneInst : core_clone_Clone Self; + cloneInst : core_clone_Clone Self; }. Arguments mkcore_marker_Copy { _ }. -Arguments coreCloneInst { _ } _. +Arguments cloneInst { _ } _. Definition core_marker_CopyU8 : core_marker_Copy u8 := {| - coreCloneInst := core_clone_CloneU8; + cloneInst := core_clone_CloneU8; |}. Definition core_marker_CopyU16 : core_marker_Copy u16 := {| - coreCloneInst := core_clone_CloneU16; + cloneInst := core_clone_CloneU16; |}. Definition core_marker_CopyU32 : core_marker_Copy u32 := {| - coreCloneInst := core_clone_CloneU32; + cloneInst := core_clone_CloneU32; |}. Definition core_marker_CopyU64 : core_marker_Copy u64 := {| - coreCloneInst := core_clone_CloneU64; + cloneInst := core_clone_CloneU64; |}. Definition core_marker_CopyU128 : core_marker_Copy u128 := {| - coreCloneInst := core_clone_CloneU128; + cloneInst := core_clone_CloneU128; |}. Definition core_marker_CopyUsize : core_marker_Copy usize := {| - coreCloneInst := core_clone_CloneUsize; + cloneInst := core_clone_CloneUsize; |}. Definition core_marker_CopyI8 : core_marker_Copy i8 := {| - coreCloneInst := core_clone_CloneI8; + cloneInst := core_clone_CloneI8; |}. Definition core_marker_CopyI16 : core_marker_Copy i16 := {| - coreCloneInst := core_clone_CloneI16; + cloneInst := core_clone_CloneI16; |}. Definition core_marker_CopyI32 : core_marker_Copy i32 := {| - coreCloneInst := core_clone_CloneI32; + cloneInst := core_clone_CloneI32; |}. Definition core_marker_CopyI64 : core_marker_Copy i64 := {| - coreCloneInst := core_clone_CloneI64; + cloneInst := core_clone_CloneI64; |}. Definition core_marker_CopyI128 : core_marker_Copy i128 := {| - coreCloneInst := core_clone_CloneI128; + cloneInst := core_clone_CloneI128; |}. Definition core_marker_CopyIsize : core_marker_Copy isize := {| - coreCloneInst := core_clone_CloneIsize; + cloneInst := core_clone_CloneIsize; |}. (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/coq/demo/Primitives.v b/tests/coq/demo/Primitives.v index cc36ab25..a6578ff8 100644 --- a/tests/coq/demo/Primitives.v +++ b/tests/coq/demo/Primitives.v @@ -507,7 +507,7 @@ Axiom core_isize_max : isize. (** TODO *) (** Trait declaration: [core::clone::Clone] *) Record core_clone_Clone (self : Type) := { - clone : self -> result self + core_clone_Clone_clone : self -> result self }. Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. @@ -525,112 +525,112 @@ Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. Definition core_clone_CloneUsize : core_clone_Clone usize := {| - clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) |}. Definition core_clone_CloneU8 : core_clone_Clone u8 := {| - clone := fun x => Ok (core_clone_impls_CloneU8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU8_clone x) |}. Definition core_clone_CloneU16 : core_clone_Clone u16 := {| - clone := fun x => Ok (core_clone_impls_CloneU16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU16_clone x) |}. Definition core_clone_CloneU32 : core_clone_Clone u32 := {| - clone := fun x => Ok (core_clone_impls_CloneU32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU32_clone x) |}. Definition core_clone_CloneU64 : core_clone_Clone u64 := {| - clone := fun x => Ok (core_clone_impls_CloneU64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU64_clone x) |}. Definition core_clone_CloneU128 : core_clone_Clone u128 := {| - clone := fun x => Ok (core_clone_impls_CloneU128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU128_clone x) |}. Definition core_clone_CloneIsize : core_clone_Clone isize := {| - clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) |}. Definition core_clone_CloneI8 : core_clone_Clone i8 := {| - clone := fun x => Ok (core_clone_impls_CloneI8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI8_clone x) |}. Definition core_clone_CloneI16 : core_clone_Clone i16 := {| - clone := fun x => Ok (core_clone_impls_CloneI16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI16_clone x) |}. Definition core_clone_CloneI32 : core_clone_Clone i32 := {| - clone := fun x => Ok (core_clone_impls_CloneI32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI32_clone x) |}. Definition core_clone_CloneI64 : core_clone_Clone i64 := {| - clone := fun x => Ok (core_clone_impls_CloneI64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI64_clone x) |}. Definition core_clone_CloneI128 : core_clone_Clone i128 := {| - clone := fun x => Ok (core_clone_impls_CloneI128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI128_clone x) |}. Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. Definition core_clone_CloneBool : core_clone_Clone bool := {| - clone := fun b => Ok (core_clone_impls_CloneBool_clone b) + core_clone_Clone_clone := fun b => Ok (core_clone_impls_CloneBool_clone b) |}. Record core_marker_Copy (Self : Type) := mkcore_marker_Copy { - coreCloneInst : core_clone_Clone Self; + cloneInst : core_clone_Clone Self; }. Arguments mkcore_marker_Copy { _ }. -Arguments coreCloneInst { _ } _. +Arguments cloneInst { _ } _. Definition core_marker_CopyU8 : core_marker_Copy u8 := {| - coreCloneInst := core_clone_CloneU8; + cloneInst := core_clone_CloneU8; |}. Definition core_marker_CopyU16 : core_marker_Copy u16 := {| - coreCloneInst := core_clone_CloneU16; + cloneInst := core_clone_CloneU16; |}. Definition core_marker_CopyU32 : core_marker_Copy u32 := {| - coreCloneInst := core_clone_CloneU32; + cloneInst := core_clone_CloneU32; |}. Definition core_marker_CopyU64 : core_marker_Copy u64 := {| - coreCloneInst := core_clone_CloneU64; + cloneInst := core_clone_CloneU64; |}. Definition core_marker_CopyU128 : core_marker_Copy u128 := {| - coreCloneInst := core_clone_CloneU128; + cloneInst := core_clone_CloneU128; |}. Definition core_marker_CopyUsize : core_marker_Copy usize := {| - coreCloneInst := core_clone_CloneUsize; + cloneInst := core_clone_CloneUsize; |}. Definition core_marker_CopyI8 : core_marker_Copy i8 := {| - coreCloneInst := core_clone_CloneI8; + cloneInst := core_clone_CloneI8; |}. Definition core_marker_CopyI16 : core_marker_Copy i16 := {| - coreCloneInst := core_clone_CloneI16; + cloneInst := core_clone_CloneI16; |}. Definition core_marker_CopyI32 : core_marker_Copy i32 := {| - coreCloneInst := core_clone_CloneI32; + cloneInst := core_clone_CloneI32; |}. Definition core_marker_CopyI64 : core_marker_Copy i64 := {| - coreCloneInst := core_clone_CloneI64; + cloneInst := core_clone_CloneI64; |}. Definition core_marker_CopyI128 : core_marker_Copy i128 := {| - coreCloneInst := core_clone_CloneI128; + cloneInst := core_clone_CloneI128; |}. Definition core_marker_CopyIsize : core_marker_Copy isize := {| - coreCloneInst := core_clone_CloneIsize; + cloneInst := core_clone_CloneIsize; |}. (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/coq/hashmap/Primitives.v b/tests/coq/hashmap/Primitives.v index cc36ab25..a6578ff8 100644 --- a/tests/coq/hashmap/Primitives.v +++ b/tests/coq/hashmap/Primitives.v @@ -507,7 +507,7 @@ Axiom core_isize_max : isize. (** TODO *) (** Trait declaration: [core::clone::Clone] *) Record core_clone_Clone (self : Type) := { - clone : self -> result self + core_clone_Clone_clone : self -> result self }. Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. @@ -525,112 +525,112 @@ Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. Definition core_clone_CloneUsize : core_clone_Clone usize := {| - clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) |}. Definition core_clone_CloneU8 : core_clone_Clone u8 := {| - clone := fun x => Ok (core_clone_impls_CloneU8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU8_clone x) |}. Definition core_clone_CloneU16 : core_clone_Clone u16 := {| - clone := fun x => Ok (core_clone_impls_CloneU16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU16_clone x) |}. Definition core_clone_CloneU32 : core_clone_Clone u32 := {| - clone := fun x => Ok (core_clone_impls_CloneU32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU32_clone x) |}. Definition core_clone_CloneU64 : core_clone_Clone u64 := {| - clone := fun x => Ok (core_clone_impls_CloneU64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU64_clone x) |}. Definition core_clone_CloneU128 : core_clone_Clone u128 := {| - clone := fun x => Ok (core_clone_impls_CloneU128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU128_clone x) |}. Definition core_clone_CloneIsize : core_clone_Clone isize := {| - clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) |}. Definition core_clone_CloneI8 : core_clone_Clone i8 := {| - clone := fun x => Ok (core_clone_impls_CloneI8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI8_clone x) |}. Definition core_clone_CloneI16 : core_clone_Clone i16 := {| - clone := fun x => Ok (core_clone_impls_CloneI16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI16_clone x) |}. Definition core_clone_CloneI32 : core_clone_Clone i32 := {| - clone := fun x => Ok (core_clone_impls_CloneI32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI32_clone x) |}. Definition core_clone_CloneI64 : core_clone_Clone i64 := {| - clone := fun x => Ok (core_clone_impls_CloneI64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI64_clone x) |}. Definition core_clone_CloneI128 : core_clone_Clone i128 := {| - clone := fun x => Ok (core_clone_impls_CloneI128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI128_clone x) |}. Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. Definition core_clone_CloneBool : core_clone_Clone bool := {| - clone := fun b => Ok (core_clone_impls_CloneBool_clone b) + core_clone_Clone_clone := fun b => Ok (core_clone_impls_CloneBool_clone b) |}. Record core_marker_Copy (Self : Type) := mkcore_marker_Copy { - coreCloneInst : core_clone_Clone Self; + cloneInst : core_clone_Clone Self; }. Arguments mkcore_marker_Copy { _ }. -Arguments coreCloneInst { _ } _. +Arguments cloneInst { _ } _. Definition core_marker_CopyU8 : core_marker_Copy u8 := {| - coreCloneInst := core_clone_CloneU8; + cloneInst := core_clone_CloneU8; |}. Definition core_marker_CopyU16 : core_marker_Copy u16 := {| - coreCloneInst := core_clone_CloneU16; + cloneInst := core_clone_CloneU16; |}. Definition core_marker_CopyU32 : core_marker_Copy u32 := {| - coreCloneInst := core_clone_CloneU32; + cloneInst := core_clone_CloneU32; |}. Definition core_marker_CopyU64 : core_marker_Copy u64 := {| - coreCloneInst := core_clone_CloneU64; + cloneInst := core_clone_CloneU64; |}. Definition core_marker_CopyU128 : core_marker_Copy u128 := {| - coreCloneInst := core_clone_CloneU128; + cloneInst := core_clone_CloneU128; |}. Definition core_marker_CopyUsize : core_marker_Copy usize := {| - coreCloneInst := core_clone_CloneUsize; + cloneInst := core_clone_CloneUsize; |}. Definition core_marker_CopyI8 : core_marker_Copy i8 := {| - coreCloneInst := core_clone_CloneI8; + cloneInst := core_clone_CloneI8; |}. Definition core_marker_CopyI16 : core_marker_Copy i16 := {| - coreCloneInst := core_clone_CloneI16; + cloneInst := core_clone_CloneI16; |}. Definition core_marker_CopyI32 : core_marker_Copy i32 := {| - coreCloneInst := core_clone_CloneI32; + cloneInst := core_clone_CloneI32; |}. Definition core_marker_CopyI64 : core_marker_Copy i64 := {| - coreCloneInst := core_clone_CloneI64; + cloneInst := core_clone_CloneI64; |}. Definition core_marker_CopyI128 : core_marker_Copy i128 := {| - coreCloneInst := core_clone_CloneI128; + cloneInst := core_clone_CloneI128; |}. Definition core_marker_CopyIsize : core_marker_Copy isize := {| - coreCloneInst := core_clone_CloneIsize; + cloneInst := core_clone_CloneIsize; |}. (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/coq/misc/Primitives.v b/tests/coq/misc/Primitives.v index cc36ab25..a6578ff8 100644 --- a/tests/coq/misc/Primitives.v +++ b/tests/coq/misc/Primitives.v @@ -507,7 +507,7 @@ Axiom core_isize_max : isize. (** TODO *) (** Trait declaration: [core::clone::Clone] *) Record core_clone_Clone (self : Type) := { - clone : self -> result self + core_clone_Clone_clone : self -> result self }. Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. @@ -525,112 +525,112 @@ Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. Definition core_clone_CloneUsize : core_clone_Clone usize := {| - clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) |}. Definition core_clone_CloneU8 : core_clone_Clone u8 := {| - clone := fun x => Ok (core_clone_impls_CloneU8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU8_clone x) |}. Definition core_clone_CloneU16 : core_clone_Clone u16 := {| - clone := fun x => Ok (core_clone_impls_CloneU16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU16_clone x) |}. Definition core_clone_CloneU32 : core_clone_Clone u32 := {| - clone := fun x => Ok (core_clone_impls_CloneU32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU32_clone x) |}. Definition core_clone_CloneU64 : core_clone_Clone u64 := {| - clone := fun x => Ok (core_clone_impls_CloneU64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU64_clone x) |}. Definition core_clone_CloneU128 : core_clone_Clone u128 := {| - clone := fun x => Ok (core_clone_impls_CloneU128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU128_clone x) |}. Definition core_clone_CloneIsize : core_clone_Clone isize := {| - clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) |}. Definition core_clone_CloneI8 : core_clone_Clone i8 := {| - clone := fun x => Ok (core_clone_impls_CloneI8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI8_clone x) |}. Definition core_clone_CloneI16 : core_clone_Clone i16 := {| - clone := fun x => Ok (core_clone_impls_CloneI16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI16_clone x) |}. Definition core_clone_CloneI32 : core_clone_Clone i32 := {| - clone := fun x => Ok (core_clone_impls_CloneI32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI32_clone x) |}. Definition core_clone_CloneI64 : core_clone_Clone i64 := {| - clone := fun x => Ok (core_clone_impls_CloneI64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI64_clone x) |}. Definition core_clone_CloneI128 : core_clone_Clone i128 := {| - clone := fun x => Ok (core_clone_impls_CloneI128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI128_clone x) |}. Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. Definition core_clone_CloneBool : core_clone_Clone bool := {| - clone := fun b => Ok (core_clone_impls_CloneBool_clone b) + core_clone_Clone_clone := fun b => Ok (core_clone_impls_CloneBool_clone b) |}. Record core_marker_Copy (Self : Type) := mkcore_marker_Copy { - coreCloneInst : core_clone_Clone Self; + cloneInst : core_clone_Clone Self; }. Arguments mkcore_marker_Copy { _ }. -Arguments coreCloneInst { _ } _. +Arguments cloneInst { _ } _. Definition core_marker_CopyU8 : core_marker_Copy u8 := {| - coreCloneInst := core_clone_CloneU8; + cloneInst := core_clone_CloneU8; |}. Definition core_marker_CopyU16 : core_marker_Copy u16 := {| - coreCloneInst := core_clone_CloneU16; + cloneInst := core_clone_CloneU16; |}. Definition core_marker_CopyU32 : core_marker_Copy u32 := {| - coreCloneInst := core_clone_CloneU32; + cloneInst := core_clone_CloneU32; |}. Definition core_marker_CopyU64 : core_marker_Copy u64 := {| - coreCloneInst := core_clone_CloneU64; + cloneInst := core_clone_CloneU64; |}. Definition core_marker_CopyU128 : core_marker_Copy u128 := {| - coreCloneInst := core_clone_CloneU128; + cloneInst := core_clone_CloneU128; |}. Definition core_marker_CopyUsize : core_marker_Copy usize := {| - coreCloneInst := core_clone_CloneUsize; + cloneInst := core_clone_CloneUsize; |}. Definition core_marker_CopyI8 : core_marker_Copy i8 := {| - coreCloneInst := core_clone_CloneI8; + cloneInst := core_clone_CloneI8; |}. Definition core_marker_CopyI16 : core_marker_Copy i16 := {| - coreCloneInst := core_clone_CloneI16; + cloneInst := core_clone_CloneI16; |}. Definition core_marker_CopyI32 : core_marker_Copy i32 := {| - coreCloneInst := core_clone_CloneI32; + cloneInst := core_clone_CloneI32; |}. Definition core_marker_CopyI64 : core_marker_Copy i64 := {| - coreCloneInst := core_clone_CloneI64; + cloneInst := core_clone_CloneI64; |}. Definition core_marker_CopyI128 : core_marker_Copy i128 := {| - coreCloneInst := core_clone_CloneI128; + cloneInst := core_clone_CloneI128; |}. Definition core_marker_CopyIsize : core_marker_Copy isize := {| - coreCloneInst := core_clone_CloneIsize; + cloneInst := core_clone_CloneIsize; |}. (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/coq/misc/_CoqProject b/tests/coq/misc/_CoqProject index 24efb46e..f2dc8af2 100644 --- a/tests/coq/misc/_CoqProject +++ b/tests/coq/misc/_CoqProject @@ -3,6 +3,7 @@ -arg -w -arg all +AdtBorrows.v Bitwise.v Constants.v External_Funs.v diff --git a/tests/coq/rename_attribute/Primitives.v b/tests/coq/rename_attribute/Primitives.v index cc36ab25..a6578ff8 100644 --- a/tests/coq/rename_attribute/Primitives.v +++ b/tests/coq/rename_attribute/Primitives.v @@ -507,7 +507,7 @@ Axiom core_isize_max : isize. (** TODO *) (** Trait declaration: [core::clone::Clone] *) Record core_clone_Clone (self : Type) := { - clone : self -> result self + core_clone_Clone_clone : self -> result self }. Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. @@ -525,112 +525,112 @@ Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. Definition core_clone_CloneUsize : core_clone_Clone usize := {| - clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) |}. Definition core_clone_CloneU8 : core_clone_Clone u8 := {| - clone := fun x => Ok (core_clone_impls_CloneU8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU8_clone x) |}. Definition core_clone_CloneU16 : core_clone_Clone u16 := {| - clone := fun x => Ok (core_clone_impls_CloneU16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU16_clone x) |}. Definition core_clone_CloneU32 : core_clone_Clone u32 := {| - clone := fun x => Ok (core_clone_impls_CloneU32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU32_clone x) |}. Definition core_clone_CloneU64 : core_clone_Clone u64 := {| - clone := fun x => Ok (core_clone_impls_CloneU64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU64_clone x) |}. Definition core_clone_CloneU128 : core_clone_Clone u128 := {| - clone := fun x => Ok (core_clone_impls_CloneU128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU128_clone x) |}. Definition core_clone_CloneIsize : core_clone_Clone isize := {| - clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) |}. Definition core_clone_CloneI8 : core_clone_Clone i8 := {| - clone := fun x => Ok (core_clone_impls_CloneI8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI8_clone x) |}. Definition core_clone_CloneI16 : core_clone_Clone i16 := {| - clone := fun x => Ok (core_clone_impls_CloneI16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI16_clone x) |}. Definition core_clone_CloneI32 : core_clone_Clone i32 := {| - clone := fun x => Ok (core_clone_impls_CloneI32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI32_clone x) |}. Definition core_clone_CloneI64 : core_clone_Clone i64 := {| - clone := fun x => Ok (core_clone_impls_CloneI64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI64_clone x) |}. Definition core_clone_CloneI128 : core_clone_Clone i128 := {| - clone := fun x => Ok (core_clone_impls_CloneI128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI128_clone x) |}. Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. Definition core_clone_CloneBool : core_clone_Clone bool := {| - clone := fun b => Ok (core_clone_impls_CloneBool_clone b) + core_clone_Clone_clone := fun b => Ok (core_clone_impls_CloneBool_clone b) |}. Record core_marker_Copy (Self : Type) := mkcore_marker_Copy { - coreCloneInst : core_clone_Clone Self; + cloneInst : core_clone_Clone Self; }. Arguments mkcore_marker_Copy { _ }. -Arguments coreCloneInst { _ } _. +Arguments cloneInst { _ } _. Definition core_marker_CopyU8 : core_marker_Copy u8 := {| - coreCloneInst := core_clone_CloneU8; + cloneInst := core_clone_CloneU8; |}. Definition core_marker_CopyU16 : core_marker_Copy u16 := {| - coreCloneInst := core_clone_CloneU16; + cloneInst := core_clone_CloneU16; |}. Definition core_marker_CopyU32 : core_marker_Copy u32 := {| - coreCloneInst := core_clone_CloneU32; + cloneInst := core_clone_CloneU32; |}. Definition core_marker_CopyU64 : core_marker_Copy u64 := {| - coreCloneInst := core_clone_CloneU64; + cloneInst := core_clone_CloneU64; |}. Definition core_marker_CopyU128 : core_marker_Copy u128 := {| - coreCloneInst := core_clone_CloneU128; + cloneInst := core_clone_CloneU128; |}. Definition core_marker_CopyUsize : core_marker_Copy usize := {| - coreCloneInst := core_clone_CloneUsize; + cloneInst := core_clone_CloneUsize; |}. Definition core_marker_CopyI8 : core_marker_Copy i8 := {| - coreCloneInst := core_clone_CloneI8; + cloneInst := core_clone_CloneI8; |}. Definition core_marker_CopyI16 : core_marker_Copy i16 := {| - coreCloneInst := core_clone_CloneI16; + cloneInst := core_clone_CloneI16; |}. Definition core_marker_CopyI32 : core_marker_Copy i32 := {| - coreCloneInst := core_clone_CloneI32; + cloneInst := core_clone_CloneI32; |}. Definition core_marker_CopyI64 : core_marker_Copy i64 := {| - coreCloneInst := core_clone_CloneI64; + cloneInst := core_clone_CloneI64; |}. Definition core_marker_CopyI128 : core_marker_Copy i128 := {| - coreCloneInst := core_clone_CloneI128; + cloneInst := core_clone_CloneI128; |}. Definition core_marker_CopyIsize : core_marker_Copy isize := {| - coreCloneInst := core_clone_CloneIsize; + cloneInst := core_clone_CloneIsize; |}. (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/coq/traits/Primitives.v b/tests/coq/traits/Primitives.v index cc36ab25..a6578ff8 100644 --- a/tests/coq/traits/Primitives.v +++ b/tests/coq/traits/Primitives.v @@ -507,7 +507,7 @@ Axiom core_isize_max : isize. (** TODO *) (** Trait declaration: [core::clone::Clone] *) Record core_clone_Clone (self : Type) := { - clone : self -> result self + core_clone_Clone_clone : self -> result self }. Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. @@ -525,112 +525,112 @@ Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. Definition core_clone_CloneUsize : core_clone_Clone usize := {| - clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) |}. Definition core_clone_CloneU8 : core_clone_Clone u8 := {| - clone := fun x => Ok (core_clone_impls_CloneU8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU8_clone x) |}. Definition core_clone_CloneU16 : core_clone_Clone u16 := {| - clone := fun x => Ok (core_clone_impls_CloneU16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU16_clone x) |}. Definition core_clone_CloneU32 : core_clone_Clone u32 := {| - clone := fun x => Ok (core_clone_impls_CloneU32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU32_clone x) |}. Definition core_clone_CloneU64 : core_clone_Clone u64 := {| - clone := fun x => Ok (core_clone_impls_CloneU64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU64_clone x) |}. Definition core_clone_CloneU128 : core_clone_Clone u128 := {| - clone := fun x => Ok (core_clone_impls_CloneU128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneU128_clone x) |}. Definition core_clone_CloneIsize : core_clone_Clone isize := {| - clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) |}. Definition core_clone_CloneI8 : core_clone_Clone i8 := {| - clone := fun x => Ok (core_clone_impls_CloneI8_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI8_clone x) |}. Definition core_clone_CloneI16 : core_clone_Clone i16 := {| - clone := fun x => Ok (core_clone_impls_CloneI16_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI16_clone x) |}. Definition core_clone_CloneI32 : core_clone_Clone i32 := {| - clone := fun x => Ok (core_clone_impls_CloneI32_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI32_clone x) |}. Definition core_clone_CloneI64 : core_clone_Clone i64 := {| - clone := fun x => Ok (core_clone_impls_CloneI64_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI64_clone x) |}. Definition core_clone_CloneI128 : core_clone_Clone i128 := {| - clone := fun x => Ok (core_clone_impls_CloneI128_clone x) + core_clone_Clone_clone := fun x => Ok (core_clone_impls_CloneI128_clone x) |}. Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. Definition core_clone_CloneBool : core_clone_Clone bool := {| - clone := fun b => Ok (core_clone_impls_CloneBool_clone b) + core_clone_Clone_clone := fun b => Ok (core_clone_impls_CloneBool_clone b) |}. Record core_marker_Copy (Self : Type) := mkcore_marker_Copy { - coreCloneInst : core_clone_Clone Self; + cloneInst : core_clone_Clone Self; }. Arguments mkcore_marker_Copy { _ }. -Arguments coreCloneInst { _ } _. +Arguments cloneInst { _ } _. Definition core_marker_CopyU8 : core_marker_Copy u8 := {| - coreCloneInst := core_clone_CloneU8; + cloneInst := core_clone_CloneU8; |}. Definition core_marker_CopyU16 : core_marker_Copy u16 := {| - coreCloneInst := core_clone_CloneU16; + cloneInst := core_clone_CloneU16; |}. Definition core_marker_CopyU32 : core_marker_Copy u32 := {| - coreCloneInst := core_clone_CloneU32; + cloneInst := core_clone_CloneU32; |}. Definition core_marker_CopyU64 : core_marker_Copy u64 := {| - coreCloneInst := core_clone_CloneU64; + cloneInst := core_clone_CloneU64; |}. Definition core_marker_CopyU128 : core_marker_Copy u128 := {| - coreCloneInst := core_clone_CloneU128; + cloneInst := core_clone_CloneU128; |}. Definition core_marker_CopyUsize : core_marker_Copy usize := {| - coreCloneInst := core_clone_CloneUsize; + cloneInst := core_clone_CloneUsize; |}. Definition core_marker_CopyI8 : core_marker_Copy i8 := {| - coreCloneInst := core_clone_CloneI8; + cloneInst := core_clone_CloneI8; |}. Definition core_marker_CopyI16 : core_marker_Copy i16 := {| - coreCloneInst := core_clone_CloneI16; + cloneInst := core_clone_CloneI16; |}. Definition core_marker_CopyI32 : core_marker_Copy i32 := {| - coreCloneInst := core_clone_CloneI32; + cloneInst := core_clone_CloneI32; |}. Definition core_marker_CopyI64 : core_marker_Copy i64 := {| - coreCloneInst := core_clone_CloneI64; + cloneInst := core_clone_CloneI64; |}. Definition core_marker_CopyI128 : core_marker_Copy i128 := {| - coreCloneInst := core_clone_CloneI128; + cloneInst := core_clone_CloneI128; |}. Definition core_marker_CopyIsize : core_marker_Copy isize := {| - coreCloneInst := core_clone_CloneIsize; + cloneInst := core_clone_CloneIsize; |}. (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/fstar/arrays/Primitives.fst b/tests/fstar/arrays/Primitives.fst index a7a007f1..436c7f73 100644 --- a/tests/fstar/arrays/Primitives.fst +++ b/tests/fstar/arrays/Primitives.fst @@ -557,55 +557,55 @@ let core_clone_CloneI128 : core_clone_Clone i128 = { } noeq type core_marker_Copy (self : Type0) = { - cloneCloneInst : core_clone_Clone self; + cloneInst : core_clone_Clone self; } let core_marker_CopyU8 : core_marker_Copy u8 = { - cloneCloneInst = core_clone_CloneU8; + cloneInst = core_clone_CloneU8; } let core_marker_CopyU16 : core_marker_Copy u16 = { - cloneCloneInst = core_clone_CloneU16; + cloneInst = core_clone_CloneU16; } let core_marker_CopyU32 : core_marker_Copy u32 = { - cloneCloneInst = core_clone_CloneU32; + cloneInst = core_clone_CloneU32; } let core_marker_CopyU64 : core_marker_Copy u64 = { - cloneCloneInst = core_clone_CloneU64; + cloneInst = core_clone_CloneU64; } let core_marker_CopyU128 : core_marker_Copy u128 = { - cloneCloneInst = core_clone_CloneU128; + cloneInst = core_clone_CloneU128; } let core_marker_CopyUsize : core_marker_Copy usize = { - cloneCloneInst = core_clone_CloneUsize; + cloneInst = core_clone_CloneUsize; } let core_marker_CopyI8 : core_marker_Copy i8 = { - cloneCloneInst = core_clone_CloneI8; + cloneInst = core_clone_CloneI8; } let core_marker_CopyI16 : core_marker_Copy i16 = { - cloneCloneInst = core_clone_CloneI16; + cloneInst = core_clone_CloneI16; } let core_marker_CopyI32 : core_marker_Copy i32 = { - cloneCloneInst = core_clone_CloneI32; + cloneInst = core_clone_CloneI32; } let core_marker_CopyI64 : core_marker_Copy i64 = { - cloneCloneInst = core_clone_CloneI64; + cloneInst = core_clone_CloneI64; } let core_marker_CopyI128 : core_marker_Copy i128 = { - cloneCloneInst = core_clone_CloneI128; + cloneInst = core_clone_CloneI128; } let core_marker_CopyIsize : core_marker_Copy isize = { - cloneCloneInst = core_clone_CloneIsize; + cloneInst = core_clone_CloneIsize; } (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/fstar/betree/Primitives.fst b/tests/fstar/betree/Primitives.fst index a7a007f1..436c7f73 100644 --- a/tests/fstar/betree/Primitives.fst +++ b/tests/fstar/betree/Primitives.fst @@ -557,55 +557,55 @@ let core_clone_CloneI128 : core_clone_Clone i128 = { } noeq type core_marker_Copy (self : Type0) = { - cloneCloneInst : core_clone_Clone self; + cloneInst : core_clone_Clone self; } let core_marker_CopyU8 : core_marker_Copy u8 = { - cloneCloneInst = core_clone_CloneU8; + cloneInst = core_clone_CloneU8; } let core_marker_CopyU16 : core_marker_Copy u16 = { - cloneCloneInst = core_clone_CloneU16; + cloneInst = core_clone_CloneU16; } let core_marker_CopyU32 : core_marker_Copy u32 = { - cloneCloneInst = core_clone_CloneU32; + cloneInst = core_clone_CloneU32; } let core_marker_CopyU64 : core_marker_Copy u64 = { - cloneCloneInst = core_clone_CloneU64; + cloneInst = core_clone_CloneU64; } let core_marker_CopyU128 : core_marker_Copy u128 = { - cloneCloneInst = core_clone_CloneU128; + cloneInst = core_clone_CloneU128; } let core_marker_CopyUsize : core_marker_Copy usize = { - cloneCloneInst = core_clone_CloneUsize; + cloneInst = core_clone_CloneUsize; } let core_marker_CopyI8 : core_marker_Copy i8 = { - cloneCloneInst = core_clone_CloneI8; + cloneInst = core_clone_CloneI8; } let core_marker_CopyI16 : core_marker_Copy i16 = { - cloneCloneInst = core_clone_CloneI16; + cloneInst = core_clone_CloneI16; } let core_marker_CopyI32 : core_marker_Copy i32 = { - cloneCloneInst = core_clone_CloneI32; + cloneInst = core_clone_CloneI32; } let core_marker_CopyI64 : core_marker_Copy i64 = { - cloneCloneInst = core_clone_CloneI64; + cloneInst = core_clone_CloneI64; } let core_marker_CopyI128 : core_marker_Copy i128 = { - cloneCloneInst = core_clone_CloneI128; + cloneInst = core_clone_CloneI128; } let core_marker_CopyIsize : core_marker_Copy isize = { - cloneCloneInst = core_clone_CloneIsize; + cloneInst = core_clone_CloneIsize; } (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/fstar/demo/Primitives.fst b/tests/fstar/demo/Primitives.fst index a7a007f1..436c7f73 100644 --- a/tests/fstar/demo/Primitives.fst +++ b/tests/fstar/demo/Primitives.fst @@ -557,55 +557,55 @@ let core_clone_CloneI128 : core_clone_Clone i128 = { } noeq type core_marker_Copy (self : Type0) = { - cloneCloneInst : core_clone_Clone self; + cloneInst : core_clone_Clone self; } let core_marker_CopyU8 : core_marker_Copy u8 = { - cloneCloneInst = core_clone_CloneU8; + cloneInst = core_clone_CloneU8; } let core_marker_CopyU16 : core_marker_Copy u16 = { - cloneCloneInst = core_clone_CloneU16; + cloneInst = core_clone_CloneU16; } let core_marker_CopyU32 : core_marker_Copy u32 = { - cloneCloneInst = core_clone_CloneU32; + cloneInst = core_clone_CloneU32; } let core_marker_CopyU64 : core_marker_Copy u64 = { - cloneCloneInst = core_clone_CloneU64; + cloneInst = core_clone_CloneU64; } let core_marker_CopyU128 : core_marker_Copy u128 = { - cloneCloneInst = core_clone_CloneU128; + cloneInst = core_clone_CloneU128; } let core_marker_CopyUsize : core_marker_Copy usize = { - cloneCloneInst = core_clone_CloneUsize; + cloneInst = core_clone_CloneUsize; } let core_marker_CopyI8 : core_marker_Copy i8 = { - cloneCloneInst = core_clone_CloneI8; + cloneInst = core_clone_CloneI8; } let core_marker_CopyI16 : core_marker_Copy i16 = { - cloneCloneInst = core_clone_CloneI16; + cloneInst = core_clone_CloneI16; } let core_marker_CopyI32 : core_marker_Copy i32 = { - cloneCloneInst = core_clone_CloneI32; + cloneInst = core_clone_CloneI32; } let core_marker_CopyI64 : core_marker_Copy i64 = { - cloneCloneInst = core_clone_CloneI64; + cloneInst = core_clone_CloneI64; } let core_marker_CopyI128 : core_marker_Copy i128 = { - cloneCloneInst = core_clone_CloneI128; + cloneInst = core_clone_CloneI128; } let core_marker_CopyIsize : core_marker_Copy isize = { - cloneCloneInst = core_clone_CloneIsize; + cloneInst = core_clone_CloneIsize; } (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/fstar/hashmap/Primitives.fst b/tests/fstar/hashmap/Primitives.fst index a7a007f1..436c7f73 100644 --- a/tests/fstar/hashmap/Primitives.fst +++ b/tests/fstar/hashmap/Primitives.fst @@ -557,55 +557,55 @@ let core_clone_CloneI128 : core_clone_Clone i128 = { } noeq type core_marker_Copy (self : Type0) = { - cloneCloneInst : core_clone_Clone self; + cloneInst : core_clone_Clone self; } let core_marker_CopyU8 : core_marker_Copy u8 = { - cloneCloneInst = core_clone_CloneU8; + cloneInst = core_clone_CloneU8; } let core_marker_CopyU16 : core_marker_Copy u16 = { - cloneCloneInst = core_clone_CloneU16; + cloneInst = core_clone_CloneU16; } let core_marker_CopyU32 : core_marker_Copy u32 = { - cloneCloneInst = core_clone_CloneU32; + cloneInst = core_clone_CloneU32; } let core_marker_CopyU64 : core_marker_Copy u64 = { - cloneCloneInst = core_clone_CloneU64; + cloneInst = core_clone_CloneU64; } let core_marker_CopyU128 : core_marker_Copy u128 = { - cloneCloneInst = core_clone_CloneU128; + cloneInst = core_clone_CloneU128; } let core_marker_CopyUsize : core_marker_Copy usize = { - cloneCloneInst = core_clone_CloneUsize; + cloneInst = core_clone_CloneUsize; } let core_marker_CopyI8 : core_marker_Copy i8 = { - cloneCloneInst = core_clone_CloneI8; + cloneInst = core_clone_CloneI8; } let core_marker_CopyI16 : core_marker_Copy i16 = { - cloneCloneInst = core_clone_CloneI16; + cloneInst = core_clone_CloneI16; } let core_marker_CopyI32 : core_marker_Copy i32 = { - cloneCloneInst = core_clone_CloneI32; + cloneInst = core_clone_CloneI32; } let core_marker_CopyI64 : core_marker_Copy i64 = { - cloneCloneInst = core_clone_CloneI64; + cloneInst = core_clone_CloneI64; } let core_marker_CopyI128 : core_marker_Copy i128 = { - cloneCloneInst = core_clone_CloneI128; + cloneInst = core_clone_CloneI128; } let core_marker_CopyIsize : core_marker_Copy isize = { - cloneCloneInst = core_clone_CloneIsize; + cloneInst = core_clone_CloneIsize; } (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/fstar/misc/Primitives.fst b/tests/fstar/misc/Primitives.fst index a7a007f1..436c7f73 100644 --- a/tests/fstar/misc/Primitives.fst +++ b/tests/fstar/misc/Primitives.fst @@ -557,55 +557,55 @@ let core_clone_CloneI128 : core_clone_Clone i128 = { } noeq type core_marker_Copy (self : Type0) = { - cloneCloneInst : core_clone_Clone self; + cloneInst : core_clone_Clone self; } let core_marker_CopyU8 : core_marker_Copy u8 = { - cloneCloneInst = core_clone_CloneU8; + cloneInst = core_clone_CloneU8; } let core_marker_CopyU16 : core_marker_Copy u16 = { - cloneCloneInst = core_clone_CloneU16; + cloneInst = core_clone_CloneU16; } let core_marker_CopyU32 : core_marker_Copy u32 = { - cloneCloneInst = core_clone_CloneU32; + cloneInst = core_clone_CloneU32; } let core_marker_CopyU64 : core_marker_Copy u64 = { - cloneCloneInst = core_clone_CloneU64; + cloneInst = core_clone_CloneU64; } let core_marker_CopyU128 : core_marker_Copy u128 = { - cloneCloneInst = core_clone_CloneU128; + cloneInst = core_clone_CloneU128; } let core_marker_CopyUsize : core_marker_Copy usize = { - cloneCloneInst = core_clone_CloneUsize; + cloneInst = core_clone_CloneUsize; } let core_marker_CopyI8 : core_marker_Copy i8 = { - cloneCloneInst = core_clone_CloneI8; + cloneInst = core_clone_CloneI8; } let core_marker_CopyI16 : core_marker_Copy i16 = { - cloneCloneInst = core_clone_CloneI16; + cloneInst = core_clone_CloneI16; } let core_marker_CopyI32 : core_marker_Copy i32 = { - cloneCloneInst = core_clone_CloneI32; + cloneInst = core_clone_CloneI32; } let core_marker_CopyI64 : core_marker_Copy i64 = { - cloneCloneInst = core_clone_CloneI64; + cloneInst = core_clone_CloneI64; } let core_marker_CopyI128 : core_marker_Copy i128 = { - cloneCloneInst = core_clone_CloneI128; + cloneInst = core_clone_CloneI128; } let core_marker_CopyIsize : core_marker_Copy isize = { - cloneCloneInst = core_clone_CloneIsize; + cloneInst = core_clone_CloneIsize; } (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/fstar/rename_attribute/Primitives.fst b/tests/fstar/rename_attribute/Primitives.fst index a7a007f1..436c7f73 100644 --- a/tests/fstar/rename_attribute/Primitives.fst +++ b/tests/fstar/rename_attribute/Primitives.fst @@ -557,55 +557,55 @@ let core_clone_CloneI128 : core_clone_Clone i128 = { } noeq type core_marker_Copy (self : Type0) = { - cloneCloneInst : core_clone_Clone self; + cloneInst : core_clone_Clone self; } let core_marker_CopyU8 : core_marker_Copy u8 = { - cloneCloneInst = core_clone_CloneU8; + cloneInst = core_clone_CloneU8; } let core_marker_CopyU16 : core_marker_Copy u16 = { - cloneCloneInst = core_clone_CloneU16; + cloneInst = core_clone_CloneU16; } let core_marker_CopyU32 : core_marker_Copy u32 = { - cloneCloneInst = core_clone_CloneU32; + cloneInst = core_clone_CloneU32; } let core_marker_CopyU64 : core_marker_Copy u64 = { - cloneCloneInst = core_clone_CloneU64; + cloneInst = core_clone_CloneU64; } let core_marker_CopyU128 : core_marker_Copy u128 = { - cloneCloneInst = core_clone_CloneU128; + cloneInst = core_clone_CloneU128; } let core_marker_CopyUsize : core_marker_Copy usize = { - cloneCloneInst = core_clone_CloneUsize; + cloneInst = core_clone_CloneUsize; } let core_marker_CopyI8 : core_marker_Copy i8 = { - cloneCloneInst = core_clone_CloneI8; + cloneInst = core_clone_CloneI8; } let core_marker_CopyI16 : core_marker_Copy i16 = { - cloneCloneInst = core_clone_CloneI16; + cloneInst = core_clone_CloneI16; } let core_marker_CopyI32 : core_marker_Copy i32 = { - cloneCloneInst = core_clone_CloneI32; + cloneInst = core_clone_CloneI32; } let core_marker_CopyI64 : core_marker_Copy i64 = { - cloneCloneInst = core_clone_CloneI64; + cloneInst = core_clone_CloneI64; } let core_marker_CopyI128 : core_marker_Copy i128 = { - cloneCloneInst = core_clone_CloneI128; + cloneInst = core_clone_CloneI128; } let core_marker_CopyIsize : core_marker_Copy isize = { - cloneCloneInst = core_clone_CloneIsize; + cloneInst = core_clone_CloneIsize; } (** [core::option::{core::option::Option}::unwrap] *) diff --git a/tests/fstar/traits/Primitives.fst b/tests/fstar/traits/Primitives.fst index a7a007f1..436c7f73 100644 --- a/tests/fstar/traits/Primitives.fst +++ b/tests/fstar/traits/Primitives.fst @@ -557,55 +557,55 @@ let core_clone_CloneI128 : core_clone_Clone i128 = { } noeq type core_marker_Copy (self : Type0) = { - cloneCloneInst : core_clone_Clone self; + cloneInst : core_clone_Clone self; } let core_marker_CopyU8 : core_marker_Copy u8 = { - cloneCloneInst = core_clone_CloneU8; + cloneInst = core_clone_CloneU8; } let core_marker_CopyU16 : core_marker_Copy u16 = { - cloneCloneInst = core_clone_CloneU16; + cloneInst = core_clone_CloneU16; } let core_marker_CopyU32 : core_marker_Copy u32 = { - cloneCloneInst = core_clone_CloneU32; + cloneInst = core_clone_CloneU32; } let core_marker_CopyU64 : core_marker_Copy u64 = { - cloneCloneInst = core_clone_CloneU64; + cloneInst = core_clone_CloneU64; } let core_marker_CopyU128 : core_marker_Copy u128 = { - cloneCloneInst = core_clone_CloneU128; + cloneInst = core_clone_CloneU128; } let core_marker_CopyUsize : core_marker_Copy usize = { - cloneCloneInst = core_clone_CloneUsize; + cloneInst = core_clone_CloneUsize; } let core_marker_CopyI8 : core_marker_Copy i8 = { - cloneCloneInst = core_clone_CloneI8; + cloneInst = core_clone_CloneI8; } let core_marker_CopyI16 : core_marker_Copy i16 = { - cloneCloneInst = core_clone_CloneI16; + cloneInst = core_clone_CloneI16; } let core_marker_CopyI32 : core_marker_Copy i32 = { - cloneCloneInst = core_clone_CloneI32; + cloneInst = core_clone_CloneI32; } let core_marker_CopyI64 : core_marker_Copy i64 = { - cloneCloneInst = core_clone_CloneI64; + cloneInst = core_clone_CloneI64; } let core_marker_CopyI128 : core_marker_Copy i128 = { - cloneCloneInst = core_clone_CloneI128; + cloneInst = core_clone_CloneI128; } let core_marker_CopyIsize : core_marker_Copy isize = { - cloneCloneInst = core_clone_CloneIsize; + cloneInst = core_clone_CloneIsize; } (** [core::option::{core::option::Option}::unwrap] *) From 8b48d7d00eacdc692ceba88a9b7b6a8653bfcb43 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Dec 2024 23:53:01 +0000 Subject: [PATCH 24/29] Fix an issue with the F* backend --- src/extract/Extract.ml | 15 +++++++++++-- tests/fstar/betree/Betree.Funs.fst | 33 ++++++++++++++-------------- tests/fstar/demo/Demo.fst | 2 +- tests/fstar/hashmap/Hashmap.Funs.fst | 12 +++++----- tests/fstar/misc/AdtBorrows.fst | 12 +++++----- tests/fstar/misc/Loops.Funs.fst | 8 +++---- tests/fstar/misc/NoNestedBorrows.fst | 10 ++++----- tests/fstar/misc/PoloniusList.fst | 4 ++-- 8 files changed, 54 insertions(+), 42 deletions(-) diff --git a/src/extract/Extract.ml b/src/extract/Extract.ml index 2dfba3bd..2bb39228 100644 --- a/src/extract/Extract.ml +++ b/src/extract/Extract.ml @@ -124,12 +124,19 @@ let extract_adt_g_value (span : Meta.span) else ("(", ")") in F.pp_print_string fmt lb; + (* F* doesn't parse lambdas and tuples the same way as other backends: the + the consequence is that we need to use more parentheses... *) + let inside = + match backend () with + | FStar -> true + | _ -> false + in let ctx = Collections.List.fold_left_link (fun () -> F.pp_print_string fmt ","; F.pp_print_space fmt ()) - (fun ctx v -> extract_value ctx false v) + (fun ctx v -> extract_value ctx inside v) ctx field_values in F.pp_print_string fmt rb; @@ -773,7 +780,11 @@ and extract_Lambda (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (* Print the lambda - note that there should always be at least one variable *) sanity_check __FILE__ __LINE__ (xl <> []) span; F.pp_print_string fmt "fun"; - let with_type = backend () = Coq in + let with_type = + match backend () with + | Coq -> true + | _ -> false + in let ctx = List.fold_left (fun ctx x -> diff --git a/tests/fstar/betree/Betree.Funs.fst b/tests/fstar/betree/Betree.Funs.fst index add686dd..d7556f98 100644 --- a/tests/fstar/betree/Betree.Funs.fst +++ b/tests/fstar/betree/Betree.Funs.fst @@ -237,7 +237,7 @@ let rec betree_Node_lookup_first_message_for_key_loop | Betree_List_Cons x next_msgs -> let (i, _) = x in if i >= key - then Ok (msgs, fun ret -> ret) + then Ok (msgs, (fun ret -> ret)) else let* (l, back) = betree_Node_lookup_first_message_for_key_loop key next_msgs in @@ -245,7 +245,7 @@ let rec betree_Node_lookup_first_message_for_key_loop fun ret -> let next_msgs1 = back ret in Betree_List_Cons x next_msgs1 in Ok (l, back1) - | Betree_List_Nil -> Ok (Betree_List_Nil, fun ret -> ret) + | Betree_List_Nil -> Ok (Betree_List_Nil, (fun ret -> ret)) end (** [betree::betree::{betree::betree::Node}#5::lookup_first_message_for_key]: @@ -279,7 +279,8 @@ let rec betree_Node_apply_upserts_loop end else let* v = core_option_Option_unwrap prev in - let* msgs1 = betree_List_push_front msgs (key, Betree_Message_Insert v) in + let* msgs1 = betree_List_push_front msgs (key, (Betree_Message_Insert v)) + in Ok (v, msgs1) (** [betree::betree::{betree::betree::Node}#5::apply_upserts]: @@ -348,10 +349,10 @@ and betree_Node_lookup then let* (st2, (o, node1)) = betree_Internal_lookup_in_children node key st1 in - Ok (st2, (o, Betree_Node_Internal node1)) + Ok (st2, (o, (Betree_Node_Internal node1))) else begin match msg with - | Betree_Message_Insert v -> Ok (st1, (Some v, self)) + | Betree_Message_Insert v -> Ok (st1, ((Some v), self)) | Betree_Message_Delete -> Ok (st1, (None, self)) | Betree_Message_Upsert _ -> let* (st2, (v, node1)) = @@ -359,12 +360,12 @@ and betree_Node_lookup let* (v1, pending1) = betree_Node_apply_upserts pending v key in let msgs1 = lookup_first_message_for_key_back pending1 in let* (st3, _) = betree_store_internal_node node1.id msgs1 st2 in - Ok (st3, (Some v1, Betree_Node_Internal node1)) + Ok (st3, ((Some v1), (Betree_Node_Internal node1))) end | Betree_List_Nil -> let* (st2, (o, node1)) = betree_Internal_lookup_in_children node key st1 in - Ok (st2, (o, Betree_Node_Internal node1)) + Ok (st2, (o, (Betree_Node_Internal node1))) end | Betree_Node_Leaf node -> let* (st1, bindings) = betree_load_leaf_node node.id st in @@ -418,8 +419,8 @@ let rec betree_Node_lookup_first_message_after_key_loop fun ret -> let next_msgs1 = back ret in Betree_List_Cons p next_msgs1 in Ok (l, back1) - else Ok (msgs, fun ret -> ret) - | Betree_List_Nil -> Ok (Betree_List_Nil, fun ret -> ret) + else Ok (msgs, (fun ret -> ret)) + | Betree_List_Nil -> Ok (Betree_List_Nil, (fun ret -> ret)) end (** [betree::betree::{betree::betree::Node}#5::lookup_first_message_after_key]: @@ -460,13 +461,13 @@ let betree_Node_apply_to_internal let* v = betree_upsert_update (Some prev) s in let* (_, msgs2) = betree_List_pop_front msgs1 in let* msgs3 = - betree_List_push_front msgs2 (key, Betree_Message_Insert v) in + betree_List_push_front msgs2 (key, (Betree_Message_Insert v)) in Ok (lookup_first_message_for_key_back msgs3) | Betree_Message_Delete -> let* (_, msgs2) = betree_List_pop_front msgs1 in let* v = betree_upsert_update None s in let* msgs3 = - betree_List_push_front msgs2 (key, Betree_Message_Insert v) in + betree_List_push_front msgs2 (key, (Betree_Message_Insert v)) in Ok (lookup_first_message_for_key_back msgs3) | Betree_Message_Upsert _ -> let* (msgs2, lookup_first_message_after_key_back) = @@ -518,12 +519,12 @@ let rec betree_Node_lookup_mut_in_bindings_loop | Betree_List_Cons hd tl -> let (i, _) = hd in if i >= key - then Ok (bindings, fun ret -> ret) + then Ok (bindings, (fun ret -> ret)) else let* (l, back) = betree_Node_lookup_mut_in_bindings_loop key tl in let back1 = fun ret -> let tl1 = back ret in Betree_List_Cons hd tl1 in Ok (l, back1) - | Betree_List_Nil -> Ok (Betree_List_Nil, fun ret -> ret) + | Betree_List_Nil -> Ok (Betree_List_Nil, (fun ret -> ret)) end (** [betree::betree::{betree::betree::Node}#5::lookup_mut_in_bindings]: @@ -653,7 +654,7 @@ and betree_Node_apply_messages betree_Internal_flush node params node_id_cnt content1 st1 in let (node1, node_id_cnt1) = p in let* (st3, _) = betree_store_internal_node node1.id content2 st2 in - Ok (st3, (Betree_Node_Internal node1, node_id_cnt1)) + Ok (st3, ((Betree_Node_Internal node1), node_id_cnt1)) else let* (st2, _) = betree_store_internal_node node.id content1 st1 in Ok (st2, (self, node_id_cnt)) @@ -667,10 +668,10 @@ and betree_Node_apply_messages let* (st2, (new_node, node_id_cnt1)) = betree_Leaf_split node content1 params node_id_cnt st1 in let* (st3, _) = betree_store_leaf_node node.id Betree_List_Nil st2 in - Ok (st3, (Betree_Node_Internal new_node, node_id_cnt1)) + Ok (st3, ((Betree_Node_Internal new_node), node_id_cnt1)) else let* (st2, _) = betree_store_leaf_node node.id content1 st1 in - Ok (st2, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) + Ok (st2, ((Betree_Node_Leaf { node with size = len }), node_id_cnt)) end (** [betree::betree::{betree::betree::Node}#5::apply]: diff --git a/tests/fstar/demo/Demo.fst b/tests/fstar/demo/Demo.fst index eadc5a41..7ab30398 100644 --- a/tests/fstar/demo/Demo.fst +++ b/tests/fstar/demo/Demo.fst @@ -121,7 +121,7 @@ let rec list_tail let back = fun ret -> let tl1 = list_tail_back ret in CList_CCons x tl1 in Ok (c, back) - | CList_CNil -> Ok (CList_CNil, fun ret -> ret) + | CList_CNil -> Ok (CList_CNil, (fun ret -> ret)) end (** Trait declaration: [demo::Counter] diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index 154dd7b8..de20c093 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -110,11 +110,11 @@ let rec hashMap_insert_in_list_loop begin match ls with | AList_Cons ckey cvalue tl -> if ckey = key - then Ok (false, AList_Cons ckey value tl) + then Ok (false, (AList_Cons ckey value tl)) else let* (b, tl1) = hashMap_insert_in_list_loop key value tl in - Ok (b, AList_Cons ckey cvalue tl1) - | AList_Nil -> Ok (true, AList_Cons key value AList_Nil) + Ok (b, (AList_Cons ckey cvalue tl1)) + | AList_Nil -> Ok (true, (AList_Cons key value AList_Nil)) end (** [hashmap::{hashmap::HashMap}::insert_in_list]: @@ -299,7 +299,7 @@ let rec hashMap_get_mut_in_list_loop fun ret -> let x = begin match ret with | Some x1 -> x1 | _ -> cvalue end in AList_Cons ckey x tl in - Ok (Some cvalue, back) + Ok ((Some cvalue), back) else let* (o, back) = hashMap_get_mut_in_list_loop tl key in let back1 = fun ret -> let tl1 = back ret in AList_Cons ckey cvalue tl1 @@ -349,12 +349,12 @@ let rec hashMap_remove_from_list_loop then let (mv_ls, _) = core_mem_replace ls AList_Nil in begin match mv_ls with - | AList_Cons _ cvalue tl1 -> Ok (Some cvalue, tl1) + | AList_Cons _ cvalue tl1 -> Ok ((Some cvalue), tl1) | AList_Nil -> Fail Failure end else let* (o, tl1) = hashMap_remove_from_list_loop key tl in - Ok (o, AList_Cons ckey x tl1) + Ok (o, (AList_Cons ckey x tl1)) | AList_Nil -> Ok (None, AList_Nil) end diff --git a/tests/fstar/misc/AdtBorrows.fst b/tests/fstar/misc/AdtBorrows.fst index 7c7a58ce..55aa109a 100644 --- a/tests/fstar/misc/AdtBorrows.fst +++ b/tests/fstar/misc/AdtBorrows.fst @@ -79,7 +79,7 @@ type mutWrapper_t (t : Type0) = t Source: 'tests/src/adt-borrows.rs', lines 74:4-76:5 *) let mutWrapper_create (#t : Type0) (x : t) : result ((mutWrapper_t t) & (mutWrapper_t t -> t)) = - Ok (x, fun ret -> ret) + Ok (x, (fun ret -> ret)) (** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::unwrap]: Source: 'tests/src/adt-borrows.rs', lines 78:4-80:5 *) @@ -171,7 +171,7 @@ let array_mut_borrow (#n : usize) (x : array u32 n) : result ((array u32 n) & (array u32 n -> array u32 n)) = - Ok (x, fun ret -> ret) + Ok (x, (fun ret -> ret)) (** [adt_borrows::boxed_slice_shared_borrow]: Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 *) @@ -182,7 +182,7 @@ let boxed_slice_shared_borrow (x : slice u32) : result (slice u32) = Source: 'tests/src/adt-borrows.rs', lines 158:0-160:1 *) let boxed_slice_mut_borrow (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = - Ok (x, fun ret -> ret) + Ok (x, (fun ret -> ret)) (** [adt_borrows::SharedList] Source: 'tests/src/adt-borrows.rs', lines 165:0-168:1 *) @@ -225,7 +225,7 @@ let mutList_push | _ -> (x, self) end in (ml, x1) in - Ok (MutList_Cons x self, back) + Ok ((MutList_Cons x self), back) (** [adt_borrows::{adt_borrows::MutList<'a, T>}#7::pop]: Source: 'tests/src/adt-borrows.rs', lines 196:4-202:5 *) @@ -250,7 +250,7 @@ let wrap_shared_in_option (#t : Type0) (x : t) : result (option t) = let wrap_mut_in_option (#t : Type0) (x : t) : result ((option t) & (option t -> t)) = let back = fun ret -> begin match ret with | Some x1 -> x1 | _ -> x end in - Ok (Some x, back) + Ok ((Some x), back) (** [adt_borrows::List] Source: 'tests/src/adt-borrows.rs', lines 213:0-216:1 *) @@ -289,7 +289,7 @@ let rec nth_mut_loop fun ret -> let x1 = begin match ret with | Some x2 -> x2 | _ -> x end in List_Cons x1 tl in - Ok (Some x, back) + Ok ((Some x), back) else let* i1 = u32_sub i 1 in let* (o, back) = nth_mut_loop tl i1 in diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst index 7ea130bc..af05eb6d 100644 --- a/tests/fstar/misc/Loops.Funs.fst +++ b/tests/fstar/misc/Loops.Funs.fst @@ -214,7 +214,7 @@ let get_elem_shared Source: 'tests/src/loops.rs', lines 149:0-151:1 *) let id_mut (#t : Type0) (ls : list_t t) : result ((list_t t) & (list_t t -> list_t t)) = - Ok (ls, fun ret -> ret) + Ok (ls, (fun ret -> ret)) (** [loops::id_shared]: Source: 'tests/src/loops.rs', lines 153:0-155:1 *) @@ -343,8 +343,8 @@ let rec list_nth_mut_loop_pair_merge_loop if i = 0 then let back = - fun ret -> let (x, x2) = ret in (List_Cons x tl0, List_Cons x2 tl1) - in + fun ret -> + let (x, x2) = ret in ((List_Cons x tl0), (List_Cons x2 tl1)) in Ok ((x0, x1), back) else let* i1 = u32_sub i 1 in @@ -352,7 +352,7 @@ let rec list_nth_mut_loop_pair_merge_loop let back1 = fun ret -> let (tl01, tl11) = back ret in - (List_Cons x0 tl01, List_Cons x1 tl11) in + ((List_Cons x0 tl01), (List_Cons x1 tl11)) in Ok (p, back1) | List_Nil -> Fail Failure end diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index 0b5461e0..45ea814a 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -318,7 +318,7 @@ let id_mut_pair1 (#t1 : Type0) (#t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & ((t1 & t2) -> (t1 & t2))) = - Ok ((x, y), fun ret -> ret) + Ok ((x, y), (fun ret -> ret)) (** [no_nested_borrows::id_mut_pair2]: Source: 'tests/src/no_nested_borrows.rs', lines 351:0-353:1 *) @@ -326,7 +326,7 @@ let id_mut_pair2 (#t1 : Type0) (#t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & ((t1 & t2) -> (t1 & t2))) = - Ok (p, fun ret -> ret) + Ok (p, (fun ret -> ret)) (** [no_nested_borrows::id_mut_pair3]: Source: 'tests/src/no_nested_borrows.rs', lines 355:0-357:1 *) @@ -334,7 +334,7 @@ let id_mut_pair3 (#t1 : Type0) (#t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & (t1 -> t1) & (t2 -> t2)) = - Ok ((x, y), fun ret -> ret, fun ret -> ret) + Ok ((x, y), (fun ret -> ret), (fun ret -> ret)) (** [no_nested_borrows::id_mut_pair4]: Source: 'tests/src/no_nested_borrows.rs', lines 359:0-361:1 *) @@ -342,7 +342,7 @@ let id_mut_pair4 (#t1 : Type0) (#t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & (t1 -> t1) & (t2 -> t2)) = - Ok (p, fun ret -> ret, fun ret -> ret) + Ok (p, (fun ret -> ret), (fun ret -> ret)) (** [no_nested_borrows::StructWithTuple] Source: 'tests/src/no_nested_borrows.rs', lines 366:0-368:1 *) @@ -506,7 +506,7 @@ let borrow_mut_tuple (#t : Type0) (#u : Type0) (x : (t & u)) : result ((t & u) & ((t & u) -> (t & u))) = - Ok (x, fun ret -> ret) + Ok (x, (fun ret -> ret)) (** [no_nested_borrows::ExpandSimpliy::Wrapper] Source: 'tests/src/no_nested_borrows.rs', lines 538:4-538:32 *) diff --git a/tests/fstar/misc/PoloniusList.fst b/tests/fstar/misc/PoloniusList.fst index e5cb3e29..28e3e80a 100644 --- a/tests/fstar/misc/PoloniusList.fst +++ b/tests/fstar/misc/PoloniusList.fst @@ -20,12 +20,12 @@ let rec get_list_at_x begin match ls with | List_Cons hd tl -> if hd = x - then Ok (ls, fun ret -> ret) + then Ok (ls, (fun ret -> ret)) else let* (l, get_list_at_x_back) = get_list_at_x tl x in let back = fun ret -> let tl1 = get_list_at_x_back ret in List_Cons hd tl1 in Ok (l, back) - | List_Nil -> Ok (List_Nil, fun ret -> ret) + | List_Nil -> Ok (List_Nil, (fun ret -> ret)) end From fbee76f6530f9480c8e9d764a9bf9d26d462f7f4 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 18 Dec 2024 09:40:02 +0000 Subject: [PATCH 25/29] Fix some inariant checks --- src/interp/Invariants.ml | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/interp/Invariants.ml b/src/interp/Invariants.ml index 4d179608..22fc05da 100644 --- a/src/interp/Invariants.ml +++ b/src/interp/Invariants.ml @@ -839,15 +839,6 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = sanity_check __FILE__ __LINE__ (info.env_count = 0 || info.aproj_borrows = []) span; - (* A symbolic value containing borrows can't be duplicated (i.e., copied): - * it must be expanded first *) - if ty_has_borrows (Some span) ctx.type_ctx.type_infos info.ty then - sanity_check __FILE__ __LINE__ (info.env_count <= 1) span; - (* A duplicated symbolic value is necessarily copyable *) - sanity_check __FILE__ __LINE__ - (info.env_count <= 1 || ty_is_copyable info.ty) - span; - sanity_check __FILE__ __LINE__ (info.aproj_borrows = [] || info.aproj_loans <> []) span; From 9b8d403bbdf344dff93b2fb9c3c0bcb85ed851b3 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 18 Dec 2024 09:40:12 +0000 Subject: [PATCH 26/29] Reformat the test files --- tests/src/adt-borrows.rs | 4 ++-- tests/src/hashmap.rs | 22 +++++++++++----------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/tests/src/adt-borrows.rs b/tests/src/adt-borrows.rs index f1c4da8f..1543064e 100644 --- a/tests/src/adt-borrows.rs +++ b/tests/src/adt-borrows.rs @@ -151,11 +151,11 @@ fn array_mut_borrow<'a, const N: usize>(x: [&'a mut u32; N]) -> [&'a mut u32; N] x } -fn boxed_slice_shared_borrow(x : Box<[&u32]>) -> Box<[&u32]> { +fn boxed_slice_shared_borrow(x: Box<[&u32]>) -> Box<[&u32]> { x } -fn boxed_slice_mut_borrow(x : Box<[&mut u32]>) -> Box<[&mut u32]> { +fn boxed_slice_mut_borrow(x: Box<[&mut u32]>) -> Box<[&mut u32]> { x } diff --git a/tests/src/hashmap.rs b/tests/src/hashmap.rs index 81656fc2..e3017eae 100644 --- a/tests/src/hashmap.rs +++ b/tests/src/hashmap.rs @@ -44,8 +44,8 @@ pub fn hash_key(k: &Key) -> Hash { #[derive(Clone, Copy)] struct Fraction { - dividend : usize, - divisor : usize, + dividend: usize, + divisor: usize, } /// A hash map from [u64] to values @@ -75,10 +75,7 @@ impl HashMap { } /// Create a new table, with a given capacity - fn new_with_capacity( - capacity: usize, - max_load_factor : Fraction, - ) -> Self { + fn new_with_capacity(capacity: usize, max_load_factor: Fraction) -> Self { // TODO: better to use `Vec::with_capacity(capacity)` instead // of `Vec::new()` let slots = HashMap::allocate_slots(Vec::new(), capacity); @@ -93,7 +90,13 @@ impl HashMap { pub fn new() -> Self { // For now we create a table with 32 slots and a max load factor of 4/5 - HashMap::new_with_capacity(32, Fraction {dividend: 4, divisor:5}) + HashMap::new_with_capacity( + 32, + Fraction { + dividend: 4, + divisor: 5, + }, + ) } pub fn clear(&mut self) { @@ -164,10 +167,7 @@ impl HashMap { let n1 = max_usize / 2; if capacity <= n1 / self.max_load_factor.dividend { // Create a new table with a higher capacity - let mut ntable = HashMap::new_with_capacity( - capacity * 2, - self.max_load_factor, - ); + let mut ntable = HashMap::new_with_capacity(capacity * 2, self.max_load_factor); // Move the elements to the new table HashMap::move_elements(&mut ntable, &mut self.slots); From f3e630745ea929c009fb00fa0f00ce0e3670cf18 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 18 Dec 2024 10:09:34 +0000 Subject: [PATCH 27/29] Cleanup a bit --- src/interp/Interpreter.ml | 1 - src/interp/InterpreterStatements.ml | 26 ++++-------- src/interp/InterpreterUtils.ml | 65 +++++++++++++---------------- 3 files changed, 37 insertions(+), 55 deletions(-) diff --git a/src/interp/Interpreter.ml b/src/interp/Interpreter.ml index 06ce858b..6c634bd2 100644 --- a/src/interp/Interpreter.ml +++ b/src/interp/Interpreter.ml @@ -9,7 +9,6 @@ open TypesUtils open Values open LlbcAst open Contexts -open SynthesizeSymbolic open Errors module SA = SymbolicAst diff --git a/src/interp/InterpreterStatements.ml b/src/interp/InterpreterStatements.ml index 19d10d8e..79275eb5 100644 --- a/src/interp/InterpreterStatements.ml +++ b/src/interp/InterpreterStatements.ml @@ -644,7 +644,6 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) * generic_args * (generic_args * trait_instance_id) option * fun_decl - * region_var_groups * inst_fun_sig = match call.func with | FnOpMove _ -> @@ -670,7 +669,7 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) instantiate_fun_sig span ctx func.generics tr_self def.signature regions_hierarchy in - (func.func, func.generics, None, def, regions_hierarchy, inst_sg) + (func.func, func.generics, None, def, inst_sg) | FunId (FBuiltin _) -> (* Unreachable: must be a transparent function *) craise __FILE__ __LINE__ span "Unreachable" @@ -728,12 +727,7 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) we also need to update the generics. *) let func = FunId fid in - ( func, - generics, - Some (generics, tr_self), - method_def, - regions_hierarchy, - inst_sg ) + (func, generics, Some (generics, tr_self), method_def, inst_sg) | None -> (* If not found, lookup the methods provided by the trait *declaration* (remember: for now, we forbid overriding provided methods) *) @@ -788,7 +782,6 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) func.generics, Some (all_generics, tr_self), method_def, - regions_hierarchy, inst_sg )) | _ -> (* We are using a local clause - we lookup the trait decl *) @@ -825,7 +818,6 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) func.generics, Some (generics, tr_self), method_def, - regions_hierarchy, inst_sg ))) (** Helper: introduce a fresh symbolic value for a global *) @@ -1345,7 +1337,7 @@ and eval_transparent_function_call_concrete (config : config) (span : Meta.span) and eval_transparent_function_call_symbolic (config : config) (span : Meta.span) (call : call) : stl_cm_fun = fun ctx -> - let func, generics, trait_method_generics, def, regions_hierarchy, inst_sg = + let func, generics, trait_method_generics, def, inst_sg = eval_transparent_function_call_symbolic_inst span call ctx in (* Sanity check: same number of inputs *) @@ -1361,8 +1353,7 @@ and eval_transparent_function_call_symbolic (config : config) (span : Meta.span) span "Nested borrows are not supported yet"; (* Evaluate the function call *) eval_function_call_symbolic_from_inst_sig config def.item_meta.span func - def.signature regions_hierarchy inst_sg generics trait_method_generics - call.args call.dest ctx + def.signature inst_sg generics trait_method_generics call.args call.dest ctx (** Evaluate a function call in symbolic mode by using the function signature. @@ -1377,8 +1368,7 @@ and eval_transparent_function_call_symbolic (config : config) (span : Meta.span) *) and eval_function_call_symbolic_from_inst_sig (config : config) (span : Meta.span) (fid : fun_id_or_trait_method_ref) (sg : fun_sig) - (regions_hierarchy : region_var_groups) (inst_sg : inst_fun_sig) - (generics : generic_args) + (inst_sg : inst_fun_sig) (generics : generic_args) (trait_method_generics : (generic_args * trait_instance_id) option) (args : operand list) (dest : place) : stl_cm_fun = fun ctx -> @@ -1550,7 +1540,7 @@ and eval_builtin_function_call_symbolic (config : config) (span : Meta.span) (* As we allow instantiating type parameters with types containing regions, we have to recompute the regions hierarchy. *) let fun_name = Print.Expressions.builtin_fun_id_to_string fid in - let regions_hierarchy, inst_sig = + let inst_sig = compute_regions_hierarchy_for_fun_call (Some span) ctx.type_ctx.type_decls ctx.fun_ctx.fun_decls ctx.global_ctx.global_decls ctx.trait_decls_ctx.trait_decls ctx.trait_impls_ctx.trait_impls fun_name @@ -1563,7 +1553,7 @@ and eval_builtin_function_call_symbolic (config : config) (span : Meta.span) (* Evaluate the function call *) eval_function_call_symbolic_from_inst_sig config span (FunId (FBuiltin fid)) - sg regions_hierarchy inst_sig func.generics None args dest ctx + sg inst_sig func.generics None args dest ctx end else begin (* Sanity check: make sure the type parameters don't contain regions - @@ -1590,7 +1580,7 @@ and eval_builtin_function_call_symbolic (config : config) (span : Meta.span) (* Evaluate the function call *) eval_function_call_symbolic_from_inst_sig config span (FunId (FBuiltin fid)) - sg regions_hierarchy inst_sig func.generics None args dest ctx + sg inst_sig func.generics None args dest ctx end (** Evaluate a statement seen as a function body *) diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index 8a10394d..8d3111b3 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -575,8 +575,7 @@ let compute_regions_hierarchy_for_fun_call (span : Meta.span option) (trait_decls : trait_decl TraitDeclId.Map.t) (trait_impls : trait_impl TraitImplId.Map.t) (fun_name : string) (type_vars : type_var list) (const_generic_vars : const_generic_var list) - (generic_args : generic_args) (sg : fun_sig) : - region_var_groups * inst_fun_sig = + (generic_args : generic_args) (sg : fun_sig) : inst_fun_sig = (* We simply put everything into a "fake" signature, then call [compute_regions_hierarchy_for_sig]. @@ -710,38 +709,32 @@ let compute_regions_hierarchy_for_fun_call (span : Meta.span option) (generics.trait_type_constraints, regions_hierarchy) in - let inst_sig = - (* Generate fresh abstraction ids and create a substitution from region - group ids to abstraction ids. - - Remark: the region ids used here are fresh (we generated them - just above). - *) - let asubst_map : AbstractionId.id RegionGroupId.Map.t = - RegionGroupId.Map.of_list - (List.map - (fun rg -> (rg.id, fresh_abstraction_id ())) - regions_hierarchy) - in - let asubst (rg_id : RegionGroupId.id) : AbstractionId.id = - RegionGroupId.Map.find rg_id asubst_map - in - let subst_abs_region_group (rg : region_var_group) : abs_region_group = - let id = asubst rg.id in - let parents = List.map asubst rg.parents in - ({ id; regions = rg.regions; parents } : abs_region_group) - in - let abs_regions_hierarchy = - List.map subst_abs_region_group regions_hierarchy - in - { - regions_hierarchy; - abs_regions_hierarchy; - trait_type_constraints; - inputs; - output; - } - in - (* Compute the instantiated function signature *) - (regions_hierarchy, inst_sig) + (* Generate fresh abstraction ids and create a substitution from region + group ids to abstraction ids. + + Remark: the region ids used here are fresh (we generated them + just above). + *) + let asubst_map : AbstractionId.id RegionGroupId.Map.t = + RegionGroupId.Map.of_list + (List.map (fun rg -> (rg.id, fresh_abstraction_id ())) regions_hierarchy) + in + let asubst (rg_id : RegionGroupId.id) : AbstractionId.id = + RegionGroupId.Map.find rg_id asubst_map + in + let subst_abs_region_group (rg : region_var_group) : abs_region_group = + let id = asubst rg.id in + let parents = List.map asubst rg.parents in + ({ id; regions = rg.regions; parents } : abs_region_group) + in + let abs_regions_hierarchy = + List.map subst_abs_region_group regions_hierarchy + in + { + regions_hierarchy; + abs_regions_hierarchy; + trait_type_constraints; + inputs; + output; + } From 692f61352a1ddafabea6fe9c29f39b4272362238 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 18 Dec 2024 10:09:40 +0000 Subject: [PATCH 28/29] Regenerate the tests --- tests/coq/hashmap/Hashmap_Funs.v | 20 +++++++++---------- .../hashmap/Hashmap.Clauses.Template.fst | 4 ++-- tests/fstar/hashmap/Hashmap.Funs.fst | 20 +++++++++---------- tests/lean/Hashmap/Funs.lean | 20 +++++++++---------- 4 files changed, 32 insertions(+), 32 deletions(-) diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index aa262c08..f43624b9 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -64,7 +64,7 @@ Definition hashMap_allocate_slots . (** [hashmap::{hashmap::HashMap}::new_with_capacity]: - Source: 'tests/src/hashmap.rs', lines 78:4-92:5 *) + Source: 'tests/src/hashmap.rs', lines 78:4-89:5 *) Definition hashMap_new_with_capacity (T : Type) (n : nat) (capacity : usize) (max_load_factor : Fraction_t) : result (HashMap_t T) @@ -83,14 +83,14 @@ Definition hashMap_new_with_capacity . (** [hashmap::{hashmap::HashMap}::new]: - Source: 'tests/src/hashmap.rs', lines 94:4-97:5 *) + Source: 'tests/src/hashmap.rs', lines 91:4-100:5 *) Definition hashMap_new (T : Type) (n : nat) : result (HashMap_t T) := hashMap_new_with_capacity T n 32%usize {| fraction_dividend := 4%usize; fraction_divisor := 5%usize |} . (** [hashmap::{hashmap::HashMap}::clear]: loop 0: - Source: 'tests/src/hashmap.rs', lines 103:8-106:9 *) + Source: 'tests/src/hashmap.rs', lines 106:8-109:9 *) Fixpoint hashMap_clear_loop {T : Type} (n : nat) (slots : alloc_vec_Vec (AList_t T)) (i : usize) : result (alloc_vec_Vec (AList_t T)) @@ -113,7 +113,7 @@ Fixpoint hashMap_clear_loop . (** [hashmap::{hashmap::HashMap}::clear]: - Source: 'tests/src/hashmap.rs', lines 99:4-107:5 *) + Source: 'tests/src/hashmap.rs', lines 102:4-110:5 *) Definition hashMap_clear {T : Type} (n : nat) (self : HashMap_t T) : result (HashMap_t T) := hm <- hashMap_clear_loop n self.(hashMap_slots) 0%usize; @@ -128,13 +128,13 @@ Definition hashMap_clear . (** [hashmap::{hashmap::HashMap}::len]: - Source: 'tests/src/hashmap.rs', lines 109:4-111:5 *) + Source: 'tests/src/hashmap.rs', lines 112:4-114:5 *) Definition hashMap_len {T : Type} (self : HashMap_t T) : result usize := Ok self.(hashMap_num_entries) . (** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-132:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-135:9 *) Fixpoint hashMap_insert_in_list_loop {T : Type} (n : nat) (key : usize) (value : T) (ls : AList_t T) : result (bool * (AList_t T)) @@ -156,7 +156,7 @@ Fixpoint hashMap_insert_in_list_loop . (** [hashmap::{hashmap::HashMap}::insert_in_list]: - Source: 'tests/src/hashmap.rs', lines 116:4-133:5 *) + Source: 'tests/src/hashmap.rs', lines 119:4-136:5 *) Definition hashMap_insert_in_list {T : Type} (n : nat) (key : usize) (value : T) (ls : AList_t T) : result (bool * (AList_t T)) @@ -165,7 +165,7 @@ Definition hashMap_insert_in_list . (** [hashmap::{hashmap::HashMap}::insert_no_resize]: - Source: 'tests/src/hashmap.rs', lines 136:4-144:5 *) + Source: 'tests/src/hashmap.rs', lines 139:4-147:5 *) Definition hashMap_insert_no_resize {T : Type} (n : nat) (self : HashMap_t T) (key : usize) (value : T) : result (HashMap_t T) @@ -267,7 +267,7 @@ Definition hashMap_move_elements . (** [hashmap::{hashmap::HashMap}::try_resize]: - Source: 'tests/src/hashmap.rs', lines 159:4-181:5 *) + Source: 'tests/src/hashmap.rs', lines 162:4-181:5 *) Definition hashMap_try_resize {T : Type} (n : nat) (self : HashMap_t T) : result (HashMap_t T) := let capacity := alloc_vec_Vec_len self.(hashMap_slots) in @@ -299,7 +299,7 @@ Definition hashMap_try_resize . (** [hashmap::{hashmap::HashMap}::insert]: - Source: 'tests/src/hashmap.rs', lines 148:4-155:5 *) + Source: 'tests/src/hashmap.rs', lines 151:4-158:5 *) Definition hashMap_insert {T : Type} (n : nat) (self : HashMap_t T) (key : usize) (value : T) : result (HashMap_t T) diff --git a/tests/fstar/hashmap/Hashmap.Clauses.Template.fst b/tests/fstar/hashmap/Hashmap.Clauses.Template.fst index bb23295b..01ab4e12 100644 --- a/tests/fstar/hashmap/Hashmap.Clauses.Template.fst +++ b/tests/fstar/hashmap/Hashmap.Clauses.Template.fst @@ -14,14 +14,14 @@ let hashMap_allocate_slots_loop_decreases (#t : Type0) admit () (** [hashmap::{hashmap::HashMap}::clear]: decreases clause - Source: 'tests/src/hashmap.rs', lines 103:8-106:9 *) + Source: 'tests/src/hashmap.rs', lines 106:8-109:9 *) unfold let hashMap_clear_loop_decreases (#t : Type0) (slots : alloc_vec_Vec (aList_t t)) (i : usize) : nat = admit () (** [hashmap::{hashmap::HashMap}::insert_in_list]: decreases clause - Source: 'tests/src/hashmap.rs', lines 1:0-132:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-135:9 *) unfold let hashMap_insert_in_list_loop_decreases (#t : Type0) (key : usize) (value : t) (ls : aList_t t) : nat = diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index de20c093..217d3a68 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -53,7 +53,7 @@ let hashMap_allocate_slots hashMap_allocate_slots_loop slots n (** [hashmap::{hashmap::HashMap}::new_with_capacity]: - Source: 'tests/src/hashmap.rs', lines 78:4-92:5 *) + Source: 'tests/src/hashmap.rs', lines 78:4-89:5 *) let hashMap_new_with_capacity (t : Type0) (capacity : usize) (max_load_factor : fraction_t) : result (hashMap_t t) @@ -67,12 +67,12 @@ let hashMap_new_with_capacity } (** [hashmap::{hashmap::HashMap}::new]: - Source: 'tests/src/hashmap.rs', lines 94:4-97:5 *) + Source: 'tests/src/hashmap.rs', lines 91:4-100:5 *) let hashMap_new (t : Type0) : result (hashMap_t t) = hashMap_new_with_capacity t 32 { dividend = 4; divisor = 5 } (** [hashmap::{hashmap::HashMap}::clear]: loop 0: - Source: 'tests/src/hashmap.rs', lines 103:8-106:9 *) + Source: 'tests/src/hashmap.rs', lines 106:8-109:9 *) let rec hashMap_clear_loop (#t : Type0) (slots : alloc_vec_Vec (aList_t t)) (i : usize) : Tot (result (alloc_vec_Vec (aList_t t))) @@ -90,18 +90,18 @@ let rec hashMap_clear_loop else Ok slots (** [hashmap::{hashmap::HashMap}::clear]: - Source: 'tests/src/hashmap.rs', lines 99:4-107:5 *) + Source: 'tests/src/hashmap.rs', lines 102:4-110:5 *) let hashMap_clear (#t : Type0) (self : hashMap_t t) : result (hashMap_t t) = let* hm = hashMap_clear_loop self.slots 0 in Ok { self with num_entries = 0; slots = hm } (** [hashmap::{hashmap::HashMap}::len]: - Source: 'tests/src/hashmap.rs', lines 109:4-111:5 *) + Source: 'tests/src/hashmap.rs', lines 112:4-114:5 *) let hashMap_len (#t : Type0) (self : hashMap_t t) : result usize = Ok self.num_entries (** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-132:9 *) + Source: 'tests/src/hashmap.rs', lines 1:0-135:9 *) let rec hashMap_insert_in_list_loop (#t : Type0) (key : usize) (value : t) (ls : aList_t t) : Tot (result (bool & (aList_t t))) @@ -118,7 +118,7 @@ let rec hashMap_insert_in_list_loop end (** [hashmap::{hashmap::HashMap}::insert_in_list]: - Source: 'tests/src/hashmap.rs', lines 116:4-133:5 *) + Source: 'tests/src/hashmap.rs', lines 119:4-136:5 *) let hashMap_insert_in_list (#t : Type0) (key : usize) (value : t) (ls : aList_t t) : result (bool & (aList_t t)) @@ -126,7 +126,7 @@ let hashMap_insert_in_list hashMap_insert_in_list_loop key value ls (** [hashmap::{hashmap::HashMap}::insert_no_resize]: - Source: 'tests/src/hashmap.rs', lines 136:4-144:5 *) + Source: 'tests/src/hashmap.rs', lines 139:4-147:5 *) let hashMap_insert_no_resize (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : result (hashMap_t t) @@ -195,7 +195,7 @@ let hashMap_move_elements hashMap_move_elements_loop ntable slots 0 (** [hashmap::{hashmap::HashMap}::try_resize]: - Source: 'tests/src/hashmap.rs', lines 159:4-181:5 *) + Source: 'tests/src/hashmap.rs', lines 162:4-181:5 *) let hashMap_try_resize (#t : Type0) (self : hashMap_t t) : result (hashMap_t t) = let capacity = alloc_vec_Vec_len self.slots in @@ -211,7 +211,7 @@ let hashMap_try_resize else Ok { self with saturated = true } (** [hashmap::{hashmap::HashMap}::insert]: - Source: 'tests/src/hashmap.rs', lines 148:4-155:5 *) + Source: 'tests/src/hashmap.rs', lines 151:4-158:5 *) let hashMap_insert (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : result (hashMap_t t) diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 0f312e73..64340990 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -58,7 +58,7 @@ def HashMap.allocate_slots HashMap.allocate_slots_loop slots n /- [hashmap::{hashmap::HashMap}::new_with_capacity]: - Source: 'tests/src/hashmap.rs', lines 78:4-92:5 -/ + Source: 'tests/src/hashmap.rs', lines 78:4-89:5 -/ def HashMap.new_with_capacity (T : Type) (capacity : Usize) (max_load_factor : Fraction) : Result (HashMap T) @@ -77,13 +77,13 @@ def HashMap.new_with_capacity } /- [hashmap::{hashmap::HashMap}::new]: - Source: 'tests/src/hashmap.rs', lines 94:4-97:5 -/ + Source: 'tests/src/hashmap.rs', lines 91:4-100:5 -/ def HashMap.new (T : Type) : Result (HashMap T) := HashMap.new_with_capacity T 32#usize { dividend := 4#usize, divisor := 5#usize } /- [hashmap::{hashmap::HashMap}::clear]: loop 0: - Source: 'tests/src/hashmap.rs', lines 103:8-106:9 -/ + Source: 'tests/src/hashmap.rs', lines 106:8-109:9 -/ divergent def HashMap.clear_loop {T : Type} (slots : alloc.vec.Vec (AList T)) (i : Usize) : Result (alloc.vec.Vec (AList T)) @@ -101,19 +101,19 @@ divergent def HashMap.clear_loop else Result.ok slots /- [hashmap::{hashmap::HashMap}::clear]: - Source: 'tests/src/hashmap.rs', lines 99:4-107:5 -/ + Source: 'tests/src/hashmap.rs', lines 102:4-110:5 -/ def HashMap.clear {T : Type} (self : HashMap T) : Result (HashMap T) := do let hm ← HashMap.clear_loop self.slots 0#usize Result.ok { self with num_entries := 0#usize, slots := hm } /- [hashmap::{hashmap::HashMap}::len]: - Source: 'tests/src/hashmap.rs', lines 109:4-111:5 -/ + Source: 'tests/src/hashmap.rs', lines 112:4-114:5 -/ def HashMap.len {T : Type} (self : HashMap T) : Result Usize := Result.ok self.num_entries /- [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: - Source: 'tests/src/hashmap.rs', lines 1:0-132:9 -/ + Source: 'tests/src/hashmap.rs', lines 1:0-135:9 -/ divergent def HashMap.insert_in_list_loop {T : Type} (key : Usize) (value : T) (ls : AList T) : Result (Bool × (AList T)) @@ -129,7 +129,7 @@ divergent def HashMap.insert_in_list_loop | AList.Nil => Result.ok (true, AList.Cons key value AList.Nil) /- [hashmap::{hashmap::HashMap}::insert_in_list]: - Source: 'tests/src/hashmap.rs', lines 116:4-133:5 -/ + Source: 'tests/src/hashmap.rs', lines 119:4-136:5 -/ @[reducible] def HashMap.insert_in_list {T : Type} (key : Usize) (value : T) (ls : AList T) : @@ -138,7 +138,7 @@ def HashMap.insert_in_list HashMap.insert_in_list_loop key value ls /- [hashmap::{hashmap::HashMap}::insert_no_resize]: - Source: 'tests/src/hashmap.rs', lines 136:4-144:5 -/ + Source: 'tests/src/hashmap.rs', lines 139:4-147:5 -/ def HashMap.insert_no_resize {T : Type} (self : HashMap T) (key : Usize) (value : T) : Result (HashMap T) @@ -208,7 +208,7 @@ def HashMap.move_elements HashMap.move_elements_loop ntable slots 0#usize /- [hashmap::{hashmap::HashMap}::try_resize]: - Source: 'tests/src/hashmap.rs', lines 159:4-181:5 -/ + Source: 'tests/src/hashmap.rs', lines 162:4-181:5 -/ def HashMap.try_resize {T : Type} (self : HashMap T) : Result (HashMap T) := do let capacity := alloc.vec.Vec.len self.slots @@ -226,7 +226,7 @@ def HashMap.try_resize {T : Type} (self : HashMap T) : Result (HashMap T) := else Result.ok { self with saturated := true } /- [hashmap::{hashmap::HashMap}::insert]: - Source: 'tests/src/hashmap.rs', lines 148:4-155:5 -/ + Source: 'tests/src/hashmap.rs', lines 151:4-158:5 -/ def HashMap.insert {T : Type} (self : HashMap T) (key : Usize) (value : T) : Result (HashMap T) From 847776f80460b69b38f0995f80475446e96421f3 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 18 Dec 2024 10:14:45 +0000 Subject: [PATCH 29/29] Make the treatment of Box::new in SymbolicToPure more general --- src/symbolic/SymbolicToPure.ml | 75 +++++++++++++++------------------- 1 file changed, 34 insertions(+), 41 deletions(-) diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index d1d11166..edc6721b 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -2859,7 +2859,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let dest_mplace = translate_opt_mplace call.dest_place in (* Retrieve the function id, and register the function call in the context if necessary. *) - let ctx, fun_id, effect_info, args, dest_v, finish_next_e = + let ctx, fun_id, effect_info, args, back_funs, dest_v = match call.call_id with | S.Fun (fid, call_id) -> (* Regular function call *) @@ -2974,32 +2974,6 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in (ctx, dsg.fwd_info.ignore_output, Some back_funs_map, back_funs) in - (* This is a **hack** for [Box::new]: introduce backward functions - which are the identity if we instantiated [Box::new] with types - containing mutable borrows. - TODO: make this general. - *) - let ctx, back_funs, finish_next_e = - match fid with - | FunId (FBuiltin BoxNew) -> - let ctx, back_funs_bodies = - List.fold_left_map - (fun ctx (f : typed_pattern) -> - let ty, _ = dest_arrow_ty ctx.span f.ty in - let ctx, v = fresh_var (Some "back") ty ctx in - let pat = mk_typed_pattern_from_var v None in - (ctx, mk_lambda pat (mk_texpression_from_var v))) - ctx back_funs - in - let back_funs = List.combine back_funs back_funs_bodies in - let finish_next_e = - List.fold_right - (fun (pat, bound) next -> mk_let false pat bound next) - back_funs - in - (ctx, [], finish_next_e) - | _ -> (ctx, back_funs, fun e -> e) - 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 @@ -3027,7 +3001,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx = bs_ctx_register_forward_call call_id call args back_funs_map ctx in - (ctx, func, effect_info, args, dest, finish_next_e) + (ctx, func, effect_info, args, back_funs, dest) | S.Unop E.Not -> ( match args with | [ arg ] -> @@ -3049,7 +3023,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in 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 ty), effect_info, args, dest, fun e -> e) + (ctx, Unop (Not ty), effect_info, args, [], dest) | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") | S.Unop E.Neg -> ( match args with @@ -3068,7 +3042,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in 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, fun e -> e) + (ctx, Unop (Neg int_ty), effect_info, args, [], dest) | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") | S.Unop (E.Cast cast_kind) -> begin match cast_kind with @@ -3085,12 +3059,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in 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, - fun e -> e ) + (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, [], dest) | CastFnPtr _ -> craise __FILE__ __LINE__ ctx.span "TODO: function casts" | CastUnsize _ -> @@ -3120,7 +3089,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in 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, fun e -> e) + (ctx, Binop (binop, int_ty0), effect_info, args, [], dest) | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") in let func = { id = FunOrOp fun_id; generics } in @@ -3130,13 +3099,37 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in let func_ty = mk_arrows input_tys ret_ty in let func = { e = Qualif func; ty = func_ty } in - let call = mk_apps ctx.span func args in + let call_e = mk_apps ctx.span func args in + (* This is a **hack** for [Box::new]: introduce backward functions + which are the identity if we instantiated [Box::new] with types + containing mutable borrows. + + We simply replace the function call with a tuple: (call to [Box::new], backward functions). + + TODO: make this general. + *) + let ctx, call_e = + match call.call_id with + | S.Fun (FunId (FBuiltin BoxNew), _) -> + let ctx, back_funs_bodies = + List.fold_left_map + (fun ctx (f : typed_pattern) -> + let ty, _ = dest_arrow_ty ctx.span f.ty in + let ctx, v = fresh_var (Some "back") ty ctx in + let pat = mk_typed_pattern_from_var v None in + (ctx, mk_lambda pat (mk_texpression_from_var v))) + ctx back_funs + in + let call_e = + mk_simpl_tuple_texpression ctx.span (call_e :: back_funs_bodies) + in + (ctx, call_e) + | _ -> (ctx, call_e) + in (* Translate the next expression *) let next_e = translate_expression e ctx in - (* TODO: this is a hack for [Box::new]: introduce the backward functions *) - let next_e = finish_next_e next_e in (* Put together *) - mk_let effect_info.can_fail dest_v call next_e + mk_let effect_info.can_fail dest_v call_e next_e and translate_end_abstraction (ectx : C.eval_ctx) (abs : V.abs) (e : S.expression) (ctx : bs_ctx) : texpression =