Unarization for Flambda 2 (unboxed products)

backend/cmm_helpers.ml

@@ -1070,6 +1070,8 @@ module Extended_machtype = struct
       typ_any_int
     | Pvalue Pintval -> typ_tagged_int
     | Pvalue _ -> typ_val
+    | Punboxed_product _ ->
+      Misc.fatal_error "Punboxed_product not expected here"
 end
 
 let machtype_of_layout layout =
@@ -4002,19 +4004,19 @@ let direct_call ~dbg ty pos f_code_sym args =
   Cop (Capply (ty, pos), f_code_sym :: args, dbg)
 
 let indirect_call ~dbg ty pos alloc_mode f args_type args =
-  match args with
-  | [arg] ->
+  match args_type with
+  | [_] ->
     (* Use a variable to avoid duplicating the cmm code of the closure [f]. *)
     let v = Backend_var.create_local "*closure*" in
     let v' = Backend_var.With_provenance.create v in
     letin v' ~defining_expr:f
       ~body:
         (Cop
            ( Capply (Extended_machtype.to_machtype ty, pos),
-             [load ~dbg Word_int Asttypes.Mutable ~addr:(Cvar v); arg; Cvar v],
+             (load ~dbg Word_int Asttypes.Mutable ~addr:(Cvar v) :: args)
+             @ [Cvar v],
              dbg ))
-  | args ->
-    call_caml_apply ty args_type Asttypes.Mutable f args pos alloc_mode dbg
+  | _ -> call_caml_apply ty args_type Asttypes.Mutable f args pos alloc_mode dbg
 
 let indirect_full_call ~dbg ty pos alloc_mode f args_type = function
   (* the single-argument case is already optimized by indirect_call *)
@@ -4143,5 +4145,5 @@ let kind_of_layout (layout : Lambda.layout) =
   | Pvalue Pfloatval -> Boxed_float
   | Pvalue (Pboxedintval bi) -> Boxed_integer bi
   | Pvalue (Pgenval | Pintval | Pvariant _ | Parrayval _)
-  | Ptop | Pbottom | Punboxed_float | Punboxed_int _ ->
+  | Ptop | Pbottom | Punboxed_float | Punboxed_int _ | Punboxed_product _ ->
     Any

backend/cmmgen.ml

@@ -150,6 +150,7 @@ let get_field env layout ptr n dbg =
     | Pvalue Pintval | Punboxed_int _ -> Word_int
     | Pvalue _ -> Word_val
     | Punboxed_float -> Double
+    | Punboxed_product _ -> Misc.fatal_error "TBD"
     | Ptop ->
         Misc.fatal_errorf "get_field with Ptop: %a" Debuginfo.print_compact dbg
     | Pbottom ->
@@ -1322,6 +1323,7 @@ and transl_let env str (layout : Lambda.layout) id exp transl_body =
   end
   | Pvalue kind ->
     transl_let_value env str kind id exp transl_body
+  | Punboxed_product _ -> Misc.fatal_error "TBD"
 
 and make_catch (kind : Cmm.kind_for_unboxing) ncatch body handler dbg =
   match body with

middle_end/clambda_primitives.ml

@@ -150,6 +150,7 @@ and layout = Lambda.layout =
   | Pvalue of value_kind
   | Punboxed_float
   | Punboxed_int of boxed_integer
+  | Punboxed_product of layout list
   | Pbottom
 
 and block_shape = Lambda.block_shape

middle_end/clambda_primitives.mli

@@ -153,6 +153,7 @@ and layout = Lambda.layout =
   | Pvalue of value_kind
   | Punboxed_float
   | Punboxed_int of boxed_integer
+  | Punboxed_product of layout list
   | Pbottom
 
 and block_shape = Lambda.block_shape

middle_end/closure/closure.ml

@@ -65,6 +65,7 @@ let is_gc_ignorable kind =
   | Punboxed_int _ -> true
   | Pvalue Pintval -> true
   | Pvalue (Pgenval | Pfloatval | Pboxedintval _ | Pvariant _ | Parrayval _) -> false
+  | Punboxed_product _ -> Misc.fatal_error "TBD"
 
 let split_closure_fv kinds fv =
   List.fold_right (fun id (not_scanned, scanned) ->

middle_end/convert_primitives.ml

@@ -38,6 +38,8 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
   | Psetfloatfield (field, init_or_assign) ->
       Psetfloatfield (field, init_or_assign)
   | Pduprecord (repr, size) -> Pduprecord (repr, size)
+  | Pmake_unboxed_product _
+  | Punboxed_product_field _ -> Misc.fatal_error "TODO"
   | Pccall prim -> Pccall prim
   | Praise kind -> Praise kind
   | Psequand -> Psequand

middle_end/flambda/closure_offsets.ml

@@ -80,7 +80,8 @@ let add_closure_offsets
         | Punboxed_float -> true
         | Punboxed_int _ -> true
         | Pvalue Pintval -> true
-        | Pvalue _ -> false)
+        | Pvalue _ -> false
+        | Punboxed_product _ -> Misc.fatal_error "TODO")
       free_vars
   in
   let free_variable_offsets, free_variable_pos =

middle_end/flambda/flambda_to_clambda.ml

@@ -713,7 +713,8 @@ and to_clambda_set_of_closures t env
         | Punboxed_float -> true
         | Punboxed_int _ -> true
         | Pvalue Pintval -> true
-        | Pvalue _ -> false)
+        | Pvalue _ -> false
+        | Punboxed_product _ -> Misc.fatal_error "TBD")
       free_vars
   in
   let to_closure_args free_vars =

middle_end/flambda2/bound_identifiers/bound_parameters.ml

@@ -58,7 +58,11 @@ let var_set t = Variable.Set.of_list (vars t)
 
 let rename t = List.map (fun t -> BP.rename t) t
 
-let arity t = List.map (fun t -> BP.kind t) t |> Flambda_arity.create
+let arity t =
+  List.map
+    (fun t -> Flambda_arity.Component_for_creation.Singleton (BP.kind t))
+    t
+  |> Flambda_arity.create
 
 let free_names t =
   List.fold_left

middle_end/flambda2/bound_identifiers/bound_parameters.mli

@@ -30,7 +30,7 @@ val is_empty : t -> bool
 
 val same_number : t -> t -> bool
 
-val arity : t -> Flambda_arity.t
+val arity : t -> [> `Unarized] Flambda_arity.t
 
 val check_no_duplicates : t -> unit