Get rid of layout_field

middle_end/flambda2/from_lambda/dissect_letrec.ml

@@ -247,7 +247,11 @@ let rec prepare_letrec (recursive_set : Ident.Set.t)
             (id, def) :: defs, Lambda.Lvar id :: args)
         args ([], [])
     in
-    let arg_layout = Typeopt.layout_union layout_field layout_block in
+    (* [arg_layout] is more general than any of the possible layouts of [args]:
+         - The arguments to [Pmakeblock]/[Pmakearray] are value fields.
+         - The argument to [Pduprecord] is a block.
+    *)
+    let arg_layout = Typeopt.layout_union layout_value_field layout_block in
     (* Bytecode evaluates effects in blocks from right to left, so reverse defs
        to preserve evaluation order. Relevant test: letrec/evaluation_order_3 *)
     let lam =
@@ -257,6 +261,7 @@ let rec prepare_letrec (recursive_set : Ident.Set.t)
         (Lambda.Lprim (prim, args, dbg))
         defs
     in
+    if !Clflags.debug_ocaml then Printlambda.lambda Format.err_formatter lam;
     prepare_letrec recursive_set current_let lam letrec
   | Lprim (Pmakeblock (_, _, _, mode), args, _)
   | Lprim (Pmakearray ((Paddrarray | Pintarray), _, mode), args, _) -> (

ocaml/lambda/lambda.ml

@@ -838,7 +838,11 @@ let layout_block = Pvalue Pgenval
 let layout_list =
   Pvalue (Pvariant { consts = [0] ;
                      non_consts = [0, Constructor_uniform [Pgenval; Pgenval]] })
-let layout_field = Pvalue Pgenval
+let layout_tuple_element = Pvalue Pgenval
+let layout_value_field = Pvalue Pgenval
+let layout_tmc_field = Pvalue Pgenval
+let layout_optional_arg = Pvalue Pgenval
+let layout_variant_arg = Pvalue Pgenval
 let layout_exception = Pvalue Pgenval
 let layout_function = Pvalue Pgenval
 let layout_object = Pvalue Pgenval
@@ -1770,7 +1774,7 @@ let array_ref_kind_result_layout = function
   | Pintarray_ref -> layout_int
   | Pfloatarray_ref _ -> layout_boxed_float Pfloat64
   | Punboxedfloatarray_ref bf -> layout_unboxed_float bf
-  | Pgenarray_ref _ | Paddrarray_ref -> layout_field
+  | Pgenarray_ref _ | Paddrarray_ref -> layout_value_field
   | Punboxedintarray_ref Pint32 -> layout_unboxed_int32
   | Punboxedintarray_ref Pint64 -> layout_unboxed_int64
   | Punboxedintarray_ref Pnativeint -> layout_unboxed_nativeint
@@ -1793,7 +1797,7 @@ let primitive_result_layout (p : primitive) =
   | Pmakeblock _ | Pmakefloatblock _ | Pmakearray _ | Pduprecord _
   | Pmakeufloatblock _ | Pmakemixedblock _
   | Pduparray _ | Pbigarraydim _ | Pobj_dup -> layout_block
-  | Pfield _ | Pfield_computed _ -> layout_field
+  | Pfield _ | Pfield_computed _ -> layout_value_field
   | Punboxed_product_field (field, layouts) -> (Array.of_list layouts).(field)
   | Pmake_unboxed_product layouts -> layout_unboxed_product layouts
   | Pfloatfield _ -> layout_boxed_float Pfloat64
@@ -1806,7 +1810,7 @@ let primitive_result_layout (p : primitive) =
   | Punbox_float float_kind -> Punboxed_float float_kind
   | Pmixedfield (_, kind, _) -> begin
       match kind with
-      | Mread_value_prefix _ -> layout_field
+      | Mread_value_prefix _ -> layout_value_field
       | Mread_flat_suffix proj -> begin
           match proj with
           | Flat_read_imm -> layout_int

ocaml/lambda/lambda.mli

@@ -720,8 +720,17 @@ val layout_boxed_float : boxed_float -> layout
 val layout_unboxed_float : boxed_float -> layout
 val layout_boxedint : boxed_integer -> layout
 val layout_boxed_vector : Primitive.boxed_vector -> layout
-(* A layout that is Pgenval because it is the field of a block *)
-val layout_field : layout
+(* A layout that is Pgenval because it is the field of a tuple *)
+val layout_tuple_element : layout
+(* A layout that is Pgenval because it is the arg of a polymorphic variant *)
+val layout_variant_arg : layout
+(* A layout that is Pgenval because it is the field of a block being considered
+   for the tmc transformation
+*)
+val layout_tmc_field : layout
+(* A layout that is Pgenval because it is an optional argument *)
+val layout_optional_arg : layout
+val layout_value_field : layout
 val layout_lazy : layout
 val layout_lazy_contents : layout
 (* A layout that is Pgenval because we are missing layout polymorphism *)

ocaml/lambda/matching.ml

@@ -1874,7 +1874,7 @@ let get_expr_args_variant_nonconst ~scopes head (arg, _mut, _sort, _layout)
   let loc = head_loc ~scopes head in
    let field_prim = nonconstant_variant_field 1 in
   (Lprim (field_prim, [ arg ], loc), Alias, Jkind.Sort.for_variant_arg,
-   layout_field)
+   layout_variant_arg)
   :: rem
 
 let divide_variant ~scopes row ctx { cases = cl; args; default = def } =
