From 06e56b7fa40946b2bd7367a392ee66fdc15fe500 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 19 Dec 2024 13:00:49 +0000 Subject: [PATCH 01/23] Add CLI options to activate the loggers --- src/Logging.ml | 64 ++++++++++++++++++++++++++++---------------------- src/Main.ml | 25 ++++++++++++++++++++ 2 files changed, 61 insertions(+), 28 deletions(-) diff --git a/src/Logging.ml b/src/Logging.ml index 782da56ec..010d079c9 100644 --- a/src/Logging.ml +++ b/src/Logging.ml @@ -1,86 +1,94 @@ include Charon.Logging +open Collections -(** Below, we create subgloggers for various submodules, so that we can precisely +(** Below, we create loggers for various (sub-)modules, so that we can precisely toggle logging on/off, depending on which information we need *) +let loggers : L.logger StringMap.t ref = ref StringMap.empty + +let create_logger name = + let l = L.get_logger ("MainLogger." ^ name) in + loggers := StringMap.add name l !loggers; + l + (** Logger for Errors *) -let errors_log = L.get_logger "MainLogger.Errors" +let errors_log = create_logger "Errors" (** Logger for PrePasses *) -let pre_passes_log = L.get_logger "MainLogger.PrePasses" +let pre_passes_log = create_logger "PrePasses" (** Logger for RegionsHierarchy *) -let regions_hierarchy_log = L.get_logger "MainLogger.RegionsHierarchy" +let regions_hierarchy_log = create_logger "RegionsHierarchy" (** Logger for Translate *) -let translate_log = L.get_logger "MainLogger.Translate" +let translate_log = create_logger "Translate" (** Logger for BorrowCheck *) -let borrow_check_log = L.get_logger "MainLogger.BorrowCheck" +let borrow_check_log = create_logger "BorrowCheck" (** Logger for Contexts *) -let contexts_log = L.get_logger "MainLogger.Contexts" +let contexts_log = create_logger "Contexts" (** Logger for PureUtils *) -let pure_utils_log = L.get_logger "MainLogger.PureUtils" +let pure_utils_log = create_logger "PureUtils" (** Logger for SymbolicToPure *) -let symbolic_to_pure_log = L.get_logger "MainLogger.SymbolicToPure" +let symbolic_to_pure_log = create_logger "SymbolicToPure" (** Logger for PureMicroPasses *) -let pure_micro_passes_log = L.get_logger "MainLogger.PureMicroPasses" +let pure_micro_passes_log = create_logger "PureMicroPasses" (** Logger for PureMicroPasses.simplify_aggregates_unchanged_fields *) let simplify_aggregates_unchanged_fields_log = - L.get_logger "MainLogger.PureMicroPasses.simplify_aggregates_unchanged_fields" + create_logger "PureMicroPasses.simplify_aggregates_unchanged_fields" (** Logger for ExtractBase *) -let extract_log = L.get_logger "MainLogger.ExtractBase" +let extract_log = create_logger "ExtractBase" (** Logger for ExtractBuiltin *) -let builtin_log = L.get_logger "MainLogger.Builtin" +let builtin_log = create_logger "Builtin" (** Logger for Interpreter *) -let interpreter_log = L.get_logger "MainLogger.Interpreter" +let interpreter_log = create_logger "Interpreter" (** Logger for InterpreterLoopsMatchCtxs *) -let loops_match_ctxs_log = L.get_logger "MainLogger.Interpreter.LoopsMatchCtxs" +let loops_match_ctxs_log = create_logger "Interpreter.LoopsMatchCtxs" (** Logger for InterpreterLoopsJoinCtxs *) -let loops_join_ctxs_log = L.get_logger "MainLogger.Interpreter.LoopsJoinCtxs" +let loops_join_ctxs_log = create_logger "Interpreter.LoopsJoinCtxs" (** Logger for InterpreterLoopsFixedPoint *) -let loops_fixed_point_log = L.get_logger "MainLogger.Interpreter.FixedPoint" +let loops_fixed_point_log = create_logger "Interpreter.FixedPoint" (** Logger for InterpreterLoops *) -let loops_log = L.get_logger "MainLogger.Interpreter.Loops" +let loops_log = create_logger "Interpreter.Loops" (** Logger for InterpreterStatements *) -let statements_log = L.get_logger "MainLogger.Interpreter.Statements" +let statements_log = create_logger "Interpreter.Statements" (** Logger for InterpreterExpressions *) -let expressions_log = L.get_logger "MainLogger.Interpreter.Expressions" +let expressions_log = create_logger "Interpreter.Expressions" (** Logger for InterpreterPaths *) -let paths_log = L.get_logger "MainLogger.Interpreter.Paths" +let paths_log = create_logger "Interpreter.Paths" (** Logger for InterpreterExpansion *) -let expansion_log = L.get_logger "MainLogger.Interpreter.Expansion" +let expansion_log = create_logger "Interpreter.Expansion" (** Logger for InterpreterProjectors *) -let projectors_log = L.get_logger "MainLogger.Interpreter.Projectors" +let projectors_log = create_logger "Interpreter.Projectors" (** Logger for InterpreterBorrows *) -let borrows_log = L.get_logger "MainLogger.Interpreter.Borrows" +let borrows_log = create_logger "Interpreter.Borrows" (** Logger for Invariants *) -let invariants_log = L.get_logger "MainLogger.Interpreter.Invariants" +let invariants_log = create_logger "Interpreter.Invariants" (** Logger for AssociatedTypes *) -let associated_types_log = L.get_logger "MainLogger.AssociatedTypes" +let associated_types_log = create_logger "AssociatedTypes" (** Logger for SCC *) -let scc_log = L.get_logger "MainLogger.Graph.SCC" +let scc_log = create_logger "Graph.SCC" (** Logger for ReorderDecls *) -let reorder_decls_log = L.get_logger "MainLogger.Graph.ReorderDecls" +let reorder_decls_log = create_logger "Graph.ReorderDecls" diff --git a/src/Main.ml b/src/Main.ml index 445c02d8d..dce089a68 100644 --- a/src/Main.ml +++ b/src/Main.ml @@ -88,6 +88,11 @@ let matches_name_with_generics (c : crate) (name : Types.name) in Option.is_some (NameMatcherMap.find_with_generics_opt mctx name generics m) +let activated_loggers : string list ref = ref [] + +let add_activated_logger (name : string) = + activated_loggers := name :: !activated_loggers + let () = (* Measure start time *) let start_time = Unix.gettimeofday () in @@ -168,6 +173,12 @@ let () = Arg.Set print_unknown_externals, " Print all the external definitions which are not listed in the \ builtin functions" ); + ( "-log", + Arg.String add_activated_logger, + " Activate debugging log for a given logger designated by its name. \ + The existing loggers are: {" + ^ String.concat ", " (Collections.StringMap.keys !loggers) + ^ "}" ); ] in @@ -229,6 +240,20 @@ let () = if cond then fail_with_error msg in + (* Activate the loggers *) + List.iter + (fun name -> + match Collections.StringMap.find_opt name !loggers with + | None -> + log#serror + ("The logger '" ^ name + ^ "' does not exist. The existing loggers are: {" + ^ String.concat ", " (Collections.StringMap.keys !loggers) + ^ "}"); + fail false + | Some logger -> logger#set_level EL.Debug) + !activated_loggers; + (* Sanity check (now that the arguments are parsed!) *) check_arg_implies (not !extract_template_decreases_clauses) From 5a72818f753b9e073e370efdd465fb65c08ec065 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 22 Dec 2024 13:54:50 +0100 Subject: [PATCH 02/23] Add markers to projectors over symbolic values and start propagating the changes --- src/Errors.ml | 8 +- src/interp/InterpreterBorrows.ml | 193 +++++++++++++++-------- src/interp/InterpreterBorrowsCore.ml | 107 +++++++++++++ src/interp/InterpreterExpansion.ml | 24 +-- src/interp/InterpreterLoopsCore.ml | 22 ++- src/interp/InterpreterLoopsFixedPoint.ml | 15 -- src/interp/InterpreterLoopsJoinCtxs.ml | 141 +++++++++++++---- src/interp/InterpreterLoopsMatchCtxs.ml | 178 +++++++++++++++------ src/interp/InterpreterProjectors.ml | 2 +- src/interp/InterpreterUtils.ml | 2 +- src/interp/Invariants.ml | 3 +- src/llbc/Print.ml | 2 +- src/llbc/TypesUtils.ml | 52 ++++++ src/llbc/Values.ml | 33 +--- src/llbc/ValuesUtils.ml | 6 + src/symbolic/SymbolicToPure.ml | 21 ++- 16 files changed, 584 insertions(+), 225 deletions(-) diff --git a/src/Errors.ml b/src/Errors.ml index 87bc27d29..3e2e7177b 100644 --- a/src/Errors.ml +++ b/src/Errors.ml @@ -113,8 +113,12 @@ let sanity_check (file : string) (line : int) b span = let sanity_check_opt_span (file : string) (line : int) b span = cassert_opt_span file line b span "Internal error, please file an issue" -let internal_error (file : string) (line : int) span = - craise file line span "Internal error, please file an issue" +let internal_error_opt_span (file : string) (line : int) + (span : Meta.span option) = + craise_opt_span file line span "Internal error, please file an issue" + +let internal_error (file : string) (line : int) (span : Meta.span) = + internal_error_opt_span file line (Some span) let warn_opt_span (file : string) (line : int) (span : Meta.span option) (msg : string) = diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 6dfe59e59..77877d02e 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -1882,12 +1882,28 @@ let destructure_abs (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) we have to end them all and remove the abstraction from the context) *) craise __FILE__ __LINE__ span "Unreachable") - | ASymbolic _ -> - (* For now, we fore all symbolic values containing borrows to be eagerly - expanded *) - sanity_check __FILE__ __LINE__ - (not (ty_has_borrows (Some span) ctx.type_ctx.type_infos ty)) - span + | ASymbolic (_, aproj) -> ( + (* *) + match aproj with + | AProjLoans (_, _, children) -> + (* There can be children in the presence of nested borrows: we + don't handle those for now. *) + sanity_check __FILE__ __LINE__ (children = []) span; + push av + | AProjBorrows (_, _, children) -> + (* For now, we fore all symbolic values containing borrows to be eagerly + expanded *) + (* There can be children in the presence of nested borrows: we + don't handle those for now. *) + sanity_check __FILE__ __LINE__ (children = []) span; + push av + | AEndedProjLoans (_, children) | AEndedProjBorrows (_, children) -> + (* There can be children in the presence of nested borrows: we + don't handle those for now. *) + sanity_check __FILE__ __LINE__ (children = []) span; + (* Just ignore *) + () + | AEmpty -> ()) and list_values (v : typed_value) : typed_avalue list * typed_value = let ty = v.ty in match v.value with @@ -2140,7 +2156,7 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (* Return *) List.rev !absl -type marker_borrow_or_loan_id = +type marked_borrow_or_loan_id = | BorrowId of proj_marker * borrow_id | LoanId of proj_marker * loan_id @@ -2151,12 +2167,12 @@ type g_borrow_content_with_ty = (ety * borrow_content, rty * aborrow_content) concrete_or_abs type merge_abstraction_info = { - loans : MarkerBorrowId.Set.t; - borrows : MarkerBorrowId.Set.t; - borrows_loans : marker_borrow_or_loan_id list; + loans : MarkedBorrowId.Set.t; + borrows : MarkedBorrowId.Set.t; + borrows_loans : marked_borrow_or_loan_id list; (** We use a list to preserve the order in which the borrows were found *) - loan_to_content : g_loan_content_with_ty MarkerBorrowId.Map.t; - borrow_to_content : g_borrow_content_with_ty MarkerBorrowId.Map.t; + loan_to_content : g_loan_content_with_ty MarkedBorrowId.Map.t; + borrow_to_content : g_borrow_content_with_ty MarkedBorrowId.Map.t; } (** Small utility to help merging abstractions. @@ -2173,25 +2189,25 @@ type merge_abstraction_info = { *) let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) (avalues : typed_avalue list) : merge_abstraction_info = - let loans : MarkerBorrowId.Set.t ref = ref MarkerBorrowId.Set.empty in - let borrows : MarkerBorrowId.Set.t ref = ref MarkerBorrowId.Set.empty in - let borrows_loans : marker_borrow_or_loan_id list ref = ref [] in - let loan_to_content : g_loan_content_with_ty MarkerBorrowId.Map.t ref = - ref MarkerBorrowId.Map.empty + let loans : MarkedBorrowId.Set.t ref = ref MarkedBorrowId.Set.empty in + let borrows : MarkedBorrowId.Set.t ref = ref MarkedBorrowId.Set.empty in + let borrows_loans : marked_borrow_or_loan_id list ref = ref [] in + let loan_to_content : g_loan_content_with_ty MarkedBorrowId.Map.t ref = + ref MarkedBorrowId.Map.empty in - let borrow_to_content : g_borrow_content_with_ty MarkerBorrowId.Map.t ref = - ref MarkerBorrowId.Map.empty + let borrow_to_content : g_borrow_content_with_ty MarkedBorrowId.Map.t ref = + ref MarkedBorrowId.Map.empty in let push_loan pm id (lc : g_loan_content_with_ty) : unit = sanity_check __FILE__ __LINE__ - (not (MarkerBorrowId.Set.mem (pm, id) !loans)) + (not (MarkedBorrowId.Set.mem (pm, id) !loans)) span; - loans := MarkerBorrowId.Set.add (pm, id) !loans; + loans := MarkedBorrowId.Set.add (pm, id) !loans; sanity_check __FILE__ __LINE__ - (not (MarkerBorrowId.Map.mem (pm, id) !loan_to_content)) + (not (MarkedBorrowId.Map.mem (pm, id) !loan_to_content)) span; - loan_to_content := MarkerBorrowId.Map.add (pm, id) lc !loan_to_content; + loan_to_content := MarkedBorrowId.Map.add (pm, id) lc !loan_to_content; borrows_loans := LoanId (pm, id) :: !borrows_loans in let push_loans pm ids lc : unit = @@ -2199,13 +2215,13 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) in let push_borrow pm id (bc : g_borrow_content_with_ty) : unit = sanity_check __FILE__ __LINE__ - (not (MarkerBorrowId.Set.mem (pm, id) !borrows)) + (not (MarkedBorrowId.Set.mem (pm, id) !borrows)) span; - borrows := MarkerBorrowId.Set.add (pm, id) !borrows; + borrows := MarkedBorrowId.Set.add (pm, id) !borrows; sanity_check __FILE__ __LINE__ - (not (MarkerBorrowId.Map.mem (pm, id) !borrow_to_content)) + (not (MarkedBorrowId.Map.mem (pm, id) !borrow_to_content)) span; - borrow_to_content := MarkerBorrowId.Map.add (pm, id) bc !borrow_to_content; + borrow_to_content := MarkedBorrowId.Map.add (pm, id) bc !borrow_to_content; borrows_loans := BorrowId (pm, id) :: !borrows_loans in @@ -2510,10 +2526,10 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) borrows_loans1) span; sanity_check __FILE__ __LINE__ - (MarkerBorrowId.Set.disjoint borrows0 borrows1) + (MarkedBorrowId.Set.disjoint borrows0 borrows1) span; sanity_check __FILE__ __LINE__ - (MarkerBorrowId.Set.disjoint loans0 loans1) + (MarkedBorrowId.Set.disjoint loans0 loans1) span); (* Merge. @@ -2536,8 +2552,8 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) Remark: a way of solving this problem would be to destructure shared loans so that they always have exactly one id. *) - let merged_borrows = ref MarkerBorrowId.Set.empty in - let merged_loans = ref MarkerBorrowId.Set.empty in + let merged_borrows = ref MarkedBorrowId.Set.empty in + let merged_loans = ref MarkedBorrowId.Set.empty in let avalues = ref [] in let push_avalue av = log#ldebug @@ -2555,7 +2571,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) (* Compute the intersection of: - the loans coming from the left abstraction - the borrows coming from the right abstraction *) - let intersect = MarkerBorrowId.Set.inter loans0 borrows1 in + let intersect = MarkedBorrowId.Set.inter loans0 borrows1 in (* This function is called when handling shared loans: we have to apply a projection marker to a set of borrow ids. *) @@ -2563,23 +2579,23 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) let bids = BorrowId.Set.to_seq bids |> Seq.map (fun x -> (pm, x)) - |> MarkerBorrowId.Set.of_seq + |> MarkedBorrowId.Set.of_seq in - let bids = MarkerBorrowId.Set.diff bids intersect in - sanity_check __FILE__ __LINE__ (not (MarkerBorrowId.Set.is_empty bids)) span; - MarkerBorrowId.Set.to_seq bids |> Seq.map snd |> BorrowId.Set.of_seq + let bids = MarkedBorrowId.Set.diff bids intersect in + sanity_check __FILE__ __LINE__ (not (MarkedBorrowId.Set.is_empty bids)) span; + MarkedBorrowId.Set.to_seq bids |> Seq.map snd |> BorrowId.Set.of_seq in - let filter_bid (bid : marker_borrow_id) : marker_borrow_id option = - if MarkerBorrowId.Set.mem bid intersect then None else Some bid + let filter_bid (bid : marked_borrow_id) : marked_borrow_id option = + if MarkedBorrowId.Set.mem bid intersect then None else Some bid in - let borrow_is_merged id = MarkerBorrowId.Set.mem id !merged_borrows in + let borrow_is_merged id = MarkedBorrowId.Set.mem id !merged_borrows in let set_borrow_as_merged id = - merged_borrows := MarkerBorrowId.Set.add id !merged_borrows + merged_borrows := MarkedBorrowId.Set.add id !merged_borrows in - let loan_is_merged id = MarkerBorrowId.Set.mem id !merged_loans in + let loan_is_merged id = MarkedBorrowId.Set.mem id !merged_loans in let set_loan_as_merged id = - merged_loans := MarkerBorrowId.Set.add id !merged_loans + merged_loans := MarkedBorrowId.Set.add id !merged_loans in let set_loans_as_merged pm ids = BorrowId.Set.elements ids @@ -2600,7 +2616,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) log#ldebug (lazy ("merge_abstractions: merging borrow " - ^ MarkerBorrowId.to_string bid)); + ^ MarkedBorrowId.to_string bid)); (* Check if the borrow has already been merged - this can happen because we go through all the borrows/loans in [abs0] *then* @@ -2614,8 +2630,8 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) | None -> () | Some bid -> (* Lookup the contents *) - let bc0 = MarkerBorrowId.Map.find_opt bid borrow_to_content0 in - let bc1 = MarkerBorrowId.Map.find_opt bid borrow_to_content1 in + let bc0 = MarkedBorrowId.Map.find_opt bid borrow_to_content0 in + let bc1 = MarkedBorrowId.Map.find_opt bid borrow_to_content1 in (* Merge *) let av : typed_avalue = match (bc0, bc1) with @@ -2651,15 +2667,15 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) log#ldebug (lazy ("merge_abstractions: merging loan " - ^ MarkerBorrowId.to_string bid)); + ^ MarkedBorrowId.to_string bid)); (* Check if we need to filter it *) match filter_bid bid with | None -> () | Some bid -> (* Lookup the contents *) - let lc0 = MarkerBorrowId.Map.find_opt bid loan_to_content0 in - let lc1 = MarkerBorrowId.Map.find_opt bid loan_to_content1 in + let lc0 = MarkedBorrowId.Map.find_opt bid loan_to_content0 in + let lc1 = MarkedBorrowId.Map.find_opt bid loan_to_content1 in (* Merge *) let av : typed_avalue option = match (lc0, lc1) with @@ -2913,7 +2929,7 @@ let merge_abstractions_merge_markers (span : Meta.span) sanity_check __FILE__ __LINE__ (not (borrow_is_merged bid)) span; (* This element has no marker. We do not filter it, hence we retrieve the contents and inject it into the avalues list *) - let bc = MarkerBorrowId.Map.find (PNone, bid) borrow_to_content in + let bc = MarkedBorrowId.Map.find (PNone, bid) borrow_to_content in push_avalue (avalue_from_bc bc); (* Setting the borrow as merged is not really necessary but we do it for consistency, and this allows us to do some sanity checks. *) @@ -2926,10 +2942,10 @@ let merge_abstractions_merge_markers (span : Meta.span) (* Not merged: set it as merged *) set_borrow_as_merged bid; (* Lookup the content of the borrow *) - let bc0 = MarkerBorrowId.Map.find (pm, bid) borrow_to_content in + let bc0 = MarkedBorrowId.Map.find (pm, bid) borrow_to_content in (* Check if there exists the same borrow but with the complementary marker *) let obc1 = - MarkerBorrowId.Map.find_opt + MarkedBorrowId.Map.find_opt (invert_proj_marker pm, bid) borrow_to_content in @@ -2959,7 +2975,7 @@ let merge_abstractions_merge_markers (span : Meta.span) *) if loan_is_merged bid then () else - let lc = MarkerBorrowId.Map.find (PNone, bid) loan_to_content in + let lc = MarkedBorrowId.Map.find (PNone, bid) loan_to_content in push_avalue (avalue_from_lc lc); (* Mark as merged *) let ids = loan_content_to_ids lc in @@ -2970,9 +2986,9 @@ let merge_abstractions_merge_markers (span : Meta.span) loan_is_merged bid then () else - let lc0 = MarkerBorrowId.Map.find (pm, bid) loan_to_content in + let lc0 = MarkedBorrowId.Map.find (pm, bid) loan_to_content in let olc1 = - MarkerBorrowId.Map.find_opt + MarkedBorrowId.Map.find_opt (invert_proj_marker pm, bid) loan_to_content in @@ -3130,14 +3146,23 @@ let merge_into_first_abstraction (span : Meta.span) (abs_kind : abs_kind) let reorder_loans_borrows_in_fresh_abs (span : Meta.span) (allow_markers : bool) (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx = let reorder_in_fresh_abs (abs : abs) : abs = - (* Split between the loans and borrows *) + (* Split between the loans and borrows, and between the concrete + and symbolic values. *) let is_borrow (av : typed_avalue) : bool = match av.value with - | ABorrow _ -> true - | ALoan _ -> false + | ABorrow _ | ASymbolic (_, AProjBorrows _) -> true + | ALoan _ | ASymbolic (_, AProjLoans _) -> false + | _ -> craise __FILE__ __LINE__ span "Unexpected" + in + let is_concrete (av : typed_avalue) : bool = + match av.value with + | ABorrow _ | ALoan _ -> true + | ASymbolic (_, (AProjBorrows _ | AProjLoans _)) -> false | _ -> craise __FILE__ __LINE__ span "Unexpected" in let aborrows, aloans = List.partition is_borrow abs.avalues in + let aborrows, borrow_projs = List.partition is_concrete aborrows in + let aloans, loan_projs = List.partition is_concrete aloans in (* Reoder the borrows, and the loans. @@ -3147,6 +3172,11 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span) (allow_markers : bool) This is actually not as arbitrary as it might seem, because the ids give us the order in which we introduced those borrows/loans. + + We do the same thing for the symbolic values: we use the symbolic ids. + The final order is: + borrows, borrow projectors, loans, loan projectors + (all sorted by increasing id) *) let get_borrow_id (av : typed_avalue) : BorrowId.id = match av.value with @@ -3165,16 +3195,49 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span) (allow_markers : bool) BorrowId.Set.min_elt lids | _ -> craise __FILE__ __LINE__ span "Unexpected" in + let get_symbolic_id (av : typed_avalue) : SymbolicValueId.id = + match av.value with + | ASymbolic (pm, aproj) -> begin + sanity_check __FILE__ __LINE__ (allow_markers || pm = PNone) span; + match aproj with + | AProjLoans (sv, _, _) | AProjBorrows (sv, _, _) -> sv.sv_id + | _ -> craise __FILE__ __LINE__ span "Unexpected" + end + | _ -> craise __FILE__ __LINE__ span "Unexpected" + in + let compare_pair : + 'a. ('a -> 'a -> int) -> 'a * typed_avalue -> 'a * typed_avalue -> int + = + fun compare_id x y -> + let fst = compare_id (fst x) (fst y) in + cassert __FILE__ __LINE__ (fst <> 0) span + ("Unexpected: can't compare: '" + ^ typed_avalue_to_string ctx (snd x) + ^ "' with '" + ^ typed_avalue_to_string ctx (snd y) + ^ "'"); + fst + in (* We use ordered maps to reorder the borrows and loans *) - let reorder (get_bid : typed_avalue -> BorrowId.id) - (values : typed_avalue list) : typed_avalue list = - List.map snd - (BorrowId.Map.bindings - (BorrowId.Map.of_list (List.map (fun v -> (get_bid v, v)) values))) + let reorder : + 'a. + (typed_avalue -> 'a) -> + ('a -> 'a -> int) -> + typed_avalue list -> + typed_avalue list = + fun get_id compare_id values -> + let values = List.map (fun v -> (get_id v, v)) values in + List.map snd (List.stable_sort (compare_pair compare_id) values) + in + let aborrows = reorder get_borrow_id compare_borrow_id aborrows in + let borrow_projs = + reorder get_symbolic_id compare_symbolic_value_id borrow_projs + in + let aloans = reorder get_loan_id compare_borrow_id aloans in + let loan_projs = + reorder get_symbolic_id compare_symbolic_value_id loan_projs in - let aborrows = reorder get_borrow_id aborrows in - let aloans = reorder get_loan_id aloans in - let avalues = List.append aborrows aloans in + let avalues = List.concat [ aborrows; borrow_projs; aloans; loan_projs ] in { abs with avalues } in diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index a9168fefa..3d1faab07 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -1306,3 +1306,110 @@ let lookup_shared_value_opt (span : Meta.span) (ctx : eval_ctx) let lookup_shared_value (span : Meta.span) (ctx : eval_ctx) (bid : BorrowId.id) : typed_value = Option.get (lookup_shared_value_opt span ctx bid) + +(** A marked borrow id *) +type marked_borrow_id = proj_marker * BorrowId.id [@@deriving show, ord] + +module MarkedBorrowIdOrd = struct + type t = marked_borrow_id + + let compare = compare_marked_borrow_id + let to_string = show_marked_borrow_id + let pp_t = pp_marked_borrow_id + let show_t = show_marked_borrow_id +end + +module MarkedBorrowIdSet = Collections.MakeSet (MarkedBorrowIdOrd) +module MarkedBorrowIdMap = Collections.MakeMap (MarkedBorrowIdOrd) + +module MarkedBorrowId : sig + type t + + val to_string : t -> string + + module Set : Collections.Set with type elt = t + module Map : Collections.Map with type key = t +end +with type t = marked_borrow_id = struct + type t = marked_borrow_id + + let to_string = show_marked_borrow_id + + module Set = MarkedBorrowIdSet + module Map = MarkedBorrowIdMap +end + +(** A marked and normalized symbolic value (loan/borrow) projection. + + A normalized symbolic value projection is a projection of a symoblic value for which + the projection type has been normalized in the following way: the projected regions + have the identifier 0, and the non-projected regions are erased. + + For instance, if we consider the region abstractions below: + {[ + abs0 {'a} { s <: S<'a, 'b> } + abs1 {'b} { s <: S<'a, 'b> } + ]} + + Then normalizing (the type of) the symbolic value [s] for ['a] gives [S<'0, '_>], + while normalizing it for ['b] gives [S<'_, '0>]. + + We use normalized types to compare loan/borrow projections of symbolic values, + and for lookups (normalized types can easily be used as keys in maps). + *) +type marked_norm_symb_proj = { + pm : proj_marker; + sv_id : symbolic_value_id; + norm_proj_ty : ty; +} +[@@deriving show, ord] + +module MarkedNormSymbProjOrd = struct + type t = marked_norm_symb_proj + + let compare = compare_marked_norm_symb_proj + let to_string = show_marked_norm_symb_proj + let pp_t = pp_marked_norm_symb_proj + let show_t = show_marked_norm_symb_proj +end + +module MarkedNormSymbProjSet = Collections.MakeSet (MarkedNormSymbProjOrd) +module MarkedNormSymbProjMap = Collections.MakeMap (MarkedNormSymbProjOrd) + +module MarkedNormSymbProj : sig + type t + + val to_string : t -> string + + module Set : Collections.Set with type elt = t + module Map : Collections.Map with type key = t +end +with type t = marked_norm_symb_proj = struct + type t = marked_norm_symb_proj + + let to_string = show_marked_norm_symb_proj + + module Set = MarkedNormSymbProjSet + module Map = MarkedNormSymbProjMap +end + +(** Normalize a projection type by replacing the projected regions with ['0] + and the non-projected ones with ['_]. + + For instance, when normalizing the projection type [S<'a, 'b>] for the + projection region ['a]. + *) +let normalize_proj_ty (regions : RegionId.Set.t) (ty : rty) : rty = + let visitor = + object + inherit [_] map_ty + + method! visit_region _ r = + match r with + | RVar (Free r) -> + if RegionId.Set.mem r regions then RVar (Free (RegionId.of_int 0)) + else RErased + | RVar (Bound _) | RStatic | RErased -> r + end + in + visitor#visit_ty () ty diff --git a/src/interp/InterpreterExpansion.ml b/src/interp/InterpreterExpansion.ml index 8f5fc71b5..ecafa834a 100644 --- a/src/interp/InterpreterExpansion.ml +++ b/src/interp/InterpreterExpansion.ml @@ -84,18 +84,19 @@ let apply_symbolic_expansion_to_target_avalues (config : config) | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj current_abs aproj - method! visit_ASymbolic current_abs aproj = + method! visit_ASymbolic current_abs pm aproj = + sanity_check __FILE__ __LINE__ (pm = PNone) span; let current_abs = Option.get current_abs in let proj_regions = current_abs.regions.owned in let ancestors_regions = current_abs.regions.ancestors in (* Explore in depth first - we won't update anything: we simply * want to check we don't have to expand inner symbolic value *) match (aproj, proj_kind) with - | AEndedProjBorrows _, _ -> ASymbolic aproj + | AEndedProjBorrows _, _ -> ASymbolic (pm, aproj) | AEndedProjLoans _, _ -> (* 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) + ASymbolic (pm, self#visit_aproj (Some current_abs) aproj) | 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 ( @@ -110,7 +111,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) projected_value.value) else (* Not the searched symbolic value: nothing to do *) - super#visit_ASymbolic (Some current_abs) aproj + super#visit_ASymbolic (Some current_abs) pm aproj | 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 @@ -139,12 +140,12 @@ let apply_symbolic_expansion_to_target_avalues (config : config) projected_value.value else (* Not the searched symbolic value: nothing to do *) - super#visit_ASymbolic (Some current_abs) aproj + super#visit_ASymbolic (Some current_abs) pm aproj | AProjLoans _, BorrowProj | AProjBorrows (_, _, _), LoanProj | AEmpty, _ -> (* Nothing to do *) - ASymbolic aproj + ASymbolic (pm, aproj) end in (* Apply the expansion *) @@ -372,13 +373,14 @@ let expand_symbolic_value_shared_borrow (config : config) (span : Meta.span) | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj proj_regions aproj - method! visit_ASymbolic proj_regions aproj = + method! visit_ASymbolic proj_regions pm aproj = + sanity_check __FILE__ __LINE__ (pm = PNone) span; match aproj with | AEndedProjBorrows _ | AEmpty -> - (* We ignore borrows *) ASymbolic aproj + (* We ignore borrows *) ASymbolic (pm, aproj) | AProjLoans _ -> (* Loans are handled later *) - ASymbolic aproj + ASymbolic (pm, aproj) | 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 @@ -388,12 +390,12 @@ let expand_symbolic_value_shared_borrow (config : config) (span : Meta.span) 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 + | None -> super#visit_ASymbolic proj_regions pm aproj | Some asb -> ABorrow (AProjSharedBorrow asb)) | AEndedProjLoans _ -> (* Sanity check: make sure there is nothing to expand inside the * children projections *) - ASymbolic (self#visit_aproj proj_regions aproj) + ASymbolic (pm, self#visit_aproj proj_regions aproj) end in (* Call the visitor *) diff --git a/src/interp/InterpreterLoopsCore.ml b/src/interp/InterpreterLoopsCore.ml index e1c9b46e0..e51a6375a 100644 --- a/src/interp/InterpreterLoopsCore.ml +++ b/src/interp/InterpreterLoopsCore.ml @@ -4,6 +4,7 @@ open Types open Values open Contexts open InterpreterUtils +open InterpreterBorrowsCore open Errors type updt_env_kind = @@ -34,10 +35,14 @@ type ctx_or_update = (eval_ctx, updt_env_kind) result *) type abs_borrows_loans_maps = { abs_ids : AbstractionId.id list; - abs_to_borrows : MarkerBorrowId.Set.t AbstractionId.Map.t; - abs_to_loans : MarkerBorrowId.Set.t AbstractionId.Map.t; - borrow_to_abs : AbstractionId.Set.t MarkerBorrowId.Map.t; - loan_to_abs : AbstractionId.Set.t MarkerBorrowId.Map.t; + abs_to_borrows : MarkedBorrowId.Set.t AbstractionId.Map.t; + abs_to_loans : MarkedBorrowId.Set.t AbstractionId.Map.t; + borrow_to_abs : AbstractionId.Set.t MarkedBorrowId.Map.t; + loan_to_abs : AbstractionId.Set.t MarkedBorrowId.Map.t; + abs_to_borrow_projs : MarkedNormSymbProj.Set.t AbstractionId.Map.t; + abs_to_loan_projs : MarkedNormSymbProj.Set.t AbstractionId.Map.t; + borrow_proj_to_abs : AbstractionId.Set.t MarkedNormSymbProj.Map.t; + loan_proj_to_abs : AbstractionId.Set.t MarkedNormSymbProj.Map.t; } (** See {!module:Aeneas.InterpreterLoopsMatchCtxs.MakeMatcher} and [Matcher]. @@ -446,7 +451,12 @@ let typed_avalue_add_marker (span : Meta.span) (ctx : eval_ctx) method! visit_loan_content _ _ = craise __FILE__ __LINE__ span "Unexpected loan" + method! visit_ASymbolic _ pm0 aproj = + sanity_check __FILE__ __LINE__ (pm0 = PNone) span; + ASymbolic (pm, aproj) + method! visit_symbolic_value _ sv = + (* Symbolic values can appera in shared values *) sanity_check __FILE__ __LINE__ (not (symbolic_value_has_borrows (Some span) ctx sv)) span; @@ -460,7 +470,7 @@ let typed_avalue_add_marker (span : Meta.span) (ctx : eval_ctx) | ASharedLoan (pm0, bids, av, child) -> sanity_check __FILE__ __LINE__ (pm0 = PNone) span; super#visit_aloan_content env (ASharedLoan (pm, bids, av, child)) - | _ -> craise __FILE__ __LINE__ span "Unsupported yet" + | _ -> internal_error __FILE__ __LINE__ span method! visit_aborrow_content env bc = match bc with @@ -470,7 +480,7 @@ let typed_avalue_add_marker (span : Meta.span) (ctx : eval_ctx) | ASharedBorrow (pm0, bid) -> sanity_check __FILE__ __LINE__ (pm0 = PNone) span; super#visit_aborrow_content env (ASharedBorrow (pm, bid)) - | _ -> craise __FILE__ __LINE__ span "Unsupported yet" + | _ -> internal_error __FILE__ __LINE__ span end in obj#visit_typed_avalue () av diff --git a/src/interp/InterpreterLoopsFixedPoint.ml b/src/interp/InterpreterLoopsFixedPoint.ml index 10a9141d5..5058e1172 100644 --- a/src/interp/InterpreterLoopsFixedPoint.ml +++ b/src/interp/InterpreterLoopsFixedPoint.ml @@ -305,21 +305,6 @@ let prepare_ashared_loans (span : Meta.span) (loop_id : LoopId.id option) : (* Continue the exploration *) super#visit_ASharedLoan env pm lids sv av - - (** Check that there are no symbolic values with *borrows* inside the - abstraction - shouldn't happen if the symbolic values are greedily - expanded. - We do this because those values could contain shared borrows: - if it is the case, we need to duplicate them too. - TODO: implement this more general behavior. - *) - method! visit_symbolic_value env sv = - cassert __FILE__ __LINE__ - (not (symbolic_value_has_borrows (Some span) ctx sv)) - span - "There should be no symbolic values with borrows inside the \ - abstraction"; - super#visit_symbolic_value env sv end in List.iter (visit_avalue#visit_typed_avalue None) abs.avalues diff --git a/src/interp/InterpreterLoopsJoinCtxs.ml b/src/interp/InterpreterLoopsJoinCtxs.ml index 45e778495..c2455c86c 100644 --- a/src/interp/InterpreterLoopsJoinCtxs.ml +++ b/src/interp/InterpreterLoopsJoinCtxs.ml @@ -5,6 +5,7 @@ open Utils open TypesUtils open ValuesUtils open InterpreterUtils +open InterpreterBorrowsCore open InterpreterBorrows open InterpreterLoopsCore open InterpreterLoopsMatchCtxs @@ -33,16 +34,33 @@ let ctx_with_info_merge_into_first_abs (span : Meta.span) (abs_kind : abs_kind) in let nabs = ctx_lookup_abs nctx nabs_id in (* Update the information *) + (* We start by computing the maps for an environment which only contains + the new region abstraction *) let { abs_to_borrows = nabs_to_borrows; abs_to_loans = nabs_to_loans; borrow_to_abs = borrow_to_nabs; loan_to_abs = loan_to_nabs; + abs_to_borrow_projs = nabs_to_borrow_projs; + abs_to_loan_projs = nabs_to_loan_projs; + borrow_proj_to_abs = borrow_proj_to_nabs; + loan_proj_to_abs = loan_proj_to_nabs; _; } = compute_abs_borrows_loans_maps span (fun _ -> true) [ EAbs nabs ] in - let { abs_ids; abs_to_borrows; abs_to_loans; borrow_to_abs; loan_to_abs } = + (* Retrieve the previous maps, so that we can update them *) + let { + abs_ids; + abs_to_borrows; + abs_to_loans; + borrow_to_abs; + loan_to_abs; + abs_to_borrow_projs; + abs_to_loan_projs; + borrow_proj_to_abs; + loan_proj_to_abs; + } = ctx.info in let abs_ids = @@ -53,40 +71,91 @@ let ctx_with_info_merge_into_first_abs (span : Meta.span) (abs_kind : abs_kind) else Some id) abs_ids in - (* Update the maps from makred borrows/loans to abstractions *) - let update_to_abs abs_to to_nabs to_abs = - (* Remove the old bindings *) - let abs0_elems = AbstractionId.Map.find abs_id0 abs_to in - let abs1_elems = AbstractionId.Map.find abs_id1 abs_to in - let abs01_elems = MarkerBorrowId.Set.union abs0_elems abs1_elems in - let to_abs = - MarkerBorrowId.Map.filter - (fun id _ -> not (MarkerBorrowId.Set.mem id abs01_elems)) - to_abs - in - (* Add the new ones *) - let merge _ _ _ = - (* We shouldn't have twice the same key *) - craise __FILE__ __LINE__ span "Unreachable" - in - MarkerBorrowId.Map.union merge to_nabs to_abs + (* Update the various maps. + + We use a functor for the maps from marked borrows/loans or symbolic value + projections to symbolic abstractions, because we have to manipulate maps and + sets over different types (borrow/loan ids and symbolic value projections). + *) + let module UpdateToAbs + (M : Collections.Map) + (S : Collections.Set with type elt = M.key) = + struct + (* Update a map from marked borrows/loans or symbolic value projections + to region abstractions by using the old map and the information computed + from the merged abstraction. + *) + let update_to_abs (abs_to : S.t AbstractionId.Map.t) + (to_nabs : AbstractionId.Set.t M.t) (to_abs : AbstractionId.Set.t M.t) : + AbstractionId.Set.t M.t = + (* Remove the old bindings from borrow/loan ids to the two region + abstractions we just merged (because those two region abstractions + do not exist anymore). *) + let abs0_elems = AbstractionId.Map.find abs_id0 abs_to in + let abs1_elems = AbstractionId.Map.find abs_id1 abs_to in + let abs01_elems = S.union abs0_elems abs1_elems in + let to_abs = M.filter (fun id _ -> not (S.mem id abs01_elems)) to_abs in + (* Add the new bindings from the borrows/loan ids that we find in the + merged abstraction to this abstraction's id *) + let merge _ _ _ = + (* We shouldn't see the same key twice *) + craise __FILE__ __LINE__ span "Unreachable" + in + M.union merge to_nabs to_abs + end in + let module UpdateMarkedBorrowId = + UpdateToAbs (MarkedBorrowId.Map) (MarkedBorrowId.Set) in let borrow_to_abs = - update_to_abs abs_to_borrows borrow_to_nabs borrow_to_abs + UpdateMarkedBorrowId.update_to_abs abs_to_borrows borrow_to_nabs + borrow_to_abs + in + let loan_to_abs = + UpdateMarkedBorrowId.update_to_abs abs_to_loans loan_to_nabs loan_to_abs + in + let module UpdateSymbProj = + UpdateToAbs (MarkedNormSymbProj.Map) (MarkedNormSymbProj.Set) + in + let borrow_proj_to_abs = + UpdateSymbProj.update_to_abs abs_to_borrow_projs borrow_proj_to_nabs + borrow_proj_to_abs + in + let loan_proj_to_abs = + UpdateSymbProj.update_to_abs abs_to_loan_projs loan_proj_to_nabs + loan_proj_to_abs in - let loan_to_abs = update_to_abs abs_to_loans loan_to_nabs loan_to_abs in - (* Update the maps from abstractions to marked borrows/loans *) + (* Update the maps from abstractions to marked borrows/loans or + symbolic value projections. + *) let update_abs_to nabs_to abs_to = + (* Remove the two region abstractions we merged *) + let m = + AbstractionId.Map.remove abs_id0 (AbstractionId.Map.remove abs_id1 abs_to) + in + (* Add the merged abstraction *) AbstractionId.Map.add_strict nabs_id (AbstractionId.Map.find nabs_id nabs_to) - (AbstractionId.Map.remove abs_id0 - (AbstractionId.Map.remove abs_id1 abs_to)) + m in let abs_to_borrows = update_abs_to nabs_to_borrows abs_to_borrows in let abs_to_loans = update_abs_to nabs_to_loans abs_to_loans in + let abs_to_borrow_projs = + update_abs_to nabs_to_borrow_projs abs_to_borrow_projs + in + let abs_to_loan_projs = update_abs_to nabs_to_loan_projs abs_to_loan_projs in let info = - { abs_ids; abs_to_borrows; abs_to_loans; borrow_to_abs; loan_to_abs } + { + abs_ids; + abs_to_borrows; + abs_to_loans; + borrow_to_abs; + loan_to_abs; + borrow_proj_to_abs; + loan_proj_to_abs; + abs_to_borrow_projs; + abs_to_loan_projs; + } in { ctx = nctx; info } @@ -134,17 +203,18 @@ let repeat_iter_borrows_merge (span : Meta.span) (old_ids : ids_sets) (** Reduce an environment. We do this to simplify an environment, for the purpose of finding a loop - fixed point. + fixed point (this is our equivalent of Abstract Interpretation's + **widening** operation). We do the following: - we look for all the *new* dummy values (we use sets of old ids to decide wether a value is new or not) and convert them into abstractions - - whenever there is a new abstraction in the context, and some of its + - whenever there is a new abstraction in the context, and some of its borrows are associated to loans in another new abstraction, we merge them. In effect, this allows us to merge newly introduced abstractions/borrows with their parent abstractions. - + For instance, looking at the [list_nth_mut] example, when evaluating the first loop iteration, we start in the following environment: {[ @@ -263,11 +333,11 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) We do this because we want to control the order in which abstractions are merged (the ids are iterated in increasing order). Otherwise, we could simply iterate over all the borrows in [loan_to_abs]... *) - let iterate ctx f = + let iterate ctx merge = List.iter (fun abs_id0 -> let lids = AbstractionId.Map.find abs_id0 ctx.info.abs_to_loans in - MarkerBorrowId.Set.iter (fun lid -> f (abs_id0, lid)) lids) + MarkedBorrowId.Set.iter (fun lid -> merge (abs_id0, lid)) lids) ctx.info.abs_ids in (* Given a loan, check if there is a fresh abstraction with the corresponding borrow *) @@ -282,7 +352,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) if with_markers && fst lid = PNone then None else (* Find the borrow corresponding to the loan we want to eliminate *) - match MarkerBorrowId.Map.find_opt lid ctx.info.borrow_to_abs with + match MarkedBorrowId.Map.find_opt lid ctx.info.borrow_to_abs with | None -> (* Nothing to to *) None | Some abs_ids1 -> ( (* We need to merge *) @@ -381,7 +451,7 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) if is_borrow then ctx.info.abs_to_borrows else ctx.info.abs_to_loans in let ids = AbstractionId.Map.find abs_id0 m in - MarkerBorrowId.Set.iter (fun id -> f (abs_id0, is_borrow, id)) ids + MarkedBorrowId.Set.iter (fun id -> f (abs_id0, is_borrow, id)) ids in (* Iterate over the borrows *) iterate true; @@ -415,13 +485,13 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) let abs0_borrows = BorrowId.Set.of_list (List.map snd - (MarkerBorrowId.Set.elements + (MarkedBorrowId.Set.elements (AbstractionId.Map.find abs_id0 info.abs_to_borrows))) in let abs1_loans = BorrowId.Set.of_list (List.map snd - (MarkerBorrowId.Set.elements + (MarkedBorrowId.Set.elements (AbstractionId.Map.find abs_id1 info.abs_to_loans))) in not (BorrowId.Set.disjoint abs0_borrows abs1_loans) @@ -433,7 +503,7 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) else (* Look for an element with the dual marker *) match - MarkerBorrowId.Map.find_opt + MarkedBorrowId.Map.find_opt (invert_proj_marker pm, bid) (if is_borrow then ctx.info.borrow_to_abs else ctx.info.loan_to_abs) with @@ -499,6 +569,7 @@ let eval_ctx_has_markers (ctx : eval_ctx) : bool = First, we reduce the environment, merging any two pair of fresh abstractions which contain a loan (in one) and its corresponding borrow (in the other). + This is our version of Abstract Interpretation's **widening** operation. For instance, we merge abs@0 and abs@1 below: {[ abs@0 { |ML l0|, ML l1 } @@ -653,7 +724,7 @@ let collapse_ctx_with_merge (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets) (ctx : eval_ctx) : eval_ctx = let merge_funs = mk_collapse_ctx_merge_duplicate_funs span loop_id ctx in try collapse_ctx span loop_id merge_funs old_ids ctx - with ValueMatchFailure _ -> craise __FILE__ __LINE__ span "Unexpected" + with ValueMatchFailure _ -> internal_error __FILE__ __LINE__ span let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : ctx_or_update = diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index b37365b3d..99feee73c 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -25,13 +25,17 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) let abs_ids = ref [] in let abs_to_borrows = ref AbstractionId.Map.empty in let abs_to_loans = ref AbstractionId.Map.empty in - let borrow_to_abs = ref MarkerBorrowId.Map.empty in - let loan_to_abs = ref MarkerBorrowId.Map.empty in + let abs_to_borrow_projs = ref AbstractionId.Map.empty in + let abs_to_loan_projs = ref AbstractionId.Map.empty in + let borrow_to_abs = ref MarkedBorrowId.Map.empty in + let loan_to_abs = ref MarkedBorrowId.Map.empty in + let borrow_proj_to_abs = ref MarkedNormSymbProj.Map.empty in + let loan_proj_to_abs = ref MarkedNormSymbProj.Map.empty in let module R (M : Collections.Map) (S : Collections.Set) = struct (* [check_singleton_sets]: check that the mapping maps to a singleton. - We need this because to tweak the behavior of the sanity checks because + We need to tweak the behavior of the sanity checks because of the following cases: - when computing the map from borrow ids (with marker) to the region abstractions they belong to, the marked borrow ids can map to a single @@ -58,16 +62,30 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) Some (S.add id1 ids)) !map end in - let module RAbsBorrow = R (AbstractionId.Map) (MarkerBorrowId.Set) in - let module RBorrowAbs = R (MarkerBorrowId.Map) (AbstractionId.Set) in - let register_borrow_id abs_id pm bid = - RAbsBorrow.register_mapping false abs_to_borrows abs_id (pm, bid); - RBorrowAbs.register_mapping true borrow_to_abs (pm, bid) abs_id + let module RAbsBorrow = R (AbstractionId.Map) (MarkedBorrowId.Set) in + let module RBorrowAbs = R (MarkedBorrowId.Map) (AbstractionId.Set) in + let module RAbsSymbProj = R (AbstractionId.Map) (MarkedNormSymbProj.Set) in + let module RSymbProjAbs = R (MarkedNormSymbProj.Map) (AbstractionId.Set) in + let register_borrow_id abs pm bid = + RAbsBorrow.register_mapping false abs_to_borrows abs.abs_id (pm, bid); + RBorrowAbs.register_mapping true borrow_to_abs (pm, bid) abs.abs_id in - let register_loan_id abs_id pm bid = - RAbsBorrow.register_mapping false abs_to_loans abs_id (pm, bid); - RBorrowAbs.register_mapping true loan_to_abs (pm, bid) abs_id + let register_loan_id abs pm bid = + RAbsBorrow.register_mapping false abs_to_loans abs.abs_id (pm, bid); + RBorrowAbs.register_mapping true loan_to_abs (pm, bid) abs.abs_id + in + let register_borrow_proj abs pm (sv : symbolic_value) (proj_ty : ty) = + let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in + let proj : marked_norm_symb_proj = { pm; sv_id = sv.sv_id; norm_proj_ty } in + RAbsSymbProj.register_mapping false abs_to_borrow_projs abs.abs_id proj; + RSymbProjAbs.register_mapping true borrow_proj_to_abs proj abs.abs_id + in + let register_loan_proj abs pm (sv : symbolic_value) (proj_ty : ty) = + let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in + let proj : marked_norm_symb_proj = { pm; sv_id = sv.sv_id; norm_proj_ty } in + RAbsSymbProj.register_mapping false abs_to_loan_projs abs.abs_id proj; + RSymbProjAbs.register_mapping true loan_proj_to_abs proj abs.abs_id in let explore_abs = @@ -75,73 +93,82 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) inherit [_] iter_typed_avalue as super (** Make sure we don't register the ignored ids *) - method! visit_aloan_content (abs_id, pm) lc = + method! visit_aloan_content (abs, pm) lc = sanity_check __FILE__ __LINE__ (pm = PNone) span; match lc with | AMutLoan (npm, lid, child) -> (* Add the current marker when visiting the loan id *) - self#visit_loan_id (abs_id, npm) lid; + self#visit_loan_id (abs, npm) lid; (* Recurse with the old marker *) - super#visit_typed_avalue (abs_id, pm) child + super#visit_typed_avalue (abs, pm) child | ASharedLoan (npm, lids, sv, child) -> (* Add the current marker when visiting the loan ids and the shared value *) - self#visit_loan_id_set (abs_id, npm) lids; - self#visit_typed_value (abs_id, npm) sv; + self#visit_loan_id_set (abs, npm) lids; + self#visit_typed_value (abs, npm) sv; (* Recurse with the old marker *) - self#visit_typed_avalue (abs_id, pm) child + self#visit_typed_avalue (abs, pm) child | AIgnoredMutLoan (_, child) | AEndedIgnoredMutLoan { child; given_back = _; given_back_meta = _ } | AIgnoredSharedLoan child -> sanity_check __FILE__ __LINE__ (pm = PNone) span; (* Ignore the id of the loan, if there is *) - self#visit_typed_avalue (abs_id, pm) child + self#visit_typed_avalue (abs, pm) child | AEndedMutLoan _ | AEndedSharedLoan _ -> craise __FILE__ __LINE__ span "Unreachable" (** Make sure we don't register the ignored ids *) - method! visit_aborrow_content (abs_id, pm) bc = + method! visit_aborrow_content (abs, pm) bc = sanity_check __FILE__ __LINE__ (pm = PNone) span; match bc with | AMutBorrow (npm, bid, child) -> (* Add the current marker when visiting the borrow id *) - self#visit_borrow_id (abs_id, npm) bid; + self#visit_borrow_id (abs, npm) bid; (* Recurse with the old marker *) - self#visit_typed_avalue (abs_id, pm) child + self#visit_typed_avalue (abs, pm) child | ASharedBorrow (npm, bid) -> (* Add the current marker when visiting the borrow id *) - self#visit_borrow_id (abs_id, npm) bid + self#visit_borrow_id (abs, npm) bid | AProjSharedBorrow _ -> sanity_check __FILE__ __LINE__ (pm = PNone) span; (* Process those normally *) - super#visit_aborrow_content (abs_id, pm) bc + super#visit_aborrow_content (abs, pm) bc | AIgnoredMutBorrow (_, child) | AEndedIgnoredMutBorrow { child; given_back = _; given_back_meta = _ } -> sanity_check __FILE__ __LINE__ (pm = PNone) span; (* Ignore the id of the borrow, if there is *) - self#visit_typed_avalue (abs_id, pm) child + self#visit_typed_avalue (abs, pm) child | AEndedMutBorrow _ | AEndedSharedBorrow -> craise __FILE__ __LINE__ span "Unreachable" - method! visit_borrow_id (abs_id, pm) bid = - register_borrow_id abs_id pm bid - - method! visit_loan_id (abs_id, pm) lid = register_loan_id abs_id pm lid + method! visit_borrow_id (abs, pm) bid = register_borrow_id abs pm bid + method! visit_loan_id (abs, pm) lid = register_loan_id abs pm lid + + method! visit_ASymbolic (abs, _) pm proj = + match proj with + | AProjLoans (sv, proj_ty, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + register_loan_proj abs pm sv proj_ty + | AProjBorrows (sv, proj_ty, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + register_borrow_proj abs pm sv proj_ty + | AEndedProjLoans (_, children) | AEndedProjBorrows (_, children) -> + sanity_check __FILE__ __LINE__ (children = []) span + | AEmpty -> () end in env_iter_abs (fun abs -> - let abs_id = abs.abs_id in if explore abs then ( abs_to_borrows := - AbstractionId.Map.add abs_id MarkerBorrowId.Set.empty !abs_to_borrows; + AbstractionId.Map.add abs.abs_id MarkedBorrowId.Set.empty + !abs_to_borrows; abs_to_loans := - AbstractionId.Map.add abs_id MarkerBorrowId.Set.empty !abs_to_loans; + AbstractionId.Map.add abs.abs_id MarkedBorrowId.Set.empty + !abs_to_loans; abs_ids := abs.abs_id :: !abs_ids; - List.iter - (explore_abs#visit_typed_avalue (abs.abs_id, PNone)) - abs.avalues) + List.iter (explore_abs#visit_typed_avalue (abs, PNone)) abs.avalues) else ()) env; @@ -153,6 +180,10 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) abs_to_loans = !abs_to_loans; borrow_to_abs = !borrow_to_abs; loan_to_abs = !loan_to_abs; + abs_to_borrow_projs = !abs_to_borrow_projs; + abs_to_loan_projs = !abs_to_loan_projs; + borrow_proj_to_abs = !borrow_proj_to_abs; + loan_proj_to_abs = !loan_proj_to_abs; } (** Match two types during a join. @@ -294,18 +325,14 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct in { value = VLoan lc; ty = v1.ty } | VSymbolic sv0, VSymbolic sv1 -> - (* For now, we force all the symbolic values containing borrows to - be eagerly expanded, and we don't support nested borrows *) cassert __FILE__ __LINE__ - (not (value_has_borrows v0.value)) - M.span - "Nested borrows are not supported yet and all the symbolic values \ - containing borrows are currently forced to be eagerly expanded"; + (not + (ety_has_nested_borrows (Some span) ctx0.type_ctx.type_infos v0.ty)) + M.span "Nested borrows are not supported yet."; cassert __FILE__ __LINE__ - (not (value_has_borrows v1.value)) - M.span - "Nested borrows are not supported yet and all the symbolic values \ - containing borrows are currently forced to be eagerly expanded"; + (not + (ety_has_nested_borrows (Some span) ctx1.type_ctx.type_infos v1.ty)) + M.span "Nested borrows are not supported yet."; (* Match *) let sv = M.match_symbolic_values ctx0 ctx1 sv0 sv1 in { v1 with value = VSymbolic sv } @@ -775,9 +802,11 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct sv0) else ( (* The caller should have checked that the symbolic values don't contain - borrows *) + nested borrows, but we can check more *) sanity_check __FILE__ __LINE__ - (not (ty_has_borrows (Some span) ctx0.type_ctx.type_infos sv0.sv_ty)) + (not + (ety_has_nested_borrows (Some span) ctx0.type_ctx.type_infos + sv0.sv_ty)) span; (* TODO: the symbolic values may contain bottoms: we're being conservatice, and fail (for now) if part of a symbolic value contains a bottom. @@ -787,7 +816,62 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct ((not (symbolic_value_has_ended_regions ctx0.ended_regions sv0)) && not (symbolic_value_has_ended_regions ctx1.ended_regions sv1)) span; - mk_fresh_symbolic_value span sv0.sv_ty) + (* If the symbolic values contain regions, we need to introduce abstractions *) + if ty_has_borrows (Some span) ctx0.type_ctx.type_infos sv0.sv_ty then ( + (* Let's say we join: + {[ + s0 : S<'0, '1> + s1 : S<'2, '3> + ]} + + We introduce a fresh symbolic value with fresh regions, as well as + one abstraction per region. It looks like so: + {[ + join s0 s1 ~> s2 : S<'a, 'b>, + A0('a) { + |proj_borrows (s0 <: S<'a, 'b>)|, + !proj_borrows (s1 <: S<'a, 'b>)!, + proj_loans (s2 : S<'a, 'b>) + } + A1('b) { + |proj_borrows (s0 <: S<'a, 'b>)|, + !proj_borrows (s1 <: S<'a, 'b>)!, + proj_loans (s2 : S<'a, 'b>) + } + ]} + *) + (* Introduce one region abstraction per region appearing in the symbolic value *) + let fresh_regions, proj_ty = + ty_refresh_regions (Some span) fresh_region_id sv0.sv_ty + in + let svj = mk_fresh_symbolic_value span proj_ty in + let proj_s0 = mk_aproj_borrows PLeft sv0 proj_ty in + let proj_s1 = mk_aproj_borrows PRight sv1 proj_ty in + let proj_svj = mk_aproj_loans PNone svj proj_ty in + let avalues = [ proj_s0; proj_s1; proj_svj ] in + List.iter + (fun rid -> + let abs = + { + abs_id = fresh_abstraction_id (); + kind = Loop (S.loop_id, None, LoopSynthInput); + can_end = true; + parents = AbstractionId.Set.empty; + original_parents = []; + regions = + { + owned = RegionId.Set.singleton rid; + ancestors = RegionId.Set.empty; + }; + avalues; + } + in + push_abs abs) + fresh_regions; + svj) + else + (* Otherwise we simply introduce a fresh symbolic value *) + mk_fresh_symbolic_value span sv0.sv_ty) let match_symbolic_with_other (ctx0 : eval_ctx) (ctx1 : eval_ctx) (left : bool) (sv : symbolic_value) (v : typed_value) : typed_value = diff --git a/src/interp/InterpreterProjectors.ml b/src/interp/InterpreterProjectors.ml index 458025ba4..f9d1f3aba 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 (PNone, AProjBorrows (s, ty, [])) | _ -> log#ltrace (lazy diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index 3e23f9ff9..71ada67c8 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -130,7 +130,7 @@ let mk_typed_value_from_symbolic_value (svalue : symbolic_value) : typed_value = 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 = ASymbolic (PNone, AProjLoans (svalue, proj_ty, [])) in let av : typed_avalue = { value = av; ty = svalue.sv_ty } in av else diff --git a/src/interp/Invariants.ml b/src/interp/Invariants.ml index 22fc05dac..44ce8b218 100644 --- a/src/interp/Invariants.ml +++ b/src/interp/Invariants.ml @@ -685,7 +685,8 @@ let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = sanity_check __FILE__ __LINE__ (child_av.ty = aloan_get_expected_child_type aty) span) - | ASymbolic aproj, ty -> ( + | ASymbolic (pm, aproj), ty -> ( + sanity_check __FILE__ __LINE__ (pm = PNone) span; let ty1 = Substitute.erase_regions ty in match aproj with | AProjLoans (sv, proj_ty, _) -> diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index 3582cbc38..408b7521c 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -208,7 +208,7 @@ module Values = struct | ABottom -> "⊥ : " ^ ty_to_string env v.ty | ABorrow bc -> aborrow_content_to_string ~span env bc | ALoan lc -> aloan_content_to_string ~span env lc - | ASymbolic s -> aproj_to_string env s + | ASymbolic (pm, proj) -> aproj_to_string env proj |> add_proj_marker pm | AIgnored _ -> "_" and aloan_content_to_string ?(span : Meta.span option = None) (env : fmt_env) diff --git a/src/llbc/TypesUtils.ml b/src/llbc/TypesUtils.ml index 0dfe226d5..416d11a33 100644 --- a/src/llbc/TypesUtils.ml +++ b/src/llbc/TypesUtils.ml @@ -1,5 +1,6 @@ open Types open Utils +open Errors include Charon.TypesUtils let expect_free_var = Substitute.expect_free_var @@ -54,6 +55,57 @@ let ty_has_nested_borrows (span : Meta.span option) let info = TypesAnalysis.analyze_ty span infos ty in info.TypesAnalysis.contains_nested_borrows +(* Refresh the regions appearing inside a type, and introduce + fresh regions for its erased regions *) +let ty_refresh_regions (span : Meta.span option) + (fresh_region : unit -> region_id) (ty : ty) : region_id list * ty = + let fresh_regions = ref [] in + let fresh_region () = + let rid = fresh_region () in + fresh_regions := rid :: !fresh_regions; + rid + in + let regions_map = ref RegionId.Map.empty in + let get_region rid = + match RegionId.Map.find_opt rid !regions_map with + | Some id -> id + | None -> + let nid = fresh_region () in + regions_map := RegionId.Map.add rid nid !regions_map; + nid + in + let visitor = + object + inherit [_] map_ty + + method! visit_region_id _ _ = + (* We shouldn't get there and should rather catch all the call sites *) + internal_error_opt_span __FILE__ __LINE__ span + + method! visit_RVar _ var = + match var with + | Free rid -> RVar (Free (get_region rid)) + | Bound _ -> RVar var + + method! visit_RErased _ = RVar (Free (fresh_region ())) + end + in + let ty = visitor#visit_ty () ty in + (List.rev !fresh_regions, ty) + +let ety_has_nested_borrows (span : Meta.span option) + (infos : TypesAnalysis.type_infos) (ty : ty) : bool = + (* FIXME: The analysis currently only works on types with regions - erased types are + not allowed. For now, we update the type to insert fresh regions. + In order to avoid collisions (which as of today wouldn't be a problem actually, + but it's cleaner if we avoid the problem), we also refresh the existing non-erased + regions. + *) + let _, fresh_region = RegionId.fresh_stateful_generator () in + let _, ty = ty_refresh_regions span fresh_region ty in + let info = TypesAnalysis.analyze_ty span infos ty in + info.TypesAnalysis.contains_nested_borrows + (** Retuns true if the type decl contains nested borrows. *) let type_decl_has_nested_borrows (span : Meta.span option) (infos : TypesAnalysis.type_infos) (type_decl : type_decl) : bool = diff --git a/src/llbc/Values.ml b/src/llbc/Values.ml index 57cbc6b8b..796b8135c 100644 --- a/src/llbc/Values.ml +++ b/src/llbc/Values.ml @@ -178,8 +178,6 @@ type abstraction_id_set = AbstractionId.Set.t [@@deriving show, ord] For additional explanations see: https://arxiv.org/pdf/2404.02680#section.5 *) type proj_marker = PNone | PLeft | PRight [@@deriving show, ord] -type marker_borrow_id = proj_marker * BorrowId.id [@@deriving show, ord] - type ended_proj_borrow_meta = { consumed : msymbolic_value; given_back : msymbolic_value; @@ -189,35 +187,6 @@ type ended_proj_borrow_meta = { type ended_mut_borrow_meta = { bid : borrow_id; given_back : msymbolic_value } [@@deriving show, ord] -module MarkerBorrowIdOrd = struct - type t = marker_borrow_id - - let compare = compare_marker_borrow_id - let to_string = show_marker_borrow_id - let pp_t = pp_marker_borrow_id - let show_t = show_marker_borrow_id -end - -module MarkerBorrowIdSet = Collections.MakeSet (MarkerBorrowIdOrd) -module MarkerBorrowIdMap = Collections.MakeMap (MarkerBorrowIdOrd) - -module MarkerBorrowId : sig - type t - - val to_string : t -> string - - module Set : Collections.Set with type elt = t - module Map : Collections.Map with type key = t -end -with type t = marker_borrow_id = struct - type t = marker_borrow_id - - let to_string = show_marker_borrow_id - - module Set = MarkerBorrowIdSet - module Map = MarkerBorrowIdMap -end - (** Ancestor for {!typed_avalue} iter visitor *) class ['self] iter_typed_avalue_base = object (self : 'self) @@ -391,7 +360,7 @@ and avalue = | ABottom (* TODO: remove once we change the way internal borrows are ended *) | ALoan of aloan_content | ABorrow of aborrow_content - | ASymbolic of aproj + | ASymbolic of proj_marker * aproj | AIgnored of mvalue option (** A value which doesn't contain borrows, or which borrows we don't own and thus ignore. diff --git a/src/llbc/ValuesUtils.ml b/src/llbc/ValuesUtils.ml index eb92a96e9..02901c539 100644 --- a/src/llbc/ValuesUtils.ml +++ b/src/llbc/ValuesUtils.ml @@ -83,6 +83,12 @@ let is_unit (v : typed_value) : bool = | VAdt av -> av.variant_id = None && av.field_values = [] | _ -> false +let mk_aproj_borrows (pm : proj_marker) (sv : symbolic_value) (proj_ty : ty) = + { value = ASymbolic (pm, AProjBorrows (sv, proj_ty, [])); ty = proj_ty } + +let mk_aproj_loans (pm : proj_marker) (sv : symbolic_value) (proj_ty : ty) = + { value = ASymbolic (pm, AProjLoans (sv, proj_ty, [])); ty = proj_ty } + (** Check if a value contains a *concrete* borrow (i.e., a [Borrow] value - we don't check if there are borrows hidden in symbolic values). *) diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 3b517edc9..e77c9f2a3 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -1966,7 +1966,8 @@ let compute_typed_avalue_proj_kind span type_infos (* Continue exploring as a sanity check: we want to make sure we don't find loans *) super#visit_ABorrow env bc - method! visit_ASymbolic ty aproj = + method! visit_ASymbolic ty pm aproj = + sanity_check __FILE__ __LINE__ (pm = PNone) span; match aproj with | V.AEndedProjLoans (_, _) -> has_loans := true; @@ -1976,12 +1977,12 @@ let compute_typed_avalue_proj_kind span type_infos keep_region ty then has_mut_loans := true; (* Continue exploring (same reasons as above) *) - super#visit_ASymbolic ty aproj + super#visit_ASymbolic ty pm aproj | AProjLoans (_, _, _) -> (* TODO: we should probably fail here *) has_loans := true; (* Continue exploring (same reasons as above) *) - super#visit_ASymbolic ty aproj + super#visit_ASymbolic ty pm aproj | AEndedProjBorrows _ -> has_borrows := true; (* We need to check wether the projected borrows are mutable or not *) @@ -1990,15 +1991,15 @@ let compute_typed_avalue_proj_kind span type_infos keep_region ty then has_mut_borrows := true; (* Continue exploring (same reasons as above) *) - super#visit_ASymbolic ty aproj + super#visit_ASymbolic ty pm aproj | AProjBorrows (_, _, _) -> (* TODO: we should probably fail here *) has_borrows := true; (* Continue exploring (same reasons as above) *) - super#visit_ASymbolic ty aproj + super#visit_ASymbolic ty pm aproj | AEmpty -> (* Continue exploring (same reasons as above) *) - super#visit_ASymbolic ty aproj + super#visit_ASymbolic ty pm aproj end in visitor#visit_typed_avalue av.ty av; @@ -2040,7 +2041,9 @@ let rec typed_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) 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 abs_regions aproj + | ASymbolic (pm, aproj) -> + sanity_check __FILE__ __LINE__ (pm = PNone) ctx.span; + aproj_to_consumed_aux ctx abs_regions aproj | AIgnored mv -> ( if filter then None else @@ -2316,7 +2319,9 @@ let rec typed_avalue_to_given_back_aux ~(filter : bool) (* The avalue should have been generated by a borrow projector: this case is unreachable *) craise __FILE__ __LINE__ ctx.span "Unreachable" | ABorrow bc -> aborrow_content_to_given_back_aux ~filter mp bc av.ty ctx - | ASymbolic aproj -> aproj_to_given_back_aux mp aproj ctx + | ASymbolic (pm, aproj) -> + sanity_check __FILE__ __LINE__ (pm = PNone) ctx.span; + aproj_to_given_back_aux mp aproj ctx | AIgnored _ -> (* If we do not filter, we have to create a dummy pattern *) if filter then (ctx, None) From 49bdd7d2e19f6ecd8b6d7d6a0d775b71f9e37546 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 22 Dec 2024 17:12:24 +0100 Subject: [PATCH 03/23] Update the functions which iterate and merge helpers for rduce and collapse --- src/interp/InterpreterBorrows.ml | 30 ++- src/interp/InterpreterLoopsJoinCtxs.ml | 351 ++++++++++++++++--------- 2 files changed, 248 insertions(+), 133 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 77877d02e..8e981bcb4 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -2396,12 +2396,12 @@ type merge_duplicates_funcs = { *) let typed_avalue_split_marker (span : Meta.span) (ctx : eval_ctx) (av : typed_avalue) : typed_avalue list = - let mk_split pm mk_value = - if pm = PNone then [ mk_value PLeft; mk_value PRight ] else [ av ] + let mk_split mk_value = [ mk_value PLeft; mk_value PRight ] in + let mk_opt_split pm mk_value = + if pm = PNone then mk_split mk_value else [ av ] in match av.value with - | AAdt _ | ABottom | ASymbolic _ | AIgnored _ -> - craise __FILE__ __LINE__ span "Unexpected" + | AAdt _ | ABottom | AIgnored _ -> internal_error __FILE__ __LINE__ span | ABorrow bc -> ( match bc with | AMutBorrow (pm, bid, child) -> @@ -2409,13 +2409,13 @@ let typed_avalue_split_marker (span : Meta.span) (ctx : eval_ctx) let mk_value pm = { av with value = ABorrow (AMutBorrow (pm, bid, child)) } in - mk_split pm mk_value + mk_opt_split pm mk_value | ASharedBorrow (pm, bid) -> let mk_value pm = { av with value = ABorrow (ASharedBorrow (pm, bid)) } in - mk_split pm mk_value - | _ -> craise __FILE__ __LINE__ span "Unsupported yet") + mk_opt_split pm mk_value + | _ -> internal_error __FILE__ __LINE__ span) | ALoan lc -> ( match lc with | AMutLoan (pm, bid, child) -> @@ -2423,7 +2423,7 @@ let typed_avalue_split_marker (span : Meta.span) (ctx : eval_ctx) let mk_value pm = { av with value = ALoan (AMutLoan (pm, bid, child)) } in - mk_split pm mk_value + mk_opt_split pm mk_value | ASharedLoan (pm, bids, sv, child) -> sanity_check __FILE__ __LINE__ (is_aignored child.value) span; sanity_check __FILE__ __LINE__ @@ -2432,8 +2432,18 @@ let typed_avalue_split_marker (span : Meta.span) (ctx : eval_ctx) let mk_value pm = { av with value = ALoan (ASharedLoan (pm, bids, sv, child)) } in - mk_split pm mk_value - | _ -> craise __FILE__ __LINE__ span "Unsupported yet") + mk_opt_split pm mk_value + | _ -> internal_error __FILE__ __LINE__ span) + | ASymbolic (pm, proj) -> ( + if pm <> PNone then [ av ] + else + match proj with + | AProjLoans (_, _, children) | AProjBorrows (_, _, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + let mk_value pm = { av with value = ASymbolic (pm, proj) } in + mk_split mk_value + | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> + internal_error __FILE__ __LINE__ span) let abs_split_markers (span : Meta.span) (ctx : eval_ctx) (abs : abs) : abs = { diff --git a/src/interp/InterpreterLoopsJoinCtxs.ml b/src/interp/InterpreterLoopsJoinCtxs.ml index c2455c86c..2b778b2c6 100644 --- a/src/interp/InterpreterLoopsJoinCtxs.ml +++ b/src/interp/InterpreterLoopsJoinCtxs.ml @@ -211,7 +211,8 @@ let repeat_iter_borrows_merge (span : Meta.span) (old_ids : ids_sets) wether a value is new or not) and convert them into abstractions - whenever there is a new abstraction in the context, and some of its borrows are associated to loans in another new abstraction, we - merge them. + merge them. We also do this with loan/borrow projectors over symbolic + values. In effect, this allows us to merge newly introduced abstractions/borrows with their parent abstractions. @@ -329,52 +330,95 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) (* * Merge all the mergeable abs. *) - (* We iterate over the *new* abstractions, then over the loans in the abstractions. - We do this because we want to control the order in which abstractions - are merged (the ids are iterated in increasing order). Otherwise, we - could simply iterate over all the borrows in [loan_to_abs]... *) - let iterate ctx merge = - List.iter - (fun abs_id0 -> - let lids = AbstractionId.Map.find abs_id0 ctx.info.abs_to_loans in - MarkedBorrowId.Set.iter (fun lid -> merge (abs_id0, lid)) lids) - ctx.info.abs_ids - in - (* Given a loan, check if there is a fresh abstraction with the corresponding borrow *) - let merge_policy ctx (abs_id0, lid) = - if not with_markers then - sanity_check __FILE__ __LINE__ (fst lid = PNone) span; - (* If we use markers: we are doing a collapse, which means we attempt - to eliminate markers (and this is the only goal of the operation). - We thus ignore the non-marked values (we merge non-marked values - when doing a "real" reduce, to simplify the environment in order - to converge to a fixed-point, for instance). *) - if with_markers && fst lid = PNone then None - else - (* Find the borrow corresponding to the loan we want to eliminate *) - match MarkedBorrowId.Map.find_opt lid ctx.info.borrow_to_abs with - | None -> (* Nothing to to *) None - | Some abs_ids1 -> ( - (* We need to merge *) - match AbstractionId.Set.elements abs_ids1 with - | [] -> None - | abs_id1 :: _ -> - log#ldebug - (lazy - ("reduce_ctx: merging abstraction " - ^ AbstractionId.to_string abs_id1 - ^ " into " - ^ AbstractionId.to_string abs_id0 - ^ ":\n\n" - ^ eval_ctx_to_string ~span:(Some span) ctx.ctx)); - Some (abs_id0, abs_id1)) + (* Because we need to manipulate different types for the concrete and the + symbolic loans and borrows, we introduce a functor *) + let module IterMerge + (Map : Collections.Map) + (Set : Collections.Set with type elt = Map.key) + (Marked : sig + val get_marker : Map.key -> proj_marker + + val get_borrow_to_abs : + abs_borrows_loans_maps -> AbstractionId.Set.t Map.t + + val get_to_loans : abs_borrows_loans_maps -> Set.t AbstractionId.Map.t + end) = + struct + (* We iterate over the *new* abstractions, then over the **loans** + (concrete or symbolic) in the abstractions. + + We do this because we want to control the order in which abstractions + are merged (the ids are iterated in increasing order). Otherwise, we + could simply iterate over all the borrows in [loan_to_abs] for instance... *) + let iterate_loans (ctx : ctx_with_info) + (merge : abstraction_id * Map.key -> unit) = + List.iter + (fun abs_id0 -> + (* Iterate over the loans *) + let lids = + AbstractionId.Map.find abs_id0 (Marked.get_to_loans ctx.info) + in + Set.iter (fun lid -> merge (abs_id0, lid)) lids) + ctx.info.abs_ids + + (* Given a **loan**, check if there is a fresh abstraction with the corresponding borrow *) + let merge_policy (ctx : ctx_with_info) (abs_id0, loan) = + if not with_markers then + sanity_check __FILE__ __LINE__ (Marked.get_marker loan = PNone) span; + (* If we use markers: we are doing a collapse, which means we attempt + to eliminate markers (and this is the only goal of the operation). + We thus ignore the non-marked values (we merge non-marked values + when doing a "real" reduce, to simplify the environment in order + to converge to a fixed-point, for instance). *) + if with_markers && Marked.get_marker loan = PNone then None + else + (* Find the *borrow* corresponding to the loan we want to eliminate + (hence the use of [get_borrow_to_abs]) *) + match Map.find_opt loan (Marked.get_borrow_to_abs ctx.info) with + | None -> (* Nothing to to *) None + | Some abs_ids1 -> ( + (* We need to merge *) + match AbstractionId.Set.elements abs_ids1 with + | [] -> None + | abs_id1 :: _ -> + log#ldebug + (lazy + ("reduce_ctx: merging abstraction " + ^ AbstractionId.to_string abs_id1 + ^ " into " + ^ AbstractionId.to_string abs_id0 + ^ ":\n\n" + ^ eval_ctx_to_string ~span:(Some span) ctx.ctx)); + Some (abs_id0, abs_id1)) + + (* Iterate over the loans and merge the abstractions *) + let iter_merge (ctx : eval_ctx) : eval_ctx = + repeat_iter_borrows_merge span old_ids abs_kind can_end merge_funs + iterate_loans merge_policy ctx + end in + (* Instantiate the functor for the concrete borrows and loans *) + let module IterMergeConcrete = + IterMerge (MarkedBorrowId.Map) (MarkedBorrowId.Set) + (struct + let get_marker (pm, _) = pm + let get_borrow_to_abs info = info.borrow_to_abs + let get_to_loans info = info.abs_to_loans + end) in - (* Iterate and merge *) - let ctx = - repeat_iter_borrows_merge span old_ids abs_kind can_end merge_funs iterate - merge_policy ctx + (* Instantiate the functor for the symbolic borrows and loans *) + let module IterMergeSymbolic = + IterMerge (MarkedNormSymbProj.Map) (MarkedNormSymbProj.Set) + (struct + let get_marker (proj : marked_norm_symb_proj) = proj.pm + let get_borrow_to_abs info = info.borrow_proj_to_abs + let get_to_loans info = info.abs_to_loan_projs + end) in + (* Apply *) + let ctx = IterMergeConcrete.iter_merge ctx in + let ctx = IterMergeSymbolic.iter_merge ctx in + (* Debugging *) log#ldebug (lazy ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids @@ -439,90 +483,151 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) (* Merge all the mergeable abs where the same element in present in both abs, but with left and right markers respectively. + + As we have to operate over different types, with both concrete borrows and loans and + borrow projectors and loan projectors, we implement this as a functor. *) - (* The iter function: iterate over the abstractions, and inside an abstraction - over the borrows then the loans *) - let iter ctx f = - List.iter - (fun abs_id0 -> - (* Small helper *) - let iterate is_borrow = - let m = - if is_borrow then ctx.info.abs_to_borrows else ctx.info.abs_to_loans + let module IterMerge + (Map : Collections.Map) + (Set : Collections.Set with type elt = Map.key) + (Marked : sig + val get_marker : Map.key -> proj_marker + + (* Remove a marker - we need this to check whether some borrows in one + abstraction have corresponding loans in another abstraction, + independently of the markers, to properly choose which abstraction + we merge into the other. *) + val unmark : Map.key -> Map.key + + (* Invert a marker *) + val invert_proj_marker : Map.key -> Map.key + val get_to_borrows : abs_borrows_loans_maps -> Set.t AbstractionId.Map.t + val get_to_loans : abs_borrows_loans_maps -> Set.t AbstractionId.Map.t + + val get_borrow_to_abs : + abs_borrows_loans_maps -> AbstractionId.Set.t Map.t + + val get_loan_to_abs : + abs_borrows_loans_maps -> AbstractionId.Set.t Map.t + end) = + struct + (* The iter function: iterate over the abstractions, and inside an abstraction + over the borrows (projectors) then the loan (projectors) *) + let iter (ctx : ctx_with_info) + (f : AbstractionId.id * bool * Map.key -> unit) = + List.iter + (fun abs_id0 -> + (* Small helper *) + let iterate is_borrow = + let m = + if is_borrow then Marked.get_to_borrows ctx.info + else Marked.get_to_loans ctx.info + in + let ids = AbstractionId.Map.find abs_id0 m in + Set.iter (fun id -> f (abs_id0, is_borrow, id)) ids in - let ids = AbstractionId.Map.find abs_id0 m in - MarkedBorrowId.Set.iter (fun id -> f (abs_id0, is_borrow, id)) ids - in - (* Iterate over the borrows *) - iterate true; - (* Iterate over the loans *) - iterate false) - ctx.info.abs_ids - in - (* Small utility: check if we need to swap two region abstractions before - merging them. - - We might have to swap the order to make sure that if there - are loans in one abstraction and the corresponding borrows - in the other they get properly merged (if we merge them in the wrong - order, we might introduce borrowing cycles). - - Example: - If we are merging abs0 and abs1 because of the marked value - [MB l0]: - {[ - abs0 { |MB l0|, MB l1 } - abs1 { ︙MB l0︙, ML l1 } - ]} - we want to make sure that we swap them (abs1 goes to the - left) to make sure [MB l1] and [ML l1] get properly eliminated. - - Remark: in case there is a borrowing cycle between the two abstractions - (which shouldn't happen) then there isn't much we can do, and whatever - the order in which we merge, we will preserve the cycle. - *) - let swap_abs info abs_id0 abs_id1 = - let abs0_borrows = - BorrowId.Set.of_list - (List.map snd - (MarkedBorrowId.Set.elements - (AbstractionId.Map.find abs_id0 info.abs_to_borrows))) - in - let abs1_loans = - BorrowId.Set.of_list - (List.map snd - (MarkedBorrowId.Set.elements - (AbstractionId.Map.find abs_id1 info.abs_to_loans))) - in - not (BorrowId.Set.disjoint abs0_borrows abs1_loans) + (* Iterate over the borrows *) + iterate true; + (* Iterate over the loans *) + iterate false) + ctx.info.abs_ids + + (* Small utility: check if we need to swap two region abstractions before + merging them. + + We might have to swap the order to make sure that if there + are loans in one abstraction and the corresponding borrows + in the other they get properly merged (if we merge them in the wrong + order, we might introduce borrowing cycles). + + Example: + If we are merging abs0 and abs1 because of the marked value + [MB l0]: + {[ + abs0 { |MB l0|, MB l1 } + abs1 { ︙MB l0︙, ML l1 } + ]} + we want to make sure that we swap them (abs1 goes to the + left) to make sure [MB l1] and [ML l1] get properly eliminated. + + Remark: in case there is a borrowing cycle between the two abstractions + (which shouldn't happen) then there isn't much we can do, and whatever + the order in which we merge, we will preserve the cycle. + *) + let swap_abs (info : abs_borrows_loans_maps) (abs_id0 : abstraction_id) + (abs_id1 : abstraction_id) = + let abs0_borrows = + Set.of_list + (List.map Marked.unmark + (Set.elements + (AbstractionId.Map.find abs_id0 (Marked.get_to_borrows info)))) + in + let abs1_loans = + Set.of_list + (List.map Marked.unmark + (Set.elements + (AbstractionId.Map.find abs_id1 (Marked.get_to_loans info)))) + in + not (Set.disjoint abs0_borrows abs1_loans) + + (* Check if there is an abstraction with the same borrow/loan id (or the + same projections of borrows/loans) and the dual marker, and merge them + if it is the case. *) + let merge_policy ctx (abs_id0, is_borrow, loan) = + if Marked.get_marker loan = PNone then None + else + (* Look for an element with the dual marker *) + match + Map.find_opt + (Marked.invert_proj_marker loan) + (if is_borrow then Marked.get_borrow_to_abs ctx.info + else Marked.get_loan_to_abs ctx.info) + with + | None -> (* Nothing to do *) None + | Some abs_ids1 -> ( + (* We need to merge *) + match AbstractionId.Set.elements abs_ids1 with + | [] -> None + | abs_id1 :: _ -> + (* Check if we need to swap *) + Some + (if swap_abs ctx.info abs_id0 abs_id1 then (abs_id1, abs_id0) + else (abs_id0, abs_id1))) + + (* Iterate and merge *) + let iter_merge (ctx : eval_ctx) : eval_ctx = + repeat_iter_borrows_merge span old_ids abs_kind can_end (Some merge_funs) + iter merge_policy ctx + end in + (* Instantiate the functor for concrete loans and borrows *) + let module IterMergeConcrete = + IterMerge (MarkedBorrowId.Map) (MarkedBorrowId.Set) + (struct + let get_marker (v : marked_borrow_id) = fst v + let unmark (_, bid) = (PNone, bid) + let invert_proj_marker (pm, bid) = (invert_proj_marker pm, bid) + let get_to_borrows info = info.abs_to_borrows + let get_to_loans info = info.abs_to_loans + let get_borrow_to_abs info = info.borrow_to_abs + let get_loan_to_abs info = info.loan_to_abs + end) in - (* Check if there is an abstraction with the same borrow/loan id and the dual - marker, and merge them if it is the case. *) - let merge_policy ctx (abs_id0, is_borrow, (pm, bid)) = - if pm = PNone then None - else - (* Look for an element with the dual marker *) - match - MarkedBorrowId.Map.find_opt - (invert_proj_marker pm, bid) - (if is_borrow then ctx.info.borrow_to_abs else ctx.info.loan_to_abs) - with - | None -> (* Nothing to do *) None - | Some abs_ids1 -> ( - (* We need to merge *) - match AbstractionId.Set.elements abs_ids1 with - | [] -> None - | abs_id1 :: _ -> - (* Check if we need to swap *) - Some - (if swap_abs ctx.info abs_id0 abs_id1 then (abs_id1, abs_id0) - else (abs_id0, abs_id1))) + (* Instantiate the functor for symbolic loans and borrows *) + let module IterMergeSymbolic = + IterMerge (MarkedNormSymbProj.Map) (MarkedNormSymbProj.Set) + (struct + let get_marker (v : marked_norm_symb_proj) = v.pm + let unmark v = { v with pm = PNone } + let invert_proj_marker v = { v with pm = invert_proj_marker v.pm } + let get_to_borrows info = info.abs_to_borrow_projs + let get_to_loans info = info.abs_to_loan_projs + let get_borrow_to_abs info = info.borrow_proj_to_abs + let get_loan_to_abs info = info.loan_proj_to_abs + end) in (* Iterate and merge *) - let ctx = - repeat_iter_borrows_merge span old_ids abs_kind can_end (Some merge_funs) - iter merge_policy ctx - in + let ctx = IterMergeConcrete.iter_merge ctx in + let ctx = IterMergeSymbolic.iter_merge ctx in log#ldebug (lazy From 2c9aa49a8da740a891768a11b98094c8e7d89ac2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 2 Jan 2025 22:01:12 +0100 Subject: [PATCH 04/23] Make progress on updating the merge --- src/interp/InterpreterBorrows.ml | 496 ++++++++++++++++++++----------- 1 file changed, 329 insertions(+), 167 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 8e981bcb4..e3f0aba00 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -2156,9 +2156,7 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (* Return *) List.rev !absl -type marked_borrow_or_loan_id = - | BorrowId of proj_marker * borrow_id - | LoanId of proj_marker * loan_id +type 'a borrow_or_loan = Borrow of 'a | Loan of 'a type g_loan_content_with_ty = (ety * loan_content, rty * aloan_content) concrete_or_abs @@ -2169,10 +2167,15 @@ type g_borrow_content_with_ty = type merge_abstraction_info = { loans : MarkedBorrowId.Set.t; borrows : MarkedBorrowId.Set.t; - borrows_loans : marked_borrow_or_loan_id list; + loan_projs : MarkedNormSymbProj.Set.t; + borrow_projs : MarkedNormSymbProj.Set.t; + borrows_loans : marked_borrow_id borrow_or_loan list; + borrow_loan_projs : marked_norm_symb_proj borrow_or_loan list; (** We use a list to preserve the order in which the borrows were found *) loan_to_content : g_loan_content_with_ty MarkedBorrowId.Map.t; borrow_to_content : g_borrow_content_with_ty MarkedBorrowId.Map.t; + loan_proj_to_content : (ty * proj_marker * aproj) MarkedNormSymbProj.Map.t; + borrow_proj_to_content : (ty * proj_marker * aproj) MarkedNormSymbProj.Map.t; } (** Small utility to help merging abstractions. @@ -2188,41 +2191,61 @@ type merge_abstraction_info = { contain shared loans). *) let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) - (avalues : typed_avalue list) : merge_abstraction_info = + (abs : abs) : merge_abstraction_info = let loans : MarkedBorrowId.Set.t ref = ref MarkedBorrowId.Set.empty in let borrows : MarkedBorrowId.Set.t ref = ref MarkedBorrowId.Set.empty in - let borrows_loans : marked_borrow_or_loan_id list ref = ref [] in + let loan_projs = ref MarkedNormSymbProj.Set.empty in + let borrow_projs = ref MarkedNormSymbProj.Set.empty in + let borrows_loans : marked_borrow_id borrow_or_loan list ref = ref [] in + let borrow_loan_projs = ref [] in let loan_to_content : g_loan_content_with_ty MarkedBorrowId.Map.t ref = ref MarkedBorrowId.Map.empty in let borrow_to_content : g_borrow_content_with_ty MarkedBorrowId.Map.t ref = ref MarkedBorrowId.Map.empty in - - let push_loan pm id (lc : g_loan_content_with_ty) : unit = - sanity_check __FILE__ __LINE__ - (not (MarkedBorrowId.Set.mem (pm, id) !loans)) - span; - loans := MarkedBorrowId.Set.add (pm, id) !loans; - sanity_check __FILE__ __LINE__ - (not (MarkedBorrowId.Map.mem (pm, id) !loan_to_content)) - span; - loan_to_content := MarkedBorrowId.Map.add (pm, id) lc !loan_to_content; - borrows_loans := LoanId (pm, id) :: !borrows_loans + let loan_proj_to_content = ref MarkedNormSymbProj.Map.empty in + let borrow_proj_to_content = ref MarkedNormSymbProj.Map.empty in + + let module Push + (Set : Collections.Set) + (Map : Collections.Map with type key = Set.elt) = + struct + let push (set : Set.t ref) (content : 'a) (to_content : 'a Map.t ref) + (is_borrow : bool) (borrows_loans : Set.elt borrow_or_loan list ref) + (marked : Set.elt) : unit = + sanity_check __FILE__ __LINE__ (not (Set.mem marked !set)) span; + set := Set.add marked !set; + sanity_check __FILE__ __LINE__ (not (Map.mem marked !to_content)) span; + to_content := Map.add marked content !to_content; + borrows_loans := + (if is_borrow then Borrow marked else Loan marked) :: !borrows_loans + end in + let module PushConcrete = Push (MarkedBorrowId.Set) (MarkedBorrowId.Map) in + let push_loan pm id (lc : g_loan_content_with_ty) = + PushConcrete.push loans lc loan_to_content false borrows_loans (pm, id) in let push_loans pm ids lc : unit = BorrowId.Set.iter (fun id -> push_loan pm id lc) ids in - let push_borrow pm id (bc : g_borrow_content_with_ty) : unit = - sanity_check __FILE__ __LINE__ - (not (MarkedBorrowId.Set.mem (pm, id) !borrows)) - span; - borrows := MarkedBorrowId.Set.add (pm, id) !borrows; - sanity_check __FILE__ __LINE__ - (not (MarkedBorrowId.Map.mem (pm, id) !borrow_to_content)) - span; - borrow_to_content := MarkedBorrowId.Map.add (pm, id) bc !borrow_to_content; - borrows_loans := BorrowId (pm, id) :: !borrows_loans + let push_borrow pm id (bc : g_borrow_content_with_ty) = + PushConcrete.push borrows bc borrow_to_content true borrows_loans (pm, id) + in + + let module PushSymbolic = + Push (MarkedNormSymbProj.Set) (MarkedNormSymbProj.Map) + in + let push_loan_proj pm sv_id proj_ty lc = + let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in + let proj = { pm; sv_id; norm_proj_ty } in + PushSymbolic.push loan_projs lc loan_proj_to_content false borrow_loan_projs + proj + in + let push_borrow_proj pm sv_id proj_ty bc = + let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in + let proj = { pm; sv_id; norm_proj_ty } in + PushSymbolic.push borrow_projs bc borrow_proj_to_content true + borrow_loan_projs proj in let iter_avalues = @@ -2301,10 +2324,27 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) sanity_check __FILE__ __LINE__ (not (symbolic_value_has_borrows (Some span) ctx sv)) span + + method! visit_ASymbolic env pm proj = + let ty = + match Option.get env with + | Concrete _ -> craise __FILE__ __LINE__ span "Unreachable" + | Abstract ty -> ty + in + match proj with + | AProjLoans (sv, proj_ty, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + push_loan_proj pm sv.sv_id proj_ty (ty, pm, proj) + | AProjBorrows (sv, proj_ty, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + push_borrow_proj pm sv.sv_id proj_ty (ty, pm, proj) + | AEndedProjLoans _ | AEndedProjBorrows _ -> + craise __FILE__ __LINE__ span "Unreachable" + | AEmpty -> () end in - List.iter (iter_avalues#visit_typed_avalue None) avalues; + List.iter (iter_avalues#visit_typed_avalue None) abs.avalues; { loans = !loans; @@ -2312,6 +2352,11 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) borrows_loans = List.rev !borrows_loans; loan_to_content = !loan_to_content; borrow_to_content = !borrow_to_content; + loan_projs = !loan_projs; + borrow_projs = !borrow_projs; + borrow_loan_projs = List.rev !borrow_loan_projs; + loan_proj_to_content = !loan_proj_to_content; + borrow_proj_to_content = !borrow_proj_to_content; } type merge_duplicates_funcs = { @@ -2504,42 +2549,60 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) let { loans = loans0; borrows = borrows0; + loan_projs = loan_projs0; + borrow_projs = borrow_projs0; borrows_loans = borrows_loans0; + borrow_loan_projs = borrow_loan_projs0; loan_to_content = loan_to_content0; + loan_proj_to_content = loan_proj_to_content0; borrow_to_content = borrow_to_content0; + borrow_proj_to_content = borrow_proj_to_content0; } = - compute_merge_abstraction_info span ctx abs0.avalues + compute_merge_abstraction_info span ctx abs0 in let { loans = loans1; borrows = borrows1; + loan_projs = loan_projs1; + borrow_projs = borrow_projs1; borrows_loans = borrows_loans1; + borrow_loan_projs = borrow_loan_projs1; loan_to_content = loan_to_content1; + loan_proj_to_content = loan_proj_to_content1; borrow_to_content = borrow_to_content1; + borrow_proj_to_content = borrow_proj_to_content1; } = - compute_merge_abstraction_info span ctx abs1.avalues + compute_merge_abstraction_info span ctx abs1 in - (* Sanity check: no markers appear unless we allow merging duplicates *) + (* Sanity check: no markers appear unless we allow merging duplicates. + Also, the borrows must be disjoint, and the loans must be disjoint. + *) if merge_funs = None then ( sanity_check __FILE__ __LINE__ (List.for_all (function - | LoanId (pm, _) | BorrowId (pm, _) -> pm = PNone) - borrows_loans0) + | Loan (pm, _) | Borrow (pm, _) -> pm = PNone) + (borrows_loans0 @ borrows_loans1)) span; sanity_check __FILE__ __LINE__ (List.for_all (function - | LoanId (pm, _) | BorrowId (pm, _) -> pm = PNone) - borrows_loans1) + | Loan proj | Borrow proj -> proj.pm = PNone) + (borrow_loan_projs0 @ borrow_loan_projs1)) span; sanity_check __FILE__ __LINE__ (MarkedBorrowId.Set.disjoint borrows0 borrows1) span; sanity_check __FILE__ __LINE__ (MarkedBorrowId.Set.disjoint loans0 loans1) + span; + sanity_check __FILE__ __LINE__ + (MarkedNormSymbProj.Set.disjoint borrow_projs0 borrow_projs1) + span; + sanity_check __FILE__ __LINE__ + (MarkedNormSymbProj.Set.disjoint loan_projs0 loan_projs1) span); (* Merge. @@ -2563,25 +2626,36 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) so that they always have exactly one id. *) let merged_borrows = ref MarkedBorrowId.Set.empty in + let merged_borrow_projs = ref MarkedNormSymbProj.Set.empty in let merged_loans = ref MarkedBorrowId.Set.empty in - let avalues = ref [] in - let push_avalue av = + let merged_loan_projs = ref MarkedNormSymbProj.Set.empty in + let borrow_avalues = ref [] in + let loan_avalues = ref [] in + let push_borrow_avalue av = log#ldebug (lazy - ("merge_abstractions_merge_loan_borrow_pairs: push_avalue: " + ("merge_abstractions_merge_loan_borrow_pairs: push_borrow_avalue: " ^ typed_avalue_to_string ~span:(Some span) ctx av)); - avalues := av :: !avalues + borrow_avalues := av :: !borrow_avalues in - let push_opt_avalue av = - match av with - | None -> () - | Some av -> push_avalue av + let push_loan_avalue av = + log#ldebug + (lazy + ("merge_abstractions_merge_loan_borrow_pairs: push_loan_avalue: " + ^ typed_avalue_to_string ~span:(Some span) ctx av)); + loan_avalues := av :: !loan_avalues in (* Compute the intersection of: - the loans coming from the left abstraction - - the borrows coming from the right abstraction *) - let intersect = MarkedBorrowId.Set.inter loans0 borrows1 in + - the borrows coming from the right abstraction + We will need to filter those (because the loan from the left will cancel + out with the borrow from the right) + *) + let intersect_concrete = MarkedBorrowId.Set.inter loans0 borrows1 in + let intersect_symbolic = + MarkedNormSymbProj.Set.inter loan_projs0 borrow_projs1 + in (* This function is called when handling shared loans: we have to apply a projection marker to a set of borrow ids. *) @@ -2591,148 +2665,233 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) |> Seq.map (fun x -> (pm, x)) |> MarkedBorrowId.Set.of_seq in - let bids = MarkedBorrowId.Set.diff bids intersect in + let bids = MarkedBorrowId.Set.diff bids intersect_concrete in sanity_check __FILE__ __LINE__ (not (MarkedBorrowId.Set.is_empty bids)) span; MarkedBorrowId.Set.to_seq bids |> Seq.map snd |> BorrowId.Set.of_seq in - let filter_bid (bid : marked_borrow_id) : marked_borrow_id option = - if MarkedBorrowId.Set.mem bid intersect then None else Some bid + let filter_concrete (bid : marked_borrow_id) : bool = + MarkedBorrowId.Set.mem bid intersect_concrete + in + let filter_symbolic (marked : marked_norm_symb_proj) : bool = + MarkedNormSymbProj.Set.mem marked intersect_symbolic in let borrow_is_merged id = MarkedBorrowId.Set.mem id !merged_borrows in + let borrow_proj_is_merged id = + MarkedNormSymbProj.Set.mem id !merged_borrow_projs + in let set_borrow_as_merged id = merged_borrows := MarkedBorrowId.Set.add id !merged_borrows in + let set_borrow_proj_as_merged id = + merged_borrow_projs := MarkedNormSymbProj.Set.add id !merged_borrow_projs + in let loan_is_merged id = MarkedBorrowId.Set.mem id !merged_loans in + let loan_proj_is_merged id = + MarkedNormSymbProj.Set.mem id !merged_loan_projs + in let set_loan_as_merged id = merged_loans := MarkedBorrowId.Set.add id !merged_loans in - let set_loans_as_merged pm ids = - BorrowId.Set.elements ids - |> List.map (fun x -> (pm, x)) - |> List.iter set_loan_as_merged + let set_loan_proj_as_merged id = + merged_loan_projs := MarkedNormSymbProj.Set.add id !merged_loan_projs + in + + let module Merge + (Set : Collections.Set) + (Map : Collections.Map with type key = Set.elt) + (Marked : sig + type borrow_content + type loan_content + + val to_string : Set.elt -> string + val borrow_is_merged : Set.elt -> bool + val loan_is_merged : Set.elt -> bool + val filter_marked : Set.elt -> bool + val set_borrow_as_merged : Set.elt -> unit + val set_loan_as_merged : Set.elt -> unit + val make_borrow_value : Set.elt -> borrow_content -> typed_avalue + + (** Return the list of marked values to mark as merged - this is important + for shared loans: the loan itself is identified by a single loan id, + but we need to mark *all* the loan ids contained in the set as merged. *) + val make_loan_value : + Set.elt -> loan_content -> Set.elt list * typed_avalue + end) = + struct + (* Iterate over all the borrows/loans found in the abstractions and merge them *) + let merge (borrow_to_content0 : Marked.borrow_content Map.t) + (borrow_to_content1 : Marked.borrow_content Map.t) + (loan_to_content0 : Marked.loan_content Map.t) + (loan_to_content1 : Marked.loan_content Map.t) + (borrows_loans : Set.elt borrow_or_loan list) : unit = + List.iter + (function + | Borrow marked -> + log#ldebug + (lazy + ("merge_abstractions: merging borrow " + ^ Marked.to_string marked)); + + (* Check if the borrow has already been merged - this can happen + because we go through all the borrows/loans in [abs0] *then* + all the borrows/loans in [abs1], and there may be duplicates + between the two *) + if Marked.borrow_is_merged marked then () + else ( + Marked.set_borrow_as_merged marked; + (* Check if we need to filter it *) + if Marked.filter_marked marked then () + else + (* Lookup the contents *) + let bc0 = Map.find_opt marked borrow_to_content0 in + let bc1 = Map.find_opt marked borrow_to_content1 in + (* Merge *) + let av : typed_avalue = + match (bc0, bc1) with + | None, Some bc | Some bc, None -> + Marked.make_borrow_value marked bc + | Some _, Some _ -> + (* Because of markers, the case where the same borrow is duplicated should + be unreachable. Note, this is due to all shared borrows currently + taking different ids, this will not be the case anymore when shared loans + will take a unique id instead of a set *) + craise __FILE__ __LINE__ span "Unreachable" + | None, None -> craise __FILE__ __LINE__ span "Unreachable" + in + push_borrow_avalue av) + | Loan marked -> + if + (* Check if the loan has already been treated - it can happen + for the same reason as for borrows, and also because shared + loans contain sets of borrows (meaning that when taking care + of one loan, we can merge several other loans at once). + *) + Marked.loan_is_merged marked + then () + else ( + (* Do not set the loans as merged yet *) + log#ldebug + (lazy + ("merge_abstractions: merging loan " + ^ Marked.to_string marked)); + (* Check if we need to filter it *) + if Marked.filter_marked marked then () + else + (* Lookup the contents *) + let lc0 = Map.find_opt marked loan_to_content0 in + let lc1 = Map.find_opt marked loan_to_content1 in + (* Merge *) + let ml, av = + match (lc0, lc1) with + | None, Some lc | Some lc, None -> + Marked.make_loan_value marked lc + | Some _, Some _ -> + (* With projection markers, shared loans should not be duplicated *) + craise __FILE__ __LINE__ span "Unreachable" + | None, None -> craise __FILE__ __LINE__ span "Unreachable" + in + List.iter Marked.set_loan_as_merged ml; + push_loan_avalue av)) + borrows_loans + end in + (* First merge the concrete borrows/loans *) + let module MergeConcrete = + Merge (MarkedBorrowId.Set) (MarkedBorrowId.Map) + (struct + type borrow_content = + ( ty * Values.borrow_content, + ty * Values.aborrow_content ) + concrete_or_abs + + type loan_content = + (ty * Values.loan_content, ty * Values.aloan_content) concrete_or_abs + + let to_string = MarkedBorrowId.to_string + let borrow_is_merged = borrow_is_merged + let loan_is_merged = loan_is_merged + let filter_marked = filter_concrete + let set_borrow_as_merged = set_borrow_as_merged + let set_loan_as_merged = set_loan_as_merged + + let make_borrow_value _ bc : typed_avalue = + match bc with + | Concrete _ -> + (* This can happen only in case of nested borrows - a concrete + borrow can only happen inside a shared loan *) + craise __FILE__ __LINE__ span "Unreachable" + | Abstract (ty, bc) -> { value = ABorrow bc; ty } + + let make_loan_value _ lc : marked_borrow_id list * typed_avalue = + match lc with + | Concrete _ -> + (* This shouldn't happen because the avalues should + have been destructured. *) + craise __FILE__ __LINE__ span "Unreachable" + | Abstract (ty, lc) -> ( + match lc with + | ASharedLoan (pm, bids, sv, child) -> + let bids = filter_bids pm bids in + sanity_check __FILE__ __LINE__ + (not (BorrowId.Set.is_empty bids)) + span; + sanity_check __FILE__ __LINE__ (is_aignored child.value) span; + sanity_check __FILE__ __LINE__ + (not (value_has_loans_or_borrows (Some span) ctx sv.value)) + span; + let marked_bids = + List.map (fun bid -> (pm, bid)) (BorrowId.Set.elements bids) + in + let lc = ASharedLoan (pm, bids, sv, child) in + (marked_bids, { value = ALoan lc; ty }) + | AMutLoan (pm, bid, _) -> + ([ (pm, bid) ], { value = ALoan lc; ty }) + | AEndedMutLoan _ + | AEndedSharedLoan _ + | AIgnoredMutLoan _ + | AEndedIgnoredMutLoan _ + | AIgnoredSharedLoan _ -> + (* The abstraction has been destructured, so those shouldn't appear *) + craise __FILE__ __LINE__ span "Unreachable") + end) in - (* Note that we first explore the borrows/loans of [abs0], because we want to merge *into* this abstraction, and as a consequence we want to preserve its structure as much as we can *) let borrows_loans = List.append borrows_loans0 borrows_loans1 in - (* Iterate over all the borrows/loans ids found in the abstractions *) - List.iter - (fun bl -> - match bl with - | BorrowId (pm, bid) -> - let bid = (pm, bid) in - log#ldebug - (lazy - ("merge_abstractions: merging borrow " - ^ MarkedBorrowId.to_string bid)); - - (* Check if the borrow has already been merged - this can happen - because we go through all the borrows/loans in [abs0] *then* - all the borrows/loans in [abs1], and there may be duplicates - between the two *) - if borrow_is_merged bid then () - else ( - set_borrow_as_merged bid; - (* Check if we need to filter it *) - match filter_bid bid with - | None -> () - | Some bid -> - (* Lookup the contents *) - let bc0 = MarkedBorrowId.Map.find_opt bid borrow_to_content0 in - let bc1 = MarkedBorrowId.Map.find_opt bid borrow_to_content1 in - (* Merge *) - let av : typed_avalue = - match (bc0, bc1) with - | None, Some bc | Some bc, None -> ( - match bc with - | Concrete (_, _) -> - (* This can happen only in case of nested borrows - - a concrete borrow can only happen inside a shared - loan - *) - craise __FILE__ __LINE__ span "Unreachable" - | Abstract (ty, bc) -> { value = ABorrow bc; ty }) - | Some _, Some _ -> - (* Because of markers, the case where the same borrow is duplicated should - be unreachable. Note, this is due to all shared borrows currently - taking different ids, this will not be the case anymore when shared loans - will take a unique id instead of a set *) - craise __FILE__ __LINE__ span "Unreachable" - | None, None -> craise __FILE__ __LINE__ span "Unreachable" - in - push_avalue av) - | LoanId (pm, bid) -> - let bid = (pm, bid) in - if - (* Check if the loan has already been treated - it can happen - for the same reason as for borrows, and also because shared - loans contain sets of borrows (meaning that when taking care - of one loan, we can merge several other loans at once). - *) - loan_is_merged bid - then () - else ( - log#ldebug - (lazy - ("merge_abstractions: merging loan " - ^ MarkedBorrowId.to_string bid)); - - (* Check if we need to filter it *) - match filter_bid bid with - | None -> () - | Some bid -> - (* Lookup the contents *) - let lc0 = MarkedBorrowId.Map.find_opt bid loan_to_content0 in - let lc1 = MarkedBorrowId.Map.find_opt bid loan_to_content1 in - (* Merge *) - let av : typed_avalue option = - match (lc0, lc1) with - | None, Some lc | Some lc, None -> ( - match lc with - | Concrete _ -> - (* This shouldn't happen because the avalues should - have been destructured. *) - craise __FILE__ __LINE__ span "Unreachable" - | Abstract (ty, lc) -> ( - match lc with - | ASharedLoan (pm, bids, sv, child) -> - let bids = filter_bids pm bids in - sanity_check __FILE__ __LINE__ - (not (BorrowId.Set.is_empty bids)) - span; - sanity_check __FILE__ __LINE__ - (is_aignored child.value) span; - sanity_check __FILE__ __LINE__ - (not - (value_has_loans_or_borrows (Some span) ctx - sv.value)) - span; - let lc = ASharedLoan (pm, bids, sv, child) in - set_loans_as_merged pm bids; - Some { value = ALoan lc; ty } - | AMutLoan _ -> - set_loan_as_merged bid; - Some { value = ALoan lc; ty } - | AEndedMutLoan _ - | AEndedSharedLoan _ - | AIgnoredMutLoan _ - | AEndedIgnoredMutLoan _ - | AIgnoredSharedLoan _ -> - (* The abstraction has been destructured, so those shouldn't appear *) - craise __FILE__ __LINE__ span "Unreachable")) - | Some _, Some _ -> - (* With projection markers, shared loans should not be duplicated *) - craise __FILE__ __LINE__ span "Unreachable" - | None, None -> craise __FILE__ __LINE__ span "Unreachable" - in - push_opt_avalue av)) - borrows_loans; + MergeConcrete.merge borrow_to_content0 borrow_to_content1 loan_to_content0 + loan_to_content1 borrows_loans; + + (* Do the same for the symbolic projections *) + let borrows_loans = List.append borrow_loan_projs0 borrow_loan_projs1 in + (* First merge the concrete borrows/loans *) + let module MergeSymbolic = + Merge (MarkedNormSymbProj.Set) (MarkedNormSymbProj.Map) + (struct + type borrow_content = ty * proj_marker * aproj + type loan_content = ty * proj_marker * aproj + + let to_string = MarkedNormSymbProj.to_string + let borrow_is_merged = borrow_proj_is_merged + let loan_is_merged = loan_proj_is_merged + let filter_marked = filter_symbolic + let set_borrow_as_merged = set_borrow_proj_as_merged + let set_loan_as_merged = set_loan_proj_as_merged + + let make_borrow_value _ (ty, pm, proj) = + { value = ASymbolic (pm, proj); ty } + + let make_loan_value marked (ty, pm, proj) = + ([ marked ], { value = ASymbolic (pm, proj); ty }) + end) + in + MergeSymbolic.merge borrow_proj_to_content0 borrow_proj_to_content1 + loan_proj_to_content0 loan_proj_to_content1 borrows_loans; (* Reverse the avalues (we visited the loans/borrows in order, but pushed - new values at the beggining of the stack of avalues) *) - List.rev !avalues + new values at the beggining of the stack of avalues). Also note that we + put the borrows, then the loans. *) + List.rev !borrow_avalues @ List.rev !loan_avalues (** Auxiliary function for {!merge_abstractions}. @@ -3115,6 +3274,9 @@ let merge_into_first_abstraction (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) (merge_funs : merge_duplicates_funcs option) (ctx : eval_ctx) (abs_id0 : AbstractionId.id) (abs_id1 : AbstractionId.id) : eval_ctx * AbstractionId.id = + (* Small sanity check *) + sanity_check __FILE__ __LINE__ (abs_id0 <> abs_id1) span; + (* Lookup the abstractions *) let abs0 = ctx_lookup_abs ctx abs_id0 in let abs1 = ctx_lookup_abs ctx abs_id1 in From 0fd18c6f94b06a9e15a51d39c2969f64204a1bc2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sat, 4 Jan 2025 15:31:56 +0100 Subject: [PATCH 05/23] Make more progress on updating the join --- src/interp/InterpreterBorrows.ml | 468 +++++++++++++++++------- src/interp/InterpreterBorrows.mli | 48 +++ src/interp/InterpreterBorrowsCore.ml | 36 ++ src/interp/InterpreterLoopsJoinCtxs.ml | 36 ++ src/interp/InterpreterLoopsMatchCtxs.ml | 12 + 5 files changed, 477 insertions(+), 123 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index e3f0aba00..08ff2ab2d 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -2191,7 +2191,8 @@ type merge_abstraction_info = { contain shared loans). *) let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) - (abs : abs) : merge_abstraction_info = + (owned_regions : RegionId.Set.t) (avalues : typed_avalue list) : + merge_abstraction_info = let loans : MarkedBorrowId.Set.t ref = ref MarkedBorrowId.Set.empty in let borrows : MarkedBorrowId.Set.t ref = ref MarkedBorrowId.Set.empty in let loan_projs = ref MarkedNormSymbProj.Set.empty in @@ -2236,13 +2237,13 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) Push (MarkedNormSymbProj.Set) (MarkedNormSymbProj.Map) in let push_loan_proj pm sv_id proj_ty lc = - let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in + let norm_proj_ty = normalize_proj_ty owned_regions proj_ty in let proj = { pm; sv_id; norm_proj_ty } in PushSymbolic.push loan_projs lc loan_proj_to_content false borrow_loan_projs proj in let push_borrow_proj pm sv_id proj_ty bc = - let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in + let norm_proj_ty = normalize_proj_ty owned_regions proj_ty in let proj = { pm; sv_id; norm_proj_ty } in PushSymbolic.push borrow_projs bc borrow_proj_to_content true borrow_loan_projs proj @@ -2344,7 +2345,7 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) end in - List.iter (iter_avalues#visit_typed_avalue None) abs.avalues; + List.iter (iter_avalues#visit_typed_avalue None) avalues; { loans = !loans; @@ -2431,6 +2432,54 @@ type merge_duplicates_funcs = { - [sv1] - [child1] *) + merge_aborrow_projs : + ty -> + proj_marker -> + symbolic_value -> + ty -> + (msymbolic_value * aproj) list -> + ty -> + proj_marker -> + symbolic_value -> + ty -> + (msymbolic_value * aproj) list -> + typed_avalue; + (** Parameters: + - [ty0] + - [pm0] + - [sv0] + - [proj_ty0] + - [children0] + - [ty1] + - [pm1] + - [sv1] + - [proj_ty1] + - [children1] + *) + merge_aloan_projs : + ty -> + proj_marker -> + symbolic_value -> + ty -> + (msymbolic_value * aproj) list -> + ty -> + proj_marker -> + symbolic_value -> + ty -> + (msymbolic_value * aproj) list -> + typed_avalue; + (** Parameters: + - [ty0] + - [pm0] + - [sv0] + - [proj_ty0] + - [children0] + - [ty1] + - [pm1] + - [sv1] + - [proj_ty1] + - [children1] + *) } (** Small utility: if a value doesn't have any marker, split it into two values @@ -2558,7 +2607,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) borrow_to_content = borrow_to_content0; borrow_proj_to_content = borrow_proj_to_content0; } = - compute_merge_abstraction_info span ctx abs0 + compute_merge_abstraction_info span ctx abs0.regions.owned abs0.avalues in let { @@ -2573,7 +2622,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) borrow_to_content = borrow_to_content1; borrow_proj_to_content = borrow_proj_to_content1; } = - compute_merge_abstraction_info span ctx abs1 + compute_merge_abstraction_info span ctx abs1.regions.owned abs1.avalues in (* Sanity check: no markers appear unless we allow merging duplicates. @@ -2907,24 +2956,15 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) *) let merge_abstractions_merge_markers (span : Meta.span) (merge_funs : merge_duplicates_funcs option) (ctx : eval_ctx) - (abs_values : typed_avalue list) : typed_avalue list = + (owned_regions : RegionId.Set.t) (avalues : typed_avalue list) : + typed_avalue list = log#ldebug (lazy ("merge_abstractions_merge_markers:\n- avalues:\n" - ^ String.concat ", " (List.map (typed_avalue_to_string ctx) abs_values))); + ^ String.concat ", " (List.map (typed_avalue_to_string ctx) avalues))); (* We linearly traverse the list of avalues created through the first phase. *) - (* Utilities to accumulate the list of values resulting from the merge *) - let avalues = ref [] in - let push_avalue av = - log#ldebug - (lazy - ("merge_abstractions_merge_markers: push_avalue: " - ^ typed_avalue_to_string ~span:(Some span) ctx av)); - avalues := av :: !avalues - in - (* Compute some relevant information *) let { loans = _; @@ -2932,8 +2972,23 @@ let merge_abstractions_merge_markers (span : Meta.span) borrows_loans; loan_to_content; borrow_to_content; + loan_projs = _; + borrow_projs = _; + borrow_loan_projs; + loan_proj_to_content; + borrow_proj_to_content; } = - compute_merge_abstraction_info span ctx abs_values + compute_merge_abstraction_info span ctx owned_regions avalues + in + + (* Utilities to accumulate the list of values resulting from the merge *) + let avalues = ref [] in + let push_avalue av = + log#ldebug + (lazy + ("merge_abstractions_merge_markers: push_avalue: " + ^ typed_avalue_to_string ~span:(Some span) ctx av)); + avalues := av :: !avalues in (* We will merge elements with the same borrow/loan id, but with different markers. @@ -2943,18 +2998,44 @@ let merge_abstractions_merge_markers (span : Meta.span) of values to insert in the resulting abstraction). *) let merged_borrows = ref BorrowId.Set.empty in let merged_loans = ref BorrowId.Set.empty in + let merged_borrow_projs = ref NormSymbProj.Set.empty in + let merged_loan_projs = ref NormSymbProj.Set.empty in let borrow_is_merged id = BorrowId.Set.mem id !merged_borrows in let set_borrow_as_merged id = merged_borrows := BorrowId.Set.add id !merged_borrows in + let borrow_proj_is_merged m = + NormSymbProj.Set.mem + (marked_norm_symb_proj_to_unmarked m) + !merged_borrow_projs + in + let set_borrow_proj_as_merged m = + merged_borrow_projs := + NormSymbProj.Set.add + (marked_norm_symb_proj_to_unmarked m) + !merged_borrow_projs + in + let loan_is_merged id = BorrowId.Set.mem id !merged_loans in let set_loan_as_merged id = merged_loans := BorrowId.Set.add id !merged_loans in let set_loans_as_merged ids = BorrowId.Set.iter set_loan_as_merged ids in + let loan_proj_is_merged m = + NormSymbProj.Set.mem + (marked_norm_symb_proj_to_unmarked m) + !merged_loan_projs + in + let set_loan_proj_as_merged m = + merged_loan_projs := + NormSymbProj.Set.add + (marked_norm_symb_proj_to_unmarked m) + !merged_loan_projs + in + (* Recreates an avalue from a borrow_content. *) let avalue_from_bc = function | Concrete (_, _) -> @@ -2978,6 +3059,19 @@ let merge_abstractions_merge_markers (span : Meta.span) { value = ALoan bc; ty } in + (* Recreates an avalue from a borrow projector. *) + let avalue_from_borrow_proj ((ty, pm, proj) : ty * proj_marker * aproj) : + typed_avalue = + { value = ASymbolic (pm, proj); ty } + in + + (* Recreates an avalue from a loan_content, and adds the set of loan ids as merged. + See the comment in the loop below for a detailed explanation *) + let avalue_from_loan_proj ((ty, pm, proj) : ty * proj_marker * aproj) : + typed_avalue = + { value = ASymbolic (pm, proj); ty } + in + let complementary_markers pm0 pm1 = (pm0 = PLeft && pm1 = PRight) || (pm0 = PRight && pm1 = PLeft) in @@ -2989,14 +3083,14 @@ let merge_abstractions_merge_markers (span : Meta.span) match (bc0, bc1) with | AMutBorrow (pm0, id0, child0), AMutBorrow (pm1, id1, child1) -> (* Sanity-check of the precondition *) - sanity_check __FILE__ __LINE__ (id0 = id1) span; sanity_check __FILE__ __LINE__ (complementary_markers pm0 pm1) span; + sanity_check __FILE__ __LINE__ (id0 = id1) span; (Option.get merge_funs).merge_amut_borrows id0 ty0 pm0 child0 ty1 pm1 child1 | ASharedBorrow (pm0, id0), ASharedBorrow (pm1, id1) -> (* Sanity-check of the precondition *) - sanity_check __FILE__ __LINE__ (id0 = id1) span; sanity_check __FILE__ __LINE__ (complementary_markers pm0 pm1) span; + sanity_check __FILE__ __LINE__ (id0 = id1) span; (Option.get merge_funs).merge_ashared_borrows id0 ty0 pm0 ty1 pm1 | AProjSharedBorrow _, AProjSharedBorrow _ -> (* Unreachable because requires nested borrows *) @@ -3041,17 +3135,17 @@ let merge_abstractions_merge_markers (span : Meta.span) match (lc0, lc1) with | AMutLoan (pm0, id0, child0), AMutLoan (pm1, id1, child1) -> (* Sanity-check of the precondition *) - sanity_check __FILE__ __LINE__ (id0 = id1) span; sanity_check __FILE__ __LINE__ (complementary_markers pm0 pm1) span; + sanity_check __FILE__ __LINE__ (id0 = id1) span; (* Merge *) (Option.get merge_funs).merge_amut_loans id0 ty0 pm0 child0 ty1 pm1 child1 | ASharedLoan (pm0, ids0, sv0, child0), ASharedLoan (pm1, ids1, sv1, child1) -> - sanity_check __FILE__ __LINE__ (complementary_markers pm0 pm1) span; (* Check that the sets of ids are the same - if it is not the case, it means we actually need to merge more than 2 avalues: we ignore this case for now *) + sanity_check __FILE__ __LINE__ (complementary_markers pm0 pm1) span; sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids0 ids1) span; let ids = ids0 in (* Merge *) @@ -3079,6 +3173,39 @@ let merge_abstractions_merge_markers (span : Meta.span) craise __FILE__ __LINE__ span "Unreachable" in + let merge_borrow_projs ((ty0, pm0, proj0) : ty * proj_marker * aproj) + ((ty1, pm1, proj1) : ty * proj_marker * aproj) : typed_avalue = + sanity_check __FILE__ __LINE__ (complementary_markers pm0 pm1) span; + match (proj0, proj1) with + | AProjBorrows (sv0, proj_ty0, child0), AProjBorrows (sv1, proj_ty1, child1) + -> + (* Sanity-check of the precondition *) + sanity_check __FILE__ __LINE__ (sv0 = sv1) span; + (* Merge *) + (Option.get merge_funs).merge_aborrow_projs ty0 pm0 sv0 proj_ty0 child0 + ty1 pm1 sv1 proj_ty1 child1 + | _ -> + (* Unreachable because those cases are ignored (ended/ignored borrows) + or inconsistent *) + craise __FILE__ __LINE__ span "Unreachable" + in + + let merge_loan_projs ((ty0, pm0, proj0) : ty * proj_marker * aproj) + ((ty1, pm1, proj1) : ty * proj_marker * aproj) : typed_avalue = + sanity_check __FILE__ __LINE__ (complementary_markers pm0 pm1) span; + match (proj0, proj1) with + | AProjLoans (sv0, proj_ty0, child0), AProjLoans (sv1, proj_ty1, child1) -> + (* Sanity-check of the precondition *) + sanity_check __FILE__ __LINE__ (sv0 = sv1) span; + (* Merge *) + (Option.get merge_funs).merge_aloan_projs ty0 pm0 sv0 proj_ty0 child0 + ty1 pm1 sv1 proj_ty1 child1 + | _ -> + (* Unreachable because those cases are ignored (ended/ignored borrows) + or inconsistent *) + craise __FILE__ __LINE__ span "Unreachable" + in + let invert_proj_marker = function | PNone -> craise __FILE__ __LINE__ span "Unreachable" | PLeft -> PRight @@ -3090,101 +3217,192 @@ let merge_abstractions_merge_markers (span : Meta.span) we remove both elements, and insert the same element but with no marker. Importantly, attempting the merge when first seeing a marked element allows us to preserve - the structure of the abstraction we are merging into (abs0). During phase 1, we traversed - the borrow_loans of the abs 0 first, and hence these elements are at the top of the list *) - List.iter - (function - | BorrowId (PNone, bid) -> - sanity_check __FILE__ __LINE__ (not (borrow_is_merged bid)) span; - (* This element has no marker. We do not filter it, hence we retrieve the - contents and inject it into the avalues list *) - let bc = MarkedBorrowId.Map.find (PNone, bid) borrow_to_content in - push_avalue (avalue_from_bc bc); - (* Setting the borrow as merged is not really necessary but we do it - for consistency, and this allows us to do some sanity checks. *) - set_borrow_as_merged bid - | BorrowId (pm, bid) -> - (* Check if the borrow has already been merged. If so, it means we already - added the merged value to the avalues list, and we can thus skip it *) - if borrow_is_merged bid then () - else ( - (* Not merged: set it as merged *) - set_borrow_as_merged bid; - (* Lookup the content of the borrow *) - let bc0 = MarkedBorrowId.Map.find (pm, bid) borrow_to_content in - (* Check if there exists the same borrow but with the complementary marker *) - let obc1 = - MarkedBorrowId.Map.find_opt - (invert_proj_marker pm, bid) - borrow_to_content - in - match obc1 with - | None -> - (* No dual element found, we keep the current one in the list of avalues, - with the same marker *) - push_avalue (avalue_from_bc bc0) - | Some bc1 -> - (* We have borrows with left and right markers in the environment. - We merge their values, and push the result to the list of avalues. - The merge will also remove the projection marker *) - push_avalue (merge_g_borrow_contents bc0 bc1)) - | LoanId (PNone, bid) -> - (* Since we currently have a set of loan ids associated to a shared_borrow, we can - have several loan ids associated to the same element. Hence, we need to ensure - that we did not add the corresponding element previously. - - To do so, we use the loan id merged set for both marked and unmarked values. - The assumption is that we should not have the same loan id for both an unmarked - element and a marked element. It might be better to sanity-check this. - - Adding the loan id to the merged set will be done inside avalue_from_lc. - - Rem: Once we move to a single loan id per shared_loan, this should not be needed - anymore. - *) - if loan_is_merged bid then () - else - let lc = MarkedBorrowId.Map.find (PNone, bid) loan_to_content in - push_avalue (avalue_from_lc lc); - (* Mark as merged *) - let ids = loan_content_to_ids lc in - set_loans_as_merged ids - | LoanId (pm, bid) -> ( - if - (* Check if the loan has already been merged. If so, we skip it. *) - loan_is_merged bid - then () - else - let lc0 = MarkedBorrowId.Map.find (pm, bid) loan_to_content in - let olc1 = - MarkedBorrowId.Map.find_opt - (invert_proj_marker pm, bid) - loan_to_content - in - (* Mark as merged *) - let ids0 = loan_content_to_ids lc0 in - set_loans_as_merged ids0; - match olc1 with - | None -> - (* No dual element found, we keep the current one with the same marker *) - push_avalue (avalue_from_lc lc0) - | Some lc1 -> - push_avalue (merge_g_loan_contents lc0 lc1); + the structure of the abstraction we are merging into (i.e., abs0). Note that during phase 1, + we traversed the borrow/loans of the abs 0 first, and hence these elements are at the top of + the list. *) + let module Merge + (Set : Collections.Set) + (Map : Collections.Map with type key = Set.elt) + (Marked : sig + type borrow_content + type loan_content + type loan_id_set + + val get_marker : Set.elt -> proj_marker + val invert_marker : Set.elt -> Set.elt + val borrow_is_merged : Set.elt -> bool + val loan_is_merged : Set.elt -> bool + val set_borrow_as_merged : Set.elt -> unit + val set_loans_as_merged : loan_id_set -> unit + val loan_content_to_ids : loan_content -> loan_id_set + val avalue_from_bc : borrow_content -> typed_avalue + val avalue_from_lc : loan_content -> typed_avalue + + val merge_borrow_contents : + borrow_content -> borrow_content -> typed_avalue + + val merge_loan_contents : loan_content -> loan_content -> typed_avalue + end) = + struct + let merge (borrow_to_content : Marked.borrow_content Map.t) + (loan_to_content : Marked.loan_content Map.t) borrows_loans = + List.iter + (function + | Borrow marked -> + (* Case disjunction: no marker/marker *) + if Marked.get_marker marked = PNone then begin + sanity_check __FILE__ __LINE__ + (not (Marked.borrow_is_merged marked)) + span; + (* This element has no marker. We do not filter it, hence we retrieve the + contents and inject it into the avalues list *) + let bc = Map.find marked borrow_to_content in + push_avalue (Marked.avalue_from_bc bc); + (* Setting the borrow as merged is not really necessary but we do it + for consistency, and this allows us to do some sanity checks. *) + Marked.set_borrow_as_merged marked + end + else if + (* Check if the borrow has already been merged. If so, it means we already + added the merged value to the avalues list, and we can thus skip it *) + Marked.borrow_is_merged marked + then () + else ( + (* Not merged: set it as merged *) + Marked.set_borrow_as_merged marked; + (* Lookup the content of the borrow *) + let bc0 = Map.find marked borrow_to_content in + (* Check if there exists the same borrow but with the complementary marker *) + let obc1 = + Map.find_opt (Marked.invert_marker marked) borrow_to_content + in + match obc1 with + | None -> + (* No dual element found, we keep the current one in the list of avalues, + with the same marker *) + push_avalue (Marked.avalue_from_bc bc0) + | Some bc1 -> + (* We have borrows with left and right markers in the environment. + We merge their values, and push the result to the list of avalues. + The merge will also remove the projection marker *) + push_avalue (Marked.merge_borrow_contents bc0 bc1)) + | Loan marked -> ( + if + (* Case disjunction: no marker/marker *) + Marked.get_marker marked = PNone + then ( + if + (* Since we currently have a set of loan ids associated to a shared_borrow, we can + have several loan ids associated to the same element. Hence, we need to ensure + that we did not previously add the corresponding element. + + To do so, we use the loan id merged set for both marked and unmarked values. + The assumption is that we should not have the same loan id for both an unmarked + element and a marked element. It might be better to sanity-check this. + + Adding the loan id to the merged set will be done inside avalue_from_lc. + + Remark: Once we move to a single loan id per shared_loan, this should not + be needed anymore. + *) + Marked.loan_is_merged marked + then () + else + let lc = Map.find marked loan_to_content in + push_avalue (Marked.avalue_from_lc lc); + (* Mark as merged *) + let ids = Marked.loan_content_to_ids lc in + Marked.set_loans_as_merged ids) + else if + (* Check if the loan has already been merged. If so, we skip it. *) + Marked.loan_is_merged marked + then () + else + let lc0 = Map.find marked loan_to_content in + let olc1 = + Map.find_opt (Marked.invert_marker marked) loan_to_content + in (* Mark as merged *) - let ids1 = loan_content_to_ids lc1 in - set_loans_as_merged ids1)) - borrows_loans; + let ids0 = Marked.loan_content_to_ids lc0 in + Marked.set_loans_as_merged ids0; + match olc1 with + | None -> + (* No dual element found, we keep the current one with the same marker *) + push_avalue (Marked.avalue_from_lc lc0) + | Some lc1 -> + push_avalue (Marked.merge_loan_contents lc0 lc1); + (* Mark as merged *) + let ids1 = Marked.loan_content_to_ids lc1 in + Marked.set_loans_as_merged ids1)) + borrows_loans + end in + (* Merge the concrete borrows/loans *) + let module MergeConcrete = + Merge (MarkedBorrowId.Set) (MarkedBorrowId.Map) + (struct + type borrow_content = g_borrow_content_with_ty + type loan_content = g_loan_content_with_ty + type loan_id_set = Values.loan_id_set + + let get_marker (pm, _) = pm + let invert_marker (pm, bid) = (invert_proj_marker pm, bid) + let borrow_is_merged (_, bid) = borrow_is_merged bid + let loan_is_merged (_, bid) = loan_is_merged bid + let set_borrow_as_merged (_, bid) = set_borrow_as_merged bid + let set_loans_as_merged bids = set_loans_as_merged bids + let loan_content_to_ids = loan_content_to_ids + let avalue_from_bc = avalue_from_bc + let avalue_from_lc = avalue_from_lc + let merge_borrow_contents = merge_g_borrow_contents + let merge_loan_contents = merge_g_loan_contents + end) + in + MergeConcrete.merge borrow_to_content loan_to_content borrows_loans; - let avalues = List.rev !avalues in + (* Merge the symbolic borrows/loans *) + let module MergeSymbolic = + Merge (MarkedNormSymbProj.Set) (MarkedNormSymbProj.Map) + (struct + type borrow_content = ty * proj_marker * aproj + type loan_content = ty * proj_marker * aproj + type loan_id_set = marked_norm_symb_proj + + let get_marker marked = marked.pm + + let invert_marker marked = + { marked with pm = invert_proj_marker marked.pm } + + let borrow_is_merged marked = borrow_proj_is_merged marked + let loan_is_merged marked = loan_proj_is_merged marked + let set_borrow_as_merged marked = set_borrow_proj_as_merged marked + let set_loans_as_merged bids = set_loan_proj_as_merged bids + + let loan_content_to_ids ((_, pm, proj) : ty * proj_marker * aproj) : + marked_norm_symb_proj = + match proj with + | AProjLoans (sv, proj_ty, _) -> + let norm_proj_ty = normalize_proj_ty owned_regions proj_ty in + { pm; sv_id = sv.sv_id; norm_proj_ty } + | _ -> internal_error __FILE__ __LINE__ span + + let avalue_from_bc = avalue_from_borrow_proj + let avalue_from_lc = avalue_from_loan_proj + let merge_borrow_contents = merge_borrow_projs + let merge_loan_contents = merge_loan_projs + end) + in + MergeSymbolic.merge borrow_proj_to_content loan_proj_to_content + borrow_loan_projs; (* Reorder the avalues. We want the avalues to have the borrows first, then the loans (this structure is more stable when we merge abstractions together, meaning it is easier to find fixed points). *) + let avalues = List.rev !avalues in let is_borrow (av : typed_avalue) : bool = match av.value with - | ABorrow _ -> true - | ALoan _ -> false + | ABorrow _ | ASymbolic (_, AProjBorrows _) -> true + | ALoan _ | ASymbolic (_, AProjLoans _) -> false | _ -> craise __FILE__ __LINE__ span "Unexpected" in let aborrows, aloans = List.partition is_borrow avalues in @@ -3217,20 +3435,8 @@ let merge_abstractions (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) (abs_is_destructured span destructure_shared_values ctx abs1) span); - (* Phase 1: simplify the loans coming from the left abstraction with - the borrows coming from the right abstraction. *) - let avalues = - merge_abstractions_merge_loan_borrow_pairs span merge_funs ctx abs0 abs1 - in - - (* Phase 2: we now remove markers, by merging pairs of the same element with - different markers into one element. To do so, we linearly traverse the list - of avalues created through the first phase. *) - let avalues = merge_abstractions_merge_markers span merge_funs ctx avalues in - - (* Create the new abstraction *) - let abs_id = fresh_abstraction_id () in - (* Note that one of the two abstractions might a parent of the other *) + (* Compute the ancestor regions, owned regions, etc. + Note that one of the two abstractions might a parent of the other *) let parents = AbstractionId.Set.diff (AbstractionId.Set.union abs0.parents abs1.parents) @@ -3246,6 +3452,22 @@ let merge_abstractions (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) in { owned; ancestors } in + + (* Phase 1: simplify the loans coming from the left abstraction with + the borrows coming from the right abstraction. *) + let avalues = + merge_abstractions_merge_loan_borrow_pairs span merge_funs ctx abs0 abs1 + in + + (* Phase 2: we now remove markers, by merging pairs of the same element with + different markers into one element. To do so, we linearly traverse the list + of avalues created through the first phase. *) + let avalues = + merge_abstractions_merge_markers span merge_funs ctx regions.owned avalues + in + + (* Create the new abstraction *) + let abs_id = fresh_abstraction_id () in let abs = { abs_id; diff --git a/src/interp/InterpreterBorrows.mli b/src/interp/InterpreterBorrows.mli index f8fd819ff..d84ded8a2 100644 --- a/src/interp/InterpreterBorrows.mli +++ b/src/interp/InterpreterBorrows.mli @@ -208,6 +208,54 @@ type merge_duplicates_funcs = { - [sv1] - [child1] *) + merge_aborrow_projs : + ty -> + proj_marker -> + symbolic_value -> + ty -> + (msymbolic_value * aproj) list -> + ty -> + proj_marker -> + symbolic_value -> + ty -> + (msymbolic_value * aproj) list -> + typed_avalue; + (** Parameters: + - [ty0] + - [pm0] + - [sv0] + - [proj_ty0] + - [children0] + - [ty1] + - [pm1] + - [sv1] + - [proj_ty1] + - [children1] + *) + merge_aloan_projs : + ty -> + proj_marker -> + symbolic_value -> + ty -> + (msymbolic_value * aproj) list -> + ty -> + proj_marker -> + symbolic_value -> + ty -> + (msymbolic_value * aproj) list -> + typed_avalue; + (** Parameters: + - [ty0] + - [pm0] + - [sv0] + - [proj_ty0] + - [children0] + - [ty1] + - [pm1] + - [sv1] + - [proj_ty1] + - [children1] + *) } (** Merge an abstraction into another abstraction. diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index 3d1faab07..2cd62578c 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -1393,6 +1393,42 @@ with type t = marked_norm_symb_proj = struct module Map = MarkedNormSymbProjMap end +type norm_symb_proj = { sv_id : symbolic_value_id; norm_proj_ty : ty } +[@@deriving show, ord] + +module NormSymbProjOrd = struct + type t = norm_symb_proj + + let compare = compare_norm_symb_proj + let to_string = show_norm_symb_proj + let pp_t = pp_norm_symb_proj + let show_t = show_norm_symb_proj +end + +module NormSymbProjSet = Collections.MakeSet (NormSymbProjOrd) +module NormSymbProjMap = Collections.MakeMap (NormSymbProjOrd) + +module NormSymbProj : sig + type t + + val to_string : t -> string + + module Set : Collections.Set with type elt = t + module Map : Collections.Map with type key = t +end +with type t = norm_symb_proj = struct + type t = norm_symb_proj + + let to_string = show_norm_symb_proj + + module Set = NormSymbProjSet + module Map = NormSymbProjMap +end + +let marked_norm_symb_proj_to_unmarked (m : marked_norm_symb_proj) : + norm_symb_proj = + { sv_id = m.sv_id; norm_proj_ty = m.norm_proj_ty } + (** Normalize a projection type by replacing the projected regions with ['0] and the non-projected ones with ['_]. diff --git a/src/interp/InterpreterLoopsJoinCtxs.ml b/src/interp/InterpreterLoopsJoinCtxs.ml index 2b778b2c6..eb0a21765 100644 --- a/src/interp/InterpreterLoopsJoinCtxs.ml +++ b/src/interp/InterpreterLoopsJoinCtxs.ml @@ -803,11 +803,47 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span) let value = ALoan (ASharedLoan (PNone, ids, sv, child)) in { value; ty } in + let merge_aborrow_projs ty0 _pm0 (sv0 : symbolic_value) proj_ty0 children0 + _ty1 _pm1 (sv1 : symbolic_value) _proj_ty1 children1 = + (* Sanity checks *) + sanity_check __FILE__ __LINE__ (children0 = []) span; + sanity_check __FILE__ __LINE__ (children1 = []) span; + (* Same remarks as for [merge_amut_borrows]. + + This time we need to also merge the symbolic values. We rely on the + join matcher [JM] to do so. + *) + let ty = ty0 in + let proj_ty = proj_ty0 in + let children = [] in + let sv = JM.match_symbolic_values ctx ctx sv0 sv1 in + let value = ASymbolic (PNone, AProjBorrows (sv, proj_ty, children)) in + { value; ty } + in + let merge_aloan_projs ty0 _pm0 (sv0 : symbolic_value) proj_ty0 children0 _ty1 + _pm1 (sv1 : symbolic_value) _proj_ty1 children1 = + (* Sanity checks *) + sanity_check __FILE__ __LINE__ (children0 = []) span; + sanity_check __FILE__ __LINE__ (children1 = []) span; + (* Same remarks as for [merge_amut_borrows]. + + This time we need to also merge the symbolic values. We rely on the + join matcher [JM] to do so. + *) + let ty = ty0 in + let proj_ty = proj_ty0 in + let children = [] in + let sv = JM.match_symbolic_values ctx ctx sv0 sv1 in + let value = ASymbolic (PNone, AProjLoans (sv, proj_ty, children)) in + { value; ty } + in { merge_amut_borrows; merge_ashared_borrows; merge_amut_loans; merge_ashared_loans; + merge_aborrow_projs; + merge_aloan_projs; } let merge_into_first_abstraction (span : Meta.span) (loop_id : LoopId.id) diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index 99feee73c..a8d7baf6a 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -61,11 +61,22 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) (* Update *) Some (S.add id1 ids)) !map + + let register_abs_id (id : AbstractionId.id) + (map : S.t AbstractionId.Map.t ref) = + if AbstractionId.Map.mem id !map then () + else map := AbstractionId.Map.add id S.empty !map end in let module RAbsBorrow = R (AbstractionId.Map) (MarkedBorrowId.Set) in let module RBorrowAbs = R (MarkedBorrowId.Map) (AbstractionId.Set) in let module RAbsSymbProj = R (AbstractionId.Map) (MarkedNormSymbProj.Set) in let module RSymbProjAbs = R (MarkedNormSymbProj.Map) (AbstractionId.Set) in + let register_abs_id abs_id = + RAbsBorrow.register_abs_id abs_id abs_to_borrows; + RAbsBorrow.register_abs_id abs_id abs_to_loans; + RAbsSymbProj.register_abs_id abs_id abs_to_borrow_projs; + RAbsSymbProj.register_abs_id abs_id abs_to_loan_projs + in let register_borrow_id abs pm bid = RAbsBorrow.register_mapping false abs_to_borrows abs.abs_id (pm, bid); RBorrowAbs.register_mapping true borrow_to_abs (pm, bid) abs.abs_id @@ -160,6 +171,7 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) env_iter_abs (fun abs -> + register_abs_id abs.abs_id; if explore abs then ( abs_to_borrows := AbstractionId.Map.add abs.abs_id MarkedBorrowId.Set.empty From 981e5c9ac4b8ba83a0be256479b2ce8dc94699c5 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 5 Jan 2025 19:21:04 +0100 Subject: [PATCH 06/23] Make progress on updating the join --- src/Logging.ml | 2 +- src/interp/InterpreterLoopsCore.ml | 74 ++++++++++++++++++++++++ src/interp/InterpreterLoopsFixedPoint.ml | 18 ++++-- src/interp/InterpreterLoopsMatchCtxs.ml | 44 ++++++++++++-- 4 files changed, 127 insertions(+), 11 deletions(-) diff --git a/src/Logging.ml b/src/Logging.ml index 010d079c9..4655c4b76 100644 --- a/src/Logging.ml +++ b/src/Logging.ml @@ -58,7 +58,7 @@ let loops_match_ctxs_log = create_logger "Interpreter.LoopsMatchCtxs" let loops_join_ctxs_log = create_logger "Interpreter.LoopsJoinCtxs" (** Logger for InterpreterLoopsFixedPoint *) -let loops_fixed_point_log = create_logger "Interpreter.FixedPoint" +let loops_fixed_point_log = create_logger "Interpreter.LoopsFixedPoint" (** Logger for InterpreterLoops *) let loops_log = create_logger "Interpreter.Loops" diff --git a/src/interp/InterpreterLoopsCore.ml b/src/interp/InterpreterLoopsCore.ml index e51a6375a..dded1dd8e 100644 --- a/src/interp/InterpreterLoopsCore.ml +++ b/src/interp/InterpreterLoopsCore.ml @@ -159,6 +159,8 @@ module type PrimMatcher = sig typed_avalue (** Parameters: + [ctx0] + [ctx1] [ty0] [pm0] [bid0] @@ -180,6 +182,8 @@ module type PrimMatcher = sig typed_avalue (** Parameters: + [ctx0] + [ctx1] [ty0] [pm0] [bid0] @@ -207,6 +211,8 @@ module type PrimMatcher = sig typed_avalue (** Parameters: + [ctx0] + [ctx1] [ty0] [pm0] [ids0] @@ -240,6 +246,8 @@ module type PrimMatcher = sig typed_avalue (** Parameters: + [ctx0] + [ctx1] [ty0] [pm0] [id0] @@ -266,6 +274,72 @@ module type PrimMatcher = sig typed_avalue -> typed_avalue + (** Parameters: + [ctx0] + [ctx1] + [ty0] + [pm0] + [sv0] + [proj_ty0] + [children0] + [ty1] + [pm1] + [sv1] + [proj_ty1] + [children1] + [ty]: result of matching ty0 and ty1 + [proj_ty]: result of matching proj_ty0 and proj_ty1 + *) + val match_aproj_borrows : + eval_ctx -> + eval_ctx -> + rty -> + proj_marker -> + symbolic_value -> + rty -> + (msymbolic_value * aproj) list -> + rty -> + proj_marker -> + symbolic_value -> + rty -> + (msymbolic_value * aproj) list -> + rty -> + rty -> + typed_avalue + + (** Parameters: + [ctx0] + [ctx1] + [ty0] + [pm0] + [sv0] + [proj_ty0] + [children0] + [ty1] + [pm1] + [sv1] + [proj_ty1] + [children1] + [ty]: result of matching ty0 and ty1 + [proj_ty]: result of matching proj_ty0 and proj_ty1 + *) + val match_aproj_loans : + eval_ctx -> + eval_ctx -> + rty -> + proj_marker -> + symbolic_value -> + rty -> + (msymbolic_value * aproj) list -> + rty -> + proj_marker -> + symbolic_value -> + rty -> + (msymbolic_value * aproj) list -> + rty -> + rty -> + typed_avalue + (** Match two arbitrary avalues whose constructors don't match (this function is typically used to raise the proper exception). *) diff --git a/src/interp/InterpreterLoopsFixedPoint.ml b/src/interp/InterpreterLoopsFixedPoint.ml index 5058e1172..9560d0205 100644 --- a/src/interp/InterpreterLoopsFixedPoint.ml +++ b/src/interp/InterpreterLoopsFixedPoint.ml @@ -605,12 +605,12 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) let fp = list_loop_abstractions#visit_eval_ctx () fp in (* For every input region group: - * - evaluate until we get to a [return] - * - end the input abstraction corresponding to the input region group - * - find which loop abstractions end at that moment - * - * [fp_ended_aids] links region groups to sets of ended abstractions. - *) + - evaluate until we get to a [return] + - end the input abstraction corresponding to the input region group + - find which loop abstractions end at that moment + + [fp_ended_aids] links region groups to sets of ended abstractions. + *) let fp_ended_aids = ref RegionGroupId.Map.empty in let add_ended_aids (rg_id : RegionGroupId.id) (aids : AbstractionId.Set.t) : unit = @@ -678,6 +678,12 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) aids_union := AbstractionId.Set.union ids !aids_union) !fp_ended_aids in + log#ldebug + (lazy + ("- aids_union: " + ^ AbstractionId.Set.to_string None !aids_union + ^ "\n" ^ "- fp_aids: " + ^ AbstractionId.Set.to_string None !fp_aids)); (* If we generate a translation, we check that all the regions need to end - this is not necessary per se, but if it doesn't happen it is bizarre and worth investigating... diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index a8d7baf6a..820ffe762 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -473,10 +473,20 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct they are necessary only when there are nested borrows *) craise __FILE__ __LINE__ M.span "Unreachable" | _ -> craise __FILE__ __LINE__ M.span "Unreachable") - | ASymbolic _, ASymbolic _ -> - (* For now, we force all the symbolic values containing borrows to - be eagerly expanded, and we don't support nested borrows *) - craise __FILE__ __LINE__ M.span "Unreachable" + | ASymbolic (pm0, proj0), ASymbolic (pm1, proj1) -> begin + match (proj0, proj1) with + | ( AProjBorrows (sv0, proj_ty0, children0), + AProjBorrows (sv1, proj_ty1, children1) ) -> + let proj_ty = M.match_rtys ctx0 ctx1 proj_ty0 proj_ty1 in + M.match_aproj_borrows ctx0 ctx1 v0.ty pm0 sv0 proj_ty0 children0 + v1.ty pm1 sv1 proj_ty1 children1 ty proj_ty + | ( AProjLoans (sv0, proj_ty0, children0), + AProjLoans (sv1, proj_ty1, children1) ) -> + let proj_ty = M.match_rtys ctx0 ctx1 proj_ty0 proj_ty1 in + M.match_aproj_loans ctx0 ctx1 v0.ty pm0 sv0 proj_ty0 children0 v1.ty + pm1 sv1 proj_ty1 children1 ty proj_ty + | _ -> craise __FILE__ __LINE__ M.span "Unreachable" + end | _ -> M.match_avalues ctx0 ctx1 v0 v1 end @@ -976,6 +986,12 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let match_amut_loans _ _ _ _ _ _ _ _ _ _ = craise __FILE__ __LINE__ span "Unreachable" + let match_aproj_borrows _ _ _ _ _ _ _ _ _ _ _ _ _ _ = + craise __FILE__ __LINE__ span "Unreachable" + + let match_aproj_loans _ _ _ _ _ _ _ _ _ _ _ _ _ _ = + craise __FILE__ __LINE__ span "Unreachable" + let match_avalues _ _ _ _ = craise __FILE__ __LINE__ span "Unreachable" end @@ -1116,6 +1132,12 @@ module MakeMoveMatcher (S : MatchMoveState) : PrimMatcher = struct craise __FILE__ __LINE__ span "Unreachable" let match_avalues _ _ _ _ = craise __FILE__ __LINE__ span "Unreachable" + + let match_aproj_borrows _ _ _ _ _ _ _ _ _ _ _ _ _ _ = + craise __FILE__ __LINE__ span "Unreachable" + + let match_aproj_loans _ _ _ _ _ _ _ _ _ _ _ _ _ _ = + craise __FILE__ __LINE__ span "Unreachable" end module MakeCheckEquivMatcher (S : MatchCheckEquivState) : CheckEquivMatcher = @@ -1395,6 +1417,20 @@ struct let value = ALoan (AMutLoan (PNone, id, av)) in { value; ty } + let match_aproj_borrows (ctx0 : eval_ctx) (ctx1 : eval_ctx) _ty0 pm0 sv0 + _proj_ty0 children0 _ty1 pm1 sv1 _proj_ty1 children1 ty proj_ty = + sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span; + sanity_check __FILE__ __LINE__ (children0 = [] && children1 = []) span; + let sv = match_symbolic_values ctx0 ctx1 sv0 sv1 in + { value = ASymbolic (PNone, AProjBorrows (sv, proj_ty, [])); ty } + + let match_aproj_loans (ctx0 : eval_ctx) (ctx1 : eval_ctx) _ty0 pm0 sv0 + _proj_ty0 children0 _ty1 pm1 sv1 _proj_ty1 children1 ty proj_ty = + sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span; + sanity_check __FILE__ __LINE__ (children0 = [] && children1 = []) span; + let sv = match_symbolic_values ctx0 ctx1 sv0 sv1 in + { value = ASymbolic (PNone, AProjLoans (sv, proj_ty, [])); ty } + let match_avalues (ctx0 : eval_ctx) (ctx1 : eval_ctx) v0 v1 = log#ldebug (lazy From 15909ac0dceb8a0d647da05e1586168e0cf8285c Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 7 Jan 2025 13:30:34 +0000 Subject: [PATCH 07/23] Make progress on SymbolicToPure --- src/dune | 1 + src/interp/Interpreter.ml | 1 + src/interp/InterpreterBorrowsCore.ml | 5 +- src/interp/InterpreterLoops.ml | 82 ++++++++--- src/interp/InterpreterLoopsCore.ml | 33 +++++ src/interp/InterpreterLoopsFixedPoint.ml | 91 +++++++++--- src/interp/InterpreterLoopsMatchCtxs.ml | 145 ++++++++++++++++--- src/interp/InterpreterProjectors.ml | 1 + src/interp/InterpreterUtils.ml | 9 +- src/llbc/Print.ml | 138 ++++++++++++------ src/llbc/TypesUtils.ml | 8 ++ src/llbc/ValuesUtils.ml | 8 ++ src/symbolic/PrintSymbolicAst.ml | 170 +++++++++++++++++++++++ src/symbolic/SymbolicAst.ml | 4 +- src/symbolic/SymbolicToPure.ml | 52 +++---- src/symbolic/SynthesizeSymbolic.ml | 15 -- 16 files changed, 612 insertions(+), 151 deletions(-) create mode 100644 src/symbolic/PrintSymbolicAst.ml diff --git a/src/dune b/src/dune index 4b077025a..f563565f9 100644 --- a/src/dune +++ b/src/dune @@ -60,6 +60,7 @@ PrePasses Print PrintPure + PrintSymbolicAst PureMicroPasses Pure PureTypeCheck diff --git a/src/interp/Interpreter.ml b/src/interp/Interpreter.ml index 8a81efa8d..a3fe42065 100644 --- a/src/interp/Interpreter.ml +++ b/src/interp/Interpreter.ml @@ -7,6 +7,7 @@ open LlbcAstUtils open Types open TypesUtils open Values +open ValuesUtils open LlbcAst open Contexts open Errors diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index 2cd62578c..b97234f8d 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -1012,8 +1012,7 @@ let update_intersecting_aproj_loans (span : Meta.span) super#visit_aproj abs sproj | AProjLoans (abs_sv, abs_proj_ty, given_back) -> let abs = Option.get abs in - if same_symbolic_id sv abs_sv then ( - sanity_check __FILE__ __LINE__ (sv.sv_ty = abs_sv.sv_ty) span; + if same_symbolic_id sv abs_sv then let abs_regions = RegionId.Set.empty in let abs_regions = if include_ancestors then @@ -1029,7 +1028,7 @@ let update_intersecting_aproj_loans (span : Meta.span) 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 else super#visit_aproj (Some abs) sproj end in diff --git a/src/interp/InterpreterLoops.ml b/src/interp/InterpreterLoops.ml index b252e2993..1fb2dd671 100644 --- a/src/interp/InterpreterLoops.ml +++ b/src/interp/InterpreterLoops.ml @@ -145,10 +145,15 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) inside the region abstractions. *) let check_abs (abs_id : AbstractionId.id) = let abs = ctx_lookup_abs fp_ctx abs_id in + log#ldebug + (lazy + ("eval_loop_symbolic_synthesize_fun_end: checking abs:\n" + ^ abs_to_string span ctx abs ^ "\n")); + let is_borrow (av : typed_avalue) : bool = match av.value with - | ABorrow _ -> true - | ALoan _ -> false + | ABorrow _ | ASymbolic (_, AProjBorrows _) -> true + | ALoan _ | ASymbolic (_, AProjLoans _) -> false | _ -> craise __FILE__ __LINE__ span "Unreachable" in let borrows, loans = List.partition is_borrow abs.avalues in @@ -164,10 +169,23 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) | ABorrow (ASharedBorrow (pm, _)) -> sanity_check __FILE__ __LINE__ (pm = PNone) span; None + | ASymbolic (_, (AProjBorrows _ | AProjLoans _)) -> None | _ -> craise __FILE__ __LINE__ span "Unreachable") borrows in + let borrow_projs = + List.filter_map + (fun (av : typed_avalue) -> + match av.value with + | ASymbolic (pm, AProjBorrows (sv, _proj_ty, children)) -> + sanity_check __FILE__ __LINE__ (pm = PNone) span; + sanity_check __FILE__ __LINE__ (children = []) span; + Some sv.sv_id + | _ -> None) + borrows + in + let mut_loans = List.filter_map (fun (av : typed_avalue) -> @@ -179,13 +197,29 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) | ALoan (ASharedLoan (pm, _, _, _)) -> sanity_check __FILE__ __LINE__ (pm = PNone) span; None + | ASymbolic (_, (AProjBorrows _ | AProjLoans _)) -> None | _ -> craise __FILE__ __LINE__ span "Unreachable") loans in + let loan_projs = + List.filter_map + (fun (av : typed_avalue) -> + match av.value with + | ASymbolic (pm, AProjLoans (sv, _proj_ty, children)) -> + sanity_check __FILE__ __LINE__ (pm = PNone) span; + sanity_check __FILE__ __LINE__ (children = []) span; + Some sv.sv_id + | _ -> None) + loans + in + sanity_check __FILE__ __LINE__ (List.length mut_borrows = List.length mut_loans) span; + sanity_check __FILE__ __LINE__ + (List.length borrow_projs = List.length loan_projs) + span; let borrows_loans = List.combine mut_borrows mut_loans in List.iter @@ -194,7 +228,17 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) BorrowId.InjSubst.find bid fp_bl_corresp.borrow_to_loan_id_map in sanity_check __FILE__ __LINE__ (lid_of_bid = lid) span) - borrows_loans + borrows_loans; + + let borrow_loan_projs = List.combine borrow_projs loan_projs in + List.iter + (fun (bid, lid) -> + let lid_of_bid = + SymbolicValueId.InjSubst.find bid + fp_bl_corresp.borrow_to_loan_proj_map + in + sanity_check __FILE__ __LINE__ (lid_of_bid = lid) span) + borrow_loan_projs in List.iter check_abs (RegionGroupId.Map.values rg_to_abs); @@ -339,7 +383,7 @@ let eval_loop_symbolic (config : config) (span : span) return nothing. *) let rg_to_given_back = - let compute_abs_given_back_tys (abs_id : AbstractionId.id) : rty list = + let compute_abs_given_back_tys (abs_id : AbstractionId.id) : Pure.ty list = let abs = ctx_lookup_abs fp_ctx abs_id in log#ldebug (lazy @@ -348,23 +392,19 @@ let eval_loop_symbolic (config : config) (span : span) let is_borrow (av : typed_avalue) : bool = match av.value with - | ABorrow _ -> true - | ALoan _ -> false + | ABorrow _ | ASymbolic (_, AProjBorrows _) -> true + | ALoan _ | ASymbolic (_, AProjLoans _) -> false | _ -> craise __FILE__ __LINE__ span "Unreachable" in let borrows, _ = List.partition is_borrow abs.avalues in List.filter_map (fun (av : typed_avalue) -> - match av.value with - | ABorrow (AMutBorrow (pm, _, child_av)) -> - sanity_check __FILE__ __LINE__ (pm = PNone) span; - sanity_check __FILE__ __LINE__ (is_aignored child_av.value) span; - Some child_av.ty - | ABorrow (ASharedBorrow (pm, _)) -> - sanity_check __FILE__ __LINE__ (pm = PNone) span; - None - | _ -> craise __FILE__ __LINE__ span "Unreachable") + SymbolicToPure.translate_back_ty (Some span) ctx.type_ctx.type_infos + (function + | RVar (Free rid) -> RegionId.Set.mem rid abs.regions.owned + | _ -> false) + false av.ty) borrows in RegionGroupId.Map.map compute_abs_given_back_tys rg_to_abs @@ -377,8 +417,16 @@ let eval_loop_symbolic (config : config) (span : span) | e :: el -> let fun_end_expr = cf_fun_end e in let loop_expr = cf_loop_body el in - S.synthesize_loop loop_id input_svalues fresh_sids rg_to_given_back - fun_end_expr loop_expr span + SymbolicAst.Loop + { + loop_id; + input_svalues; + fresh_svalues = fresh_sids; + rg_to_given_back_tys = rg_to_given_back; + end_expr = fun_end_expr; + loop_expr; + span; + } in (res_fun_end :: resl_loop_body, cc) diff --git a/src/interp/InterpreterLoopsCore.ml b/src/interp/InterpreterLoopsCore.ml index dded1dd8e..f362e1caa 100644 --- a/src/interp/InterpreterLoopsCore.ml +++ b/src/interp/InterpreterLoopsCore.ml @@ -429,9 +429,42 @@ type ids_maps = { } [@@deriving show] +let ids_maps_to_string (ctx : eval_ctx) (m : ids_maps) : string = + let { + aid_map; + blid_map; + borrow_id_map; + loan_id_map; + rid_map; + sid_map; + sid_to_value_map; + } = + m + in + let indent = Some " " in + "{" ^ "\n aid_map = " + ^ AbstractionId.InjSubst.to_string indent aid_map + ^ "\n blid_map = " + ^ BorrowId.InjSubst.to_string indent blid_map + ^ "\n borrow_id_map = " + ^ BorrowId.InjSubst.to_string indent borrow_id_map + ^ "\n loan_id_map = " + ^ BorrowId.InjSubst.to_string indent loan_id_map + ^ "\n rid_map = " + ^ RegionId.InjSubst.to_string indent rid_map + ^ "\n sid_map = " + ^ SymbolicValueId.InjSubst.to_string indent sid_map + ^ "\n sid_to_value_map = " + ^ SymbolicValueId.Map.to_string indent + (typed_value_to_string ctx) + sid_to_value_map + ^ "\n}" + type borrow_loan_corresp = { borrow_to_loan_id_map : BorrowId.InjSubst.t; loan_to_borrow_id_map : BorrowId.InjSubst.t; + borrow_to_loan_proj_map : SymbolicValueId.InjSubst.t; + loan_to_borrow_proj_map : SymbolicValueId.InjSubst.t; } [@@deriving show] diff --git a/src/interp/InterpreterLoopsFixedPoint.ml b/src/interp/InterpreterLoopsFixedPoint.ml index 9560d0205..7f3a5328b 100644 --- a/src/interp/InterpreterLoopsFixedPoint.ml +++ b/src/interp/InterpreterLoopsFixedPoint.ml @@ -889,7 +889,8 @@ let compute_fixed_point_id_correspondance (span : Meta.span) log#ldebug (lazy ("compute_fixed_point_id_correspondance:\n\n- tgt_to_src_maps:\n" - ^ show_ids_maps maps ^ "\n\n")); + ^ ids_maps_to_string src_ctx maps + ^ "\n\n")); let src_to_tgt_borrow_map = BorrowId.Map.of_list @@ -897,6 +898,15 @@ let compute_fixed_point_id_correspondance (span : Meta.span) (fun (x, y) -> (y, x)) (BorrowId.InjSubst.bindings maps.borrow_id_map)) in + let src_to_tgt_sid_map = + SymbolicValueId.Map.of_list + (List.filter_map + (fun ((sid, v) : _ * typed_value) -> + match v.value with + | VSymbolic v -> Some (v.sv_id, sid) + | _ -> None) + (SymbolicValueId.Map.bindings maps.sid_to_value_map)) + in (* Sanity check: for every abstraction, the target loans and borrows are mapped to the same set of source loans and borrows. @@ -936,7 +946,7 @@ let compute_fixed_point_id_correspondance (span : Meta.span) (fun x -> BorrowId.InjSubst.find x maps.borrow_id_map) ids.loan_ids in - (* Check that the loan and borrows are related *) + (* Check that the loans and borrows are related *) sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids.borrow_ids loan_ids) span) @@ -954,6 +964,7 @@ let compute_fixed_point_id_correspondance (span : Meta.span) abstractions to move the shared values out of the source context abstractions. *) let tgt_borrow_to_loan = ref BorrowId.InjSubst.empty in + let tgt_borrow_to_loan_proj = ref SymbolicValueId.InjSubst.empty in let visit_tgt = object inherit [_] iter_abs @@ -964,6 +975,25 @@ let compute_fixed_point_id_correspondance (span : Meta.span) (* Update the map *) tgt_borrow_to_loan := BorrowId.InjSubst.add id tgt_borrow_id !tgt_borrow_to_loan + + method! visit_aproj _ proj = + match proj with + | AProjLoans (_sv, _proj_ty, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + () + | AProjBorrows (sv, _proj_ty, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + (* Find the target borrow *) + let tgt_borrow_id = + SymbolicValueId.Map.find sv.sv_id src_to_tgt_sid_map + in + (* Update the map *) + tgt_borrow_to_loan_proj := + SymbolicValueId.InjSubst.add sv.sv_id tgt_borrow_id + !tgt_borrow_to_loan_proj + | AEndedProjBorrows _ | AEndedProjLoans _ | AEmpty -> + (* We shouldn't get there *) + internal_error __FILE__ __LINE__ span end in List.iter (visit_tgt#visit_abs ()) new_absl; @@ -976,10 +1006,19 @@ let compute_fixed_point_id_correspondance (span : Meta.span) (BorrowId.InjSubst.bindings !tgt_borrow_to_loan)) in + let tgt_loan_to_borrow_proj = + SymbolicValueId.InjSubst.of_list + (List.map + (fun (x, y) -> (y, x)) + (SymbolicValueId.InjSubst.bindings !tgt_borrow_to_loan_proj)) + in + (* Return *) { borrow_to_loan_id_map = !tgt_borrow_to_loan; loan_to_borrow_id_map = tgt_loan_to_borrow; + borrow_to_loan_proj_map = !tgt_borrow_to_loan_proj; + loan_to_borrow_proj_map = tgt_loan_to_borrow_proj; } let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) @@ -988,13 +1027,19 @@ let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) let fp_ids, fp_ids_maps = compute_ctx_ids fp_ctx in let fresh_sids = SymbolicValueId.Set.diff fp_ids.sids old_ids.sids in - (* Compute the set of symbolic values which appear in shared values inside - *fixed* abstractions: because we introduce fresh abstractions and reborrows - with {!prepare_ashared_loans}, those values are never accessed directly - inside the loop iterations: we can ignore them (and should, because - otherwise it leads to a very ugly translation with duplicated, unused - values) *) - let shared_sids_in_fixed_abs = + (* Compute the set of symbolic values which appear inside *fixed* abstractions. + There are two kinds of values: + - shared symbolic values (appearing in shared loans): because we introduce + fresh abstractions and reborrows with {!prepare_ashared_loans}, those + values are never accessed directly inside the loop iterations: we can + ignore them (and should, because otherwise it leads to a very ugly + translation with duplicated, unused values) + - projections over symbolic values. + TODO: actually it may happen that a projector inside a fixed abstraction + gets expanded. We need to update the way we compute joins and check + whether two contexts are equivalent to make it more general. + *) + let sids_in_fixed_abs = let fixed_absl = List.filter (fun (ee : env_elem) -> @@ -1015,12 +1060,21 @@ let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) object (self) inherit [_] iter_env - method! visit_ASharedLoan inside_shared _ _ sv child_av = + method! visit_ASharedLoan register _ _ sv child_av = self#visit_typed_value true sv; - self#visit_typed_avalue inside_shared child_av - - method! visit_symbolic_value_id inside_shared sid = - if inside_shared then sids := SymbolicValueId.Set.add sid !sids + self#visit_typed_avalue register child_av + + method! visit_AProjLoans register sv proj_ty children = + self#visit_symbolic_value true sv; + self#visit_ty register proj_ty; + self#visit_list + (fun register (s, p) -> + self#visit_msymbolic_value register s; + self#visit_aproj register p) + register children + + method! visit_symbolic_value_id register sid = + if register then sids := SymbolicValueId.Set.add sid !sids end in visitor#visit_env false fixed_absl; @@ -1031,17 +1085,20 @@ let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) see comments for [shared_sids_in_fixed_abs]. *) let sids_to_values = fp_ids_maps.sids_to_values in + (* Also remove the symbolic values which appear inside of projectors in + fixed abstractions - those are "fixed" and not modified between iterations + of the loop, *) log#ldebug (lazy - ("compute_fp_ctx_symbolic_values:" ^ "\n- shared_sids_in_fixed_abs:" - ^ SymbolicValueId.Set.show shared_sids_in_fixed_abs + ("compute_fp_ctx_symbolic_values:" ^ "\n- sids_in_fixed_abs:" + ^ SymbolicValueId.Set.show sids_in_fixed_abs ^ "\n- all_sids_to_values: " ^ SymbolicValueId.Map.show (symbolic_value_to_string ctx) sids_to_values ^ "\n")); let sids_to_values = SymbolicValueId.Map.filter - (fun sid _ -> not (SymbolicValueId.Set.mem sid shared_sids_in_fixed_abs)) + (fun sid _ -> not (SymbolicValueId.Set.mem sid sids_in_fixed_abs)) sids_to_values in diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index 820ffe762..f2130975e 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -1877,8 +1877,8 @@ let match_ctx_with_target (config : config) (span : Meta.span) (* Match the source and target contexts *) log#ldebug (lazy - ("cf_introduce_loop_fp_abs:\n" ^ "\n- fixed_ids: " - ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " + ("mach_ctx_with_target: about to introduce the identity abstractions (i):\n" + ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx: " ^ eval_ctx_to_string tgt_ctx )); @@ -1915,11 +1915,21 @@ let match_ctx_with_target (config : config) (span : Meta.span) (fun (x, y) -> (y, x)) (BorrowId.InjSubst.bindings src_to_tgt_maps.borrow_id_map)) in + let tgt_to_src_sid_map = + SymbolicValueId.Map.of_list + (List.filter_map + (fun ((sid, v) : _ * typed_value) -> + match v.value with + | VSymbolic sv -> Some (sv.sv_id, sid) + | _ -> None) + (SymbolicValueId.Map.bindings src_to_tgt_maps.sid_to_value_map)) + in (* Debug *) log#ldebug (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs:" ^ "\n\n- src_ctx: " + ("match_ctx_with_target: about to introduce the identity abstractions \ + (ii):" ^ "\n\n- src_ctx: " ^ eval_ctx_to_string ~span:(Some span) src_ctx ^ "\n\n- tgt_ctx: " ^ eval_ctx_to_string ~span:(Some span) tgt_ctx @@ -1933,7 +1943,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) ^ "\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- fp_bl_maps:\n" ^ show_borrow_loan_corresp fp_bl_maps ^ "\n\n- src_to_tgt_maps: " - ^ show_ids_maps src_to_tgt_maps)); + ^ ids_maps_to_string tgt_ctx src_to_tgt_maps)); (* Update the borrows and symbolic ids in the source context. @@ -1954,8 +1964,8 @@ let match_ctx_with_target (config : config) (span : Meta.span) {[ env_fp = { abs@0 { ML l0 } - ls -> MB l1 (s3 : loops::List) - i -> s4 : u32 + ls -> MB l1 (s@3 : loops::List) + i -> s@4 : u32 abs@fp { MB l0 // this borrow appears in [env0] ML l1 @@ -1965,7 +1975,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) Through matching, we detect that in [env_fp], [l1] is matched to [l5]. We introduce a fresh borrow [l6] for [l1], and remember - in the map [src_fresh_borrows_map] that: [{ l1 -> l6}]. + in the map [src_fresh_borrows_map] that: [{ l1 -> l6 }]. We get: {[ @@ -1982,17 +1992,44 @@ let match_ctx_with_target (config : config) (span : Meta.span) {[ abs@2 { MB l5, ML l6 } ]} + + We do something similar for symbolic values. *) - (* First, compute the set of borrows which appear in the fresh abstractions - of the fixed-point: we want to introduce fresh ids only for those. *) + (* First, compute the set of borrows and symbolic values appearing in *borrow* + projections which appear in the fresh abstractions of the fixed-point: we + want to introduce fresh ids only for those. *) let new_absl_ids, _ = compute_absl_ids new_absl in let src_fresh_borrows_map = ref BorrowId.Map.empty in + let src_fresh_sids_map = ref SymbolicValueId.Map.empty in + let register_symbolic_value (sv : symbolic_value) : symbolic_value = + let id = sv.sv_id in + (* Register the symbolic value, if it needs to be mapped *) + let id = + if + (* We map the borrows for which we computed a mapping - TODO: simplify *) + SymbolicValueId.Map.mem id tgt_to_src_sid_map + (* And which have corresponding loans in the fresh fixed-point abstractions *) + && SymbolicValueId.Set.mem + (SymbolicValueId.Map.find id tgt_to_src_sid_map) + new_absl_ids.sids + then ( + let src_id = SymbolicValueId.Map.find id tgt_to_src_sid_map in + let nid = fresh_symbolic_value_id () in + src_fresh_sids_map := + SymbolicValueId.Map.add src_id nid !src_fresh_sids_map; + nid) + else id + in + { sv with sv_id = id } + in let visit_tgt = object - inherit [_] map_eval_ctx + inherit [_] map_eval_ctx as super + (* For *borrows* it is simple: there is a separation between *borrow* + ids and *loan* ids, meaning we simply have to update one visitor. *) method! visit_borrow_id _ id = - (* Map the borrow, if it needs to be mapped *) + (* Map the borrow, if it needs to be mapped - TODO: simplify *) if (* We map the borrows for which we computed a mapping *) BorrowId.InjSubst.Set.mem id @@ -2008,6 +2045,17 @@ let match_ctx_with_target (config : config) (span : Meta.span) BorrowId.Map.add src_id nid !src_fresh_borrows_map; nid) else id + + method! visit_VSymbolic _ sv = VSymbolic (register_symbolic_value sv) + + method! visit_aproj env p = + match p with + | AProjLoans _ -> super#visit_aproj env p + | AProjBorrows (sv, proj_ty, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + let sv = register_symbolic_value sv in + AProjBorrows (sv, proj_ty, children) + | _ -> super#visit_aproj env p end in @@ -2015,21 +2063,18 @@ let match_ctx_with_target (config : config) (span : Meta.span) log#ldebug (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: src_fresh_borrows_map:\n" + ("match_ctx_with_target: cf_introduce_loop_fp_abs:" + ^ "\n- src_fresh_borrows_map:\n" ^ BorrowId.Map.show BorrowId.to_string !src_fresh_borrows_map + ^ "\n- src_fresh_sids_map:\n" + ^ SymbolicValueId.Map.show SymbolicValueId.to_string !src_fresh_sids_map ^ "\n")); - (* Rem.: we don't update the symbolic values. It is not necessary - because there shouldn't be any symbolic value containing borrows. - - Rem.: we will need to do something about the symbolic values in the - abstractions and in the *variable bindings* once we allow symbolic - values containing borrows to not be eagerly expanded. - *) sanity_check __FILE__ __LINE__ Config.greedy_expand_symbolics_with_borrows span; - (* Update the borrows and loans in the abstractions of the target context. + (* Update the borrows/loans and the borrow/loan projectors in the abstractions + of the target context. Going back to the [list_nth_mut] example and by using [src_fresh_borrows_map], we instantiate the fixed-point abstractions that we will insert into the @@ -2079,7 +2124,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) let get_abs_id = AbstractionIdGen.get_id in let visit_src = - object + object (self) inherit [_] map_eval_ctx as super method! visit_borrow_id _ bid = @@ -2132,6 +2177,55 @@ let match_ctx_with_target (config : config) (span : Meta.span) method! visit_symbolic_value_id _ _ = fresh_symbolic_value_id () method! visit_abstraction_id _ id = get_abs_id id + method! visit_aproj env proj = + match proj with + | AProjLoans (sv, proj_ty, children) -> + (* The logic is similar to the concrete borrows/loans cases above *) + let id = sv.sv_id in + sanity_check __FILE__ __LINE__ (children = []) span; + let sv_id = + begin + match SymbolicValueId.Map.find_opt id !src_fresh_sids_map with + | None -> + sanity_check __FILE__ __LINE__ + (SymbolicValueId.InjSubst.find id src_to_tgt_maps.sid_map + = id) + span; + id + | Some id -> id + end + in + let proj_ty = self#visit_ty env proj_ty in + (* We shouldn't need to update the type of the symbolic value itself *) + let sv_ty = sv.sv_ty in + AProjLoans ({ sv_id; sv_ty }, proj_ty, children) + | AProjBorrows (sv, proj_ty, children) -> + sanity_check __FILE__ __LINE__ (children = []) span; + (* Lookup the loan corresponding to this borrow *) + let src_lid = + SymbolicValueId.InjSubst.find sv.sv_id + fp_bl_maps.borrow_to_loan_proj_map + in + + (* Lookup the value to which this borrow was mapped - note that it + is necessary a symbolic value *) + let tgt_value = + SymbolicValueId.Map.find src_lid src_to_tgt_maps.sid_to_value_map + in + let sv_id = + begin + match tgt_value.value with + | VSymbolic sv -> sv.sv_id + | _ -> internal_error __FILE__ __LINE__ span + end + in + let proj_ty = self#visit_ty env proj_ty in + (* We shouldn't need to update the type of the symbolic value itself *) + let sv_ty = sv.sv_ty in + AProjBorrows ({ sv_id; sv_ty }, proj_ty, children) + | AEndedProjBorrows _ | AEndedProjLoans _ | AEmpty -> + super#visit_aproj env proj + method! visit_region_id _ _ = craise_opt_span __FILE__ __LINE__ None "Internal error: region ids should not be visited directly; the \ @@ -2193,6 +2287,15 @@ let match_ctx_with_target (config : config) (span : Meta.span) in (* Compute the loop input values *) + log#ldebug + (lazy + ("match_ctx_with_target: about to compute the input values:" + ^ "\n- fp_input_svalues: " + ^ String.concat ", " (List.map SymbolicValueId.to_string fp_input_svalues) + ^ "\n- src_to_tgt_maps:\n" + ^ ids_maps_to_string tgt_ctx src_to_tgt_maps + ^ "\n- src_ctx:\n" ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx:\n" + ^ eval_ctx_to_string tgt_ctx ^ "\n")); let input_values = SymbolicValueId.Map.of_list (List.map diff --git a/src/interp/InterpreterProjectors.ml b/src/interp/InterpreterProjectors.ml index f9d1f3aba..6237913a4 100644 --- a/src/interp/InterpreterProjectors.ml +++ b/src/interp/InterpreterProjectors.ml @@ -4,6 +4,7 @@ open Contexts module Subst = Substitute module Assoc = AssociatedTypes open TypesUtils +open ValuesUtils open InterpreterUtils open InterpreterBorrowsCore open Errors diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index 71ada67c8..dc99c5337 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -5,6 +5,7 @@ open Contexts open LlbcAst open Utils open TypesUtils +open ValuesUtils open Errors (* TODO: we should probably rename the file to ContextsUtils *) @@ -112,14 +113,6 @@ let mk_fresh_symbolic_typed_value_from_no_regions_ty (span : Meta.span) sanity_check __FILE__ __LINE__ (ty_no_regions ty) span; mk_fresh_symbolic_typed_value span ty -(** Create a typed value from a symbolic value. *) -let mk_typed_value_from_symbolic_value (svalue : symbolic_value) : typed_value = - let av = VSymbolic svalue in - let av : typed_value = - { value = av; ty = Substitute.erase_regions svalue.sv_ty } - in - av - (** Create a loans projector value from a symbolic value. Checks if the projector will actually project some regions. If not, diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index 408b7521c..7f2245e02 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -124,14 +124,17 @@ module Values = struct ^ String.concat "," (List.map (abstract_shared_borrow_to_string env) abs) ^ "}" - let rec aproj_to_string (env : fmt_env) (pv : aproj) : string = + let rec aproj_to_string ?(with_ended : bool = false) (env : fmt_env) + (pv : aproj) : string = match pv with | AProjLoans (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 + let given_back = + List.map (aproj_to_string ~with_ended env) given_back + in " (" ^ String.concat "," given_back ^ ") " in "⌊" ^ symbolic_value_proj_to_string env sv rty ^ given_back ^ "⌋" @@ -140,22 +143,41 @@ module Values = struct 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 + let given_back = + List.map (aproj_to_string ~with_ended 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 "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 "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 - "ended_aproj_borrows (" ^ String.concat "," given_back ^ ")" + | AEndedProjLoans (msv, given_back) -> + let msv = + if with_ended then + "original_loan = " ^ symbolic_value_to_string env msv + else "_" + in + let given_back = List.map snd given_back in + let given_back = + List.map (aproj_to_string ~with_ended env) given_back + in + "ended_aproj_loans (" ^ msv ^ ", (" + ^ String.concat "," given_back + ^ "))" + | AEndedProjBorrows (meta, given_back) -> + let meta = + if with_ended then + "original_borrow = " + ^ symbolic_value_to_string env meta.consumed + ^ ", given_back = " + ^ symbolic_value_to_string env meta.given_back + else "_" + in + let given_back = List.map snd given_back in + let given_back = + List.map (aproj_to_string ~with_ended env) given_back + in + "ended_aproj_borrows (" ^ meta ^ ", " + ^ String.concat "," given_back + ^ "))" | AEmpty -> "_" (** Wrap a value inside its marker, if there is one *) @@ -166,11 +188,13 @@ module Values = struct | PRight -> "︙" ^ s ^ "︙" let rec typed_avalue_to_string ?(span : Meta.span option = None) - (env : fmt_env) (v : typed_avalue) : string = + ?(with_ended : bool = false) (env : fmt_env) (v : typed_avalue) : string = match v.value with | AAdt av -> ( let field_values = - List.map (typed_avalue_to_string ~span env) av.field_values + List.map + (typed_avalue_to_string ~span ~with_ended env) + av.field_values in match v.ty with | TAdt (TTuple, _) -> @@ -206,17 +230,19 @@ module Values = struct | _ -> craise_opt_span __FILE__ __LINE__ span "Inconsistent typed value" ) | ABottom -> "⊥ : " ^ ty_to_string env v.ty - | ABorrow bc -> aborrow_content_to_string ~span env bc - | ALoan lc -> aloan_content_to_string ~span env lc - | ASymbolic (pm, proj) -> aproj_to_string env proj |> add_proj_marker pm + | ABorrow bc -> aborrow_content_to_string ~span ~with_ended env bc + | ALoan lc -> aloan_content_to_string ~span ~with_ended env lc + | ASymbolic (pm, proj) -> + aproj_to_string ~with_ended env proj |> add_proj_marker pm | AIgnored _ -> "_" - and aloan_content_to_string ?(span : Meta.span option = None) (env : fmt_env) - (lc : aloan_content) : string = + and aloan_content_to_string ?(span : Meta.span option = None) + ?(with_ended : bool = false) (env : fmt_env) (lc : aloan_content) : string + = match lc with | AMutLoan (pm, bid, av) -> "@mut_loan(" ^ BorrowId.to_string bid ^ ", " - ^ typed_avalue_to_string ~span env av + ^ typed_avalue_to_string ~span ~with_ended env av ^ ")" |> add_proj_marker pm | ASharedLoan (pm, loans, v, av) -> @@ -224,42 +250,45 @@ module Values = struct "@shared_loan(" ^ loans ^ ", " ^ typed_value_to_string ~span env v ^ ", " - ^ typed_avalue_to_string ~span env av + ^ typed_avalue_to_string ~span ~with_ended env av ^ ")" |> add_proj_marker pm | AEndedMutLoan ml -> "@ended_mut_loan{" - ^ typed_avalue_to_string ~span env ml.child + ^ typed_avalue_to_string ~span ~with_ended env ml.child ^ "; " - ^ typed_avalue_to_string ~span env ml.given_back + ^ typed_avalue_to_string ~span ~with_ended env ml.given_back ^ " }" | AEndedSharedLoan (v, av) -> "@ended_shared_loan(" ^ typed_value_to_string ~span env v ^ ", " - ^ typed_avalue_to_string ~span env av + ^ typed_avalue_to_string ~span ~with_ended env av ^ ")" | AIgnoredMutLoan (opt_bid, av) -> "@ignored_mut_loan(" ^ option_to_string BorrowId.to_string opt_bid ^ ", " - ^ typed_avalue_to_string ~span env av + ^ typed_avalue_to_string ~span ~with_ended env av ^ ")" | AEndedIgnoredMutLoan ml -> "@ended_ignored_mut_loan{ " - ^ typed_avalue_to_string ~span env ml.child + ^ typed_avalue_to_string ~span ~with_ended env ml.child ^ "; " - ^ typed_avalue_to_string ~span env ml.given_back + ^ typed_avalue_to_string ~span ~with_ended env ml.given_back ^ "}" | AIgnoredSharedLoan sl -> - "@ignored_shared_loan(" ^ typed_avalue_to_string ~span env sl ^ ")" + "@ignored_shared_loan(" + ^ typed_avalue_to_string ~span ~with_ended env sl + ^ ")" and aborrow_content_to_string ?(span : Meta.span option = None) - (env : fmt_env) (bc : aborrow_content) : string = + ?(with_ended : bool = false) (env : fmt_env) (bc : aborrow_content) : + string = match bc with | AMutBorrow (pm, bid, av) -> "mb@" ^ BorrowId.to_string bid ^ " (" - ^ typed_avalue_to_string ~span env av + ^ typed_avalue_to_string ~span ~with_ended env av ^ ")" |> add_proj_marker pm | ASharedBorrow (pm, bid) -> @@ -268,15 +297,17 @@ module Values = struct "@ignored_mut_borrow(" ^ option_to_string BorrowId.to_string opt_bid ^ ", " - ^ typed_avalue_to_string ~span env av + ^ typed_avalue_to_string ~span ~with_ended env av ^ ")" | AEndedMutBorrow (_mv, child) -> - "@ended_mut_borrow(" ^ typed_avalue_to_string ~span env child ^ ")" + "@ended_mut_borrow(" + ^ typed_avalue_to_string ~span ~with_ended env child + ^ ")" | AEndedIgnoredMutBorrow { child; given_back; given_back_meta = _ } -> "@ended_ignored_mut_borrow{ " - ^ typed_avalue_to_string ~span env child + ^ typed_avalue_to_string ~span ~with_ended env child ^ "; " - ^ typed_avalue_to_string ~span env given_back + ^ typed_avalue_to_string ~span ~with_ended env given_back ^ ")" | AEndedSharedBorrow -> "@ended_shared_borrow" | AProjSharedBorrow sb -> @@ -307,12 +338,12 @@ module Values = struct | Identity -> "Identity" let abs_to_string ?(span : Meta.span option = None) (env : fmt_env) - (verbose : bool) (indent : string) (indent_incr : string) (abs : abs) : - string = + ?(with_ended : bool = false) (verbose : bool) (indent : string) + (indent_incr : string) (abs : abs) : string = let indent2 = indent ^ indent_incr in let avs = List.map - (fun av -> indent2 ^ typed_avalue_to_string ~span env av) + (fun av -> indent2 ^ typed_avalue_to_string ~span ~with_ended env av) abs.avalues in let avs = String.concat ",\n" avs in @@ -347,6 +378,26 @@ module Values = struct ^ region_var_groups_to_string sg.regions_hierarchy ^ "\n- abs_regions_hierarchy:\n" ^ abs_region_groups_to_string sg.abs_regions_hierarchy + + let symbolic_expansion_to_string (env : fmt_env) (ty : ty) + (se : symbolic_expansion) : string = + match se with + | SeLiteral lit -> literal_to_string lit + | SeAdt (variant_id, svl) -> + let field_values = + List.map ValuesUtils.mk_typed_value_from_symbolic_value svl + in + let v : typed_value = + { value = VAdt { variant_id; field_values }; ty } + in + typed_value_to_string env v + | SeMutRef (bid, sv) -> + "MB " ^ BorrowId.to_string bid ^ " " ^ symbolic_value_to_string env sv + | SeSharedRef (bid, sv) -> + "SB {" + ^ BorrowId.Set.to_string None bid + ^ "} " + ^ symbolic_value_to_string env sv end (** Pretty-printing for contexts *) @@ -629,10 +680,11 @@ module EvalCtx = struct let env = eval_ctx_to_fmt_env ctx in typed_value_to_string ~span env v - let typed_avalue_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) - (v : typed_avalue) : string = + let typed_avalue_to_string ?(span : Meta.span option = None) + ?(with_ended : bool = false) (ctx : eval_ctx) (v : typed_avalue) : string + = let env = eval_ctx_to_fmt_env ctx in - typed_avalue_to_string ~span env v + typed_avalue_to_string ~span ~with_ended env v let place_to_string (ctx : eval_ctx) (op : place) : string = let env = eval_ctx_to_fmt_env ctx in diff --git a/src/llbc/TypesUtils.ml b/src/llbc/TypesUtils.ml index 416d11a33..5193deaf0 100644 --- a/src/llbc/TypesUtils.ml +++ b/src/llbc/TypesUtils.ml @@ -159,6 +159,14 @@ let ty_has_mut_borrow_for_region_in_pred (infos : TypesAnalysis.type_infos) false with Found -> true +let ty_has_mut_borrow_for_region_in_set (infos : TypesAnalysis.type_infos) + (regions : RegionId.Set.t) (ty : ty) : bool = + ty_has_mut_borrow_for_region_in_pred infos + (function + | RVar (Free rid) -> RegionId.Set.mem rid regions + | _ -> false) + ty + (** Small helper *) let raise_if_not_rty_visitor = object diff --git a/src/llbc/ValuesUtils.ml b/src/llbc/ValuesUtils.ml index 02901c539..83f1b6bef 100644 --- a/src/llbc/ValuesUtils.ml +++ b/src/llbc/ValuesUtils.ml @@ -44,6 +44,14 @@ let value_as_symbolic (span : Meta.span) (v : value) : symbolic_value = | VSymbolic v -> v | _ -> craise __FILE__ __LINE__ span "Unexpected" +(** Create a typed value from a symbolic value. *) +let mk_typed_value_from_symbolic_value (svalue : symbolic_value) : typed_value = + let av = VSymbolic svalue in + let av : typed_value = + { value = av; ty = Substitute.erase_regions svalue.sv_ty } + in + av + (** Box a value *) let mk_box_value (span : Meta.span) (v : typed_value) : typed_value = let box_ty = mk_box_ty v.ty in diff --git a/src/symbolic/PrintSymbolicAst.ml b/src/symbolic/PrintSymbolicAst.ml new file mode 100644 index 000000000..9615a8493 --- /dev/null +++ b/src/symbolic/PrintSymbolicAst.ml @@ -0,0 +1,170 @@ +open Types +open Values +open Print +open SymbolicAst + +type fmt_env = Print.fmt_env + +let call_id_to_string (env : fmt_env) (call_id : call_id) : string = + match call_id with + | Fun (fid, call_id) -> + Expressions.fun_id_or_trait_method_ref_to_string env fid + ^ "@" + ^ FunCallId.to_string call_id + | Unop unop -> Expressions.unop_to_string env unop + | Binop binop -> Expressions.binop_to_string binop + +let call_to_string (env : fmt_env) (indent : string) (call : call) : string = + let dest = Values.symbolic_value_to_string env call.dest in + let call_id = call_id_to_string env call.call_id in + let generics = Types.generic_args_to_string env call.generics in + let args = + if call.args = [] then "" + else + "(" + ^ String.concat ", " + (List.map (Values.typed_value_to_string env) call.args) + ^ ")" + in + indent ^ dest ^ " = " ^ call_id ^ generics ^ args + +let value_aggregate_to_string (env : fmt_env) (v : value_aggregate) : string = + match v with + | VaSingleValue v -> Values.typed_value_to_string env v + | VaArray vl -> + "[" + ^ String.concat ", " (List.map (Values.typed_value_to_string env) vl) + ^ "]" + | VaCgValue cg_id -> const_generic_db_var_to_string env (Free cg_id) + | VaTraitConstValue (trait_ref, item) -> + trait_ref_to_string env trait_ref ^ "." ^ item + +let rec expression_to_string (env : fmt_env) (indent : string) + (indent_incr : string) (e : expression) : string = + match e with + | Return (_ctx, ret) -> + let ret = + match ret with + | None -> "" + | Some ret -> " " ^ Values.typed_value_to_string env ret + in + indent ^ "return" ^ ret + | Panic -> indent ^ "panic" + | FunCall (call, next) -> + let call = call_to_string env indent call in + let next = expression_to_string env indent indent_incr next in + call ^ "\n" ^ next + | EndAbstraction (_, abs, next) -> + let indent1 = indent ^ indent_incr in + let verbose = false in + let abs = + Values.abs_to_string env ~with_ended:true verbose indent1 indent_incr + abs + in + let next = expression_to_string env indent indent_incr next in + indent ^ "end\n" ^ abs ^ "\n" ^ next + | EvalGlobal (global_id, global_generics, sv, next) -> + let sv = Values.symbolic_value_to_string env sv in + let global = + global_decl_ref_to_string env { global_id; global_generics } + in + let next = expression_to_string env indent indent_incr next in + indent ^ "let " ^ sv ^ " = " ^ global ^ " in\n" ^ next + | Assertion (_, b, next) -> + let b = Values.typed_value_to_string env b in + let next = expression_to_string env indent indent_incr next in + indent ^ "assert " ^ b ^ ";\n" ^ next + | Expansion (_, sv, exp) -> expansion_to_string env indent indent_incr sv exp + | IntroSymbolic (_, _, sv, v, next) -> + let sv = Values.symbolic_value_to_string env sv in + let v = value_aggregate_to_string env v in + let next = expression_to_string env indent indent_incr next in + indent ^ "let " ^ sv ^ " = " ^ v ^ "in\n" ^ next + | ForwardEnd (ret, _, sid_to_value, fwd_end, backs) -> + let indent1 = indent ^ indent_incr in + let ret = + match ret with + | None -> "None" + | Some (_, ret) -> "Some " ^ Values.typed_value_to_string env ret + in + let ret = "ret = " ^ ret in + let sid_to_value = + match sid_to_value with + | None -> "None" + | Some sid_to_value -> + SymbolicValueId.Map.to_string None + (Values.typed_value_to_string env) + sid_to_value + in + let sid_to_value = "sid_to_value = " ^ sid_to_value in + + let fwd_end = expression_to_string env indent1 indent_incr fwd_end in + let backs = + RegionGroupId.Map.to_string (Some indent1) + (fun e -> "\n" ^ expression_to_string env indent1 indent e) + backs + in + indent ^ "forward_end {\n" ^ indent1 ^ ret ^ "\n" ^ indent1 ^ sid_to_value + ^ "\n" ^ indent1 ^ "fwd_end=\n" ^ fwd_end ^ "\n" ^ indent1 ^ "backs=\n" + ^ backs ^ "\n" ^ indent ^ "}" + | Loop loop -> loop_to_string env indent indent_incr loop + | ReturnWithLoop (loop_id, is_continue) -> + indent ^ "return_with_loop (" ^ LoopId.to_string loop_id + ^ ", is_continue: " ^ bool_to_string is_continue ^ ")" + | Meta (_, next) -> expression_to_string env indent indent_incr next + | Error (_, error) -> indent ^ "ERROR(" ^ error ^ ")" + +and expansion_to_string (env : fmt_env) (indent : string) (indent_incr : string) + (scrut : symbolic_value) (e : expansion) : string = + let ty = scrut.sv_ty in + let scrut = Values.symbolic_value_to_string env scrut in + let indent1 = indent ^ indent_incr in + match e with + | ExpandNoBranch (se, next) -> + let next = expression_to_string env indent indent_incr next in + indent ^ "let " + ^ Values.symbolic_expansion_to_string env ty se + ^ " = " ^ scrut ^ "in\n" ^ next + | ExpandAdt branches -> + let branch_to_string + ((variant_id, svl, branch) : + variant_id option * symbolic_value list * expression) : string = + let field_values = + List.map ValuesUtils.mk_typed_value_from_symbolic_value svl + in + let v : typed_value = + { value = VAdt { variant_id; field_values }; ty } + in + indent ^ "| " + ^ Values.typed_value_to_string env v + ^ " ->\n" + ^ expression_to_string env indent1 indent_incr branch + in + indent ^ "match " ^ scrut ^ " with\n" + ^ String.concat "\n" (List.map branch_to_string branches) + | ExpandBool (e0, e1) -> + let e0 = expression_to_string env indent1 indent_incr e0 in + let e1 = expression_to_string env indent1 indent_incr e1 in + indent ^ "if " ^ scrut ^ " then\n" ^ e0 ^ "\n" ^ indent ^ "else\n" ^ e1 + | ExpandInt (_, branches, otherwise) -> + let branch_to_string ((sv, branch) : scalar_value * expression) : string = + indent ^ "| " + ^ Values.scalar_value_to_string sv + ^ " ->\n" + ^ expression_to_string env indent1 indent_incr branch + in + let otherwise = expression_to_string env indent1 indent_incr otherwise in + indent ^ "match " ^ scrut ^ " with\n" + ^ String.concat "\n" (List.map branch_to_string branches) + ^ "\n" ^ indent ^ "| _ ->\n" ^ otherwise + +and loop_to_string (env : fmt_env) (indent : string) (indent_incr : string) + (loop : loop) : string = + let indent1 = indent ^ indent_incr in + let loop_id = LoopId.to_string loop.loop_id in + let fresh_svalues = SymbolicValueId.Set.to_string None loop.fresh_svalues in + let end_expr = expression_to_string env indent1 indent_incr loop.end_expr in + let loop_expr = expression_to_string env indent1 indent_incr loop.loop_expr in + "loop@" ^ loop_id ^ " {\n\n" ^ indent1 ^ "fresh_svalues = " ^ fresh_svalues + ^ "\n\n" ^ indent1 ^ "end_expr=\n" ^ end_expr ^ "\n\n" ^ indent1 + ^ "loop_expr=\n" ^ loop_expr ^ "\n" ^ indent ^ "}" diff --git a/src/symbolic/SymbolicAst.ml b/src/symbolic/SymbolicAst.ml index f92be2b36..782b29910 100644 --- a/src/symbolic/SymbolicAst.ml +++ b/src/symbolic/SymbolicAst.ml @@ -41,7 +41,7 @@ type call = { borrows (we need to perform lookups). *) sg : fun_sig option; - (** The un-instantiated function signature, if this is not a unop/binop. + (** The non-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. @@ -225,7 +225,7 @@ and loop = { input_svalues : symbolic_value list; (** The input symbolic values *) fresh_svalues : symbolic_value_id_set; (** The symbolic values introduced by the loop fixed-point *) - rg_to_given_back_tys : (ty list RegionGroupId.Map.t[@opaque]); + rg_to_given_back_tys : (Pure.ty list RegionGroupId.Map.t[@opaque]); (** The map from region group ids to the types of the values given back by the corresponding loop abstractions. *) diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index e77c9f2a3..0375837e4 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -5,6 +5,7 @@ open InterpreterUtils open FunsAnalysis open TypesAnalysis open Errors +open PrintSymbolicAst module T = Types module V = Values module C = Contexts @@ -441,13 +442,18 @@ let typed_pattern_to_string (ctx : bs_ctx) (p : Pure.typed_pattern) : string = let env = bs_ctx_to_pure_fmt_env ctx in PrintPure.typed_pattern_to_string ~span:(Some ctx.span) env p -let abs_to_string (ctx : bs_ctx) (abs : V.abs) : string = +let abs_to_string ?(with_ended : bool = false) (ctx : bs_ctx) (abs : V.abs) : + string = let env = bs_ctx_to_fmt_env ctx in let verbose = false in let indent = "" in let indent_incr = " " in - Print.Values.abs_to_string ~span:(Some ctx.span) env verbose indent - indent_incr abs + Print.Values.abs_to_string ~span:(Some ctx.span) ~with_ended env verbose + indent indent_incr abs + +let bs_ctx_expression_to_string (ctx : bs_ctx) (e : S.expression) : string = + let env = bs_ctx_to_fmt_env ctx in + expression_to_string env "" " " e let ctx_get_effect_info_for_bid (ctx : bs_ctx) (bid : RegionGroupId.id option) : fun_effect_info = @@ -2213,7 +2219,9 @@ let typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) upon ending the borrow we consumed a value). Otherwise we ignore it. *) log#ldebug - (lazy ("typed_avalue_to_consumed: " ^ typed_avalue_to_string ectx av)); + (lazy + ("typed_avalue_to_consumed: " + ^ typed_avalue_to_string ~with_ended:true ectx av)); match compute_typed_avalue_proj_kind ctx.span ctx.type_ctx.type_infos abs_regions av @@ -2240,9 +2248,7 @@ 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 ^ "\n- raw: " - ^ V.show_abs abs)); + (lazy ("abs_to_consumed:\n" ^ abs_to_string ~with_ended:true ctx abs)); let values = List.filter_map (typed_avalue_to_consumed ctx ectx abs.regions.owned) @@ -2250,7 +2256,9 @@ let abs_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) (abs : V.abs) : in log#ldebug (lazy - ("abs_to_consumed:\n- abs: " ^ abs_to_string ctx abs ^ "\n- values: " + ("abs_to_consumed:\n- abs: " + ^ abs_to_string ~with_ended:true ctx abs + ^ "\n- values: " ^ Print.list_to_string (texpression_to_string ctx) values)); values @@ -4197,9 +4205,9 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = loop.input_svalues ^ "\n- filtered svl: " ^ (Print.list_to_string (symbolic_value_to_string ctx)) svl - ^ "\n- rg_to_abs\n:" + ^ "\n- rg_to_abs:\n" ^ T.RegionGroupId.Map.show - (Print.list_to_string (ty_to_string ctx)) + (Print.list_to_string (pure_ty_to_string ctx)) loop.rg_to_given_back_tys ^ "\n")); let ctx, _ = fresh_vars_for_symbolic_values svl ctx in @@ -4225,21 +4233,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = in (* Compute the backward outputs *) - let rg_to_given_back_tys = - RegionGroupId.Map.map - (fun tys -> - (* The types shouldn't contain borrows - we can translate them as forward types *) - List.map - (fun ty -> - cassert __FILE__ __LINE__ - (not - (TypesUtils.ty_has_borrows (Some ctx.span) - ctx.type_ctx.type_infos ty)) - ctx.span "The types shouldn't contain borrows"; - ctx_translate_fwd_ty ctx ty) - tys) - loop.rg_to_given_back_tys - in + let rg_to_given_back_tys = loop.rg_to_given_back_tys in (* The output type of the loop function *) let fwd_effect_info = @@ -4575,6 +4569,14 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = match body with | None -> None | Some body -> + log#ldebug + (lazy + ("SymbolicToPure.translate_fun_decl: " + ^ name_to_string ctx def.item_meta.name + ^ "\n- body:\n" + ^ bs_ctx_expression_to_string ctx body)); + raise (Failure "TODO"); + let effect_info = get_fun_effect_info ctx (FunId (FRegular def_id)) None None in diff --git a/src/symbolic/SynthesizeSymbolic.ml b/src/symbolic/SynthesizeSymbolic.ml index 11b19e982..054d25d1c 100644 --- a/src/symbolic/SynthesizeSymbolic.ml +++ b/src/symbolic/SynthesizeSymbolic.ml @@ -178,20 +178,5 @@ let synthesize_assertion (ctx : Contexts.eval_ctx) (v : typed_value) (e : expression) = Assertion (ctx, v, e) -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) - (loop_expr : expression) (span : Meta.span) : expression = - Loop - { - loop_id; - input_svalues; - fresh_svalues; - rg_to_given_back_tys; - end_expr; - loop_expr; - span; - } - let save_snapshot (ctx : Contexts.eval_ctx) (e : expression) : expression = Meta (Snapshot ctx, e) From a480989c3b03686baf9cc65efc31194bb2c34ef7 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 7 Jan 2025 14:51:53 +0000 Subject: [PATCH 08/23] Fix a bug in convert_value_to_abstractions --- src/interp/InterpreterBorrows.ml | 3 +- src/interp/InterpreterLoops.ml | 3 +- src/interp/InterpreterLoopsJoinCtxs.ml | 13 +- src/interp/InterpreterUtils.ml | 9 +- src/interp/Invariants.ml | 631 +++++++++++++------------ src/llbc/Print.ml | 27 +- src/symbolic/PrintSymbolicAst.ml | 12 +- src/symbolic/SymbolicToPure.ml | 4 +- 8 files changed, 387 insertions(+), 315 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 08ff2ab2d..2898ae9dd 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -2009,6 +2009,7 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) avalues; } in + Invariants.opt_type_check_abs span ctx abs; (* Add to the list of abstractions *) absl := abs :: !absl in @@ -2083,7 +2084,6 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) let value = ABorrow (ASharedBorrow (PNone, bid)) in ([ { value; ty } ], v) | VMutBorrow (bid, bv) -> - let r_id = if group then r_id else fresh_region_id () in (* We don't support nested borrows for now *) cassert __FILE__ __LINE__ (not (value_has_borrows (Some span) ctx bv.value)) @@ -3507,6 +3507,7 @@ let merge_into_first_abstraction (span : Meta.span) (abs_kind : abs_kind) let nabs = merge_abstractions span abs_kind can_end merge_funs ctx abs0 abs1 in + Invariants.opt_type_check_abs span ctx nabs; (* Update the environment: replace the abstraction 0 with the result of the merge, remove the abstraction 1 *) diff --git a/src/interp/InterpreterLoops.ml b/src/interp/InterpreterLoops.ml index 1fb2dd671..b7a723b3c 100644 --- a/src/interp/InterpreterLoops.ml +++ b/src/interp/InterpreterLoops.ml @@ -388,7 +388,8 @@ let eval_loop_symbolic (config : config) (span : span) log#ldebug (lazy ("eval_loop_symbolic: compute_abs_given_back_tys:\n- abs:\n" - ^ abs_to_string span ctx abs ^ "\n")); + ^ abs_to_string span ~with_ended:true ctx abs + ^ "\n")); let is_borrow (av : typed_avalue) : bool = match av.value with diff --git a/src/interp/InterpreterLoopsJoinCtxs.ml b/src/interp/InterpreterLoopsJoinCtxs.ml index eb0a21765..eee4f049d 100644 --- a/src/interp/InterpreterLoopsJoinCtxs.ml +++ b/src/interp/InterpreterLoopsJoinCtxs.ml @@ -303,12 +303,13 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) match ee with | EAbs _ | EFrame | EBinding (BVar _, _) -> [ ee ] | EBinding (BDummy id, v) -> - if is_fresh_did id then + if is_fresh_did id then ( let absl = convert_value_to_abstractions span abs_kind can_end destructure_shared_values ctx0 v in - List.map (fun abs -> EAbs abs) absl + Invariants.opt_type_check_absl span ctx0 absl; + List.map (fun abs -> EAbs abs) absl) else [ ee ]) ctx0.env) in @@ -1171,6 +1172,8 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) (lazy ("loop_join_origin_with_continue_ctxs:join_one: after destructure:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); + (* Sanity check *) + if !Config.sanity_checks then Invariants.check_invariants span ctx; (* Reduce the context we want to add to the join *) let ctx = reduce_ctx span loop_id fixed_ids ctx in @@ -1178,9 +1181,13 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) (lazy ("loop_join_origin_with_continue_ctxs:join_one: after reduce:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); + (* Sanity check *) + if !Config.sanity_checks then Invariants.check_invariants span ctx; (* Refresh the fresh abstractions *) let ctx = refresh_abs fixed_ids.aids ctx in + (* Sanity check *) + if !Config.sanity_checks then Invariants.check_invariants span ctx; (* Join the two contexts *) let ctx1 = join_one_aux ctx in @@ -1195,6 +1202,8 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) (lazy ("loop_join_origin_with_continue_ctxs:join_one: after join-collapse:\n" ^ eval_ctx_to_string ~span:(Some span) !joined_ctx)); + (* Sanity check *) + if !Config.sanity_checks then Invariants.check_invariants span !joined_ctx; (* Reduce again to reach a fixed point *) joined_ctx := reduce_ctx span loop_id fixed_ids !joined_ctx; diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index dc99c5337..c33a196f7 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -64,8 +64,8 @@ let env_elem_to_string span ctx = let env_to_string span ctx env = eval_ctx_to_string ~span:(Some span) { ctx with env } -let abs_to_string span ctx = - Print.EvalCtx.abs_to_string ~span:(Some span) ctx "" " " +let abs_to_string span ?(with_ended = false) ctx = + Print.EvalCtx.abs_to_string ~span:(Some span) ~with_ended ctx "" " " let same_symbolic_id (sv0 : symbolic_value) (sv1 : symbolic_value) : bool = sv0.sv_id = sv1.sv_id @@ -255,6 +255,11 @@ let symbolic_value_has_ended_regions (ended_regions : RegionId.Set.t) let regions = ty_regions s.sv_ty in not (RegionId.Set.disjoint regions ended_regions) +let region_is_owned (abs : abs) (r : region) : bool = + match r with + | RVar (Free rid) -> RegionId.Set.mem rid abs.regions.owned + | _ -> false + let bottom_in_value_visitor (ended_regions : RegionId.Set.t) = object inherit [_] iter_typed_value diff --git a/src/interp/Invariants.ml b/src/interp/Invariants.ml index 44ce8b218..b02b40c69 100644 --- a/src/interp/Invariants.ml +++ b/src/interp/Invariants.ml @@ -384,7 +384,9 @@ let check_literal_type (span : Meta.span) (cv : literal) (ty : literal_type) : | VBool _, TBool | VChar _, TChar -> () | _ -> craise __FILE__ __LINE__ span "Erroneous typing" -let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = +(** If [lookups] is [true] whenever we encounter a loan/borrow we lookup the corresponding + borrow/loan to check its type. This only works when checking non-partial environments. *) +let check_typing_invariant_visitor span ctx (lookups : bool) = (* TODO: the type of aloans doens't make sense: they have a type * of the shape [& (mut) T] where they should have type [T]... * This messes a bit the type invariant checks when checking the @@ -396,231 +398,232 @@ let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = let _, ty, _ = ty_get_ref ty in ty in - - let visitor = - object - inherit [_] iter_eval_ctx as super - method! visit_abs _ abs = super#visit_abs (Some abs) abs - - method! visit_EBinding info binder v = - (* We also check that the regions are erased *) - sanity_check __FILE__ __LINE__ (ty_is_ety v.ty) span; - super#visit_EBinding info binder v - - method! visit_symbolic_value inside_abs v = - (* Check that the types have regions *) - sanity_check __FILE__ __LINE__ (ty_is_rty v.sv_ty) span; - super#visit_symbolic_value inside_abs v - - method! visit_typed_value info tv = - (* Check that the types have erased regions *) - sanity_check __FILE__ __LINE__ (ty_is_ety tv.ty) span; - (* Check the current pair (value, type) *) - (match (tv.value, tv.ty) with - | VLiteral cv, TLiteral ty -> check_literal_type span cv ty - (* ADT case *) - | VAdt av, TAdt (TAdtId def_id, generics) -> - (* Retrieve the definition to check the variant id, the number of - * parameters, etc. *) - let def = ctx_lookup_type_decl ctx def_id in - (* Check the number of parameters *) - sanity_check __FILE__ __LINE__ - (List.length generics.regions = List.length def.generics.regions) - span; - sanity_check __FILE__ __LINE__ - (List.length generics.types = List.length def.generics.types) - span; - (* Check that the variant id is consistent *) - (match (av.variant_id, def.kind) with - | Some variant_id, Enum variants -> - sanity_check __FILE__ __LINE__ - (VariantId.to_int variant_id < List.length variants) - span - | None, Struct _ -> () - | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); - (* Check that the field types are correct *) - let field_types = - AssociatedTypes.type_decl_get_inst_norm_field_etypes span ctx def - av.variant_id generics - in - let fields_with_types = List.combine av.field_values field_types in - List.iter - (fun ((v, ty) : typed_value * ty) -> - sanity_check __FILE__ __LINE__ (v.ty = ty) span) - fields_with_types - (* Tuple case *) - | VAdt av, TAdt (TTuple, generics) -> - sanity_check __FILE__ __LINE__ (generics.regions = []) span; - sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; - sanity_check __FILE__ __LINE__ (av.variant_id = None) span; - (* Check that the fields have the proper values - and check that there - * are as many fields as field types at the same time *) - let fields_with_types = - List.combine av.field_values generics.types - in - List.iter - (fun ((v, ty) : typed_value * ty) -> - sanity_check __FILE__ __LINE__ (v.ty = ty) span) - fields_with_types - (* Builtin type case *) - | VAdt av, TAdt (TBuiltin aty_id, generics) -> ( - sanity_check __FILE__ __LINE__ (av.variant_id = None) span; - match - ( aty_id, - av.field_values, - generics.regions, - generics.types, - generics.const_generics ) - with - (* Box *) - | TBox, [ inner_value ], [], [ inner_ty ], [] -> - sanity_check __FILE__ __LINE__ (inner_value.ty = inner_ty) span - | TArray, inner_values, _, [ inner_ty ], [ cg ] -> - (* *) - sanity_check __FILE__ __LINE__ - (List.for_all - (fun (v : typed_value) -> v.ty = inner_ty) - inner_values) - span; - (* The length is necessarily concrete *) - let len = - (ValuesUtils.literal_as_scalar - (TypesUtils.const_generic_as_literal cg)) - .value - in - sanity_check __FILE__ __LINE__ - (Z.of_int (List.length inner_values) = len) - span - | (TSlice | TStr), _, _, _, _ -> - craise __FILE__ __LINE__ span "Unexpected" - | _ -> craise __FILE__ __LINE__ span "Erroneous type") - | VBottom, _ -> (* Nothing to check *) () - | VBorrow bc, TRef (_, ref_ty, rkind) -> ( - match (bc, rkind) with - | VSharedBorrow bid, RShared | VReservedMutBorrow bid, RMut -> ( + object + inherit [_] iter_eval_ctx as super + method! visit_abs _ abs = super#visit_abs (Some abs) abs + + method! visit_EBinding info binder v = + (* We also check that the regions are erased *) + sanity_check __FILE__ __LINE__ (ty_is_ety v.ty) span; + super#visit_EBinding info binder v + + method! visit_symbolic_value inside_abs v = + (* Check that the types have regions *) + sanity_check __FILE__ __LINE__ (ty_is_rty v.sv_ty) span; + super#visit_symbolic_value inside_abs v + + method! visit_typed_value info tv = + (* Check that the types have erased regions *) + sanity_check __FILE__ __LINE__ (ty_is_ety tv.ty) span; + (* Check the current pair (value, type) *) + (match (tv.value, tv.ty) with + | VLiteral cv, TLiteral ty -> check_literal_type span cv ty + (* ADT case *) + | VAdt av, TAdt (TAdtId def_id, generics) -> + (* Retrieve the definition to check the variant id, the number of + * parameters, etc. *) + let def = ctx_lookup_type_decl ctx def_id in + (* Check the number of parameters *) + sanity_check __FILE__ __LINE__ + (List.length generics.regions = List.length def.generics.regions) + span; + sanity_check __FILE__ __LINE__ + (List.length generics.types = List.length def.generics.types) + span; + (* Check that the variant id is consistent *) + (match (av.variant_id, def.kind) with + | Some variant_id, Enum variants -> + sanity_check __FILE__ __LINE__ + (VariantId.to_int variant_id < List.length variants) + span + | None, Struct _ -> () + | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); + (* Check that the field types are correct *) + let field_types = + AssociatedTypes.type_decl_get_inst_norm_field_etypes span ctx def + av.variant_id generics + in + let fields_with_types = List.combine av.field_values field_types in + List.iter + (fun ((v, ty) : typed_value * ty) -> + sanity_check __FILE__ __LINE__ (v.ty = ty) span) + fields_with_types + (* Tuple case *) + | VAdt av, TAdt (TTuple, generics) -> + sanity_check __FILE__ __LINE__ (generics.regions = []) span; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; + sanity_check __FILE__ __LINE__ (av.variant_id = None) span; + (* Check that the fields have the proper values - and check that there + * are as many fields as field types at the same time *) + let fields_with_types = List.combine av.field_values generics.types in + List.iter + (fun ((v, ty) : typed_value * ty) -> + sanity_check __FILE__ __LINE__ (v.ty = ty) span) + fields_with_types + (* Builtin type case *) + | VAdt av, TAdt (TBuiltin aty_id, generics) -> ( + sanity_check __FILE__ __LINE__ (av.variant_id = None) span; + match + ( aty_id, + av.field_values, + generics.regions, + generics.types, + generics.const_generics ) + with + (* Box *) + | TBox, [ inner_value ], [], [ inner_ty ], [] -> + sanity_check __FILE__ __LINE__ (inner_value.ty = inner_ty) span + | TArray, inner_values, _, [ inner_ty ], [ cg ] -> + (* *) + sanity_check __FILE__ __LINE__ + (List.for_all + (fun (v : typed_value) -> v.ty = inner_ty) + inner_values) + span; + (* The length is necessarily concrete *) + let len = + (ValuesUtils.literal_as_scalar + (TypesUtils.const_generic_as_literal cg)) + .value + in + sanity_check __FILE__ __LINE__ + (Z.of_int (List.length inner_values) = len) + span + | (TSlice | TStr), _, _, _, _ -> + craise __FILE__ __LINE__ span "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Erroneous type") + | VBottom, _ -> (* Nothing to check *) () + | VBorrow bc, TRef (_, ref_ty, rkind) -> ( + match (bc, rkind) with + | VSharedBorrow bid, RShared | VReservedMutBorrow bid, RMut -> ( + if (* Lookup the borrowed value to check it has the proper type. Note that we ignore the marker: we will check it when checking the loan itself. *) + lookups + then let _, glc = lookup_loan span ek_all bid ctx in match glc with | Concrete (VSharedLoan (_, sv)) | Abstract (ASharedLoan (_, _, sv, _)) -> sanity_check __FILE__ __LINE__ (sv.ty = ref_ty) span | _ -> craise __FILE__ __LINE__ span "Inconsistent context") - | VMutBorrow (_, bv), RMut -> - sanity_check __FILE__ __LINE__ - ((* Check that the borrowed value has the proper type *) - bv.ty = ref_ty) - span - | _ -> craise __FILE__ __LINE__ span "Erroneous typing") - | VLoan lc, ty -> ( - match lc with - | VSharedLoan (_, sv) -> - sanity_check __FILE__ __LINE__ (sv.ty = ty) span - | VMutLoan bid -> ( + | VMutBorrow (_, bv), RMut -> + sanity_check __FILE__ __LINE__ + ((* Check that the borrowed value has the proper type *) + bv.ty = ref_ty) + span + | _ -> craise __FILE__ __LINE__ span "Erroneous typing") + | VLoan lc, ty -> ( + match lc with + | VSharedLoan (_, sv) -> + sanity_check __FILE__ __LINE__ (sv.ty = ty) span + | VMutLoan bid -> ( + if lookups then (* Lookup the borrowed value to check it has the proper type. *) let glc = lookup_borrow span ek_all bid ctx in match glc with | Concrete (VMutBorrow (_, bv)) -> sanity_check __FILE__ __LINE__ (bv.ty = ty) span - | Abstract (AMutBorrow (pm, _, sv)) -> - (* The marker check is redundant, but doesn't cost much *) - sanity_check __FILE__ __LINE__ (pm = PNone) span; + | Abstract (AMutBorrow (_, _, sv)) -> sanity_check __FILE__ __LINE__ (Substitute.erase_regions sv.ty = ty) span | _ -> craise __FILE__ __LINE__ span "Inconsistent context")) - | VSymbolic sv, ty -> - let ty' = Substitute.erase_regions sv.sv_ty in - sanity_check __FILE__ __LINE__ (ty' = ty) span - | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); - (* Continue exploring to inspect the subterms *) - super#visit_typed_value info tv - - (* TODO: there is a lot of duplication with {!visit_typed_value} - * which is quite annoying. There might be a way of factorizing - * that by factorizing the definitions of value and avalue, but - * the generation of visitors then doesn't work properly (TODO: - * report that). Still, it is actually not that problematic - * because this code shouldn't change a lot in the future, - * so the cost of maintenance should be pretty low. - * *) - method! visit_typed_avalue info atv = - (* Check that the types have regions *) - sanity_check __FILE__ __LINE__ (ty_is_rty atv.ty) span; - (* Check the current pair (value, type) *) - (match (atv.value, atv.ty) with - (* ADT case *) - | AAdt av, TAdt (TAdtId def_id, generics) -> - (* Retrieve the definition to check the variant id, the number of - * parameters, etc. *) - let def = ctx_lookup_type_decl ctx def_id in - (* Check the number of parameters *) - sanity_check __FILE__ __LINE__ - (List.length generics.regions = List.length def.generics.regions) - span; - sanity_check __FILE__ __LINE__ - (List.length generics.types = List.length def.generics.types) - span; - sanity_check __FILE__ __LINE__ - (List.length generics.const_generics - = List.length def.generics.const_generics) - span; - (* Check that the variant id is consistent *) - (match (av.variant_id, def.kind) with - | Some variant_id, Enum variants -> - sanity_check __FILE__ __LINE__ - (VariantId.to_int variant_id < List.length variants) - span - | None, Struct _ -> () - | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); - (* Check that the field types are correct *) - let field_types = - AssociatedTypes.type_decl_get_inst_norm_field_rtypes span ctx def - av.variant_id generics - in - let fields_with_types = List.combine av.field_values field_types in - List.iter - (fun ((v, ty) : typed_avalue * ty) -> - sanity_check __FILE__ __LINE__ (v.ty = ty) span) - fields_with_types - (* Tuple case *) - | AAdt av, TAdt (TTuple, generics) -> - sanity_check __FILE__ __LINE__ (generics.regions = []) span; - sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; - sanity_check __FILE__ __LINE__ (av.variant_id = None) span; - (* Check that the fields have the proper values - and check that there - * are as many fields as field types at the same time *) - let fields_with_types = - List.combine av.field_values generics.types - in - List.iter - (fun ((v, ty) : typed_avalue * ty) -> - sanity_check __FILE__ __LINE__ (v.ty = ty) span) - fields_with_types - (* Builtin type case *) - | AAdt av, TAdt (TBuiltin aty_id, generics) -> ( - sanity_check __FILE__ __LINE__ (av.variant_id = None) span; - match - ( aty_id, - av.field_values, - generics.regions, - generics.types, - generics.const_generics ) - with - (* Box *) - | TBox, [ boxed_value ], [], [ boxed_ty ], [] -> - sanity_check __FILE__ __LINE__ (boxed_value.ty = boxed_ty) span - | _ -> craise __FILE__ __LINE__ span "Erroneous type") - | ABottom, _ -> (* Nothing to check *) () - | ABorrow bc, TRef (_, ref_ty, rkind) -> ( - match (bc, rkind) with - | AMutBorrow (pm, _, av), RMut -> - sanity_check __FILE__ __LINE__ (pm = PNone) span; - (* Check that the child value has the proper type *) - sanity_check __FILE__ __LINE__ (av.ty = ref_ty) span - | ASharedBorrow (pm, bid), RShared -> ( - sanity_check __FILE__ __LINE__ (pm = PNone) span; + | VSymbolic sv, ty -> + let ty' = Substitute.erase_regions sv.sv_ty in + sanity_check __FILE__ __LINE__ (ty' = ty) span + | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); + (* Continue exploring to inspect the subterms *) + super#visit_typed_value info tv + + (* TODO: there is a lot of duplication with {!visit_typed_value} + * which is quite annoying. There might be a way of factorizing + * that by factorizing the definitions of value and avalue, but + * the generation of visitors then doesn't work properly (TODO: + * report that). Still, it is actually not that problematic + * because this code shouldn't change a lot in the future, + * so the cost of maintenance should be pretty low. + * *) + method! visit_typed_avalue info atv = + (* Check that the types have regions *) + sanity_check __FILE__ __LINE__ (ty_is_rty atv.ty) span; + (* Check the current pair (value, type) *) + (match (atv.value, atv.ty) with + (* ADT case *) + | AAdt av, TAdt (TAdtId def_id, generics) -> + (* Retrieve the definition to check the variant id, the number of + * parameters, etc. *) + let def = ctx_lookup_type_decl ctx def_id in + (* Check the number of parameters *) + sanity_check __FILE__ __LINE__ + (List.length generics.regions = List.length def.generics.regions) + span; + sanity_check __FILE__ __LINE__ + (List.length generics.types = List.length def.generics.types) + span; + sanity_check __FILE__ __LINE__ + (List.length generics.const_generics + = List.length def.generics.const_generics) + span; + (* Check that the variant id is consistent *) + (match (av.variant_id, def.kind) with + | Some variant_id, Enum variants -> + sanity_check __FILE__ __LINE__ + (VariantId.to_int variant_id < List.length variants) + span + | None, Struct _ -> () + | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); + (* Check that the field types are correct *) + let field_types = + AssociatedTypes.type_decl_get_inst_norm_field_rtypes span ctx def + av.variant_id generics + in + let fields_with_types = List.combine av.field_values field_types in + List.iter + (fun ((v, ty) : typed_avalue * ty) -> + sanity_check __FILE__ __LINE__ (v.ty = ty) span) + fields_with_types + (* Tuple case *) + | AAdt av, TAdt (TTuple, generics) -> + sanity_check __FILE__ __LINE__ (generics.regions = []) span; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; + sanity_check __FILE__ __LINE__ (av.variant_id = None) span; + (* Check that the fields have the proper values - and check that there + * are as many fields as field types at the same time *) + let fields_with_types = List.combine av.field_values generics.types in + List.iter + (fun ((v, ty) : typed_avalue * ty) -> + sanity_check __FILE__ __LINE__ (v.ty = ty) span) + fields_with_types + (* Builtin type case *) + | AAdt av, TAdt (TBuiltin aty_id, generics) -> ( + sanity_check __FILE__ __LINE__ (av.variant_id = None) span; + match + ( aty_id, + av.field_values, + generics.regions, + generics.types, + generics.const_generics ) + with + (* Box *) + | TBox, [ boxed_value ], [], [ boxed_ty ], [] -> + sanity_check __FILE__ __LINE__ (boxed_value.ty = boxed_ty) span + | _ -> craise __FILE__ __LINE__ span "Erroneous type") + | ABottom, _ -> (* Nothing to check *) () + | ABorrow bc, TRef (region, ref_ty, rkind) -> ( + let abs = Option.get info in + (* Check the borrow content *) + match (bc, rkind) with + | AMutBorrow (_, _, av), RMut -> + (* Check that the region is owned by the abstraction *) + sanity_check __FILE__ __LINE__ (region_is_owned abs region) span; + (* Check that the child value has the proper type *) + sanity_check __FILE__ __LINE__ (av.ty = ref_ty) span + | ASharedBorrow (_, bid), RShared -> ( + (* Check that the region is owned by the abstraction *) + sanity_check __FILE__ __LINE__ (region_is_owned abs region) span; + if lookups then (* Lookup the borrowed value to check it has the proper type *) let _, glc = lookup_loan span ek_all bid ctx in match glc with @@ -630,20 +633,32 @@ let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = (sv.ty = Substitute.erase_regions ref_ty) span | _ -> craise __FILE__ __LINE__ span "Inconsistent context") - | AIgnoredMutBorrow (_opt_bid, av), RMut -> - sanity_check __FILE__ __LINE__ (av.ty = ref_ty) span - | ( AEndedIgnoredMutBorrow { given_back; child; given_back_meta = _ }, - RMut ) -> - sanity_check __FILE__ __LINE__ (given_back.ty = ref_ty) span; - sanity_check __FILE__ __LINE__ (child.ty = ref_ty) span - | AProjSharedBorrow _, RShared -> () - | _ -> craise __FILE__ __LINE__ span "Inconsistent context") - | ALoan lc, aty -> ( - match lc with - | AMutLoan (PNone, bid, child_av) - | AIgnoredMutLoan (Some bid, child_av) -> ( - let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span; + | AIgnoredMutBorrow (_opt_bid, av), RMut -> + sanity_check __FILE__ __LINE__ (av.ty = ref_ty) span + | ( AEndedIgnoredMutBorrow { given_back; child; given_back_meta = _ }, + RMut ) -> + sanity_check __FILE__ __LINE__ (given_back.ty = ref_ty) span; + sanity_check __FILE__ __LINE__ (child.ty = ref_ty) span + | AProjSharedBorrow _, RShared -> () + | _ -> craise __FILE__ __LINE__ span "Inconsistent context") + | ALoan lc, aty -> ( + let abs = Option.get info in + match lc with + | AMutLoan (_, bid, child_av) | AIgnoredMutLoan (Some bid, child_av) + -> ( + (* Check that the region is owned by the abstraction *) + let region, _, _ = ty_as_ref aty in + begin + match lc with + | AMutLoan _ -> + sanity_check __FILE__ __LINE__ + (region_is_owned abs region) + span + | _ -> () + end; + let borrowed_aty = aloan_get_expected_child_type aty in + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span; + if lookups then (* Lookup the borrowed value to check it has the proper type *) let glc = lookup_borrow span ek_all bid ctx in match glc with @@ -657,80 +672,88 @@ let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = = Substitute.erase_regions borrowed_aty) span | _ -> craise __FILE__ __LINE__ span "Inconsistent context") - | AMutLoan (_, _, _) -> - (* We get there if the projection marker is not [PNone] *) - internal_error __FILE__ __LINE__ span - | AIgnoredMutLoan (None, child_av) -> - let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span - | ASharedLoan (PNone, _, sv, child_av) - | AEndedSharedLoan (sv, child_av) -> - let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check __FILE__ __LINE__ - (sv.ty = Substitute.erase_regions borrowed_aty) - span; - (* TODO: the type of aloans doesn't make sense, see above *) - sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span - | ASharedLoan (_, _, _, _) -> - (* We get there if the projection marker is not [PNone] *) - internal_error __FILE__ __LINE__ span - | AEndedMutLoan { given_back; child; given_back_meta = _ } - | AEndedIgnoredMutLoan { given_back; child; given_back_meta = _ } -> - let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check __FILE__ __LINE__ - (given_back.ty = borrowed_aty) - span; - sanity_check __FILE__ __LINE__ (child.ty = borrowed_aty) span - | AIgnoredSharedLoan child_av -> - sanity_check __FILE__ __LINE__ - (child_av.ty = aloan_get_expected_child_type aty) - span) - | ASymbolic (pm, aproj), ty -> ( - sanity_check __FILE__ __LINE__ (pm = PNone) span; - let ty1 = Substitute.erase_regions ty in - match aproj with - | 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 proj_ty) - span - | 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 - - * 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 proj_ty) - span - | AEndedProjLoans (_msv, given_back_ls) -> - List.iter - (fun (_, proj) -> - match proj with - | AProjBorrows (_sv, ty', _) -> - sanity_check __FILE__ __LINE__ (ty' = ty) span - | AEndedProjBorrows _ | AEmpty -> () - | _ -> craise __FILE__ __LINE__ span "Unexpected") - given_back_ls - | AEndedProjBorrows _ | AEmpty -> ()) - | AIgnored _, _ -> () - | _ -> - log#ltrace - (lazy - ("Erroneous typing:" ^ "\n- raw value: " ^ show_typed_avalue atv - ^ "\n- value: " - ^ typed_avalue_to_string ~span:(Some span) ctx atv - ^ "\n- type: " ^ ty_to_string ctx atv.ty)); - internal_error __FILE__ __LINE__ span); - (* Continue exploring to inspect the subterms *) - super#visit_typed_avalue info atv - end - in - visitor#visit_eval_ctx (None : abs option) ctx + | AIgnoredMutLoan (None, child_av) -> + let borrowed_aty = aloan_get_expected_child_type aty in + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span + | ASharedLoan (_, _, sv, child_av) | AEndedSharedLoan (sv, child_av) + -> + (* Check that the region is owned by the abstraction *) + let region, _, _ = ty_as_ref aty in + sanity_check __FILE__ __LINE__ (region_is_owned abs region) span; + let borrowed_aty = aloan_get_expected_child_type aty in + sanity_check __FILE__ __LINE__ + (sv.ty = Substitute.erase_regions borrowed_aty) + span; + (* TODO: the type of aloans doesn't make sense, see above *) + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span + | AEndedMutLoan { given_back; child; given_back_meta = _ } + | AEndedIgnoredMutLoan { given_back; child; given_back_meta = _ } -> + (* Check that the region is owned by the abstraction *) + let region, _, _ = ty_as_ref aty in + begin + match lc with + | AEndedMutLoan _ -> + sanity_check __FILE__ __LINE__ + (region_is_owned abs region) + span + | _ -> () + end; + let borrowed_aty = aloan_get_expected_child_type aty in + sanity_check __FILE__ __LINE__ (given_back.ty = borrowed_aty) span; + sanity_check __FILE__ __LINE__ (child.ty = borrowed_aty) span + | AIgnoredSharedLoan child_av -> + sanity_check __FILE__ __LINE__ + (child_av.ty = aloan_get_expected_child_type aty) + span) + | ASymbolic (_, aproj), ty -> ( + let ty1 = Substitute.erase_regions ty in + match aproj with + | 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 proj_ty) + span + | 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 - + * 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 proj_ty) + span + | AEndedProjLoans (_msv, given_back_ls) -> + List.iter + (fun (_, proj) -> + match proj with + | AProjBorrows (_sv, ty', _) -> + sanity_check __FILE__ __LINE__ (ty' = ty) span + | AEndedProjBorrows _ | AEmpty -> () + | _ -> craise __FILE__ __LINE__ span "Unexpected") + given_back_ls + | AEndedProjBorrows _ | AEmpty -> ()) + | AIgnored _, _ -> () + | _ -> + log#ltrace + (lazy + ("Erroneous typing:" ^ "\n- raw value: " ^ show_typed_avalue atv + ^ "\n- value: " + ^ typed_avalue_to_string ~span:(Some span) ctx atv + ^ "\n- type: " ^ ty_to_string ctx atv.ty)); + internal_error __FILE__ __LINE__ span); + (* Continue exploring to inspect the subterms *) + super#visit_typed_avalue info atv + end + +let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) (lookups : bool) + : unit = + (check_typing_invariant_visitor span ctx lookups)#visit_eval_ctx + (None : abs option) + ctx type proj_borrows_info = { abs_id : AbstractionId.id; @@ -883,6 +906,20 @@ let check_invariants (span : Meta.span) (ctx : eval_ctx) : unit = ("Checking invariants:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); check_loans_borrows_relation_invariant span ctx; check_borrowed_values_invariant span ctx; - check_typing_invariant span ctx; + check_typing_invariant span ctx true; check_symbolic_values span ctx) else log#ldebug (lazy "Not checking invariants (check is not activated)") + +let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = + if !Config.sanity_checks then check_typing_invariant span ctx true + +let opt_type_check_abs (span : Meta.span) (ctx : eval_ctx) (abs : abs) : unit = + if !Config.sanity_checks then + (check_typing_invariant_visitor span ctx false)#visit_abs None abs + +let opt_type_check_absl (span : Meta.span) (ctx : eval_ctx) (absl : abs list) : + unit = + if !Config.sanity_checks then + List.iter + ((check_typing_invariant_visitor span ctx false)#visit_abs None) + absl diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index 7f2245e02..fe8fa24d2 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -187,6 +187,13 @@ module Values = struct | PLeft -> "|" ^ s ^ "|" | PRight -> "︙" ^ s ^ "︙" + let ended_mut_borrow_meta_to_string (env : fmt_env) + (mv : ended_mut_borrow_meta) : string = + let { bid; given_back } = mv in + "{ bid = " ^ BorrowId.to_string bid ^ "; given_back = " + ^ symbolic_value_to_string env given_back + ^ " }" + let rec typed_avalue_to_string ?(span : Meta.span option = None) ?(with_ended : bool = false) (env : fmt_env) (v : typed_avalue) : string = match v.value with @@ -254,7 +261,12 @@ module Values = struct ^ ")" |> add_proj_marker pm | AEndedMutLoan ml -> - "@ended_mut_loan{" + let consumed = + if with_ended then + "consumed = " ^ typed_value_to_string env ml.given_back_meta ^ ", " + else "" + in + "@ended_mut_loan{" ^ consumed ^ typed_avalue_to_string ~span ~with_ended env ml.child ^ "; " ^ typed_avalue_to_string ~span ~with_ended env ml.given_back @@ -299,10 +311,12 @@ module Values = struct ^ ", " ^ typed_avalue_to_string ~span ~with_ended env av ^ ")" - | AEndedMutBorrow (_mv, child) -> + | AEndedMutBorrow (mv, child) -> "@ended_mut_borrow(" - ^ typed_avalue_to_string ~span ~with_ended env child - ^ ")" + ^ + if with_ended then + "given_back= " ^ ended_mut_borrow_meta_to_string env mv + else "" ^ typed_avalue_to_string ~span ~with_ended env child ^ ")" | AEndedIgnoredMutBorrow { child; given_back; given_back_meta = _ } -> "@ended_ignored_mut_borrow{ " ^ typed_avalue_to_string ~span ~with_ended env child @@ -735,7 +749,8 @@ module EvalCtx = struct env_elem_to_string ~span env false true indent indent_incr ev let abs_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) - (indent : string) (indent_incr : string) (abs : abs) : string = + ?(with_ended : bool = false) (indent : string) (indent_incr : string) + (abs : abs) : string = let env = eval_ctx_to_fmt_env ctx in - abs_to_string ~span env false indent indent_incr abs + abs_to_string ~span env ~with_ended false indent indent_incr abs end diff --git a/src/symbolic/PrintSymbolicAst.ml b/src/symbolic/PrintSymbolicAst.ml index 9615a8493..03ce443e2 100644 --- a/src/symbolic/PrintSymbolicAst.ml +++ b/src/symbolic/PrintSymbolicAst.ml @@ -82,6 +82,8 @@ let rec expression_to_string (env : fmt_env) (indent : string) indent ^ "let " ^ sv ^ " = " ^ v ^ "in\n" ^ next | ForwardEnd (ret, _, sid_to_value, fwd_end, backs) -> let indent1 = indent ^ indent_incr in + let indent2 = indent1 ^ indent_incr in + let indent3 = indent2 ^ indent_incr in let ret = match ret with | None -> "None" @@ -98,15 +100,15 @@ let rec expression_to_string (env : fmt_env) (indent : string) in let sid_to_value = "sid_to_value = " ^ sid_to_value in - let fwd_end = expression_to_string env indent1 indent_incr fwd_end in + let fwd_end = expression_to_string env indent2 indent_incr fwd_end in let backs = - RegionGroupId.Map.to_string (Some indent1) - (fun e -> "\n" ^ expression_to_string env indent1 indent e) + RegionGroupId.Map.to_string (Some indent2) + (fun e -> "\n" ^ expression_to_string env indent3 indent_incr e) backs in indent ^ "forward_end {\n" ^ indent1 ^ ret ^ "\n" ^ indent1 ^ sid_to_value - ^ "\n" ^ indent1 ^ "fwd_end=\n" ^ fwd_end ^ "\n" ^ indent1 ^ "backs=\n" - ^ backs ^ "\n" ^ indent ^ "}" + ^ "\n" ^ indent1 ^ "fwd_end =\n" ^ fwd_end ^ "\n" ^ indent1 ^ "backs =\n" + ^ indent1 ^ backs ^ "\n" ^ indent ^ "}" | Loop loop -> loop_to_string env indent indent_incr loop | ReturnWithLoop (loop_id, is_continue) -> indent ^ "return_with_loop (" ^ LoopId.to_string loop_id diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 0375837e4..94b316855 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -3238,6 +3238,9 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) let given_back_variables = List.map (fun v -> mk_typed_pattern_from_var v None) given_back_variables in + sanity_check __FILE__ __LINE__ + (List.length given_back_variables = List.length consumed_values) + ctx.span; let variables_values = List.combine given_back_variables consumed_values in (* Sanity check: the two lists match (same types) *) @@ -4575,7 +4578,6 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = ^ name_to_string ctx def.item_meta.name ^ "\n- body:\n" ^ bs_ctx_expression_to_string ctx body)); - raise (Failure "TODO"); let effect_info = get_fun_effect_info ctx (FunId (FRegular def_id)) None None From 3c79871124a06e4288fc3887b5b3b0cb7a6778e2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 09:58:04 +0000 Subject: [PATCH 09/23] Add a CLI option to throw an exception when generating specific ids --- src/Main.ml | 52 ++++++++++++++++++++++++++++++---- src/llbc/ContextsBase.ml | 32 +++++++++++++++------ src/symbolic/SymbolicToPure.ml | 14 ++++++++- 3 files changed, 83 insertions(+), 15 deletions(-) diff --git a/src/Main.ml b/src/Main.ml index dce089a68..1ec1ef6d6 100644 --- a/src/Main.ml +++ b/src/Main.ml @@ -90,8 +90,15 @@ let matches_name_with_generics (c : crate) (name : Types.name) let activated_loggers : string list ref = ref [] -let add_activated_logger (name : string) = - activated_loggers := name :: !activated_loggers +let add_activated_loggers (name_list : string) = + let names = String.split_on_char ',' name_list in + activated_loggers := names @ !activated_loggers + +let marked_ids : string list ref = ref [] + +let add_marked_ids (ids : string) = + let ids = String.split_on_char ',' ids in + marked_ids := ids @ !marked_ids let () = (* Measure start time *) @@ -174,11 +181,21 @@ let () = " Print all the external definitions which are not listed in the \ builtin functions" ); ( "-log", - Arg.String add_activated_logger, - " Activate debugging log for a given logger designated by its name. \ - The existing loggers are: {" + Arg.String add_activated_loggers, + " Activate debugging log for a given logger designated by its name. It \ + is possible to specifiy a list of names if they are separated by \ + commas without spaces; for instance: '-log \ + Interpreter,SymbolicToPure'. The existing loggers are: {" ^ String.concat ", " (Collections.StringMap.keys !loggers) ^ "}" ); + ( "-mark-ids", + Arg.String add_marked_ids, + " For developers: mark some identifiers to throw an exception if we \ + generate them; this is useful to insert breakpoints when debugging by \ + using the log. For example, one can mark the symbolic value ids 1 and \ + 2 with '-mark-ids s1,s2', or '-mark-ids s@1, s@2. The supported \ + prefixes are: 's' (symbolic value id), 'b' (borrow id), 'a' \ + (abstraction id), 'r' (region id)." ); ] in @@ -254,6 +271,31 @@ let () = | Some logger -> logger#set_level EL.Debug) !activated_loggers; + (* Properly register the marked ids *) + List.iter + (fun id -> + let i = if String.length id >= 2 && String.get id 1 = '@' then 2 else 1 in + let sub = String.sub id i (String.length id - i) in + match int_of_string_opt sub with + | None -> + log#serror + ("Invalid identifier provided to option `-mark-ids`: '" ^ id + ^ "': '" ^ sub ^ "' can't be parsed as an int"); + fail false + | Some i -> ( + let open ContextsBase in + match String.get id 0 with + | 's' -> marked_symbolic_value_ids_insert_from_int i + | 'b' -> marked_borrow_ids_insert_from_int i + | 'a' -> marked_abstraction_ids_insert_from_int i + | 'r' -> marked_region_ids_insert_from_int i + | _ -> + log#serror + ("Invalid identifier provided to option: '" ^ id + ^ "': the first character should be in {'s', 'b', 'a', 'r'}"); + fail false)) + !marked_ids; + (* Sanity check (now that the arguments are parsed!) *) check_arg_implies (not !extract_template_decreases_clauses) diff --git a/src/llbc/ContextsBase.ml b/src/llbc/ContextsBase.ml index dd7ad953f..5e06c5e6e 100644 --- a/src/llbc/ContextsBase.ml +++ b/src/llbc/ContextsBase.ml @@ -71,15 +71,29 @@ type dummy_var_id = DummyVarId.id [@@deriving show, ord] it proved more convenient (and even before updating the code of the interpreter to use CPS). *) - -let symbolic_value_id_counter, fresh_symbolic_value_id = - SymbolicValueId.fresh_stateful_generator () - -let borrow_id_counter, fresh_borrow_id = BorrowId.fresh_stateful_generator () -let region_id_counter, fresh_region_id = RegionId.fresh_stateful_generator () - -let abstraction_id_counter, fresh_abstraction_id = - AbstractionId.fresh_stateful_generator () +let ( symbolic_value_id_counter, + marked_symbolic_value_ids, + marked_symbolic_value_ids_insert_from_int, + fresh_symbolic_value_id ) = + SymbolicValueId.fresh_marked_stateful_generator () + +let ( borrow_id_counter, + marked_borrow_ids, + marked_borrow_ids_insert_from_int, + fresh_borrow_id ) = + BorrowId.fresh_marked_stateful_generator () + +let ( region_id_counter, + marked_region_ids, + marked_region_ids_insert_from_int, + fresh_region_id ) = + RegionId.fresh_marked_stateful_generator () + +let ( abstraction_id_counter, + marked_abstraction_ids, + marked_abstraction_ids_insert_from_int, + fresh_abstraction_id ) = + AbstractionId.fresh_marked_stateful_generator () let loop_id_counter, fresh_loop_id = LoopId.fresh_stateful_generator () diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 94b316855..24c9dff47 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -2196,8 +2196,20 @@ and aproj_to_consumed_aux (ctx : bs_ctx) (_abs_regions : T.RegionId.Set.t) | V.AEndedProjLoans (msv, []) -> (* The symbolic value was left unchanged *) Some (symbolic_value_to_texpression ctx msv) - | V.AEndedProjLoans (_, [ (mnv, child_aproj) ]) -> + | V.AEndedProjLoans (msv, [ (mnv, child_aproj) ]) -> sanity_check __FILE__ __LINE__ (child_aproj = AEmpty) ctx.span; + (* TODO: check that the updated symbolic values covers all the cases + (part of the symbolic value might have been updated, and the rest + left unchanged) - it might happen with nested borrows (see the documentation + of [AProjLoans]). For now we check that there are no nested borrows + to make sure we have to update this part of the code once we add support + for nested borrows. + *) + sanity_check __FILE__ __LINE__ + (not + (TypesUtils.ty_has_nested_borrows (Some ctx.span) + ctx.type_ctx.type_infos msv.sv_ty)) + ctx.span; (* The symbolic value was updated *) Some (symbolic_value_to_texpression ctx mnv) | V.AEndedProjLoans (_, _) -> From a3c22986714ce12155fd6181619d91260e11dc39 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 10:18:19 +0000 Subject: [PATCH 10/23] Use both the trace and debug levels for the loggers --- src/Main.ml | 24 ++++--- src/extract/Extract.ml | 4 +- src/extract/ExtractBuiltin.ml | 4 +- src/interp/Interpreter.ml | 12 ++-- src/interp/InterpreterBorrows.ml | 56 ++++++++-------- src/interp/InterpreterExpansion.ml | 14 ++-- src/interp/InterpreterExpressions.ml | 10 +-- src/interp/InterpreterLoops.ml | 24 +++---- src/interp/InterpreterLoopsFixedPoint.ml | 40 ++++++------ src/interp/InterpreterLoopsJoinCtxs.ml | 42 ++++++------ src/interp/InterpreterLoopsMatchCtxs.ml | 82 ++++++++++++------------ src/interp/InterpreterPaths.ml | 4 +- src/interp/InterpreterProjectors.ml | 2 +- src/interp/InterpreterStatements.ml | 40 ++++++------ src/interp/Invariants.ml | 8 +-- src/llbc/AssociatedTypes.ml | 12 ++-- src/llbc/Contexts.ml | 2 +- src/llbc/RegionsHierarchy.ml | 2 +- src/pure/PureMicroPasses.ml | 38 +++++------ src/pure/PureTypeCheck.ml | 2 +- src/pure/ReorderDecls.ml | 2 +- src/symbolic/SymbolicToPure.ml | 68 ++++++++++---------- 22 files changed, 248 insertions(+), 244 deletions(-) diff --git a/src/Main.ml b/src/Main.ml index 1ec1ef6d6..1fe7857fb 100644 --- a/src/Main.ml +++ b/src/Main.ml @@ -88,11 +88,11 @@ let matches_name_with_generics (c : crate) (name : Types.name) in Option.is_some (NameMatcherMap.find_with_generics_opt mctx name generics m) -let activated_loggers : string list ref = ref [] +let activated_loggers : (EL.level * string) list ref = ref [] -let add_activated_loggers (name_list : string) = +let add_activated_loggers level (name_list : string) = let names = String.split_on_char ',' name_list in - activated_loggers := names @ !activated_loggers + activated_loggers := List.map (fun n -> (level, n)) names @ !activated_loggers let marked_ids : string list ref = ref [] @@ -181,13 +181,17 @@ let () = " Print all the external definitions which are not listed in the \ builtin functions" ); ( "-log", - Arg.String add_activated_loggers, - " Activate debugging log for a given logger designated by its name. It \ - is possible to specifiy a list of names if they are separated by \ - commas without spaces; for instance: '-log \ - Interpreter,SymbolicToPure'. The existing loggers are: {" + Arg.String (add_activated_loggers EL.Trace), + " Activate trace log for a given logger designated by its name. It is \ + possible to specifiy a list of names if they are separated by commas \ + without spaces; for instance: '-log Interpreter,SymbolicToPure'. The \ + existing loggers are: {" ^ String.concat ", " (Collections.StringMap.keys !loggers) ^ "}" ); + ( "-log-debug", + Arg.String (add_activated_loggers EL.Debug), + " Same as '-log' but sets the level to the more verbose 'debug' rather \ + than 'trace'" ); ( "-mark-ids", Arg.String add_marked_ids, " For developers: mark some identifiers to throw an exception if we \ @@ -259,7 +263,7 @@ let () = (* Activate the loggers *) List.iter - (fun name -> + (fun (level, name) -> match Collections.StringMap.find_opt name !loggers with | None -> log#serror @@ -268,7 +272,7 @@ let () = ^ String.concat ", " (Collections.StringMap.keys !loggers) ^ "}"); fail false - | Some logger -> logger#set_level EL.Debug) + | Some logger -> logger#set_level level) !activated_loggers; (* Properly register the marked ids *) diff --git a/src/extract/Extract.ml b/src/extract/Extract.ml index 7a3f1ccb5..50fd4f0fe 100644 --- a/src/extract/Extract.ml +++ b/src/extract/Extract.ml @@ -433,7 +433,7 @@ and extract_App (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) and extract_function_call (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (fid : fun_or_op_id) (generics : generic_args) (args : texpression list) : unit = - log#ldebug + log#ltrace (lazy ("extract_function_call: " ^ fun_or_op_id_to_string ctx fid @@ -2962,7 +2962,7 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter) (** Extract a trait implementation *) let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) (impl : trait_impl) : unit = - log#ldebug + log#ltrace (lazy ("extract_trait_impl: " ^ name_to_string ctx impl.item_meta.name)); (* Retrieve the impl name *) let impl_name = ctx_get_trait_impl impl.item_meta.span impl.def_id ctx in diff --git a/src/extract/ExtractBuiltin.ml b/src/extract/ExtractBuiltin.ml index 0837bfb59..75f9a7a9c 100644 --- a/src/extract/ExtractBuiltin.ml +++ b/src/extract/ExtractBuiltin.ml @@ -588,7 +588,7 @@ let mk_builtin_funs_map () = (fun (name, filter, info) -> (name, (filter, info))) (builtin_funs ())) in - log#ldebug + log#ltrace (lazy ("builtin_funs_map:\n" ^ NameMatcherMap.to_string (fun _ -> "...") m)); m @@ -872,7 +872,7 @@ let builtin_trait_impls_info () : (pattern * (bool list option * string)) list = let mk_builtin_trait_impls_map () = let m = NameMatcherMap.of_list (builtin_trait_impls_info ()) in - log#ldebug + log#ltrace (lazy ("builtin_trait_impls_map:\n" ^ NameMatcherMap.to_string (fun _ -> "...") m)); diff --git a/src/interp/Interpreter.ml b/src/interp/Interpreter.ml index a3fe42065..3139d6d6d 100644 --- a/src/interp/Interpreter.ml +++ b/src/interp/Interpreter.ml @@ -266,7 +266,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) (loop_id : LoopId.id option) (is_regular_return : bool) (inside_loop : bool) (ctx : eval_ctx) : SA.expression = let span = fdef.item_meta.span in - log#ldebug + log#ltrace (lazy ("evaluate_function_symbolic_synthesize_backward_from_return:" ^ "\n- fname: " @@ -348,7 +348,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) ctx) else ctx in - log#ldebug + log#ltrace (lazy ("evaluate_function_symbolic_synthesize_backward_from_return: (after \ putting the return value in the proper abstraction)\n" ^ "\n- ctx:\n" @@ -437,7 +437,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) if !Config.borrow_check then (Some fun_abs_id, true) else (None, false) | Some abs -> (Some abs.abs_id, false) in - log#ldebug + log#ltrace (lazy ("evaluate_function_symbolic_synthesize_backward_from_return: ending \ input abstraction: " @@ -520,7 +520,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) (Print.Contexts.decls_ctx_to_fmt_env ctx) fdef.item_meta.name in - log#ldebug (lazy ("evaluate_function_symbolic: " ^ name_to_string ())); + log#ltrace (lazy ("evaluate_function_symbolic: " ^ name_to_string ())); (* Create the evaluation context *) let ctx, input_svs, inst_sg = initialize_symbolic_context_for_fun ctx fdef in @@ -533,7 +533,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) let config = mk_config SymbolicMode in let finish (res : statement_eval_res) (ctx : eval_ctx) = let ctx0 = ctx in - log#ldebug + log#ltrace (lazy ("evaluate_function_symbolic: cf_finish: " ^ Cps.show_statement_eval_res res)); @@ -658,7 +658,7 @@ module Test = struct let span = fdef.item_meta.span in (* Debug *) - log#ldebug + log#ltrace (lazy ("test_unit_function: " ^ Print.Types.name_to_string diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 2898ae9dd..82a88deca 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -256,7 +256,7 @@ let give_back_value (config : config) (span : Meta.span) (bid : BorrowId.id) (not (bottom_in_value ctx.ended_regions nv)) span "Can not end a borrow because the value to give back contains bottom"; (* Debug *) - log#ldebug + log#ltrace (lazy ("give_back_value:\n- bid: " ^ BorrowId.to_string bid ^ "\n- value: " ^ typed_value_to_string ~span:(Some span) ctx nv @@ -465,7 +465,7 @@ 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; - log#ldebug + log#ltrace (lazy ("end_aproj_borrows:" ^ "\n- ended regions: " ^ RegionId.Set.to_string None ended_regions @@ -865,7 +865,7 @@ let convert_avalue_to_given_back_value (span : Meta.span) (av : typed_avalue) : let give_back (config : config) (span : Meta.span) (l : BorrowId.id) (bc : g_borrow_content) (ctx : eval_ctx) : eval_ctx = (* Debug *) - log#ldebug + log#ltrace (lazy (let bc = match bc with @@ -994,7 +994,7 @@ let rec end_borrow_aux (config : config) (span : Meta.span) let chain = add_borrow_or_abs_id_to_chain span "end_borrow_aux: " (BorrowId l) chain in - log#ldebug + log#ltrace (lazy ("end borrow: " ^ BorrowId.to_string l ^ ":\n- original context:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); @@ -1019,7 +1019,7 @@ let rec end_borrow_aux (config : config) (span : Meta.span) *) | Error priority -> ( (* Debug *) - log#ldebug + log#ltrace (lazy ("end borrow: " ^ BorrowId.to_string l ^ ": found outer borrows/abs or inner loans:" @@ -1061,7 +1061,7 @@ let rec end_borrow_aux (config : config) (span : Meta.span) check ctx; (ctx, end_abs)) | Ok (ctx, None) -> - log#ldebug (lazy "End borrow: borrow not found"); + log#ltrace (lazy "End borrow: borrow not found"); (* It is possible that we can't find a borrow in symbolic mode (ending * an abstraction may end several borrows at once *) sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) span; @@ -1109,7 +1109,7 @@ and end_abstraction_aux (config : config) (span : Meta.span) in (* Remember the original context for printing purposes *) let ctx0 = ctx in - log#ldebug + log#ltrace (lazy ("end_abstraction_aux: " ^ AbstractionId.to_string abs_id @@ -1122,7 +1122,7 @@ and end_abstraction_aux (config : config) (span : Meta.span) context anymore, meaning we have to simply ignore it. *) match ctx_lookup_abs_opt ctx abs_id with | None -> - log#ldebug + log#ltrace (lazy ("abs not found (already ended): " ^ AbstractionId.to_string abs_id @@ -1139,7 +1139,7 @@ and end_abstraction_aux (config : config) (span : Meta.span) (* End the parent abstractions first *) let ctx, cc = end_abstractions_aux config span chain abs.parents ctx in - log#ldebug + log#ltrace (lazy ("end_abstraction_aux: " ^ AbstractionId.to_string abs_id @@ -1150,7 +1150,7 @@ and end_abstraction_aux (config : config) (span : Meta.span) let ctx, cc = comp cc (end_abstraction_loans config span chain abs_id ctx) in - log#ldebug + log#ltrace (lazy ("end_abstraction_aux: " ^ AbstractionId.to_string abs_id @@ -1180,7 +1180,7 @@ and end_abstraction_aux (config : config) (span : Meta.span) in (* Debugging *) - log#ldebug + log#ltrace (lazy ("end_abstraction_aux: " ^ AbstractionId.to_string abs_id @@ -1212,7 +1212,7 @@ 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 + log#ltrace (lazy ("end_abstraction_loans:" ^ "\n- abs_id: " ^ AbstractionId.to_string abs_id @@ -1250,7 +1250,7 @@ and end_abstraction_loans (config : config) (span : Meta.span) and end_abstraction_borrows (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_id : AbstractionId.id) : cm_fun = fun ctx -> - log#ldebug + log#ltrace (lazy ("end_abstraction_borrows: abs_id: " ^ AbstractionId.to_string abs_id)); (* Note that the abstraction mustn't contain any loans *) @@ -1326,7 +1326,7 @@ and end_abstraction_borrows (config : config) (span : Meta.span) with (* There are concrete (i.e., not symbolic) borrows: end them, then re-explore *) | FoundABorrowContent bc -> - log#ldebug + log#ltrace (lazy ("end_abstraction_borrows: found aborrow content: " ^ aborrow_content_to_string ~span:(Some span) ctx bc)); @@ -1383,7 +1383,7 @@ and end_abstraction_borrows (config : config) (span : Meta.span) end_abstraction_borrows config span chain abs_id ctx (* There are symbolic borrows: end them, then reexplore *) | FoundAProjBorrows (sv, proj_ty, given_back) -> - log#ldebug + log#ltrace (lazy ("end_abstraction_borrows: found aproj borrows: " ^ aproj_to_string ctx (AProjBorrows (sv, proj_ty, given_back)))); @@ -1400,7 +1400,7 @@ and end_abstraction_borrows (config : config) (span : Meta.span) end_abstraction_borrows config span chain abs_id ctx (* There are concrete (i.e., not symbolic) borrows in shared values: end them, then reexplore *) | FoundBorrowContent bc -> - log#ldebug + log#ltrace (lazy ("end_abstraction_borrows: found borrow content: " ^ borrow_content_to_string ~span:(Some span) ctx bc)); @@ -1461,7 +1461,7 @@ 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 + log#ltrace (lazy ("end_proj_loans_symbolic:" ^ "\n- abs_id: " ^ AbstractionId.to_string abs_id @@ -1633,7 +1633,7 @@ let end_abstractions_no_synth config span ids ctx = let promote_shared_loan_to_mut_loan (span : Meta.span) (l : BorrowId.id) (ctx : eval_ctx) : typed_value * eval_ctx = (* Debug *) - log#ldebug + log#ltrace (lazy ("promote_shared_loan_to_mut_loan:\n- loan: " ^ BorrowId.to_string l ^ "\n- context:\n" @@ -1729,7 +1729,7 @@ let rec promote_reserved_mut_borrow (config : config) (span : Meta.span) | None -> (* No loan to end inside the value *) (* Some sanity checks *) - log#ldebug + log#ltrace (lazy ("activate_reserved_mut_borrow: resulting value:\n" ^ typed_value_to_string ~span:(Some span) ctx sv)); @@ -2024,7 +2024,7 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (group : bool) (r_id : RegionId.id) (v : typed_value) : typed_avalue list * typed_value = (* Debug *) - log#ldebug + log#ltrace (lazy ("convert_value_to_abstractions: to_avalues:\n- value: " ^ typed_value_to_string ~span:(Some span) ctx v)); @@ -2571,7 +2571,7 @@ let abs_split_markers (span : Meta.span) (ctx : eval_ctx) (abs : abs) : abs = let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) (merge_funs : merge_duplicates_funcs option) (ctx : eval_ctx) (abs0 : abs) (abs1 : abs) : typed_avalue list = - log#ldebug (lazy "merge_abstractions_merge_loan_borrow_pairs"); + log#ltrace (lazy "merge_abstractions_merge_loan_borrow_pairs"); (* Split the markers inside the abstractions (if we allow using markers). @@ -2681,14 +2681,14 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) let borrow_avalues = ref [] in let loan_avalues = ref [] in let push_borrow_avalue av = - log#ldebug + log#ltrace (lazy ("merge_abstractions_merge_loan_borrow_pairs: push_borrow_avalue: " ^ typed_avalue_to_string ~span:(Some span) ctx av)); borrow_avalues := av :: !borrow_avalues in let push_loan_avalue av = - log#ldebug + log#ltrace (lazy ("merge_abstractions_merge_loan_borrow_pairs: push_loan_avalue: " ^ typed_avalue_to_string ~span:(Some span) ctx av)); @@ -2777,7 +2777,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) List.iter (function | Borrow marked -> - log#ldebug + log#ltrace (lazy ("merge_abstractions: merging borrow " ^ Marked.to_string marked)); @@ -2820,7 +2820,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) then () else ( (* Do not set the loans as merged yet *) - log#ldebug + log#ltrace (lazy ("merge_abstractions: merging loan " ^ Marked.to_string marked)); @@ -2958,7 +2958,7 @@ let merge_abstractions_merge_markers (span : Meta.span) (merge_funs : merge_duplicates_funcs option) (ctx : eval_ctx) (owned_regions : RegionId.Set.t) (avalues : typed_avalue list) : typed_avalue list = - log#ldebug + log#ltrace (lazy ("merge_abstractions_merge_markers:\n- avalues:\n" ^ String.concat ", " (List.map (typed_avalue_to_string ctx) avalues))); @@ -2984,7 +2984,7 @@ let merge_abstractions_merge_markers (span : Meta.span) (* Utilities to accumulate the list of values resulting from the merge *) let avalues = ref [] in let push_avalue av = - log#ldebug + log#ltrace (lazy ("merge_abstractions_merge_markers: push_avalue: " ^ typed_avalue_to_string ~span:(Some span) ctx av)); @@ -3415,7 +3415,7 @@ let merge_abstractions_merge_markers (span : Meta.span) let merge_abstractions (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) (merge_funs : merge_duplicates_funcs option) (ctx : eval_ctx) (abs0 : abs) (abs1 : abs) : abs = - log#ldebug + log#ltrace (lazy ("merge_abstractions:\n- abs0:\n" ^ abs_to_string span ctx abs0 diff --git a/src/interp/InterpreterExpansion.ml b/src/interp/InterpreterExpansion.ml index ecafa834a..145832ecb 100644 --- a/src/interp/InterpreterExpansion.ml +++ b/src/interp/InterpreterExpansion.ml @@ -487,7 +487,7 @@ let expand_symbolic_value_no_branching (config : config) (span : Meta.span) (sv : symbolic_value) (sv_place : SA.mplace option) : cm_fun = fun ctx -> (* Debug *) - log#ldebug + log#ltrace (lazy ("expand_symbolic_value_no_branching: " ^ symbolic_value_to_string ctx sv)); (* Remember the initial context for printing purposes *) @@ -528,7 +528,7 @@ let expand_symbolic_value_no_branching (config : config) (span : Meta.span) ^ show_rty rty) in (* Debug *) - log#ldebug + log#ltrace (lazy ("expand_symbolic_value_no_branching: " ^ symbolic_value_to_string ctx0 sv @@ -549,7 +549,7 @@ let expand_symbolic_adt (config : config) (span : Meta.span) eval_ctx -> eval_ctx list * (SA.expression list -> SA.expression) = fun ctx -> (* Debug *) - log#ldebug (lazy ("expand_symbolic_adt:" ^ symbolic_value_to_string ctx sv)); + log#ltrace (lazy ("expand_symbolic_adt:" ^ symbolic_value_to_string ctx sv)); (* Compute the expanded value - note that when doing so, we may introduce * fresh symbolic values in the context (which thus gets updated) *) let original_sv = sv in @@ -639,13 +639,13 @@ let greedy_expand_symbolics_with_borrows (config : config) (span : Meta.span) : (* We reverse the environment before exploring it - this way the values get expanded in a more "logical" order (this is only for convenience) *) obj#visit_env () (List.rev ctx.env); - log#ldebug + log#ltrace (lazy "greedy_expand_symbolics_with_borrows: no value to expand\n"); (* Nothing to expand: continue *) (ctx, fun e -> e) with FoundSymbolicValue sv -> (* Expand and recheck the environment *) - log#ldebug + log#ltrace (lazy ("greedy_expand_symbolics_with_borrows: about to expand: " ^ symbolic_value_to_string ctx sv)); @@ -694,7 +694,7 @@ let greedy_expand_symbolics_with_borrows (config : config) (span : Meta.span) : | TDynTrait _ -> craise __FILE__ __LINE__ span "Unreachable" in (* *) - log#ldebug + log#ltrace (lazy ("\ngreedy_expand_symbolics_with_borrows: after expansion:\n" ^ eval_ctx_to_string ~span:(Some span) ctx @@ -709,6 +709,6 @@ let greedy_expand_symbolic_values (config : config) (span : Meta.span) : cm_fun = fun ctx -> if Config.greedy_expand_symbolics_with_borrows then ( - log#ldebug (lazy "greedy_expand_symbolic_values"); + log#ltrace (lazy "greedy_expand_symbolic_values"); greedy_expand_symbolics_with_borrows config span ctx) else (ctx, fun e -> e) diff --git a/src/interp/InterpreterExpressions.ml b/src/interp/InterpreterExpressions.ml index db1f3c04f..9be0e1976 100644 --- a/src/interp/InterpreterExpressions.ml +++ b/src/interp/InterpreterExpressions.ml @@ -99,7 +99,7 @@ let literal_to_typed_value (span : Meta.span) (ty : literal_type) (cv : literal) : typed_value = (* Check the type while converting - we actually need some information * contained in the type *) - log#ldebug + log#ltrace (lazy ("literal_to_typed_value:" ^ "\n- cv: " ^ Print.Values.literal_to_string cv)); @@ -128,7 +128,7 @@ let literal_to_typed_value (span : Meta.span) (ty : literal_type) (cv : literal) *) let rec copy_value (span : Meta.span) (allow_adt_copy : bool) (config : config) (ctx : eval_ctx) (v : typed_value) : eval_ctx * typed_value = - log#ldebug + log#ltrace (lazy ("copy_value: " ^ typed_value_to_string ~span:(Some span) ctx v @@ -268,7 +268,7 @@ let eval_operand_no_reorganize (config : config) (span : Meta.span) typed_value * eval_ctx * (SymbolicAst.expression -> SymbolicAst.expression) = (* Debug *) - log#ldebug + log#ltrace (lazy ("eval_operand_no_reorganize: op: " ^ operand_to_string ctx op ^ "\n- ctx:\n" @@ -379,7 +379,7 @@ let eval_operand (config : config) (span : Meta.span) (op : operand) typed_value * eval_ctx * (SymbolicAst.expression -> SymbolicAst.expression) = (* Debug *) - log#ldebug + log#ltrace (lazy ("eval_operand: op: " ^ operand_to_string ctx op ^ "\n- ctx:\n" ^ eval_ctx_to_string ~span:(Some span) ctx @@ -876,7 +876,7 @@ let eval_rvalue_not_global (config : config) (span : Meta.span) (typed_value, eval_error) result * eval_ctx * (SymbolicAst.expression -> SymbolicAst.expression) = - log#ldebug (lazy "eval_rvalue"); + log#ltrace (lazy "eval_rvalue"); (* Small helper *) let wrap_in_result (v, ctx, cc) = (Ok v, ctx, cc) in (* Delegate to the proper auxiliary function *) diff --git a/src/interp/InterpreterLoops.ml b/src/interp/InterpreterLoops.ml index b7a723b3c..649f7a786 100644 --- a/src/interp/InterpreterLoops.ml +++ b/src/interp/InterpreterLoops.ml @@ -28,7 +28,7 @@ let eval_loop_concrete (span : Meta.span) (eval_loop_body : stl_cm_fun) : new context (and repeat this an indefinite number of times). *) let rec rec_eval_loop_body (ctx : eval_ctx) (res : statement_eval_res) = - log#ldebug (lazy "eval_loop_concrete: reeval_loop_body"); + log#ltrace (lazy "eval_loop_concrete: reeval_loop_body"); match res with | Return -> [ (ctx, LoopReturn loop_id) ] | Panic -> [ (ctx, Panic) ] @@ -95,7 +95,7 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) (* First, preemptively end borrows/move values by matching the current context with the target context *) let ctx, cf_prepare = - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic_synthesize_fun_end: about to reorganize the \ original context to match the fixed-point ctx with it:\n\ @@ -107,7 +107,7 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) in (* Actually match *) - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic_synthesize_fun_end: about to compute the id \ correspondance between the fixed-point ctx and the original ctx:\n\ @@ -118,7 +118,7 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) let fp_bl_corresp = compute_fixed_point_id_correspondance span fixed_ids ctx fp_ctx in - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic_synthesize_fun_end: about to match the fixed-point \ context with the original context:\n\ @@ -145,7 +145,7 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) inside the region abstractions. *) let check_abs (abs_id : AbstractionId.id) = let abs = ctx_lookup_abs fp_ctx abs_id in - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic_synthesize_fun_end: checking abs:\n" ^ abs_to_string span ctx abs ^ "\n")); @@ -262,7 +262,7 @@ let eval_loop_symbolic_synthesize_loop_body (config : config) (span : span) For now, we forbid having breaks in loops (and eliminate breaks in the prepasses) *) let eval_after_loop_iter (ctx, res) = - log#ldebug (lazy "eval_loop_symbolic: eval_after_loop_iter"); + log#ltrace (lazy "eval_loop_symbolic: eval_after_loop_iter"); match res with | Return -> (* We replace the [Return] with a [LoopReturn] *) @@ -275,7 +275,7 @@ let eval_loop_symbolic_synthesize_loop_body (config : config) (span : span) (* We don't support nested loops for now *) cassert __FILE__ __LINE__ (i = 0) span "Nested loops are not supported yet"; - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic: about to match the fixed-point context with \ the context at a continue:\n\ @@ -306,7 +306,7 @@ let eval_loop_symbolic (config : config) (span : span) (eval_loop_body : stl_cm_fun) : stl_cm_fun = fun ctx -> (* Debug *) - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic:\nContext:\n" ^ eval_ctx_to_string ~span:(Some span) ctx @@ -321,7 +321,7 @@ let eval_loop_symbolic (config : config) (span : span) in (* Debug *) - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic:\nInitial context:\n" ^ eval_ctx_to_string ~span:(Some span) ctx @@ -346,7 +346,7 @@ let eval_loop_symbolic (config : config) (span : span) fp_ctx fp_input_svalues rg_to_abs in - log#ldebug + log#ltrace (lazy "eval_loop_symbolic: matched the fixed-point context with the original \ context."); @@ -357,7 +357,7 @@ let eval_loop_symbolic (config : config) (span : span) fixed_ids fp_ctx fp_input_svalues fp_bl_corresp in - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic: result:" ^ "\n- src context:\n" ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx @@ -385,7 +385,7 @@ let eval_loop_symbolic (config : config) (span : span) let rg_to_given_back = let compute_abs_given_back_tys (abs_id : AbstractionId.id) : Pure.ty list = let abs = ctx_lookup_abs fp_ctx abs_id in - log#ldebug + log#ltrace (lazy ("eval_loop_symbolic: compute_abs_given_back_tys:\n- abs:\n" ^ abs_to_string span ~with_ended:true ctx abs diff --git a/src/interp/InterpreterLoopsFixedPoint.ml b/src/interp/InterpreterLoopsFixedPoint.ml index 7f3a5328b..6f98970ea 100644 --- a/src/interp/InterpreterLoopsFixedPoint.ml +++ b/src/interp/InterpreterLoopsFixedPoint.ml @@ -397,7 +397,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) let ctx = prepare_ashared_loans_no_synth span loop_id ctx0 in (* Debug *) - log#ldebug + log#ltrace (lazy ("compute_loop_entry_fixed_point: after prepare_ashared_loans:" ^ "\n\n- ctx0:\n" @@ -416,7 +416,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) context (the context at the loop entry, after we called {!prepare_ashared_loans}, if this is the first iteration) *) let join_ctxs (ctx1 : eval_ctx) (ctxs : eval_ctx list) : eval_ctx = - log#ldebug (lazy "compute_loop_entry_fixed_point: join_ctxs"); + log#ltrace (lazy "compute_loop_entry_fixed_point: join_ctxs"); (* If this is the first iteration, end the borrows/loans/abs which appear in ctx1 and not in the other contexts, then compute the set of fixed ids. This means those borrows/loans have to end @@ -443,7 +443,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) ctx in (* End the borrows/abs in [ctx1] *) - log#ldebug + log#ltrace (lazy ("compute_loop_entry_fixed_point: join_ctxs: ending \ borrows/abstractions before entering the loop:\n\ @@ -474,7 +474,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) in ctx2 in - log#ldebug (lazy "compute_loop_entry_fixed_point: after join_ctxs"); + log#ltrace (lazy "compute_loop_entry_fixed_point: after join_ctxs"); (* Compute the set of fixed ids - for the symbolic ids, we compute the intersection of ids between the original environment and the list @@ -496,7 +496,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) existentially quantified borrows/abstractions/symbolic values. *) let equiv_ctxs (ctx1 : eval_ctx) (ctx2 : eval_ctx) : bool = - log#ldebug (lazy "compute_fixed_point: equiv_ctx:"); + log#ltrace (lazy "compute_fixed_point: equiv_ctx:"); let fixed_ids = compute_fixed_ids [ ctx1; ctx2 ] in let check_equivalent = true in let lookup_shared_value _ = craise __FILE__ __LINE__ span "Unreachable" in @@ -515,7 +515,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) let ctx_resl, _ = eval_loop_body ctx in (* Keep only the contexts which reached a `continue`. *) let keep_continue_ctx (ctx, res) = - log#ldebug + log#ltrace (lazy "compute_loop_entry_fixed_point: register_continue_ctx"); match res with | Return | Panic | Break _ -> None @@ -534,7 +534,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) in let continue_ctxs = List.filter_map keep_continue_ctx ctx_resl in - log#ldebug + log#ltrace (lazy ("compute_fixed_point: about to join with continue_ctx" ^ "\n\n- ctx0:\n" @@ -553,7 +553,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) let ctx1 = join_ctxs ctx continue_ctxs in (* Debug *) - log#ldebug + log#ltrace (lazy ("compute_fixed_point: after joining continue ctxs" ^ "\n\n- ctx0:\n" ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx @@ -567,7 +567,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) let fp = compute_fixed_point ctx max_num_iter max_num_iter in (* Debug *) - log#ldebug + log#ltrace (lazy ("compute_fixed_point: fixed point computed before matching with input \ region groups:" ^ "\n\n- fp:\n" @@ -621,7 +621,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) fp_ended_aids := RegionGroupId.Map.add rg_id aids !fp_ended_aids in let end_at_return (ctx, res) = - log#ldebug (lazy "compute_loop_entry_fixed_point: cf_loop"); + log#ltrace (lazy "compute_loop_entry_fixed_point: cf_loop"); match res with | Continue _ | Panic -> () | Break _ -> @@ -633,7 +633,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) *) craise __FILE__ __LINE__ span "Unreachable" | Return -> - log#ldebug (lazy "compute_loop_entry_fixed_point: cf_loop: Return"); + log#ltrace (lazy "compute_loop_entry_fixed_point: cf_loop: Return"); (* Should we consume the return value and pop the frame? * If we check in [Interpreter] that the loop abstraction we end is * indeed the correct one, I think it is sound to under-approximate here @@ -678,7 +678,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) aids_union := AbstractionId.Set.union ids !aids_union) !fp_ended_aids in - log#ldebug + log#ltrace (lazy ("- aids_union: " ^ AbstractionId.Set.to_string None !aids_union @@ -734,7 +734,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) } ]} *) - log#ldebug + log#ltrace (lazy ("No loop region to end for the region group " ^ RegionGroupId.to_string rg_id)); @@ -753,7 +753,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) List.iter (fun id -> try - log#ldebug + log#ltrace (lazy ("compute_loop_entry_fixed_point: merge FP \ abstraction: " ^ AbstractionId.to_string id ^ " into " @@ -824,7 +824,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) while allowing exactly one iteration to see if it fails *) let _ = let fp_test = update_kinds_can_end true fp in - log#ldebug + log#ltrace (lazy ("compute_fixed_point: fixed point after matching with the function \ region groups:\n" @@ -843,7 +843,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) let compute_fixed_point_id_correspondance (span : Meta.span) (fixed_ids : ids_sets) (src_ctx : eval_ctx) (tgt_ctx : eval_ctx) : borrow_loan_corresp = - log#ldebug + log#ltrace (lazy ("compute_fixed_point_id_correspondance:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- src_ctx:\n" @@ -857,7 +857,7 @@ let compute_fixed_point_id_correspondance (span : Meta.span) let filt_tgt_env, new_absl, _ = ctx_split_fixed_new span fixed_ids tgt_ctx in let filt_tgt_ctx = { tgt_ctx with env = filt_tgt_env } in - log#ldebug + log#ltrace (lazy ("compute_fixed_point_id_correspondance:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- filt_src_ctx:\n" @@ -886,7 +886,7 @@ let compute_fixed_point_id_correspondance (span : Meta.span) filt_tgt_ctx filt_src_ctx) in - log#ldebug + log#ltrace (lazy ("compute_fixed_point_id_correspondance:\n\n- tgt_to_src_maps:\n" ^ ids_maps_to_string src_ctx maps @@ -1088,7 +1088,7 @@ let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) (* Also remove the symbolic values which appear inside of projectors in fixed abstractions - those are "fixed" and not modified between iterations of the loop, *) - log#ldebug + log#ltrace (lazy ("compute_fp_ctx_symbolic_values:" ^ "\n- sids_in_fixed_abs:" ^ SymbolicValueId.Set.show sids_in_fixed_abs @@ -1143,7 +1143,7 @@ let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) (List.rev !ordered_sids) in - log#ldebug + log#ltrace (lazy ("compute_fp_ctx_symbolic_values:" ^ "\n- src context:\n" ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx diff --git a/src/interp/InterpreterLoopsJoinCtxs.ml b/src/interp/InterpreterLoopsJoinCtxs.ml index eee4f049d..5b52d5a53 100644 --- a/src/interp/InterpreterLoopsJoinCtxs.ml +++ b/src/interp/InterpreterLoopsJoinCtxs.ml @@ -278,7 +278,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets) (ctx0 : eval_ctx) : eval_ctx = (* Debug *) - log#ldebug + log#ltrace (lazy ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx0:\n" ^ eval_ctx_to_string ~span:(Some span) ctx0 @@ -314,14 +314,14 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) ctx0.env) in let ctx = { ctx0 with env } in - log#ldebug + log#ltrace (lazy ("reduce_ctx: after converting values to abstractions:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); - log#ldebug + log#ltrace (lazy ("reduce_ctx: after decomposing the shared values in the abstractions:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx:\n" @@ -382,7 +382,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) match AbstractionId.Set.elements abs_ids1 with | [] -> None | abs_id1 :: _ -> - log#ldebug + log#ltrace (lazy ("reduce_ctx: merging abstraction " ^ AbstractionId.to_string abs_id1 @@ -420,7 +420,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) let ctx = IterMergeSymbolic.iter_merge ctx in (* Debugging *) - log#ldebug + log#ltrace (lazy ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after reduce:\n" @@ -431,7 +431,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) all the markers at this point. *) let ctx = reorder_fresh_abs span true old_ids.aids ctx in - log#ldebug + log#ltrace (lazy ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after reduce and reorder borrows/loans and abstractions:\n" @@ -466,7 +466,7 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx : eval_ctx) : eval_ctx = (* Debug *) - log#ldebug + log#ltrace (lazy ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- initial ctx:\n" @@ -630,7 +630,7 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) let ctx = IterMergeConcrete.iter_merge ctx in let ctx = IterMergeSymbolic.iter_merge ctx in - log#ldebug + log#ltrace (lazy ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after collapse:\n" @@ -641,7 +641,7 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) all the markers yet *) let ctx = reorder_fresh_abs span true old_ids.aids ctx in - log#ldebug + log#ltrace (lazy ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after collapse and reorder borrows/loans:\n" @@ -871,7 +871,7 @@ let collapse_ctx_with_merge (span : Meta.span) (loop_id : LoopId.id) let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : ctx_or_update = (* Debug *) - log#ldebug + log#ltrace (lazy ("join_ctxs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" @@ -887,7 +887,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (* Explore the environments. *) let join_suffixes (env0 : env) (env1 : env) : env = (* Debug *) - log#ldebug + log#ltrace (lazy ("join_suffixes:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" @@ -948,7 +948,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) | ( (EBinding (BDummy b0, v0) as var0) :: env0', (EBinding (BDummy b1, v1) as var1) :: env1' ) -> (* Debug *) - log#ldebug + log#ltrace (lazy ("join_prefixes: BDummys:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- value0:\n" @@ -973,7 +973,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) | ( (EBinding (BVar b0, v0) as var0) :: env0', (EBinding (BVar b1, v1) as var1) :: env1' ) -> (* Debug *) - log#ldebug + log#ltrace (lazy ("join_prefixes: BVars:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- value0:\n" @@ -993,7 +993,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) var :: join_prefixes env0' env1' | (EAbs abs0 as abs) :: env0', EAbs abs1 :: env1' -> (* Debug *) - log#ldebug + log#ltrace (lazy ("join_prefixes: Abs:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- abs0:\n" @@ -1023,7 +1023,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) | _ -> craise __FILE__ __LINE__ span "Unreachable" in - log#ldebug + log#ltrace (lazy ("- env0:\n" ^ show_env env0 ^ "\n\n- env1:\n" ^ show_env env1 ^ "\n\n")); @@ -1161,14 +1161,14 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) join_one_aux ctx in let join_one (ctx : eval_ctx) : eval_ctx = - log#ldebug + log#ltrace (lazy ("loop_join_origin_with_continue_ctxs:join_one: initial ctx:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Destructure the abstractions introduced in the new context *) let ctx = destructure_new_abs span loop_id fixed_ids.aids ctx in - log#ldebug + log#ltrace (lazy ("loop_join_origin_with_continue_ctxs:join_one: after destructure:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); @@ -1177,7 +1177,7 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) (* Reduce the context we want to add to the join *) let ctx = reduce_ctx span loop_id fixed_ids ctx in - log#ldebug + log#ltrace (lazy ("loop_join_origin_with_continue_ctxs:join_one: after reduce:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); @@ -1191,14 +1191,14 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) (* Join the two contexts *) let ctx1 = join_one_aux ctx in - log#ldebug + log#ltrace (lazy ("loop_join_origin_with_continue_ctxs:join_one: after join:\n" ^ eval_ctx_to_string ~span:(Some span) ctx1)); (* Collapse to eliminate the markers *) joined_ctx := collapse_ctx_with_merge span loop_id fixed_ids !joined_ctx; - log#ldebug + log#ltrace (lazy ("loop_join_origin_with_continue_ctxs:join_one: after join-collapse:\n" ^ eval_ctx_to_string ~span:(Some span) !joined_ctx)); @@ -1207,7 +1207,7 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) (* Reduce again to reach a fixed point *) joined_ctx := reduce_ctx span loop_id fixed_ids !joined_ctx; - log#ldebug + log#ltrace (lazy ("loop_join_origin_with_continue_ctxs:join_one: after last reduce:\n" ^ eval_ctx_to_string ~span:(Some span) !joined_ctx)); diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index f2130975e..165e12864 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -361,17 +361,17 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct | VBottom, _ -> M.match_bottom_with_other ctx0 ctx1 true v1 | _, VBottom -> M.match_bottom_with_other ctx0 ctx1 false v0 | _ -> - log#ldebug + log#ltrace (lazy ("Unexpected match case:\n- value0: " ^ typed_value_to_string ~span:(Some M.span) ctx0 v0 ^ "\n- value1: " ^ typed_value_to_string ~span:(Some M.span) ctx1 v1)); - craise __FILE__ __LINE__ M.span "Unexpected match case" + internal_error __FILE__ __LINE__ M.span and match_typed_avalues (ctx0 : eval_ctx) (ctx1 : eval_ctx) (v0 : typed_avalue) (v1 : typed_avalue) : typed_avalue = - log#ldebug + log#ltrace (lazy ("match_typed_avalues:\n- value0: " ^ typed_avalue_to_string ~span:(Some M.span) ctx0 v0 @@ -405,18 +405,18 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct | ABottom, ABottom -> mk_abottom M.span ty | AIgnored _, AIgnored _ -> mk_aignored M.span ty None | ABorrow bc0, ABorrow bc1 -> ( - log#ldebug (lazy "match_typed_avalues: borrows"); + log#ltrace (lazy "match_typed_avalues: borrows"); match (bc0, bc1) with | ASharedBorrow (pm0, bid0), ASharedBorrow (pm1, bid1) -> - log#ldebug (lazy "match_typed_avalues: shared borrows"); + log#ltrace (lazy "match_typed_avalues: shared borrows"); M.match_ashared_borrows ctx0 ctx1 v0.ty pm0 bid0 v1.ty pm1 bid1 ty | AMutBorrow (pm0, bid0, av0), AMutBorrow (pm1, bid1, av1) -> - log#ldebug (lazy "match_typed_avalues: mut borrows"); - log#ldebug + log#ltrace (lazy "match_typed_avalues: mut borrows"); + log#ltrace (lazy "match_typed_avalues: mut borrows: matching children values"); let av = match_arec av0 av1 in - log#ldebug + log#ltrace (lazy "match_typed_avalues: mut borrows: matched children values"); M.match_amut_borrows ctx0 ctx1 v0.ty pm0 bid0 av0 v1.ty pm1 bid1 av1 ty av @@ -444,13 +444,13 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct *) craise __FILE__ __LINE__ M.span "Unexpected") | ALoan lc0, ALoan lc1 -> ( - log#ldebug (lazy "match_typed_avalues: loans"); + log#ltrace (lazy "match_typed_avalues: loans"); (* TODO: maybe we should enforce that the ids are always exactly the same - without matching *) match (lc0, lc1) with | ASharedLoan (pm0, ids0, sv0, av0), ASharedLoan (pm1, ids1, sv1, av1) -> - log#ldebug (lazy "match_typed_avalues: shared loans"); + log#ltrace (lazy "match_typed_avalues: shared loans"); let sv = match_rec sv0 sv1 in let av = match_arec av0 av1 in sanity_check __FILE__ __LINE__ @@ -459,11 +459,11 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct M.match_ashared_loans ctx0 ctx1 v0.ty pm0 ids0 sv0 av0 v1.ty pm1 ids1 sv1 av1 ty sv av | AMutLoan (pm0, id0, av0), AMutLoan (pm1, id1, av1) -> - log#ldebug (lazy "match_typed_avalues: mut loans"); - log#ldebug + log#ltrace (lazy "match_typed_avalues: mut loans"); + log#ltrace (lazy "match_typed_avalues: mut loans: matching children values"); let av = match_arec av0 av1 in - log#ldebug + log#ltrace (lazy "match_typed_avalues: mut loans: matched children values"); M.match_amut_loans ctx0 ctx1 v0.ty pm0 id0 av0 v1.ty pm1 id1 av1 ty av @@ -1255,7 +1255,7 @@ struct let match_shared_borrows (ctx0 : eval_ctx) (ctx1 : eval_ctx) (match_typed_values : typed_value -> typed_value -> typed_value) (_ty : ety) (bid0 : borrow_id) (bid1 : borrow_id) : borrow_id = - log#ldebug + log#ltrace (lazy ("MakeCheckEquivMatcher: match_shared_borrows: " ^ "bid0: " ^ BorrowId.to_string bid0 ^ ", bid1: " ^ BorrowId.to_string bid1)); @@ -1269,7 +1269,7 @@ struct else let v0 = S.lookup_shared_value_in_ctx0 bid0 in let v1 = S.lookup_shared_value_in_ctx1 bid1 in - log#ldebug + log#ltrace (lazy ("MakeCheckEquivMatcher: match_shared_borrows: looked up values:" ^ "sv0: " @@ -1303,7 +1303,7 @@ struct let id0 = sv0.sv_id in let id1 = sv1.sv_id in - log#ldebug + log#ltrace (lazy ("MakeCheckEquivMatcher: match_symbolic_values: " ^ "sv0: " ^ SymbolicValueId.to_string id0 @@ -1406,7 +1406,7 @@ struct (* We are checking whether that two environments are equivalent: there shouldn't be any projection markers *) sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span; - log#ldebug + log#ltrace (lazy ("MakeCheckEquivMatcher:match_amut_loans:" ^ "\n- id0: " ^ BorrowId.to_string id0 ^ "\n- id1: " ^ BorrowId.to_string id1 @@ -1432,7 +1432,7 @@ struct { value = ASymbolic (PNone, AProjLoans (sv, proj_ty, [])); ty } let match_avalues (ctx0 : eval_ctx) (ctx1 : eval_ctx) v0 v1 = - log#ldebug + log#ltrace (lazy ("avalues don't match:\n- v0: " ^ typed_avalue_to_string ~span:(Some span) ctx0 v0 @@ -1445,7 +1445,7 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (lookup_shared_value_in_ctx0 : BorrowId.id -> typed_value) (lookup_shared_value_in_ctx1 : BorrowId.id -> typed_value) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : ids_maps option = - log#ldebug + log#ltrace (lazy ("match_ctxs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" @@ -1555,7 +1555,7 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) let _ = CEM.match_rids regions0 regions1 in let _ = CEM.match_rids ancestors_regions0 ancestors_regions1 in - log#ldebug (lazy "match_abstractions: matching values"); + log#ltrace (lazy "match_abstractions: matching values"); let _ = if List.length avalues0 <> List.length avalues1 then raise @@ -1565,13 +1565,13 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (fun (v0, v1) -> M.match_typed_avalues ctx0 ctx1 v0 v1) (List.combine avalues0 avalues1) in - log#ldebug (lazy "match_abstractions: values matched OK"); + log#ltrace (lazy "match_abstractions: values matched OK"); () in (* Rem.: this function raises exceptions of type [Distinct] *) let rec match_envs (env0 : env) (env1 : env) : unit = - log#ldebug + log#ltrace (lazy ("match_ctxs: match_envs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- rid_map: " @@ -1614,10 +1614,10 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (* Continue *) match_envs env0' env1' | EAbs abs0 :: env0', EAbs abs1 :: env1' -> - log#ldebug (lazy "match_ctxs: match_envs: matching abs"); + log#ltrace (lazy "match_ctxs: match_envs: matching abs"); (* Same as for the dummy values: there are two cases *) if AbstractionId.Set.mem abs0.abs_id fixed_ids.aids then ( - log#ldebug (lazy "match_ctxs: match_envs: matching abs: fixed abs"); + log#ltrace (lazy "match_ctxs: match_envs: matching abs: fixed abs"); (* Still in the prefix: the abstractions must be the same *) sanity_check __FILE__ __LINE__ (abs0 = abs1) span; (* Their ids must be fixed *) @@ -1628,7 +1628,7 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (* Continue *) match_envs env0' env1') else ( - log#ldebug + log#ltrace (lazy "match_ctxs: match_envs: matching abs: not fixed abs"); (* Match the values *) match_abstractions abs0 abs1; @@ -1670,10 +1670,10 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) Some maps with | Distinct msg -> - log#ldebug (lazy ("match_ctxs: distinct: " ^ msg ^ "\n")); + log#ltrace (lazy ("match_ctxs: distinct: " ^ msg ^ "\n")); None | ValueMatchFailure k -> - log#ldebug + log#ltrace (lazy ("match_ctxs: distinct: ValueMatchFailure" ^ show_updt_env_kind k ^ "\n")); @@ -1691,7 +1691,7 @@ let prepare_match_ctx_with_target (config : config) (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (src_ctx : eval_ctx) : cm_fun = fun tgt_ctx -> (* Debug *) - log#ldebug + log#ltrace (lazy ("prepare_match_ctx_with_target:\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " @@ -1706,7 +1706,7 @@ let prepare_match_ctx_with_target (config : config) (span : Meta.span) let filt_src_env, _, _ = ctx_split_fixed_new span fixed_ids src_ctx in let filt_tgt_env, _, _ = ctx_split_fixed_new span fixed_ids tgt_ctx in - log#ldebug + log#ltrace (lazy ("prepare_match_ctx_with_target: reorganize_join_tgt:\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" @@ -1751,7 +1751,7 @@ let prepare_match_ctx_with_target (config : config) (span : Meta.span) (List.combine filt_src_env filt_tgt_env) in (* No exception was thrown: continue *) - log#ldebug + log#ltrace (lazy ("prepare_match_ctx_with_target: reorganize_join_tgt: done with \ borrows/loans:\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids @@ -1809,7 +1809,7 @@ let prepare_match_ctx_with_target (config : config) (span : Meta.span) ctx_push_fresh_dummy_vars tgt_ctx (List.rev !nvalues) in - log#ldebug + log#ltrace (lazy ("prepare_match_ctx_with_target: reorganize_join_tgt: done with \ borrows/loans and moves:\n" ^ "\n- fixed_ids: " @@ -1842,7 +1842,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) (src_ctx : eval_ctx) : st_cm_fun = fun tgt_ctx -> (* Debug *) - log#ldebug + log#ltrace (lazy ("match_ctx_with_target:\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx: " @@ -1875,7 +1875,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) [add_identity_abs] to add the identity abstractions one by one. *) (* Match the source and target contexts *) - log#ldebug + log#ltrace (lazy ("mach_ctx_with_target: about to introduce the identity abstractions (i):\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " @@ -1926,7 +1926,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) in (* Debug *) - log#ldebug + log#ltrace (lazy ("match_ctx_with_target: about to introduce the identity abstractions \ (ii):" ^ "\n\n- src_ctx: " @@ -2061,7 +2061,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) let tgt_ctx = visit_tgt#visit_eval_ctx () tgt_ctx in - log#ldebug + log#ltrace (lazy ("match_ctx_with_target: cf_introduce_loop_fp_abs:" ^ "\n- src_fresh_borrows_map:\n" @@ -2128,7 +2128,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) inherit [_] map_eval_ctx as super method! visit_borrow_id _ bid = - log#ldebug + log#ltrace (lazy ("match_ctx_with_target: cf_introduce_loop_fp_abs: \ visit_borrow_id: " ^ BorrowId.to_string bid ^ "\n")); @@ -2138,7 +2138,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) BorrowId.InjSubst.find bid fp_bl_maps.borrow_to_loan_id_map in - log#ldebug + log#ltrace (lazy ("match_ctx_with_target: cf_introduce_loop_fp_abs: looked up \ src_lid: " ^ BorrowId.to_string src_lid ^ "\n")); @@ -2148,7 +2148,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) BorrowId.InjSubst.find src_lid src_to_tgt_maps.borrow_id_map in - log#ldebug + log#ltrace (lazy ("match_ctx_with_target: cf_introduce_loop_fp_abs: looked up \ tgt_bid: " ^ BorrowId.to_string tgt_bid ^ "\n")); @@ -2156,7 +2156,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) tgt_bid method! visit_loan_id _ id = - log#ldebug + log#ltrace (lazy ("match_ctx_with_target: cf_introduce_loop_fp_abs: visit_loan_id: " ^ BorrowId.to_string id ^ "\n")); @@ -2269,7 +2269,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) let nenv = List.append new_absl tgt_ctx.env in let tgt_ctx = { tgt_ctx with env = nenv } in - log#ldebug + log#ltrace (lazy ("match_ctx_with_target: cf_introduce_loop_fp_abs: done:\n- result ctx:\n" ^ eval_ctx_to_string ~span:(Some span) tgt_ctx)); @@ -2287,7 +2287,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) in (* Compute the loop input values *) - log#ldebug + log#ltrace (lazy ("match_ctx_with_target: about to compute the input values:" ^ "\n- fp_input_svalues: " diff --git a/src/interp/InterpreterPaths.ml b/src/interp/InterpreterPaths.ml index 668c919be..3f18dc850 100644 --- a/src/interp/InterpreterPaths.ml +++ b/src/interp/InterpreterPaths.ml @@ -431,7 +431,7 @@ let expand_bottom_value_from_projection (span : Meta.span) (access : access_kind) (p : place) (pe : projection_elem) (ctx : eval_ctx) : eval_ctx = (* Debugging *) - log#ldebug + log#ltrace (lazy ("expand_bottom_value_from_projection:\n" ^ "pe: " ^ show_projection_elem pe ^ "\n" ^ "ty: " ^ show_ety p.ty)); @@ -637,7 +637,7 @@ let prepare_lplace (config : config) (span : Meta.span) (p : place) (ctx : eval_ctx) : typed_value * eval_ctx * (SymbolicAst.expression -> SymbolicAst.expression) = - log#ldebug + log#ltrace (lazy ("prepare_lplace:" ^ "\n- p: " ^ place_to_string ctx p ^ "\n- Initial context:\n" diff --git a/src/interp/InterpreterProjectors.ml b/src/interp/InterpreterProjectors.ml index 6237913a4..5a4c61cc8 100644 --- a/src/interp/InterpreterProjectors.ml +++ b/src/interp/InterpreterProjectors.ml @@ -206,7 +206,7 @@ let rec apply_proj_borrows (span : Meta.span) (check_symbolic_no_ended : bool) let rset1 = ctx.ended_regions in let ty2 = ty in let rset2 = regions in - log#ldebug + log#ltrace (lazy ("projections_intersect:" ^ "\n- ty1: " ^ ty_to_string ctx ty1 ^ "\n- rset1: " diff --git a/src/interp/InterpreterStatements.ml b/src/interp/InterpreterStatements.ml index d115b5aba..c7603b9de 100644 --- a/src/interp/InterpreterStatements.ml +++ b/src/interp/InterpreterStatements.ml @@ -21,7 +21,7 @@ let log = L.statements_log (** Drop a value at a given place - TODO: factorize this with [assign_to_place] *) let drop_value (config : config) (span : Meta.span) (p : place) : cm_fun = fun ctx -> - log#ldebug + log#ltrace (lazy ("drop_value: place: " ^ place_to_string ctx p ^ "\n- Initial context:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); @@ -42,7 +42,7 @@ let drop_value (config : config) (span : Meta.span) (p : place) : cm_fun = (* Update the destination to ⊥ *) let nv = { v with value = VBottom } in let ctx = write_place span access p nv ctx in - log#ldebug + log#ltrace (lazy ("drop_value: place: " ^ place_to_string ctx p ^ "\n- Final context:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); @@ -92,7 +92,7 @@ let push_vars (span : Meta.span) (vars : (var * typed_value) list) let assign_to_place (config : config) (span : Meta.span) (rv : typed_value) (p : place) : cm_fun = fun ctx -> - log#ldebug + log#ltrace (lazy ("assign_to_place:" ^ "\n- rv: " ^ typed_value_to_string ~span:(Some span) ctx rv @@ -118,7 +118,7 @@ let assign_to_place (config : config) (span : Meta.span) (rv : typed_value) (* Update the destination *) let ctx = write_place span Write p rv ctx in (* Debug *) - log#ldebug + log#ltrace (lazy ("assign_to_place:" ^ "\n- rv: " ^ typed_value_to_string ~span:(Some span) ctx rv @@ -204,7 +204,7 @@ let eval_assertion (config : config) (span : Meta.span) (assertion : assertion) let set_discriminant (config : config) (span : Meta.span) (p : place) (variant_id : VariantId.id) : st_cm_fun = fun ctx -> - log#ldebug + log#ltrace (lazy ("set_discriminant:" ^ "\n- p: " ^ place_to_string ctx p ^ "\n- variant id: " @@ -312,7 +312,7 @@ let pop_frame (config : config) (span : Meta.span) (pop_return_value : bool) * eval_ctx * (SymbolicAst.expression -> SymbolicAst.expression) = (* Debug *) - log#ldebug (lazy ("pop_frame:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); + log#ltrace (lazy ("pop_frame:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); (* List the local variables, but the return variable *) let ret_vid = VarId.zero in @@ -328,7 +328,7 @@ let pop_frame (config : config) (span : Meta.span) (pop_return_value : bool) in let locals : VarId.id list = list_locals ctx.env in (* Debug *) - log#ldebug + log#ltrace (lazy ("pop_frame: locals in which to drop the outer loans: [" ^ String.concat "," (List.map VarId.to_string locals) @@ -346,7 +346,7 @@ let pop_frame (config : config) (span : Meta.span) (pop_return_value : bool) locals ctx in (* Debug *) - log#ldebug + log#ltrace (lazy ("pop_frame: after dropping outer loans in local variables:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); @@ -653,7 +653,7 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) match func.func with | FunId (FRegular fid) -> let def = ctx_lookup_fun_decl ctx fid in - log#ldebug + log#ltrace (lazy ("fun call:\n- call: " ^ call_to_string ctx call ^ "\n- call.generics:\n" @@ -675,7 +675,7 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) (* Unreachable: must be a transparent function *) craise __FILE__ __LINE__ span "Unreachable" | TraitMethod (trait_ref, method_name, _) -> ( - log#ldebug + log#ltrace (lazy ("trait method call:\n- call: " ^ call_to_string ctx call ^ "\n- method name: " ^ method_name ^ "\n- call.generics:\n" @@ -695,7 +695,7 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) | TraitImpl (impl_id, generics) -> ( (* Lookup the trait impl *) let trait_impl = ctx_lookup_trait_impl ctx impl_id in - log#ldebug + log#ltrace (lazy ("trait impl: " ^ trait_impl_to_string ctx trait_impl)); (* First look in the required methods *) let method_id = @@ -765,7 +765,7 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) TypesUtils.merge_generic_args trait_decl_ref.decl_generics func.generics in - log#ldebug + log#ltrace (lazy ("provided method call:" ^ "\n- method name: " ^ method_name ^ "\n- all_generics:\n" @@ -797,7 +797,7 @@ let eval_transparent_function_call_symbolic_inst (span : Meta.span) trait_decl.provided_methods) in let method_def = ctx_lookup_fun_decl ctx method_id in - log#ldebug + log#ltrace (lazy ("method:\n" ^ fun_decl_to_string ctx method_def)); (* Instantiate *) (* When instantiating, we need to group the generics for the @@ -840,7 +840,7 @@ let eval_global_as_fresh_symbolic_value (span : Meta.span) let rec eval_statement (config : config) (st : statement) : stl_cm_fun = fun ctx -> (* Debugging *) - log#ldebug + log#ltrace (lazy ("\n**About to evaluate statement**: [\n" ^ statement_to_string_with_tab ctx st @@ -861,7 +861,7 @@ let rec eval_statement (config : config) (st : statement) : stl_cm_fun = and eval_statement_raw (config : config) (st : statement) : stl_cm_fun = fun ctx -> - log#ldebug + log#ltrace (lazy ("\neval_statement_raw: statement:\n" ^ statement_to_string_with_tab ctx st @@ -880,7 +880,7 @@ and eval_statement_raw (config : config) (st : statement) : stl_cm_fun = (* Evaluate the rvalue *) let res, ctx, cc = eval_rvalue_not_global config st.span rvalue ctx in (* Assign *) - log#ldebug + log#ltrace (lazy ("about to assign to place: " ^ place_to_string ctx p ^ "\n- Context:\n" @@ -1373,7 +1373,7 @@ and eval_function_call_symbolic_from_inst_sig (config : config) (trait_method_generics : (generic_args * trait_instance_id) option) (args : operand list) (dest : place) : stl_cm_fun = fun ctx -> - log#ldebug + log#ltrace (lazy ("eval_function_call_symbolic_from_inst_sig:\n- fid: " ^ fun_id_or_trait_method_ref_to_string ctx fid @@ -1547,7 +1547,7 @@ and eval_builtin_function_call_symbolic (config : config) (span : Meta.span) 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 + log#ltrace (lazy ("eval_builtin_function_call_symbolic: special case:" ^ "\n- inst_sig:" ^ inst_fun_sig_to_string ctx inst_sig)); @@ -1587,14 +1587,14 @@ and eval_builtin_function_call_symbolic (config : config) (span : Meta.span) (** Evaluate a statement seen as a function body *) and eval_function_body (config : config) (body : statement) : stl_cm_fun = fun ctx -> - log#ldebug (lazy "eval_function_body:"); + log#ltrace (lazy "eval_function_body:"); let ctx_resl, cf_body = eval_statement config body ctx in let ctx_res_cfl = List.map (fun (ctx, res) -> (* Note that we *don't* check the result ({!Panic}, {!Return}, etc.): we delegate the check to the caller. *) - log#ldebug (lazy "eval_function_body: cf_finish"); + log#ltrace (lazy "eval_function_body: cf_finish"); (* Expand the symbolic values if necessary - we need to do that before checking the invariants *) let ctx, cf = greedy_expand_symbolic_values config body.span ctx in diff --git a/src/interp/Invariants.ml b/src/interp/Invariants.ml index b02b40c69..1b31bce3a 100644 --- a/src/interp/Invariants.ml +++ b/src/interp/Invariants.ml @@ -266,7 +266,7 @@ let check_loans_borrows_relation_invariant (span : Meta.span) (ctx : eval_ctx) : borrows_visitor#visit_eval_ctx () ctx; (* Debugging *) - log#ldebug + log#ltrace (lazy ("\nAbout to check context invariant:\n" ^ context_to_string ())); (* Finally, check that everything is consistant *) @@ -849,7 +849,7 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = in (* Collect the information *) obj#visit_eval_ctx None ctx; - log#ldebug + log#ltrace (lazy ("check_symbolic_values: collected information:\n" ^ SymbolicValueId.Map.to_string (Some " ") show_sv_info !infos)); @@ -901,14 +901,14 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = let check_invariants (span : Meta.span) (ctx : eval_ctx) : unit = if !Config.sanity_checks then ( - log#ldebug + log#ltrace (lazy ("Checking invariants:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); check_loans_borrows_relation_invariant span ctx; check_borrowed_values_invariant span ctx; check_typing_invariant span ctx true; check_symbolic_values span ctx) - else log#ldebug (lazy "Not checking invariants (check is not activated)") + else log#ltrace (lazy "Not checking invariants (check is not activated)") let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = if !Config.sanity_checks then check_typing_invariant span ctx true diff --git a/src/llbc/AssociatedTypes.ml b/src/llbc/AssociatedTypes.ml index 51d28dfc2..9c021cbd1 100644 --- a/src/llbc/AssociatedTypes.ml +++ b/src/llbc/AssociatedTypes.ml @@ -204,7 +204,7 @@ let norm_ctx_lookup_trait_impl_parent_clause (ctx : norm_ctx) See the comments for {!norm_ctx_normalize_trait_instance_id}. *) let rec norm_ctx_normalize_ty (ctx : norm_ctx) (ty : ty) : ty = - log#ldebug (lazy ("norm_ctx_normalize_ty: " ^ ty_to_string ctx ty)); + log#ltrace (lazy ("norm_ctx_normalize_ty: " ^ ty_to_string ctx ty)); match ty with | TAdt (id, generics) -> TAdt (id, norm_ctx_normalize_generic_args ctx generics) @@ -224,7 +224,7 @@ let rec norm_ctx_normalize_ty (ctx : norm_ctx) (ty : ty) : ty = let output = norm_ctx_normalize_ty ctx output in TArrow { binder_regions; binder_value = (inputs, output) } | TTraitType (trait_ref, type_name) -> ( - log#ldebug + log#ltrace (lazy ("norm_ctx_normalize_ty:\n- trait type: " ^ ty_to_string ctx ty ^ "\n- trait_ref: " @@ -235,7 +235,7 @@ let rec norm_ctx_normalize_ty (ctx : norm_ctx) (ty : ty) : ty = let ty : ty = match trait_ref.trait_id with | TraitImpl (impl_id, generics) -> - log#ldebug + log#ltrace (lazy ("norm_ctx_normalize_ty (trait impl):\n- trait type: " ^ ty_to_string ctx ty ^ "\n- trait_ref: " @@ -254,7 +254,7 @@ let rec norm_ctx_normalize_ty (ctx : norm_ctx) (ty : ty) : ty = (* Normalize *) norm_ctx_normalize_ty ctx ty | _ -> - log#ldebug + log#ltrace (lazy ("norm_ctx_normalize_ty: trait type: not a trait ref: " ^ ty_to_string ctx ty ^ "\n- trait_ref: " @@ -377,7 +377,7 @@ and norm_ctx_normalize_generic_args (ctx : norm_ctx) (generics : generic_args) : and norm_ctx_normalize_trait_ref (ctx : norm_ctx) (trait_ref : trait_ref) : trait_ref = - log#ldebug + log#ltrace (lazy ("norm_ctx_normalize_trait_ref: " ^ trait_ref_to_string ctx trait_ref @@ -390,7 +390,7 @@ and norm_ctx_normalize_trait_ref (ctx : norm_ctx) (trait_ref : trait_ref) : norm_ctx_normalize_region_binder norm_ctx_normalize_trait_decl_ref ctx trait_decl_ref in - log#ldebug + log#ltrace (lazy ("norm_ctx_normalize_trait_ref: no norm: " ^ trait_instance_id_to_string ctx trait_id)); diff --git a/src/llbc/Contexts.ml b/src/llbc/Contexts.ml index a53fa2b45..2c7ffbd2d 100644 --- a/src/llbc/Contexts.ml +++ b/src/llbc/Contexts.ml @@ -223,7 +223,7 @@ let ctx_push_var (span : Meta.span) (ctx : eval_ctx) (var : var) *) let ctx_push_vars (span : Meta.span) (ctx : eval_ctx) (vars : (var * typed_value) list) : eval_ctx = - log#ldebug + log#ltrace (lazy ("push_vars:\n" ^ String.concat "\n" diff --git a/src/llbc/RegionsHierarchy.ml b/src/llbc/RegionsHierarchy.ml index 3e3f21029..76bdfdd19 100644 --- a/src/llbc/RegionsHierarchy.ml +++ b/src/llbc/RegionsHierarchy.ml @@ -47,7 +47,7 @@ let compute_regions_hierarchy_for_sig (span : Meta.span option) (trait_decls : trait_decl TraitDeclId.Map.t) (trait_impls : trait_impl TraitImplId.Map.t) (fun_name : string) (sg : fun_sig) : region_var_groups = - log#ldebug (lazy (__FUNCTION__ ^ ": " ^ fun_name)); + log#ltrace (lazy (__FUNCTION__ ^ ": " ^ fun_name)); (* Initialize a normalization context (we may need to normalize some associated types) *) let norm_ctx : AssociatedTypes.norm_ctx = diff --git a/src/pure/PureMicroPasses.ml b/src/pure/PureMicroPasses.ml index 5e480d45e..8f1e43a76 100644 --- a/src/pure/PureMicroPasses.ml +++ b/src/pure/PureMicroPasses.ml @@ -1649,7 +1649,7 @@ let simplify_aggregates_unchanged_fields (ctx : trans_ctx) (def : fun_decl) : inherit [_] map_expression as super method! visit_Switch env scrut switch = - log#ldebug + log#ltrace (lazy ("Visiting switch: " ^ switch_to_string ctx scrut switch)); (* Update the scrutinee *) let scrut = self#visit_texpression env scrut in @@ -1693,7 +1693,7 @@ let simplify_aggregates_unchanged_fields (ctx : trans_ctx) (def : fun_decl) : let e = match e0.e with | StructUpdate updt -> - log#ldebug + log#ltrace (lazy ("Visiting struct update: " ^ struct_update_to_string ctx updt)); (* Update the fields *) @@ -1714,12 +1714,12 @@ let simplify_aggregates_unchanged_fields (ctx : trans_ctx) (def : fun_decl) : (* If this value is equal to the value we update the field with, we can simply ignore the update *) if field_value = expand_expression env e.e then ( - log#ldebug + log#ltrace (lazy ("Simplifying field: " ^ texpression_to_string ctx e)); None) else ( - log#ldebug + log#ltrace (lazy ("Not simplifying field: " ^ texpression_to_string ctx e)); @@ -1727,7 +1727,7 @@ let simplify_aggregates_unchanged_fields (ctx : trans_ctx) (def : fun_decl) : in let updates = List.filter_map update_field updt.updates in if updates = [] then ( - log#ldebug + log#ltrace (lazy ("StructUpdate: " ^ texpression_to_string ctx e0 @@ -1736,7 +1736,7 @@ let simplify_aggregates_unchanged_fields (ctx : trans_ctx) (def : fun_decl) : init.e) else let updt1 = { updt with updates } in - log#ldebug + log#ltrace (lazy ("StructUpdate: " ^ struct_update_to_string ctx updt @@ -1745,7 +1745,7 @@ let simplify_aggregates_unchanged_fields (ctx : trans_ctx) (def : fun_decl) : super#visit_StructUpdate env updt1 end | App _ -> - log#ldebug + log#ltrace (lazy ("Visiting app: " ^ texpression_to_string ctx e0)); (* It may be an ADT expression (e.g., [Cons x y] or [(x, y)]): check if it is the case, and if it is, compute the expansion @@ -1765,7 +1765,7 @@ let simplify_aggregates_unchanged_fields (ctx : trans_ctx) (def : fun_decl) : begin match expanded with | [ e2 ] -> - log#ldebug + log#ltrace (lazy ("Simplified: " ^ texpression_to_string ctx e1 @@ -2502,11 +2502,11 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = if apply then ( let def = pass ctx def in - log#ldebug + log#ltrace (lazy (pass_name ^ ":\n\n" ^ fun_decl_to_string ctx def ^ "\n")); def) else ( - log#ldebug + log#ltrace (lazy ("ignoring " ^ pass_name ^ " due to the configuration\n")); def)) def end_passes @@ -2555,7 +2555,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : in let subgroups = ReorderDecls.group_reorder_fun_decls all_decls in - log#ldebug + log#ltrace (lazy ("filter_loop_inputs: all_decls:\n\n" ^ String.concat "\n\n" (List.map (fun_decl_to_string ctx) all_decls) @@ -2588,7 +2588,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : (fun v -> (var_get_id v, mk_texpression_from_var v)) inputs_prefix in - log#ldebug + log#ltrace (lazy ("inputs:\n" ^ String.concat ", " (List.map (var_to_string ctx) inputs_prefix) @@ -2634,7 +2634,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : let beg_args, end_args = Collections.List.split_at args inputs_prefix_length in - log#ldebug + log#ltrace (lazy ("beg_args:\n" ^ String.concat ", " @@ -2663,7 +2663,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : in visitor#visit_texpression () body.body; - log#ldebug + log#ltrace (lazy ("\n- used variables: " ^ String.concat ", " @@ -2689,7 +2689,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : | [ f ] -> (* Group made of one function: check if it is a loop. If it is the case, explore it. *) - log#ldebug + log#ltrace (lazy ("filter_loop_inputs: singleton:\n\n" ^ fun_decl_to_string ctx f ^ "\n")); @@ -2905,13 +2905,13 @@ let compute_reducible (_ctx : trans_ctx) (transl : pure_fun_translation list) : *) let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_and_loops = (* Debug *) - log#ldebug (lazy ("PureMicroPasses.apply_passes_to_def: " ^ def.name)); + log#ltrace (lazy ("PureMicroPasses.apply_passes_to_def: " ^ def.name)); - log#ldebug (lazy ("original decl:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + log#ltrace (lazy ("original decl:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* First, find names for the variables which are unnamed *) let def = compute_pretty_names def in - log#ldebug + log#ltrace (lazy ("compute_pretty_name:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* TODO: we might want to leverage more the assignment span-data, for @@ -2923,7 +2923,7 @@ let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_and_loops = * Rk.: some passes below use the fact that we removed the span-data * (otherwise we would have to "unspan" expressions before matching) *) let def = remove_span def in - log#ldebug (lazy ("remove_span:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + log#ltrace (lazy ("remove_span:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* Extract the loop definitions by removing the {!Loop} node *) let def, loops = decompose_loops ctx def in diff --git a/src/pure/PureTypeCheck.ml b/src/pure/PureTypeCheck.ml index d9cbf9714..6d3cc30eb 100644 --- a/src/pure/PureTypeCheck.ml +++ b/src/pure/PureTypeCheck.ml @@ -76,7 +76,7 @@ let check_literal (span : Meta.span) (v : literal) (ty : literal_type) : unit = let rec check_typed_pattern (span : Meta.span) (ctx : tc_ctx) (v : typed_pattern) : tc_ctx = - log#ldebug (lazy ("check_typed_pattern: " ^ show_typed_pattern v)); + log#ltrace (lazy ("check_typed_pattern: " ^ show_typed_pattern v)); match v.value with | PatConstant cv -> check_literal span cv (ty_as_literal span v.ty); diff --git a/src/pure/ReorderDecls.ml b/src/pure/ReorderDecls.ml index 9706da71b..756372d63 100644 --- a/src/pure/ReorderDecls.ml +++ b/src/pure/ReorderDecls.ml @@ -72,7 +72,7 @@ let group_reorder_fun_decls (decls : fun_decl list) : let idl = List.map get_fun_id decls in let ids = FunIdSet.of_list idl in - log#ldebug + log#ltrace (lazy ("group_reorder_fun_decls: ids:\n" ^ (Print.list_to_string FunIdOrderedType.show_t) idl)); diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 24c9dff47..7c01e2c12 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -723,7 +723,7 @@ let compute_fun_sig_explicit_info (sg : Pure.fun_sig) : explicit_info = *) let translate_type_decl (ctx : Contexts.decls_ctx) (def : T.type_decl) : type_decl = - log#ldebug + log#ltrace (lazy (let ctx = Print.Contexts.decls_ctx_to_fmt_env ctx in "translate_type_decl:\n\n" @@ -1166,7 +1166,7 @@ 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 + log#ltrace (lazy (let ctx = Print.Contexts.decls_ctx_to_fmt_env decls_ctx in "translate_inst_fun_sig_with_regions_hierarchy_to_decomposed_fun_type: " @@ -1252,7 +1252,7 @@ let translate_inst_fun_sig_to_decomposed_fun_type (span : Meta.span option) let inputs = List.filter_map (translate_back_ty_for_gid gid) [ sg.output ] in - log#ldebug + log#ltrace (lazy (let ctx = Print.Contexts.decls_ctx_to_fmt_env decls_ctx in let pctx = PrintPure.decls_ctx_to_fmt_env decls_ctx in @@ -1291,7 +1291,7 @@ let translate_inst_fun_sig_to_decomposed_fun_type (span : Meta.span option) List.map (fun (name, opt_ty) -> (name, Option.get opt_ty)) outputs in let names, outputs = List.split outputs in - log#ldebug + log#ltrace (lazy (let ctx = Print.Contexts.decls_ctx_to_fmt_env decls_ctx in let pctx = PrintPure.decls_ctx_to_fmt_env decls_ctx in @@ -1510,7 +1510,7 @@ let translate_fun_sig_from_decl_to_decomposed (decls_ctx : C.decls_ctx) translate_fun_sig_to_decomposed decls_ctx fdef.def_id fdef.signature input_names in - log#ldebug + log#ltrace (lazy ("translate_fun_sig_from_decl_to_decomposed:" ^ "\n- name: " ^ T.show_name fdef.item_meta.name @@ -1882,7 +1882,7 @@ let rec typed_value_to_texpression (ctx : bs_ctx) (ectx : C.eval_ctx) | VSymbolic sv -> symbolic_value_to_texpression ctx sv in (* Debugging *) - log#ldebug + log#ltrace (lazy ("typed_value_to_texpression: result:" ^ "\n- input value:\n" ^ typed_value_to_string ctx v @@ -2230,7 +2230,7 @@ let typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) it contains mutable loans, then we generate a consumed value (because upon ending the borrow we consumed a value). Otherwise we ignore it. *) - log#ldebug + log#ltrace (lazy ("typed_avalue_to_consumed: " ^ typed_avalue_to_string ~with_ended:true ectx av)); @@ -2239,7 +2239,7 @@ let typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) av with | LoanProj BMut -> - log#ldebug + log#ltrace (lazy "typed_avalue_to_consumed: the value contains mutable loan projectors"); typed_avalue_to_consumed_aux ~filter:true ctx ectx abs_regions av @@ -2247,7 +2247,7 @@ let typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) (* 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 + log#ltrace (lazy "typed_avalue_to_consumed: the value doesn't contains mutable loan \ projectors (ignoring it)"); @@ -2259,14 +2259,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 + log#ltrace (lazy ("abs_to_consumed:\n" ^ abs_to_string ~with_ended:true ctx abs)); let values = List.filter_map (typed_avalue_to_consumed ctx ectx abs.regions.owned) abs.avalues in - log#ldebug + log#ltrace (lazy ("abs_to_consumed:\n- abs: " ^ abs_to_string ~with_ended:true ctx abs @@ -2538,7 +2538,7 @@ let abs_to_given_back (mpl : mplace option list option) (abs : V.abs) ctx avalues in let values = List.filter_map (fun x -> x) values in - log#ldebug + log#ltrace (lazy ("abs_to_given_back:\n- abs: " ^ abs_to_string ctx abs ^ "\n- values: " ^ Print.list_to_string (typed_pattern_to_string ctx) values)); @@ -2660,7 +2660,7 @@ let register_consumed_mut_borrows (ectx : C.eval_ctx) (ctx : bs_ctx) let decompose_let_match (ctx : bs_ctx) ((pat, bound) : typed_pattern * texpression) : bs_ctx * (typed_pattern * texpression) = - log#ldebug + log#ltrace (lazy ("decompose_let_match: " ^ "\n- pat: " ^ typed_pattern_to_string ctx pat @@ -2866,7 +2866,7 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : texpression = - log#ldebug + log#ltrace (lazy ("translate_function_call:\n" ^ "\n- call.call_id:" ^ S.show_call_id call.call_id @@ -2926,7 +2926,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (List.map (fun _ -> None) sg.inputs) in let back_tys = compute_back_tys_with_info dsg None in - log#ldebug + log#ltrace (lazy ("back_tys:\n " ^ String.concat "\n" @@ -3165,7 +3165,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : and translate_end_abstraction (ectx : C.eval_ctx) (abs : V.abs) (e : S.expression) (ctx : bs_ctx) : texpression = - log#ldebug + log#ltrace (lazy ("translate_end_abstraction: abstraction kind: " ^ V.show_abs_kind abs.kind)); @@ -3182,7 +3182,7 @@ and translate_end_abstraction (ectx : C.eval_ctx) (abs : V.abs) and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) (e : S.expression) (ctx : bs_ctx) (rg_id : T.RegionGroupId.id) : texpression = - log#ldebug + log#ltrace (lazy ("translate_end_abstraction_synth_input:" ^ "\n- function: " ^ name_to_string ctx ctx.fun_decl.item_meta.name @@ -3232,7 +3232,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) (* Get the list of values consumed by the abstraction upon ending *) let consumed_values = abs_to_consumed ctx ectx abs in - log#ldebug + log#ltrace (lazy ("translate_end_abstraction_synth_input:" ^ "\n\n- given back variables types:\n" @@ -3336,7 +3336,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) match func with | None -> next_e ctx | Some func -> - log#ldebug + log#ltrace (lazy (let args = List.map (texpression_to_string ctx) args in "func: " @@ -3367,7 +3367,7 @@ and translate_end_abstraction_identity (ectx : C.eval_ctx) (abs : V.abs) and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) (e : S.expression) (ctx : bs_ctx) (rg_id : T.RegionGroupId.id) : texpression = - log#ldebug + log#ltrace (lazy ("Translating ended synthesis abstraction: " ^ abs_to_string ctx abs)); (* If we end the abstraction which consumed the return value of the function we are synthesizing, we get back the borrows which were inside. Those borrows @@ -3400,7 +3400,7 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) (* First, retrieve the list of variables used for the inputs for the * backward function *) let inputs = T.RegionGroupId.Map.find rg_id ctx.backward_inputs_no_state in - log#ldebug + log#ltrace (lazy ("Consumed inputs: " ^ Print.list_to_string (pure_var_to_string ctx) inputs)); @@ -3412,9 +3412,9 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) (* 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... *) - log#ldebug (lazy ("abs: " ^ abs_to_string ctx abs)); + log#ltrace (lazy ("abs: " ^ abs_to_string ctx abs)); let ctx, given_back = abs_to_given_back_no_mp abs ctx in - log#ldebug + log#ltrace (lazy ("given back: " ^ Print.list_to_string (typed_pattern_to_string ctx) given_back)); @@ -3424,7 +3424,7 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) (* Sanity check *) List.iter (fun ((given_back, input) : typed_pattern * var) -> - log#ldebug + log#ltrace (lazy ("\n- given_back ty: " ^ pure_ty_to_string ctx given_back.ty @@ -3668,7 +3668,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) If (true_e, false_e) ) in let ty = true_e.ty in - log#ldebug + log#ltrace (lazy ("true_e.ty: " ^ pure_ty_to_string ctx true_e.ty @@ -3761,7 +3761,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value) and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option) (sv : V.symbolic_value) (v : S.value_aggregate) (e : S.expression) (ctx : bs_ctx) : texpression = - log#ldebug + log#ltrace (lazy ("translate_intro_symbolic:" ^ "\n- value aggregate: " ^ S.show_value_aggregate v)); @@ -4047,7 +4047,7 @@ and translate_forward_end (return_value : (C.eval_ctx * V.typed_value) option) (* Lookup the loop information *) let loop_info = LoopId.Map.find loop_id ctx.loops in - log#ldebug + log#ltrace (lazy ("translate_forward_end:\n- loop_input_values:\n" ^ V.SymbolicValueId.Map.show @@ -4063,7 +4063,7 @@ and translate_forward_end (return_value : (C.eval_ctx * V.typed_value) option) let loop_input_values = List.map (fun sv -> - log#ldebug + log#ltrace (lazy ("translate_forward_end: looking up input_svl: " ^ V.SymbolicValueId.to_string sv.V.sv_id @@ -4213,7 +4213,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = V.SymbolicValueId.Set.mem sv.sv_id loop.fresh_svalues) loop.input_svalues in - log#ldebug + log#ltrace (lazy ("translate_loop:" ^ "\n- input_svalues: " ^ (Print.list_to_string (symbolic_value_to_string ctx)) @@ -4257,7 +4257,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = 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 + log#ltrace (lazy (let back_sgs = RegionGroupId.Map.bindings ctx.sg.fun_ty.back_sg in "translate_loop:" ^ "\n- back_sgs: " @@ -4568,7 +4568,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = (* Translate *) let def = ctx.fun_decl in assert (ctx.bid = None); - log#ldebug + log#ltrace (lazy ("SymbolicToPure.translate_fun_decl: " ^ name_to_string ctx def.item_meta.name @@ -4584,7 +4584,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = match body with | None -> None | Some body -> - log#ldebug + log#ltrace (lazy ("SymbolicToPure.translate_fun_decl: " ^ name_to_string ctx def.item_meta.name @@ -4672,7 +4672,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = List.map (fun v -> mk_typed_pattern_from_var v None) inputs in (* Sanity check *) - log#ldebug + log#ltrace (lazy ("SymbolicToPure.translate_fun_decl: " ^ name_to_string ctx def.item_meta.name @@ -4717,7 +4717,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = } in (* Debugging *) - log#ldebug + log#ltrace (lazy ("SymbolicToPure.translate_fun_decl: translated:\n" ^ fun_decl_to_string ctx def)); From 690c3f39e01f5a418c1d542a76c8566c98dc3606 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 11:22:36 +0000 Subject: [PATCH 11/23] Improve formatting --- src/llbc/Print.ml | 22 +++++----- src/pure/PrintPure.ml | 79 ++++++++++++++++++++++++++++++++++ src/symbolic/SymbolicToPure.ml | 43 +++++++++++++----- 3 files changed, 122 insertions(+), 22 deletions(-) diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index fe8fa24d2..072e50a0c 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -135,7 +135,7 @@ module Values = struct let given_back = List.map (aproj_to_string ~with_ended env) given_back in - " (" ^ String.concat "," given_back ^ ") " + " [" ^ String.concat "," given_back ^ "]" in "⌊" ^ symbolic_value_proj_to_string env sv rty ^ given_back ^ "⌋" | AProjBorrows (sv, rty, given_back) -> @@ -146,7 +146,7 @@ module Values = struct let given_back = List.map (aproj_to_string ~with_ended env) given_back in - " (" ^ String.concat "," given_back ^ ") " + " [" ^ String.concat "," given_back ^ "]" in "(" ^ symbolic_value_proj_to_string env sv rty ^ given_back ^ ")" | AEndedProjLoans (msv, given_back) -> @@ -159,9 +159,9 @@ module Values = struct let given_back = List.map (aproj_to_string ~with_ended env) given_back in - "ended_aproj_loans (" ^ msv ^ ", (" + "ended_aproj_loans (" ^ msv ^ ", [" ^ String.concat "," given_back - ^ "))" + ^ "])" | AEndedProjBorrows (meta, given_back) -> let meta = if with_ended then @@ -175,9 +175,9 @@ module Values = struct let given_back = List.map (aproj_to_string ~with_ended env) given_back in - "ended_aproj_borrows (" ^ meta ^ ", " + "ended_aproj_borrows (" ^ meta ^ ", [" ^ String.concat "," given_back - ^ "))" + ^ "])" | AEmpty -> "_" (** Wrap a value inside its marker, if there is one *) @@ -362,16 +362,16 @@ module Values = struct in let avs = String.concat ",\n" avs in let kind = - if verbose then "[kind:" ^ abs_kind_to_string abs.kind ^ "]" else "" + if verbose then "kind:" ^ abs_kind_to_string abs.kind ^ "," else "" in - let can_end = if abs.can_end then "{endable}" else "{frozen}" in + let can_end = if abs.can_end then "endable" else "frozen" in indent ^ "abs@" ^ AbstractionId.to_string abs.abs_id - ^ kind ^ "{parents=" + ^ "{" ^ kind ^ "parents=" ^ AbstractionId.Set.to_string None abs.parents - ^ "}" ^ "{regions=" + ^ ",regions=" ^ RegionId.Set.to_string None abs.regions.owned - ^ "}" ^ can_end ^ " {\n" ^ avs ^ "\n" ^ indent ^ "}" + ^ "," ^ 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 diff --git a/src/pure/PrintPure.ml b/src/pure/PrintPure.ml index 65aed17b7..a443afc89 100644 --- a/src/pure/PrintPure.ml +++ b/src/pure/PrintPure.ml @@ -483,6 +483,85 @@ let typed_pattern_to_string ?(span : Meta.span option = None) (env : fmt_env) (v : typed_pattern) : string = snd (typed_pattern_to_string_aux span env v) +let back_sg_info_to_string (env : fmt_env) (info : back_sg_info) : string = + let { inputs; inputs_no_state; outputs; output_names; effect_info; filter } = + info + in + let input_to_string (n, ty) = + (match n with + | None -> "" + | Some n -> n ^ ":") + ^ ty_to_string env false ty + in + let inputs_to_string inputs = + "[" ^ String.concat "," (List.map input_to_string inputs) ^ "]" + in + "{ inputs = " ^ inputs_to_string inputs ^ "; inputs_no_state = " + ^ inputs_to_string inputs_no_state + ^ "; outputs = [" + ^ String.concat "," (List.map (ty_to_string env false) outputs) + ^ "; output_names = [" + ^ String.concat "," + (List.map + (function + | None -> "_" + | Some n -> n) + output_names) + ^ "; effect_info = " + ^ show_fun_effect_info effect_info + ^ "; filter = " + ^ Print.bool_to_string filter + ^ " }" + +let decomposed_fun_type_to_string (env : fmt_env) (sg : decomposed_fun_type) : + string = + let { fwd_inputs; fwd_output; back_sg; fwd_info } = sg in + "{\n fwd_inputs = " + ^ String.concat "," (List.map (ty_to_string env false) fwd_inputs) + ^ ";\n fwd_output = " + ^ ty_to_string env false fwd_output + ^ ";\n back_sg = " + ^ RegionGroupId.Map.to_string None (back_sg_info_to_string env) back_sg + ^ ";\n fwd_info = " ^ show_fun_sig_info fwd_info ^ "\n}" + +let trait_type_constraint_to_string (env : fmt_env) (c : trait_type_constraint) + : string = + let { trait_ref; type_name; ty } = c in + trait_ref_to_string env false trait_ref + ^ "." ^ type_name ^ " = " ^ ty_to_string env false ty + +let predicates_to_string (env : fmt_env) (preds : predicates) : string = + let { trait_type_constraints } = preds in + String.concat "," + (List.map (trait_type_constraint_to_string env) trait_type_constraints) + +let decomposed_fun_sig_to_string (env : fmt_env) (sg : decomposed_fun_sig) : + string = + let { generics; llbc_generics; preds; fun_ty } = sg in + let llbc_generics = + let env : _ Charon.PrintUtils.fmt_env = + { + type_decls = env.type_decls; + fun_decls = env.fun_decls; + global_decls = env.global_decls; + trait_decls = env.trait_decls; + trait_impls = env.trait_impls; + regions = []; + generics = Charon.TypesUtils.empty_generic_params; + locals = []; + } + in + let l0, l1 = Print.generic_params_to_strings env llbc_generics in + "[" ^ String.concat "," (l0 @ l1) ^ "]" + in + "{\n generics = [" + ^ String.concat "," (generic_params_to_strings env generics) + ^ "];\n llbc_generics = ..." ^ llbc_generics ^ ";\n preds = " + ^ predicates_to_string env preds + ^ ";\n fun_ty = " + ^ decomposed_fun_type_to_string env fun_ty + ^ "\n}" + let fun_sig_to_string (env : fmt_env) (sg : fun_sig) : string = let env = { env with generics = sg.generics } in let generics = generic_params_to_strings env sg.generics in diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 7c01e2c12..1473cb595 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -1514,7 +1514,11 @@ let translate_fun_sig_from_decl_to_decomposed (decls_ctx : C.decls_ctx) (lazy ("translate_fun_sig_from_decl_to_decomposed:" ^ "\n- name: " ^ T.show_name fdef.item_meta.name - ^ "\n- sg:\n" ^ show_decomposed_fun_sig sg ^ "\n")); + ^ "\n- sg:\n" + ^ PrintPure.decomposed_fun_sig_to_string + (PrintPure.decls_ctx_to_fmt_env decls_ctx) + sg + ^ "\n")); sg let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty @@ -1770,13 +1774,15 @@ let fresh_back_vars_for_current_fun (ctx : bs_ctx) fresh_opt_vars back_vars ctx (** IMPORTANT: do not use this one directly, but rather {!symbolic_value_to_texpression} *) -let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : var = +let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : + var option = match V.SymbolicValueId.Map.find_opt sv.sv_id ctx.sv_to_var with - | Some v -> v + | Some v -> Some v | None -> - craise __FILE__ __LINE__ ctx.span + save_error __FILE__ __LINE__ ctx.span ("Could not find var for symbolic value: " - ^ V.SymbolicValueId.to_string sv.sv_id) + ^ V.SymbolicValueId.to_string sv.sv_id); + None (** Peel boxes as long as the value is of the form [Box] *) let rec unbox_typed_value (span : Meta.span) (v : V.typed_value) : V.typed_value @@ -1802,8 +1808,17 @@ let symbolic_value_to_texpression (ctx : bs_ctx) (sv : V.symbolic_value) : if ty_is_unit ty then mk_unit_rvalue else (* Otherwise lookup the variable *) - let var = lookup_var_for_symbolic_value sv ctx in - mk_texpression_from_var var + match lookup_var_for_symbolic_value sv ctx with + | Some var -> mk_texpression_from_var var + | None -> + { + e = + EError + ( None, + "Could not find var for symbolic value: " + ^ V.SymbolicValueId.to_string sv.sv_id ); + ty; + } (** Translate a typed value. @@ -2540,7 +2555,9 @@ let abs_to_given_back (mpl : mplace option list option) (abs : V.abs) let values = List.filter_map (fun x -> x) values in log#ltrace (lazy - ("abs_to_given_back:\n- abs: " ^ abs_to_string ctx abs ^ "\n- values: " + ("abs_to_given_back:\n- abs: " + ^ abs_to_string ~with_ended:true ctx abs + ^ "\n- values: " ^ Print.list_to_string (typed_pattern_to_string ctx) values)); (ctx, values) @@ -2596,9 +2613,13 @@ let eval_ctx_to_symbolic_assignments_info (ctx : bs_ctx) (* If the type is unit, do nothing *) if ty_is_unit ty then () else - (* Otherwise lookup the variable *) - let var = lookup_var_for_symbolic_value sv ctx in - push_info var.id name + (* Otherwise lookup the variable - note that the variable may + not be present in the context in case of error: we delegate + to the lookup function the task of raising an error if the user + wants to fail hard. *) + Option.iter + (fun (var : var) -> push_info var.id name) + (lookup_var_for_symbolic_value sv ctx) | _ -> () end in From 3ebe90210161dbcaf9ad0e18bf8090d4b8078e64 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 13:15:12 +0000 Subject: [PATCH 12/23] Fix an issue with the translation of loops --- src/interp/Cps.ml | 18 +++- src/interp/Interpreter.ml | 11 ++- src/interp/InterpreterLoops.ml | 7 +- src/interp/InterpreterLoopsMatchCtxs.ml | 103 +++++++++++++---------- src/interp/InterpreterLoopsMatchCtxs.mli | 4 +- src/pure/PureUtils.ml | 6 ++ src/symbolic/PrintSymbolicAst.ml | 24 +++--- src/symbolic/SymbolicAst.ml | 22 +++-- src/symbolic/SymbolicToPure.ml | 62 ++++++++------ 9 files changed, 160 insertions(+), 97 deletions(-) diff --git a/src/interp/Cps.ml b/src/interp/Cps.ml index e77db88e5..6c3796c23 100644 --- a/src/interp/Cps.ml +++ b/src/interp/Cps.ml @@ -17,7 +17,10 @@ type statement_eval_res = | Panic | LoopReturn of loop_id (** We reached a return statement *while inside a loop* *) - | EndEnterLoop of loop_id * typed_value SymbolicValueId.Map.t + | EndEnterLoop of + loop_id + * typed_value SymbolicValueId.Map.t + * symbolic_value_id SymbolicValueId.Map.t (** When we enter a loop, we delegate the end of the function is synthesized with a call to the loop translation. We use this evaluation result to transmit the fact that we end evaluation @@ -25,13 +28,24 @@ type statement_eval_res = We provide the list of values for the translated loop function call (or to be more precise the input values instantiation). + + We also provide the map from the input symbolic values to refresh symbolic + values (we need those to introduce intermediate let-bindings in the translation). + TODO: not clean; we will get rid of those once we generalize. *) - | EndContinue of loop_id * typed_value SymbolicValueId.Map.t + | EndContinue of + loop_id + * typed_value SymbolicValueId.Map.t + * symbolic_value_id SymbolicValueId.Map.t (** For loop translations: we end with a continue (i.e., a recursive call to the translation for the loop body). We provide the list of values for the translated loop function call (or to be more precise the input values instantiation). + + We also provide the map from the input symbolic values to refresh symbolic + values (we need those to introduce intermediate let-bindings in the translation). + TODO: not clean; we will get rid of those once we generalize. *) [@@deriving show] diff --git a/src/interp/Interpreter.ml b/src/interp/Interpreter.ml index 3139d6d6d..3650c3652 100644 --- a/src/interp/Interpreter.ml +++ b/src/interp/Interpreter.ml @@ -585,8 +585,8 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) let back_el = RegionGroupId.Map.of_list back_el in (* Put everything together *) 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) -> + | EndEnterLoop (loop_id, loop_input_values, refreshed_input_sids) + | EndContinue (loop_id, loop_input_values, refreshed_input_sids) -> (* Similar to [Return]: we have to play different endings *) let inside_loop = match res with @@ -621,7 +621,12 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) in let back_el = RegionGroupId.Map.of_list back_el in (* Put everything together *) - ForwardEnd (None, ctx0, Some loop_input_values, fwd_e, back_el) + ForwardEnd + ( None, + ctx0, + Some (loop_input_values, refreshed_input_sids), + 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/InterpreterLoops.ml b/src/interp/InterpreterLoops.ml index 649f7a786..33c66ddda 100644 --- a/src/interp/InterpreterLoops.ml +++ b/src/interp/InterpreterLoops.ml @@ -103,7 +103,8 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) ^ "\n\n-tgt ctx (original context):\n" ^ eval_ctx_to_string init_ctx)); - prepare_match_ctx_with_target config span loop_id fixed_ids fp_ctx init_ctx + prepare_loop_match_ctx_with_target config span loop_id fixed_ids fp_ctx + init_ctx in (* Actually match *) @@ -135,7 +136,7 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) we never get out) *) let res_fun_end = comp cf_prepare - (match_ctx_with_target config span loop_id true fp_bl_corresp + (loop_match_ctx_with_target config span loop_id true fp_bl_corresp fp_input_svalues fixed_ids fp_ctx ctx) in @@ -283,7 +284,7 @@ let eval_loop_symbolic_synthesize_loop_body (config : config) (span : span) ^ eval_ctx_to_string ~span:(Some span) fp_ctx ^ "\n\n-tgt ctx (ctx at continue):\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); - match_ctx_with_target config span loop_id false fp_bl_corresp + loop_match_ctx_with_target config span loop_id false fp_bl_corresp fp_input_svalues fixed_ids fp_ctx ctx | Unit | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> (* For why we can't get [Unit], see the comments inside {!eval_loop_concrete}. diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index 165e12864..650413764 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -1255,7 +1255,7 @@ struct let match_shared_borrows (ctx0 : eval_ctx) (ctx1 : eval_ctx) (match_typed_values : typed_value -> typed_value -> typed_value) (_ty : ety) (bid0 : borrow_id) (bid1 : borrow_id) : borrow_id = - log#ltrace + log#ldebug (lazy ("MakeCheckEquivMatcher: match_shared_borrows: " ^ "bid0: " ^ BorrowId.to_string bid0 ^ ", bid1: " ^ BorrowId.to_string bid1)); @@ -1269,7 +1269,7 @@ struct else let v0 = S.lookup_shared_value_in_ctx0 bid0 in let v1 = S.lookup_shared_value_in_ctx1 bid1 in - log#ltrace + log#ldebug (lazy ("MakeCheckEquivMatcher: match_shared_borrows: looked up values:" ^ "sv0: " @@ -1303,7 +1303,7 @@ struct let id0 = sv0.sv_id in let id1 = sv1.sv_id in - log#ltrace + log#ldebug (lazy ("MakeCheckEquivMatcher: match_symbolic_values: " ^ "sv0: " ^ SymbolicValueId.to_string id0 @@ -1406,7 +1406,7 @@ struct (* We are checking whether that two environments are equivalent: there shouldn't be any projection markers *) sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span; - log#ltrace + log#ldebug (lazy ("MakeCheckEquivMatcher:match_amut_loans:" ^ "\n- id0: " ^ BorrowId.to_string id0 ^ "\n- id1: " ^ BorrowId.to_string id1 @@ -1432,7 +1432,7 @@ struct { value = ASymbolic (PNone, AProjLoans (sv, proj_ty, [])); ty } let match_avalues (ctx0 : eval_ctx) (ctx1 : eval_ctx) v0 v1 = - log#ltrace + log#ldebug (lazy ("avalues don't match:\n- v0: " ^ typed_avalue_to_string ~span:(Some span) ctx0 v0 @@ -1445,7 +1445,7 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (lookup_shared_value_in_ctx0 : BorrowId.id -> typed_value) (lookup_shared_value_in_ctx1 : BorrowId.id -> typed_value) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : ids_maps option = - log#ltrace + log#ldebug (lazy ("match_ctxs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" @@ -1555,7 +1555,7 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) let _ = CEM.match_rids regions0 regions1 in let _ = CEM.match_rids ancestors_regions0 ancestors_regions1 in - log#ltrace (lazy "match_abstractions: matching values"); + log#ldebug (lazy "match_abstractions: matching values"); let _ = if List.length avalues0 <> List.length avalues1 then raise @@ -1565,13 +1565,13 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (fun (v0, v1) -> M.match_typed_avalues ctx0 ctx1 v0 v1) (List.combine avalues0 avalues1) in - log#ltrace (lazy "match_abstractions: values matched OK"); + log#ldebug (lazy "match_abstractions: values matched OK"); () in (* Rem.: this function raises exceptions of type [Distinct] *) let rec match_envs (env0 : env) (env1 : env) : unit = - log#ltrace + log#ldebug (lazy ("match_ctxs: match_envs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- rid_map: " @@ -1614,10 +1614,10 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (* Continue *) match_envs env0' env1' | EAbs abs0 :: env0', EAbs abs1 :: env1' -> - log#ltrace (lazy "match_ctxs: match_envs: matching abs"); + log#ldebug (lazy "match_ctxs: match_envs: matching abs"); (* Same as for the dummy values: there are two cases *) if AbstractionId.Set.mem abs0.abs_id fixed_ids.aids then ( - log#ltrace (lazy "match_ctxs: match_envs: matching abs: fixed abs"); + log#ldebug (lazy "match_ctxs: match_envs: matching abs: fixed abs"); (* Still in the prefix: the abstractions must be the same *) sanity_check __FILE__ __LINE__ (abs0 = abs1) span; (* Their ids must be fixed *) @@ -1628,7 +1628,7 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (* Continue *) match_envs env0' env1') else ( - log#ltrace + log#ldebug (lazy "match_ctxs: match_envs: matching abs: not fixed abs"); (* Match the values *) match_abstractions abs0 abs1; @@ -1687,14 +1687,14 @@ let ctxs_are_equivalent (span : Meta.span) (fixed_ids : ids_sets) (match_ctxs span check_equivalent fixed_ids lookup_shared_value lookup_shared_value ctx0 ctx1) -let prepare_match_ctx_with_target (config : config) (span : Meta.span) +let prepare_loop_match_ctx_with_target (config : config) (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (src_ctx : eval_ctx) : cm_fun = fun tgt_ctx -> (* Debug *) - log#ltrace + log#ldebug (lazy - ("prepare_match_ctx_with_target:\n" ^ "\n- fixed_ids: " - ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " + (__FUNCTION__ ^ ":\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" + ^ "\n- src_ctx: " ^ eval_ctx_to_string ~span:(Some span) src_ctx ^ "\n- tgt_ctx: " ^ eval_ctx_to_string ~span:(Some span) tgt_ctx)); @@ -1706,11 +1706,10 @@ let prepare_match_ctx_with_target (config : config) (span : Meta.span) let filt_src_env, _, _ = ctx_split_fixed_new span fixed_ids src_ctx in let filt_tgt_env, _, _ = ctx_split_fixed_new span fixed_ids tgt_ctx in - log#ltrace + log#ldebug (lazy - ("prepare_match_ctx_with_target: reorganize_join_tgt:\n" - ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" - ^ "\n- filt_src_ctx: " + (__FUNCTION__ ^ ": reorganize_join_tgt:\n" ^ "\n- fixed_ids: " + ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- filt_src_ctx: " ^ env_to_string span src_ctx filt_src_env ^ "\n- filt_tgt_ctx: " ^ env_to_string span tgt_ctx filt_tgt_env)); @@ -1751,11 +1750,11 @@ let prepare_match_ctx_with_target (config : config) (span : Meta.span) (List.combine filt_src_env filt_tgt_env) in (* No exception was thrown: continue *) - log#ltrace + log#ldebug (lazy - ("prepare_match_ctx_with_target: reorganize_join_tgt: done with \ - borrows/loans:\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids - ^ "\n" ^ "\n- filt_src_ctx: " + (__FUNCTION__ ^ ": reorganize_join_tgt: done with borrows/loans:\n" + ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" + ^ "\n- filt_src_ctx: " ^ env_to_string span src_ctx filt_src_env ^ "\n- filt_tgt_ctx: " ^ env_to_string span tgt_ctx filt_tgt_env)); @@ -1809,11 +1808,11 @@ let prepare_match_ctx_with_target (config : config) (span : Meta.span) ctx_push_fresh_dummy_vars tgt_ctx (List.rev !nvalues) in - log#ltrace + log#ldebug (lazy - ("prepare_match_ctx_with_target: reorganize_join_tgt: done with \ - borrows/loans and moves:\n" ^ "\n- fixed_ids: " - ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " + (__FUNCTION__ + ^ ": reorganize_join_tgt: done with borrows/loans and moves:\n" + ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " ^ eval_ctx_to_string ~span:(Some span) src_ctx ^ "\n- tgt_ctx: " ^ eval_ctx_to_string ~span:(Some span) tgt_ctx)); @@ -1835,7 +1834,7 @@ let prepare_match_ctx_with_target (config : config) (span : Meta.span) (* Apply the reorganization *) reorganize_join_tgt tgt_ctx -let match_ctx_with_target (config : config) (span : Meta.span) +let loop_match_ctx_with_target (config : config) (span : Meta.span) (loop_id : LoopId.id) (is_loop_entry : bool) (fp_bl_maps : borrow_loan_corresp) (fp_input_svalues : SymbolicValueId.id list) (fixed_ids : ids_sets) @@ -1844,8 +1843,8 @@ let match_ctx_with_target (config : config) (span : Meta.span) (* Debug *) log#ltrace (lazy - ("match_ctx_with_target:\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids - ^ "\n" ^ "\n- src_ctx: " ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx: " + (__FUNCTION__ ^ ":\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" + ^ "\n- src_ctx: " ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx: " ^ eval_ctx_to_string tgt_ctx)); (* We first reorganize [tgt_ctx] so that we can match [src_ctx] with it (by @@ -1854,7 +1853,8 @@ let match_ctx_with_target (config : config) (span : Meta.span) were introduced during the loop iterations) *) let tgt_ctx, cc = - prepare_match_ctx_with_target config span loop_id fixed_ids src_ctx tgt_ctx + prepare_loop_match_ctx_with_target config span loop_id fixed_ids src_ctx + tgt_ctx in (* Introduce the "identity" abstractions for the loop re-entry. @@ -1928,8 +1928,8 @@ let match_ctx_with_target (config : config) (span : Meta.span) (* Debug *) log#ltrace (lazy - ("match_ctx_with_target: about to introduce the identity abstractions \ - (ii):" ^ "\n\n- src_ctx: " + (__FUNCTION__ ^ ": about to introduce the identity abstractions (ii):" + ^ "\n\n- src_ctx: " ^ eval_ctx_to_string ~span:(Some span) src_ctx ^ "\n\n- tgt_ctx: " ^ eval_ctx_to_string ~span:(Some span) tgt_ctx @@ -2061,13 +2061,21 @@ let match_ctx_with_target (config : config) (span : Meta.span) let tgt_ctx = visit_tgt#visit_eval_ctx () tgt_ctx in + let refreshed_input_sids = + SymbolicValueId.Map.filter + (fun sid _ -> List.mem sid fp_input_svalues) + !src_fresh_sids_map + in + log#ltrace (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs:" + (__FUNCTION__ ^ ": cf_introduce_loop_fp_abs:" ^ "\n- src_fresh_borrows_map:\n" ^ BorrowId.Map.show BorrowId.to_string !src_fresh_borrows_map ^ "\n- src_fresh_sids_map:\n" ^ SymbolicValueId.Map.show SymbolicValueId.to_string !src_fresh_sids_map + ^ "\n- refreshed_input_sids:\n" + ^ SymbolicValueId.Map.show SymbolicValueId.to_string refreshed_input_sids ^ "\n")); sanity_check __FILE__ __LINE__ Config.greedy_expand_symbolics_with_borrows @@ -2130,8 +2138,8 @@ let match_ctx_with_target (config : config) (span : Meta.span) method! visit_borrow_id _ bid = log#ltrace (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: \ - visit_borrow_id: " ^ BorrowId.to_string bid ^ "\n")); + (__FUNCTION__ ^ ": cf_introduce_loop_fp_abs: visit_borrow_id: " + ^ BorrowId.to_string bid ^ "\n")); (* Lookup the id of the loan corresponding to this borrow *) let src_lid = @@ -2140,8 +2148,8 @@ let match_ctx_with_target (config : config) (span : Meta.span) log#ltrace (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: looked up \ - src_lid: " ^ BorrowId.to_string src_lid ^ "\n")); + (__FUNCTION__ ^ ": cf_introduce_loop_fp_abs: looked up src_lid: " + ^ BorrowId.to_string src_lid ^ "\n")); (* Lookup the tgt borrow id to which this borrow was mapped *) let tgt_bid = @@ -2150,15 +2158,15 @@ let match_ctx_with_target (config : config) (span : Meta.span) log#ltrace (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: looked up \ - tgt_bid: " ^ BorrowId.to_string tgt_bid ^ "\n")); + (__FUNCTION__ ^ ": cf_introduce_loop_fp_abs: looked up tgt_bid: " + ^ BorrowId.to_string tgt_bid ^ "\n")); tgt_bid method! visit_loan_id _ id = log#ltrace (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: visit_loan_id: " + (__FUNCTION__ ^ ": cf_introduce_loop_fp_abs: visit_loan_id: " ^ BorrowId.to_string id ^ "\n")); (* Map the borrow - rem.: we mapped the borrows *in the values*, meaning we know how to map the *corresponding loans in the @@ -2271,7 +2279,7 @@ let match_ctx_with_target (config : config) (span : Meta.span) log#ltrace (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: done:\n- result ctx:\n" + (__FUNCTION__ ^ ": cf_introduce_loop_fp_abs: done:\n- result ctx:\n" ^ eval_ctx_to_string ~span:(Some span) tgt_ctx)); (* Sanity check *) @@ -2289,11 +2297,13 @@ let match_ctx_with_target (config : config) (span : Meta.span) (* Compute the loop input values *) log#ltrace (lazy - ("match_ctx_with_target: about to compute the input values:" + (__FUNCTION__ ^ ": about to compute the input values:" ^ "\n- fp_input_svalues: " ^ String.concat ", " (List.map SymbolicValueId.to_string fp_input_svalues) ^ "\n- src_to_tgt_maps:\n" ^ ids_maps_to_string tgt_ctx src_to_tgt_maps + ^ "\n- refreshed_input_sids:\n" + ^ SymbolicValueId.Map.show SymbolicValueId.to_string refreshed_input_sids ^ "\n- src_ctx:\n" ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx:\n" ^ eval_ctx_to_string tgt_ctx ^ "\n")); let input_values = @@ -2305,8 +2315,9 @@ let match_ctx_with_target (config : config) (span : Meta.span) in let res = - if is_loop_entry then EndEnterLoop (loop_id, input_values) - else EndContinue (loop_id, input_values) + if is_loop_entry then + EndEnterLoop (loop_id, input_values, refreshed_input_sids) + else EndContinue (loop_id, input_values, refreshed_input_sids) in ((tgt_ctx, res), cc) diff --git a/src/interp/InterpreterLoopsMatchCtxs.mli b/src/interp/InterpreterLoopsMatchCtxs.mli index cd8073587..591f4f220 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.mli +++ b/src/interp/InterpreterLoopsMatchCtxs.mli @@ -148,7 +148,7 @@ val ctxs_are_equivalent : Meta.span -> ids_sets -> eval_ctx -> eval_ctx -> bool - [src_ctx] *) -val prepare_match_ctx_with_target : +val prepare_loop_match_ctx_with_target : config -> Meta.span -> LoopId.id -> ids_sets -> eval_ctx -> cm_fun (** Match a context with a target context. @@ -297,7 +297,7 @@ val prepare_match_ctx_with_target : - [fixed_ids] - [src_ctx] *) -val match_ctx_with_target : +val loop_match_ctx_with_target : config -> Meta.span -> loop_id -> diff --git a/src/pure/PureUtils.ml b/src/pure/PureUtils.ml index 24a3c568e..fd03758f2 100644 --- a/src/pure/PureUtils.ml +++ b/src/pure/PureUtils.ml @@ -132,6 +132,12 @@ let mk_let (monadic : bool) (lv : typed_pattern) (re : texpression) let ty = next_e.ty in { e; ty } +let mk_lets (monadic : bool) (lets : (typed_pattern * texpression) list) + (next_e : texpression) : texpression = + List.fold_right + (fun (pat, value) (e : texpression) -> mk_let monadic pat value e) + lets next_e + let mk_tag (msg : string) (next_e : texpression) : texpression = let e = Meta (Tag msg, next_e) in let ty = next_e.ty in diff --git a/src/symbolic/PrintSymbolicAst.ml b/src/symbolic/PrintSymbolicAst.ml index 03ce443e2..78fcdcb18 100644 --- a/src/symbolic/PrintSymbolicAst.ml +++ b/src/symbolic/PrintSymbolicAst.ml @@ -80,7 +80,7 @@ let rec expression_to_string (env : fmt_env) (indent : string) let v = value_aggregate_to_string env v in let next = expression_to_string env indent indent_incr next in indent ^ "let " ^ sv ^ " = " ^ v ^ "in\n" ^ next - | ForwardEnd (ret, _, sid_to_value, fwd_end, backs) -> + | ForwardEnd (ret, _, loop_sid_maps, fwd_end, backs) -> let indent1 = indent ^ indent_incr in let indent2 = indent1 ^ indent_incr in let indent3 = indent2 ^ indent_incr in @@ -90,15 +90,18 @@ let rec expression_to_string (env : fmt_env) (indent : string) | Some (_, ret) -> "Some " ^ Values.typed_value_to_string env ret in let ret = "ret = " ^ ret in - let sid_to_value = - match sid_to_value with - | None -> "None" - | Some sid_to_value -> - SymbolicValueId.Map.to_string None - (Values.typed_value_to_string env) - sid_to_value + let sid_to_value, refreshed_sids = + match loop_sid_maps with + | None -> ("None", "None") + | Some (sid_to_value, refreshed_sids) -> + ( SymbolicValueId.Map.to_string None + (Values.typed_value_to_string env) + sid_to_value, + SymbolicValueId.Map.to_string None SymbolicValueId.to_string + refreshed_sids ) in let sid_to_value = "sid_to_value = " ^ sid_to_value in + let refreshed_sids = "refreshed_sids = " ^ refreshed_sids in let fwd_end = expression_to_string env indent2 indent_incr fwd_end in let backs = @@ -107,8 +110,9 @@ let rec expression_to_string (env : fmt_env) (indent : string) backs in indent ^ "forward_end {\n" ^ indent1 ^ ret ^ "\n" ^ indent1 ^ sid_to_value - ^ "\n" ^ indent1 ^ "fwd_end =\n" ^ fwd_end ^ "\n" ^ indent1 ^ "backs =\n" - ^ indent1 ^ backs ^ "\n" ^ indent ^ "}" + ^ "\n" ^ indent1 ^ refreshed_sids ^ "\n" ^ indent1 ^ "fwd_end =\n" + ^ fwd_end ^ "\n" ^ indent1 ^ "backs =\n" ^ indent1 ^ backs ^ "\n" ^ indent + ^ "}" | Loop loop -> loop_to_string env indent indent_incr loop | ReturnWithLoop (loop_id, is_continue) -> indent ^ "return_with_loop (" ^ LoopId.to_string loop_id diff --git a/src/symbolic/SymbolicAst.ml b/src/symbolic/SymbolicAst.ml index 782b29910..1f1a20a51 100644 --- a/src/symbolic/SymbolicAst.ml +++ b/src/symbolic/SymbolicAst.ml @@ -184,22 +184,30 @@ type expression = | ForwardEnd of ((Contexts.eval_ctx[@opaque]) * typed_value) option * (Contexts.eval_ctx[@opaque]) - * typed_value symbolic_value_id_map option + * (typed_value symbolic_value_id_map + * symbolic_value_id 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). The fields are: - - the evaluation context **after we evaluated the return value** - - the value consumed by the return variable + - optional: the evaluation context **after we evaluated the return + value** with 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. + - optional maps: + - 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. + - from input symbolic values to refreshed input symbolic value + TODO: this is a technical detail which shouldn't be here - we need + it to introduce intermediate let-bindings in the translation. We + should get rid of this once the translation of loops is cleaned up + and generalized. - 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 diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 1473cb595..49ba84127 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -1169,8 +1169,7 @@ let translate_inst_fun_sig_to_decomposed_fun_type (span : Meta.span option) log#ltrace (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: " + __FUNCTION__ ^ ": " ^ "\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 @@ -1774,14 +1773,14 @@ let fresh_back_vars_for_current_fun (ctx : bs_ctx) fresh_opt_vars back_vars ctx (** IMPORTANT: do not use this one directly, but rather {!symbolic_value_to_texpression} *) -let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : +let lookup_var_for_symbolic_value (id : V.symbolic_value_id) (ctx : bs_ctx) : var option = - match V.SymbolicValueId.Map.find_opt sv.sv_id ctx.sv_to_var with + match V.SymbolicValueId.Map.find_opt id ctx.sv_to_var with | Some v -> Some v | None -> save_error __FILE__ __LINE__ ctx.span ("Could not find var for symbolic value: " - ^ V.SymbolicValueId.to_string sv.sv_id); + ^ V.SymbolicValueId.to_string id); None (** Peel boxes as long as the value is of the form [Box] *) @@ -1791,7 +1790,7 @@ let rec unbox_typed_value (span : Meta.span) (v : V.typed_value) : V.typed_value | V.VAdt av, T.TAdt (T.TBuiltin T.TBox, _) -> ( match av.field_values with | [ bv ] -> unbox_typed_value span bv - | _ -> craise __FILE__ __LINE__ span "Unreachable") + | _ -> internal_error __FILE__ __LINE__ span) | _ -> v (** Translate a symbolic value. @@ -1808,7 +1807,7 @@ let symbolic_value_to_texpression (ctx : bs_ctx) (sv : V.symbolic_value) : if ty_is_unit ty then mk_unit_rvalue else (* Otherwise lookup the variable *) - match lookup_var_for_symbolic_value sv ctx with + match lookup_var_for_symbolic_value sv.sv_id ctx with | Some var -> mk_texpression_from_var var | None -> { @@ -2619,7 +2618,7 @@ let eval_ctx_to_symbolic_assignments_info (ctx : bs_ctx) wants to fail hard. *) Option.iter (fun (var : var) -> push_info var.id name) - (lookup_var_for_symbolic_value sv ctx) + (lookup_var_for_symbolic_value sv.sv_id ctx) | _ -> () end in @@ -2807,12 +2806,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 (return_value, ectx, loop_input_values, e, back_e) -> + | ForwardEnd (return_value, ectx, loop_sid_maps, 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 return_value ectx loop_input_values e back_e ctx + translate_forward_end return_value ectx loop_sid_maps e back_e ctx | Loop loop -> translate_loop loop ctx | Error (span, msg) -> translate_error span msg @@ -3289,9 +3288,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) let next_e = translate_expression e ctx in (* Generate the assignemnts *) let monadic = false in - List.fold_right - (fun (var, value) (e : texpression) -> mk_let monadic var value e) - variables_values next_e + mk_lets monadic variables_values next_e and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) (e : S.expression) (ctx : bs_ctx) (call_id : V.FunCallId.id) @@ -3464,9 +3461,7 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) 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 input_var e) - given_back_inputs next_e + mk_lets monadic given_back_inputs next_e and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) (e : S.expression) (ctx : bs_ctx) (loop_id : V.LoopId.id) @@ -3829,9 +3824,11 @@ and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option) 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 = + (loop_sid_maps : + (V.typed_value S.symbolic_value_id_map + * V.symbolic_value_id 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 @@ -4057,11 +4054,11 @@ and translate_forward_end (return_value : (C.eval_ctx * V.typed_value) option) (* If we are (re-)entering a loop, we need to introduce a call to the forward translation of the loop. *) - match loop_input_values with + match loop_sid_maps with | None -> (* "Regular" case: we reached a return *) translate_end ctx - | Some loop_input_values -> + | Some (loop_input_values_map, refreshed_sids) -> (* Loop *) let loop_id = Option.get ctx.loop_id in @@ -4070,10 +4067,10 @@ and translate_forward_end (return_value : (C.eval_ctx * V.typed_value) option) log#ltrace (lazy - ("translate_forward_end:\n- loop_input_values:\n" + ("translate_forward_end:\n- loop_input_values_map:\n" ^ V.SymbolicValueId.Map.show (typed_value_to_string ctx) - loop_input_values + loop_input_values_map ^ "\n- loop_info.input_svl:\n" ^ Print.list_to_string (symbolic_value_to_string ctx) @@ -4089,7 +4086,7 @@ and translate_forward_end (return_value : (C.eval_ctx * V.typed_value) option) ("translate_forward_end: looking up input_svl: " ^ V.SymbolicValueId.to_string sv.V.sv_id ^ "\n")); - V.SymbolicValueId.Map.find sv.V.sv_id loop_input_values) + V.SymbolicValueId.Map.find sv.V.sv_id loop_input_values_map) loop_info.input_svl in let args = @@ -4182,8 +4179,25 @@ and translate_forward_end (return_value : (C.eval_ctx * V.typed_value) option) { ctx with loops = LoopId.Map.add loop_id loop_info ctx.loops } in + (* Introduce the refreshed input symbolic values *) + let ctx, refreshed_inputs = + List.fold_left_map + (fun ctx (sid, nid) -> + let sv_ty = + (SymbolicValueId.Map.find sid loop_input_values_map).ty + in + let sv : V.symbolic_value = { sv_ty; sv_id = sid } in + let nsv : V.symbolic_value = { sv_ty; sv_id = nid } in + let ctx, nsv = fresh_var_for_symbolic_value nsv ctx in + let sv = symbolic_value_to_texpression ctx sv in + (ctx, (PureUtils.mk_typed_pattern_from_var nsv None, sv))) + ctx + (SymbolicValueId.Map.bindings refreshed_sids) + in + (* Translate the end of the function *) let next_e = translate_end ctx in + let next_e = mk_lets false refreshed_inputs next_e in (* Introduce the call to the loop forward function in the generated AST *) let out_pat = mk_simpl_tuple_pattern out_pats in From 84150b29b24b900c54bb0c75df47d776e460534f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 14:16:57 +0000 Subject: [PATCH 13/23] Fix a printing issue --- src/interp/InterpreterBorrows.ml | 81 +++++++++++++++++++++--- src/interp/InterpreterLoops.ml | 4 +- src/interp/InterpreterLoopsFixedPoint.ml | 20 +++--- src/interp/InterpreterLoopsJoinCtxs.ml | 28 ++++---- src/interp/InterpreterLoopsMatchCtxs.ml | 12 ++-- src/interp/InterpreterUtils.ml | 1 - src/llbc/Print.ml | 40 ++++++------ src/llbc/ValuesUtils.ml | 31 ++++++++- 8 files changed, 152 insertions(+), 65 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 82a88deca..e1d323a9f 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -250,7 +250,7 @@ let give_back_value (config : config) (span : Meta.span) (bid : BorrowId.id) (nv : typed_value) (ctx : eval_ctx) : eval_ctx = (* Sanity check *) exec_assert __FILE__ __LINE__ - (not (loans_in_value nv)) + (not (concrete_loans_in_value nv)) span "Can not end a borrow because the value to give back contains bottom"; exec_assert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions nv)) @@ -884,7 +884,7 @@ let give_back (config : config) (span : Meta.span) (l : BorrowId.id) | Concrete (VMutBorrow (l', tv)) -> (* Sanity check *) sanity_check __FILE__ __LINE__ (l' = l) span; - sanity_check __FILE__ __LINE__ (not (loans_in_value tv)) span; + sanity_check __FILE__ __LINE__ (not (concrete_loans_in_value tv)) span; (* Check that the corresponding loan is somewhere - purely a sanity check *) sanity_check __FILE__ __LINE__ (Option.is_some (lookup_loan_opt span sanity_ek l ctx)) @@ -1657,7 +1657,7 @@ let promote_shared_loan_to_mut_loan (span : Meta.span) (l : BorrowId.id) (* We need to check that there aren't any loans in the value: we should have gotten rid of those already, but it is better to do a sanity check. *) - sanity_check __FILE__ __LINE__ (not (loans_in_value sv)) span; + sanity_check __FILE__ __LINE__ (not (concrete_loans_in_value sv)) span; (* Check there isn't {!Bottom} (this is actually an invariant *) cassert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions sv)) @@ -1733,7 +1733,7 @@ let rec promote_reserved_mut_borrow (config : config) (span : Meta.span) (lazy ("activate_reserved_mut_borrow: resulting value:\n" ^ typed_value_to_string ~span:(Some span) ctx sv)); - sanity_check __FILE__ __LINE__ (not (loans_in_value sv)) span; + sanity_check __FILE__ __LINE__ (not (concrete_loans_in_value sv)) span; sanity_check __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions sv)) span; @@ -1987,6 +1987,7 @@ let abs_is_destructured (span : Meta.span) (destructure_shared_values : bool) let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) (destructure_shared_values : bool) (ctx : eval_ctx) (v : typed_value) : abs list = + log#ltrace (lazy (__FUNCTION__ ^ ": " ^ typed_value_to_string ctx v)); (* Convert the value to a list of avalues *) let absl = ref [] in let push_abs (r_id : RegionId.id) (avalues : typed_avalue list) : unit = @@ -2139,15 +2140,75 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) let av = ALoan (AMutLoan (PNone, bid, ignored None)) in let av = { value = av; ty } in ([ av ], v)) - | VSymbolic _ -> - (* For now, we force all the symbolic values containing borrows to - be eagerly expanded, and we don't support nested borrows *) + | VSymbolic sv -> + (* Check that there are no nested borrows in the symbolic value - + we don't support this case yet *) cassert __FILE__ __LINE__ - (not (value_has_borrows (Some span) ctx v.value)) + (not + (ty_has_nested_borrows (Some span) ctx.type_ctx.type_infos sv.sv_ty)) span "Nested borrows are not supported yet"; - (* Return nothing *) - ([], v) + + (* If we don't need to group the borrows into one region (because the + symbolic value is inside a mutable borrow for instance) check that + none of the regions used by the symbolic value have ended. *) + sanity_check __FILE__ __LINE__ + (group || not (symbolic_value_has_ended_regions ctx.ended_regions sv)) + span; + + (* If we group the borrows: simply introduce a projector. + Otherwise, introduce one abstraction per region *) + if group then + (* Substitute the regions in the type *) + let visitor = + object + inherit [_] map_ty + + method! visit_RVar _ var = + match var with + | Free _ -> RVar (Free r_id) + | Bound _ -> internal_error __FILE__ __LINE__ span + end + in + let ty = visitor#visit_ty () sv.sv_ty in + let nv = ASymbolic (PNone, AProjBorrows (sv, ty, [])) in + let nv : typed_avalue = { value = nv; ty } in + ([ nv ], v) + else + (* Introduce one abstraction per live region *) + let regions = ref RegionId.Map.empty in + + let get_region rid = + (* Introduce a fresh region, if the region is alive *) + if not (RegionId.Set.mem rid ctx.ended_regions) then ( + match RegionId.Map.find_opt rid !regions with + | Some rid -> rid + | None -> + let nrid = fresh_region_id () in + regions := RegionId.Map.add rid nrid !regions; + nrid) + else rid + in + let visitor = + object + inherit [_] map_ty + + method! visit_RVar _ var = + match var with + | Free rid -> RVar (Free (get_region rid)) + | Bound _ -> internal_error __FILE__ __LINE__ span + end + in + let ty = visitor#visit_ty () sv.sv_ty in + (* Introduce the abstractions *) + RegionId.Map.iter + (fun _ rid -> + let nv = ASymbolic (PNone, AProjBorrows (sv, ty, [])) in + let nv : typed_avalue = { value = nv; ty } in + push_abs rid [ nv ]) + !regions; + ([], v) in + (* Generate the avalues *) let r_id = fresh_region_id () in let values, _ = to_avalues true false false r_id v in diff --git a/src/interp/InterpreterLoops.ml b/src/interp/InterpreterLoops.ml index 33c66ddda..a99a1cf37 100644 --- a/src/interp/InterpreterLoops.ml +++ b/src/interp/InterpreterLoops.ml @@ -361,9 +361,9 @@ let eval_loop_symbolic (config : config) (span : span) log#ltrace (lazy ("eval_loop_symbolic: result:" ^ "\n- src context:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx ^ "\n- fixed point:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) fp_ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false fp_ctx ^ "\n- fixed_sids: " ^ SymbolicValueId.Set.show fixed_ids.sids ^ "\n- fresh_sids: " diff --git a/src/interp/InterpreterLoopsFixedPoint.ml b/src/interp/InterpreterLoopsFixedPoint.ml index 6f98970ea..41ea669d3 100644 --- a/src/interp/InterpreterLoopsFixedPoint.ml +++ b/src/interp/InterpreterLoopsFixedPoint.ml @@ -401,9 +401,9 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) (lazy ("compute_loop_entry_fixed_point: after prepare_ashared_loans:" ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx0 + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx0 ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx ^ "\n\n")); (* The fixed ids. They are the ids of the original ctx, after we ended @@ -538,13 +538,13 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) (lazy ("compute_fixed_point: about to join with continue_ctx" ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx ^ "\n\n" ^ String.concat "\n\n" (List.map (fun ctx -> "- continue_ctx:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx) + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx) continue_ctxs) ^ "\n\n")); @@ -556,9 +556,9 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) log#ltrace (lazy ("compute_fixed_point: after joining continue ctxs" ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx1 + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx1 ^ "\n\n")); (* Check if we reached a fixed point: if not, iterate *) @@ -571,7 +571,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) (lazy ("compute_fixed_point: fixed point computed before matching with input \ region groups:" ^ "\n\n- fp:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) fp + ^ eval_ctx_to_string ~span:(Some span) ~filter:false fp ^ "\n\n")); (* Make sure we have exactly one loop abstraction per function region (merge @@ -828,7 +828,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) (lazy ("compute_fixed_point: fixed point after matching with the function \ region groups:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) fp_test)); + ^ eval_ctx_to_string ~span:(Some span) ~filter:false fp_test)); compute_fixed_point fp_test 1 1 in @@ -1146,9 +1146,9 @@ let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) log#ltrace (lazy ("compute_fp_ctx_symbolic_values:" ^ "\n- src context:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx ^ "\n- fixed point:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) fp_ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false fp_ctx ^ "\n- fresh_sids: " ^ SymbolicValueId.Set.show fresh_sids ^ "\n- input_svalues: " diff --git a/src/interp/InterpreterLoopsJoinCtxs.ml b/src/interp/InterpreterLoopsJoinCtxs.ml index 5b52d5a53..45b320c3f 100644 --- a/src/interp/InterpreterLoopsJoinCtxs.ml +++ b/src/interp/InterpreterLoopsJoinCtxs.ml @@ -280,7 +280,8 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) (* Debug *) log#ltrace (lazy - ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx0:\n" + (__FUNCTION__ ^ ":\n\n- fixed_ids:\n" ^ show_ids_sets old_ids + ^ "\n\n- ctx0:\n" ^ eval_ctx_to_string ~span:(Some span) ctx0 ^ "\n\n")); @@ -316,14 +317,15 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) let ctx = { ctx0 with env } in log#ltrace (lazy - ("reduce_ctx: after converting values to abstractions:\n" + (__FUNCTION__ ^ ": after converting values to abstractions:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); log#ltrace (lazy - ("reduce_ctx: after decomposing the shared values in the abstractions:\n" + (__FUNCTION__ + ^ ": after decomposing the shared values in the abstractions:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); @@ -384,7 +386,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) | abs_id1 :: _ -> log#ltrace (lazy - ("reduce_ctx: merging abstraction " + (__FUNCTION__ ^ ": merging abstraction " ^ AbstractionId.to_string abs_id1 ^ " into " ^ AbstractionId.to_string abs_id0 @@ -422,7 +424,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) (* Debugging *) log#ltrace (lazy - ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids + (__FUNCTION__ ^ ":\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after reduce:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); @@ -433,7 +435,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) log#ltrace (lazy - ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids + (__FUNCTION__ ^ ":\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after reduce and reorder borrows/loans and abstractions:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); @@ -468,7 +470,7 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) (* Debug *) log#ltrace (lazy - ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids + (__FUNCTION__ ^ ":\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- initial ctx:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); @@ -632,7 +634,7 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) log#ltrace (lazy - ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids + (__FUNCTION__ ^ ":\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after collapse:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); @@ -643,7 +645,7 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id) log#ltrace (lazy - ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids + (__FUNCTION__ ^ ":\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after collapse and reorder borrows/loans:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); @@ -875,9 +877,9 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (lazy ("join_ctxs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx0 + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx0 ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx1 + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx1 ^ "\n\n")); let env0 = List.rev ctx0.env in @@ -891,10 +893,10 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (lazy ("join_suffixes:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) + ^ eval_ctx_to_string ~span:(Some span) ~filter:false { ctx0 with env = List.rev env0 } ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) + ^ eval_ctx_to_string ~span:(Some span) ~filter:false { ctx1 with env = List.rev env1 } ^ "\n\n")); diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index 650413764..e4f398d05 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -1449,9 +1449,9 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (lazy ("match_ctxs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx0 + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx0 ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx1 + ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx1 ^ "\n\n")); (* Initialize the maps and instantiate the matcher *) @@ -1583,10 +1583,10 @@ let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) ^ "\n- aid_map: " ^ AbstractionId.InjSubst.show_t !aid_map ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) + ^ eval_ctx_to_string ~span:(Some span) ~filter:false { ctx0 with env = List.rev env0 } ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~span:(Some span) + ^ eval_ctx_to_string ~span:(Some span) ~filter:false { ctx1 with env = List.rev env1 } ^ "\n\n")); @@ -1934,9 +1934,9 @@ let loop_match_ctx_with_target (config : config) (span : Meta.span) ^ "\n\n- tgt_ctx: " ^ eval_ctx_to_string ~span:(Some span) tgt_ctx ^ "\n\n- filt_tgt_ctx: " - ^ eval_ctx_to_string_no_filter ~span:(Some span) filt_tgt_ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false filt_tgt_ctx ^ "\n\n- filt_src_ctx: " - ^ eval_ctx_to_string_no_filter ~span:(Some span) filt_src_ctx + ^ eval_ctx_to_string ~span:(Some span) ~filter:false filt_src_ctx ^ "\n\n- new_absl:\n" ^ eval_ctx_to_string ~span:(Some span) { src_ctx with env = List.map (fun abs -> EAbs abs) new_absl } diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index c33a196f7..70dbfa8d5 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -15,7 +15,6 @@ let log = Logging.interpreter_log (** Some utilities *) -let eval_ctx_to_string_no_filter = Print.Contexts.eval_ctx_to_string_no_filter let eval_ctx_to_string = Print.Contexts.eval_ctx_to_string let name_to_string = Print.EvalCtx.name_to_string let symbolic_value_to_string = Print.EvalCtx.symbolic_value_to_string diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index 072e50a0c..81dab6788 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -456,13 +456,14 @@ module Contexts = struct (** Filters "dummy" bindings from an environment, to gain space and clarity/ See [env_to_string]. *) - let filter_env (env : env) : env_elem option list = + let filter_env (ended_regions : RegionId.Set.t) (env : env) : + env_elem option list = (* We filter: - * - non-dummy bindings which point to ⊥ - * - dummy bindings which don't contain loans nor borrows - * Note that the first case can sometimes be confusing: we may try to improve - * it... - *) + - non-dummy bindings which point to ⊥ + - dummy bindings which don't contain loans nor borrows + Note that the first case can sometimes be confusing: we may try to improve + it... + *) let filter_elem (ev : env_elem) : env_elem option = match ev with | EBinding (BVar _, tv) -> @@ -470,7 +471,9 @@ module Contexts = struct if is_bottom tv.value then None else Some ev | EBinding (BDummy _, tv) -> (* Dummy binding: check if the value contains borrows or loans *) - if borrows_in_value tv || loans_in_value tv then Some ev else None + if value_has_non_ended_borrows_or_loans ended_regions tv.value then + Some ev + else None | _ -> Some ev in let env = List.map filter_elem env in @@ -490,10 +493,11 @@ module Contexts = struct [with_var_types]: if true, print the type of the variables *) let env_to_string ?(span : Meta.span option = None) (filter : bool) - (fmt_env : fmt_env) (verbose : bool) (with_var_types : bool) (env : env) : - string = + (fmt_env : fmt_env) (verbose : bool) (with_var_types : bool) + (ended_regions : RegionId.Set.t) (env : env) : string = let env = - if filter then filter_env env else List.map (fun ev -> Some ev) env + if filter then filter_env ended_regions env + else List.map (fun ev -> Some ev) env in "{\n" ^ String.concat "\n" @@ -577,8 +581,9 @@ module Contexts = struct let frames = split_aux [] [] env in frames - let eval_ctx_to_string_gen ?(span : Meta.span option = None) (verbose : bool) - (filter : bool) (with_var_types : bool) (ctx : eval_ctx) : string = + let eval_ctx_to_string ?(span : Meta.span option = None) + ?(verbose : bool = false) ?(filter : bool = true) + ?(with_var_types : bool = true) (ctx : eval_ctx) : string = let fmt_env = eval_ctx_to_fmt_env ctx in let ended_regions = RegionId.Set.to_string None ctx.ended_regions in let frames = split_env_according_to_frames ctx.env in @@ -601,20 +606,13 @@ module Contexts = struct ^ string_of_int !num_bindings ^ "\n- dummy bindings: " ^ string_of_int !num_dummies ^ "\n- abstractions: " ^ string_of_int !num_abs ^ "\n" - ^ env_to_string ~span filter fmt_env verbose with_var_types f + ^ env_to_string ~span filter fmt_env verbose with_var_types + ctx.ended_regions f ^ "\n") frames in "# Ended regions: " ^ ended_regions ^ "\n" ^ "# " ^ string_of_int num_frames ^ " frame(s)\n" ^ String.concat "" frames - - let eval_ctx_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) : - string = - eval_ctx_to_string_gen ~span false true true ctx - - let eval_ctx_to_string_no_filter ?(span : Meta.span option = None) - (ctx : eval_ctx) : string = - eval_ctx_to_string_gen ~span false false true ctx end (** Pretty-printing for LLBC ASTs (functions based on an evaluation context) *) diff --git a/src/llbc/ValuesUtils.ml b/src/llbc/ValuesUtils.ml index 83f1b6bef..8667b0bd3 100644 --- a/src/llbc/ValuesUtils.ml +++ b/src/llbc/ValuesUtils.ml @@ -100,7 +100,7 @@ let mk_aproj_loans (pm : proj_marker) (sv : symbolic_value) (proj_ty : ty) = (** Check if a value contains a *concrete* borrow (i.e., a [Borrow] value - we don't check if there are borrows hidden in symbolic values). *) -let borrows_in_value (v : typed_value) : bool = +let concrete_borrows_in_value (v : typed_value) : bool = let obj = object inherit [_] iter_typed_value @@ -132,7 +132,7 @@ let reserved_in_value (v : typed_value) : bool = (** Check if a value contains a loan (which is necessarily *concrete*: symbolic values can't "hide" loans). *) -let loans_in_value (v : typed_value) : bool = +let concrete_loans_in_value (v : typed_value) : bool = let obj = object inherit [_] iter_typed_value @@ -259,6 +259,33 @@ let value_has_borrows span (infos : TypesAnalysis.type_infos) (v : value) : bool false with Found -> true +let value_has_non_ended_borrows_or_loans (ended_regions : RegionId.Set.t) + (v : value) : bool = + let ty_visitor = + object + inherit [_] iter_ty + + method! visit_RVar _ region = + match region with + | Free rid -> + if not (RegionId.Set.mem rid ended_regions) then raise Found else () + | Bound _ -> () + end + in + let value_visitor = + object + inherit [_] iter_typed_value + method! visit_borrow_content _ _ = raise Found + method! visit_loan_content _ _ = raise Found + method! visit_symbolic_value _ sv = ty_visitor#visit_ty () sv.sv_ty + end + in + (* We use exceptions *) + try + value_visitor#visit_value () v; + false + with Found -> true + (** Check if a value has loans. Note that loans are necessarily concrete (there can't be loans hidden From f0c4264858deabb2a7104f68677c69a833f75bf5 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 14:30:25 +0000 Subject: [PATCH 14/23] Improve formatting --- src/interp/InterpreterBorrows.ml | 18 ++++++++---------- src/interp/InterpreterBorrowsCore.ml | 8 ++++++++ 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index e1d323a9f..48b538c89 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -2632,7 +2632,7 @@ let abs_split_markers (span : Meta.span) (ctx : eval_ctx) (abs : abs) : abs = let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) (merge_funs : merge_duplicates_funcs option) (ctx : eval_ctx) (abs0 : abs) (abs1 : abs) : typed_avalue list = - log#ltrace (lazy "merge_abstractions_merge_loan_borrow_pairs"); + log#ltrace (lazy __FUNCTION__); (* Split the markers inside the abstractions (if we allow using markers). @@ -2744,14 +2744,14 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) let push_borrow_avalue av = log#ltrace (lazy - ("merge_abstractions_merge_loan_borrow_pairs: push_borrow_avalue: " + (__FUNCTION__ ^ ": push_borrow_avalue: " ^ typed_avalue_to_string ~span:(Some span) ctx av)); borrow_avalues := av :: !borrow_avalues in let push_loan_avalue av = log#ltrace (lazy - ("merge_abstractions_merge_loan_borrow_pairs: push_loan_avalue: " + (__FUNCTION__ ^ ": push_loan_avalue: " ^ typed_avalue_to_string ~span:(Some span) ctx av)); loan_avalues := av :: !loan_avalues in @@ -2840,8 +2840,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) | Borrow marked -> log#ltrace (lazy - ("merge_abstractions: merging borrow " - ^ Marked.to_string marked)); + (__FUNCTION__ ^ ": merging borrow: " ^ Marked.to_string marked)); (* Check if the borrow has already been merged - this can happen because we go through all the borrows/loans in [abs0] *then* @@ -2883,8 +2882,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) (* Do not set the loans as merged yet *) log#ltrace (lazy - ("merge_abstractions: merging loan " - ^ Marked.to_string marked)); + (__FUNCTION__ ^ ": merging loan: " ^ Marked.to_string marked)); (* Check if we need to filter it *) if Marked.filter_marked marked then () else @@ -2981,7 +2979,7 @@ let merge_abstractions_merge_loan_borrow_pairs (span : Meta.span) type borrow_content = ty * proj_marker * aproj type loan_content = ty * proj_marker * aproj - let to_string = MarkedNormSymbProj.to_string + let to_string = marked_norm_symb_proj_to_string ctx let borrow_is_merged = borrow_proj_is_merged let loan_is_merged = loan_proj_is_merged let filter_marked = filter_symbolic @@ -3021,7 +3019,7 @@ let merge_abstractions_merge_markers (span : Meta.span) typed_avalue list = log#ltrace (lazy - ("merge_abstractions_merge_markers:\n- avalues:\n" + (__FUNCTION__ ^ ":\n- avalues:\n" ^ String.concat ", " (List.map (typed_avalue_to_string ctx) avalues))); (* We linearly traverse the list of avalues created through the first phase. *) @@ -3047,7 +3045,7 @@ let merge_abstractions_merge_markers (span : Meta.span) let push_avalue av = log#ltrace (lazy - ("merge_abstractions_merge_markers: push_avalue: " + (__FUNCTION__ ^ ": push_avalue: " ^ typed_avalue_to_string ~span:(Some span) ctx av)); avalues := av :: !avalues in diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index b97234f8d..6e0946feb 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -1363,6 +1363,14 @@ type marked_norm_symb_proj = { } [@@deriving show, ord] +let marked_norm_symb_proj_to_string (ctx : eval_ctx) (p : marked_norm_symb_proj) + : string = + let { pm; sv_id; norm_proj_ty } = p in + Print.Values.symbolic_value_id_to_pretty_string sv_id + ^ " <: " + ^ ty_to_string ctx norm_proj_ty + |> Print.Values.add_proj_marker pm + module MarkedNormSymbProjOrd = struct type t = marked_norm_symb_proj From c78fae94f8d4e2c59e409f83c1cf4e09ec53b5ba Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 15:17:08 +0000 Subject: [PATCH 15/23] Improve formatting --- src/interp/InterpreterBorrows.ml | 24 ++++++++++++++++-------- src/interp/InterpreterLoops.ml | 12 ++++++------ src/interp/InterpreterLoopsFixedPoint.ml | 23 +++++++++++------------ src/interp/InterpreterLoopsMatchCtxs.ml | 21 +++++++++++++++++---- 4 files changed, 50 insertions(+), 30 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 48b538c89..075684620 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -1985,7 +1985,7 @@ let abs_is_destructured (span : Meta.span) (destructure_shared_values : bool) abs = abs' let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) - (can_end : bool) (destructure_shared_values : bool) (ctx : eval_ctx) + ~(can_end : bool) ~(destructure_shared_values : bool) (ctx : eval_ctx) (v : typed_value) : abs list = log#ltrace (lazy (__FUNCTION__ ^ ": " ^ typed_value_to_string ctx v)); (* Convert the value to a list of avalues *) @@ -2021,8 +2021,8 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) loan, we need to compute the value which will be shared. If [destructure_shared_values] is [true], this shared value will be stripped of its shared loans. *) - let rec to_avalues (allow_borrows : bool) (inside_borrowed : bool) - (group : bool) (r_id : RegionId.id) (v : typed_value) : + let rec to_avalues ~(allow_borrows : bool) ~(inside_borrowed : bool) + ~(group : bool) (r_id : RegionId.id) (v : typed_value) : typed_avalue list * typed_value = (* Debug *) log#ltrace @@ -2046,7 +2046,7 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) let avl, field_values = List.split (List.map - (to_avalues allow_borrows inside_borrowed group r_id) + (to_avalues ~allow_borrows ~inside_borrowed ~group r_id) adt.field_values) in (List.concat avl, field_values) @@ -2057,7 +2057,7 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (fun fv -> let r_id = fresh_region_id () in let avl, fv = - to_avalues allow_borrows inside_borrowed group r_id fv + to_avalues ~allow_borrows ~inside_borrowed ~group r_id fv in push_abs r_id avl; fv) @@ -2096,7 +2096,10 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) let av = { value = av; ty } in (* Continue exploring, looking for loans (and forbidding borrows, because we don't support nested borrows for now) *) - let avl, bv = to_avalues false true true r_id bv in + let avl, bv = + to_avalues ~allow_borrows:false ~inside_borrowed:true ~group:true + r_id bv + in let value = { v with value = VBorrow (VMutBorrow (bid, bv)) } in (av :: avl, value) | VReservedMutBorrow _ -> @@ -2118,7 +2121,10 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (* For avalues, a loan has the type borrow (see the comments in [avalue]) *) let ty = mk_ref_ty (RVar (Free r_id)) ty RShared in (* Rem.: the shared value might contain loans *) - let avl, sv = to_avalues false true true r_id sv in + let avl, sv = + to_avalues ~allow_borrows:false ~inside_borrowed:true ~group:true + r_id sv + in let av = ALoan (ASharedLoan (PNone, bids, sv, ignored)) in let av = { value = av; ty } in (* Continue exploring, looking for loans (and forbidding borrows, @@ -2211,7 +2217,9 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (* Generate the avalues *) let r_id = fresh_region_id () in - let values, _ = to_avalues true false false r_id v in + let values, _ = + to_avalues ~allow_borrows:true ~inside_borrowed:false ~group:false r_id v + in (* Introduce an abstraction for the returned values *) push_abs r_id values; (* Return *) diff --git a/src/interp/InterpreterLoops.ml b/src/interp/InterpreterLoops.ml index a99a1cf37..77b93917d 100644 --- a/src/interp/InterpreterLoops.ml +++ b/src/interp/InterpreterLoops.ml @@ -309,7 +309,7 @@ let eval_loop_symbolic (config : config) (span : span) (* Debug *) log#ltrace (lazy - ("eval_loop_symbolic:\nContext:\n" + (__FUNCTION__ ^ ":\nContext:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); @@ -324,7 +324,7 @@ let eval_loop_symbolic (config : config) (span : span) (* Debug *) log#ltrace (lazy - ("eval_loop_symbolic:\nInitial context:\n" + (__FUNCTION__ ^ ":\nInitial context:\n" ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\nFixed point:\n" ^ eval_ctx_to_string ~span:(Some span) fp_ctx)); @@ -349,8 +349,8 @@ let eval_loop_symbolic (config : config) (span : span) log#ltrace (lazy - "eval_loop_symbolic: matched the fixed-point context with the original \ - context."); + (__FUNCTION__ + ^ ": matched the fixed-point context with the original context.")); (* Synthesize the loop body *) let resl_loop_body, cf_loop_body = @@ -360,7 +360,7 @@ let eval_loop_symbolic (config : config) (span : span) log#ltrace (lazy - ("eval_loop_symbolic: result:" ^ "\n- src context:\n" + (__FUNCTION__ ^ ": result:" ^ "\n- src context:\n" ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx ^ "\n- fixed point:\n" ^ eval_ctx_to_string ~span:(Some span) ~filter:false fp_ctx @@ -388,7 +388,7 @@ let eval_loop_symbolic (config : config) (span : span) let abs = ctx_lookup_abs fp_ctx abs_id in log#ltrace (lazy - ("eval_loop_symbolic: compute_abs_given_back_tys:\n- abs:\n" + (__FUNCTION__ ^ ": compute_abs_given_back_tys:\n- abs:\n" ^ abs_to_string span ~with_ended:true ctx abs ^ "\n")); diff --git a/src/interp/InterpreterLoopsFixedPoint.ml b/src/interp/InterpreterLoopsFixedPoint.ml index 41ea669d3..addbb7663 100644 --- a/src/interp/InterpreterLoopsFixedPoint.ml +++ b/src/interp/InterpreterLoopsFixedPoint.ml @@ -399,8 +399,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) (* Debug *) log#ltrace (lazy - ("compute_loop_entry_fixed_point: after prepare_ashared_loans:" - ^ "\n\n- ctx0:\n" + (__FUNCTION__ ^ ": after prepare_ashared_loans:" ^ "\n\n- ctx0:\n" ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx0 ^ "\n\n- ctx1:\n" ^ eval_ctx_to_string ~span:(Some span) ~filter:false ctx @@ -416,7 +415,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) context (the context at the loop entry, after we called {!prepare_ashared_loans}, if this is the first iteration) *) let join_ctxs (ctx1 : eval_ctx) (ctxs : eval_ctx list) : eval_ctx = - log#ltrace (lazy "compute_loop_entry_fixed_point: join_ctxs"); + log#ltrace (lazy (__FUNCTION__ ^ ": join_ctxs")); (* If this is the first iteration, end the borrows/loans/abs which appear in ctx1 and not in the other contexts, then compute the set of fixed ids. This means those borrows/loans have to end @@ -445,8 +444,9 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) (* End the borrows/abs in [ctx1] *) log#ltrace (lazy - ("compute_loop_entry_fixed_point: join_ctxs: ending \ - borrows/abstractions before entering the loop:\n\ + (__FUNCTION__ + ^ ": join_ctxs: ending borrows/abstractions before entering the \ + loop:\n\ - ending borrow ids: " ^ BorrowId.Set.to_string None blids ^ "\n- ending abstraction ids: " @@ -474,7 +474,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) in ctx2 in - log#ltrace (lazy "compute_loop_entry_fixed_point: after join_ctxs"); + log#ltrace (lazy (__FUNCTION__ ^ ": after join_ctxs")); (* Compute the set of fixed ids - for the symbolic ids, we compute the intersection of ids between the original environment and the list @@ -515,8 +515,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) let ctx_resl, _ = eval_loop_body ctx in (* Keep only the contexts which reached a `continue`. *) let keep_continue_ctx (ctx, res) = - log#ltrace - (lazy "compute_loop_entry_fixed_point: register_continue_ctx"); + log#ltrace (lazy (__FUNCTION__ ^ ": register_continue_ctx")); match res with | Return | Panic | Break _ -> None | Unit -> @@ -621,7 +620,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) fp_ended_aids := RegionGroupId.Map.add rg_id aids !fp_ended_aids in let end_at_return (ctx, res) = - log#ltrace (lazy "compute_loop_entry_fixed_point: cf_loop"); + log#ltrace (lazy (__FUNCTION__ ^ ": cf_loop")); match res with | Continue _ | Panic -> () | Break _ -> @@ -633,7 +632,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) *) craise __FILE__ __LINE__ span "Unreachable" | Return -> - log#ltrace (lazy "compute_loop_entry_fixed_point: cf_loop: Return"); + log#ltrace (lazy (__FUNCTION__ ^ ": cf_loop: Return")); (* Should we consume the return value and pop the frame? * If we check in [Interpreter] that the loop abstraction we end is * indeed the correct one, I think it is sound to under-approximate here @@ -755,8 +754,8 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) try log#ltrace (lazy - ("compute_loop_entry_fixed_point: merge FP \ - abstraction: " ^ AbstractionId.to_string id ^ " into " + (__FUNCTION__ ^ ": merge FP abstraction: " + ^ AbstractionId.to_string id ^ " into " ^ AbstractionId.to_string !id0)); (* Note that we merge *into* [id0] *) let fp', id0' = diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index e4f398d05..56f7811f3 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -43,6 +43,8 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) - however, when computing the mapping from region abstractions to the borrow ids they contain, this time we do map abstraction ids to sets which can compute strictly more than one value + Also: note that it is possible to copy symbolic values containing borrows + (if those borrows are shared borrows for instance). *) let register_mapping (check_singleton_sets : bool) (map : S.t M.t ref) (id0 : M.key) (id1 : S.elt) : unit = @@ -90,6 +92,19 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in let proj : marked_norm_symb_proj = { pm; sv_id = sv.sv_id; norm_proj_ty } in RAbsSymbProj.register_mapping false abs_to_borrow_projs abs.abs_id proj; + (* This mapping is not generally injective as it is possible to copy symbolic values. + For now we still force it to be injective because we don't handle well the case + when we join contexts where symbolic values have been copied. + A more general, easy-to-implement solution would be to freshen the copied + symbolic values like so (when copying symbolic values containing borrows): + {[ + // x ~> s0 + y = copy x + // x ~> s1 + // y ~> s2 + // abs { proj_borrows s0, proj_loans s1, proj_loans s2 } + ]} + *) RSymbProjAbs.register_mapping true borrow_proj_to_abs proj abs.abs_id in let register_loan_proj abs pm (sv : symbolic_value) (proj_ty : ty) = @@ -954,12 +969,10 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct | None -> (* Convert the value to an abstraction *) let abs_kind : abs_kind = Loop (S.loop_id, None, LoopSynthInput) in - let can_end = true in - let destructure_shared_values = true in let ctx = if value_is_left then ctx0 else ctx1 in let absl = - convert_value_to_abstractions span abs_kind can_end - destructure_shared_values ctx v + convert_value_to_abstractions span abs_kind ~can_end:true + ~destructure_shared_values:true ctx v in (* Add a marker to the abstraction indicating the provenance of the value *) let pm = if value_is_left then PLeft else PRight in From 7edfc20f25de5ddcbfa01dba5a2ee7eda9672c3c Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 18:30:20 +0000 Subject: [PATCH 16/23] Fix issues with the fixed-point computations and the invariant checks --- src/interp/InterpreterBorrows.ml | 215 ++++++++++++++++++++-- src/interp/InterpreterBorrows.mli | 27 ++- src/interp/InterpreterBorrowsCore.ml | 99 ++++++++++ src/interp/InterpreterLoops.ml | 41 +++-- src/interp/InterpreterLoopsFixedPoint.ml | 125 +------------ src/interp/InterpreterLoopsFixedPoint.mli | 12 -- src/interp/InterpreterLoopsJoinCtxs.ml | 48 +++-- src/interp/InterpreterLoopsMatchCtxs.ml | 11 +- src/interp/InterpreterStatements.ml | 6 +- src/interp/InterpreterUtils.ml | 2 + src/interp/Invariants.ml | 126 ++++++++----- src/llbc/ValuesUtils.ml | 4 +- 12 files changed, 477 insertions(+), 239 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 075684620..2ace641a6 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -1824,9 +1824,24 @@ let destructure_abs (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) sanity_check __FILE__ __LINE__ (opt_bid = None) span; (* Simply explore the child *) list_avalues false push_fail child_av + | AEndedSharedLoan (sv, child_av) -> + (* We don't support nested borrows for now *) + cassert __FILE__ __LINE__ + (not + (ty_has_borrows (Some span) ctx.type_ctx.type_infos child_av.ty)) + span "Nested borrows are not supported yet"; + (* Explore the shared value *) + (* Destructure the shared value *) + let avl, _ = + if destructure_shared_values then list_values sv else ([], sv) + in + (* Explore the child *) + list_avalues false push_fail child_av; + (* Push the avalues introduced because we decomposed the inner loans + in the shared value - see the ASharedLoan case *) + List.iter push avl | AEndedMutLoan { child = child_av; given_back = _; given_back_meta = _ } - | AEndedSharedLoan (_, child_av) | AEndedIgnoredMutLoan { child = child_av; given_back = _; given_back_meta = _ } | AIgnoredSharedLoan child_av -> @@ -1984,6 +1999,152 @@ let abs_is_destructured (span : Meta.span) (destructure_shared_values : bool) in abs = abs' +exception FoundBorrowId of BorrowId.id +exception FoundAbsId of AbstractionId.id + +(** Find the first endable loan projector in an abstraction. + + An endable loan projector is a loan projector over a symbolic value + which doesn't appear anywhere else in the context. + *) +let find_first_endable_loan_proj_in_abs (span : Meta.span) (ctx : eval_ctx) + (abs : abs) : unit = + let visitor = + object + inherit [_] iter_abs as super + + method! visit_aproj env proj = + match proj with + | AProjLoans (sv, proj_ty, _) -> + (* Check if there are borrow projectors in the context *) + let explore_shared = false in + begin + match + lookup_intersecting_aproj_borrows_opt span explore_shared + abs.regions.owned sv proj_ty ctx + with + | None -> + (* No intersecting projections: we can end this loan projector *) + raise (FoundAbsProj (abs.abs_id, sv)) + | Some _ -> + (* There are intersecting projections: we can't end this loan projector *) + super#visit_aproj env proj + end + | AProjBorrows _ | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> + super#visit_aproj env proj + end + in + (* Visit *) + visitor#visit_abs () abs + +(* Repeat until we can't simplify the context anymore: + - end the borrows which appear in anonymous values and don't contain loans + - end the region abstractions which can be ended (no loans) + - replace the values in anonymous values with bottom whenever possible + (the value is not inside a borrow/loan and doesn't itself contain borrows/loans) + - end the loan projectors inside region abstractions when the corresponding + symbolic value doesn't appear anywhere else in the context + However we ignore the "fixed" abstractions. +*) +let rec simplify_dummy_values_useless_abs_aux (config : config) + (span : Meta.span) ~(simplify_abs : bool) + (fixed_abs_ids : AbstractionId.Set.t) : cm_fun = + fun ctx -> + (* Small utility: check that the loan corresponding to a borrow + does not belong to an abstraction in the fixed set. + *) + let loan_id_not_in_fixed_abs (lid : BorrowId.id) : bool = + match fst (lookup_loan span ek_all lid ctx) with + | AbsId abs_id -> not (AbstractionId.Set.mem abs_id fixed_abs_ids) + | _ -> true + in + let rec explore_env (ctx : eval_ctx) (env : env) : env = + match env with + | [] -> [] (* Done *) + | EBinding (BDummy vid, v) :: env -> + (* If the symbolic value doesn't contain concrete borrows or loans + we simply ignore it *) + if not (concrete_borrows_loans_in_value v.value) then + explore_env ctx env + else + (* Explore the anonymous value - raises an exception if it finds + a borrow to end *) + let visitor = + object + inherit [_] map_typed_value as super + method! visit_VLoan _ lc = VLoan lc (* Don't enter inside loans *) + + method! visit_VBorrow _ bc = + (* Check if we can end the borrow, do not enter inside if we can't *) + match bc with + | VSharedBorrow bid | VReservedMutBorrow bid -> + if loan_id_not_in_fixed_abs bid then + raise (FoundBorrowId bid) + else VBorrow bc + | VMutBorrow (bid, v) -> + if + (not (concrete_loans_in_value v)) + && loan_id_not_in_fixed_abs bid + then raise (FoundBorrowId bid) + else (* Stop there *) + VBorrow bc + + (* If no concrete borrows/loans: replace with bottow *) + method! visit_value _ v = + if not (concrete_borrows_loans_in_value v) then VBottom + else super#visit_value () v + end + in + let v = visitor#visit_typed_value () v in + (* No exception was raised: continue *) + EBinding (BDummy vid, v) :: explore_env ctx env + | EAbs abs :: env + when simplify_abs && abs.can_end + && not (AbstractionId.Set.mem abs.abs_id fixed_abs_ids) -> ( + (* Check if it is possible to end the abstraction: if yes, raise an exception *) + let opt_loan = get_first_non_ignored_aloan_in_abstraction span abs in + match opt_loan with + | None -> + (* No remaining loans: we can end the abstraction *) + raise (FoundAbsId abs.abs_id) + | Some _ -> + (* There are remaining loans: we can't end the abstraction *) + (* Check if we can end some loan projectors *) + find_first_endable_loan_proj_in_abs span ctx abs; + (* Continue *) + EAbs abs :: explore_env ctx env) + | b :: env -> b :: explore_env ctx env + in + let rec_call = + simplify_dummy_values_useless_abs_aux config span ~simplify_abs + fixed_abs_ids + in + try + (* Explore the environment *) + ({ ctx with env = explore_env ctx ctx.env }, fun e -> e) + with + | FoundAbsId abs_id -> + let ctx, cc = end_abstraction config span abs_id ctx in + comp cc (rec_call ctx) + | FoundBorrowId bid -> + let ctx, cc = end_borrow config span bid ctx in + comp cc (rec_call ctx) + | FoundAbsProj (abs_id, sv) -> + (* We can end this loan projector (there are no corresponding borrows + projectors in the context): set it as ended and continue *) + let ctx = update_aproj_loans_to_ended span abs_id sv ctx in + rec_call ctx + +let simplify_dummy_values_useless_abs (config : config) (span : Meta.span) + ~(simplify_abs : bool) (fixed_abs_ids : AbstractionId.Set.t) : cm_fun = + fun ctx -> + let ctx, cc = + simplify_dummy_values_useless_abs_aux config span ~simplify_abs + fixed_abs_ids ctx + in + Invariants.check_invariants span ctx; + (ctx, cc) + let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) ~(can_end : bool) ~(destructure_shared_values : bool) (ctx : eval_ctx) (v : typed_value) : abs list = @@ -1992,9 +2153,17 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) let absl = ref [] in let push_abs (r_id : RegionId.id) (avalues : typed_avalue list) : unit = if avalues = [] then () - else + else begin (* Create the abs - note that we keep the order of the avalues as it is (unlike the environments) *) + log#ldebug + (lazy + (__FUNCTION__ ^ ": push_abs: avalues:\n" + ^ String.concat "\n" + (List.map + (fun (v : typed_avalue) -> + typed_avalue_to_string ctx v ^ " : " ^ ty_to_string ctx v.ty) + avalues))); let abs = { abs_id = fresh_abstraction_id (); @@ -2010,9 +2179,13 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) avalues; } in + log#ldebug + (lazy + (__FUNCTION__ ^ ": push_abs: abs:\n" ^ abs_to_string span ctx abs)); Invariants.opt_type_check_abs span ctx abs; (* Add to the list of abstractions *) absl := abs :: !absl + end in (* [group]: group in one abstraction (because we dived into a borrow/loan) @@ -2025,9 +2198,9 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) ~(group : bool) (r_id : RegionId.id) (v : typed_value) : typed_avalue list * typed_value = (* Debug *) - log#ltrace + log#ldebug (lazy - ("convert_value_to_abstractions: to_avalues:\n- value: " + (__FUNCTION__ ^ ": to_avalues:\n- value: " ^ typed_value_to_string ~span:(Some span) ctx v)); let ty = v.ty in @@ -2164,21 +2337,25 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (* If we group the borrows: simply introduce a projector. Otherwise, introduce one abstraction per region *) if group then - (* Substitute the regions in the type *) - let visitor = - object - inherit [_] map_ty - - method! visit_RVar _ var = - match var with - | Free _ -> RVar (Free r_id) - | Bound _ -> internal_error __FILE__ __LINE__ span - end - in - let ty = visitor#visit_ty () sv.sv_ty in - let nv = ASymbolic (PNone, AProjBorrows (sv, ty, [])) in - let nv : typed_avalue = { value = nv; ty } in - ([ nv ], v) + (* Check if the type contains regions: if not, simply ignore + it (there are no projections to introduce) *) + if TypesUtils.ty_no_regions sv.sv_ty then ([], v) + else + (* Substitute the regions in the type *) + let visitor = + object + inherit [_] map_ty + + method! visit_RVar _ var = + match var with + | Free _ -> RVar (Free r_id) + | Bound _ -> internal_error __FILE__ __LINE__ span + end + in + let ty = visitor#visit_ty () sv.sv_ty in + let nv = ASymbolic (PNone, AProjBorrows (sv, ty, [])) in + let nv : typed_avalue = { value = nv; ty } in + ([ nv ], v) else (* Introduce one abstraction per live region *) let regions = ref RegionId.Map.empty in diff --git a/src/interp/InterpreterBorrows.mli b/src/interp/InterpreterBorrows.mli index d84ded8a2..b3d5fac21 100644 --- a/src/interp/InterpreterBorrows.mli +++ b/src/interp/InterpreterBorrows.mli @@ -105,6 +105,25 @@ val destructure_abs : *) val abs_is_destructured : Meta.span -> bool -> eval_ctx -> abs -> bool +(** Simplify the dummy values in a context by removing as many as possible + and ending as many borrows as possible. + + We remove all the dummy values which: + - contain no loans/borrows. + - contain symbolic values (including those containing borrows: it is tantamount + to ending preemptively the outer borrows) + + We also: + - end the borrows which are inside dummy and don't themselves contain loans + - end the region abstractions which can be ended because they contain no loans + - end the loan projectors which can be ended because the corresponding + symbolic value doesn't appear anywhere else in the context + We ignore the abstractions which are specified by the set of abstraction + ids (we do not end them, nor their loans). + *) +val simplify_dummy_values_useless_abs : + config -> Meta.span -> simplify_abs:bool -> AbstractionId.Set.t -> cm_fun + (** Turn a value into a abstractions. We are conservative, and don't group borrows/loans into the same abstraction @@ -129,7 +148,13 @@ val abs_is_destructured : Meta.span -> bool -> eval_ctx -> abs -> bool - [v] *) val convert_value_to_abstractions : - Meta.span -> abs_kind -> bool -> bool -> eval_ctx -> typed_value -> abs list + Meta.span -> + abs_kind -> + can_end:bool -> + destructure_shared_values:bool -> + eval_ctx -> + typed_value -> + abs list (** See {!merge_into_abstraction}. diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index 6e0946feb..262c887d0 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -1456,3 +1456,102 @@ let normalize_proj_ty (regions : RegionId.Set.t) (ty : rty) : rty = end in visitor#visit_ty () ty + +(** Compute the union of two normalized projection types *) +let rec norm_proj_tys_union (span : Meta.span) (ty1 : rty) (ty2 : rty) : rty = + match (ty1, ty2) with + | TAdt (id1, generics1), TAdt (id2, generics2) -> + sanity_check __FILE__ __LINE__ (id1 = id2) span; + TAdt (id1, norm_proj_generic_args_union span generics1 generics2) + | TVar id1, TVar id2 -> + sanity_check __FILE__ __LINE__ (id1 = id2) span; + TVar id1 + | TLiteral lit1, TLiteral lit2 -> + sanity_check __FILE__ __LINE__ (lit1 = lit2) span; + TLiteral lit1 + | TNever, TNever -> TNever + | TRef (r1, ty1, rk1), TRef (r2, ty2, rk2) -> + sanity_check __FILE__ __LINE__ (rk1 = rk2) span; + TRef + ( norm_proj_regions_union span r1 r2, + norm_proj_tys_union span ty1 ty2, + rk1 ) + | TRawPtr (ty1, rk1), TRawPtr (ty2, rk2) -> + sanity_check __FILE__ __LINE__ (rk1 = rk2) span; + TRawPtr (norm_proj_tys_union span ty1 ty2, rk1) + | TTraitType (tr1, item1), TTraitType (tr2, item2) -> + sanity_check __FILE__ __LINE__ (item1 = item2) span; + TTraitType (norm_proj_trait_refs_union span tr1 tr2, item1) + | TDynTrait (), TDynTrait () -> TDynTrait () + | ( TArrow + { binder_regions = binder_regions1; binder_value = inputs1, output1 }, + TArrow + { binder_regions = binder_regions2; binder_value = inputs2, output2 } ) + -> + (* TODO: general case *) + sanity_check __FILE__ __LINE__ (binder_regions1 = []) span; + sanity_check __FILE__ __LINE__ (binder_regions2 = []) span; + let binder_value = + ( List.map2 (norm_proj_tys_union span) inputs1 inputs2, + norm_proj_tys_union span output1 output2 ) + in + TArrow { binder_regions = []; binder_value } + | _ -> internal_error __FILE__ __LINE__ span + +and norm_proj_generic_args_union span (generics1 : generic_args) + (generics2 : generic_args) : generic_args = + let { + regions = regions1; + types = types1; + const_generics = const_generics1; + trait_refs = trait_refs1; + } = + generics1 + in + let { + regions = regions2; + types = types2; + const_generics = const_generics2; + trait_refs = trait_refs2; + } = + generics2 + in + { + regions = List.map2 (norm_proj_regions_union span) regions1 regions2; + types = List.map2 (norm_proj_tys_union span) types1 types2; + const_generics = + List.map2 + (norm_proj_const_generics_union span) + const_generics1 const_generics2; + trait_refs = + List.map2 (norm_proj_trait_refs_union span) trait_refs1 trait_refs2; + } + +and norm_proj_regions_union (span : Meta.span) (r1 : region) (r2 : region) : + region = + match (r1, r2) with + | RVar (Free _), RVar (Free _) -> + (* There is an intersection: the regions should be disjoint *) + internal_error __FILE__ __LINE__ span + | RVar (Free rid), RErased | RErased, RVar (Free rid) -> + sanity_check __FILE__ __LINE__ (rid = RegionId.zero) span; + RVar (Free rid) + | _ -> internal_error __FILE__ __LINE__ span + +and norm_proj_trait_refs_union (span : Meta.span) (tr1 : trait_ref) + (tr2 : trait_ref) : trait_ref = + let { trait_id = trait_id1; trait_decl_ref = decl_ref1 } = tr1 in + let { trait_id = trait_id2; trait_decl_ref = decl_ref2 } = tr2 in + sanity_check __FILE__ __LINE__ (trait_id1 = trait_id2) span; + (* There might be regions but let's ignore this for now... *) + sanity_check __FILE__ __LINE__ (decl_ref1 = decl_ref2) span; + tr1 + +and norm_proj_const_generics_union (span : Meta.span) (cg1 : const_generic) + (cg2 : const_generic) : const_generic = + sanity_check __FILE__ __LINE__ (cg1 = cg2) span; + cg1 + +let norm_proj_ty_contains span (ty1 : rty) (ty2 : rty) : bool = + let set = RegionId.Set.singleton RegionId.zero in + projection_contains span ty1 set ty2 set diff --git a/src/interp/InterpreterLoops.ml b/src/interp/InterpreterLoops.ml index 77b93917d..e1802ff2c 100644 --- a/src/interp/InterpreterLoops.ml +++ b/src/interp/InterpreterLoops.ml @@ -92,26 +92,29 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) ((eval_ctx * statement_eval_res) * (SymbolicAst.expression -> SymbolicAst.expression)) * borrow_loan_corresp = - (* First, preemptively end borrows/move values by matching the current + log#ltrace + (lazy + (__FUNCTION__ + ^ ": about to reorganize the original context to match the fixed-point \ + ctx with it:\n\ + - src ctx (fixed-point ctx):\n" ^ eval_ctx_to_string fp_ctx + ^ "\n\n-tgt ctx (original context):\n" + ^ eval_ctx_to_string init_ctx)); + + let ctx = init_ctx in + + (* Preemptively end borrows/move values by matching the current context with the target context *) let ctx, cf_prepare = - log#ltrace - (lazy - ("eval_loop_symbolic_synthesize_fun_end: about to reorganize the \ - original context to match the fixed-point ctx with it:\n\ - - src ctx (fixed-point ctx):\n" ^ eval_ctx_to_string fp_ctx - ^ "\n\n-tgt ctx (original context):\n" - ^ eval_ctx_to_string init_ctx)); - - prepare_loop_match_ctx_with_target config span loop_id fixed_ids fp_ctx - init_ctx + prepare_loop_match_ctx_with_target config span loop_id fixed_ids fp_ctx ctx in (* Actually match *) log#ltrace (lazy - ("eval_loop_symbolic_synthesize_fun_end: about to compute the id \ - correspondance between the fixed-point ctx and the original ctx:\n\ + (__FUNCTION__ + ^ ": about to compute the id correspondance between the fixed-point ctx \ + and the original ctx:\n\ - src ctx (fixed-point ctx)\n" ^ eval_ctx_to_string fp_ctx ^ "\n\n-tgt ctx (original context):\n" ^ eval_ctx_to_string ctx)); @@ -121,8 +124,8 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) in log#ltrace (lazy - ("eval_loop_symbolic_synthesize_fun_end: about to match the fixed-point \ - context with the original context:\n\ + (__FUNCTION__ + ^ ": about to match the fixed-point context with the original context:\n\ - src ctx (fixed-point ctx)" ^ eval_ctx_to_string ~span:(Some span) fp_ctx ^ "\n\n-tgt ctx (original context):\n" @@ -148,8 +151,7 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) let abs = ctx_lookup_abs fp_ctx abs_id in log#ltrace (lazy - ("eval_loop_symbolic_synthesize_fun_end: checking abs:\n" - ^ abs_to_string span ctx abs ^ "\n")); + (__FUNCTION__ ^ ": checking abs:\n" ^ abs_to_string span ctx abs ^ "\n")); let is_borrow (av : typed_avalue) : bool = match av.value with @@ -438,10 +440,11 @@ let eval_loop (config : config) (span : span) (eval_loop_body : stl_cm_fun) : match config.mode with | ConcreteMode -> (eval_loop_concrete span eval_loop_body) ctx | SymbolicMode -> - (* Simplify the context by ending the unnecessary borrows/loans and getting + (* Preemptively simplify the context by ending the unnecessary borrows/loans and getting rid of the useless symbolic values (which are in anonymous variables) *) let ctx, cc = - cleanup_fresh_values_and_abs config span empty_ids_set ctx + InterpreterBorrows.simplify_dummy_values_useless_abs config span + ~simplify_abs:false AbstractionId.Set.empty ctx in (* We want to make sure the loop will *not* manipulate shared avalues diff --git a/src/interp/InterpreterLoopsFixedPoint.ml b/src/interp/InterpreterLoopsFixedPoint.ml index addbb7663..549b68df2 100644 --- a/src/interp/InterpreterLoopsFixedPoint.ml +++ b/src/interp/InterpreterLoopsFixedPoint.ml @@ -6,7 +6,6 @@ open ValuesUtils module S = SynthesizeSymbolic open Cps open InterpreterUtils -open InterpreterBorrowsCore open InterpreterBorrows open InterpreterLoopsCore open InterpreterLoopsMatchCtxs @@ -16,117 +15,6 @@ open Errors (** The local logger *) let log = Logging.loops_fixed_point_log -exception FoundBorrowId of BorrowId.id -exception FoundAbsId of AbstractionId.id - -(* Repeat until we can't simplify the context anymore: - - end the borrows which appear in fresh anonymous values and don't contain loans - - end the fresh region abstractions which can be ended (no loans) -*) -let rec end_useless_fresh_borrows_and_abs (config : config) (span : Meta.span) - (fixed_ids : ids_sets) : cm_fun = - fun ctx -> - let rec explore_env (env : env) : unit = - match env with - | [] -> () (* Done *) - | EBinding (BDummy vid, v) :: env - when not (DummyVarId.Set.mem vid fixed_ids.dids) -> - (* Explore the anonymous value - raises an exception if it finds - a borrow to end *) - let visitor = - object - inherit [_] iter_typed_value - method! visit_VLoan _ _ = () (* Don't enter inside loans *) - - method! visit_VBorrow _ bc = - (* Check if we can end the borrow, do not enter inside if we can't *) - match bc with - | VSharedBorrow bid | VReservedMutBorrow bid -> - raise (FoundBorrowId bid) - | VMutBorrow (bid, v) -> - if not (value_has_loans v.value) then - raise (FoundBorrowId bid) - else (* Stop there *) - () - end - in - visitor#visit_typed_value () v; - (* No exception was raised: continue *) - explore_env env - | EAbs abs :: env when not (AbstractionId.Set.mem abs.abs_id fixed_ids.aids) - -> ( - (* Check if it is possible to end the abstraction: if yes, raise an exception *) - let opt_loan = get_first_non_ignored_aloan_in_abstraction span abs in - match opt_loan with - | None -> - (* No remaining loans: we can end the abstraction *) - raise (FoundAbsId abs.abs_id) - | Some _ -> - (* There are remaining loans: we can't end the abstraction *) - explore_env env) - | _ :: env -> explore_env env - in - let rec_call = end_useless_fresh_borrows_and_abs config span fixed_ids in - try - (* Explore the environment *) - explore_env ctx.env; - (* No exception raised: simply continue *) - (ctx, fun e -> e) - with - | FoundAbsId abs_id -> - let ctx, cc = end_abstraction config span abs_id ctx in - comp cc (rec_call ctx) - | FoundBorrowId bid -> - let ctx, cc = end_borrow config span bid ctx in - comp cc (rec_call ctx) - -(* Explore the fresh anonymous values and replace all the values which are not - borrows/loans with ⊥ *) -let cleanup_fresh_values (span : Meta.span option) (fixed_ids : ids_sets) - (ctx : eval_ctx) : eval_ctx = - let rec explore_env (env : env) : env = - match env with - | [] -> [] (* Done *) - | EBinding (BDummy vid, v) :: env - when not (DummyVarId.Set.mem vid fixed_ids.dids) -> - let env = explore_env env in - (* Eliminate the value altogether if it doesn't contain loans/borrows *) - if not (value_has_loans_or_borrows span ctx v.value) then env - else - (* Explore the anonymous value - raises an exception if it finds - a borrow to end *) - let visitor = - object - inherit [_] map_typed_value as super - method! visit_VLoan _ v = VLoan v (* Don't enter inside loans *) - - method! visit_VBorrow _ v = - VBorrow v (* Don't enter inside borrows *) - - method! visit_value _ v = - if not (value_has_loans_or_borrows span ctx v) then VBottom - else super#visit_value () v - end - in - let v = visitor#visit_typed_value () v in - EBinding (BDummy vid, v) :: env - | x :: env -> x :: explore_env env - in - { ctx with env = explore_env ctx.env } - -(* Repeat until we can't simplify the context anymore: - - explore the fresh anonymous values and replace all the values which are not - borrows/loans with ⊥ - - also end the borrows which appear in fresh anonymous values and don't contain loans - - end the fresh region abstractions which can be ended (no loans) -*) -let cleanup_fresh_values_and_abs (config : config) (span : Meta.span) - (fixed_ids : ids_sets) : cm_fun = - fun ctx -> - let ctx, cc = end_useless_fresh_borrows_and_abs config span fixed_ids ctx in - let ctx = cleanup_fresh_values (Some span) fixed_ids ctx in - (ctx, cc) - let prepare_ashared_loans (span : Meta.span) (loop_id : LoopId.id option) : cm_fun = fun ctx0 -> @@ -433,12 +321,8 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) let aids = AbstractionId.Set.diff old_ids.aids new_ids.aids in (* End those borrows and abstractions *) let end_borrows_abs blids aids ctx = - let ctx = - InterpreterBorrows.end_borrows_no_synth config span blids ctx - in - let ctx = - InterpreterBorrows.end_abstractions_no_synth config span aids ctx - in + let ctx = end_borrows_no_synth config span blids ctx in + let ctx = end_abstractions_no_synth config span aids ctx in ctx in (* End the borrows/abs in [ctx1] *) @@ -651,10 +535,7 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span) abs.kind = SynthInput rg_id) span; (* End this abstraction *) - let ctx = - InterpreterBorrows.end_abstraction_no_synth config span abs_id - ctx - in + let ctx = end_abstraction_no_synth config span abs_id ctx in (* Explore the context, and check which abstractions are not there anymore *) let ids, _ = compute_ctx_ids ctx in let ended_ids = AbstractionId.Set.diff !fp_aids ids.aids in diff --git a/src/interp/InterpreterLoopsFixedPoint.mli b/src/interp/InterpreterLoopsFixedPoint.mli index 8db7b9734..43d3d5155 100644 --- a/src/interp/InterpreterLoopsFixedPoint.mli +++ b/src/interp/InterpreterLoopsFixedPoint.mli @@ -3,18 +3,6 @@ open Contexts open InterpreterUtils open InterpreterLoopsCore -(** Repeat until we can't simplify the context anymore: - - explore the fresh anonymous values and replace all the values which are not - borrows/loans with ⊥ - - also end the borrows which appear in fresh anonymous values and don't contain loans - - end the fresh region abstractions which can be ended (no loans) - - Inputs: - - config - - fixed ids (the fixeds ids are the ids we consider as non-fresh) - *) -val cleanup_fresh_values_and_abs : config -> Meta.span -> ids_sets -> Cps.cm_fun - (** Prepare the shared loans in the abstractions by moving them to fresh abstractions. diff --git a/src/interp/InterpreterLoopsJoinCtxs.ml b/src/interp/InterpreterLoopsJoinCtxs.ml index 45b320c3f..14f21b383 100644 --- a/src/interp/InterpreterLoopsJoinCtxs.ml +++ b/src/interp/InterpreterLoopsJoinCtxs.ml @@ -293,6 +293,8 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) let is_fresh_did (id : DummyVarId.id) : bool = not (DummyVarId.Set.mem id old_ids.dids) in + + let ctx = ctx0 in (* Convert the dummy values to abstractions (note that when we convert values to abstractions, the resulting abstraction should be destructured) *) (* Note that we preserve the order of the dummy values: we replace them with @@ -306,15 +308,15 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option) | EBinding (BDummy id, v) -> if is_fresh_did id then ( let absl = - convert_value_to_abstractions span abs_kind can_end - destructure_shared_values ctx0 v + convert_value_to_abstractions span abs_kind ~can_end + ~destructure_shared_values ctx v in - Invariants.opt_type_check_absl span ctx0 absl; + Invariants.opt_type_check_absl span ctx absl; List.map (fun abs -> EAbs abs) absl) else [ ee ]) - ctx0.env) + ctx.env) in - let ctx = { ctx0 with env } in + let ctx = { ctx with env } in log#ltrace (lazy (__FUNCTION__ ^ ": after converting values to abstractions:\n" @@ -950,7 +952,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) | ( (EBinding (BDummy b0, v0) as var0) :: env0', (EBinding (BDummy b1, v1) as var1) :: env1' ) -> (* Debug *) - log#ltrace + log#ldebug (lazy ("join_prefixes: BDummys:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- value0:\n" @@ -975,7 +977,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) | ( (EBinding (BVar b0, v0) as var0) :: env0', (EBinding (BVar b1, v1) as var1) :: env1' ) -> (* Debug *) - log#ltrace + log#ldebug (lazy ("join_prefixes: BVars:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- value0:\n" @@ -995,7 +997,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) var :: join_prefixes env0' env1' | (EAbs abs0 as abs) :: env0', EAbs abs1 :: env1' -> (* Debug *) - log#ltrace + log#ldebug (lazy ("join_prefixes: Abs:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- abs0:\n" @@ -1025,7 +1027,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) | _ -> craise __FILE__ __LINE__ span "Unreachable" in - log#ltrace + log#ldebug (lazy ("- env0:\n" ^ show_env env0 ^ "\n\n- env1:\n" ^ show_env env1 ^ "\n\n")); @@ -1086,6 +1088,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (** Destructure all the new abstractions *) let destructure_new_abs (span : Meta.span) (loop_id : LoopId.id) (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx = + log#ltrace (lazy (__FUNCTION__ ^ ": ctx:\n\n" ^ eval_ctx_to_string ctx)); let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in let can_end = true in let destructure_shared_values = true in @@ -1105,6 +1108,8 @@ let destructure_new_abs (span : Meta.span) (loop_id : LoopId.id) ctx.env in let ctx = { ctx with env } in + log#ltrace + (lazy (__FUNCTION__ ^ ": resulting ctx:\n\n" ^ eval_ctx_to_string ctx)); Invariants.check_invariants span ctx; ctx @@ -1165,23 +1170,32 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) let join_one (ctx : eval_ctx) : eval_ctx = log#ltrace (lazy - ("loop_join_origin_with_continue_ctxs:join_one: initial ctx:\n" + (__FUNCTION__ ^ ":join_one: initial ctx:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); + + (* Simplify the dummy values, by removing as many as we can - + we ignore the synthesis continuation *) + let ctx, _ = + simplify_dummy_values_useless_abs config span ~simplify_abs:false + fixed_ids.aids ctx + in + log#ltrace + (lazy + (__FUNCTION__ ^ ":join_one: after simplify_dummy_values_useless_abs:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Destructure the abstractions introduced in the new context *) let ctx = destructure_new_abs span loop_id fixed_ids.aids ctx in log#ltrace (lazy - ("loop_join_origin_with_continue_ctxs:join_one: after destructure:\n" + (__FUNCTION__ ^ ":join_one: after destructure:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); - (* Sanity check *) - if !Config.sanity_checks then Invariants.check_invariants span ctx; (* Reduce the context we want to add to the join *) let ctx = reduce_ctx span loop_id fixed_ids ctx in log#ltrace (lazy - ("loop_join_origin_with_continue_ctxs:join_one: after reduce:\n" + (__FUNCTION__ ^ ":join_one: after reduce:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Sanity check *) if !Config.sanity_checks then Invariants.check_invariants span ctx; @@ -1195,14 +1209,14 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) let ctx1 = join_one_aux ctx in log#ltrace (lazy - ("loop_join_origin_with_continue_ctxs:join_one: after join:\n" + (__FUNCTION__ ^ ":join_one: after join:\n" ^ eval_ctx_to_string ~span:(Some span) ctx1)); (* Collapse to eliminate the markers *) joined_ctx := collapse_ctx_with_merge span loop_id fixed_ids !joined_ctx; log#ltrace (lazy - ("loop_join_origin_with_continue_ctxs:join_one: after join-collapse:\n" + (__FUNCTION__ ^ ":join_one: after join-collapse:\n" ^ eval_ctx_to_string ~span:(Some span) !joined_ctx)); (* Sanity check *) if !Config.sanity_checks then Invariants.check_invariants span !joined_ctx; @@ -1211,7 +1225,7 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) joined_ctx := reduce_ctx span loop_id fixed_ids !joined_ctx; log#ltrace (lazy - ("loop_join_origin_with_continue_ctxs:join_one: after last reduce:\n" + (__FUNCTION__ ^ ":join_one: after last reduce:\n" ^ eval_ctx_to_string ~span:(Some span) !joined_ctx)); (* Sanity check *) diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index 56f7811f3..287be70ec 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -1860,14 +1860,21 @@ let loop_match_ctx_with_target (config : config) (span : Meta.span) ^ "\n- src_ctx: " ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx: " ^ eval_ctx_to_string tgt_ctx)); + (* Simplify the target context *) + let tgt_ctx, cc = + simplify_dummy_values_useless_abs config span ~simplify_abs:false + fixed_ids.aids tgt_ctx + in + (* We first reorganize [tgt_ctx] so that we can match [src_ctx] with it (by ending loans for instance - remember that the [src_ctx] is the fixed point context, which results from joins during which we ended the loans which were introduced during the loop iterations) *) let tgt_ctx, cc = - prepare_loop_match_ctx_with_target config span loop_id fixed_ids src_ctx - tgt_ctx + comp cc + (prepare_loop_match_ctx_with_target config span loop_id fixed_ids src_ctx + tgt_ctx) in (* Introduce the "identity" abstractions for the loop re-entry. diff --git a/src/interp/InterpreterStatements.ml b/src/interp/InterpreterStatements.ml index c7603b9de..64f01a00a 100644 --- a/src/interp/InterpreterStatements.ml +++ b/src/interp/InterpreterStatements.ml @@ -1594,10 +1594,14 @@ and eval_function_body (config : config) (body : statement) : stl_cm_fun = (fun (ctx, res) -> (* Note that we *don't* check the result ({!Panic}, {!Return}, etc.): we delegate the check to the caller. *) - log#ltrace (lazy "eval_function_body: cf_finish"); + log#ltrace + (lazy ("eval_function_body: cf_finish:\n" ^ eval_ctx_to_string ctx)); (* Expand the symbolic values if necessary - we need to do that before checking the invariants *) let ctx, cf = greedy_expand_symbolic_values config body.span ctx in + log#ltrace + (lazy + ("eval_function_body: after expansion:\n" ^ eval_ctx_to_string ctx)); (* Sanity check *) Invariants.check_invariants body.span ctx; (* Continue *) diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index 70dbfa8d5..41c732641 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -211,6 +211,8 @@ exception exception FoundAProjLoans of symbolic_value * ty * (msymbolic_value * aproj) list +exception FoundAbsProj of abstraction_id * symbolic_value + let symbolic_value_id_in_ctx (sv_id : SymbolicValueId.id) (ctx : eval_ctx) : bool = let obj = diff --git a/src/interp/Invariants.ml b/src/interp/Invariants.ml index 1b31bce3a..2b2665cf7 100644 --- a/src/interp/Invariants.ml +++ b/src/interp/Invariants.ml @@ -778,6 +778,35 @@ type sv_info = { } [@@deriving show] +let proj_borrows_info_to_string (ctx : eval_ctx) (info : proj_borrows_info) : + string = + let { abs_id; regions; proj_ty; as_shared_value } = info in + "{ abs_id = " + ^ AbstractionId.to_string abs_id + ^ "; regions = " + ^ RegionId.Set.to_string None regions + ^ "; proj_ty = " ^ ty_to_string ctx proj_ty ^ "; as_shared_value = " + ^ Print.bool_to_string as_shared_value + ^ "}" + +let proj_loans_info_to_string (ctx : eval_ctx) (info : proj_loans_info) : string + = + let { abs_id; regions; proj_ty } = info in + "{ abs_id = " + ^ AbstractionId.to_string abs_id + ^ "; regions = " + ^ RegionId.Set.to_string None regions + ^ "; proj_ty = " ^ ty_to_string ctx proj_ty ^ "}" + +let sv_info_to_string (ctx : eval_ctx) (info : sv_info) : string = + let { ty; env_count = _; aproj_borrows; aproj_loans } = info in + "{\n ty = " ^ ty_to_string ctx ty ^ ";\n aproj_borrows = [" + ^ String.concat ", " + (List.map (proj_borrows_info_to_string ctx) aproj_borrows) + ^ "];\n aproj_loans = [" + ^ String.concat ", " (List.map (proj_loans_info_to_string ctx) aproj_loans) + ^ "]\n}" + (** Check the invariants over the symbolic values. - a symbolic value can't be both in proj_borrows and in the concrete env @@ -849,52 +878,61 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = in (* Collect the information *) obj#visit_eval_ctx None ctx; - log#ltrace - (lazy - ("check_symbolic_values: collected information:\n" - ^ SymbolicValueId.Map.to_string (Some " ") show_sv_info !infos)); + (* Check *) - let check_info _id info = - (* TODO: check that: - * - the borrows are mutually disjoint - *) - (* A symbolic value can't be both in the regular environment and inside - * projectors of borrows in abstractions *) - sanity_check __FILE__ __LINE__ - (info.env_count = 0 || info.aproj_borrows = []) - span; - sanity_check __FILE__ __LINE__ - (info.aproj_borrows = [] || info.aproj_loans <> []) - span; - (* At the same time: - * - check that the loans don't intersect - * - compute the set of regions for which we project loans - *) - (* Check that the loan projectors contain the region projectors *) - let loan_regions = - List.fold_left - (fun regions linfo -> - let regions = - RegionId.Set.fold - (fun rid regions -> - sanity_check __FILE__ __LINE__ - (not (RegionId.Set.mem rid regions)) - span; - RegionId.Set.add rid regions) - regions linfo.regions + let check_info id info = + log#ltrace + (lazy + (__FUNCTION__ ^ ": checking info (sid: )" + ^ SymbolicValueId.to_string id + ^ ":\n" ^ sv_info_to_string ctx info)); + if info.aproj_borrows = [] && info.aproj_loans = [] then () + else ( + (* TODO: check that: + * - the borrows are mutually disjoint + *) + sanity_check __FILE__ __LINE__ + (info.aproj_borrows = [] || info.aproj_loans <> []) + span; + (* Check that the loan projections don't intersect and compute + the normalized union of those projections *) + let aproj_loans = + List.map + (fun (linfo : proj_loans_info) -> + normalize_proj_ty linfo.regions linfo.proj_ty) + info.aproj_loans + in + + (* There should be at least one loan proj *) + let loan_proj_union = + match aproj_loans with + | [] -> internal_error __FILE__ __LINE__ span + | loan_proj_union :: aproj_loans -> + List.fold_left + (fun loan_proj_union proj_ty -> + norm_proj_tys_union span loan_proj_union proj_ty) + loan_proj_union aproj_loans + in + + (* Check that the union of the loan projectors contains the borrow projections. *) + let aproj_borrows = + List.map + (fun (linfo : proj_borrows_info) -> + normalize_proj_ty linfo.regions linfo.proj_ty) + info.aproj_borrows + in + match aproj_borrows with + | [] -> (* Nothing to do *) () + | borrow_proj_union :: aproj_borrows -> + let borrow_proj_union = + List.fold_left + (fun borrow_proj_union proj_ty -> + norm_proj_tys_union span borrow_proj_union proj_ty) + borrow_proj_union aproj_borrows in - regions) - RegionId.Set.empty info.aproj_loans - in - (* Check that the union of the loan projectors contains the borrow projections. *) - List.iter - (fun (binfo : proj_borrows_info) -> - sanity_check __FILE__ __LINE__ - (projection_contains span info.ty loan_regions binfo.proj_ty - binfo.regions) - span) - info.aproj_borrows; - () + sanity_check __FILE__ __LINE__ + (norm_proj_ty_contains span loan_proj_union borrow_proj_union) + span) in M.iter check_info !infos diff --git a/src/llbc/ValuesUtils.ml b/src/llbc/ValuesUtils.ml index 8667b0bd3..b0c1719c7 100644 --- a/src/llbc/ValuesUtils.ml +++ b/src/llbc/ValuesUtils.ml @@ -146,7 +146,7 @@ let concrete_loans_in_value (v : typed_value) : bool = with Found -> true (** Check if a value contains concrete borrows or loans *) -let concrete_borrows_loans_in_value (v : typed_value) : bool = +let concrete_borrows_loans_in_value (v : value) : bool = let obj = object inherit [_] iter_typed_value @@ -156,7 +156,7 @@ let concrete_borrows_loans_in_value (v : typed_value) : bool = in (* We use exceptions *) try - obj#visit_typed_value () v; + obj#visit_value () v; false with Found -> true From 2bed38a29d86549082ad2371d239647fee502437 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 18:34:03 +0000 Subject: [PATCH 17/23] Add more tests to adt-borrows.rs --- tests/coq/misc/AdtBorrows.v | 295 +++++++++++++++++++++++++++++--- tests/fstar/misc/AdtBorrows.fst | 230 ++++++++++++++++++++++--- tests/lean/AdtBorrows.lean | 247 +++++++++++++++++++++++--- tests/src/adt-borrows.rs | 76 ++++++++ 4 files changed, 770 insertions(+), 78 deletions(-) diff --git a/tests/coq/misc/AdtBorrows.v b/tests/coq/misc/AdtBorrows.v index d2261958d..cb6103c30 100644 --- a/tests/coq/misc/AdtBorrows.v +++ b/tests/coq/misc/AdtBorrows.v @@ -121,8 +121,17 @@ Definition mutWrapper_unwrap let back := fun (ret : T) => ret in Ok (self, back) . +(** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::id]: + Source: 'tests/src/adt-borrows.rs', lines 82:4-84:5 *) +Definition mutWrapper_id + {T : Type} (self : MutWrapper_t T) : + result ((MutWrapper_t T) * (MutWrapper_t T -> MutWrapper_t T)) + := + let back := fun (ret : MutWrapper_t T) => ret in Ok (self, back) +. + (** [adt_borrows::use_mut_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 83:0-89:1 *) + Source: 'tests/src/adt-borrows.rs', lines 87:0-93:1 *) Definition use_mut_wrapper : result unit := p <- mutWrapper_create 0%i32; let (w, create_back) := p in @@ -133,15 +142,27 @@ Definition use_mut_wrapper : result unit := massert (x s= 1%i32) . +(** [adt_borrows::use_mut_wrapper_id]: + Source: 'tests/src/adt-borrows.rs', lines 95:0-97:1 *) +Definition use_mut_wrapper_id + {T : Type} (x : MutWrapper_t T) : + result ((MutWrapper_t T) * (MutWrapper_t T -> MutWrapper_t T)) + := + p <- mutWrapper_id x; + let (mw, id_back) := p in + let back := fun (ret : MutWrapper_t T) => id_back ret in + Ok (mw, back) +. + (** [adt_borrows::MutWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 91:0-93:1 *) + Source: 'tests/src/adt-borrows.rs', lines 99:0-101: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 96:4-98:5 *) + Source: 'tests/src/adt-borrows.rs', lines 104:4-106: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,15 +170,24 @@ Definition mutWrapper1_create . (** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 100:4-102:5 *) + Source: 'tests/src/adt-borrows.rs', lines 108:4-110: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 Ok (self.(mutWrapper1_x), back) . +(** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::id]: + Source: 'tests/src/adt-borrows.rs', lines 112:4-114:5 *) +Definition mutWrapper1_id + {T : Type} (self : MutWrapper1_t T) : + result ((MutWrapper1_t T) * (MutWrapper1_t T -> MutWrapper1_t T)) + := + Ok (self, fun (ret : MutWrapper1_t T) => ret) +. + (** [adt_borrows::use_mut_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 105:0-111:1 *) + Source: 'tests/src/adt-borrows.rs', lines 117:0-123:1 *) Definition use_mut_wrapper1 : result unit := p <- mutWrapper1_create 0%i32; let (w, create_back) := p in @@ -168,8 +198,22 @@ Definition use_mut_wrapper1 : result unit := massert (x s= 1%i32) . +(** [adt_borrows::use_mut_wrapper1_id]: + Source: 'tests/src/adt-borrows.rs', lines 125:0-127:1 *) +Definition use_mut_wrapper1_id + {T : Type} (x : MutWrapper1_t T) : + result ((MutWrapper1_t T) * (MutWrapper1_t T -> MutWrapper1_t T)) + := + p <- mutWrapper1_id x; + let (mw, id_back) := p in + let back := + fun (ret : MutWrapper1_t T) => + id_back {| mutWrapper1_x := ret.(mutWrapper1_x) |} in + Ok (mw, back) +. + (** [adt_borrows::MutWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 113:0-116:1 *) + Source: 'tests/src/adt-borrows.rs', lines 129:0-132:1 *) Record MutWrapper2_t (T : Type) := mkMutWrapper2_t { mutWrapper2_x : T; mutWrapper2_y : T; @@ -181,7 +225,7 @@ Arguments mutWrapper2_x { _ }. Arguments mutWrapper2_y { _ }. (** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::create]: - Source: 'tests/src/adt-borrows.rs', lines 119:4-121:5 *) + Source: 'tests/src/adt-borrows.rs', lines 135:4-137:5 *) Definition mutWrapper2_create {T : Type} (x : T) (y : T) : result ((MutWrapper2_t T) * (MutWrapper2_t T -> T) * (MutWrapper2_t T -> T)) @@ -192,7 +236,7 @@ Definition mutWrapper2_create . (** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 123:4-125:5 *) + Source: 'tests/src/adt-borrows.rs', lines 139:4-141:5 *) Definition mutWrapper2_unwrap {T : Type} (self : MutWrapper2_t T) : result ((T * T) * (T -> MutWrapper2_t T) * (T -> MutWrapper2_t T)) @@ -206,8 +250,30 @@ Definition mutWrapper2_unwrap Ok ((self.(mutWrapper2_x), self.(mutWrapper2_y)), back'a, back'b) . +(** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::id]: + Source: 'tests/src/adt-borrows.rs', lines 143:4-145:5 *) +Definition mutWrapper2_id + {T : Type} (self : MutWrapper2_t T) : + result ((MutWrapper2_t T) * (MutWrapper2_t T -> MutWrapper2_t T) * + (MutWrapper2_t T -> MutWrapper2_t T)) + := + let back'a := + fun (ret : MutWrapper2_t T) => + {| + mutWrapper2_x := ret.(mutWrapper2_x); + mutWrapper2_y := self.(mutWrapper2_y) + |} in + let back'b := + fun (ret : MutWrapper2_t T) => + {| + mutWrapper2_x := self.(mutWrapper2_x); + mutWrapper2_y := ret.(mutWrapper2_y) + |} in + Ok (self, back'a, back'b) +. + (** [adt_borrows::use_mut_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 128:0-137:1 *) + Source: 'tests/src/adt-borrows.rs', lines 148:0-157:1 *) Definition use_mut_wrapper2 : result unit := t <- mutWrapper2_create 0%i32 10%i32; let '(w, create_back, create_back1) := t in @@ -232,15 +298,49 @@ Definition use_mut_wrapper2 : result unit := massert (y s= 11%i32) . +(** [adt_borrows::use_mut_wrapper2_id]: + Source: 'tests/src/adt-borrows.rs', lines 159:0-161:1 *) +Definition use_mut_wrapper2_id + {T : Type} (x : MutWrapper2_t T) : + result ((MutWrapper2_t T) * (MutWrapper2_t T -> MutWrapper2_t T) * + (MutWrapper2_t T -> MutWrapper2_t T)) + := + t <- mutWrapper2_id x; + let '(mw, id_back, id_back1) := t in + let back'a := + fun (ret : MutWrapper2_t T) => + {| + mutWrapper2_x := + (id_back + {| + mutWrapper2_x := ret.(mutWrapper2_x); + mutWrapper2_y := mw.(mutWrapper2_y) + |}).(mutWrapper2_x); + mutWrapper2_y := x.(mutWrapper2_y) + |} in + let back'b := + fun (ret : MutWrapper2_t T) => + {| + mutWrapper2_x := x.(mutWrapper2_x); + mutWrapper2_y := + (id_back1 + {| + mutWrapper2_x := mw.(mutWrapper2_x); + mutWrapper2_y := ret.(mutWrapper2_y) + |}).(mutWrapper2_y) + |} in + Ok (mw, back'a, back'b) +. + (** [adt_borrows::array_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 146:0-148:1 *) + Source: 'tests/src/adt-borrows.rs', lines 170:0-172: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 150:0-152:1 *) + Source: 'tests/src/adt-borrows.rs', lines 174:0-176:1 *) Definition array_mut_borrow {N : usize} (x : array u32 N) : result ((array u32 N) * (array u32 N -> array u32 N)) @@ -248,21 +348,68 @@ Definition array_mut_borrow Ok (x, fun (ret : array u32 N) => ret) . +(** [adt_borrows::use_array_mut_borrow1]: + Source: 'tests/src/adt-borrows.rs', lines 178:0-180:1 *) +Definition use_array_mut_borrow1 + {N : usize} (x : array u32 N) : + result ((array u32 N) * (array u32 N -> array u32 N)) + := + array_mut_borrow x +. + +(** [adt_borrows::use_array_mut_borrow2]: + Source: 'tests/src/adt-borrows.rs', lines 182:0-185:1 *) +Definition use_array_mut_borrow2 + {N : usize} (x : array u32 N) : + result ((array u32 N) * (array u32 N -> array u32 N)) + := + p <- array_mut_borrow x; + let (x1, array_mut_borrow_back) := p in + p1 <- array_mut_borrow x1; + let (a, array_mut_borrow_back1) := p1 in + let back := + fun (ret : array u32 N) => + let x2 := array_mut_borrow_back1 ret in array_mut_borrow_back x2 in + Ok (a, back) +. + (** [adt_borrows::boxed_slice_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 *) + Source: 'tests/src/adt-borrows.rs', lines 187:0-189: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 158:0-160:1 *) + Source: 'tests/src/adt-borrows.rs', lines 191:0-193:1 *) Definition boxed_slice_mut_borrow (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := Ok (x, fun (ret : slice u32) => ret) . +(** [adt_borrows::use_boxed_slice_mut_borrow1]: + Source: 'tests/src/adt-borrows.rs', lines 195:0-197:1 *) +Definition use_boxed_slice_mut_borrow1 + (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := + boxed_slice_mut_borrow x +. + +(** [adt_borrows::use_boxed_slice_mut_borrow2]: + Source: 'tests/src/adt-borrows.rs', lines 199:0-202:1 *) +Definition use_boxed_slice_mut_borrow2 + (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := + p <- boxed_slice_mut_borrow x; + let (x1, boxed_slice_mut_borrow_back) := p in + p1 <- boxed_slice_mut_borrow x1; + let (s, boxed_slice_mut_borrow_back1) := p1 in + let back := + fun (ret : slice u32) => + let s1 := boxed_slice_mut_borrow_back1 ret in + boxed_slice_mut_borrow_back s1 in + Ok (s, back) +. + (** [adt_borrows::SharedList] - Source: 'tests/src/adt-borrows.rs', lines 165:0-168:1 *) + Source: 'tests/src/adt-borrows.rs', lines 207:0-210:1 *) Inductive SharedList_t (T : Type) := | SharedList_Nil : SharedList_t T | SharedList_Cons : T -> SharedList_t T -> SharedList_t T @@ -272,14 +419,14 @@ 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 *) + Source: 'tests/src/adt-borrows.rs', lines 214:4-216: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 *) + Source: 'tests/src/adt-borrows.rs', lines 218:4-224:5 *) Definition sharedList_pop {T : Type} (self : SharedList_t T) : result (T * (SharedList_t T)) := match self with @@ -289,7 +436,7 @@ Definition sharedList_pop . (** [adt_borrows::MutList] - Source: 'tests/src/adt-borrows.rs', lines 185:0-188:1 *) + Source: 'tests/src/adt-borrows.rs', lines 227:0-230:1 *) Inductive MutList_t (T : Type) := | MutList_Nil : MutList_t T | MutList_Cons : T -> MutList_t T -> MutList_t T @@ -299,7 +446,7 @@ 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 *) + Source: 'tests/src/adt-borrows.rs', lines 234:4-236:5 *) Definition mutList_push {T : Type} (self : MutList_t T) (x : T) : result ((MutList_t T) * (MutList_t T -> ((MutList_t T) * T))) @@ -313,7 +460,7 @@ Definition mutList_push . (** [adt_borrows::{adt_borrows::MutList<'a, T>}#7::pop]: - Source: 'tests/src/adt-borrows.rs', lines 196:4-202:5 *) + Source: 'tests/src/adt-borrows.rs', lines 238:4-244:5 *) Definition mutList_pop {T : Type} (self : MutList_t T) : result ((T * (MutList_t T)) * ((T * (MutList_t T)) -> MutList_t T)) @@ -329,13 +476,13 @@ Definition mutList_pop . (** [adt_borrows::wrap_shared_in_option]: - Source: 'tests/src/adt-borrows.rs', lines 205:0-207:1 *) + Source: 'tests/src/adt-borrows.rs', lines 247:0-249: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 *) + Source: 'tests/src/adt-borrows.rs', lines 251:0-253: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 @@ -344,7 +491,7 @@ Definition wrap_mut_in_option . (** [adt_borrows::List] - Source: 'tests/src/adt-borrows.rs', lines 213:0-216:1 *) + Source: 'tests/src/adt-borrows.rs', lines 255:0-258:1 *) Inductive List_t (T : Type) := | List_Cons : T -> List_t T -> List_t T | List_Nil : List_t T @@ -354,7 +501,7 @@ Arguments List_Cons { _ }. Arguments List_Nil { _ }. (** [adt_borrows::nth_shared]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 219:4-228:1 *) + Source: 'tests/src/adt-borrows.rs', lines 261:4-270:1 *) Fixpoint nth_shared_loop {T : Type} (ls : List_t T) (i : u32) : result (option T) := match ls with @@ -367,14 +514,14 @@ Fixpoint nth_shared_loop . (** [adt_borrows::nth_shared]: - Source: 'tests/src/adt-borrows.rs', lines 218:0-228:1 *) + Source: 'tests/src/adt-borrows.rs', lines 260:0-270: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 *) + Source: 'tests/src/adt-borrows.rs', lines 273:4-282:1 *) Fixpoint nth_mut_loop {T : Type} (ls : List_t T) (i : u32) : result ((option T) * (option T -> List_t T)) @@ -400,7 +547,7 @@ Fixpoint nth_mut_loop . (** [adt_borrows::nth_mut]: - Source: 'tests/src/adt-borrows.rs', lines 230:0-240:1 *) + Source: 'tests/src/adt-borrows.rs', lines 272:0-282:1 *) Definition nth_mut {T : Type} (ls : List_t T) (i : u32) : result ((option T) * (option T -> List_t T)) @@ -408,4 +555,100 @@ Definition nth_mut nth_mut_loop ls i . +(** [adt_borrows::update_array_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 284:0-286:1 *) +Definition update_array_mut_borrow + (a : array u32 32%usize) : + result ((array u32 32%usize) * (array u32 32%usize -> array u32 32%usize)) + := + Ok (a, fun (ret : array u32 32%usize) => ret) +. + +(** [adt_borrows::array_mut_borrow_loop1]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 289:4-291:5 *) +Fixpoint array_mut_borrow_loop1_loop + (b : bool) (a : array u32 32%usize) : result (array u32 32%usize) := + if b + then ( + p <- update_array_mut_borrow a; + let (a1, update_array_mut_borrow_back) := p in + a2 <- array_mut_borrow_loop1_loop true a1; + Ok (update_array_mut_borrow_back a2)) + else Ok a +. + +(** [adt_borrows::array_mut_borrow_loop1]: + Source: 'tests/src/adt-borrows.rs', lines 288:0-292:1 *) +Definition array_mut_borrow_loop1 + (b : bool) (a : array u32 32%usize) : result (array u32 32%usize) := + array_mut_borrow_loop1_loop b a +. + +(** [adt_borrows::array_mut_borrow_loop2]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 295:4-297:5 *) +Fixpoint array_mut_borrow_loop2_loop + (b : bool) (a : array u32 32%usize) : + result ((array u32 32%usize) * (array u32 32%usize -> array u32 32%usize)) + := + if b + then ( + p <- update_array_mut_borrow a; + let (a1, update_array_mut_borrow_back) := p in + p1 <- array_mut_borrow_loop2_loop true a1; + let (a2, back) := p1 in + let back1 := + fun (ret : array u32 32%usize) => + let a3 := back ret in update_array_mut_borrow_back a3 in + Ok (a2, back1)) + else Ok (a, fun (ret : array u32 32%usize) => ret) +. + +(** [adt_borrows::array_mut_borrow_loop2]: + Source: 'tests/src/adt-borrows.rs', lines 294:0-299:1 *) +Definition array_mut_borrow_loop2 + (b : bool) (a : array u32 32%usize) : + result ((array u32 32%usize) * (array u32 32%usize -> array u32 32%usize)) + := + array_mut_borrow_loop2_loop b a +. + +(** [adt_borrows::copy_shared_array]: + Source: 'tests/src/adt-borrows.rs', lines 301:0-303:1 *) +Definition copy_shared_array + (a : array u32 32%usize) : result (array u32 32%usize) := + Ok a +. + +(** [adt_borrows::array_shared_borrow_loop1]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 306:4-308:5 *) +Fixpoint array_shared_borrow_loop1_loop + (b : bool) (a : array u32 32%usize) : result unit := + if b + then (a1 <- copy_shared_array a; array_shared_borrow_loop1_loop true a1) + else Ok tt +. + +(** [adt_borrows::array_shared_borrow_loop1]: + Source: 'tests/src/adt-borrows.rs', lines 305:0-309:1 *) +Definition array_shared_borrow_loop1 + (b : bool) (a : array u32 32%usize) : result unit := + array_shared_borrow_loop1_loop b a +. + +(** [adt_borrows::array_shared_borrow_loop2]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 312:4-314:5 *) +Fixpoint array_shared_borrow_loop2_loop + (b : bool) (a : array u32 32%usize) : result (array u32 32%usize) := + if b + then (a1 <- copy_shared_array a; array_shared_borrow_loop2_loop true a1) + else Ok a +. + +(** [adt_borrows::array_shared_borrow_loop2]: + Source: 'tests/src/adt-borrows.rs', lines 311:0-316:1 *) +Definition array_shared_borrow_loop2 + (b : bool) (a : array u32 32%usize) : result (array u32 32%usize) := + array_shared_borrow_loop2_loop b a +. + End AdtBorrows. diff --git a/tests/fstar/misc/AdtBorrows.fst b/tests/fstar/misc/AdtBorrows.fst index 55aa109ac..27df1e792 100644 --- a/tests/fstar/misc/AdtBorrows.fst +++ b/tests/fstar/misc/AdtBorrows.fst @@ -87,8 +87,16 @@ 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::{adt_borrows::MutWrapper<'a, T>}#3::id]: + Source: 'tests/src/adt-borrows.rs', lines 82:4-84:5 *) +let mutWrapper_id + (#t : Type0) (self : mutWrapper_t t) : + result ((mutWrapper_t t) & (mutWrapper_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 83:0-89:1 *) + Source: 'tests/src/adt-borrows.rs', lines 87:0-93:1 *) let use_mut_wrapper : result unit = let* (w, create_back) = mutWrapper_create 0 in let* (p, unwrap_back) = mutWrapper_unwrap w in @@ -96,24 +104,42 @@ let use_mut_wrapper : result unit = let x = create_back (unwrap_back p1) in if x = 1 then Ok () else Fail Failure +(** [adt_borrows::use_mut_wrapper_id]: + Source: 'tests/src/adt-borrows.rs', lines 95:0-97:1 *) +let use_mut_wrapper_id + (#t : Type0) (x : mutWrapper_t t) : + result ((mutWrapper_t t) & (mutWrapper_t t -> mutWrapper_t t)) + = + let* (mw, id_back) = mutWrapper_id x in + let back = fun ret -> id_back ret in + Ok (mw, back) + (** [adt_borrows::MutWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 91:0-93:1 *) + Source: 'tests/src/adt-borrows.rs', lines 99:0-101:1 *) type mutWrapper1_t (t : Type0) = { x : t; } (** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::create]: - Source: 'tests/src/adt-borrows.rs', lines 96:4-98:5 *) + Source: 'tests/src/adt-borrows.rs', lines 104:4-106: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 100:4-102:5 *) + Source: 'tests/src/adt-borrows.rs', lines 108:4-110: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::{adt_borrows::MutWrapper1<'a, T>}#4::id]: + Source: 'tests/src/adt-borrows.rs', lines 112:4-114:5 *) +let mutWrapper1_id + (#t : Type0) (self : mutWrapper1_t t) : + result ((mutWrapper1_t t) & (mutWrapper1_t t -> mutWrapper1_t t)) + = + Ok (self, (fun ret -> ret)) + (** [adt_borrows::use_mut_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 105:0-111:1 *) + Source: 'tests/src/adt-borrows.rs', lines 117:0-123:1 *) let use_mut_wrapper1 : result unit = let* (w, create_back) = mutWrapper1_create 0 in let* (p, unwrap_back) = mutWrapper1_unwrap w in @@ -121,12 +147,22 @@ let use_mut_wrapper1 : result unit = let x = create_back (unwrap_back p1) in if x = 1 then Ok () else Fail Failure +(** [adt_borrows::use_mut_wrapper1_id]: + Source: 'tests/src/adt-borrows.rs', lines 125:0-127:1 *) +let use_mut_wrapper1_id + (#t : Type0) (x : mutWrapper1_t t) : + result ((mutWrapper1_t t) & (mutWrapper1_t t -> mutWrapper1_t t)) + = + let* (mw, id_back) = mutWrapper1_id x in + let back = fun ret -> id_back { x = ret.x } in + Ok (mw, back) + (** [adt_borrows::MutWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 113:0-116:1 *) + Source: 'tests/src/adt-borrows.rs', lines 129:0-132: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 119:4-121:5 *) + Source: 'tests/src/adt-borrows.rs', lines 135:4-137:5 *) let mutWrapper2_create (#t : Type0) (x : t) (y : t) : result ((mutWrapper2_t t) & (mutWrapper2_t t -> t) & (mutWrapper2_t t -> t)) @@ -136,7 +172,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 123:4-125:5 *) + Source: 'tests/src/adt-borrows.rs', lines 139:4-141:5 *) let mutWrapper2_unwrap (#t : Type0) (self : mutWrapper2_t t) : result ((t & t) & (t -> mutWrapper2_t t) & (t -> mutWrapper2_t t)) @@ -145,8 +181,19 @@ let mutWrapper2_unwrap let back'b = fun ret -> { self with y = ret } in Ok ((self.x, self.y), back'a, back'b) +(** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::id]: + Source: 'tests/src/adt-borrows.rs', lines 143:4-145:5 *) +let mutWrapper2_id + (#t : Type0) (self : mutWrapper2_t t) : + result ((mutWrapper2_t t) & (mutWrapper2_t t -> mutWrapper2_t t) & + (mutWrapper2_t t -> mutWrapper2_t t)) + = + let back'a = fun ret -> { self with x = ret.x } in + let back'b = fun ret -> { self with y = ret.y } in + Ok (self, back'a, back'b) + (** [adt_borrows::use_mut_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 128:0-137:1 *) + Source: 'tests/src/adt-borrows.rs', lines 148:0-157: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 @@ -160,44 +207,95 @@ let use_mut_wrapper2 : result unit = if y = 11 then Ok () else Fail Failure else Fail Failure +(** [adt_borrows::use_mut_wrapper2_id]: + Source: 'tests/src/adt-borrows.rs', lines 159:0-161:1 *) +let use_mut_wrapper2_id + (#t : Type0) (x : mutWrapper2_t t) : + result ((mutWrapper2_t t) & (mutWrapper2_t t -> mutWrapper2_t t) & + (mutWrapper2_t t -> mutWrapper2_t t)) + = + let* (mw, id_back, id_back1) = mutWrapper2_id x in + let back'a = fun ret -> { x with x = (id_back { mw with x = ret.x }).x } in + let back'b = fun ret -> { x with y = (id_back1 { mw with y = ret.y }).y } in + Ok (mw, back'a, back'b) + (** [adt_borrows::array_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 146:0-148:1 *) + Source: 'tests/src/adt-borrows.rs', lines 170:0-172: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 150:0-152:1 *) + Source: 'tests/src/adt-borrows.rs', lines 174:0-176:1 *) 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)) +(** [adt_borrows::use_array_mut_borrow1]: + Source: 'tests/src/adt-borrows.rs', lines 178:0-180:1 *) +let use_array_mut_borrow1 + (#n : usize) (x : array u32 n) : + result ((array u32 n) & (array u32 n -> array u32 n)) + = + array_mut_borrow x + +(** [adt_borrows::use_array_mut_borrow2]: + Source: 'tests/src/adt-borrows.rs', lines 182:0-185:1 *) +let use_array_mut_borrow2 + (#n : usize) (x : array u32 n) : + result ((array u32 n) & (array u32 n -> array u32 n)) + = + let* (x1, array_mut_borrow_back) = array_mut_borrow x in + let* (a, array_mut_borrow_back1) = array_mut_borrow x1 in + let back = + fun ret -> let x2 = array_mut_borrow_back1 ret in array_mut_borrow_back x2 + in + Ok (a, back) + (** [adt_borrows::boxed_slice_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 *) + Source: 'tests/src/adt-borrows.rs', lines 187:0-189: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 158:0-160:1 *) + Source: 'tests/src/adt-borrows.rs', lines 191:0-193:1 *) let boxed_slice_mut_borrow (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = Ok (x, (fun ret -> ret)) +(** [adt_borrows::use_boxed_slice_mut_borrow1]: + Source: 'tests/src/adt-borrows.rs', lines 195:0-197:1 *) +let use_boxed_slice_mut_borrow1 + (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = + boxed_slice_mut_borrow x + +(** [adt_borrows::use_boxed_slice_mut_borrow2]: + Source: 'tests/src/adt-borrows.rs', lines 199:0-202:1 *) +let use_boxed_slice_mut_borrow2 + (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = + let* (x1, boxed_slice_mut_borrow_back) = boxed_slice_mut_borrow x in + let* (s, boxed_slice_mut_borrow_back1) = boxed_slice_mut_borrow x1 in + let back = + fun ret -> + let s1 = boxed_slice_mut_borrow_back1 ret in + boxed_slice_mut_borrow_back s1 in + Ok (s, back) + (** [adt_borrows::SharedList] - Source: 'tests/src/adt-borrows.rs', lines 165:0-168:1 *) + Source: 'tests/src/adt-borrows.rs', lines 207:0-210: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 *) + Source: 'tests/src/adt-borrows.rs', lines 214:4-216: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 *) + Source: 'tests/src/adt-borrows.rs', lines 218:4-224:5 *) let sharedList_pop (#t : Type0) (self : sharedList_t t) : result (t & (sharedList_t t)) = begin match self with @@ -206,13 +304,13 @@ let sharedList_pop end (** [adt_borrows::MutList] - Source: 'tests/src/adt-borrows.rs', lines 185:0-188:1 *) + Source: 'tests/src/adt-borrows.rs', lines 227:0-230: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 *) + Source: 'tests/src/adt-borrows.rs', lines 234:4-236:5 *) let mutList_push (#t : Type0) (self : mutList_t t) (x : t) : result ((mutList_t t) & (mutList_t t -> ((mutList_t t) & t))) @@ -228,7 +326,7 @@ let mutList_push 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 *) + Source: 'tests/src/adt-borrows.rs', lines 238:4-244:5 *) let mutList_pop (#t : Type0) (self : mutList_t t) : result ((t & (mutList_t t)) & ((t & (mutList_t t)) -> mutList_t t)) @@ -241,25 +339,25 @@ let mutList_pop end (** [adt_borrows::wrap_shared_in_option]: - Source: 'tests/src/adt-borrows.rs', lines 205:0-207:1 *) + Source: 'tests/src/adt-borrows.rs', lines 247:0-249: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 *) + Source: 'tests/src/adt-borrows.rs', lines 251:0-253: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 *) + Source: 'tests/src/adt-borrows.rs', lines 255:0-258: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 *) + Source: 'tests/src/adt-borrows.rs', lines 261:4-270:1 *) let rec nth_shared_loop (#t : Type0) (ls : list_t t) (i : u32) : result (option t) = begin match ls with @@ -271,12 +369,12 @@ let rec nth_shared_loop end (** [adt_borrows::nth_shared]: - Source: 'tests/src/adt-borrows.rs', lines 218:0-228:1 *) + Source: 'tests/src/adt-borrows.rs', lines 260:0-270: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 *) + Source: 'tests/src/adt-borrows.rs', lines 273:4-282:1 *) let rec nth_mut_loop (#t : Type0) (ls : list_t t) (i : u32) : result ((option t) & (option t -> list_t t)) @@ -299,10 +397,90 @@ let rec nth_mut_loop end (** [adt_borrows::nth_mut]: - Source: 'tests/src/adt-borrows.rs', lines 230:0-240:1 *) + Source: 'tests/src/adt-borrows.rs', lines 272:0-282: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 +(** [adt_borrows::update_array_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 284:0-286:1 *) +let update_array_mut_borrow + (a : array u32 32) : + result ((array u32 32) & (array u32 32 -> array u32 32)) + = + Ok (a, (fun ret -> ret)) + +(** [adt_borrows::array_mut_borrow_loop1]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 289:4-291:5 *) +let rec array_mut_borrow_loop1_loop + (b : bool) (a : array u32 32) : result (array u32 32) = + if b + then + let* (a1, update_array_mut_borrow_back) = update_array_mut_borrow a in + let* a2 = array_mut_borrow_loop1_loop true a1 in + Ok (update_array_mut_borrow_back a2) + else Ok a + +(** [adt_borrows::array_mut_borrow_loop1]: + Source: 'tests/src/adt-borrows.rs', lines 288:0-292:1 *) +let array_mut_borrow_loop1 + (b : bool) (a : array u32 32) : result (array u32 32) = + array_mut_borrow_loop1_loop b a + +(** [adt_borrows::array_mut_borrow_loop2]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 295:4-297:5 *) +let rec array_mut_borrow_loop2_loop + (b : bool) (a : array u32 32) : + result ((array u32 32) & (array u32 32 -> array u32 32)) + = + if b + then + let* (a1, update_array_mut_borrow_back) = update_array_mut_borrow a in + let* (a2, back) = array_mut_borrow_loop2_loop true a1 in + let back1 = fun ret -> let a3 = back ret in update_array_mut_borrow_back a3 + in + Ok (a2, back1) + else Ok (a, (fun ret -> ret)) + +(** [adt_borrows::array_mut_borrow_loop2]: + Source: 'tests/src/adt-borrows.rs', lines 294:0-299:1 *) +let array_mut_borrow_loop2 + (b : bool) (a : array u32 32) : + result ((array u32 32) & (array u32 32 -> array u32 32)) + = + array_mut_borrow_loop2_loop b a + +(** [adt_borrows::copy_shared_array]: + Source: 'tests/src/adt-borrows.rs', lines 301:0-303:1 *) +let copy_shared_array (a : array u32 32) : result (array u32 32) = + Ok a + +(** [adt_borrows::array_shared_borrow_loop1]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 306:4-308:5 *) +let rec array_shared_borrow_loop1_loop + (b : bool) (a : array u32 32) : result unit = + if b + then let* a1 = copy_shared_array a in array_shared_borrow_loop1_loop true a1 + else Ok () + +(** [adt_borrows::array_shared_borrow_loop1]: + Source: 'tests/src/adt-borrows.rs', lines 305:0-309:1 *) +let array_shared_borrow_loop1 (b : bool) (a : array u32 32) : result unit = + array_shared_borrow_loop1_loop b a + +(** [adt_borrows::array_shared_borrow_loop2]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 312:4-314:5 *) +let rec array_shared_borrow_loop2_loop + (b : bool) (a : array u32 32) : result (array u32 32) = + if b + then let* a1 = copy_shared_array a in array_shared_borrow_loop2_loop true a1 + else Ok a + +(** [adt_borrows::array_shared_borrow_loop2]: + Source: 'tests/src/adt-borrows.rs', lines 311:0-316:1 *) +let array_shared_borrow_loop2 + (b : bool) (a : array u32 32) : result (array u32 32) = + array_shared_borrow_loop2_loop b a + diff --git a/tests/lean/AdtBorrows.lean b/tests/lean/AdtBorrows.lean index d3d42867a..2be17f660 100644 --- a/tests/lean/AdtBorrows.lean +++ b/tests/lean/AdtBorrows.lean @@ -98,8 +98,17 @@ def MutWrapper.unwrap let back := fun ret => ret Result.ok (self, back) +/- [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::id]: + Source: 'tests/src/adt-borrows.rs', lines 82:4-84:5 -/ +def MutWrapper.id + {T : Type} (self : MutWrapper T) : + Result ((MutWrapper T) × (MutWrapper T → MutWrapper T)) + := + let back := fun ret => ret + Result.ok (self, back) + /- [adt_borrows::use_mut_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 83:0-89:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 87:0-93:1 -/ def use_mut_wrapper : Result Unit := do let (w, create_back) ← MutWrapper.create 0#i32 @@ -108,27 +117,46 @@ def use_mut_wrapper : Result Unit := let x := create_back (unwrap_back p1) massert (x = 1#i32) +/- [adt_borrows::use_mut_wrapper_id]: + Source: 'tests/src/adt-borrows.rs', lines 95:0-97:1 -/ +def use_mut_wrapper_id + {T : Type} (x : MutWrapper T) : + Result ((MutWrapper T) × (MutWrapper T → MutWrapper T)) + := + do + let (mw, id_back) ← MutWrapper.id x + let back := fun ret => id_back ret + Result.ok (mw, back) + /- [adt_borrows::MutWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 91:0-93:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 99:0-101:1 -/ structure MutWrapper1 (T : Type) where x : T /- [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::create]: - Source: 'tests/src/adt-borrows.rs', lines 96:4-98:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 104:4-106: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 100:4-102:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 108:4-110: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::{adt_borrows::MutWrapper1<'a, T>}#4::id]: + Source: 'tests/src/adt-borrows.rs', lines 112:4-114:5 -/ +def MutWrapper1.id + {T : Type} (self : MutWrapper1 T) : + Result ((MutWrapper1 T) × (MutWrapper1 T → MutWrapper1 T)) + := + Result.ok (self, fun ret => ret) + /- [adt_borrows::use_mut_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 105:0-111:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 117:0-123:1 -/ def use_mut_wrapper1 : Result Unit := do let (w, create_back) ← MutWrapper1.create 0#i32 @@ -137,14 +165,25 @@ def use_mut_wrapper1 : Result Unit := let x := create_back (unwrap_back p1) massert (x = 1#i32) +/- [adt_borrows::use_mut_wrapper1_id]: + Source: 'tests/src/adt-borrows.rs', lines 125:0-127:1 -/ +def use_mut_wrapper1_id + {T : Type} (x : MutWrapper1 T) : + Result ((MutWrapper1 T) × (MutWrapper1 T → MutWrapper1 T)) + := + do + let (mw, id_back) ← MutWrapper1.id x + let back := fun ret => id_back ret + Result.ok (mw, back) + /- [adt_borrows::MutWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 113:0-116:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 129:0-132: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 119:4-121:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 135:4-137:5 -/ def MutWrapper2.create {T : Type} (x : T) (y : T) : Result ((MutWrapper2 T) × (MutWrapper2 T → T) × (MutWrapper2 T → T)) @@ -154,7 +193,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 123:4-125:5 -/ + Source: 'tests/src/adt-borrows.rs', lines 139:4-141:5 -/ def MutWrapper2.unwrap {T : Type} (self : MutWrapper2 T) : Result ((T × T) × (T → MutWrapper2 T) × (T → MutWrapper2 T)) @@ -163,8 +202,19 @@ def MutWrapper2.unwrap let back'b := fun ret => { self with y := ret } Result.ok ((self.x, self.y), back'a, back'b) +/- [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::id]: + Source: 'tests/src/adt-borrows.rs', lines 143:4-145:5 -/ +def MutWrapper2.id + {T : Type} (self : MutWrapper2 T) : + Result ((MutWrapper2 T) × (MutWrapper2 T → MutWrapper2 T) × (MutWrapper2 + T → MutWrapper2 T)) + := + let back'a := fun ret => { self with x := ret.x } + let back'b := fun ret => { self with y := ret.y } + Result.ok (self, back'a, back'b) + /- [adt_borrows::use_mut_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 128:0-137:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 148:0-157:1 -/ def use_mut_wrapper2 : Result Unit := do let (w, create_back, create_back1) ← MutWrapper2.create 0#i32 10#i32 @@ -177,44 +227,98 @@ def use_mut_wrapper2 : Result Unit := let y := create_back1 { w with y := (unwrap_back1 py1).y } massert (y = 11#i32) +/- [adt_borrows::use_mut_wrapper2_id]: + Source: 'tests/src/adt-borrows.rs', lines 159:0-161:1 -/ +def use_mut_wrapper2_id + {T : Type} (x : MutWrapper2 T) : + Result ((MutWrapper2 T) × (MutWrapper2 T → MutWrapper2 T) × (MutWrapper2 + T → MutWrapper2 T)) + := + do + let (mw, id_back, id_back1) ← MutWrapper2.id x + let back'a := fun ret => { x with x := (id_back { mw with x := ret.x }).x } + let back'b := fun ret => { x with y := (id_back1 { mw with y := ret.y }).y } + Result.ok (mw, back'a, back'b) + /- [adt_borrows::array_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 146:0-148:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 170:0-172: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 150:0-152:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 174:0-176:1 -/ def array_mut_borrow {N : Usize} (x : Array U32 N) : Result ((Array U32 N) × (Array U32 N → Array U32 N)) := Result.ok (x, fun ret => ret) +/- [adt_borrows::use_array_mut_borrow1]: + Source: 'tests/src/adt-borrows.rs', lines 178:0-180:1 -/ +def use_array_mut_borrow1 + {N : Usize} (x : Array U32 N) : + Result ((Array U32 N) × (Array U32 N → Array U32 N)) + := + array_mut_borrow x + +/- [adt_borrows::use_array_mut_borrow2]: + Source: 'tests/src/adt-borrows.rs', lines 182:0-185:1 -/ +def use_array_mut_borrow2 + {N : Usize} (x : Array U32 N) : + Result ((Array U32 N) × (Array U32 N → Array U32 N)) + := + do + let (x1, array_mut_borrow_back) ← array_mut_borrow x + let (a, array_mut_borrow_back1) ← array_mut_borrow x1 + let back := + fun ret => let x2 := array_mut_borrow_back1 ret + array_mut_borrow_back x2 + Result.ok (a, back) + /- [adt_borrows::boxed_slice_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 154:0-156:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 187:0-189: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 158:0-160:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 191:0-193:1 -/ def boxed_slice_mut_borrow (x : Slice U32) : Result ((Slice U32) × (Slice U32 → Slice U32)) := Result.ok (x, fun ret => ret) +/- [adt_borrows::use_boxed_slice_mut_borrow1]: + Source: 'tests/src/adt-borrows.rs', lines 195:0-197:1 -/ +def use_boxed_slice_mut_borrow1 + (x : Slice U32) : Result ((Slice U32) × (Slice U32 → Slice U32)) := + boxed_slice_mut_borrow x + +/- [adt_borrows::use_boxed_slice_mut_borrow2]: + Source: 'tests/src/adt-borrows.rs', lines 199:0-202:1 -/ +def use_boxed_slice_mut_borrow2 + (x : Slice U32) : Result ((Slice U32) × (Slice U32 → Slice U32)) := + do + let (x1, boxed_slice_mut_borrow_back) ← boxed_slice_mut_borrow x + let (s, boxed_slice_mut_borrow_back1) ← boxed_slice_mut_borrow x1 + let back := + fun ret => + let s1 := boxed_slice_mut_borrow_back1 ret + boxed_slice_mut_borrow_back s1 + Result.ok (s, back) + /- [adt_borrows::SharedList] - Source: 'tests/src/adt-borrows.rs', lines 165:0-168:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 207:0-210: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 -/ + Source: 'tests/src/adt-borrows.rs', lines 214:4-216: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 -/ + Source: 'tests/src/adt-borrows.rs', lines 218:4-224:5 -/ def SharedList.pop {T : Type} (self : SharedList T) : Result (T × (SharedList T)) := match self with @@ -222,13 +326,13 @@ def SharedList.pop | SharedList.Cons hd tl => Result.ok (hd, tl) /- [adt_borrows::MutList] - Source: 'tests/src/adt-borrows.rs', lines 185:0-188:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 227:0-230: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 -/ + Source: 'tests/src/adt-borrows.rs', lines 234:4-236:5 -/ def MutList.push {T : Type} (self : MutList T) (x : T) : Result ((MutList T) × (MutList T → ((MutList T) × T))) @@ -243,7 +347,7 @@ def MutList.push 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 -/ + Source: 'tests/src/adt-borrows.rs', lines 238:4-244:5 -/ def MutList.pop {T : Type} (self : MutList T) : Result ((T × (MutList T)) × ((T × (MutList T)) → MutList T)) @@ -256,12 +360,12 @@ def MutList.pop Result.ok ((hd, tl), back) /- [adt_borrows::wrap_shared_in_option]: - Source: 'tests/src/adt-borrows.rs', lines 205:0-207:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 247:0-249: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 -/ + Source: 'tests/src/adt-borrows.rs', lines 251:0-253:1 -/ def wrap_mut_in_option {T : Type} (x : T) : Result ((Option T) × (Option T → T)) := let back := fun ret => match ret with @@ -270,13 +374,13 @@ def wrap_mut_in_option Result.ok (some x, back) /- [adt_borrows::List] - Source: 'tests/src/adt-borrows.rs', lines 213:0-216:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 255:0-258: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 -/ + Source: 'tests/src/adt-borrows.rs', lines 261:4-270:1 -/ divergent def nth_shared_loop {T : Type} (ls : List T) (i : U32) : Result (Option T) := match ls with @@ -289,13 +393,13 @@ divergent def nth_shared_loop | List.Nil => Result.ok none /- [adt_borrows::nth_shared]: - Source: 'tests/src/adt-borrows.rs', lines 218:0-228:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 260:0-270: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 -/ + Source: 'tests/src/adt-borrows.rs', lines 273:4-282:1 -/ divergent def nth_mut_loop {T : Type} (ls : List T) (i : U32) : Result ((Option T) × (Option T → List T)) @@ -322,7 +426,7 @@ divergent def nth_mut_loop Result.ok (none, back) /- [adt_borrows::nth_mut]: - Source: 'tests/src/adt-borrows.rs', lines 230:0-240:1 -/ + Source: 'tests/src/adt-borrows.rs', lines 272:0-282:1 -/ @[reducible] def nth_mut {T : Type} (ls : List T) (i : U32) : @@ -330,4 +434,95 @@ def nth_mut := nth_mut_loop ls i +/- [adt_borrows::update_array_mut_borrow]: + Source: 'tests/src/adt-borrows.rs', lines 284:0-286:1 -/ +def update_array_mut_borrow + (a : Array U32 32#usize) : + Result ((Array U32 32#usize) × (Array U32 32#usize → Array U32 32#usize)) + := + Result.ok (a, fun ret => ret) + +/- [adt_borrows::array_mut_borrow_loop1]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 289:4-291:5 -/ +divergent def array_mut_borrow_loop1_loop + (b : Bool) (a : Array U32 32#usize) : Result (Array U32 32#usize) := + if b + then + do + let (a1, update_array_mut_borrow_back) ← update_array_mut_borrow a + let a2 ← array_mut_borrow_loop1_loop true a1 + Result.ok (update_array_mut_borrow_back a2) + else Result.ok a + +/- [adt_borrows::array_mut_borrow_loop1]: + Source: 'tests/src/adt-borrows.rs', lines 288:0-292:1 -/ +@[reducible] +def array_mut_borrow_loop1 + (b : Bool) (a : Array U32 32#usize) : Result (Array U32 32#usize) := + array_mut_borrow_loop1_loop b a + +/- [adt_borrows::array_mut_borrow_loop2]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 295:4-297:5 -/ +divergent def array_mut_borrow_loop2_loop + (b : Bool) (a : Array U32 32#usize) : + Result ((Array U32 32#usize) × (Array U32 32#usize → Array U32 32#usize)) + := + if b + then + do + let (a1, update_array_mut_borrow_back) ← update_array_mut_borrow a + let (a2, back) ← array_mut_borrow_loop2_loop true a1 + let back1 := fun ret => let a3 := back ret + update_array_mut_borrow_back a3 + Result.ok (a2, back1) + else Result.ok (a, fun ret => ret) + +/- [adt_borrows::array_mut_borrow_loop2]: + Source: 'tests/src/adt-borrows.rs', lines 294:0-299:1 -/ +@[reducible] +def array_mut_borrow_loop2 + (b : Bool) (a : Array U32 32#usize) : + Result ((Array U32 32#usize) × (Array U32 32#usize → Array U32 32#usize)) + := + array_mut_borrow_loop2_loop b a + +/- [adt_borrows::copy_shared_array]: + Source: 'tests/src/adt-borrows.rs', lines 301:0-303:1 -/ +def copy_shared_array (a : Array U32 32#usize) : Result (Array U32 32#usize) := + Result.ok a + +/- [adt_borrows::array_shared_borrow_loop1]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 306:4-308:5 -/ +divergent def array_shared_borrow_loop1_loop + (b : Bool) (a : Array U32 32#usize) : Result Unit := + if b + then do + let a1 ← copy_shared_array a + array_shared_borrow_loop1_loop true a1 + else Result.ok () + +/- [adt_borrows::array_shared_borrow_loop1]: + Source: 'tests/src/adt-borrows.rs', lines 305:0-309:1 -/ +@[reducible] +def array_shared_borrow_loop1 + (b : Bool) (a : Array U32 32#usize) : Result Unit := + array_shared_borrow_loop1_loop b a + +/- [adt_borrows::array_shared_borrow_loop2]: loop 0: + Source: 'tests/src/adt-borrows.rs', lines 312:4-314:5 -/ +divergent def array_shared_borrow_loop2_loop + (b : Bool) (a : Array U32 32#usize) : Result (Array U32 32#usize) := + if b + then do + let a1 ← copy_shared_array a + array_shared_borrow_loop2_loop true a1 + else Result.ok a + +/- [adt_borrows::array_shared_borrow_loop2]: + Source: 'tests/src/adt-borrows.rs', lines 311:0-316:1 -/ +@[reducible] +def array_shared_borrow_loop2 + (b : Bool) (a : Array U32 32#usize) : Result (Array U32 32#usize) := + array_shared_borrow_loop2_loop b a + end adt_borrows diff --git a/tests/src/adt-borrows.rs b/tests/src/adt-borrows.rs index 1543064ef..fe8a3e58a 100644 --- a/tests/src/adt-borrows.rs +++ b/tests/src/adt-borrows.rs @@ -78,6 +78,10 @@ impl<'a, T> MutWrapper<'a, T> { fn unwrap(self: Self) -> &'a mut T { self.0 } + + fn id(self) -> Self { + self + } } fn use_mut_wrapper() { @@ -88,6 +92,10 @@ fn use_mut_wrapper() { assert!(x == 1); } +fn use_mut_wrapper_id<'a, T>(x: MutWrapper<'a, T>) -> MutWrapper<'a, T> { + x.id() +} + struct MutWrapper1<'a, T> { x: &'a mut T, } @@ -100,6 +108,10 @@ impl<'a, T> MutWrapper1<'a, T> { fn unwrap(self: Self) -> &'a mut T { self.x } + + fn id(self) -> Self { + self + } } fn use_mut_wrapper1() { @@ -110,6 +122,10 @@ fn use_mut_wrapper1() { assert!(x == 1); } +fn use_mut_wrapper1_id<'a, T>(x: MutWrapper1<'a, T>) -> MutWrapper1<'a, T> { + x.id() +} + struct MutWrapper2<'a, 'b, T> { x: &'a mut T, y: &'b mut T, @@ -123,6 +139,10 @@ impl<'a, 'b, T> MutWrapper2<'a, 'b, T> { fn unwrap(self: Self) -> (&'a mut T, &'b mut T) { (self.x, self.y) } + + fn id(self) -> Self { + self + } } fn use_mut_wrapper2() { @@ -136,6 +156,10 @@ fn use_mut_wrapper2() { assert!(y == 11); } +fn use_mut_wrapper2_id<'a, 'b, T>(x: MutWrapper2<'a, 'b, T>) -> MutWrapper2<'a, 'b, T> { + x.id() +} + // // Arrays/slices containing borrows // @@ -151,6 +175,15 @@ fn array_mut_borrow<'a, const N: usize>(x: [&'a mut u32; N]) -> [&'a mut u32; N] x } +fn use_array_mut_borrow1<'a, const N: usize>(x: [&'a mut u32; N]) -> [&'a mut u32; N] { + array_mut_borrow(x) +} + +fn use_array_mut_borrow2<'a, const N: usize>(x: [&'a mut u32; N]) -> [&'a mut u32; N] { + let x = array_mut_borrow(x); + array_mut_borrow(x) +} + fn boxed_slice_shared_borrow(x: Box<[&u32]>) -> Box<[&u32]> { x } @@ -159,6 +192,15 @@ fn boxed_slice_mut_borrow(x: Box<[&mut u32]>) -> Box<[&mut u32]> { x } +fn use_boxed_slice_mut_borrow1(x: Box<[&mut u32]>) -> Box<[&mut u32]> { + boxed_slice_mut_borrow(x) +} + +fn use_boxed_slice_mut_borrow2(x: Box<[&mut u32]>) -> Box<[&mut u32]> { + let x = boxed_slice_mut_borrow(x); + boxed_slice_mut_borrow(x) +} + // // Enumerations with borrows // @@ -238,3 +280,37 @@ pub fn nth_mut(mut ls: &mut List, mut i: u32) -> Option<&mut T> { } None } + +pub fn update_array_mut_borrow(a: [&mut u32; 32]) -> [&mut u32; 32] { + a +} + +pub fn array_mut_borrow_loop1(b: bool, mut a: [&mut u32; 32]) { + while b { + a = update_array_mut_borrow(a) + } +} + +pub fn array_mut_borrow_loop2(b: bool, mut a: [&mut u32; 32]) -> [&mut u32; 32] { + while b { + a = update_array_mut_borrow(a) + } + a +} + +pub fn copy_shared_array(a: [&u32; 32]) -> [&u32; 32] { + a +} + +pub fn array_shared_borrow_loop1(b: bool, mut a: [&u32; 32]) { + while b { + a = copy_shared_array(a) + } +} + +pub fn array_shared_borrow_loop2(b: bool, mut a: [&u32; 32]) -> [&u32; 32] { + while b { + a = copy_shared_array(a) + } + a +} From 7487a67cd642362efa6b58a10992df3f83a69027 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 20:55:05 +0000 Subject: [PATCH 18/23] Improve a micro-pass --- src/pure/PureMicroPasses.ml | 2 ++ tests/coq/misc/AdtBorrows.v | 7 +------ tests/fstar/misc/AdtBorrows.fst | 4 +--- tests/lean/AdtBorrows.lean | 5 +---- 4 files changed, 5 insertions(+), 13 deletions(-) diff --git a/src/pure/PureMicroPasses.ml b/src/pure/PureMicroPasses.ml index 8f1e43a76..8757e39da 100644 --- a/src/pure/PureMicroPasses.ml +++ b/src/pure/PureMicroPasses.ml @@ -1382,6 +1382,8 @@ let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl = (* Look for a type constructor applied to arguments *) method! visit_texpression env e = + (* First simplify the sub-expressions *) + let e = super#visit_texpression env e in match e.e with | App _ -> ( (* TODO: we should remove this case, which dates from before the diff --git a/tests/coq/misc/AdtBorrows.v b/tests/coq/misc/AdtBorrows.v index cb6103c30..f484a0b39 100644 --- a/tests/coq/misc/AdtBorrows.v +++ b/tests/coq/misc/AdtBorrows.v @@ -204,12 +204,7 @@ Definition use_mut_wrapper1_id {T : Type} (x : MutWrapper1_t T) : result ((MutWrapper1_t T) * (MutWrapper1_t T -> MutWrapper1_t T)) := - p <- mutWrapper1_id x; - let (mw, id_back) := p in - let back := - fun (ret : MutWrapper1_t T) => - id_back {| mutWrapper1_x := ret.(mutWrapper1_x) |} in - Ok (mw, back) + mutWrapper1_id x . (** [adt_borrows::MutWrapper2] diff --git a/tests/fstar/misc/AdtBorrows.fst b/tests/fstar/misc/AdtBorrows.fst index 27df1e792..1aac4abe1 100644 --- a/tests/fstar/misc/AdtBorrows.fst +++ b/tests/fstar/misc/AdtBorrows.fst @@ -153,9 +153,7 @@ let use_mut_wrapper1_id (#t : Type0) (x : mutWrapper1_t t) : result ((mutWrapper1_t t) & (mutWrapper1_t t -> mutWrapper1_t t)) = - let* (mw, id_back) = mutWrapper1_id x in - let back = fun ret -> id_back { x = ret.x } in - Ok (mw, back) + mutWrapper1_id x (** [adt_borrows::MutWrapper2] Source: 'tests/src/adt-borrows.rs', lines 129:0-132:1 *) diff --git a/tests/lean/AdtBorrows.lean b/tests/lean/AdtBorrows.lean index 2be17f660..3d84aaeb5 100644 --- a/tests/lean/AdtBorrows.lean +++ b/tests/lean/AdtBorrows.lean @@ -171,10 +171,7 @@ def use_mut_wrapper1_id {T : Type} (x : MutWrapper1 T) : Result ((MutWrapper1 T) × (MutWrapper1 T → MutWrapper1 T)) := - do - let (mw, id_back) ← MutWrapper1.id x - let back := fun ret => id_back ret - Result.ok (mw, back) + MutWrapper1.id x /- [adt_borrows::MutWrapper2] Source: 'tests/src/adt-borrows.rs', lines 129:0-132:1 -/ From a7746fe981ca39c887821781284ac405f46c1d8c Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 20:55:13 +0000 Subject: [PATCH 19/23] Regenerate the tests --- tests/src/loops-borrow-check-fail.borrow-check.out | 4 ++-- tests/src/mutually-recursive-traits.lean.out | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/src/loops-borrow-check-fail.borrow-check.out b/tests/src/loops-borrow-check-fail.borrow-check.out index 28d9e5635..6c28bee87 100644 --- a/tests/src/loops-borrow-check-fail.borrow-check.out +++ b/tests/src/loops-borrow-check-fail.borrow-check.out @@ -1,5 +1,5 @@ [Info ] Imported: tests/llbc/loops_borrow_check_fail.llbc [Error] Can not apply a projection to the ⊥ value Source: 'tests/src/loops-borrow-check-fail.rs', lines 8:10-8:13 -[Error] Can not apply a projection to the ⊥ value -Source: 'tests/src/loops-borrow-check-fail.rs', lines 19:12-19:17 +[Error] Unexpected +Source: 'tests/src/loops-borrow-check-fail.rs', lines 18:4-20:5 diff --git a/tests/src/mutually-recursive-traits.lean.out b/tests/src/mutually-recursive-traits.lean.out index 3277563cc..383d80f7a 100644 --- a/tests/src/mutually-recursive-traits.lean.out +++ b/tests/src/mutually-recursive-traits.lean.out @@ -14,4 +14,4 @@ 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 886, characters 2-177 Called from Aeneas__Translate.extract_file in file "Translate.ml", line 1018, characters 2-36 Called from Aeneas__Translate.translate_crate in file "Translate.ml", line 1652, characters 5-42 -Called from Dune__exe__Main in file "Main.ml", line 493, characters 11-63 +Called from Dune__exe__Main in file "Main.ml", line 564, characters 11-63 From 4df2288cff736032e9fcc124bd1715ec021d3d08 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 21:02:07 +0000 Subject: [PATCH 20/23] Improve the CLI --- src/Main.ml | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/Main.ml b/src/Main.ml index 16732141b..47f74a295 100644 --- a/src/Main.ml +++ b/src/Main.ml @@ -244,6 +244,7 @@ let () = in (* Activate the loggers *) + let activated_loggers_set = ref Collections.StringSet.empty in List.iter (fun (level, name) -> match Collections.StringMap.find_opt name !loggers with @@ -254,7 +255,19 @@ let () = ^ String.concat ", " (Collections.StringMap.keys !loggers) ^ "}"); fail false - | Some logger -> logger#set_level level) + | Some logger -> + (* Check that we haven't activated the logger twice *) + if Collections.StringSet.mem name !activated_loggers_set then begin + log#serror + ("The logger '" ^ name + ^ "' is used twice in the '-log' and/or '-log-debug' option(s)"); + fail false + end + else begin + activated_loggers_set := + Collections.StringSet.add name !activated_loggers_set; + logger#set_level level + end) !activated_loggers; (* Properly register the marked ids *) From 45603fae7493b93f0a19b1e72625e988068541bf Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 21:03:54 +0000 Subject: [PATCH 21/23] 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 8dbc03bb1..42ed7f7bd 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. -8a17efc262ef3af377ab172efc865edcf1bb40ea +df3b7fd4c1277827c92b4a2cb84347f1f54d92a6 diff --git a/flake.lock b/flake.lock index 8a08ed8e0..e0572b1be 100644 --- a/flake.lock +++ b/flake.lock @@ -9,11 +9,11 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1736180214, - "narHash": "sha256-BtyLLaWlN/b8SC/6eL0f9Imaoq71bHjAWh/ASugXxfk=", + "lastModified": 1736369122, + "narHash": "sha256-LKddoHMQKNJBzeY4c3zQUy+bNCgjlBdKfs7TghpQodI=", "owner": "aeneasverif", "repo": "charon", - "rev": "8a17efc262ef3af377ab172efc865edcf1bb40ea", + "rev": "df3b7fd4c1277827c92b4a2cb84347f1f54d92a6", "type": "github" }, "original": { @@ -177,11 +177,11 @@ ] }, "locked": { - "lastModified": 1736216977, - "narHash": "sha256-EMueGrzBpryM8mgOyoyJ7DdNRRk09ug1ggcLLp0WrCQ=", + "lastModified": 1736303309, + "narHash": "sha256-IKrk7RL+Q/2NC6+Ql6dwwCNZI6T6JH2grTdJaVWHF0A=", "owner": "oxalica", "repo": "rust-overlay", - "rev": "bbe7e4e7a70d235db4bbdcabbf8a2f6671881dd7", + "rev": "a0b81d4fa349d9af1765b0f0b4a899c13776f706", "type": "github" }, "original": { From 581c7bcd41b99617ceed58b3f87c41b0e2e67bfc Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 21:05:02 +0000 Subject: [PATCH 22/23] Deactivate the extraction of adt-borrows.rs for Coq and F* --- tests/coq/misc/AdtBorrows.v | 649 -------------------------------- tests/fstar/misc/AdtBorrows.fst | 484 ------------------------ tests/src/adt-borrows.rs | 2 +- 3 files changed, 1 insertion(+), 1134 deletions(-) delete mode 100644 tests/coq/misc/AdtBorrows.v delete mode 100644 tests/fstar/misc/AdtBorrows.fst diff --git a/tests/coq/misc/AdtBorrows.v b/tests/coq/misc/AdtBorrows.v deleted file mode 100644 index f484a0b39..000000000 --- a/tests/coq/misc/AdtBorrows.v +++ /dev/null @@ -1,649 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [adt_borrows] *) -Require Import Primitives. -Import Primitives. -Require Import Coq.ZArith.ZArith. -Require Import List. -Import ListNotations. -Local Open Scope Primitives_scope. -Module AdtBorrows. - -(** [adt_borrows::SharedWrapper] - 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 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 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 19:0-24:1 *) -Definition use_shared_wrapper : result unit := - w <- sharedWrapper_create 0%i32; - p <- sharedWrapper_unwrap w; - massert (0%i32 s= p) -. - -(** [adt_borrows::SharedWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 26:0-28:1 *) -Record SharedWrapper1_t (T : Type) := -mkSharedWrapper1_t { - sharedWrapper1_x : T; -} -. - -Arguments mkSharedWrapper1_t { _ }. -Arguments sharedWrapper1_x { _ }. - -(** [adt_borrows::{adt_borrows::SharedWrapper1<'a, T>}#1::create]: - 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 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 40:0-45:1 *) -Definition use_shared_wrapper1 : result unit := - w <- sharedWrapper1_create 0%i32; - p <- sharedWrapper1_unwrap w; - massert (0%i32 s= p) -. - -(** [adt_borrows::SharedWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 47:0-50:1 *) -Record SharedWrapper2_t (T : Type) := -mkSharedWrapper2_t { - sharedWrapper2_x : T; sharedWrapper2_y : T; -} -. - -Arguments mkSharedWrapper2_t { _ }. -Arguments sharedWrapper2_x { _ }. -Arguments sharedWrapper2_y { _ }. - -(** [adt_borrows::{adt_borrows::SharedWrapper2<'a, 'b, T>}#2::create]: - 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 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 62:0-69:1 *) -Definition use_shared_wrapper2 : result unit := - w <- sharedWrapper2_create 0%i32 1%i32; - p <- sharedWrapper2_unwrap w; - let (px, py) := p in - _ <- massert (0%i32 s= px); - massert (1%i32 s= py) -. - -(** [adt_borrows::MutWrapper] - 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 74:4-76:5 *) -Definition mutWrapper_create - {T : Type} (x : T) : result ((MutWrapper_t T) * (MutWrapper_t T -> T)) := - Ok (x, fun (ret : MutWrapper_t T) => ret) -. - -(** [adt_borrows::{adt_borrows::MutWrapper<'a, T>}#3::unwrap]: - 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::{adt_borrows::MutWrapper<'a, T>}#3::id]: - Source: 'tests/src/adt-borrows.rs', lines 82:4-84:5 *) -Definition mutWrapper_id - {T : Type} (self : MutWrapper_t T) : - result ((MutWrapper_t T) * (MutWrapper_t T -> MutWrapper_t T)) - := - let back := fun (ret : MutWrapper_t T) => ret in Ok (self, back) -. - -(** [adt_borrows::use_mut_wrapper]: - Source: 'tests/src/adt-borrows.rs', lines 87:0-93:1 *) -Definition use_mut_wrapper : result unit := - p <- mutWrapper_create 0%i32; - let (w, create_back) := p in - p1 <- mutWrapper_unwrap w; - let (p2, unwrap_back) := p1 in - p3 <- i32_add p2 1%i32; - let x := create_back (unwrap_back p3) in - massert (x s= 1%i32) -. - -(** [adt_borrows::use_mut_wrapper_id]: - Source: 'tests/src/adt-borrows.rs', lines 95:0-97:1 *) -Definition use_mut_wrapper_id - {T : Type} (x : MutWrapper_t T) : - result ((MutWrapper_t T) * (MutWrapper_t T -> MutWrapper_t T)) - := - p <- mutWrapper_id x; - let (mw, id_back) := p in - let back := fun (ret : MutWrapper_t T) => id_back ret in - Ok (mw, back) -. - -(** [adt_borrows::MutWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 99:0-101: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 104:4-106: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 - Ok ({| mutWrapper1_x := x |}, back) -. - -(** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 108:4-110: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 - Ok (self.(mutWrapper1_x), back) -. - -(** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::id]: - Source: 'tests/src/adt-borrows.rs', lines 112:4-114:5 *) -Definition mutWrapper1_id - {T : Type} (self : MutWrapper1_t T) : - result ((MutWrapper1_t T) * (MutWrapper1_t T -> MutWrapper1_t T)) - := - Ok (self, fun (ret : MutWrapper1_t T) => ret) -. - -(** [adt_borrows::use_mut_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 117:0-123:1 *) -Definition use_mut_wrapper1 : result unit := - p <- mutWrapper1_create 0%i32; - let (w, create_back) := p in - p1 <- mutWrapper1_unwrap w; - let (p2, unwrap_back) := p1 in - p3 <- i32_add p2 1%i32; - let x := create_back (unwrap_back p3) in - massert (x s= 1%i32) -. - -(** [adt_borrows::use_mut_wrapper1_id]: - Source: 'tests/src/adt-borrows.rs', lines 125:0-127:1 *) -Definition use_mut_wrapper1_id - {T : Type} (x : MutWrapper1_t T) : - result ((MutWrapper1_t T) * (MutWrapper1_t T -> MutWrapper1_t T)) - := - mutWrapper1_id x -. - -(** [adt_borrows::MutWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 129:0-132:1 *) -Record MutWrapper2_t (T : Type) := -mkMutWrapper2_t { - mutWrapper2_x : T; mutWrapper2_y : T; -} -. - -Arguments mkMutWrapper2_t { _ }. -Arguments mutWrapper2_x { _ }. -Arguments mutWrapper2_y { _ }. - -(** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::create]: - Source: 'tests/src/adt-borrows.rs', lines 135:4-137:5 *) -Definition mutWrapper2_create - {T : Type} (x : T) (y : T) : - result ((MutWrapper2_t T) * (MutWrapper2_t T -> T) * (MutWrapper2_t T -> T)) - := - let back'a := fun (ret : MutWrapper2_t T) => ret.(mutWrapper2_x) in - let back'b := fun (ret : MutWrapper2_t T) => ret.(mutWrapper2_y) in - Ok ({| mutWrapper2_x := x; mutWrapper2_y := y |}, back'a, back'b) -. - -(** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 139:4-141:5 *) -Definition mutWrapper2_unwrap - {T : Type} (self : MutWrapper2_t T) : - result ((T * T) * (T -> MutWrapper2_t T) * (T -> MutWrapper2_t T)) - := - let back'a := - fun (ret : T) => - {| mutWrapper2_x := ret; mutWrapper2_y := self.(mutWrapper2_y) |} in - let back'b := - fun (ret : T) => - {| mutWrapper2_x := self.(mutWrapper2_x); mutWrapper2_y := ret |} in - Ok ((self.(mutWrapper2_x), self.(mutWrapper2_y)), back'a, back'b) -. - -(** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::id]: - Source: 'tests/src/adt-borrows.rs', lines 143:4-145:5 *) -Definition mutWrapper2_id - {T : Type} (self : MutWrapper2_t T) : - result ((MutWrapper2_t T) * (MutWrapper2_t T -> MutWrapper2_t T) * - (MutWrapper2_t T -> MutWrapper2_t T)) - := - let back'a := - fun (ret : MutWrapper2_t T) => - {| - mutWrapper2_x := ret.(mutWrapper2_x); - mutWrapper2_y := self.(mutWrapper2_y) - |} in - let back'b := - fun (ret : MutWrapper2_t T) => - {| - mutWrapper2_x := self.(mutWrapper2_x); - mutWrapper2_y := ret.(mutWrapper2_y) - |} in - Ok (self, back'a, back'b) -. - -(** [adt_borrows::use_mut_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 148:0-157:1 *) -Definition use_mut_wrapper2 : result unit := - t <- mutWrapper2_create 0%i32 10%i32; - let '(w, create_back, create_back1) := t in - t1 <- mutWrapper2_unwrap w; - let '(p, unwrap_back, unwrap_back1) := t1 in - let (px, py) := p in - px1 <- i32_add px 1%i32; - py1 <- i32_add py 1%i32; - let x := - create_back - {| - mutWrapper2_x := (unwrap_back px1).(mutWrapper2_x); - mutWrapper2_y := w.(mutWrapper2_y) - |} in - _ <- massert (x s= 1%i32); - let y := - create_back1 - {| - mutWrapper2_x := w.(mutWrapper2_x); - mutWrapper2_y := (unwrap_back1 py1).(mutWrapper2_y) - |} in - massert (y s= 11%i32) -. - -(** [adt_borrows::use_mut_wrapper2_id]: - Source: 'tests/src/adt-borrows.rs', lines 159:0-161:1 *) -Definition use_mut_wrapper2_id - {T : Type} (x : MutWrapper2_t T) : - result ((MutWrapper2_t T) * (MutWrapper2_t T -> MutWrapper2_t T) * - (MutWrapper2_t T -> MutWrapper2_t T)) - := - t <- mutWrapper2_id x; - let '(mw, id_back, id_back1) := t in - let back'a := - fun (ret : MutWrapper2_t T) => - {| - mutWrapper2_x := - (id_back - {| - mutWrapper2_x := ret.(mutWrapper2_x); - mutWrapper2_y := mw.(mutWrapper2_y) - |}).(mutWrapper2_x); - mutWrapper2_y := x.(mutWrapper2_y) - |} in - let back'b := - fun (ret : MutWrapper2_t T) => - {| - mutWrapper2_x := x.(mutWrapper2_x); - mutWrapper2_y := - (id_back1 - {| - mutWrapper2_x := mw.(mutWrapper2_x); - mutWrapper2_y := ret.(mutWrapper2_y) - |}).(mutWrapper2_y) - |} in - Ok (mw, back'a, back'b) -. - -(** [adt_borrows::array_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 170:0-172: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 174:0-176:1 *) -Definition array_mut_borrow - {N : usize} (x : array u32 N) : - result ((array u32 N) * (array u32 N -> array u32 N)) - := - Ok (x, fun (ret : array u32 N) => ret) -. - -(** [adt_borrows::use_array_mut_borrow1]: - Source: 'tests/src/adt-borrows.rs', lines 178:0-180:1 *) -Definition use_array_mut_borrow1 - {N : usize} (x : array u32 N) : - result ((array u32 N) * (array u32 N -> array u32 N)) - := - array_mut_borrow x -. - -(** [adt_borrows::use_array_mut_borrow2]: - Source: 'tests/src/adt-borrows.rs', lines 182:0-185:1 *) -Definition use_array_mut_borrow2 - {N : usize} (x : array u32 N) : - result ((array u32 N) * (array u32 N -> array u32 N)) - := - p <- array_mut_borrow x; - let (x1, array_mut_borrow_back) := p in - p1 <- array_mut_borrow x1; - let (a, array_mut_borrow_back1) := p1 in - let back := - fun (ret : array u32 N) => - let x2 := array_mut_borrow_back1 ret in array_mut_borrow_back x2 in - Ok (a, back) -. - -(** [adt_borrows::boxed_slice_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 187:0-189: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 191:0-193:1 *) -Definition boxed_slice_mut_borrow - (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := - Ok (x, fun (ret : slice u32) => ret) -. - -(** [adt_borrows::use_boxed_slice_mut_borrow1]: - Source: 'tests/src/adt-borrows.rs', lines 195:0-197:1 *) -Definition use_boxed_slice_mut_borrow1 - (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := - boxed_slice_mut_borrow x -. - -(** [adt_borrows::use_boxed_slice_mut_borrow2]: - Source: 'tests/src/adt-borrows.rs', lines 199:0-202:1 *) -Definition use_boxed_slice_mut_borrow2 - (x : slice u32) : result ((slice u32) * (slice u32 -> slice u32)) := - p <- boxed_slice_mut_borrow x; - let (x1, boxed_slice_mut_borrow_back) := p in - p1 <- boxed_slice_mut_borrow x1; - let (s, boxed_slice_mut_borrow_back1) := p1 in - let back := - fun (ret : slice u32) => - let s1 := boxed_slice_mut_borrow_back1 ret in - boxed_slice_mut_borrow_back s1 in - Ok (s, back) -. - -(** [adt_borrows::SharedList] - Source: 'tests/src/adt-borrows.rs', lines 207:0-210: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 214:4-216: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 218:4-224: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 227:0-230: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 234:4-236: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 238:4-244: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 247:0-249: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 251:0-253: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 255:0-258: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 261:4-270: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 260:0-270: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 273:4-282: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 272:0-282: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 -. - -(** [adt_borrows::update_array_mut_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 284:0-286:1 *) -Definition update_array_mut_borrow - (a : array u32 32%usize) : - result ((array u32 32%usize) * (array u32 32%usize -> array u32 32%usize)) - := - Ok (a, fun (ret : array u32 32%usize) => ret) -. - -(** [adt_borrows::array_mut_borrow_loop1]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 289:4-291:5 *) -Fixpoint array_mut_borrow_loop1_loop - (b : bool) (a : array u32 32%usize) : result (array u32 32%usize) := - if b - then ( - p <- update_array_mut_borrow a; - let (a1, update_array_mut_borrow_back) := p in - a2 <- array_mut_borrow_loop1_loop true a1; - Ok (update_array_mut_borrow_back a2)) - else Ok a -. - -(** [adt_borrows::array_mut_borrow_loop1]: - Source: 'tests/src/adt-borrows.rs', lines 288:0-292:1 *) -Definition array_mut_borrow_loop1 - (b : bool) (a : array u32 32%usize) : result (array u32 32%usize) := - array_mut_borrow_loop1_loop b a -. - -(** [adt_borrows::array_mut_borrow_loop2]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 295:4-297:5 *) -Fixpoint array_mut_borrow_loop2_loop - (b : bool) (a : array u32 32%usize) : - result ((array u32 32%usize) * (array u32 32%usize -> array u32 32%usize)) - := - if b - then ( - p <- update_array_mut_borrow a; - let (a1, update_array_mut_borrow_back) := p in - p1 <- array_mut_borrow_loop2_loop true a1; - let (a2, back) := p1 in - let back1 := - fun (ret : array u32 32%usize) => - let a3 := back ret in update_array_mut_borrow_back a3 in - Ok (a2, back1)) - else Ok (a, fun (ret : array u32 32%usize) => ret) -. - -(** [adt_borrows::array_mut_borrow_loop2]: - Source: 'tests/src/adt-borrows.rs', lines 294:0-299:1 *) -Definition array_mut_borrow_loop2 - (b : bool) (a : array u32 32%usize) : - result ((array u32 32%usize) * (array u32 32%usize -> array u32 32%usize)) - := - array_mut_borrow_loop2_loop b a -. - -(** [adt_borrows::copy_shared_array]: - Source: 'tests/src/adt-borrows.rs', lines 301:0-303:1 *) -Definition copy_shared_array - (a : array u32 32%usize) : result (array u32 32%usize) := - Ok a -. - -(** [adt_borrows::array_shared_borrow_loop1]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 306:4-308:5 *) -Fixpoint array_shared_borrow_loop1_loop - (b : bool) (a : array u32 32%usize) : result unit := - if b - then (a1 <- copy_shared_array a; array_shared_borrow_loop1_loop true a1) - else Ok tt -. - -(** [adt_borrows::array_shared_borrow_loop1]: - Source: 'tests/src/adt-borrows.rs', lines 305:0-309:1 *) -Definition array_shared_borrow_loop1 - (b : bool) (a : array u32 32%usize) : result unit := - array_shared_borrow_loop1_loop b a -. - -(** [adt_borrows::array_shared_borrow_loop2]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 312:4-314:5 *) -Fixpoint array_shared_borrow_loop2_loop - (b : bool) (a : array u32 32%usize) : result (array u32 32%usize) := - if b - then (a1 <- copy_shared_array a; array_shared_borrow_loop2_loop true a1) - else Ok a -. - -(** [adt_borrows::array_shared_borrow_loop2]: - Source: 'tests/src/adt-borrows.rs', lines 311:0-316:1 *) -Definition array_shared_borrow_loop2 - (b : bool) (a : array u32 32%usize) : result (array u32 32%usize) := - array_shared_borrow_loop2_loop b a -. - -End AdtBorrows. diff --git a/tests/fstar/misc/AdtBorrows.fst b/tests/fstar/misc/AdtBorrows.fst deleted file mode 100644 index 1aac4abe1..000000000 --- a/tests/fstar/misc/AdtBorrows.fst +++ /dev/null @@ -1,484 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [adt_borrows] *) -module AdtBorrows -open Primitives - -#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" - -(** [adt_borrows::SharedWrapper] - 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 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 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 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 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 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 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 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 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 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 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 62:0-69:1 *) -let use_shared_wrapper2 : result unit = - let* w = sharedWrapper2_create 0 1 in - let* p = sharedWrapper2_unwrap w in - let (px, py) = p in - 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 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 74:4-76:5 *) -let mutWrapper_create - (#t : Type0) (x : t) : result ((mutWrapper_t t) & (mutWrapper_t t -> t)) = - 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 *) -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::{adt_borrows::MutWrapper<'a, T>}#3::id]: - Source: 'tests/src/adt-borrows.rs', lines 82:4-84:5 *) -let mutWrapper_id - (#t : Type0) (self : mutWrapper_t t) : - result ((mutWrapper_t t) & (mutWrapper_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 87:0-93:1 *) -let use_mut_wrapper : result unit = - let* (w, create_back) = mutWrapper_create 0 in - let* (p, unwrap_back) = mutWrapper_unwrap w in - let* p1 = i32_add p 1 in - let x = create_back (unwrap_back p1) in - if x = 1 then Ok () else Fail Failure - -(** [adt_borrows::use_mut_wrapper_id]: - Source: 'tests/src/adt-borrows.rs', lines 95:0-97:1 *) -let use_mut_wrapper_id - (#t : Type0) (x : mutWrapper_t t) : - result ((mutWrapper_t t) & (mutWrapper_t t -> mutWrapper_t t)) - = - let* (mw, id_back) = mutWrapper_id x in - let back = fun ret -> id_back ret in - Ok (mw, back) - -(** [adt_borrows::MutWrapper1] - Source: 'tests/src/adt-borrows.rs', lines 99:0-101:1 *) -type mutWrapper1_t (t : Type0) = { x : t; } - -(** [adt_borrows::{adt_borrows::MutWrapper1<'a, T>}#4::create]: - Source: 'tests/src/adt-borrows.rs', lines 104:4-106: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 108:4-110: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::{adt_borrows::MutWrapper1<'a, T>}#4::id]: - Source: 'tests/src/adt-borrows.rs', lines 112:4-114:5 *) -let mutWrapper1_id - (#t : Type0) (self : mutWrapper1_t t) : - result ((mutWrapper1_t t) & (mutWrapper1_t t -> mutWrapper1_t t)) - = - Ok (self, (fun ret -> ret)) - -(** [adt_borrows::use_mut_wrapper1]: - Source: 'tests/src/adt-borrows.rs', lines 117:0-123:1 *) -let use_mut_wrapper1 : result unit = - let* (w, create_back) = mutWrapper1_create 0 in - let* (p, unwrap_back) = mutWrapper1_unwrap w in - let* p1 = i32_add p 1 in - let x = create_back (unwrap_back p1) in - if x = 1 then Ok () else Fail Failure - -(** [adt_borrows::use_mut_wrapper1_id]: - Source: 'tests/src/adt-borrows.rs', lines 125:0-127:1 *) -let use_mut_wrapper1_id - (#t : Type0) (x : mutWrapper1_t t) : - result ((mutWrapper1_t t) & (mutWrapper1_t t -> mutWrapper1_t t)) - = - mutWrapper1_id x - -(** [adt_borrows::MutWrapper2] - Source: 'tests/src/adt-borrows.rs', lines 129:0-132: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 135:4-137:5 *) -let mutWrapper2_create - (#t : Type0) (x : t) (y : t) : - result ((mutWrapper2_t t) & (mutWrapper2_t t -> t) & (mutWrapper2_t t -> t)) - = - let back'a = fun ret -> ret.x in - let back'b = fun ret -> ret.y in - Ok ({ x; y }, back'a, back'b) - -(** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::unwrap]: - Source: 'tests/src/adt-borrows.rs', lines 139:4-141:5 *) -let mutWrapper2_unwrap - (#t : Type0) (self : mutWrapper2_t t) : - result ((t & t) & (t -> mutWrapper2_t t) & (t -> mutWrapper2_t t)) - = - let back'a = fun ret -> { self with x = ret } in - let back'b = fun ret -> { self with y = ret } in - Ok ((self.x, self.y), back'a, back'b) - -(** [adt_borrows::{adt_borrows::MutWrapper2<'a, 'b, T>}#5::id]: - Source: 'tests/src/adt-borrows.rs', lines 143:4-145:5 *) -let mutWrapper2_id - (#t : Type0) (self : mutWrapper2_t t) : - result ((mutWrapper2_t t) & (mutWrapper2_t t -> mutWrapper2_t t) & - (mutWrapper2_t t -> mutWrapper2_t t)) - = - let back'a = fun ret -> { self with x = ret.x } in - let back'b = fun ret -> { self with y = ret.y } in - Ok (self, back'a, back'b) - -(** [adt_borrows::use_mut_wrapper2]: - Source: 'tests/src/adt-borrows.rs', lines 148:0-157: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 - let (px, py) = p in - let* px1 = i32_add px 1 in - let* py1 = i32_add py 1 in - let x = create_back { w with x = (unwrap_back px1).x } in - if x = 1 - then - let y = create_back1 { w with y = (unwrap_back1 py1).y } in - if y = 11 then Ok () else Fail Failure - else Fail Failure - -(** [adt_borrows::use_mut_wrapper2_id]: - Source: 'tests/src/adt-borrows.rs', lines 159:0-161:1 *) -let use_mut_wrapper2_id - (#t : Type0) (x : mutWrapper2_t t) : - result ((mutWrapper2_t t) & (mutWrapper2_t t -> mutWrapper2_t t) & - (mutWrapper2_t t -> mutWrapper2_t t)) - = - let* (mw, id_back, id_back1) = mutWrapper2_id x in - let back'a = fun ret -> { x with x = (id_back { mw with x = ret.x }).x } in - let back'b = fun ret -> { x with y = (id_back1 { mw with y = ret.y }).y } in - Ok (mw, back'a, back'b) - -(** [adt_borrows::array_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 170:0-172: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 174:0-176:1 *) -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)) - -(** [adt_borrows::use_array_mut_borrow1]: - Source: 'tests/src/adt-borrows.rs', lines 178:0-180:1 *) -let use_array_mut_borrow1 - (#n : usize) (x : array u32 n) : - result ((array u32 n) & (array u32 n -> array u32 n)) - = - array_mut_borrow x - -(** [adt_borrows::use_array_mut_borrow2]: - Source: 'tests/src/adt-borrows.rs', lines 182:0-185:1 *) -let use_array_mut_borrow2 - (#n : usize) (x : array u32 n) : - result ((array u32 n) & (array u32 n -> array u32 n)) - = - let* (x1, array_mut_borrow_back) = array_mut_borrow x in - let* (a, array_mut_borrow_back1) = array_mut_borrow x1 in - let back = - fun ret -> let x2 = array_mut_borrow_back1 ret in array_mut_borrow_back x2 - in - Ok (a, back) - -(** [adt_borrows::boxed_slice_shared_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 187:0-189: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 191:0-193:1 *) -let boxed_slice_mut_borrow - (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = - Ok (x, (fun ret -> ret)) - -(** [adt_borrows::use_boxed_slice_mut_borrow1]: - Source: 'tests/src/adt-borrows.rs', lines 195:0-197:1 *) -let use_boxed_slice_mut_borrow1 - (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = - boxed_slice_mut_borrow x - -(** [adt_borrows::use_boxed_slice_mut_borrow2]: - Source: 'tests/src/adt-borrows.rs', lines 199:0-202:1 *) -let use_boxed_slice_mut_borrow2 - (x : slice u32) : result ((slice u32) & (slice u32 -> slice u32)) = - let* (x1, boxed_slice_mut_borrow_back) = boxed_slice_mut_borrow x in - let* (s, boxed_slice_mut_borrow_back1) = boxed_slice_mut_borrow x1 in - let back = - fun ret -> - let s1 = boxed_slice_mut_borrow_back1 ret in - boxed_slice_mut_borrow_back s1 in - Ok (s, back) - -(** [adt_borrows::SharedList] - Source: 'tests/src/adt-borrows.rs', lines 207:0-210: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 214:4-216: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 218:4-224: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 227:0-230: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 234:4-236: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 238:4-244: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 247:0-249: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 251:0-253: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 255:0-258: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 261:4-270: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 260:0-270: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 273:4-282: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 272:0-282: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 - -(** [adt_borrows::update_array_mut_borrow]: - Source: 'tests/src/adt-borrows.rs', lines 284:0-286:1 *) -let update_array_mut_borrow - (a : array u32 32) : - result ((array u32 32) & (array u32 32 -> array u32 32)) - = - Ok (a, (fun ret -> ret)) - -(** [adt_borrows::array_mut_borrow_loop1]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 289:4-291:5 *) -let rec array_mut_borrow_loop1_loop - (b : bool) (a : array u32 32) : result (array u32 32) = - if b - then - let* (a1, update_array_mut_borrow_back) = update_array_mut_borrow a in - let* a2 = array_mut_borrow_loop1_loop true a1 in - Ok (update_array_mut_borrow_back a2) - else Ok a - -(** [adt_borrows::array_mut_borrow_loop1]: - Source: 'tests/src/adt-borrows.rs', lines 288:0-292:1 *) -let array_mut_borrow_loop1 - (b : bool) (a : array u32 32) : result (array u32 32) = - array_mut_borrow_loop1_loop b a - -(** [adt_borrows::array_mut_borrow_loop2]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 295:4-297:5 *) -let rec array_mut_borrow_loop2_loop - (b : bool) (a : array u32 32) : - result ((array u32 32) & (array u32 32 -> array u32 32)) - = - if b - then - let* (a1, update_array_mut_borrow_back) = update_array_mut_borrow a in - let* (a2, back) = array_mut_borrow_loop2_loop true a1 in - let back1 = fun ret -> let a3 = back ret in update_array_mut_borrow_back a3 - in - Ok (a2, back1) - else Ok (a, (fun ret -> ret)) - -(** [adt_borrows::array_mut_borrow_loop2]: - Source: 'tests/src/adt-borrows.rs', lines 294:0-299:1 *) -let array_mut_borrow_loop2 - (b : bool) (a : array u32 32) : - result ((array u32 32) & (array u32 32 -> array u32 32)) - = - array_mut_borrow_loop2_loop b a - -(** [adt_borrows::copy_shared_array]: - Source: 'tests/src/adt-borrows.rs', lines 301:0-303:1 *) -let copy_shared_array (a : array u32 32) : result (array u32 32) = - Ok a - -(** [adt_borrows::array_shared_borrow_loop1]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 306:4-308:5 *) -let rec array_shared_borrow_loop1_loop - (b : bool) (a : array u32 32) : result unit = - if b - then let* a1 = copy_shared_array a in array_shared_borrow_loop1_loop true a1 - else Ok () - -(** [adt_borrows::array_shared_borrow_loop1]: - Source: 'tests/src/adt-borrows.rs', lines 305:0-309:1 *) -let array_shared_borrow_loop1 (b : bool) (a : array u32 32) : result unit = - array_shared_borrow_loop1_loop b a - -(** [adt_borrows::array_shared_borrow_loop2]: loop 0: - Source: 'tests/src/adt-borrows.rs', lines 312:4-314:5 *) -let rec array_shared_borrow_loop2_loop - (b : bool) (a : array u32 32) : result (array u32 32) = - if b - then let* a1 = copy_shared_array a in array_shared_borrow_loop2_loop true a1 - else Ok a - -(** [adt_borrows::array_shared_borrow_loop2]: - Source: 'tests/src/adt-borrows.rs', lines 311:0-316:1 *) -let array_shared_borrow_loop2 - (b : bool) (a : array u32 32) : result (array u32 32) = - array_shared_borrow_loop2_loop b a - diff --git a/tests/src/adt-borrows.rs b/tests/src/adt-borrows.rs index fe8a3e58a..ac2201daf 100644 --- a/tests/src/adt-borrows.rs +++ b/tests/src/adt-borrows.rs @@ -1,4 +1,4 @@ -//@ [coq,fstar] subdir=misc +//@ [coq,fstar] skip //! This file contains tests with ADTs containing borrows. // From 4421f379249782e8d7d7f708f2a6f90a89b072e9 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Jan 2025 22:24:50 +0000 Subject: [PATCH 23/23] Simplify the handling of borrow/loan projectors --- src/interp/InterpreterBorrows.ml | 107 +++++++++---------- src/interp/InterpreterBorrows.mli | 16 +-- src/interp/InterpreterBorrowsCore.ml | 99 ++++++++--------- src/interp/InterpreterExpansion.ml | 34 +++--- src/interp/InterpreterLoops.ml | 8 +- src/interp/InterpreterLoopsCore.ml | 18 ++-- src/interp/InterpreterLoopsFixedPoint.ml | 12 +-- src/interp/InterpreterLoopsJoinCtxs.ml | 26 ++--- src/interp/InterpreterLoopsMatchCtxs.ml | 103 +++++++++--------- src/interp/InterpreterProjectors.ml | 4 +- src/interp/InterpreterUtils.ml | 23 ++-- src/interp/Invariants.ml | 52 ++++----- src/llbc/Print.ml | 12 +-- src/llbc/Values.ml | 21 ++-- src/llbc/ValuesUtils.ml | 10 +- src/symbolic/SymbolicToPure.ml | 29 +++-- tests/src/mutually-recursive-traits.lean.out | 2 +- 17 files changed, 300 insertions(+), 276 deletions(-) diff --git a/src/interp/InterpreterBorrows.ml b/src/interp/InterpreterBorrows.ml index 2ace641a6..ecac20ca7 100644 --- a/src/interp/InterpreterBorrows.ml +++ b/src/interp/InterpreterBorrows.ml @@ -459,18 +459,16 @@ let give_back_value (config : config) (span : Meta.span) (bid : BorrowId.id) over those borrows. *) let end_aproj_borrows (span : Meta.span) (ended_regions : RegionId.Set.t) - (proj_ty : rty) (sv : symbolic_value) (nsv : symbolic_value) + (proj_ty : rty) (sv_id : symbolic_value_id) (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; + sanity_check __FILE__ __LINE__ (sv_id <> nsv.sv_id && ty_is_rty proj_ty) span; log#ltrace (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 + ^ symbolic_value_id_to_pretty_string sv_id ^ "\n- nsv: " ^ symbolic_value_to_string ctx nsv ^ "\n- ctx: " ^ eval_ctx_to_string ctx)); @@ -504,36 +502,36 @@ let end_aproj_borrows (span : Meta.span) (ended_regions : RegionId.Set.t) - 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 = + let update_ancestors (_abs : abs) (abs_sv_id : symbolic_value_id) + (abs_proj_ty : rty) (local_given_back : (msymbolic_value_id * aproj) list) + : aproj = (* Compute the projection over the given back value *) - let child_proj = AProjLoans (nsv, abs_proj_ty, []) in - AProjBorrows (abs_sv, abs_proj_ty, (sv, child_proj) :: local_given_back) + let child_proj = AProjLoans (nsv.sv_id, abs_proj_ty, []) in + AProjBorrows + (abs_sv_id, abs_proj_ty, (sv_id, child_proj) :: local_given_back) in let 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 + ~update_mut:update_ancestors ended_regions sv_id 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 = + let update_owned (_abs : abs) (_abs_sv_id : symbolic_value_id) + (_abs_proj_ty : rty) + (local_given_back : (msymbolic_value_id * aproj) list) : aproj = (* There is nothing to project *) - let mvalues = { consumed = sv; given_back = nsv } in + let mvalues = { consumed = sv_id; 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 - ~update_mut:update_owned ended_regions sv proj_ty ctx + ~update_mut:update_owned ended_regions sv_id proj_ty ctx (** Give back a *modified* symbolic value. *) let give_back_symbolic_value (_config : config) (span : Meta.span) - (ended_regions : RegionId.Set.t) (proj_ty : rty) (sv : symbolic_value) + (ended_regions : RegionId.Set.t) (proj_ty : rty) (sv_id : symbolic_value_id) (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; + sanity_check __FILE__ __LINE__ (sv_id <> nsv.sv_id && ty_is_rty proj_ty) span; (* 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 @@ -567,21 +565,21 @@ let give_back_symbolic_value (_config : config) (span : Meta.span) *) 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 (abs_sv, abs_proj_ty, (sv, child_proj) :: local_given_back) + let child_proj = AProjBorrows (nsv.sv_id, abs_proj_ty, []) in + AProjLoans (abs_sv, abs_proj_ty, (sv_id, child_proj) :: local_given_back) in let ctx = update_intersecting_aproj_loans span ~fail_if_unchanged:false - ~include_ancestors:true ~include_owned:false ended_regions proj_ty sv + ~include_ancestors:true ~include_owned:false ended_regions proj_ty sv_id subst_ancestors ctx in let subst_owned (_abs : abs) abs_sv _abs_proj_ty local_given_back = (* There is nothing to project *) let child_proj = AEmpty in - AEndedProjLoans (abs_sv, (nsv, child_proj) :: local_given_back) + AEndedProjLoans (abs_sv, (nsv.sv_id, child_proj) :: local_given_back) in update_intersecting_aproj_loans span ~fail_if_unchanged:true - ~include_ancestors:false ~include_owned:true ended_regions proj_ty sv + ~include_ancestors:false ~include_owned:true ended_regions proj_ty sv_id subst_owned ctx (** Auxiliary function to end borrows. See {!give_back}. @@ -1459,7 +1457,8 @@ 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) (proj_ty : rty) : cm_fun = + (regions : RegionId.Set.t) (sv_id : symbolic_value_id) (proj_ty : rty) : + cm_fun = fun ctx -> log#ltrace (lazy @@ -1468,16 +1467,16 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) ^ "\n- regions: " ^ RegionId.Set.to_string None regions ^ "\n- sv: " - ^ symbolic_value_to_string ctx sv + ^ symbolic_value_id_to_pretty_string sv_id ^ "\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 + let check ctx = no_aproj_over_symbolic_in_context span sv_id 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 proj_ty - ctx + lookup_intersecting_aproj_borrows_opt span explore_shared regions sv_id + proj_ty ctx with | None -> (* We couldn't find any in the context: it means that the symbolic value @@ -1485,7 +1484,7 @@ and end_proj_loans_symbolic (config : config) (span : Meta.span) 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 + let ctx = update_aproj_loans_to_ended span abs_id sv_id ctx in (* Sanity check *) check ctx; (* Continue *) @@ -1535,10 +1534,10 @@ 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 proj_ty ctx + ~include_owned:true regions sv_id proj_ty ctx in (* End the loan itself *) - update_aproj_loans_to_ended span abs_id sv ctx + update_aproj_loans_to_ended span abs_id sv_id ctx in (* Sanity check *) check ctx; @@ -1587,8 +1586,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 proj_ty - ctx) + (end_proj_loans_symbolic config span chain abs_id regions sv_id + proj_ty ctx) in (* Sanity check *) check ctx; @@ -2015,17 +2014,17 @@ let find_first_endable_loan_proj_in_abs (span : Meta.span) (ctx : eval_ctx) method! visit_aproj env proj = match proj with - | AProjLoans (sv, proj_ty, _) -> + | AProjLoans (sv_id, proj_ty, _) -> (* Check if there are borrow projectors in the context *) let explore_shared = false in begin match lookup_intersecting_aproj_borrows_opt span explore_shared - abs.regions.owned sv proj_ty ctx + abs.regions.owned sv_id proj_ty ctx with | None -> (* No intersecting projections: we can end this loan projector *) - raise (FoundAbsProj (abs.abs_id, sv)) + raise (FoundAbsProj (abs.abs_id, sv_id)) | Some _ -> (* There are intersecting projections: we can't end this loan projector *) super#visit_aproj env proj @@ -2353,7 +2352,7 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) end in let ty = visitor#visit_ty () sv.sv_ty in - let nv = ASymbolic (PNone, AProjBorrows (sv, ty, [])) in + let nv = ASymbolic (PNone, AProjBorrows (sv.sv_id, ty, [])) in let nv : typed_avalue = { value = nv; ty } in ([ nv ], v) else @@ -2385,7 +2384,7 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (* Introduce the abstractions *) RegionId.Map.iter (fun _ rid -> - let nv = ASymbolic (PNone, AProjBorrows (sv, ty, [])) in + let nv = ASymbolic (PNone, AProjBorrows (sv.sv_id, ty, [])) in let nv : typed_avalue = { value = nv; ty } in push_abs rid [ nv ]) !regions; @@ -2579,12 +2578,12 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) | Abstract ty -> ty in match proj with - | AProjLoans (sv, proj_ty, children) -> + | AProjLoans (sv_id, proj_ty, children) -> sanity_check __FILE__ __LINE__ (children = []) span; - push_loan_proj pm sv.sv_id proj_ty (ty, pm, proj) - | AProjBorrows (sv, proj_ty, children) -> + push_loan_proj pm sv_id proj_ty (ty, pm, proj) + | AProjBorrows (sv_id, proj_ty, children) -> sanity_check __FILE__ __LINE__ (children = []) span; - push_borrow_proj pm sv.sv_id proj_ty (ty, pm, proj) + push_borrow_proj pm sv_id proj_ty (ty, pm, proj) | AEndedProjLoans _ | AEndedProjBorrows _ -> craise __FILE__ __LINE__ span "Unreachable" | AEmpty -> () @@ -2681,14 +2680,14 @@ type merge_duplicates_funcs = { merge_aborrow_projs : ty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> ty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> ty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> ty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> typed_avalue; (** Parameters: - [ty0] @@ -2705,14 +2704,14 @@ type merge_duplicates_funcs = { merge_aloan_projs : ty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> ty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> ty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> ty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> typed_avalue; (** Parameters: - [ty0] @@ -3624,9 +3623,9 @@ let merge_abstractions_merge_markers (span : Meta.span) let loan_content_to_ids ((_, pm, proj) : ty * proj_marker * aproj) : marked_norm_symb_proj = match proj with - | AProjLoans (sv, proj_ty, _) -> + | AProjLoans (sv_id, proj_ty, _) -> let norm_proj_ty = normalize_proj_ty owned_regions proj_ty in - { pm; sv_id = sv.sv_id; norm_proj_ty } + { pm; sv_id; norm_proj_ty } | _ -> internal_error __FILE__ __LINE__ span let avalue_from_bc = avalue_from_borrow_proj @@ -3839,7 +3838,7 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span) (allow_markers : bool) | ASymbolic (pm, aproj) -> begin sanity_check __FILE__ __LINE__ (allow_markers || pm = PNone) span; match aproj with - | AProjLoans (sv, _, _) | AProjBorrows (sv, _, _) -> sv.sv_id + | AProjLoans (sv_id, _, _) | AProjBorrows (sv_id, _, _) -> sv_id | _ -> craise __FILE__ __LINE__ span "Unexpected" end | _ -> craise __FILE__ __LINE__ span "Unexpected" diff --git a/src/interp/InterpreterBorrows.mli b/src/interp/InterpreterBorrows.mli index b3d5fac21..78499fd74 100644 --- a/src/interp/InterpreterBorrows.mli +++ b/src/interp/InterpreterBorrows.mli @@ -236,14 +236,14 @@ type merge_duplicates_funcs = { merge_aborrow_projs : ty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> ty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> ty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> ty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> typed_avalue; (** Parameters: - [ty0] @@ -260,14 +260,14 @@ type merge_duplicates_funcs = { merge_aloan_projs : ty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> ty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> ty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> ty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> typed_avalue; (** Parameters: - [ty0] diff --git a/src/interp/InterpreterBorrowsCore.ml b/src/interp/InterpreterBorrowsCore.ml index 262c887d0..8e1e4c115 100644 --- a/src/interp/InterpreterBorrowsCore.ml +++ b/src/interp/InterpreterBorrowsCore.ml @@ -37,7 +37,7 @@ type borrow_ids = Borrows of BorrowId.Set.t | Borrow of BorrowId.id type borrow_ids_or_proj_symbolic_value = | BorrowIds of borrow_ids - | SymbolicValue of symbolic_value * rty + | SymbolicValue of symbolic_value_id * rty [@@deriving show] exception FoundBorrowIds of borrow_ids @@ -687,11 +687,11 @@ let get_first_outer_loan_or_borrow_in_value (with_borrows : bool) | FoundBorrowContent bc -> Some (BorrowContent bc) let proj_borrows_intersects_proj_loans (span : Meta.span) - (proj_borrows : RegionId.Set.t * symbolic_value * rty) - (proj_loans : RegionId.Set.t * symbolic_value * rty) : bool = - let b_regions, b_sv, b_ty = proj_borrows in - let l_regions, l_sv, l_ty = proj_loans in - if same_symbolic_id b_sv l_sv then + (proj_borrows : RegionId.Set.t * symbolic_value_id * rty) + (proj_loans : RegionId.Set.t * symbolic_value_id * rty) : bool = + let b_regions, b_sv_id, b_ty = proj_borrows in + let l_regions, l_sv_id, l_ty = proj_loans in + if b_sv_id = l_sv_id then projections_intersect span l_ty l_regions b_ty b_regions else false @@ -721,8 +721,9 @@ type looked_up_aproj_borrows = This is a helper function. *) let lookup_intersecting_aproj_borrows_opt (span : Meta.span) - (lookup_shared : bool) (regions : RegionId.Set.t) (sv : symbolic_value) - (proj_ty : rty) (ctx : eval_ctx) : looked_up_aproj_borrows option = + (lookup_shared : bool) (regions : RegionId.Set.t) + (sv_id : symbolic_value_id) (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 @@ -739,7 +740,7 @@ let lookup_intersecting_aproj_borrows_opt (span : Meta.span) if proj_borrows_intersects_proj_loans span (abs.regions.owned, sv', proj_ty') - (regions, sv, proj_ty) + (regions, sv_id, proj_ty) then let x = (abs.abs_id, proj_ty) in if is_shared then add_shared x else set_non_shared x @@ -760,9 +761,9 @@ let lookup_intersecting_aproj_borrows_opt (span : Meta.span) let abs = Option.get abs in match asb with | AsbBorrow _ -> () - | AsbProjReborrows (sv', proj_ty) -> + | AsbProjReborrows (sv_id', proj_ty) -> let is_shared = true in - check_add_proj_borrows is_shared abs sv' proj_ty + check_add_proj_borrows is_shared abs sv_id' proj_ty else () method! visit_aproj abs sproj = @@ -791,12 +792,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) (proj_ty : rty) + (regions : RegionId.Set.t) (sv_id : symbolic_value_id) (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 proj_ty - ctx + lookup_intersecting_aproj_borrows_opt span lookup_shared regions sv_id + proj_ty ctx with | None -> None | Some (NonSharedProj (abs_id, rty)) -> Some (abs_id, rty) @@ -816,11 +817,14 @@ let update_intersecting_aproj_borrows (span : Meta.span) ~(fail_if_unchanged : bool) ~(include_ancestors : bool) ~(include_owned : bool) ~(update_shared : - (abs -> symbolic_value -> rty -> abstract_shared_borrows) option) + (abs -> symbolic_value_id -> rty -> abstract_shared_borrows) option) ~(update_mut : - abs -> symbolic_value -> rty -> (msymbolic_value * aproj) list -> aproj) - (proj_regions : RegionId.Set.t) (sv : symbolic_value) (proj_ty : rty) - (ctx : eval_ctx) : eval_ctx = + abs -> + symbolic_value_id -> + rty -> + (msymbolic_value_id * aproj) list -> + aproj) (proj_regions : RegionId.Set.t) (sv_id : symbolic_value_id) + (proj_ty : rty) (ctx : eval_ctx) : eval_ctx = (* Small helpers for sanity checks *) let shared = ref None in let add_shared () = @@ -847,7 +851,7 @@ let update_intersecting_aproj_borrows (span : Meta.span) if proj_borrows_intersects_proj_loans span (intersect_regions, sv', proj_ty') - (proj_regions, sv, proj_ty) + (proj_regions, sv_id, proj_ty) then ( if is_shared then add_shared () else set_non_shared (); true) @@ -911,7 +915,7 @@ 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) (proj_ty : rty) + (proj_regions : RegionId.Set.t) (sv_id : symbolic_value_id) (proj_ty : rty) (nv : aproj) (ctx : eval_ctx) : eval_ctx = (* Small helpers *) let updated = ref false in @@ -924,7 +928,7 @@ let update_intersecting_aproj_borrows_mut (span : Meta.span) let 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 + proj_regions sv_id proj_ty ctx in (* Check that we updated at least once *) sanity_check __FILE__ __LINE__ !updated span; @@ -938,14 +942,14 @@ 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) (proj_ty : rty) + (regions : RegionId.Set.t) (sv_id : symbolic_value_id) (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 ~fail_if_unchanged:true - ~include_ancestors ~include_owned ~update_shared ~update_mut regions sv + ~include_ancestors ~include_owned ~update_shared ~update_mut regions sv_id proj_ty ctx (** Updates the proj_loans intersecting some projection. @@ -987,10 +991,13 @@ let remove_intersecting_aproj_borrows_shared (span : Meta.span) let update_intersecting_aproj_loans (span : Meta.span) ~(fail_if_unchanged : bool) ~(include_ancestors : bool) ~(include_owned : bool) (proj_regions : RegionId.Set.t) (proj_ty : rty) - (sv : symbolic_value) + (sv_id : symbolic_value_id) (subst : - abs -> symbolic_value -> rty -> (msymbolic_value * aproj) list -> aproj) - (ctx : eval_ctx) : eval_ctx = + abs -> + symbolic_value_id -> + rty -> + (msymbolic_value_id * aproj) list -> + aproj) (ctx : eval_ctx) : eval_ctx = (* *) sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) span; (* Small helpers for sanity checks *) @@ -1012,7 +1019,7 @@ let update_intersecting_aproj_loans (span : Meta.span) super#visit_aproj abs sproj | AProjLoans (abs_sv, abs_proj_ty, given_back) -> let abs = Option.get abs in - if same_symbolic_id sv abs_sv then + if sv_id = abs_sv then let abs_regions = RegionId.Set.empty in let abs_regions = if include_ancestors then @@ -1050,8 +1057,8 @@ let update_intersecting_aproj_loans (span : Meta.span) to the couple (abstraction id, symbolic value). *) let lookup_aproj_loans_opt (span : Meta.span) (abs_id : AbstractionId.id) - (sv : symbolic_value) (ctx : eval_ctx) : - (msymbolic_value * aproj) list option = + (sv_id : symbolic_value_id) (ctx : eval_ctx) : + (msymbolic_value_id * aproj) list option = (* Small helpers for sanity checks *) let found = ref None in let set_found x = @@ -1074,10 +1081,7 @@ let lookup_aproj_loans_opt (span : Meta.span) (abs_id : AbstractionId.id) | AProjLoans (abs_sv, _, given_back) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; - if abs_sv.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (abs_sv = sv) span; - set_found given_back) - else ()); + if abs_sv = sv_id then set_found given_back else ()); super#visit_aproj abs sproj end in @@ -1087,8 +1091,9 @@ let lookup_aproj_loans_opt (span : Meta.span) (abs_id : AbstractionId.id) !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) + (sv_id : symbolic_value_id) (ctx : eval_ctx) : + (msymbolic_value_id * aproj) list = + Option.get (lookup_aproj_loans_opt span abs_id sv_id ctx) (** Helper function: might break invariants. @@ -1099,7 +1104,7 @@ let lookup_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) to the couple (abstraction id, symbolic value). *) let update_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) - (sv : symbolic_value) (nproj : aproj) (ctx : eval_ctx) : eval_ctx = + (sv_id : symbolic_value_id) (nproj : aproj) (ctx : eval_ctx) : eval_ctx = (* Small helpers for sanity checks *) let found = ref false in let update () = @@ -1123,9 +1128,7 @@ let update_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) | AProjLoans (abs_sv, _, _) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; - if abs_sv.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (abs_sv = sv) span; - update ()) + if abs_sv = sv_id then update () else super#visit_aproj (Some abs) sproj end in @@ -1171,9 +1174,7 @@ let update_aproj_borrows (span : Meta.span) (abs_id : AbstractionId.id) | AProjBorrows (abs_sv, _proj_ty, _given_back) -> let abs = Option.get abs in sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; - if abs_sv.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (abs_sv = sv) span; - update ()) + if abs_sv = sv.sv_id then update () else super#visit_aproj (Some abs) sproj end in @@ -1193,22 +1194,22 @@ let update_aproj_borrows (span : Meta.span) (abs_id : AbstractionId.id) 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 = + (sv_id : symbolic_value_id) (ctx : eval_ctx) : eval_ctx = (* Lookup the projector of loans *) - match lookup_aproj_loans_opt span abs_id sv ctx with + match lookup_aproj_loans_opt span abs_id sv_id ctx with | Some given_back -> (* Create the new value for the projector *) - let nproj = AEndedProjLoans (sv, given_back) in + let nproj = AEndedProjLoans (sv_id, given_back) in (* Insert it *) - let ctx = update_aproj_loans span abs_id sv nproj ctx in + let ctx = update_aproj_loans span abs_id sv_id 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 = +let no_aproj_over_symbolic_in_context (span : Meta.span) + (sv_id : symbolic_value_id) (ctx : eval_ctx) : unit = (* The visitor *) let obj = object @@ -1218,7 +1219,7 @@ let no_aproj_over_symbolic_in_context (span : Meta.span) (sv : symbolic_value) (match sproj with | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> () | AProjLoans (abs_sv, _, _) | AProjBorrows (abs_sv, _, _) -> - if abs_sv.sv_id = sv.sv_id then raise Found else ()); + if abs_sv = sv_id then raise Found else ()); super#visit_aproj env sproj end in diff --git a/src/interp/InterpreterExpansion.ml b/src/interp/InterpreterExpansion.ml index 145832ecb..ab2d53246 100644 --- a/src/interp/InterpreterExpansion.ml +++ b/src/interp/InterpreterExpansion.ml @@ -77,10 +77,8 @@ let apply_symbolic_expansion_to_target_avalues (config : config) *) method! visit_aproj current_abs aproj = (match aproj with - | AProjLoans (sv, _, _) | AProjBorrows (sv, _, _) -> - sanity_check __FILE__ __LINE__ - (not (same_symbolic_id sv original_sv)) - span + | AProjLoans (sv_id, _, _) | AProjBorrows (sv_id, _, _) -> + sanity_check __FILE__ __LINE__ (sv_id <> original_sv.sv_id) span | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj current_abs aproj @@ -97,9 +95,9 @@ 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 (pm, self#visit_aproj (Some current_abs) aproj) - | AProjLoans (sv, proj_ty, given_back), LoanProj -> + | AProjLoans (sv_id, proj_ty, given_back), LoanProj -> (* Check if this is the symbolic value we are looking for *) - if same_symbolic_id sv original_sv then ( + if sv_id = original_sv.sv_id then ( (* There mustn't be any given back values *) sanity_check __FILE__ __LINE__ (given_back = []) span; (* Apply the projector *) @@ -112,7 +110,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) else (* Not the searched symbolic value: nothing to do *) super#visit_ASymbolic (Some current_abs) pm aproj - | AProjBorrows (sv, proj_ty, given_back), BorrowProj -> + | AProjBorrows (sv_id, 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 @@ -120,7 +118,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) *) 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 + if sv_id = original_sv.sv_id then (* Convert the symbolic expansion to a value on which we can * apply a projector (if the expansion is a reference expansion, * convert it to a borrow) *) @@ -311,13 +309,13 @@ let expand_symbolic_value_shared_borrow (config : config) (span : Meta.span) * projector and asb). * Returns [Some] if the symbolic value has been expanded to an asb list, * [None] otherwise *) - let reborrow_ashared proj_regions (sv : symbolic_value) (proj_ty : rty) : - abstract_shared_borrows option = - if same_symbolic_id sv original_sv then + let reborrow_ashared proj_regions (sv_id : symbolic_value_id) (proj_ty : rty) + : abstract_shared_borrows option = + if sv_id = original_sv.sv_id then match proj_ty with | TRef (r, ref_ty, RShared) -> (* Projector over the shared value *) - let shared_asb = AsbProjReborrows (sv, ref_ty) in + let shared_asb = AsbProjReborrows (sv_id, ref_ty) in (* Check if the region is in the set of projected regions *) if region_in_set r proj_regions then (* In the set: we need to reborrow *) @@ -351,8 +349,10 @@ let expand_symbolic_value_shared_borrow (config : config) (span : Meta.span) = match asb with | AsbBorrow _ -> [ asb ] - | AsbProjReborrows (sv, proj_ty) -> ( - match reborrow_ashared (Option.get proj_regions) sv proj_ty with + | AsbProjReborrows (sv_id, proj_ty) -> ( + match + reborrow_ashared (Option.get proj_regions) sv_id proj_ty + with | None -> [ asb ] | Some asb -> asb) in @@ -366,10 +366,8 @@ let expand_symbolic_value_shared_borrow (config : config) (span : Meta.span) *) method! visit_aproj proj_regions aproj = (match aproj with - | AProjLoans (sv, _, _) | AProjBorrows (sv, _, _) -> - sanity_check __FILE__ __LINE__ - (not (same_symbolic_id sv original_sv)) - span + | AProjLoans (sv_id, _, _) | AProjBorrows (sv_id, _, _) -> + sanity_check __FILE__ __LINE__ (sv_id <> original_sv.sv_id) span | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj proj_regions aproj diff --git a/src/interp/InterpreterLoops.ml b/src/interp/InterpreterLoops.ml index e1802ff2c..adc81c8dd 100644 --- a/src/interp/InterpreterLoops.ml +++ b/src/interp/InterpreterLoops.ml @@ -181,10 +181,10 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) List.filter_map (fun (av : typed_avalue) -> match av.value with - | ASymbolic (pm, AProjBorrows (sv, _proj_ty, children)) -> + | ASymbolic (pm, AProjBorrows (sv_id, _proj_ty, children)) -> sanity_check __FILE__ __LINE__ (pm = PNone) span; sanity_check __FILE__ __LINE__ (children = []) span; - Some sv.sv_id + Some sv_id | _ -> None) borrows in @@ -209,10 +209,10 @@ let eval_loop_symbolic_synthesize_fun_end (config : config) (span : span) List.filter_map (fun (av : typed_avalue) -> match av.value with - | ASymbolic (pm, AProjLoans (sv, _proj_ty, children)) -> + | ASymbolic (pm, AProjLoans (sv_id, _proj_ty, children)) -> sanity_check __FILE__ __LINE__ (pm = PNone) span; sanity_check __FILE__ __LINE__ (children = []) span; - Some sv.sv_id + Some sv_id | _ -> None) loans in diff --git a/src/interp/InterpreterLoopsCore.ml b/src/interp/InterpreterLoopsCore.ml index f362e1caa..1ac0f12dd 100644 --- a/src/interp/InterpreterLoopsCore.ml +++ b/src/interp/InterpreterLoopsCore.ml @@ -295,14 +295,14 @@ module type PrimMatcher = sig eval_ctx -> rty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> rty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> rty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> rty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> rty -> rty -> typed_avalue @@ -328,14 +328,14 @@ module type PrimMatcher = sig eval_ctx -> rty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> rty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> rty -> proj_marker -> - symbolic_value -> + symbolic_value_id -> rty -> - (msymbolic_value * aproj) list -> + (msymbolic_value_id * aproj) list -> rty -> rty -> typed_avalue @@ -563,7 +563,7 @@ let typed_avalue_add_marker (span : Meta.span) (ctx : eval_ctx) ASymbolic (pm, aproj) method! visit_symbolic_value _ sv = - (* Symbolic values can appera in shared values *) + (* Symbolic values can appear in shared values *) sanity_check __FILE__ __LINE__ (not (symbolic_value_has_borrows (Some span) ctx sv)) span; diff --git a/src/interp/InterpreterLoopsFixedPoint.ml b/src/interp/InterpreterLoopsFixedPoint.ml index 549b68df2..e6513782e 100644 --- a/src/interp/InterpreterLoopsFixedPoint.ml +++ b/src/interp/InterpreterLoopsFixedPoint.ml @@ -861,15 +861,15 @@ let compute_fixed_point_id_correspondance (span : Meta.span) | AProjLoans (_sv, _proj_ty, children) -> sanity_check __FILE__ __LINE__ (children = []) span; () - | AProjBorrows (sv, _proj_ty, children) -> + | AProjBorrows (sv_id, _proj_ty, children) -> sanity_check __FILE__ __LINE__ (children = []) span; (* Find the target borrow *) let tgt_borrow_id = - SymbolicValueId.Map.find sv.sv_id src_to_tgt_sid_map + SymbolicValueId.Map.find sv_id src_to_tgt_sid_map in (* Update the map *) tgt_borrow_to_loan_proj := - SymbolicValueId.InjSubst.add sv.sv_id tgt_borrow_id + SymbolicValueId.InjSubst.add sv_id tgt_borrow_id !tgt_borrow_to_loan_proj | AEndedProjBorrows _ | AEndedProjLoans _ | AEmpty -> (* We shouldn't get there *) @@ -944,12 +944,12 @@ let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) self#visit_typed_value true sv; self#visit_typed_avalue register child_av - method! visit_AProjLoans register sv proj_ty children = - self#visit_symbolic_value true sv; + method! visit_AProjLoans register sv_id proj_ty children = + self#visit_symbolic_value_id true sv_id; self#visit_ty register proj_ty; self#visit_list (fun register (s, p) -> - self#visit_msymbolic_value register s; + self#visit_msymbolic_value_id register s; self#visit_aproj register p) register children diff --git a/src/interp/InterpreterLoopsJoinCtxs.ml b/src/interp/InterpreterLoopsJoinCtxs.ml index 546d42d5d..d734c22a5 100644 --- a/src/interp/InterpreterLoopsJoinCtxs.ml +++ b/src/interp/InterpreterLoopsJoinCtxs.ml @@ -808,37 +808,31 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span) let value = ALoan (ASharedLoan (PNone, ids, sv, child)) in { value; ty } in - let merge_aborrow_projs ty0 _pm0 (sv0 : symbolic_value) proj_ty0 children0 - _ty1 _pm1 (sv1 : symbolic_value) _proj_ty1 children1 = + let merge_aborrow_projs ty0 _pm0 (sv0 : symbolic_value_id) proj_ty0 children0 + _ty1 _pm1 (sv1 : symbolic_value_id) _proj_ty1 children1 = (* Sanity checks *) sanity_check __FILE__ __LINE__ (children0 = []) span; sanity_check __FILE__ __LINE__ (children1 = []) span; - (* Same remarks as for [merge_amut_borrows]. - - This time we need to also merge the symbolic values. We rely on the - join matcher [JM] to do so. - *) + (* Same remarks as for [merge_amut_borrows]. *) let ty = ty0 in let proj_ty = proj_ty0 in let children = [] in - let sv = JM.match_symbolic_values ctx ctx sv0 sv1 in + sanity_check __FILE__ __LINE__ (sv0 = sv1) span; + let sv = sv0 in let value = ASymbolic (PNone, AProjBorrows (sv, proj_ty, children)) in { value; ty } in - let merge_aloan_projs ty0 _pm0 (sv0 : symbolic_value) proj_ty0 children0 _ty1 - _pm1 (sv1 : symbolic_value) _proj_ty1 children1 = + let merge_aloan_projs ty0 _pm0 (sv0 : symbolic_value_id) proj_ty0 children0 + _ty1 _pm1 (sv1 : symbolic_value_id) _proj_ty1 children1 = (* Sanity checks *) sanity_check __FILE__ __LINE__ (children0 = []) span; sanity_check __FILE__ __LINE__ (children1 = []) span; - (* Same remarks as for [merge_amut_borrows]. - - This time we need to also merge the symbolic values. We rely on the - join matcher [JM] to do so. - *) + (* Same remarks as for [merge_amut_borrows]. *) let ty = ty0 in let proj_ty = proj_ty0 in let children = [] in - let sv = JM.match_symbolic_values ctx ctx sv0 sv1 in + sanity_check __FILE__ __LINE__ (sv0 = sv1) span; + let sv = sv0 in let value = ASymbolic (PNone, AProjLoans (sv, proj_ty, children)) in { value; ty } in diff --git a/src/interp/InterpreterLoopsMatchCtxs.ml b/src/interp/InterpreterLoopsMatchCtxs.ml index 287be70ec..468c6cfbd 100644 --- a/src/interp/InterpreterLoopsMatchCtxs.ml +++ b/src/interp/InterpreterLoopsMatchCtxs.ml @@ -88,9 +88,9 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) RAbsBorrow.register_mapping false abs_to_loans abs.abs_id (pm, bid); RBorrowAbs.register_mapping true loan_to_abs (pm, bid) abs.abs_id in - let register_borrow_proj abs pm (sv : symbolic_value) (proj_ty : ty) = + let register_borrow_proj abs pm (sv_id : symbolic_value_id) (proj_ty : ty) = let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in - let proj : marked_norm_symb_proj = { pm; sv_id = sv.sv_id; norm_proj_ty } in + let proj : marked_norm_symb_proj = { pm; sv_id; norm_proj_ty } in RAbsSymbProj.register_mapping false abs_to_borrow_projs abs.abs_id proj; (* This mapping is not generally injective as it is possible to copy symbolic values. For now we still force it to be injective because we don't handle well the case @@ -107,9 +107,9 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool) *) RSymbProjAbs.register_mapping true borrow_proj_to_abs proj abs.abs_id in - let register_loan_proj abs pm (sv : symbolic_value) (proj_ty : ty) = + let register_loan_proj abs pm (sv_id : symbolic_value_id) (proj_ty : ty) = let norm_proj_ty = normalize_proj_ty abs.regions.owned proj_ty in - let proj : marked_norm_symb_proj = { pm; sv_id = sv.sv_id; norm_proj_ty } in + let proj : marked_norm_symb_proj = { pm; sv_id; norm_proj_ty } in RAbsSymbProj.register_mapping false abs_to_loan_projs abs.abs_id proj; RSymbProjAbs.register_mapping true loan_proj_to_abs proj abs.abs_id in @@ -882,9 +882,9 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct ty_refresh_regions (Some span) fresh_region_id sv0.sv_ty in let svj = mk_fresh_symbolic_value span proj_ty in - let proj_s0 = mk_aproj_borrows PLeft sv0 proj_ty in - let proj_s1 = mk_aproj_borrows PRight sv1 proj_ty in - let proj_svj = mk_aproj_loans PNone svj proj_ty in + let proj_s0 = mk_aproj_borrows PLeft sv0.sv_id proj_ty in + let proj_s1 = mk_aproj_borrows PRight sv1.sv_id proj_ty in + let proj_svj = mk_aproj_loans PNone svj.sv_id proj_ty in let avalues = [ proj_s0; proj_s1; proj_svj ] in List.iter (fun rid -> @@ -1430,19 +1430,27 @@ struct let value = ALoan (AMutLoan (PNone, id, av)) in { value; ty } - let match_aproj_borrows (ctx0 : eval_ctx) (ctx1 : eval_ctx) _ty0 pm0 sv0 - _proj_ty0 children0 _ty1 pm1 sv1 _proj_ty1 children1 ty proj_ty = + let match_aproj_borrows (ctx0 : eval_ctx) (ctx1 : eval_ctx) _ty0 pm0 sv_id0 + proj_ty0 children0 _ty1 pm1 sv_id1 proj_ty1 children1 ty proj_ty = sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span; sanity_check __FILE__ __LINE__ (children0 = [] && children1 = []) span; + (* We only want to match the ids of the symbolic values, but in order + to call [match_symbolic_values] we need to have types... *) + let sv0 = { sv_id = sv_id0; sv_ty = proj_ty0 } in + let sv1 = { sv_id = sv_id1; sv_ty = proj_ty1 } in let sv = match_symbolic_values ctx0 ctx1 sv0 sv1 in - { value = ASymbolic (PNone, AProjBorrows (sv, proj_ty, [])); ty } + { value = ASymbolic (PNone, AProjBorrows (sv.sv_id, proj_ty, [])); ty } - let match_aproj_loans (ctx0 : eval_ctx) (ctx1 : eval_ctx) _ty0 pm0 sv0 - _proj_ty0 children0 _ty1 pm1 sv1 _proj_ty1 children1 ty proj_ty = + let match_aproj_loans (ctx0 : eval_ctx) (ctx1 : eval_ctx) _ty0 pm0 sv_id0 + proj_ty0 children0 _ty1 pm1 sv_id1 proj_ty1 children1 ty proj_ty = sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span; sanity_check __FILE__ __LINE__ (children0 = [] && children1 = []) span; + (* We only want to match the ids of the symbolic values, but in order + to call [match_symbolic_values] we need to have types... *) + let sv0 = { sv_id = sv_id0; sv_ty = proj_ty0 } in + let sv1 = { sv_id = sv_id1; sv_ty = proj_ty1 } in let sv = match_symbolic_values ctx0 ctx1 sv0 sv1 in - { value = ASymbolic (PNone, AProjLoans (sv, proj_ty, [])); ty } + { value = ASymbolic (PNone, AProjLoans (sv.sv_id, proj_ty, [])); ty } let match_avalues (ctx0 : eval_ctx) (ctx1 : eval_ctx) v0 v1 = log#ldebug @@ -2021,26 +2029,25 @@ let loop_match_ctx_with_target (config : config) (span : Meta.span) let new_absl_ids, _ = compute_absl_ids new_absl in let src_fresh_borrows_map = ref BorrowId.Map.empty in let src_fresh_sids_map = ref SymbolicValueId.Map.empty in - let register_symbolic_value (sv : symbolic_value) : symbolic_value = - let id = sv.sv_id in + let register_symbolic_value_id (id : symbolic_value_id) : symbolic_value_id = (* Register the symbolic value, if it needs to be mapped *) - let id = - if - (* We map the borrows for which we computed a mapping - TODO: simplify *) - SymbolicValueId.Map.mem id tgt_to_src_sid_map - (* And which have corresponding loans in the fresh fixed-point abstractions *) - && SymbolicValueId.Set.mem - (SymbolicValueId.Map.find id tgt_to_src_sid_map) - new_absl_ids.sids - then ( - let src_id = SymbolicValueId.Map.find id tgt_to_src_sid_map in - let nid = fresh_symbolic_value_id () in - src_fresh_sids_map := - SymbolicValueId.Map.add src_id nid !src_fresh_sids_map; - nid) - else id - in - { sv with sv_id = id } + if + (* We map the borrows for which we computed a mapping - TODO: simplify *) + SymbolicValueId.Map.mem id tgt_to_src_sid_map + (* And which have corresponding loans in the fresh fixed-point abstractions *) + && SymbolicValueId.Set.mem + (SymbolicValueId.Map.find id tgt_to_src_sid_map) + new_absl_ids.sids + then ( + let src_id = SymbolicValueId.Map.find id tgt_to_src_sid_map in + let nid = fresh_symbolic_value_id () in + src_fresh_sids_map := + SymbolicValueId.Map.add src_id nid !src_fresh_sids_map; + nid) + else id + in + let register_symbolic_value (sv : symbolic_value) : symbolic_value = + { sv with sv_id = register_symbolic_value_id sv.sv_id } in let visit_tgt = object @@ -2071,10 +2078,10 @@ let loop_match_ctx_with_target (config : config) (span : Meta.span) method! visit_aproj env p = match p with | AProjLoans _ -> super#visit_aproj env p - | AProjBorrows (sv, proj_ty, children) -> + | AProjBorrows (sv_id, proj_ty, children) -> sanity_check __FILE__ __LINE__ (children = []) span; - let sv = register_symbolic_value sv in - AProjBorrows (sv, proj_ty, children) + let sv_id = register_symbolic_value_id sv_id in + AProjBorrows (sv_id, proj_ty, children) | _ -> super#visit_aproj env p end in @@ -2207,31 +2214,31 @@ let loop_match_ctx_with_target (config : config) (span : Meta.span) method! visit_aproj env proj = match proj with - | AProjLoans (sv, proj_ty, children) -> + | AProjLoans (sv_id, proj_ty, children) -> (* The logic is similar to the concrete borrows/loans cases above *) - let id = sv.sv_id in sanity_check __FILE__ __LINE__ (children = []) span; let sv_id = begin - match SymbolicValueId.Map.find_opt id !src_fresh_sids_map with + match + SymbolicValueId.Map.find_opt sv_id !src_fresh_sids_map + with | None -> sanity_check __FILE__ __LINE__ - (SymbolicValueId.InjSubst.find id src_to_tgt_maps.sid_map - = id) + (SymbolicValueId.InjSubst.find sv_id + src_to_tgt_maps.sid_map + = sv_id) span; - id + sv_id | Some id -> id end in let proj_ty = self#visit_ty env proj_ty in - (* We shouldn't need to update the type of the symbolic value itself *) - let sv_ty = sv.sv_ty in - AProjLoans ({ sv_id; sv_ty }, proj_ty, children) - | AProjBorrows (sv, proj_ty, children) -> + AProjLoans (sv_id, proj_ty, children) + | AProjBorrows (sv_id, proj_ty, children) -> sanity_check __FILE__ __LINE__ (children = []) span; (* Lookup the loan corresponding to this borrow *) let src_lid = - SymbolicValueId.InjSubst.find sv.sv_id + SymbolicValueId.InjSubst.find sv_id fp_bl_maps.borrow_to_loan_proj_map in @@ -2248,9 +2255,7 @@ let loop_match_ctx_with_target (config : config) (span : Meta.span) end in let proj_ty = self#visit_ty env proj_ty in - (* We shouldn't need to update the type of the symbolic value itself *) - let sv_ty = sv.sv_ty in - AProjBorrows ({ sv_id; sv_ty }, proj_ty, children) + AProjBorrows (sv_id, proj_ty, children) | AEndedProjBorrows _ | AEndedProjLoans _ | AEmpty -> super#visit_aproj env proj diff --git a/src/interp/InterpreterProjectors.ml b/src/interp/InterpreterProjectors.ml index 5a4c61cc8..c649b169c 100644 --- a/src/interp/InterpreterProjectors.ml +++ b/src/interp/InterpreterProjectors.ml @@ -89,7 +89,7 @@ let rec apply_proj_borrows_on_shared_borrow (span : Meta.span) (ctx : eval_ctx) (not (projections_intersect span s.sv_ty ctx.ended_regions ty regions)) span; - [ AsbProjReborrows (s, ty) ] + [ AsbProjReborrows (s.sv_id, ty) ] | _ -> craise __FILE__ __LINE__ span "Unreachable" let rec apply_proj_borrows (span : Meta.span) (check_symbolic_no_ended : bool) @@ -217,7 +217,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 (PNone, AProjBorrows (s, ty, [])) + ASymbolic (PNone, AProjBorrows (s.sv_id, ty, [])) | _ -> log#ltrace (lazy diff --git a/src/interp/InterpreterUtils.ml b/src/interp/InterpreterUtils.ml index 06f5dabdf..ab371aa4c 100644 --- a/src/interp/InterpreterUtils.ml +++ b/src/interp/InterpreterUtils.ml @@ -18,6 +18,10 @@ let log = Logging.interpreter_log let eval_ctx_to_string = Print.Contexts.eval_ctx_to_string let name_to_string = Print.EvalCtx.name_to_string let symbolic_value_to_string = Print.EvalCtx.symbolic_value_to_string + +let symbolic_value_id_to_pretty_string = + Print.Values.symbolic_value_id_to_pretty_string + let borrow_content_to_string = Print.EvalCtx.borrow_content_to_string let loan_content_to_string = Print.EvalCtx.loan_content_to_string let aborrow_content_to_string = Print.EvalCtx.aborrow_content_to_string @@ -122,7 +126,7 @@ let mk_fresh_symbolic_typed_value_from_no_regions_ty (span : Meta.span) 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 (PNone, AProjLoans (svalue, proj_ty, [])) in + let av = ASymbolic (PNone, AProjLoans (svalue.sv_id, proj_ty, [])) in let av : typed_avalue = { value = av; ty = svalue.sv_ty } in av else @@ -137,7 +141,7 @@ 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, []) + AProjBorrows (svalue.sv_id, proj_ty, []) else AEmpty (** TODO: move *) @@ -205,13 +209,14 @@ exception FoundGLoanContent of g_loan_content (** Utility exception *) exception - FoundAProjBorrows of symbolic_value * ty * (msymbolic_value * aproj) list + FoundAProjBorrows of + symbolic_value_id * ty * (msymbolic_value_id * aproj) list (** Utility exception *) exception - FoundAProjLoans of symbolic_value * ty * (msymbolic_value * aproj) list + FoundAProjLoans of symbolic_value_id * ty * (msymbolic_value_id * aproj) list -exception FoundAbsProj of abstraction_id * symbolic_value +exception FoundAbsProj of abstraction_id * symbolic_value_id let symbolic_value_id_in_ctx (sv_id : SymbolicValueId.id) (ctx : eval_ctx) : bool = @@ -224,8 +229,8 @@ 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, _, _) -> - if sv.sv_id = sv_id then raise Found else () + | AProjLoans (sv_id1, _, _) | AProjBorrows (sv_id1, _, _) -> + if sv_id1 = sv_id then raise Found else () | AEndedProjLoans _ | AEndedProjBorrows _ | AEmpty -> ()); super#visit_aproj env aproj @@ -233,8 +238,8 @@ let symbolic_value_id_in_ctx (sv_id : SymbolicValueId.id) (ctx : eval_ctx) : let visit (asb : abstract_shared_borrow) : unit = match asb with | AsbBorrow _ -> () - | AsbProjReborrows (sv, _) -> - if sv.sv_id = sv_id then raise Found else () + | AsbProjReborrows (sv_id1, _) -> + if sv_id1 = sv_id then raise Found else () in List.iter visit asb end diff --git a/src/interp/Invariants.ml b/src/interp/Invariants.ml index 2b2665cf7..919231322 100644 --- a/src/interp/Invariants.ml +++ b/src/interp/Invariants.ml @@ -398,6 +398,14 @@ let check_typing_invariant_visitor span ctx (lookups : bool) = let _, ty, _ = ty_get_ref ty in ty in + (* The types with erased regions of the symbolic values that we find *) + let sv_etys = ref SymbolicValueId.Map.empty in + let check_symbolic_value_type sv_id ty = + let ty = Substitute.erase_regions ty in + match SymbolicValueId.Map.find_opt sv_id !sv_etys with + | None -> sv_etys := SymbolicValueId.Map.add sv_id ty !sv_etys + | Some ty1 -> sanity_check __FILE__ __LINE__ (ty1 = ty) span + in object inherit [_] iter_eval_ctx as super method! visit_abs _ abs = super#visit_abs (Some abs) abs @@ -531,6 +539,7 @@ let check_typing_invariant_visitor span ctx (lookups : bool) = span | _ -> craise __FILE__ __LINE__ span "Inconsistent context")) | VSymbolic sv, ty -> + check_symbolic_value_type sv.sv_id sv.sv_ty; let ty' = Substitute.erase_regions sv.sv_ty in sanity_check __FILE__ __LINE__ (ty' = ty) span | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); @@ -706,22 +715,15 @@ let check_typing_invariant_visitor span ctx (lookups : bool) = (child_av.ty = aloan_get_expected_child_type aty) span) | ASymbolic (_, aproj), ty -> ( - let ty1 = Substitute.erase_regions ty in match aproj with - | 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 [_] *) + | AProjLoans (sv_id, proj_ty, _) -> + check_symbolic_value_type sv_id ty; let abs = Option.get info in sanity_check __FILE__ __LINE__ (ty_has_regions_in_set abs.regions.owned proj_ty) span - | 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 - - * otherwise they should have been reduced to [_] *) + | AProjBorrows (sv_id, proj_ty, _) -> + check_symbolic_value_type sv_id ty; let abs = Option.get info in sanity_check __FILE__ __LINE__ (ty_has_regions_in_set abs.regions.owned proj_ty) @@ -771,7 +773,6 @@ type proj_loans_info = { [@@deriving show] type sv_info = { - ty : rty; (** The regions shouldn't be erased *) env_count : int; aproj_borrows : proj_borrows_info list; aproj_loans : proj_loans_info list; @@ -799,8 +800,8 @@ let proj_loans_info_to_string (ctx : eval_ctx) (info : proj_loans_info) : string ^ "; proj_ty = " ^ ty_to_string ctx proj_ty ^ "}" let sv_info_to_string (ctx : eval_ctx) (info : sv_info) : string = - let { ty; env_count = _; aproj_borrows; aproj_loans } = info in - "{\n ty = " ^ ty_to_string ctx ty ^ ";\n aproj_borrows = [" + let { env_count = _; aproj_borrows; aproj_loans } = info in + "{\n aproj_borrows = [" ^ String.concat ", " (List.map (proj_borrows_info_to_string ctx) aproj_borrows) ^ "];\n aproj_loans = [" @@ -824,28 +825,27 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = (* Small utility *) let module M = SymbolicValueId.Map in let infos : sv_info M.t ref = ref M.empty in - let lookup_info (sv : symbolic_value) : sv_info = - match M.find_opt sv.sv_id !infos with + let lookup_info (sv_id : symbolic_value_id) : sv_info = + match M.find_opt sv_id !infos with | Some info -> info - | None -> - { ty = sv.sv_ty; env_count = 0; aproj_borrows = []; aproj_loans = [] } + | None -> { env_count = 0; aproj_borrows = []; aproj_loans = [] } in - let update_info (sv : symbolic_value) (info : sv_info) = - infos := M.add sv.sv_id info !infos + let update_info (sv_id : symbolic_value_id) (info : sv_info) = + infos := M.add sv_id info !infos in - let add_env_sv (sv : symbolic_value) : unit = - let info = lookup_info sv in + let add_env_sv (sv_id : symbolic_value_id) : unit = + let info = lookup_info sv_id in let info = { info with env_count = info.env_count + 1 } in - update_info sv info + update_info sv_id info in - let add_aproj_borrows (sv : symbolic_value) abs_id regions proj_ty + let add_aproj_borrows (sv : symbolic_value_id) abs_id regions proj_ty as_shared_value : unit = let info = lookup_info sv in let binfo = { abs_id; regions; proj_ty; as_shared_value } in let info = { info with aproj_borrows = binfo :: info.aproj_borrows } in update_info sv info in - let add_aproj_loans (sv : symbolic_value) proj_ty abs_id regions : unit = + let add_aproj_loans (sv : symbolic_value_id) proj_ty abs_id regions : unit = let info = lookup_info sv in let linfo = { abs_id; regions; proj_ty } in let info = { info with aproj_loans = linfo :: info.aproj_loans } in @@ -856,7 +856,7 @@ let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = object inherit [_] iter_eval_ctx as super method! visit_abs _ abs = super#visit_abs (Some abs) abs - method! visit_VSymbolic _ sv = add_env_sv sv + method! visit_VSymbolic _ sv = add_env_sv sv.sv_id method! visit_abstract_shared_borrow abs asb = let abs = Option.get abs in diff --git a/src/llbc/Print.ml b/src/llbc/Print.ml index 3d36ee522..44ff1caed 100644 --- a/src/llbc/Print.ml +++ b/src/llbc/Print.ml @@ -34,9 +34,9 @@ module Values = struct symbolic_value_id_to_pretty_string sv.sv_id ^ " : " ^ ty_to_string env sv.sv_ty - let symbolic_value_proj_to_string (env : fmt_env) (sv : symbolic_value) + let symbolic_value_proj_to_string (env : fmt_env) (sv_id : symbolic_value_id) (rty : ty) : string = - symbolic_value_id_to_pretty_string sv.sv_id ^ " <: " ^ ty_to_string env rty + symbolic_value_id_to_pretty_string 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] @@ -115,8 +115,8 @@ module Values = struct (abs : abstract_shared_borrow) : string = match abs with | AsbBorrow bid -> BorrowId.to_string bid - | AsbProjReborrows (sv, rty) -> - "{" ^ symbolic_value_proj_to_string env sv rty ^ "}" + | AsbProjReborrows (sv_id, rty) -> + "{" ^ symbolic_value_proj_to_string env sv_id rty ^ "}" let abstract_shared_borrows_to_string (env : fmt_env) (abs : abstract_shared_borrows) : string = @@ -152,7 +152,7 @@ module Values = struct | AEndedProjLoans (msv, given_back) -> let msv = if with_ended then - "original_loan = " ^ symbolic_value_to_string env msv + "original_loan = " ^ symbolic_value_id_to_pretty_string msv else "_" in let given_back = List.map snd given_back in @@ -166,7 +166,7 @@ module Values = struct let meta = if with_ended then "original_borrow = " - ^ symbolic_value_to_string env meta.consumed + ^ symbolic_value_id_to_pretty_string meta.consumed ^ ", given_back = " ^ symbolic_value_to_string env meta.given_back else "_" diff --git a/src/llbc/Values.ml b/src/llbc/Values.ml index 796b8135c..5a4763281 100644 --- a/src/llbc/Values.ml +++ b/src/llbc/Values.ml @@ -171,6 +171,7 @@ type mvalue = typed_value [@@deriving show, ord] *) type msymbolic_value = symbolic_value [@@deriving show, ord] +type msymbolic_value_id = symbolic_value_id [@@deriving show, ord] type abstraction_id = AbstractionId.id [@@deriving show, ord] type abstraction_id_set = AbstractionId.Set.t [@@deriving show, ord] @@ -179,7 +180,7 @@ type abstraction_id_set = AbstractionId.Set.t [@@deriving show, ord] type proj_marker = PNone | PLeft | PRight [@@deriving show, ord] type ended_proj_borrow_meta = { - consumed : msymbolic_value; + consumed : msymbolic_value_id; given_back : msymbolic_value; } [@@deriving show, ord] @@ -196,6 +197,9 @@ class ['self] iter_typed_avalue_base = method visit_msymbolic_value : 'env -> msymbolic_value -> unit = fun _ _ -> () + method visit_msymbolic_value_id : 'env -> msymbolic_value_id -> unit = + fun _ _ -> () + method visit_region_id_set : 'env -> region_id_set -> unit = fun _ _ -> () method visit_abstraction_id : 'env -> abstraction_id -> unit = fun _ _ -> () @@ -221,6 +225,10 @@ class ['self] map_typed_avalue_base = method visit_msymbolic_value : 'env -> msymbolic_value -> msymbolic_value = fun _ m -> m + method visit_msymbolic_value_id + : 'env -> msymbolic_value_id -> msymbolic_value_id = + fun _ m -> m + method visit_region_id_set : 'env -> region_id_set -> region_id_set = fun _ s -> s @@ -258,13 +266,13 @@ class ['self] map_typed_avalue_base = *) type abstract_shared_borrow = | AsbBorrow of borrow_id - | AsbProjReborrows of symbolic_value * ty + | AsbProjReborrows of symbolic_value_id * ty (** A set of abstract shared borrows *) and abstract_shared_borrows = abstract_shared_borrow list and aproj = - | AProjLoans of symbolic_value * ty * (msymbolic_value * aproj) list + | AProjLoans of symbolic_value_id * ty * (msymbolic_value_id * aproj) list (** A projector of loans over a symbolic value. Whenever we call a function, we introduce a symbolic value for @@ -307,7 +315,7 @@ and aproj = 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 + | AProjBorrows of symbolic_value_id * ty * (msymbolic_value_id * 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}. @@ -333,14 +341,15 @@ and aproj = 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 + | AEndedProjLoans of msymbolic_value_id * (msymbolic_value_id * aproj) list (** An ended projector of loans over a symbolic value. See the explanations for {!AProjLoans} Note that we keep the original symbolic value as a meta-value. *) - | AEndedProjBorrows of ended_proj_borrow_meta * (msymbolic_value * aproj) list + | AEndedProjBorrows of + ended_proj_borrow_meta * (msymbolic_value_id * aproj) list (** The only purpose of {!AEndedProjBorrows} is to store, for synthesis purposes: - the symbolic value which was consumed upon creating the projection diff --git a/src/llbc/ValuesUtils.ml b/src/llbc/ValuesUtils.ml index b0c1719c7..c00c19213 100644 --- a/src/llbc/ValuesUtils.ml +++ b/src/llbc/ValuesUtils.ml @@ -91,11 +91,13 @@ let is_unit (v : typed_value) : bool = | VAdt av -> av.variant_id = None && av.field_values = [] | _ -> false -let mk_aproj_borrows (pm : proj_marker) (sv : symbolic_value) (proj_ty : ty) = - { value = ASymbolic (pm, AProjBorrows (sv, proj_ty, [])); ty = proj_ty } +let mk_aproj_borrows (pm : proj_marker) (sv_id : symbolic_value_id) + (proj_ty : ty) = + { value = ASymbolic (pm, AProjBorrows (sv_id, proj_ty, [])); ty = proj_ty } -let mk_aproj_loans (pm : proj_marker) (sv : symbolic_value) (proj_ty : ty) = - { value = ASymbolic (pm, AProjLoans (sv, proj_ty, [])); ty = proj_ty } +let mk_aproj_loans (pm : proj_marker) (sv_id : symbolic_value_id) (proj_ty : ty) + = + { value = ASymbolic (pm, AProjLoans (sv_id, proj_ty, [])); ty = proj_ty } (** Check if a value contains a *concrete* borrow (i.e., a [Borrow] value - we don't check if there are borrows hidden in symbolic values). diff --git a/src/symbolic/SymbolicToPure.ml b/src/symbolic/SymbolicToPure.ml index 475960810..cf73a8b41 100644 --- a/src/symbolic/SymbolicToPure.ml +++ b/src/symbolic/SymbolicToPure.ml @@ -2045,7 +2045,7 @@ let rec typed_avalue_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) craise __FILE__ __LINE__ ctx.span "Unreachable" | ASymbolic (pm, aproj) -> sanity_check __FILE__ __LINE__ (pm = PNone) ctx.span; - aproj_to_consumed_aux ctx abs_regions aproj + aproj_to_consumed_aux ctx abs_regions aproj av.ty | AIgnored mv -> ( if filter then None else @@ -2187,12 +2187,16 @@ and aloan_content_to_consumed_aux ~(filter : bool) (ctx : bs_ctx) craise __FILE__ __LINE__ ctx.span "Unimplemented" and aproj_to_consumed_aux (ctx : bs_ctx) (_abs_regions : T.RegionId.Set.t) - (aproj : V.aproj) : texpression option = + (aproj : V.aproj) (ty : T.ty) : texpression option = match aproj with | V.AEndedProjLoans (msv, []) -> - (* The symbolic value was left unchanged *) + (* The symbolic value was left unchanged. + + We're using the projection type as the type of the symbolic value - + it doesn't really matter. *) + let msv : V.symbolic_value = { sv_id = msv; sv_ty = ty } in Some (symbolic_value_to_texpression ctx msv) - | V.AEndedProjLoans (msv, [ (mnv, child_aproj) ]) -> + | V.AEndedProjLoans (_msv, [ (mnv, child_aproj) ]) -> sanity_check __FILE__ __LINE__ (child_aproj = AEmpty) ctx.span; (* TODO: check that the updated symbolic values covers all the cases (part of the symbolic value might have been updated, and the rest @@ -2204,9 +2208,13 @@ and aproj_to_consumed_aux (ctx : bs_ctx) (_abs_regions : T.RegionId.Set.t) sanity_check __FILE__ __LINE__ (not (TypesUtils.ty_has_nested_borrows (Some ctx.span) - ctx.type_ctx.type_infos msv.sv_ty)) + ctx.type_ctx.type_infos ty)) ctx.span; - (* The symbolic value was updated *) + (* The symbolic value was updated. + + We're using the projection type as the type of the symbolic value - + it doesn't really matter. *) + let mnv : V.symbolic_value = { sv_id = mnv; sv_ty = ty } in Some (symbolic_value_to_texpression ctx mnv) | V.AEndedProjLoans (_, _) -> (* The symbolic value was updated, and the given back values come from several @@ -2337,7 +2345,7 @@ let rec typed_avalue_to_given_back_aux ~(filter : bool) | ABorrow bc -> aborrow_content_to_given_back_aux ~filter mp bc av.ty ctx | ASymbolic (pm, aproj) -> sanity_check __FILE__ __LINE__ (pm = PNone) ctx.span; - aproj_to_given_back_aux mp aproj ctx + aproj_to_given_back_aux mp aproj av.ty ctx | AIgnored _ -> (* If we do not filter, we have to create a dummy pattern *) if filter then (ctx, None) @@ -2474,7 +2482,7 @@ and aborrow_content_to_given_back_aux ~(filter : bool) (mp : mplace option) let ty = translate_fwd_ty (Some ctx.span) ctx.type_ctx.type_infos ty in (ctx, Some (mk_dummy_pattern ty)) -and aproj_to_given_back_aux (mp : mplace option) (aproj : V.aproj) +and aproj_to_given_back_aux (mp : mplace option) (aproj : V.aproj) (ty : T.ty) (ctx : bs_ctx) : bs_ctx * typed_pattern option = match aproj with | V.AEndedProjLoans (_, _) -> craise __FILE__ __LINE__ ctx.span "Unreachable" @@ -2485,11 +2493,14 @@ and aproj_to_given_back_aux (mp : mplace option) (aproj : V.aproj) let pat = mk_typed_pattern_from_var var mp in (* Register the default value *) let ctx = + (* Using the projection type as the type of the symbolic value - it + doesn't really matter *) + let sv : V.symbolic_value = { sv_id = mv.consumed; sv_ty = ty } in { ctx with var_id_to_default = VarId.Map.add var.id - (symbolic_value_to_texpression ctx mv.consumed) + (symbolic_value_to_texpression ctx sv) ctx.var_id_to_default; } in diff --git a/tests/src/mutually-recursive-traits.lean.out b/tests/src/mutually-recursive-traits.lean.out index 383d80f7a..0a37e6b58 100644 --- a/tests/src/mutually-recursive-traits.lean.out +++ b/tests/src/mutually-recursive-traits.lean.out @@ -14,4 +14,4 @@ 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 886, characters 2-177 Called from Aeneas__Translate.extract_file in file "Translate.ml", line 1018, characters 2-36 Called from Aeneas__Translate.translate_crate in file "Translate.ml", line 1652, characters 5-42 -Called from Dune__exe__Main in file "Main.ml", line 564, characters 11-63 +Called from Dune__exe__Main in file "Main.ml", line 577, characters 11-63