Code review

Author: mshinwell

middle_end/flambda2/from_lambda/closure_conversion.ml

@@ -306,7 +306,7 @@ module Inlining = struct
 
   let inline acc ~apply ~apply_depth ~func_desc:code =
     let callee = Apply.callee apply in
-    let region_inlined_into = Simple.var (Apply.region apply) in
+    let region_inlined_into = Apply.region apply in
     let args = Apply.args apply in
     let apply_return_continuation = Apply.continuation apply in
     let apply_exn_continuation = Apply.exn_continuation apply in
@@ -1708,7 +1708,7 @@ let wrap_over_application acc env full_call (apply : IR.apply) over_args
       Some (over_app_region, Continuation.create ())
     | Heap, true | Local, _ -> None
   in
-  let current_region =
+  let apply_region =
     match needs_region with
     | None -> Env.find_var env apply.region
     | Some (region, _) -> region
@@ -1745,7 +1745,7 @@ let wrap_over_application acc env full_call (apply : IR.apply) over_args
         ~inlining_state:(Inlining_state.default ~round:0)
         ~probe_name ~position
         ~relative_history:(Env.relative_history_from_scoped ~loc:apply.loc env)
-        ~region:current_region
+        ~region:apply_region
     in
     match needs_region with
     | None -> Expr_with_acc.create_apply acc over_application
@@ -1777,7 +1777,7 @@ let wrap_over_application acc env full_call (apply : IR.apply) over_args
         ~body:(fun acc -> Expr_with_acc.create_apply acc over_application)
         ~is_exn_handler:false
   in
-  let body = full_call wrapper_cont ~region:current_region in
+  let body = full_call wrapper_cont ~region:apply_region in
   let acc, both_applications =
     Let_cont_with_acc.build_non_recursive acc wrapper_cont
       ~handler_params:

middle_end/flambda2/from_lambda/lambda_to_flambda.ml

@@ -366,7 +366,11 @@ end = struct
   let leaving_try_region t =
     match t.region_stack with
     | [] -> Misc.fatal_error "Cannot pop try region, region stack is empty"
-    | _ :: region_stack -> { t with region_stack }
+    | Try_with _ :: region_stack -> { t with region_stack }
+    | Regular region :: _ ->
+      Misc.fatal_errorf
+        "Attempted to pop try region but found regular region %a" Ident.print
+        region
 
   let current_region t =
     if not (Flambda_features.stack_allocation_enabled ())

middle_end/flambda2/simplify/expr_builder.ml

@@ -125,7 +125,12 @@ let create_let uacc (bound_vars : Bound_pattern.t) (defining_expr : Named.t)
       | Prim (prim, _) -> P.is_end_region prim
       | Simple _ | Set_of_closures _ | Static_consts _ | Rec_info _ -> None
     in
-    (* XXX should clarify effects judgement somehow to generalise here *)
+    let is_end_region_for_unused_region =
+      match is_end_region with
+      | None -> false
+      | Some region ->
+        not (Name.Set.mem (Name.var region) (UA.required_names uacc))
+    in
     if Option.is_none is_end_region
        && not (Named.at_most_generative_effects defining_expr)
     then (
@@ -149,19 +154,8 @@ let create_let uacc (bound_vars : Bound_pattern.t) (defining_expr : Named.t)
                Variable.user_visible (VB.var bound_var))
       in
       let will_delete_binding =
-        let is_end_region_for_unused_region =
-          match is_end_region with
-          | None -> false
-          | Some region ->
-            not (Name.Set.mem (Name.var region) (UA.required_names uacc))
-        in
         if is_end_region_for_unused_region
-        then
-          (* Format.eprintf "deleting End_region %a\n%!"
-             (Misc.Stdlib.Option.print Variable.print) (match defining_expr with
-             | Prim (prim, _) -> P.is_end_region prim | Simple _ |
-             Set_of_closures _ | Static_consts _ | Rec_info _ -> None); *)
-          true
+        then true
         else if Option.is_some is_end_region
         then false
         else

middle_end/flambda2/simplify/inlining/inlining_transforms.ml

@@ -39,9 +39,6 @@ let make_inlined_body ~callee ~unroll_to ~params ~args ~my_closure ~my_region
   let my_closure =
     Bound_parameter.create my_closure Flambda_kind.With_subkind.any_value
   in
