Fix type error for variant constructor args as optional field record

CHANGELOG.md

@@ -10,6 +10,12 @@
 > - :house: [Internal]
 > - :nail_care: [Polish]
 
+# 10.1.0-rc.6
+
+#### :bug: Bug Fix
+
+- Fix issue where optional field in the inlined record caused the type error https://github.com/rescript-lang/rescript-compiler/pull/5827
+
 # 10.1.0-rc.5
 
 #### :bug: Bug Fix

jscomp/core/js_dump.ml

@@ -757,6 +757,20 @@ and expression_desc cxt ~(level : int) f x : cxt =
             (if !Js_config.debug then [ (name_symbol, E.str p.name) ] else [])
             (fun i -> Js_op.Lit i)
         in
+        let is_optional (pname: Js_op.property_name)  =
+          match pname with
+          | Lit n -> Ext_list.mem_string p.optional_labels n
+          | Symbol_name -> false
+        in
+        let tails =
+          match p.optional_labels with
+          | [] -> tails
+          | _ ->
+            Ext_list.filter_map tails (fun (f, x) ->
+              match x.expression_desc with
+              | Undefined when is_optional f -> None
+              | _ -> Some (f, x))
+          in
         if p.num_nonconst = 1 then tails
         else
           ( Js_op.Lit L.tag,

jscomp/ml/datarepr.ml

@@ -113,6 +113,7 @@ let constructor_descrs ty_path decl cstrs =
       if cd_args = Cstr_tuple [] then incr num_consts else incr num_nonconsts;
       if cd_res = None then incr num_normal)
     cstrs;
+  let has_optional attrs = Ext_list.exists attrs (fun ({txt },_) -> txt = "ns.optional") in
   let rec describe_constructors idx_const idx_nonconst = function
       [] -> []
     | {cd_id; cd_args; cd_res; cd_loc; cd_attributes} :: rem ->
@@ -131,11 +132,17 @@ let constructor_descrs ty_path decl cstrs =
           | _  -> (Cstr_block idx_nonconst,
                    describe_constructors idx_const (idx_nonconst+1) rem) in
         let cstr_name = Ident.name cd_id in
+        let optional_labels = match cd_args with
+          | Cstr_tuple _ -> []
+          | Cstr_record lbls ->
+            Ext_list.filter_map lbls (fun ({ld_id;ld_attributes; _}) ->
+              if has_optional ld_attributes then Some ld_id.name else None)
+        in
         let existentials, cstr_args, cstr_inlined =
           let representation =
             if decl.type_unboxed.unboxed
             then Record_unboxed true
-            else Record_inlined {tag = idx_nonconst; name = cstr_name; num_nonconsts = !num_nonconsts}
+            else Record_inlined {tag = idx_nonconst; name = cstr_name; num_nonconsts = !num_nonconsts; optional_labels}
           in
           constructor_args decl.type_private cd_args cd_res
             (Path.Pdot (ty_path, cstr_name, Path.nopos)) representation

jscomp/ml/lambda.ml

@@ -40,7 +40,7 @@ type record_repr =
 
 type tag_info = 
   | Blk_constructor of {name : string ; num_nonconst : int ; tag : int }
-  | Blk_record_inlined of { name : string ; num_nonconst :  int;  tag : int; fields : string array; mutable_flag : Asttypes.mutable_flag }   
+  | Blk_record_inlined of { name : string ; num_nonconst :  int;  tag : int;  optional_labels: string list; fields : string array; mutable_flag : Asttypes.mutable_flag }   
   | Blk_tuple
   | Blk_poly_var of string 
   | Blk_record of {fields : string array; mutable_flag : Asttypes.mutable_flag; record_repr : record_repr}  
@@ -96,9 +96,9 @@ let blk_record_ext =  ref (fun fields mutable_flag ->
     Blk_record_ext {fields = all_labels_info; mutable_flag }
   )
 
