Add layout type in Lambda (#1032)

Author: Ekdohibs

backend/cmm_helpers.ml

@@ -1901,7 +1901,7 @@ module SArgBlocks = struct
 
   type loc = Debuginfo.t
 
-  type nonrec value_kind = value_kind
+  type layout = value_kind
 
   (* CR mshinwell: GPR#2294 will fix the Debuginfo here *)
 
@@ -3889,3 +3889,5 @@ let transl_attrib : Lambda.check_attribute -> Cmm.codegen_option list = function
   | Default_check -> []
   | Assert p -> [Assert (transl_property p)]
   | Assume p -> [Assume (transl_property p)]
+
+let kind_of_layout (Lambda.Pvalue kind) = Vval kind

backend/cmm_helpers.mli

@@ -1195,3 +1195,5 @@ val transl_attrib : Lambda.check_attribute -> Cmm.codegen_option list
 
 (* CR lmaurer: Return [Linkage_name.t] instead *)
 val make_symbol : ?compilation_unit:Compilation_unit.t -> string -> string
+
+val kind_of_layout : Lambda.layout -> value_kind

backend/cmmgen.ml

@@ -654,27 +654,27 @@ let rec transl env e =
           (untag_int (transl env arg) dbg)
           s.us_index_consts
           (Array.map (fun expr -> transl env expr, dbg) s.us_actions_consts)
-          dbg (Vval kind)
+          dbg (kind_of_layout kind)
       else if Array.length s.us_index_consts = 0 then
         bind "switch" (transl env arg) (fun arg ->
-          transl_switch dbg (Vval kind) env (get_tag arg dbg)
+          transl_switch dbg (kind_of_layout kind) env (get_tag arg dbg)
             s.us_index_blocks s.us_actions_blocks)
       else
         bind "switch" (transl env arg) (fun arg ->
           Cifthenelse(
           Cop(Cand, [arg; Cconst_int (1, dbg)], dbg),
           dbg,
-          transl_switch dbg (Vval kind) env
+          transl_switch dbg (kind_of_layout kind) env
             (untag_int arg dbg) s.us_index_consts s.us_actions_consts,
           dbg,
-          transl_switch dbg (Vval kind) env
+          transl_switch dbg (kind_of_layout kind) env
             (get_tag arg dbg) s.us_index_blocks s.us_actions_blocks,
-          dbg, Vval kind))
+          dbg, kind_of_layout kind))
   | Ustringswitch(arg,sw,d, kind) ->
       let dbg = Debuginfo.none in
       bind "switch" (transl env arg)
         (fun arg ->
-          strmatch_compile dbg (Vval kind) arg (Option.map (transl env) d)
+          strmatch_compile dbg (kind_of_layout kind) arg (Option.map (transl env) d)
             (List.map (fun (s,act) -> s,transl env act) sw))
   | Ustaticfail (nfail, args) ->
       let cargs = List.map (transl env) args in
@@ -684,21 +684,21 @@ let rec transl env e =
   | Ucatch(nfail, [], body, handler, kind) ->
       let dbg = Debuginfo.none in
       let env_body = enter_catch_body env nfail in
-      make_catch (Vval kind) nfail
+      make_catch (kind_of_layout kind) nfail
         (transl env_body body)
         (transl env handler) dbg
   | Ucatch(nfail, ids, body, handler, kind) ->
       let dbg = Debuginfo.none in
-      transl_catch (Vval kind) env nfail ids body handler dbg
+      transl_catch (kind_of_layout kind) env nfail ids body handler dbg
   | Utrywith(body, exn, handler, kind) ->
       let dbg = Debuginfo.none in
       let new_body = transl (incr_depth env) body in
-      Ctrywith(new_body, Regular, exn, transl env handler, dbg, Vval kind)
+      Ctrywith(new_body, Regular, exn, transl env handler, dbg, kind_of_layout kind)
   | Uifthenelse(cond, ifso, ifnot, kind) ->
       let ifso_dbg = Debuginfo.none in
       let ifnot_dbg = Debuginfo.none in
       let dbg = Debuginfo.none in
-      transl_if env (Vval kind) Unknown dbg cond
+      transl_if env (kind_of_layout kind) Unknown dbg cond
         ifso_dbg (transl env ifso) ifnot_dbg (transl env ifnot)
   | Usequence(exp1, exp2) ->
       Csequence(remove_unit(transl env exp1), transl env exp2)
@@ -773,7 +773,7 @@ and transl_catch (kind : Cmm.value_kind) env nfail ids body handler dbg =
      each argument.  *)
   let report args =
     List.iter2
