Make variant runtime representation canonical across compiler IRs

CHANGELOG.md

@@ -50,6 +50,7 @@
 
 #### :house: Internal
 
+- Give nominal variants one canonical runtime layout: compute their JavaScript representation once after typing each declaration, replace positional constructor tags with semantic runtime descriptors, and make construction, matching, coercion, printing, diagnostics, and GenType consume the stored representation instead of reinterpreting annotations. Pattern matching keeps occurrence-specific plans local without adding another Lambda or Lam expression form. https://github.com/rescript-lang/rescript/pull/8579
 - Sync the platform npm package's compiler binaries (`packages/@rescript/<platform>/bin`) via dune promotion on every `dune build`, instead of Makefile/CI copy steps that only ran when make did: a plain `dune build` can no longer leave `cli/*.js` and the test harnesses running a stale compiler. https://github.com/rescript-lang/rescript/pull/8560
 - Remove unused compiler IR definitions, modules, helpers, error variants, and Typedtree fields. https://github.com/rescript-lang/rescript/pull/8551 https://github.com/rescript-lang/rescript/pull/8555
 - Make locally abstract value constraints (`let f: type a. t = value`) structural in the parsetree, remove the obsolete `Pexp_newtype` and `Texp_newtype` wrapper metadata, and keep the old encoding confined to the frozen external-PPX bridge. The CMT magic number is bumped to `Caml1999T024`. https://github.com/rescript-lang/rescript/pull/8575

analysis/reanalyze/src/dead_type.ml

@@ -39,7 +39,7 @@ let add_declaration ~config ~decls ~file ~(module_path : Module_path.t)
         Ident.name ld_id |> Name.create
         |> process_type_label ~decl_kind:RecordLabel ~loc:ld_loc)
       l