@@ -2117,7 +2117,7 @@ let get_expr_args_tuple ~scopes head (arg, _mut, _sort, _layout) rem =
       rem
     else
       (Lprim (Pfield (pos, Pointer, Reads_agree), [ arg ], loc), Alias,
-       Jkind.Sort.for_tuple_element, layout_field)
+       Jkind.Sort.for_tuple_element, layout_tuple_element)
         :: make_args (pos + 1)
   in
   make_args 0
@@ -3986,9 +3986,11 @@ let for_let ~scopes ~arg_sort ~return_layout loc param pat body =
 (* Easy case since variables are available *)
 let for_tupled_function ~scopes ~return_layout loc paraml pats_act_list partial =
   let partial = check_partial_list pats_act_list partial in
-  (* The arguments of a tupled function are always values since they must be fields *)
+  (* The arguments of a tupled function are always values since they must be
+     tuple elements *)
   let args =
-    List.map (fun id -> (Lvar id, Strict, Jkind.Sort.for_tuple_element, layout_field))
+    List.map (fun id -> (Lvar id, Strict, Jkind.Sort.for_tuple_element,
+                         layout_tuple_element))
       paraml
   in
   let handler =

ocaml/lambda/simplif.ml

@@ -586,7 +586,9 @@ let simplify_lets lam =
       let slbody = simplif lbody in
       begin try
         let kind = match kind_ref with
-          | None -> Lambda.layout_field
+          | None ->
+              (* This is a [Pmakeblock] so the fields are all values *)
+              Lambda.layout_value_field
           | Some [field_kind] -> Pvalue field_kind
           | Some _ -> assert false
         in
@@ -801,10 +803,9 @@ let split_default_wrapper ~id:fun_id ~kind ~params ~return ~body
         let inner_id = Ident.create_local (Ident.name fun_id ^ "_inner") in
         let map_param (p : Lambda.lparam) =
           try
-            (* If the param is optional, then it must be a value *)
             {
               name = List.assoc p.name map;
-              layout = Lambda.layout_field;
+              layout = Lambda.layout_optional_arg;
               attributes = Lambda.default_param_attribute;
               mode = p.mode
             }

ocaml/lambda/tmc.ml

@@ -169,7 +169,7 @@ end = struct
       List.fold_right (fun binding body ->
           match binding with
           | None -> body
-          | Some (v, lam) -> Llet(Strict, Lambda.layout_field, v, lam, body)
+          | Some (v, lam) -> Llet(Strict, Lambda.layout_tmc_field, v, lam, body)
         ) bindings body in
     fun ~block_id constr body ->
     bind_list ~block_id ~arg_offset:0 constr.before @@ fun vbefore ->
@@ -915,7 +915,9 @@ let rec choice ctx t =
     (* we don't handle { foo with x = ...; y = recursive-call } *)
     | Pduprecord _
 
-    (* we don't handle all-float records or mixed blocks *)
+    (* we don't handle all-float records or mixed blocks. If we
+       did, we'd need to remove references to Lambda.layout_tmc_field
+    *)
     | Pmakefloatblock _
     | Pmakeufloatblock _
     | Pmakemixedblock _