-      (fun (_id, kind, u) c ->
+      (fun (_id, Pvalue kind, u) c ->
          let strict = is_strict kind in
          u := join_unboxed_number_kind ~strict !u
              (is_unboxed_number_cmm c)
@@ -1221,7 +1221,7 @@ and transl_unbox_sized size dbg env exp =
   | Thirty_two -> transl_unbox_int dbg env Pint32 exp
   | Sixty_four -> transl_unbox_int dbg env Pint64 exp
 
-and transl_let env str (kind : Lambda.value_kind) id exp transl_body =
+and transl_let env str (Pvalue kind : Lambda.layout) id exp transl_body =
   let dbg = Debuginfo.none in
   let cexp = transl env exp in
   let unboxing =

middle_end/clambda.ml

@@ -58,31 +58,31 @@ and ulambda =
       scanned_slots : ulambda list ;
     }
   | Uoffset of ulambda * int
-  | Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
+  | Ulet of mutable_flag * layout * Backend_var.With_provenance.t
       * ulambda * ulambda
   | Uphantom_let of Backend_var.With_provenance.t
       * uphantom_defining_expr option * ulambda
   | Uletrec of (Backend_var.With_provenance.t * ulambda) list * ulambda
   | Uprim of Clambda_primitives.primitive * ulambda list * Debuginfo.t
-  | Uswitch of ulambda * ulambda_switch * Debuginfo.t * Lambda.value_kind
+  | Uswitch of ulambda * ulambda_switch * Debuginfo.t * layout
   | Ustringswitch of
       ulambda *
       (string * ulambda) list *
       ulambda option *
-      Lambda.value_kind
+      layout
   | Ustaticfail of int * ulambda list
   | Ucatch of
       int *
-      (Backend_var.With_provenance.t * value_kind) list *
+      (Backend_var.With_provenance.t * layout) list *
       ulambda *
       ulambda *
-      Lambda.value_kind
+      layout
   | Utrywith of
       ulambda *
       Backend_var.With_provenance.t *
       ulambda *
-      Lambda.value_kind
-  | Uifthenelse of ulambda * ulambda * ulambda * Lambda.value_kind
+      layout
+  | Uifthenelse of ulambda * ulambda * ulambda * layout
   | Usequence of ulambda * ulambda
   | Uwhile of ulambda * ulambda
   | Ufor of Backend_var.With_provenance.t * ulambda * ulambda
@@ -98,8 +98,8 @@ and ulambda =
 and ufunction = {
   label  : function_label;
   arity  : arity;
-  params : (Backend_var.With_provenance.t * value_kind) list;
-  return : value_kind;
+  params : (Backend_var.With_provenance.t * layout) list;
+  return : layout;
   body   : ulambda;
   dbg    : Debuginfo.t;
   env    : Backend_var.t option;

middle_end/clambda.mli

@@ -69,31 +69,31 @@ and ulambda =
       scanned_slots : ulambda list
     }
   | Uoffset of ulambda * int
-  | Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
+  | Ulet of mutable_flag * layout * Backend_var.With_provenance.t
       * ulambda * ulambda
   | Uphantom_let of Backend_var.With_provenance.t
       * uphantom_defining_expr option * ulambda
   | Uletrec of (Backend_var.With_provenance.t * ulambda) list * ulambda
   | Uprim of Clambda_primitives.primitive * ulambda list * Debuginfo.t
-  | Uswitch of ulambda * ulambda_switch * Debuginfo.t * Lambda.value_kind
+  | Uswitch of ulambda * ulambda_switch * Debuginfo.t * Lambda.layout
   | Ustringswitch of
       ulambda *
       (string * ulambda) list *
       ulambda option *
-      Lambda.value_kind
+      Lambda.layout
   | Ustaticfail of int * ulambda list
   | Ucatch of
       int *
-      (Backend_var.With_provenance.t * value_kind) list *
+      (Backend_var.With_provenance.t * layout) list *
       ulambda *
       ulambda *
-      Lambda.value_kind
+      Lambda.layout
   | Utrywith of
       ulambda *
       Backend_var.With_provenance.t *
       ulambda *
-      Lambda.value_kind
-  | Uifthenelse of ulambda * ulambda * ulambda * Lambda.value_kind
+      Lambda.layout
+  | Uifthenelse of ulambda * ulambda * ulambda * Lambda.layout
   | Usequence of ulambda * ulambda
   | Uwhile of ulambda * ulambda
   | Ufor of Backend_var.With_provenance.t * ulambda * ulambda
@@ -109,8 +109,8 @@ and ulambda =
 and ufunction = {
   label  : function_label;
   arity  : arity;
-  params : (Backend_var.With_provenance.t * value_kind) list;
-  return : value_kind;
+  params : (Backend_var.With_provenance.t * layout) list;
+  return : layout;
   body   : ulambda;
   dbg    : Debuginfo.t;
   env    : Backend_var.t option;

middle_end/clambda_primitives.ml

@@ -141,6 +141,9 @@ and value_kind = Lambda.value_kind =
     }
   | Parrayval of array_kind
 
+and layout = Lambda.layout =
+  | Pvalue of value_kind
+
 and block_shape = Lambda.block_shape
 and boxed_integer = Primitive.boxed_integer =
     Pnativeint | Pint32 | Pint64

middle_end/clambda_primitives.mli

@@ -144,6 +144,9 @@ and value_kind = Lambda.value_kind =
     }
   | Parrayval of array_kind
 
+and layout = Lambda.layout =
+  | Pvalue of value_kind
+
 and block_shape = Lambda.block_shape
 and boxed_integer = Primitive.boxed_integer =
     Pnativeint | Pint32 | Pint64