Merge ocaml-jst

backend/cmm_helpers.ml

@@ -2951,8 +2951,8 @@ type assignment_kind =
 let assignment_kind (ptr : Lambda.immediate_or_pointer)
     (init : Lambda.initialization_or_assignment) =
   match init, ptr with
-  | Assignment Alloc_heap, Pointer -> Caml_modify
-  | Assignment Alloc_local, Pointer ->
+  | Assignment Modify_heap, Pointer -> Caml_modify
+  | Assignment Modify_maybe_stack, Pointer ->
     assert Config.stack_allocation;
     Caml_modify_local
   | Heap_initialization, _ -> Caml_initialize

dune

@@ -790,7 +790,6 @@
   (trap_stack.mli as compiler-libs/trap_stack.mli)
   (cfg_equivalence.mli as compiler-libs/cfg_equivalence.mli)
   (ocaml/extensions.mli as compiler-libs/extensions.mli)
-  (ocaml/translcomprehension.mli as compiler-libs/translcomprehension.mli)
   (.ocamloptcomp.objs/byte/linear_format.cmi
    as
    compiler-libs/linear_format.cmi)

middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml

@@ -94,7 +94,8 @@ let convert_init_or_assign (i_or_a : L.initialization_or_assignment)
     ~current_region : P.Init_or_assign.t =
   match i_or_a with
   | Assignment mode ->
-    Assignment (Alloc_mode.For_allocations.from_lambda mode ~current_region)
+    Assignment
+      (Alloc_mode.For_allocations.from_lambda_modify mode ~current_region)
   | Heap_initialization -> Initialization
   | Root_initialization ->
     Misc.fatal_error "[Root_initialization] should not appear in Flambda input"

middle_end/flambda2/term_basics/alloc_mode.ml

@@ -98,6 +98,21 @@ module For_allocations = struct
       assert (Flambda_features.stack_allocation_enabled ());
       Lambda.alloc_local
 
+  let from_lambda_modify (mode : Lambda.modify_mode) ~current_region =
+    if not (Flambda_features.stack_allocation_enabled ())
+    then Heap
+    else
+      match mode with
+      | Modify_heap -> Heap
+      | Modify_maybe_stack -> Local { region = current_region }
+
+  let to_lambda_modify t =
+    match t with
+    | Heap -> Lambda.modify_heap
+    | Local _ ->
+      assert (Flambda_features.stack_allocation_enabled ());
+      Lambda.modify_maybe_stack
+
   let free_names t =
     match t with
     | Heap -> Name_occurrences.empty

middle_end/flambda2/term_basics/alloc_mode.mli

@@ -61,6 +61,10 @@ module For_allocations : sig
 
   val to_lambda : t -> Lambda.alloc_mode
 
+  val from_lambda_modify : Lambda.modify_mode -> current_region:Variable.t -> t
+
+  val to_lambda_modify : t -> Lambda.modify_mode
+
   include Contains_names.S with type t := t
 
   include Contains_ids.S with type t := t

middle_end/flambda2/terms/flambda_primitive.ml

@@ -243,7 +243,8 @@ module Init_or_assign = struct
   let to_lambda t : Lambda.initialization_or_assignment =
     match t with
     | Initialization -> Heap_initialization
-    | Assignment mode -> Assignment (Alloc_mode.For_allocations.to_lambda mode)
+    | Assignment mode ->
+      Assignment (Alloc_mode.For_allocations.to_lambda_modify mode)
 
   let free_names t =
     match t with

middle_end/printclambda_primitives.ml

@@ -84,8 +84,8 @@ let primitive ppf (prim:Clambda_primitives.primitive) =
         match init with
         | Heap_initialization -> "(heap-init)"
         | Root_initialization -> "(root-init)"
-        | Assignment Alloc_heap -> ""
-        | Assignment Alloc_local -> "(local)"
+        | Assignment Modify_heap -> ""
+        | Assignment Modify_maybe_stack -> "(maybe-stack)"
       in
       fprintf ppf "setfield_%s%s %i" instr init n
   | Psetfield_computed (ptr, init) ->
@@ -98,8 +98,8 @@ let primitive ppf (prim:Clambda_primitives.primitive) =
         match init with
         | Heap_initialization -> "(heap-init)"
         | Root_initialization -> "(root-init)"
-        | Assignment Alloc_heap -> ""
-        | Assignment Alloc_local -> "(local)"
+        | Assignment Modify_heap -> ""
+        | Assignment Modify_maybe_stack -> "(maybe-stack)"
       in
       fprintf ppf "setfield_%s%s_computed" instr init
   | Pfloatfield (n, Alloc_heap) -> fprintf ppf "floatfield %i" n
@@ -109,8 +109,8 @@ let primitive ppf (prim:Clambda_primitives.primitive) =
         match init with
         | Heap_initialization -> "(heap-init)"
         | Root_initialization -> "(root-init)"
-        | Assignment Alloc_heap -> ""
-        | Assignment Alloc_local -> "(local)"
+        | Assignment Modify_heap -> ""
+        | Assignment Modify_maybe_stack -> "(maybe-stack)"
       in
       fprintf ppf "setfloatfield%s %i" init n
   | Pduprecord (rep, size) ->

native_toplevel/opttoploop.ml

@@ -378,10 +378,9 @@ let name_expression ~loc ~attrs exp =
   in
   let sg = [Sig_value(id, vd, Exported)] in
   let pat =
-    { pat_desc = Tpat_var(id, mknoloc name);
+    { pat_desc = Tpat_var(id, mknoloc name, Types.Value_mode.global);
       pat_loc = loc;
       pat_extra = [];
-      pat_mode = Types.Value_mode.global;
       pat_type = exp.exp_type;
       pat_env = exp.exp_env;
       pat_attributes = []; }