-let blk_record_inlined = ref (fun fields name num_nonconst ~tag mutable_flag -> 
+let blk_record_inlined = ref (fun fields name num_nonconst optional_labels ~tag mutable_flag -> 
   let fields = fields |> Array.map (fun (x,_) -> x.Types.lbl_name) in    
-  Blk_record_inlined {fields; name; num_nonconst; tag; mutable_flag}
+  Blk_record_inlined {fields; name; num_nonconst; tag; mutable_flag; optional_labels}
 ) 
 
 let ref_tag_info : tag_info = 

jscomp/ml/lambda.mli

@@ -40,7 +40,7 @@ type record_repr =
 
 type tag_info = 
   | Blk_constructor of {name : string ; num_nonconst : int; tag : int}
-  | Blk_record_inlined of { name : string ; num_nonconst :  int ;  tag : int; fields : string array; mutable_flag : mutable_flag}   
+  | Blk_record_inlined of { name : string ; num_nonconst :  int ;  tag : int; optional_labels: string list; fields : string array; mutable_flag : mutable_flag }   
   | Blk_tuple
   | Blk_poly_var of string 
   | Blk_record of {fields : string array; mutable_flag : mutable_flag; record_repr : record_repr }
@@ -85,6 +85,7 @@ val blk_record_inlined :
     (Types.label_description* Typedtree.record_label_definition) array ->
     string ->
     int ->
+    string list ->
     tag:int ->    
     mutable_flag ->  
     tag_info

jscomp/ml/translcore.ml

@@ -1138,10 +1138,10 @@ and transl_record loc env fields repres opt_init_expr =
             | Record_optional_labels _ ->
                 Lconst
                   (Const_block (!Lambda.blk_record fields mut Record_optional, cl))
-            | Record_inlined { tag; name; num_nonconsts } ->
+            | Record_inlined { tag; name; num_nonconsts; optional_labels } ->
                 Lconst
                   (Const_block
-                     ( !Lambda.blk_record_inlined fields name num_nonconsts ~tag
+                     ( !Lambda.blk_record_inlined fields name num_nonconsts optional_labels ~tag
                          mut,
                        cl ))
             | Record_unboxed _ ->
@@ -1160,10 +1160,10 @@ and transl_record loc env fields repres opt_init_expr =
                     ll,
                     loc )
             | Record_float_unused -> assert false
-            | Record_inlined { tag; name; num_nonconsts } ->
+            | Record_inlined { tag; name; num_nonconsts; optional_labels } ->
                 Lprim
                   ( Pmakeblock
-                      (!Lambda.blk_record_inlined fields name num_nonconsts ~tag
+                      (!Lambda.blk_record_inlined fields name num_nonconsts optional_labels ~tag
                          mut),
                     ll,
                     loc )

jscomp/ml/typecore.ml

@@ -1153,6 +1153,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
       let label_is_optional ld =
         match ld.lbl_repres with
         | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
+        | Record_inlined {optional_labels} -> Ext_list.mem_string optional_labels ld.lbl_name
         | _ -> false in
       let process_optional_label (ld, pat) =
         let exp_optional_attr =
@@ -1879,6 +1880,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
   let label_is_optional ld =
     match ld.lbl_repres with
     | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
+    | Record_inlined {optional_labels} -> Ext_list.mem_string optional_labels ld.lbl_name
     | _ -> false in
   let process_optional_label (id, ld, e) =
     let exp_optional_attr =

jscomp/ml/typedecl.ml

@@ -358,6 +358,20 @@ let transl_declaration env sdecl id =
           | (_,_,loc)::_ ->
               Location.prerr_warning loc Warnings.Constraint_on_gadt
         end;
+        let has_optional attrs = Ext_list.exists attrs (fun ({txt },_) -> txt = "ns.optional") in
+        let scstrs =
+          Ext_list.map scstrs (fun ({pcd_args} as cstr) ->
+            match pcd_args with
+            | Pcstr_tuple _ -> cstr
+            | Pcstr_record lds ->
+              {cstr with pcd_args = Pcstr_record (Ext_list.map lds (fun ld ->
+                if has_optional ld.pld_attributes then
+                  let typ = ld.pld_type in
+                  let typ = {typ with ptyp_desc = Ptyp_constr ({txt = Lident "option"; loc=typ.ptyp_loc}, [typ])} in
+                  {ld with pld_type = typ}
+                else ld
+              ))}
+            ) in
         let all_constrs = ref StringSet.empty in
         List.iter
           (fun {pcd_name = {txt = name}} ->

jscomp/ml/types.ml

@@ -154,7 +154,7 @@ and record_representation =
   | Record_float_unused                   (* Was: all fields are floats. Now: unused *)
   | Record_unboxed of bool                (* Unboxed single-field record, inlined or not *)
   | Record_inlined of                     (* Inlined record *)
-      { tag : int ; name : string; num_nonconsts : int}
+      { tag : int ; name : string; num_nonconsts : int; optional_labels : string list}
   | Record_extension                      (* Inlined record under extension *)
   | Record_optional_labels of string list (* List of optional labels *)
 
@@ -348,10 +348,10 @@ let same_record_representation x y =
       match y with
       | Record_optional_labels lbls2 -> lbls = lbls2
       | _ -> false)
-  | Record_inlined {tag; name; num_nonconsts} -> (
+  | Record_inlined {tag; name; num_nonconsts; optional_labels} -> (
       match y with
       | Record_inlined y ->
-          tag = y.tag && name = y.name && num_nonconsts = y.num_nonconsts
+          tag = y.tag && name = y.name && num_nonconsts = y.num_nonconsts && optional_labels = y.optional_labels
       | _ -> false)
   | Record_extension -> y = Record_extension
   | Record_unboxed x -> ( match y with Record_unboxed y -> x = y | _ -> false)

jscomp/ml/types.mli

@@ -301,7 +301,7 @@ and record_representation =
   | Record_float_unused                   (* Was: all fields are floats. Now: unused *)
   | Record_unboxed of bool                (* Unboxed single-field record, inlined or not *)
   | Record_inlined of                     (* Inlined record *)
-      { tag : int ; name : string; num_nonconsts : int}
+      { tag : int ; name : string; num_nonconsts : int; optional_labels : string list}
   | Record_extension                      (* Inlined record under extension *)
   | Record_optional_labels of string list (* List of optional labels *)
 

jscomp/test/record_regression.js

@@ -60,6 +60,183 @@ function setAA(ao) {
         };
 }
 
+var ir0 = {
+  TAG: /* V0 */0,
+  x0: "v0",
+  x3: 3
+};
+
+var ir1 = {
+  TAG: /* V0 */0,
+  x0: "v0",
+  x1: "v1",
+  x3: 3
+};
+
+var ir2 = {
+  TAG: /* V0 */0,
+  x0: "v0",
+  x1: "v1",
+  x2: 2,
+  x3: 3
+};
+
+var ir3 = {
+  TAG: /* V1 */1,
+  y0: "v0",
+  y1: 1
+};
+
+var pm0;
+
+pm0 = ir0.TAG === /* V0 */0 ? [
+    "v0",
+    3
+  ] : [
+    "v0",
+    undefined
+  ];
+
+var pm1;
+
+if (ir1.TAG === /* V0 */0) {
+  var x1 = "v1";
+  var x0 = "v0";
+  pm1 = x1 !== undefined ? [
+      x0,
+      x1,
+      3
+    ] : [
+      x0,
+      "n/a",
+      3
+    ];
+} else {
+  pm1 = [
+    "v0",
+    "n/a",
+    "v1"
+  ];
+}
+
+var pm2;
+
+if (ir2.TAG === /* V0 */0) {
+  var x1$1 = "v1";
+  var x0$1 = "v0";
+  if (x1$1 !== undefined) {
+    var x2 = 2;
+    pm2 = x2 !== undefined ? [
+        x0$1,
+        x1$1,
+        x2,
+        3
+      ] : [
+        x0$1,
+        x1$1,
+        0,
+        3
+      ];
+  } else {
+    var x2$1 = 2;
+    pm2 = x2$1 !== undefined ? [
+        x0$1,
+        "n/a",
+        x2$1,
+        3
+      ] : [
+        x0$1,
+        "n/a",
+        0,
+        3
+      ];
+  }
+} else {
+  pm2 = [
+    "v0",
+    "n/a",
+    0,
+    "v1"
+  ];
+}
+
+function inlinedRecord(ir) {
+  if (ir.TAG !== /* V0 */0) {
+    return [
+            ir.y0,
+            "n/a",
+            0,
+            ir.y1
+          ];
+  }
+  var x1 = ir.x1;
+  var x0 = ir.x0;
+  if (x1 !== undefined) {
+    switch (x1) {
+      case "x1" :
+          var x2 = ir.x2;
+          if (x2 !== undefined) {
+            return [
+                    x0,
+                    "x1",
+                    x2,
+                    ir.x3
+                  ];
+          }
+          break;
+      case "xx1" :
+          var x2$1 = ir.x2;
+          if (x2$1 !== undefined) {
+            return [
+                    x0,
+                    "xx1",
+                    x2$1,
+                    ir.x3
+                  ];
+          }
+          break;
+      default:
+
+    }
+    var x2$2 = ir.x2;
+    if (x2$2 !== undefined) {
+      return [
+              x0,
+              x1,
+              x2$2,
+              ir.x3
+            ];
+    } else {
+      return [
+              x0,
+              x1,
+              0,
+              ir.x3
+            ];
+    }
+  }
+  var x2$3 = ir.x2;
+  if (x2$3 !== undefined) {
+    return [
+            x0,
+            "n/a",
+            x2$3,
+            ir.x3
+          ];
+  } else {
+    return [
+            x0,
+            "n/a",
+            0,
+            ir.x3
+          ];
+  }
+}
+
+var pm3 = inlinedRecord(ir2);
+
+var pm4 = inlinedRecord(ir3);
+
 var f2 = {
   x: 3,
   y: 3,
@@ -93,4 +270,14 @@ exports.h10 = h10;
 exports.h11 = h11;
 exports.po = po;
 exports.setAA = setAA;
+exports.ir0 = ir0;
+exports.ir1 = ir1;
+exports.ir2 = ir2;
+exports.ir3 = ir3;
+exports.pm0 = pm0;
+exports.pm1 = pm1;
+exports.pm2 = pm2;
+exports.inlinedRecord = inlinedRecord;
+exports.pm3 = pm3;
+exports.pm4 = pm4;
 /*  Not a pure module */