-  let my_region =
-    Bound_parameter.create my_region Flambda_kind.With_subkind.region
-  in
   let bind_params ~params ~args ~body =
     if List.compare_lengths params args <> 0
     then
@@ -88,7 +85,7 @@ let wrap_inlined_body_for_exn_extra_args ~extra_args ~apply_exn_continuation
 
 let inline dacc ~apply ~unroll_to ~was_inline_always function_decl =
   let callee = Apply.callee apply in
-  let region_inlined_into = Simple.var (Apply.region apply) in
+  let region_inlined_into = Apply.region apply in
   let args = Apply.args apply in
   let apply_return_continuation = Apply.continuation apply in
   let apply_exn_continuation = Apply.exn_continuation apply in

middle_end/flambda2/simplify/simplify_common.ml

@@ -150,12 +150,13 @@ let split_direct_over_application apply ~param_arity ~result_arity
     match needs_region with
     | None -> Expr.create_apply perform_over_application
     | Some (region, after_over_application) ->
-      (* This wraps the second application (the over application itself) with
-         [Begin_region] ... [End_region]. This application might raise an
-         exception, but that doesn't need any special handling, since we're not
-         actually introducing any more local allocations here. (Missing the
-         [End_region] on the exceptional return path is fine, c.f. the usual
-         compilation of [try ... with] -- see [Closure_conversion].) *)
+      (* This wraps both applications (the full application and the second
+         application) with [Begin_region] ... [End_region]. The applications
+         might raise an exception, but that doesn't need any special handling,
+         since we're not actually introducing any more local allocations here.
+         (Missing the [End_region] on the exceptional return path is fine, c.f.
+         the usual compilation of [try ... with] -- see
+         [Closure_conversion].) *)
       let over_application_results =
         List.mapi
           (fun i kind ->

middle_end/flambda2/simplify_shared/inlining_helpers.ml

@@ -30,11 +30,14 @@ let make_inlined_body ~callee ~region_inlined_into ~params ~args ~my_closure
   let renaming =
     Renaming.add_continuation renaming exn_continuation apply_exn_continuation
   in
+  let renaming =
+    (* 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]. *)
+    Renaming.add_variable renaming my_region region_inlined_into
+  in
   let body =
-    bind_params
-      ~params:(my_closure :: my_region :: params)
-      ~args:(callee :: region_inlined_into :: args)
-      ~body
+    bind_params ~params:(my_closure :: params) ~args:(callee :: args) ~body
   in
   let body = bind_depth ~my_depth ~rec_info ~body in
   apply_renaming body renaming

middle_end/flambda2/simplify_shared/inlining_helpers.mli

@@ -16,11 +16,11 @@
 
 val make_inlined_body :
   callee:Simple.t ->
-  region_inlined_into:Simple.t ->
+  region_inlined_into:Variable.t ->
   params:'param list ->
   args:Simple.List.t ->
   my_closure:'param ->
-  my_region:'param ->
+  my_region:Variable.t ->
   my_depth:Variable.t ->
   rec_info:Rec_info_expr.t ->
   body:'expr_with_acc ->

middle_end/flambda2/to_cmm/to_cmm.ml

@@ -78,7 +78,6 @@ let unit0 ~offsets ~make_symbol flambda_unit ~all_code =
   let env =
     Env.create offsets all_code ~return_continuation:dummy_k
       ~exn_continuation:(Flambda_unit.exn_continuation flambda_unit)
-      ~my_region:(Flambda_unit.toplevel_my_region flambda_unit)
   in
   let _env, return_cont_params =
     (* The environment is dropped because the handler for the dummy continuation

middle_end/flambda2/to_cmm/to_cmm_env.ml

@@ -83,10 +83,36 @@ type t =
     stages : stage list (* Stages of let-bindings, most recent at the head. *)
   }
 
+let create offsets functions_info ~return_continuation ~exn_continuation =
+  { return_continuation;
+    exn_continuation;
+    offsets;
+    functions_info;
+    stages = [];
+    pures = Variable.Map.empty;
+    vars = Variable.Map.empty;
+    vars_extra = Variable.Map.empty;
+    conts = Continuation.Map.empty;
+    exn_handlers = Continuation.Set.singleton exn_continuation;
+    exn_conts_extra_args = Continuation.Map.empty
+  }
+
+let enter_function_body env ~return_continuation ~exn_continuation =
+  create env.offsets env.functions_info ~return_continuation ~exn_continuation
+
 let return_continuation env = env.return_continuation
 
 let exn_continuation env = env.exn_continuation
 