-  | Type_variant decls ->
+  | Type_variant (decls, _) ->
     List.iteri
       (fun i {Types.cd_id; cd_loc; cd_args} ->
         let _handle_inline_records =

analysis/reanalyze/src/dead_value.ml

@@ -230,11 +230,11 @@ let rec collect_expr ~config ~refs ~file_deps ~cross_file ~direct_callees
       ( _,
         {
           cstr_loc = {Location.loc_start = pos_to; loc_ghost} as loc_to;
-          cstr_tag;
+          cstr_kind;
         },
         _ ) ->
-    (match cstr_tag with
-    | Cstr_extension path ->
+    (match cstr_kind with
+    | Extension_constructor path ->
       path
       |> Dead_exception.mark_as_used ~config ~refs ~file_deps ~cross_file
            ~binding ~loc_from ~loc_to

analysis/src/hover.ml

@@ -82,7 +82,7 @@ let find_relevant_types_from_type ~state ~file ~package typ =
         match decl.type_kind with
         | Type_record (lds, _) ->
           (env1, typ :: (lds |> label_declarations_types))
-        | Type_variant cds ->
+        | Type_variant (cds, _) ->
           ( env1,
             cds
             |> List.map (fun (cd : Types.constructor_declaration) ->

analysis/src/process_cmt.ml

@@ -90,7 +90,7 @@ let rec for_type_signature_item ~(env : Shared_types.Env.t)
                 (* TODO dig *)
                 | _ -> Abstract None)
               | Type_open -> Open
-              | Type_variant constructors ->
+              | Type_variant (constructors, _) ->
                 Variant
                   (constructors
                   |> List.map

compiler/bsc/rescript_compiler_main.ml

@@ -370,9 +370,6 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
       "*internal* Set gentype bsb project root (workspace root containing \
        .sourcedirs.json)" );
     (******************************************************************************)
-    ( "-unboxed-types",
-      set Clflags.unboxed_types,
-      "*internal* Unannotated unboxable types will be unboxed" );
     ("-nostdlib", set Js_config.no_stdlib, "*internal* Don't use stdlib");
     ( "-color",
       string_call set_color_option,

compiler/core/bs_conditional_initial.ml

@@ -44,8 +44,6 @@ let setup_env () =
     Record_attributes_check.check_bs_attributes_inclusion;
   Builtin_attributes.check_duplicated_labels :=
     Record_attributes_check.check_duplicated_labels;
-  Matching.names_from_construct_pattern :=
-    Matching_polyfill.names_from_construct_pattern;
 
   Printtyp.print_res_poly_identifier := Res_printer.polyvar_ident_to_string
 (*; Switch.cut := 100*)

compiler/core/j.ml

@@ -148,9 +148,7 @@ and expression_desc =
   | Array of expression list
   | Optional_block of expression * bool
   (* [true] means [identity] *)
-  | Caml_block of expression list * mutable_flag * expression * tag_info
-  (* The third argument is [tag] , forth is [tag_info] *)
-  (* [tag] and [size] tailed  for [Obj.new_block] *)
+  | Caml_block of expression list * mutable_flag * tag_info
   | Caml_block_tag of expression * string (* e.tag *)
   (* It will just fetch tag, to make it safe, when creating it,
      we need apply "|0", we don't do it in the
@@ -246,7 +244,7 @@ and case_clause = {
   source_loc: Location.t option;
 }
 
-and string_clause = Ast_untagged_variants.tag_type * case_clause
+and string_clause = Variant_runtime.tag_type * case_clause
 and int_clause = int * case_clause
 and label = string
 

compiler/core/js_analyzer.ml

@@ -105,7 +105,7 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) =
     no_side_effect a && no_side_effect b
   | Is_null_or_undefined b -> no_side_effect b
   | Str _ -> true
-  | Array xs | Caml_block (xs, _, _, _) ->
+  | Array xs | Caml_block (xs, _, _) ->
     (* create [immutable] block,
         does not really mean that this opreation itself is [pure].
 
@@ -239,10 +239,10 @@ let rec eq_expression ({expression_desc = x0} : J.expression)
     match y0 with
     | Optional_block (a1, b1) -> b0 = b1 && eq_expression a0 a1
     | _ -> false)
-  | Caml_block (ls0, flag0, tag0, _) -> (
+  | Caml_block (ls0, flag0, info0) -> (
     match y0 with
-    | Caml_block (ls1, flag1, tag1, _) ->
-      eq_expression_list ls0 ls1 && flag0 = flag1 && eq_expression tag0 tag1
+    | Caml_block (ls1, flag1, info1) ->
+      eq_expression_list ls0 ls1 && flag0 = flag1 && info0 = info1
     | _ -> false)
   | Length _ | Is_null_or_undefined _ | String_append _ | Typeof _ | Js_not _
   | Js_bnot _ | In _ | Cond _ | FlatCall _ | New _ | Fun _ | Raw_js_code _
@@ -312,7 +312,7 @@ let rev_toplevel_flatten block =
    | Str (b,_) -> b
    | Number _ -> true (* Can be refined later *)
    | Array xs -> Ext_list.for_all xs is_constant
-   | Caml_block(xs, Immutable, tag, _)
+   | Caml_block(xs, Immutable, _)
     -> Ext_list.for_all xs is_constant && is_constant tag
    | Bin (_op, a, b) ->
     is_constant a && is_constant b

compiler/core/js_dump.ml

@@ -155,7 +155,6 @@ let rec exp_need_paren ?(arrow = false) (e : J.expression) =
   | Fun _
   | Caml_block
       ( _,
-        _,
         _,
         ( Blk_record _ | Blk_module _ | Blk_poly_var _ | Blk_extension
         | Blk_record_ext _ | Blk_record_inlined _ | Blk_constructor _ ) )
@@ -588,7 +587,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
      {
        expression_desc =
          (* This is the props javascript object *)
-         Caml_block (el, _mutable_flag, _, Lambda.Blk_record {fields});
+         Caml_block (el, _mutable_flag, Lambda.Blk_record {fields});
      };
     ] ->
       (* We extract the props from the javascript object *)
@@ -603,7 +602,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
      tag;
      {
        expression_desc =
-         Caml_block (el, _mutable_flag, _, Lambda.Blk_record {fields});
+         Caml_block (el, _mutable_flag, Lambda.Blk_record {fields});
      };
      key;
     ] ->
@@ -937,14 +936,14 @@ and expression_desc cxt ~(level : int) f x : cxt =
     expression ~level cxt f
       (if identity then e
        else E.runtime_call Primitive_modules.option "some" [e])
-  | Caml_block (el, _, _, Blk_module fields) ->
+  | Caml_block (el, _, Blk_module fields) ->
     expression_desc cxt ~level f
       (Object
          ( None,
            Ext_list.map_combine fields el (fun x ->
                Js_op.Lit (Ext_ident.convert x)) ))
   (*name convention of Record is slight different from modules*)
-  | Caml_block (el, _, _, Blk_record {fields}) ->
+  | Caml_block (el, _, Blk_record {fields}) ->
     if
       Array.length fields <> 0
       && Ext_array.for_alli fields (fun i (v, _) -> string_of_int i = v)
@@ -957,7 +956,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
             | _ -> Some (Js_op.Lit f, x))
       in
       expression_desc cxt ~level f (Object (None, fields))
-  | Caml_block (el, _, _, Blk_poly_var _) -> (
+  | Caml_block (el, _, Blk_poly_var _) -> (
     match el with
     | [tag; value] ->
       expression_desc cxt ~level f
@@ -968,19 +967,15 @@ and expression_desc cxt ~(level : int) f x : cxt =
                (Lit Literals.polyvar_value, value);
              ] ))
     | _ -> assert false)
-  | Caml_block (el, _, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
+  | Caml_block (el, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
     expression_desc cxt ~level f (exn_block_as_obj ~stack:false el ext)
-  | Caml_block (el, _, tag, Blk_record_inlined p) ->
-    let untagged = Ast_untagged_variants.process_untagged p.attrs in
+  | Caml_block (el, _, Blk_record_inlined p) ->
+    let {Variant_runtime.tag; tag_name; untagged} = p.runtime in
     let objs =
       let tails =
         Ext_list.combine_array p.fields el (fun (i, opt) -> (Js_op.Lit i, opt))
       in
-      let tag_name =
-        match Ast_untagged_variants.process_tag_name p.attrs with
-        | None -> L.tag
-        | Some s -> s
-      in
+      let tag_name = Option.value tag_name ~default:L.tag in
       let tails =
         Ext_list.filter_map tails (fun ((f, optional), x) ->
             match x.expression_desc with
@@ -991,21 +986,17 @@ and expression_desc cxt ~(level : int) f x : cxt =
       else
         ( Js_op.Lit tag_name,
           (* TAG:xx for inline records *)
-          match Ast_untagged_variants.process_tag_type p.attrs with
+          match tag.tag_type with
           | None -> E.str p.name
           | Some t -> E.tag_type t )
         :: tails
     in
     expression_desc cxt ~level f (Object (None, objs))
-  | Caml_block (el, _, tag, Blk_constructor p) ->
+  | Caml_block (el, _, Blk_constructor p) ->
     let not_is_cons = p.name <> Literals.cons in
-    let tag_type = Ast_untagged_variants.process_tag_type p.attrs in
-    let untagged = Ast_untagged_variants.process_untagged p.attrs in
-    let tag_name =
-      match Ast_untagged_variants.process_tag_name p.attrs with
-      | None -> L.tag
-      | Some s -> s
-    in
+    let {Variant_runtime.tag; tag_name; untagged} = p.runtime in
+    let tag_type = tag.tag_type in
+    let tag_name = Option.value tag_name ~default:L.tag in
     let objs =
       let tails =
         Ext_list.mapi_append el
@@ -1019,7 +1010,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
              [(name_symbol, E.str p.name)]
            else [])
       in
-      if untagged || (not_is_cons = false && p.num_nonconst = 1) then tails
+      if untagged || not_is_cons = false then tails
       else
         ( Js_op.Lit tag_name,
           (* TAG:xx *)
@@ -1036,11 +1027,9 @@ and expression_desc cxt ~(level : int) f x : cxt =
       | _ -> J.Object (None, objs)
     in
     expression_desc cxt ~level f exp
-  | Caml_block (_, _, _, (Blk_module_export _ | Blk_some | Blk_some_not_nested))
-    ->
+  | Caml_block (_, _, (Blk_module_export _ | Blk_some | Blk_some_not_nested)) ->
     assert false
-  | Caml_block (el, _, _tag, Blk_tuple) ->
-    expression_desc cxt ~level f (Array el)
+  | Caml_block (el, _, Blk_tuple) -> expression_desc cxt ~level f (Array el)
   | Caml_block_tag (e, tag) ->
     P.group f 1 (fun _ ->
         let cxt = expression ~level:15 cxt f e in
@@ -1700,7 +1689,7 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
     let cxt = P.paren_group f 1 (fun _ -> expression ~level:0 cxt f e) in
     P.space f;
     P.brace_vgroup f 1 (fun _ ->
-        let pp_as_value f (tag_type : Ast_untagged_variants.tag_type) =
+        let pp_as_value f (tag_type : Variant_runtime.tag_type) =
           let e = E.tag_type tag_type in
           ignore @@ expression_desc cxt ~level:0 f e.expression_desc
         in
@@ -1717,7 +1706,7 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
   | Throw e ->
     let e =
       match e.expression_desc with
-      | Caml_block (el, _, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
+      | Caml_block (el, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
         {e with expression_desc = exn_block_as_obj ~stack:true el ext}
       | _ -> e
     in

compiler/core/js_exp_make.ml

@@ -202,7 +202,7 @@ let dot ?comment (e0 : t) (e1 : string) : t =
 let module_access (e : t) (name : string) (pos : int32) =
   let name = Ext_ident.convert name in
   match e.expression_desc with
-  | Caml_block (l, _, _, _) when no_side_effect e -> (
+  | Caml_block (l, _, _) when no_side_effect e -> (
     match Ext_list.nth_opt l (Int32.to_int pos) with
     | Some x -> x
     | None ->
@@ -218,10 +218,10 @@ let module_access (e : t) (name : string) (pos : int32) =
       source_loc = None;
     }
 
-let make_block ?comment (tag : t) (tag_info : J.tag_info) (es : t list)
+let make_block ?comment (tag_info : J.tag_info) (es : t list)
     (mutable_flag : J.mutable_flag) : t =
   {
-    expression_desc = Caml_block (es, mutable_flag, tag, tag_info);
+    expression_desc = Caml_block (es, mutable_flag, tag_info);
     comment;
     source_loc = None;
   }
@@ -478,7 +478,7 @@ let array_index ?comment (e0 : t) (e1 : t) : t =
 
 let array_index_by_int ?comment (e : t) (pos : int32) : t =
   match e.expression_desc with
-  | (Array l (* Float i -- should not appear here *) | Caml_block (l, _, _, _))
+  | (Array l (* Float i -- should not appear here *) | Caml_block (l, _, _))
     when no_side_effect e -> (
     match Ext_list.nth_opt l (Int32.to_int pos) with
     | Some x -> x
@@ -497,7 +497,7 @@ let array_index_by_int ?comment (e : t) (pos : int32) : t =
 
 let record_access (e : t) (name : string) (pos : int32) =
   match e.expression_desc with
-  | (Array l (* Float i -- should not appear here *) | Caml_block (l, _, _, _))
+  | (Array l (* Float i -- should not appear here *) | Caml_block (l, _, _))
     when no_side_effect e -> (
     match Ext_list.nth_opt l (Int32.to_int pos) with
     | Some x -> x
@@ -530,7 +530,7 @@ let cons_access (e : t) (pos : int32) =
 
 let poly_var_tag_access (e : t) =
   match e.expression_desc with
-  | Caml_block (l, _, _, _) when no_side_effect e -> (
+  | Caml_block (l, _, _) when no_side_effect e -> (
     match l with
     | x :: _ -> x
     | [] -> assert false)
@@ -543,7 +543,7 @@ let poly_var_tag_access (e : t) =
 
 let poly_var_value_access (e : t) =
   match e.expression_desc with
-  | Caml_block (l, _, _, _) when no_side_effect e -> (
+  | Caml_block (l, _, _) when no_side_effect e -> (
     match l with
     | _ :: v :: _ -> v
     | _ -> assert false)
@@ -556,7 +556,7 @@ let poly_var_value_access (e : t) =
 
 let extension_access (e : t) name (pos : int32) : t =
   match e.expression_desc with
-  | (Array l (* Float i -- should not appear here *) | Caml_block (l, _, _, _))
+  | (Array l (* Float i -- should not appear here *) | Caml_block (l, _, _))
     when no_side_effect e -> (
     match Ext_list.nth_opt l (Int32.to_int pos) with
     | Some x -> x
@@ -635,7 +635,7 @@ let extension_assign (e : t) (pos : int32) name (value : t) =
 let array_length ?comment (e : t) : t =
   match e.expression_desc with
   (* TODO: use array instead? *)
-  | (Array l | Caml_block (l, _, _, _)) when no_side_effect e ->
+  | (Array l | Caml_block (l, _, _)) when no_side_effect e ->
     int ?comment (Int32.of_int (List.length l))
   | _ -> {expression_desc = Length e; comment; source_loc = None}
 
@@ -1358,7 +1358,7 @@ let rec float_equal ?comment (e0 : t) (e1 : t) : t =
 let int_equal = float_equal
 
 let tag_type = function
-  | Ast_untagged_variants.String s -> str s ~delim:DStarJ
+  | Variant_runtime.String s -> str s ~delim:DStarJ
   | Int i -> small_int i
   | Float f -> float f
   | BigInt i ->
@@ -1374,7 +1374,7 @@ let tag_type = function
   | Untagged FunctionType -> str "function"
   | Untagged StringType -> str "string"
   | Untagged (InstanceType i) ->
-    str (Ast_untagged_variants.Instance.to_string i) ~delim:DNoQuotes
+    str (Variant_runtime.Instance.to_string i) ~delim:DNoQuotes
   | Untagged ObjectType -> str "object"
   | Untagged UnknownType ->
     (* TODO: this should not happen *)
@@ -1395,7 +1395,7 @@ let rec emit_check (check : t Ast_untagged_variants.Dynamic_checks.t) =
   | TypeOf x -> typeof (emit_check x)
   | IsInstanceOf (Array, x) -> is_array (emit_check x)
   | IsInstanceOf (instance, x) ->
-    let instance_name = Ast_untagged_variants.Instance.to_string instance in
+    let instance_name = Variant_runtime.Instance.to_string instance in
     instanceof (emit_check x) (str instance_name ~delim:DNoQuotes)
   | Not x -> not (emit_check x)
   | Expr x -> x

compiler/core/js_exp_make.mli

@@ -165,7 +165,7 @@ val extension_assign : t -> int32 -> string -> t -> t
 
 val assign : ?comment:string -> t -> t -> t
 
-val tag_type : Ast_untagged_variants.tag_type -> t
+val tag_type : Variant_runtime.tag_type -> t
 
 val emit_check : t Ast_untagged_variants.Dynamic_checks.t -> t
 
@@ -187,8 +187,8 @@ val is_type_number : ?comment:string -> t -> t
 val is_int_tag : ?has_null_undefined_other:bool * bool * bool -> t -> t
 
 val is_a_literal_case :
-  literal_cases:Ast_untagged_variants.tag_type list ->
-  block_cases:Ast_untagged_variants.block_type list ->
+  literal_cases:Variant_runtime.tag_type list ->
+  block_cases:Variant_runtime.block_type list ->
   t ->
   t
 
@@ -272,8 +272,6 @@ val optional_not_nest_block : J.expression -> J.expression
 
 val make_block :
   ?comment:string ->
-  J.expression ->
-  (* tag *)
   J.tag_info ->
   (* tag_info *)
   J.expression list ->