Separate variant layouts from constructor matching plans

The runtime representation of a variant is declaration-level data, while the decision for a particular match depends on its arms, actions, default, and exhaustiveness. Represent the two separately:

- Variant_runtime.layout stores immutable constructor representations and declaration-level matching facts computed once.
- Type_variant stores an abstract one-shot layout_ref. Recursive declarations allocate it while provisional, then complete the same identity after the recursive group is available.
- Ordinary constructor descriptions address their representation by layout reference and source position, removing repeated name lookup and duplicated layout storage.
- Matching builds one occurrence-specific constructor_matching_plan in combine_constructor and immediately lowers it to existing Lambda forms. No Lam or Lambda expression form is added.
- Construction, matching, and type-based optimization consume the canonical representation instead of reinterpreting runtime attributes.

Rename Transparent to Unboxed and variant_dispatch to matching_facts so the remaining terms describe the represented facts rather than an implementation strategy.

Signed-off-by: Cristiano Calcagno <cristianoc@users.noreply.github.com>

Author: cristianoc

compiler/ml/datarepr.ml

@@ -70,7 +70,7 @@ let constructor_args priv cd_args cd_res path rep =
     let type_params = Type_set.elements arg_vars_set in
     let type_representation =
       match rep with
-      | Record_unboxed _ -> Transparent
+      | Record_unboxed _ -> Unboxed
       | _ -> Boxed
     in
     let tdecl =
@@ -102,19 +102,37 @@ let constructor_has_optional_shape
 
 (* The constructor's entry in its variant's canonical layout *)
 let constructor_case (cstr : constructor_description) =
-  match cstr.cstr_layout with
-  | Some layout -> Variant_runtime.constructor_by_name layout cstr.cstr_name
-  | None -> assert false
+  match cstr.cstr_kind with
+  | Ordinary_constructor representation ->
+    Variant_runtime.representation representation
+  | Extension_constructor _ -> assert false
 
-(* Sole payload-carrying constructor of an unboxed type: constructing it is
-   the identity at runtime *)
-let constructor_is_transparent (cstr : constructor_description) =
-  (match cstr.cstr_layout with
-  | Some [|Block _|] -> true
-  | _ -> false)
-  && List.exists
-       (fun (attribute, _) -> attribute.txt = "unboxed")
-       cstr.cstr_attributes
+let constructor_variant (cstr : constructor_description) =
+  match cstr.cstr_kind with
+  | Ordinary_constructor {variant} -> Variant_runtime.get_layout variant
+  | Extension_constructor _ -> assert false
+
+let constructor_position (cstr : constructor_description) =
+  match cstr.cstr_kind with
+  | Ordinary_constructor {position} -> position
+  | Extension_constructor _ -> assert false
+
+let constructor_payload_is_unboxed (cstr : constructor_description) =
+  match cstr.cstr_kind with
+  | Ordinary_constructor representation -> (
+    match Variant_runtime.representation representation with
+    | Block {runtime = {untagged = true}} -> true
+    | Constant _ | Block _ -> false)
+  | Extension_constructor _ -> false
+
+(* Sole payload-carrying constructor of an @unboxed type: constructing it is
+   the identity at runtime. *)
+let constructor_is_unboxed (cstr : constructor_description) =
+  match cstr.cstr_kind with
+  | Ordinary_constructor {variant} ->
+    constructor_payload_is_unboxed cstr
+    && Variant_runtime.length (Variant_runtime.get_layout variant) = 1
+  | Extension_constructor _ -> false
 
 let constructor_descrs ty_path decl cstrs =
   let layout =
@@ -123,27 +141,32 @@ let constructor_descrs ty_path decl cstrs =
     | Type_abstract | Type_record _ | Type_open -> assert false
   in
   let ty_res = newgenconstr ty_path decl.type_params in
-  let num_nonconsts = Variant_runtime.num_blocks layout in
-  let rec describe_constructors = function
+  let rec describe_constructors position = function
     | [] -> []
     | {cd_id; cd_args; cd_res; cd_loc; cd_attributes} :: rem ->
       let ty_res =
         match cd_res with
         | Some ty_res' -> ty_res'
         | None -> ty_res
       in
