From 90f2ef84a6a023cf883191c0c911b4e1cee8fe0a Mon Sep 17 00:00:00 2001 From: Vincent Laviron Date: Thu, 23 Jan 2025 18:20:12 +0100 Subject: [PATCH] Make my_region optional Functions that contain no escaping local allocations shouldn't need region parameters. This PR enforces it by making these parameters optional. All local allocations (and applications) still need to take a region, so if there is no current region this will cause a fatal error at compile time. --- .../bound_identifiers/bound_for_function.ml | 74 +++++++-- .../bound_identifiers/bound_for_function.mli | 8 +- .../from_lambda/closure_conversion.ml | 154 ++++++++++++------ .../from_lambda/closure_conversion.mli | 2 +- .../from_lambda/closure_conversion_aux.ml | 29 +++- .../from_lambda/closure_conversion_aux.mli | 20 ++- .../flambda2/from_lambda/lambda_to_flambda.ml | 132 +++++++++------ .../from_lambda/lambda_to_flambda_env.ml | 10 +- .../from_lambda/lambda_to_flambda_env.mli | 15 +- .../lambda_to_flambda_primitives.mli | 4 +- .../flambda2/nominal/name_occurrences.ml | 3 + .../flambda2/nominal/name_occurrences.mli | 2 + .../flambda2/parser/fexpr_to_flambda.ml | 3 +- .../flambda2/parser/flambda_to_fexpr.ml | 12 +- middle_end/flambda2/reaper/rev_expr.ml | 4 +- middle_end/flambda2/reaper/rev_expr.mli | 4 +- middle_end/flambda2/reaper/traverse.ml | 8 +- middle_end/flambda2/simplify/rebuilt_expr.mli | 4 +- .../flambda2/simplify/rebuilt_static_const.ml | 3 +- .../flambda2/simplify/simplify_apply_expr.ml | 22 ++- .../simplify/simplify_set_of_closures.ml | 60 +++---- .../simplify_shared/inlining_helpers.ml | 18 +- .../simplify_shared/inlining_helpers.mli | 4 +- middle_end/flambda2/term_basics/alloc_mode.ml | 13 +- .../flambda2/term_basics/alloc_mode.mli | 7 +- middle_end/flambda2/terms/flambda.ml | 13 +- middle_end/flambda2/terms/flambda.mli | 12 +- .../flambda2/to_cmm/to_cmm_set_of_closures.ml | 25 ++- middle_end/flambda2/to_cmm/to_cmm_shared.ml | 5 + middle_end/flambda2/to_cmm/to_cmm_shared.mli | 5 + 30 files changed, 436 insertions(+), 239 deletions(-) diff --git a/middle_end/flambda2/bound_identifiers/bound_for_function.ml b/middle_end/flambda2/bound_identifiers/bound_for_function.ml index b1da1458714..0bb2a6d9950 100644 --- a/middle_end/flambda2/bound_identifiers/bound_for_function.ml +++ b/middle_end/flambda2/bound_identifiers/bound_for_function.ml @@ -19,8 +19,8 @@ type t = exn_continuation : Continuation.t; params : Bound_parameters.t; my_closure : Variable.t; - my_region : Variable.t; - my_ghost_region : Variable.t; + my_region : Variable.t option; + my_ghost_region : Variable.t option; my_depth : Variable.t } @@ -39,8 +39,8 @@ let[@ocamlformat "disable"] print ppf Continuation.print exn_continuation Bound_parameters.print params Variable.print my_closure - Variable.print my_region - Variable.print my_ghost_region + (Format.pp_print_option Variable.print) my_region + (Format.pp_print_option Variable.print) my_ghost_region Variable.print my_depth let create ~return_continuation ~exn_continuation ~params ~my_closure ~my_region @@ -49,10 +49,19 @@ let create ~return_continuation ~exn_continuation ~params ~my_closure ~my_region (if Flambda_features.check_invariants () then let params_set = Bound_parameters.var_set params in - let my_set = - Variable.Set.of_list [my_closure; my_region; my_ghost_region; my_depth] + let my_set, expected_size = + let regions, num_regions = + match my_region, my_ghost_region with + | None, None -> [], 0 + | Some region, Some ghost_region -> [region; ghost_region], 2 + | None, Some _ | Some _, None -> + Misc.fatal_errorf + "[my_region] and [my_ghost_region] must be both present or both \ + absent" + in + Variable.Set.of_list (my_closure :: my_depth :: regions), 2 + num_regions in - if Variable.Set.cardinal my_set <> 4 + if Variable.Set.cardinal my_set <> expected_size || not (Variable.Set.is_empty (Variable.Set.inter my_set params_set)) then Misc.fatal_errorf @@ -106,10 +115,17 @@ let free_names Name_occurrences.add_variable free_names my_closure Name_mode.normal in let free_names = - Name_occurrences.add_variable free_names my_region Name_mode.normal + Option.fold ~none:free_names + ~some:(fun my_region -> + Name_occurrences.add_variable free_names my_region Name_mode.normal) + my_region in let free_names = - Name_occurrences.add_variable free_names my_ghost_region Name_mode.normal + Option.fold ~none:free_names + ~some:(fun my_ghost_region -> + Name_occurrences.add_variable free_names my_ghost_region + Name_mode.normal) + my_ghost_region in Name_occurrences.add_variable free_names my_depth Name_mode.normal @@ -130,8 +146,10 @@ let apply_renaming in let params = Bound_parameters.apply_renaming params renaming in let my_closure = Renaming.apply_variable renaming my_closure in - let my_region = Renaming.apply_variable renaming my_region in - let my_ghost_region = Renaming.apply_variable renaming my_ghost_region in + let my_region = Option.map (Renaming.apply_variable renaming) my_region in + let my_ghost_region = + Option.map (Renaming.apply_variable renaming) my_ghost_region + in let my_depth = Renaming.apply_variable renaming my_depth in (* CR mshinwell: this should have a phys-equal check *) { return_continuation; @@ -158,8 +176,17 @@ let ids_for_export let ids = Ids_for_export.add_continuation ids exn_continuation in let ids = Ids_for_export.union ids (Bound_parameters.ids_for_export params) in let ids = Ids_for_export.add_variable ids my_closure in - let ids = Ids_for_export.add_variable ids my_region in - let ids = Ids_for_export.add_variable ids my_ghost_region in + let ids = + Option.fold ~none:ids + ~some:(fun my_region -> Ids_for_export.add_variable ids my_region) + my_region + in + let ids = + Option.fold ~none:ids + ~some:(fun my_ghost_region -> + Ids_for_export.add_variable ids my_ghost_region) + my_ghost_region + in Ids_for_export.add_variable ids my_depth let rename @@ -175,8 +202,8 @@ let rename exn_continuation = Continuation.rename exn_continuation; params = Bound_parameters.rename params; my_closure = Variable.rename my_closure; - my_region = Variable.rename my_region; - my_ghost_region = Variable.rename my_ghost_region; + my_region = Option.map (Variable.rename ?append:None) my_region; + my_ghost_region = Option.map (Variable.rename ?append:None) my_ghost_region; my_depth = Variable.rename my_depth } @@ -216,10 +243,21 @@ let renaming ~guaranteed_fresh:my_closure2 in let renaming = - Renaming.add_fresh_variable renaming my_region1 ~guaranteed_fresh:my_region2 + match my_region1, my_region2 with + | None, None -> renaming + | Some my_region1, Some my_region2 -> + Renaming.add_fresh_variable renaming my_region1 + ~guaranteed_fresh:my_region2 + | None, Some _ | Some _, None -> + Misc.fatal_error "Mismatched [my_region] field in renaming" in let renaming = - Renaming.add_fresh_variable renaming my_ghost_region1 - ~guaranteed_fresh:my_ghost_region2 + match my_ghost_region1, my_ghost_region2 with + | None, None -> renaming + | Some my_ghost_region1, Some my_ghost_region2 -> + Renaming.add_fresh_variable renaming my_ghost_region1 + ~guaranteed_fresh:my_ghost_region2 + | None, Some _ | Some _, None -> + Misc.fatal_error "Mismatched [my_ghost_region] field in renaming" in Renaming.add_fresh_variable renaming my_depth1 ~guaranteed_fresh:my_depth2 diff --git a/middle_end/flambda2/bound_identifiers/bound_for_function.mli b/middle_end/flambda2/bound_identifiers/bound_for_function.mli index c3e52e04699..6be44d305a0 100644 --- a/middle_end/flambda2/bound_identifiers/bound_for_function.mli +++ b/middle_end/flambda2/bound_identifiers/bound_for_function.mli @@ -24,8 +24,8 @@ val create : exn_continuation:Continuation.t -> params:Bound_parameters.t -> my_closure:Variable.t -> - my_region:Variable.t -> - my_ghost_region:Variable.t -> + my_region:Variable.t option -> + my_ghost_region:Variable.t option -> my_depth:Variable.t -> t @@ -37,9 +37,9 @@ val params : t -> Bound_parameters.t val my_closure : t -> Variable.t -val my_region : t -> Variable.t +val my_region : t -> Variable.t option -val my_ghost_region : t -> Variable.t +val my_ghost_region : t -> Variable.t option val my_depth : t -> Variable.t diff --git a/middle_end/flambda2/from_lambda/closure_conversion.ml b/middle_end/flambda2/from_lambda/closure_conversion.ml index 4af35523526..9e1a8ba6fea 100644 --- a/middle_end/flambda2/from_lambda/closure_conversion.ml +++ b/middle_end/flambda2/from_lambda/closure_conversion.ml @@ -571,9 +571,9 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds prim_is_layout_poly } : Lambda.external_call_description) as prim_desc) - ~(args : Simple.t list list) exn_continuation dbg ~current_region - ~current_ghost_region (k : Acc.t -> Named.t list -> Expr_with_acc.t) : - Expr_with_acc.t = + ~(args : Simple.t list list) exn_continuation dbg + ~(current_region : Variable.t option) ~current_ghost_region + (k : Acc.t -> Named.t list -> Expr_with_acc.t) : Expr_with_acc.t = if prim_is_layout_poly then Misc.fatal_errorf @@ -1098,11 +1098,16 @@ let close_named acc env ~let_bound_ids_with_kinds (named : IR.named) prim Debuginfo.none k | Begin_region { is_try_region; ghost; parent_region } -> let prim : Lambda_to_flambda_primitives_helpers.expr_primitive = + let arg : Lambda_to_flambda_primitives_helpers.simple_or_prim list = + match parent_region with + | None -> [] + | Some parent_region -> [Simple (find_simple_from_id env parent_region)] + in Variadic ( (if is_try_region then Begin_try_region { ghost } else Begin_region { ghost }), - [Simple (find_simple_from_id env parent_region)] ) + arg ) in Lambda_to_flambda_primitives_helpers.bind_recs acc None ~register_const0 prim Debuginfo.none k @@ -1118,10 +1123,12 @@ let close_named acc env ~let_bound_ids_with_kinds (named : IR.named) Lambda_to_flambda_primitives_helpers.bind_recs acc None ~register_const0 prim Debuginfo.none k | Prim { prim; args; loc; exn_continuation; region; ghost_region } -> + let get_region_ident region = + Option.map (fun region -> fst (Env.find_var env region)) region + in close_primitive acc env ~let_bound_ids_with_kinds named prim ~args loc - exn_continuation - ~current_region:(fst (Env.find_var env region)) - ~current_ghost_region:(fst (Env.find_var env ghost_region)) + exn_continuation ~current_region:(get_region_ident region) + ~current_ghost_region:(get_region_ident ghost_region) k type simplified_block_load = @@ -1499,12 +1506,16 @@ let close_exact_or_unknown_apply acc env } : IR.apply) callee_approx ~replace_region : Expr_with_acc.t = let callee = find_simple_from_id env func in - let current_region, current_ghost_region = - match replace_region with - | None -> fst (Env.find_var env region), fst (Env.find_var env ghost_region) - | Some (region, ghost_region) -> region, ghost_region - in let mode = + let current_region, current_ghost_region = + match replace_region with + | None -> + let convert_region region = + Option.map (fun region -> fst (Env.find_var env region)) region + in + convert_region region, convert_region ghost_region + | Some (region, ghost_region) -> Some region, Some ghost_region + in Alloc_mode.For_applications.from_lambda mode ~current_region ~current_ghost_region in @@ -1928,8 +1939,9 @@ let compute_body_of_unboxed_function acc my_region my_closure let make_unboxed_function_wrapper acc function_slot ~unarized_params:params params_arity ~unarized_param_modes:param_modes return result_arity_main_code - code_id main_code_id decl loc external_env recursive cost_metrics dbg - is_tupled inlining_decision absolute_history relative_history main_code + code_id main_code_id decl loc external_env recursive + contains_no_escaping_local_allocs cost_metrics dbg is_tupled + inlining_decision absolute_history relative_history main_code by_function_slot function_code_ids unboxed_function_slot unboxed_params unboxed_return = (* The outside caller gave us the function slot and code ID meant for the @@ -1941,8 +1953,16 @@ let make_unboxed_function_wrapper acc function_slot ~unarized_params:params let return_continuation = Continuation.create () in let exn_continuation = Continuation.create () in let my_closure = Variable.create "my_closure" in - let my_region = Variable.create "my_region" in - let my_ghost_region = Variable.create "my_ghost_region" in + let my_region = + if contains_no_escaping_local_allocs + then None + else Some (Variable.create "my_region") + in + let my_ghost_region = + if contains_no_escaping_local_allocs + then None + else Some (Variable.create "my_ghost_region") + in let my_depth = Variable.create "my_depth" in let rec unbox_params params params_unboxing = match params, params_unboxing with @@ -2115,8 +2135,8 @@ let make_unboxed_function_wrapper acc function_slot ~unarized_params:params Name_occurrences.remove_continuation ~continuation:return_continuation (Name_occurrences.remove_continuation ~continuation:exn_continuation (Name_occurrences.remove_var ~var:my_closure - (Name_occurrences.remove_var ~var:my_region - (Name_occurrences.remove_var ~var:my_ghost_region + (Name_occurrences.remove_var_opt ~var:my_region + (Name_occurrences.remove_var_opt ~var:my_ghost_region (Name_occurrences.remove_var ~var:my_depth (List.fold_left (fun free_names param -> @@ -2134,7 +2154,7 @@ let make_unboxed_function_wrapper acc function_slot ~unarized_params:params ~contains_no_escaping_local_allocs: (match Function_decl.result_mode decl with | Alloc_heap -> true - | Alloc_local -> true) + | Alloc_local -> false) ~stub:true ~inline:Inline_attribute.Default_inline ~poll_attribute: (Poll_attribute.from_lambda (Function_decl.poll_attribute decl)) @@ -2310,12 +2330,24 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot unarized_params closure_env in let closure_env, my_region = - Env.add_var_like closure_env my_region Not_user_visible - K.With_subkind.region + match my_region with + | None -> closure_env, None + | Some my_region -> + let env, region = + Env.add_var_like closure_env my_region Not_user_visible + K.With_subkind.region + in + env, Some region in let closure_env, my_ghost_region = - Env.add_var_like closure_env my_ghost_region Not_user_visible - K.With_subkind.region + match my_ghost_region with + | None -> closure_env, None + | Some my_ghost_region -> + let env, region = + Env.add_var_like closure_env my_ghost_region Not_user_visible + K.With_subkind.region + in + env, Some region in let closure_env = Env.with_depth closure_env my_depth in let closure_env, absolute_history, relative_history = @@ -2456,26 +2488,20 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot ~my_depth ~free_names_of_body:(Known free_names_of_body) in let result_mode = Function_decl.result_mode decl in - if Name_occurrences.mem_var free_names_of_body my_region - && Lambda.is_heap_mode result_mode - then - Misc.fatal_errorf - "Unexpected free my_region in code (%a) with heap result mode:\n%a" - Code_id.print code_id Function_params_and_body.print params_and_body; - if Name_occurrences.mem_var free_names_of_body my_ghost_region - && Lambda.is_heap_mode result_mode - then - Misc.fatal_errorf - "Unexpected free my_ghost_region in code (%a) with heap result mode:\n%a" - Code_id.print code_id Function_params_and_body.print params_and_body; + (match my_region with + | Some _ -> assert (not (Lambda.is_heap_mode result_mode)) + | None -> assert (Lambda.is_heap_mode result_mode)); + (match my_ghost_region with + | Some _ -> assert (not (Lambda.is_heap_mode result_mode)) + | None -> assert (Lambda.is_heap_mode result_mode)); let acc = List.fold_left (fun acc param -> Acc.remove_var_from_free_names (BP.var param) acc) acc (Bound_parameters.to_list main_code_unarized_params) |> Acc.remove_var_from_free_names my_closure - |> Acc.remove_var_from_free_names my_region - |> Acc.remove_var_from_free_names my_ghost_region + |> Acc.remove_var_opt_from_free_names my_region + |> Acc.remove_var_opt_from_free_names my_ghost_region |> Acc.remove_var_from_free_names my_depth |> Acc.remove_continuation_from_free_names return_continuation |> Acc.remove_continuation_from_free_names @@ -2506,6 +2532,9 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot | Normal_calling_convention -> code_id | Unboxed_calling_convention _ -> Code_id.rename code_id in + let contains_no_escaping_local_allocs = + Function_decl.contains_no_escaping_local_allocs decl + in let main_code = Code.create main_code_id ~params_and_body ~free_names_of_params_and_body:(Acc.free_names acc) @@ -2513,9 +2542,7 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot ~param_modes:main_code_unarized_param_modes ~first_complex_local_param:first_complex_local_param_main_code ~result_arity:result_arity_main_code ~result_types:Unknown ~result_mode - ~contains_no_escaping_local_allocs: - (Function_decl.contains_no_escaping_local_allocs decl) - ~stub ~inline + ~contains_no_escaping_local_allocs ~stub ~inline ~poll_attribute: (Poll_attribute.from_lambda (Function_decl.poll_attribute decl)) ~zero_alloc_attribute: @@ -2539,7 +2566,8 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot (unboxed_params, unboxed_return, unboxed_function_slot) -> make_unboxed_function_wrapper acc function_slot ~unarized_params params_arity ~unarized_param_modes return result_arity_main_code code_id - main_code_id decl loc external_env recursive cost_metrics dbg is_tupled + main_code_id decl loc external_env recursive + contains_no_escaping_local_allocs cost_metrics dbg is_tupled inlining_decision absolute_history relative_history main_code by_function_slot function_code_ids unboxed_function_slot unboxed_params unboxed_return @@ -2799,7 +2827,9 @@ let close_functions acc external_env ~current_region function_declarations = let close_let_rec acc env ~function_declarations ~(body : Acc.t -> Env.t -> Expr_with_acc.t) ~current_region = - let current_region = fst (Env.find_var env current_region) in + let current_region = + Option.map (fun region -> fst (Env.find_var env region)) current_region + in let env = List.fold_right (fun decl env -> @@ -2956,6 +2986,16 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply) let all_args = provided @ List.map (fun (p : Function_decl.param) -> IR.Var p.name) params in + let my_region = + if contains_no_escaping_local_allocs + then None + else Some (Ident.create_local "my_region") + in + let my_ghost_region = + if contains_no_escaping_local_allocs + then None + else Some (Ident.create_local "my_ghost_region") + in let fbody acc env = close_exact_or_unknown_apply acc env { apply with @@ -2966,7 +3006,9 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply) exn_continuation; inlined = Lambda.Default_inlined; mode = result_mode; - return_arity = result_arity + return_arity = result_arity; + region = my_region; + ghost_region = my_ghost_region } (Some approx) ~replace_region:None in @@ -3017,11 +3059,10 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply) }) ~params ~params_arity ~removed_params:Ident.Set.empty ~return:result_arity ~calling_convention:Normal_calling_convention - ~return_continuation ~exn_continuation ~my_region:apply.region - ~my_ghost_region:apply.ghost_region ~body:fbody ~attr ~loc:apply.loc - ~free_idents_of_body ~closure_alloc_mode ~first_complex_local_param - ~result_mode ~contains_no_escaping_local_allocs - Recursive.Non_recursive ] + ~return_continuation ~exn_continuation ~my_region ~my_ghost_region + ~body:fbody ~attr ~loc:apply.loc ~free_idents_of_body + ~closure_alloc_mode ~first_complex_local_param ~result_mode + ~contains_no_escaping_local_allocs Recursive.Non_recursive ] in let body acc env = let arg = find_simple_from_id env wrapper_id in @@ -3057,9 +3098,11 @@ let wrap_over_application acc env full_call (apply : IR.apply) ~remaining let apply_region, apply_ghost_region = match needs_region with | None -> - ( fst (Env.find_var env apply.region), - fst (Env.find_var env apply.ghost_region) ) - | Some (region, ghost_region, _) -> region, ghost_region + ( Option.map (fun region -> fst (Env.find_var env region)) apply.region, + Option.map + (fun region -> fst (Env.find_var env region)) + apply.ghost_region ) + | Some (region, ghost_region, _) -> Some region, Some ghost_region in let perform_over_application acc = let acc, apply_exn_continuation = @@ -3302,6 +3345,12 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t = | Over_app { full; provided_arity; remaining; remaining_arity; result_mode } -> let full_args_call apply_continuation ~region ~ghost_region acc = + let replace_region = + match region, ghost_region with + | None, None -> None + | Some region, Some ghost_region -> Some (region, ghost_region) + | Some _, None | None, Some _ -> Misc.fatal_error "Mismatched regions" + in close_exact_or_unknown_apply acc env { apply with args = full; @@ -3312,8 +3361,7 @@ let close_apply acc env (apply : IR.apply) : Expr_with_acc.t = Flambda_arity.create_singletons [Flambda_kind.With_subkind.any_value] } - (Some approx) - ~replace_region:(Some (region, ghost_region)) + (Some approx) ~replace_region in wrap_over_application acc env full_args_call apply ~remaining ~remaining_arity ~result_mode) diff --git a/middle_end/flambda2/from_lambda/closure_conversion.mli b/middle_end/flambda2/from_lambda/closure_conversion.mli index cc86bc6ac03..26eada90a02 100644 --- a/middle_end/flambda2/from_lambda/closure_conversion.mli +++ b/middle_end/flambda2/from_lambda/closure_conversion.mli @@ -36,7 +36,7 @@ val close_let_rec : Env.t -> function_declarations:Function_decl.t list -> body:(Acc.t -> Env.t -> Expr_with_acc.t) -> - current_region:Ident.t -> + current_region:Ident.t option -> Expr_with_acc.t val close_let_cont : diff --git a/middle_end/flambda2/from_lambda/closure_conversion_aux.ml b/middle_end/flambda2/from_lambda/closure_conversion_aux.ml index 9e380e6a038..c6268881df0 100644 --- a/middle_end/flambda2/from_lambda/closure_conversion_aux.ml +++ b/middle_end/flambda2/from_lambda/closure_conversion_aux.ml @@ -38,7 +38,7 @@ module IR = struct | Begin_region of { ghost : bool; is_try_region : bool; - parent_region : Ident.t + parent_region : Ident.t option } | End_region of { is_try_region : bool; @@ -50,8 +50,8 @@ module IR = struct args : simple list list; loc : Lambda.scoped_location; exn_continuation : exn_continuation option; - region : Ident.t; - ghost_region : Ident.t + region : Ident.t option; + ghost_region : Ident.t option } type apply_kind = @@ -72,8 +72,8 @@ module IR = struct inlined : Lambda.inlined_attribute; probe : Lambda.probe; mode : Lambda.locality_mode; - region : Ident.t; - ghost_region : Ident.t; + region : Ident.t option; + ghost_region : Ident.t option; args_arity : [`Complex] Flambda_arity.t; return_arity : [`Unarized] Flambda_arity.t } @@ -619,6 +619,9 @@ module Acc = struct let remove_var_from_free_names var t = { t with free_names = Name_occurrences.remove_var t.free_names ~var } + let remove_var_opt_from_free_names var t = + { t with free_names = Name_occurrences.remove_var_opt t.free_names ~var } + let add_continuation_application ~cont args_approx t = let continuation_application = match args_approx with @@ -767,8 +770,8 @@ module Function_decls = struct calling_convention : calling_convention; return_continuation : Continuation.t; exn_continuation : IR.exn_continuation; - my_region : Ident.t; - my_ghost_region : Ident.t; + my_region : Ident.t option; + my_ghost_region : Ident.t option; body : Acc.t -> Env.t -> Acc.t * Flambda.Import.Expr.t; free_idents_of_body : Ident.Set.t; attr : Lambda.function_attribute; @@ -791,6 +794,18 @@ module Function_decls = struct | None -> Ident.create_local "unnamed_function" | Some let_rec_ident -> let_rec_ident in + (match contains_no_escaping_local_allocs, my_region, my_ghost_region with + | true, None, None -> () + | false, Some _, Some _ -> () + | _, _, _ -> + Misc.fatal_errorf + "Function %a declared with contains_no_escaping_local_allocs:%b but \ + my_region is %a and my_ghost_region is %a" + Ident.print let_rec_ident contains_no_escaping_local_allocs + (Format.pp_print_option Ident.print) + my_region + (Format.pp_print_option Ident.print) + my_ghost_region); { let_rec_ident; function_slot; kind; diff --git a/middle_end/flambda2/from_lambda/closure_conversion_aux.mli b/middle_end/flambda2/from_lambda/closure_conversion_aux.mli index 3b878333654..3516379e827 100644 --- a/middle_end/flambda2/from_lambda/closure_conversion_aux.mli +++ b/middle_end/flambda2/from_lambda/closure_conversion_aux.mli @@ -40,7 +40,7 @@ module IR : sig | Begin_region of { ghost : bool; is_try_region : bool; - parent_region : Ident.t + parent_region : Ident.t option } | End_region of { is_try_region : bool; @@ -54,8 +54,8 @@ module IR : sig args : simple list list; loc : Lambda.scoped_location; exn_continuation : exn_continuation option; - region : Ident.t; - ghost_region : Ident.t + region : Ident.t option; + ghost_region : Ident.t option } type apply_kind = @@ -76,8 +76,8 @@ module IR : sig inlined : Lambda.inlined_attribute; probe : Lambda.probe; mode : Lambda.locality_mode; - region : Ident.t; - ghost_region : Ident.t; + region : Ident.t option; + ghost_region : Ident.t option; args_arity : [`Complex] Flambda_arity.t; return_arity : [`Unarized] Flambda_arity.t } @@ -263,6 +263,8 @@ module Acc : sig val remove_var_from_free_names : Variable.t -> t -> t + val remove_var_opt_from_free_names : Variable.t option -> t -> t + val remove_continuation_from_free_names : Continuation.t -> t -> t val mark_continuation_as_untrackable : Continuation.t -> t -> t @@ -354,8 +356,8 @@ module Function_decls : sig calling_convention:calling_convention -> return_continuation:Continuation.t -> exn_continuation:IR.exn_continuation -> - my_region:Ident.t -> - my_ghost_region:Ident.t -> + my_region:Ident.t option -> + my_ghost_region:Ident.t option -> body:(Acc.t -> Env.t -> Acc.t * Flambda.Import.Expr.t) -> attr:Lambda.function_attribute -> loc:Lambda.scoped_location -> @@ -385,9 +387,9 @@ module Function_decls : sig val exn_continuation : t -> IR.exn_continuation - val my_region : t -> Ident.t + val my_region : t -> Ident.t option - val my_ghost_region : t -> Ident.t + val my_ghost_region : t -> Ident.t option val body : t -> Acc.t -> Env.t -> Acc.t * Flambda.Import.Expr.t diff --git a/middle_end/flambda2/from_lambda/lambda_to_flambda.ml b/middle_end/flambda2/from_lambda/lambda_to_flambda.ml index 5705ba8b11f..61316ac032f 100644 --- a/middle_end/flambda2/from_lambda/lambda_to_flambda.ml +++ b/middle_end/flambda2/from_lambda/lambda_to_flambda.ml @@ -262,19 +262,25 @@ let restore_continuation_context acc env ccenv cont ~close_current_region_early if close_current_region_early then let env, region_stack_elt = Env.pop_one_region env in - let region = Env.Region_stack_element.region region_stack_elt in - let ghost_region = Env.Region_stack_element.ghost_region region_stack_elt in - CC.close_let acc ccenv - [Ident.create_local "unit", Flambda_kind.With_subkind.tagged_immediate] - Not_user_visible - (End_region { is_try_region = false; region; ghost = false }) - ~body:(fun acc ccenv -> - CC.close_let acc ccenv - [Ident.create_local "unit", Flambda_kind.With_subkind.tagged_immediate] - Not_user_visible - (End_region - { is_try_region = false; region = ghost_region; ghost = true }) - ~body:(fun acc ccenv -> normal_case env acc ccenv)) + match region_stack_elt with + | None -> normal_case env acc ccenv + | Some region_stack_elt -> + let region = Env.Region_stack_element.region region_stack_elt in + let ghost_region = + Env.Region_stack_element.ghost_region region_stack_elt + in + CC.close_let acc ccenv + [Ident.create_local "unit", Flambda_kind.With_subkind.tagged_immediate] + Not_user_visible + (End_region { is_try_region = false; region; ghost = false }) + ~body:(fun acc ccenv -> + CC.close_let acc ccenv + [ ( Ident.create_local "unit", + Flambda_kind.With_subkind.tagged_immediate ) ] + Not_user_visible + (End_region + { is_try_region = false; region = ghost_region; ghost = true }) + ~body:(fun acc ccenv -> normal_case env acc ccenv)) else normal_case env acc ccenv let restore_continuation_context_for_switch_arm env cont = @@ -306,13 +312,10 @@ let apply_cont_with_extra_args acc env ccenv ~dbg cont traps args = let wrap_return_continuation acc env ccenv (apply : IR.apply) = let extra_args = Env.extra_args_for_continuation env apply.continuation in - let close_current_region_early, region_stack_elt = + let close_current_region_early, region, ghost_region = match apply.region_close with - | Rc_normal | Rc_nontail -> - ( false, - Env.Region_stack_element.create ~region:apply.region - ~ghost_region:apply.ghost_region ) - | Rc_close_at_apply -> + | Rc_normal | Rc_nontail -> false, apply.region, apply.ghost_region + | Rc_close_at_apply -> ( (* [Rc_close_at_apply] means that the application is in tail position with respect to the *current region*. Only that region should be closed early, prior to the application, meaning that the region for the @@ -320,13 +323,17 @@ let wrap_return_continuation acc env ccenv (apply : IR.apply) = application, further regions should be closed if necessary in order to bring the current region stack in line with the return continuation's region stack. *) - true, Env.parent_region env + match Env.parent_region env with + | None -> true, None, None + | Some region_stack_elt -> + ( true, + Some (Env.Region_stack_element.region region_stack_elt), + Some (Env.Region_stack_element.ghost_region region_stack_elt) )) in - let region = Env.Region_stack_element.region region_stack_elt in - let ghost_region = Env.Region_stack_element.ghost_region region_stack_elt in let body acc ccenv continuation = match extra_args with - | [] -> CC.close_apply acc ccenv { apply with continuation; region } + | [] -> + CC.close_apply acc ccenv { apply with continuation; region; ghost_region } | _ :: _ -> let wrapper_cont = Continuation.create () in let return_kinds = Flambda_arity.unarized_components apply.return_arity in @@ -488,7 +495,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) (Singleton Flambda_kind.With_subkind.any_value) in CC.close_let_rec acc ccenv ~function_declarations:[func] ~body - ~current_region:(Env.current_region env |> Env.Region_stack_element.region) + ~current_region: + (Env.current_region env |> Option.map Env.Region_stack_element.region) | Lmutlet (value_kind, id, defining_expr, body) -> (* CR mshinwell: user-visibleness needs thinking about here *) let temp_id = Ident.create_local "let_mutable" in @@ -515,7 +523,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) (fun body func acc ccenv -> CC.close_let_rec acc ccenv ~function_declarations:[func] ~body ~current_region: - (Env.current_region env |> Env.Region_stack_element.region)) + (Env.current_region env + |> Option.map Env.Region_stack_element.region)) body bindings in let_expr acc ccenv @@ -578,9 +587,11 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) in let body acc ccenv = cps acc env ccenv body k k_exn in let current_region = Env.current_region env in - let region = Env.Region_stack_element.region current_region in + let region = + Option.map Env.Region_stack_element.region current_region + in let ghost_region = - Env.Region_stack_element.ghost_region current_region + Option.map Env.Region_stack_element.ghost_region current_region in CC.close_let acc ccenv ids_with_kinds (is_user_visible env id) (Prim { prim; args; loc; exn_continuation; region; ghost_region }) @@ -641,7 +652,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) let function_declarations = cps_function_bindings env bindings in let body acc ccenv = cps acc env ccenv body k k_exn in CC.close_let_rec acc ccenv ~function_declarations ~body - ~current_region:(Env.current_region env |> Env.Region_stack_element.region) + ~current_region: + (Env.current_region env |> Option.map Env.Region_stack_element.region) | Lprim (prim, args, loc) -> ( match[@ocaml.warning "-fragile-match"] prim with | Praise raise_kind -> ( @@ -794,9 +806,12 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) inlined = Default_inlined; probe = None; mode; - region = Env.Region_stack_element.region current_region; + region = + Option.map Env.Region_stack_element.region + current_region; ghost_region = - Env.Region_stack_element.ghost_region current_region; + Option.map Env.Region_stack_element.ghost_region + current_region; args_arity = Flambda_arity.create args_arity; return_arity = Flambda_arity.unarize_t @@ -853,7 +868,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) (Begin_region { is_try_region = true; ghost = false; - parent_region = Env.Region_stack_element.region region_stack_elt + parent_region = + Option.map Env.Region_stack_element.region region_stack_elt }) ~body:(fun acc ccenv -> CC.close_let acc ccenv @@ -863,7 +879,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) { is_try_region = true; ghost = true; parent_region = - Env.Region_stack_element.ghost_region region_stack_elt + Option.map Env.Region_stack_element.ghost_region + region_stack_elt }) ~body) in @@ -952,7 +969,11 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) | Lregion (body, _) when not (Flambda_features.stack_allocation_enabled ()) -> cps acc env ccenv body k k_exn | Lexclave body -> - let current_region = Env.current_region env in + let current_region = + match Env.current_region env with + | Some region -> region + | None -> Misc.fatal_error "Lexclave in a context with no current region" + in let region = Env.Region_stack_element.region current_region in let ghost_region = Env.Region_stack_element.ghost_region current_region in CC.close_let acc ccenv @@ -985,7 +1006,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) (Begin_region { is_try_region = false; ghost = false; - parent_region = Env.Region_stack_element.region parent_stack_elt + parent_region = + Option.map Env.Region_stack_element.region parent_stack_elt }) ~body:(fun acc ccenv -> CC.close_let acc ccenv @@ -995,7 +1017,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation) { is_try_region = false; ghost = true; parent_region = - Env.Region_stack_element.ghost_region parent_stack_elt + Option.map Env.Region_stack_element.ghost_region + parent_stack_elt }) ~body:(fun acc ccenv -> maybe_insert_let_cont "body_return" layout k acc env ccenv @@ -1117,9 +1140,9 @@ and cps_tail_apply acc env ccenv ap_func ap_args ap_region_close ap_mode ap_loc inlined = ap_inlined; probe = ap_probe; mode = ap_mode; - region = Env.Region_stack_element.region current_region; + region = Option.map Env.Region_stack_element.region current_region; ghost_region = - Env.Region_stack_element.ghost_region current_region; + Option.map Env.Region_stack_element.ghost_region current_region; args_arity = Flambda_arity.create args_arity; return_arity = Flambda_arity.unarize_t @@ -1237,8 +1260,11 @@ and cps_function_bindings env (bindings : Lambda.rec_binding list) = bindings_with_wrappers and cps_function env ~fid ~(recursive : Recursive.t) ?precomputed_free_idents - ({ kind; params; return; body; attr; loc; mode; ret_mode; region } : + ({ kind; params; return; body; attr; loc; mode; ret_mode; region = _ } : L.lfunction) : Function_decl.t = + let contains_no_escaping_local_allocs = + match ret_mode with Alloc_heap -> true | Alloc_local -> false + in let first_complex_local_param = List.length params - match kind with Curried { nlocal } -> nlocal | Tupled -> 0 @@ -1365,11 +1391,17 @@ and cps_function env ~fid ~(recursive : Recursive.t) ?precomputed_free_idents | Some ids -> ids | None -> Lambda.free_variables body in - let my_region = Ident.create_local "my_region" in - let my_ghost_region = Ident.create_local "my_ghost_region" in - let my_region_stack_elt = - Env.Region_stack_element.create ~region:my_region - ~ghost_region:my_ghost_region + let my_region_stack_elt, my_region, my_ghost_region = + if contains_no_escaping_local_allocs + then None, None, None + else + let my_region = Ident.create_local "my_region" in + let my_ghost_region = Ident.create_local "my_ghost_region" in + ( Some + (Env.Region_stack_element.create ~region:my_region + ~ghost_region:my_ghost_region), + Some my_region, + Some my_ghost_region ) in let new_env = Env.create ~current_unit:(Env.current_unit env) @@ -1448,7 +1480,7 @@ and cps_function env ~fid ~(recursive : Recursive.t) ?precomputed_free_idents ~params_arity ~removed_params ~return ~calling_convention ~return_continuation:body_cont ~exn_continuation ~my_region ~my_ghost_region ~body ~attr ~loc ~free_idents_of_body recursive ~closure_alloc_mode:mode - ~first_complex_local_param ~contains_no_escaping_local_allocs:region + ~first_complex_local_param ~contains_no_escaping_local_allocs ~result_mode:ret_mode and cps_switch acc env ccenv (switch : L.lambda_switch) ~condition_dbg @@ -1588,9 +1620,11 @@ and cps_switch acc env ccenv (switch : L.lambda_switch) ~condition_dbg isint_switch in let current_region = Env.current_region env in - let region = Env.Region_stack_element.region current_region in + let region = + Option.map Env.Region_stack_element.region current_region + in let ghost_region = - Env.Region_stack_element.ghost_region current_region + Option.map Env.Region_stack_element.ghost_region current_region in CC.close_let acc ccenv [is_scrutinee_int, Flambda_kind.With_subkind.tagged_immediate] @@ -1630,13 +1664,9 @@ let lambda_to_flambda ~mode ~big_endian ~cmx_loader ~compilation_unit let toplevel_my_ghost_region = Ident.create_local "toplevel_my_ghost_region" in - let toplevel_my_region_stack_elt = - Env.Region_stack_element.create ~region:toplevel_my_region - ~ghost_region:toplevel_my_ghost_region - in let env = Env.create ~current_unit:compilation_unit ~return_continuation - ~exn_continuation ~my_region:toplevel_my_region_stack_elt + ~exn_continuation ~my_region:None in let program acc ccenv = cps_tail acc env ccenv lam return_continuation exn_continuation diff --git a/middle_end/flambda2/from_lambda/lambda_to_flambda_env.ml b/middle_end/flambda2/from_lambda/lambda_to_flambda_env.ml index b7419de1373..c43cc71a3d0 100644 --- a/middle_end/flambda2/from_lambda/lambda_to_flambda_env.ml +++ b/middle_end/flambda2/from_lambda/lambda_to_flambda_env.ml @@ -80,9 +80,7 @@ type t = try_stack_at_handler : Continuation.t list Continuation.Map.t; static_exn_continuation : Continuation.t Numeric_types.Int.Map.t; recursive_static_catches : Numeric_types.Int.Set.t; - my_region : Region_stack_element.t; - (* CR-someday ncourant/mshinwell: replace this with [my_region: - Region_stack_element.t option] *) + my_region : Region_stack_element.t option; region_stack : Region_stack_element.t list; region_stack_in_cont_scope : Region_stack_element.t list Continuation.Map.t; region_closure_continuations : @@ -309,7 +307,7 @@ let current_region t = else match t.region_stack with | [] -> t.my_region - | region_stack_elt :: _ -> region_stack_elt + | region_stack_elt :: _ -> Some region_stack_elt let parent_region t = if not (Flambda_features.stack_allocation_enabled ()) @@ -319,7 +317,7 @@ let parent_region t = | [] -> Misc.fatal_error "Cannot determine parent region, region stack is empty" | [_] -> t.my_region - | _ :: region :: _ -> region + | _ :: region :: _ -> Some region let my_region t = t.my_region @@ -340,7 +338,7 @@ let pop_one_region t = else match t.region_stack with | [] -> Misc.fatal_error "No regions available to pop" - | region :: region_stack -> { t with region_stack }, region + | region :: region_stack -> { t with region_stack }, Some region let pop_regions_up_to_context t continuation = let initial_stack_context = region_stack_in_cont_scope t continuation in diff --git a/middle_end/flambda2/from_lambda/lambda_to_flambda_env.mli b/middle_end/flambda2/from_lambda/lambda_to_flambda_env.mli index 049e7c922e5..3d6ce56da30 100644 --- a/middle_end/flambda2/from_lambda/lambda_to_flambda_env.mli +++ b/middle_end/flambda2/from_lambda/lambda_to_flambda_env.mli @@ -32,7 +32,7 @@ val create : current_unit:Compilation_unit.t -> return_continuation:Continuation.t -> exn_continuation:Continuation.t -> - my_region:Region_stack_element.t -> + my_region:Region_stack_element.t option -> t val current_unit : t -> Compilation_unit.t @@ -162,15 +162,16 @@ val entering_region : val leaving_region : t -> t (** The region stack element corresponding to the [my_region] parameter of - the current function, or the toplevel region stack element created by - simplify.ml. *) -val my_region : t -> Region_stack_element.t + the current function, if relevant. + The toplevel expression doesn't have such a variable, and functions + that cannot allocate in the parent region may not have one either. *) +val my_region : t -> Region_stack_element.t option (** The current region stack element, to be used for allocation etc. *) -val current_region : t -> Region_stack_element.t +val current_region : t -> Region_stack_element.t option (** The region stack element immediately outside [current_region]. *) -val parent_region : t -> Region_stack_element.t +val parent_region : t -> Region_stack_element.t option (** The innermost (newest) region is first in the list. *) val region_stack : t -> Region_stack_element.t list @@ -178,7 +179,7 @@ val region_stack : t -> Region_stack_element.t list val region_stack_in_cont_scope : t -> Continuation.t -> Region_stack_element.t list -val pop_one_region : t -> t * Region_stack_element.t +val pop_one_region : t -> t * Region_stack_element.t option (** Hack for staticfail (which should eventually use [pop_regions_up_to_context]) *) diff --git a/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.mli b/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.mli index 70cbfc63835..3968ce3ab2f 100644 --- a/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.mli +++ b/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.mli @@ -27,7 +27,7 @@ val convert_and_bind : Lambda.primitive -> args:Simple.t list list -> Debuginfo.t -> - current_region:Variable.t -> - current_ghost_region:Variable.t -> + current_region:Variable.t option -> + current_ghost_region:Variable.t option -> (Acc.t -> Flambda.Named.t list -> Expr_with_acc.t) -> Expr_with_acc.t diff --git a/middle_end/flambda2/nominal/name_occurrences.ml b/middle_end/flambda2/nominal/name_occurrences.ml index 37c53aad463..63d95bbc38c 100644 --- a/middle_end/flambda2/nominal/name_occurrences.ml +++ b/middle_end/flambda2/nominal/name_occurrences.ml @@ -831,6 +831,9 @@ let remove_var t ~var = let names = For_names.remove t.names (Name.var var) in { t with names } +let remove_var_opt t ~var = + match var with None -> t | Some var -> remove_var t ~var + let remove_symbol t ~symbol = if For_names.is_empty t.names then t diff --git a/middle_end/flambda2/nominal/name_occurrences.mli b/middle_end/flambda2/nominal/name_occurrences.mli index 9a445fdffbc..cc854f1a6cb 100644 --- a/middle_end/flambda2/nominal/name_occurrences.mli +++ b/middle_end/flambda2/nominal/name_occurrences.mli @@ -173,6 +173,8 @@ val value_slot_is_used_or_imported : t -> Value_slot.t -> bool val remove_var : t -> var:Variable.t -> t +val remove_var_opt : t -> var:Variable.t option -> t + val remove_code_id_or_symbol : t -> code_id_or_symbol:Code_id_or_symbol.t -> t val remove_continuation : t -> continuation:Continuation.t -> t diff --git a/middle_end/flambda2/parser/fexpr_to_flambda.ml b/middle_end/flambda2/parser/fexpr_to_flambda.ml index a2b30ee5271..f509ee8f680 100644 --- a/middle_end/flambda2/parser/fexpr_to_flambda.ml +++ b/middle_end/flambda2/parser/fexpr_to_flambda.ml @@ -917,7 +917,8 @@ let rec expr env (e : Fexpr.expr) : Flambda.Expr.t = Flambda.Function_params_and_body.create ~return_continuation ~exn_continuation:(Exn_continuation.exn_handler exn_continuation) (Bound_parameters.create params) - ~body ~my_closure ~my_region ~my_ghost_region ~my_depth + ~body ~my_closure ~my_region:(Some my_region) + ~my_ghost_region:(Some my_ghost_region) ~my_depth ~free_names_of_body:Unknown in let free_names = diff --git a/middle_end/flambda2/parser/flambda_to_fexpr.ml b/middle_end/flambda2/parser/flambda_to_fexpr.ml index af4a00318b5..7e88ba8bd86 100644 --- a/middle_end/flambda2/parser/flambda_to_fexpr.ml +++ b/middle_end/flambda2/parser/flambda_to_fexpr.ml @@ -918,8 +918,16 @@ and static_let_expr env bound_static defining_expr body : Fexpr.expr = (Bound_parameters.to_list params) in let closure_var, env = Env.bind_var env my_closure in - let region_var, env = Env.bind_var env my_region in - let ghost_region_var, env = Env.bind_var env my_ghost_region in + let region_var, env = + match my_region with + | None -> nowhere "_region", env + | Some my_region -> Env.bind_var env my_region + in + let ghost_region_var, env = + match my_ghost_region with + | None -> nowhere "_ghost_region", env + | Some my_ghost_region -> Env.bind_var env my_ghost_region + in let depth_var, env = Env.bind_var env my_depth in let body = expr env body in (* CR-someday lmaurer: Omit exn_cont, closure_var if not used *) diff --git a/middle_end/flambda2/reaper/rev_expr.ml b/middle_end/flambda2/reaper/rev_expr.ml index 0dac11a7b80..2c3f4f14954 100644 --- a/middle_end/flambda2/reaper/rev_expr.ml +++ b/middle_end/flambda2/reaper/rev_expr.ml @@ -59,8 +59,8 @@ and rev_params_and_body = params : Bound_parameters.t; body : rev_expr; my_closure : Variable.t; - my_region : Variable.t; - my_ghost_region : Variable.t; + my_region : Variable.t option; + my_ghost_region : Variable.t option; my_depth : Variable.t } diff --git a/middle_end/flambda2/reaper/rev_expr.mli b/middle_end/flambda2/reaper/rev_expr.mli index 0dac11a7b80..2c3f4f14954 100644 --- a/middle_end/flambda2/reaper/rev_expr.mli +++ b/middle_end/flambda2/reaper/rev_expr.mli @@ -59,8 +59,8 @@ and rev_params_and_body = params : Bound_parameters.t; body : rev_expr; my_closure : Variable.t; - my_region : Variable.t; - my_ghost_region : Variable.t; + my_region : Variable.t option; + my_ghost_region : Variable.t option; my_depth : Variable.t } diff --git a/middle_end/flambda2/reaper/traverse.ml b/middle_end/flambda2/reaper/traverse.ml index 3d4503e2b56..363291101f6 100644 --- a/middle_end/flambda2/reaper/traverse.ml +++ b/middle_end/flambda2/reaper/traverse.ml @@ -664,8 +664,12 @@ and traverse_function_params_and_body acc code_id code ~return_continuation then List.iter (fun v -> Acc.used ~denv (Simple.var v) acc) (exn :: return); Bound_parameters.iter (fun bp -> Acc.bound_parameter_kind bp acc) params; Acc.kind (Name.var my_closure) Flambda_kind.value acc; - Acc.kind (Name.var my_region) Flambda_kind.region acc; - Acc.kind (Name.var my_ghost_region) Flambda_kind.region acc; + Option.iter + (fun region -> Acc.kind (Name.var region) Flambda_kind.region acc) + my_region; + Option.iter + (fun region -> Acc.kind (Name.var region) Flambda_kind.region acc) + my_ghost_region; Acc.kind (Name.var my_depth) Flambda_kind.rec_info acc; if is_opaque then diff --git a/middle_end/flambda2/simplify/rebuilt_expr.mli b/middle_end/flambda2/simplify/rebuilt_expr.mli index 127a1686dfc..7871ae062ce 100644 --- a/middle_end/flambda2/simplify/rebuilt_expr.mli +++ b/middle_end/flambda2/simplify/rebuilt_expr.mli @@ -66,8 +66,8 @@ module Function_params_and_body : sig body:rebuilt_expr -> free_names_of_body:Name_occurrences.t -> my_closure:Variable.t -> - my_region:Variable.t -> - my_ghost_region:Variable.t -> + my_region:Variable.t option -> + my_ghost_region:Variable.t option -> my_depth:Variable.t -> t diff --git a/middle_end/flambda2/simplify/rebuilt_static_const.ml b/middle_end/flambda2/simplify/rebuilt_static_const.ml index 5558f0304ae..db2ba4b853e 100644 --- a/middle_end/flambda2/simplify/rebuilt_static_const.ml +++ b/middle_end/flambda2/simplify/rebuilt_static_const.ml @@ -339,8 +339,7 @@ module Group = struct ~body:(Expr.create_invalid Code_not_rebuilt) ~free_names_of_body:Unknown ~my_closure:(Variable.create "my_closure") - ~my_region:(Variable.create "my_region") - ~my_ghost_region:(Variable.create "my_ghost_region") + ~my_region:None ~my_ghost_region:None ~my_depth:(Variable.create "my_depth")) let pieces_of_code_including_those_not_rebuilt t = diff --git a/middle_end/flambda2/simplify/simplify_apply_expr.ml b/middle_end/flambda2/simplify/simplify_apply_expr.ml index f4cc96bd669..b09cd1c2a1f 100644 --- a/middle_end/flambda2/simplify/simplify_apply_expr.ml +++ b/middle_end/flambda2/simplify/simplify_apply_expr.ml @@ -521,9 +521,20 @@ let simplify_direct_partial_application ~simplify_expr dacc apply | None -> applied_unarized_args | Some applied_callee -> applied_callee :: applied_unarized_args in + let contains_no_escaping_local_allocs = + Code_metadata.contains_no_escaping_local_allocs callee's_code_metadata + in let my_closure = Variable.create "my_closure" in - let my_region = Variable.create "my_region" in - let my_ghost_region = Variable.create "my_ghost_region" in + let my_region = + if contains_no_escaping_local_allocs + then None + else Some (Variable.create "my_region") + in + let my_ghost_region = + if contains_no_escaping_local_allocs + then None + else Some (Variable.create "my_ghost_region") + in let my_depth = Variable.create "my_depth" in let exn_continuation = Apply.exn_continuation apply |> Exn_continuation.without_extra_args @@ -627,11 +638,8 @@ let simplify_direct_partial_application ~simplify_expr dacc apply ~params_arity:remaining_param_arity ~param_modes:remaining_params_alloc_modes ~first_complex_local_param ~result_arity ~result_types:Unknown - ~result_mode - ~contains_no_escaping_local_allocs: - (Code_metadata.contains_no_escaping_local_allocs - callee's_code_metadata) - ~stub:true ~inline:Default_inline ~poll_attribute:Default + ~result_mode ~contains_no_escaping_local_allocs ~stub:true + ~inline:Default_inline ~poll_attribute:Default ~zero_alloc_attribute:Zero_alloc_attribute.Default_zero_alloc ~is_a_functor:false ~is_opaque:false ~recursive ~cost_metrics:cost_metrics_of_body diff --git a/middle_end/flambda2/simplify/simplify_set_of_closures.ml b/middle_end/flambda2/simplify/simplify_set_of_closures.ml index f012ea3fa15..0cf7cf8ca0a 100644 --- a/middle_end/flambda2/simplify/simplify_set_of_closures.ml +++ b/middle_end/flambda2/simplify/simplify_set_of_closures.ml @@ -65,12 +65,18 @@ let dacc_inside_function context ~outer_dacc ~params ~my_closure ~my_region (T.alias_type_of K.value (Simple.name name))) in let denv = - let my_region = Bound_var.create my_region Name_mode.normal in - DE.add_variable denv my_region (T.unknown K.region) + match my_region with + | None -> denv + | Some my_region -> + let my_region = Bound_var.create my_region Name_mode.normal in + DE.add_variable denv my_region (T.unknown K.region) in let denv = - let my_ghost_region = Bound_var.create my_ghost_region Name_mode.normal in - DE.add_variable denv my_ghost_region (T.unknown K.region) + match my_ghost_region with + | None -> denv + | Some my_ghost_region -> + let my_ghost_region = Bound_var.create my_ghost_region Name_mode.normal in + DE.add_variable denv my_ghost_region (T.unknown K.region) in let denv = let my_depth = Bound_var.create my_depth Name_mode.normal in @@ -177,18 +183,25 @@ let simplify_function_body context ~outer_dacc function_slot_opt Misc.fatal_errorf "Did not expect lifted constants in [dacc]:@ %a" DA.print dacc; assert (not (DE.at_unit_toplevel (DA.denv dacc))); + let region_params = + let region_param region = + match region with + | None -> [] + | Some region -> + [Bound_parameter.create region Flambda_kind.With_subkind.region] + in + region_param my_region @ region_param my_ghost_region + in match C.simplify_function_body context dacc body ~return_continuation ~exn_continuation ~return_arity:(Code.result_arity code) ~implicit_params: (Bound_parameters.create - [ Bound_parameter.create my_closure - Flambda_kind.With_subkind.any_value; - Bound_parameter.create my_region Flambda_kind.With_subkind.region; - Bound_parameter.create my_ghost_region - Flambda_kind.With_subkind.region; - Bound_parameter.create my_depth Flambda_kind.With_subkind.rec_info - ]) + ([ Bound_parameter.create my_closure + Flambda_kind.With_subkind.any_value; + Bound_parameter.create my_depth Flambda_kind.With_subkind.rec_info + ] + @ region_params)) ~loopify_state ~params with | body, uacc -> @@ -213,27 +226,13 @@ let simplify_function_body context ~outer_dacc function_slot_opt then Recursive else Non_recursive in - if NO.mem_var free_names_of_body my_region - && Lambda.is_heap_mode (Code.result_mode code) - then - Misc.fatal_errorf - "Unexpected free my_region in code with heap result mode:\n%a" - (RE.print (UA.are_rebuilding_terms uacc)) - body; - if NO.mem_var free_names_of_body my_ghost_region - && Lambda.is_heap_mode (Code.result_mode code) - then - Misc.fatal_errorf - "Unexpected free my_ghost_region in code with heap result mode:\n%a" - (RE.print (UA.are_rebuilding_terms uacc)) - body; let free_names_of_code = free_names_of_body |> NO.remove_continuation ~continuation:return_continuation |> NO.remove_continuation ~continuation:exn_continuation |> NO.remove_var ~var:my_closure - |> NO.remove_var ~var:my_region - |> NO.remove_var ~var:my_ghost_region + |> NO.remove_var_opt ~var:my_region + |> NO.remove_var_opt ~var:my_ghost_region |> NO.remove_var ~var:my_depth |> NO.diff ~without:(Bound_parameters.free_names params) |> NO.diff ~without:previously_free_depth_variables @@ -247,8 +246,11 @@ let simplify_function_body context ~outer_dacc function_slot_opt %a@ \n\ Simplified version:@ fun %a %a %a %a %a ->@ \n\ \ %a" NO.print free_names_of_code Code_id.print code_id - Bound_parameters.print params Variable.print my_closure Variable.print - my_region Variable.print my_ghost_region Variable.print my_depth + Bound_parameters.print params Variable.print my_closure + (Format.pp_print_option Variable.print) + my_region + (Format.pp_print_option Variable.print) + my_ghost_region Variable.print my_depth (RE.print (UA.are_rebuilding_terms uacc)) body; { params; diff --git a/middle_end/flambda2/simplify_shared/inlining_helpers.ml b/middle_end/flambda2/simplify_shared/inlining_helpers.ml index a0c20243aa0..c3d5ad7f7e1 100644 --- a/middle_end/flambda2/simplify_shared/inlining_helpers.ml +++ b/middle_end/flambda2/simplify_shared/inlining_helpers.ml @@ -17,8 +17,8 @@ open! Flambda.Import module RC = Apply.Result_continuation -let make_inlined_body ~callee ~called_code_id:_ ~region_inlined_into ~params - ~args ~my_closure ~my_region ~my_ghost_region ~my_depth ~rec_info ~body +let make_inlined_body ~callee ~called_code_id ~region_inlined_into ~params ~args + ~my_closure ~my_region ~my_ghost_region ~my_depth ~rec_info ~body ~exn_continuation ~return_continuation ~apply_exn_continuation ~apply_return_continuation ~bind_params ~bind_depth ~apply_renaming = let renaming = Renaming.empty in @@ -36,14 +36,20 @@ let make_inlined_body ~callee ~called_code_id:_ ~region_inlined_into ~params [my_region] should be unused in the body. *) match (region_inlined_into : Alloc_mode.For_applications.t) with | Heap -> renaming - | Local { region; ghost_region } -> + | Local { region; ghost_region } -> ( (* Unlike for parameters, we know that the argument for the [my_region] parameter is fresh for [body], so we can use a permutation without fear of swapping out existing occurrences of such argument within [body]. Similarly for [ghost_region]. *) - Renaming.add_variable - (Renaming.add_variable renaming my_region region) - my_ghost_region ghost_region + match my_region, my_ghost_region with + | Some my_region, Some my_ghost_region -> + Renaming.add_variable + (Renaming.add_variable renaming my_region region) + my_ghost_region ghost_region + | None, None -> renaming + | None, Some _ | Some _, None -> + Misc.fatal_errorf "When inlining %a: Mismatched regions" Code_id.print + called_code_id) in let body = match callee with diff --git a/middle_end/flambda2/simplify_shared/inlining_helpers.mli b/middle_end/flambda2/simplify_shared/inlining_helpers.mli index 04e83ce5a82..e6788c9b37c 100644 --- a/middle_end/flambda2/simplify_shared/inlining_helpers.mli +++ b/middle_end/flambda2/simplify_shared/inlining_helpers.mli @@ -21,8 +21,8 @@ val make_inlined_body : params:'param list -> args:Simple.List.t -> my_closure:'param -> - my_region:Variable.t -> - my_ghost_region:Variable.t -> + my_region:Variable.t option -> + my_ghost_region:Variable.t option -> my_depth:Variable.t -> rec_info:Rec_info_expr.t -> body:'expr_with_acc -> diff --git a/middle_end/flambda2/term_basics/alloc_mode.ml b/middle_end/flambda2/term_basics/alloc_mode.ml index f1652fb44b7..0679d9d2fb0 100644 --- a/middle_end/flambda2/term_basics/alloc_mode.ml +++ b/middle_end/flambda2/term_basics/alloc_mode.ml @@ -102,8 +102,12 @@ module For_applications = struct else match mode with | Alloc_heap -> Heap - | Alloc_local -> - Local { region = current_region; ghost_region = current_ghost_region } + | Alloc_local -> ( + match current_region, current_ghost_region with + | Some current_region, Some current_ghost_region -> + Local { region = current_region; ghost_region = current_ghost_region } + | None, _ | _, None -> + Misc.fatal_error "Local application without a region") let free_names t = match t with @@ -167,7 +171,10 @@ module For_allocations = struct else match mode with | Alloc_heap -> Heap - | Alloc_local -> Local { region = current_region } + | Alloc_local -> ( + match current_region with + | Some region -> Local { region } + | None -> Misc.fatal_error "Local allocation without a region") let free_names t = match t with diff --git a/middle_end/flambda2/term_basics/alloc_mode.mli b/middle_end/flambda2/term_basics/alloc_mode.mli index 54a3a6d439f..7151b8a0807 100644 --- a/middle_end/flambda2/term_basics/alloc_mode.mli +++ b/middle_end/flambda2/term_basics/alloc_mode.mli @@ -63,8 +63,8 @@ module For_applications : sig val from_lambda : Lambda.locality_mode -> - current_region:Variable.t -> - current_ghost_region:Variable.t -> + current_region:Variable.t option -> + current_ghost_region:Variable.t option -> t include Contains_names.S with type t := t @@ -90,7 +90,8 @@ module For_allocations : sig val as_type : t -> For_types.t - val from_lambda : Lambda.locality_mode -> current_region:Variable.t -> t + val from_lambda : + Lambda.locality_mode -> current_region:Variable.t option -> t include Contains_names.S with type t := t diff --git a/middle_end/flambda2/terms/flambda.ml b/middle_end/flambda2/terms/flambda.ml index 28baf96bc38..1b1ed7e95b6 100644 --- a/middle_end/flambda2/terms/flambda.ml +++ b/middle_end/flambda2/terms/flambda.ml @@ -589,11 +589,14 @@ and print_function_params_and_body ppf t = \u{27c5}%t%a%t\u{27c6}@ %a %a %t%a%t %t.%t@]@ %a))@]" Flambda_colours.lambda Flambda_colours.pop Continuation.print return_continuation Continuation.print exn_continuation - Flambda_colours.parameter Variable.print my_region Flambda_colours.pop - Flambda_colours.parameter Variable.print my_ghost_region - Flambda_colours.pop Bound_parameters.print params Bound_parameter.print - my_closure Flambda_colours.depth_variable Variable.print my_depth - Flambda_colours.pop Flambda_colours.elide Flambda_colours.pop print body + Flambda_colours.parameter + (Format.pp_print_option Variable.print) + my_region Flambda_colours.pop Flambda_colours.parameter + (Format.pp_print_option Variable.print) + my_ghost_region Flambda_colours.pop Bound_parameters.print params + Bound_parameter.print my_closure Flambda_colours.depth_variable + Variable.print my_depth Flambda_colours.pop Flambda_colours.elide + Flambda_colours.pop print body in let module BFF = Bound_for_function in Name_abstraction.pattern_match_for_printing diff --git a/middle_end/flambda2/terms/flambda.mli b/middle_end/flambda2/terms/flambda.mli index fbee4974aae..e496dd5243a 100644 --- a/middle_end/flambda2/terms/flambda.mli +++ b/middle_end/flambda2/terms/flambda.mli @@ -484,8 +484,8 @@ module Function_params_and_body : sig body:expr -> free_names_of_body:Name_occurrences.t Or_unknown.t -> my_closure:Variable.t -> - my_region:Variable.t -> - my_ghost_region:Variable.t -> + my_region:Variable.t option -> + my_ghost_region:Variable.t option -> my_depth:Variable.t -> t @@ -507,8 +507,8 @@ module Function_params_and_body : sig body:expr -> my_closure:Variable.t -> is_my_closure_used:bool Or_unknown.t -> - my_region:Variable.t -> - my_ghost_region:Variable.t -> + my_region:Variable.t option -> + my_ghost_region:Variable.t option -> my_depth:Variable.t -> free_names_of_body:Name_occurrences.t Or_unknown.t -> 'a) -> @@ -533,8 +533,8 @@ module Function_params_and_body : sig body1:expr -> body2:expr -> my_closure:Variable.t -> - my_region:Variable.t -> - my_ghost_region:Variable.t -> + my_region:Variable.t option -> + my_ghost_region:Variable.t option -> my_depth:Variable.t -> 'a) -> 'a diff --git a/middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml b/middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml index bc32d396182..7066da7ccbe 100644 --- a/middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml +++ b/middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml @@ -458,23 +458,34 @@ let params_and_body0 env res code_id ~result_arity ~fun_dbg Env.enter_function_body env ~return_continuation ~return_continuation_arity ~exn_continuation in - (* [my_region] can be referenced in [Begin_try_region] primitives so must be - in the environment; however it should never end up in actual generated - code, so we don't need any binder for it (this is why we can ignore + (* [my_region] can be referenced in [Begin_region] primitives so must be in + the environment; however it should never end up in actual generated code, + so we don't need any binder for it (this is why we can ignore [_bound_var]). If it does end up in generated code, Selection will complain and refuse to compile the code. *) - let env, my_region_var = Env.create_bound_parameter env my_region in + let env, my_region_var = + match my_region with + | None -> env, None + | Some my_region -> + let env, region = Env.create_bound_parameter env my_region in + env, Some region + in (* Similarly for [my_ghost_region]. *) let env, my_ghost_region_var = - Env.create_bound_parameter env my_ghost_region + match my_ghost_region with + | None -> env, None + | Some my_ghost_region -> + let env, region = Env.create_bound_parameter env my_ghost_region in + env, Some region in (* Translate the arg list and body *) let env, fun_params = C.function_bound_parameters env params in let fun_body, fun_body_free_vars, res = translate_expr env res body in let fun_free_vars = C.remove_vars_with_machtype - (C.remove_var_with_provenance - (C.remove_var_with_provenance fun_body_free_vars my_ghost_region_var) + (C.remove_var_opt_with_provenance + (C.remove_var_opt_with_provenance fun_body_free_vars + my_ghost_region_var) my_region_var) fun_params in diff --git a/middle_end/flambda2/to_cmm/to_cmm_shared.ml b/middle_end/flambda2/to_cmm/to_cmm_shared.ml index 7da2054eee5..bb408a0129f 100644 --- a/middle_end/flambda2/to_cmm/to_cmm_shared.ml +++ b/middle_end/flambda2/to_cmm/to_cmm_shared.ml @@ -37,6 +37,11 @@ let remove_var_with_provenance free_vars var = let v = Backend_var.With_provenance.var var in Backend_var.Set.remove v free_vars +let remove_var_opt_with_provenance free_vars var = + match var with + | None -> free_vars + | Some var -> remove_var_with_provenance free_vars var + let remove_vars_with_machtype free_vars vars = List.fold_left (fun free_vars (cmm_var, _machtype) -> diff --git a/middle_end/flambda2/to_cmm/to_cmm_shared.mli b/middle_end/flambda2/to_cmm/to_cmm_shared.mli index f10d1d61744..2adddc260ff 100644 --- a/middle_end/flambda2/to_cmm/to_cmm_shared.mli +++ b/middle_end/flambda2/to_cmm/to_cmm_shared.mli @@ -27,6 +27,11 @@ val remove_skipped_args : 'a list -> _ To_cmm_env.param_type list -> 'a list val remove_var_with_provenance : To_cmm_env.free_vars -> Backend_var.With_provenance.t -> To_cmm_env.free_vars +val remove_var_opt_with_provenance : + To_cmm_env.free_vars -> + Backend_var.With_provenance.t option -> + To_cmm_env.free_vars + val remove_vars_with_machtype : To_cmm_env.free_vars -> (Backend_var.With_provenance.t * _) list ->