+(* Code and closures *)
+
+let get_code_metadata env code_id =
+  match Exported_code.find_exn env.functions_info code_id with
+  | code_or_metadata -> Code_or_metadata.code_metadata code_or_metadata
+  | exception Not_found ->
+    Misc.fatal_errorf "To_cmm_env.get_code_metadata: code ID %a not bound"
+      Code_id.print code_id
+
 let exported_offsets t = t.offsets
 
 (* Variables *)
@@ -369,39 +395,3 @@ let flush_delayed_lets ?(entering_loop = false) env =
   in
   let flush e = flush pures_to_flush env.stages e in
   flush, { env with stages = []; pures = pures_to_keep }
-
-(* Creation *)
-
-let create offsets functions_info ~return_continuation ~exn_continuation
-    ~my_region =
-  let t =
-    { return_continuation;
-      exn_continuation;
-      offsets;
-      functions_info;
-      stages = [];
-      pures = Variable.Map.empty;
-      vars = Variable.Map.empty;
-      vars_extra = Variable.Map.empty;
-      conts = Continuation.Map.empty;
-      exn_handlers = Continuation.Set.singleton exn_continuation;
-      exn_conts_extra_args = Continuation.Map.empty
-    }
-  in
-  (* Dummy binding for [my_region] *)
-  bind_variable t my_region ~num_normal_occurrences_of_bound_vars:Unknown
-    ~effects_and_coeffects_of_defining_expr:Ece.pure
-    ~defining_expr:(C.int_const Debuginfo.none 0)
-
-(* Code and closures *)
-
-let get_code_metadata env code_id =
-  match Exported_code.find_exn env.functions_info code_id with
-  | code_or_metadata -> Code_or_metadata.code_metadata code_or_metadata
-  | exception Not_found ->
-    Misc.fatal_errorf "To_cmm_env.get_code_metadata: code ID %a not bound"
-      Code_id.print code_id
-
-let enter_function_body env ~return_continuation ~exn_continuation ~my_region =
-  create env.offsets env.functions_info ~return_continuation ~exn_continuation
-    ~my_region

middle_end/flambda2/to_cmm/to_cmm_env.mli

@@ -24,7 +24,6 @@ val create :
   Exported_code.t ->
   return_continuation:Continuation.t ->
   exn_continuation:Continuation.t ->
-  my_region:Variable.t ->
   t
 
 (** Given an existing environment providing the "global" information (such as
@@ -34,7 +33,6 @@ val enter_function_body :
   t ->
   return_continuation:Continuation.t ->
   exn_continuation:Continuation.t ->
-  my_region:Variable.t ->
   t
 
 (** {2 Continuations} *)

middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml

@@ -250,7 +250,7 @@ end)
 (* Translation of the bodies of functions. *)
 
 let params_and_body0 env res code_id ~fun_dbg ~return_continuation
-    ~exn_continuation ~my_region params ~body ~my_closure
+    ~exn_continuation params ~body ~my_closure
     ~(is_my_closure_used : _ Or_unknown.t) ~translate_expr =
   let params =
     let is_my_closure_used =
@@ -271,7 +271,6 @@ let params_and_body0 env res code_id ~fun_dbg ~return_continuation
      trap action is attached to one of its calls *)
   let env =
     Env.enter_function_body env ~return_continuation ~exn_continuation
-      ~my_region
   in
   (* Translate the arg list and body *)
   let env, fun_args = C.bound_parameters env params in
@@ -291,14 +290,14 @@ let params_and_body env res code_id p ~fun_dbg ~translate_expr =
          ~body
          ~my_closure
          ~is_my_closure_used
-         ~my_region
+         ~my_region:_
          ~my_depth:_
          ~free_names_of_body:_
        ->
       try
         params_and_body0 env res code_id ~fun_dbg ~return_continuation
-          ~exn_continuation ~my_region params ~body ~my_closure
-          ~is_my_closure_used ~translate_expr
+          ~exn_continuation params ~body ~my_closure ~is_my_closure_used
+          ~translate_expr
       with Misc.Fatal_error as e ->
         Format.eprintf
           "\n\