-      let descr_rem = describe_constructors rem in
+      let descr_rem = describe_constructors (position + 1) rem in
       let cstr_name = Ident.name cd_id in
+      let representation : Variant_runtime.constructor_reference =
+        {variant = layout; position}
+      in
       let existentials, cstr_args, cstr_inlined =
-        let representation =
-          if decl.type_representation = Transparent then Record_unboxed true
-          else
-            Record_inlined
-              {name = cstr_name; num_nonconsts; attrs = cd_attributes}
+        let record_representation =
+          match cd_args with
+          | Cstr_tuple _ ->
+            (* [constructor_args] ignores this value for tuple payloads. *)
+            Record_regular
+          | Cstr_record _ when decl.type_representation = Unboxed ->
+            Record_unboxed true
+          | Cstr_record _ -> Record_inlined {name = cstr_name; representation}
         in
         constructor_args decl.type_private cd_args cd_res
           (Path.Pdot (ty_path, cstr_name, Path.nopos))
-          representation
+          record_representation
       in
       let cstr =
         {
@@ -152,8 +175,7 @@ let constructor_descrs ty_path decl cstrs =
           cstr_existentials = existentials;
           cstr_args;
           cstr_arity = List.length cstr_args;
-          cstr_kind = Ordinary_constructor;
-          cstr_layout = Some layout;
+          cstr_kind = Ordinary_constructor representation;
           cstr_private = decl.type_private;
           cstr_generalized = cd_res <> None;
           cstr_loc = cd_loc;
@@ -163,7 +185,7 @@ let constructor_descrs ty_path decl cstrs =
       in
       (cd_id, cstr) :: descr_rem
   in
-  let result = describe_constructors cstrs in
+  let result = describe_constructors 0 cstrs in
   match result with
   | [
       (({Ident.name = "None"} as a_id), ({cstr_args = []} as a_descr));
@@ -204,7 +226,6 @@ let extension_descr path_ext ext =
     cstr_args;
     cstr_arity = List.length cstr_args;
     cstr_kind = Extension_constructor path_ext;
-    cstr_layout = None;
     cstr_private = ext.ext_private;
     cstr_generalized = ext.ext_ret_type <> None;
     cstr_loc = ext.ext_loc;

compiler/ml/datarepr.mli

@@ -21,7 +21,11 @@ open Types
 val constructor_has_optional_shape : Types.constructor_description -> bool
 val constructor_case :
   Types.constructor_description -> Variant_runtime.constructor_case
-val constructor_is_transparent : Types.constructor_description -> bool
+val constructor_variant :
+  Types.constructor_description -> Variant_runtime.layout
+val constructor_position : Types.constructor_description -> int
+val constructor_payload_is_unboxed : Types.constructor_description -> bool
+val constructor_is_unboxed : Types.constructor_description -> bool
 
 val extension_descr : Path.t -> extension_constructor -> constructor_description
 

compiler/ml/includecore.ml

@@ -350,8 +350,8 @@ let type_declarations ?(equality = false) ~loc env name decl1 id decl2 =
         in
         match
           ( decl2.type_kind,
-            decl1.type_representation = Transparent || untagged1,
-            decl2.type_representation = Transparent || untagged2 )
+            decl1.type_representation = Unboxed || untagged1,
+            decl2.type_representation = Unboxed || untagged2 )
         with
         | Type_abstract, _, _ -> []
         | _, true, false -> [Unboxed_representation false]

compiler/ml/lambda.ml

@@ -385,7 +385,7 @@ and switch_key =
 
 and switch_dispatch =
   | Switch_direct
-  | Switch_variant of Variant_runtime.variant_dispatch
+  | Switch_variant of Variant_runtime.matching_facts
 
 and 'a switch = {
   sw_consts_full: bool;

compiler/ml/lambda.mli

@@ -357,7 +357,7 @@ and switch_key =
 
 and switch_dispatch =
   | Switch_direct
-  | Switch_variant of Variant_runtime.variant_dispatch
+  | Switch_variant of Variant_runtime.matching_facts
 
 and 'a switch = {
   sw_consts_full: bool;