Allow type variables when spreading record type definitions

jscomp/ml/typedecl.ml

@@ -433,21 +433,54 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
                    | _ -> false) in
           let lbls_opt = match has_spread with
             | true ->
+              let substitute_type_vars type_vars typ =
+                match typ with
+                | {desc = Tvar (Some tvar_name)}
+                | {desc = Tlink {desc = Tvar (Some tvar_name)}} ->
+                  type_vars
+                  |> List.find_opt (fun t ->
+                         match t.desc with
+                         | (Tvar (Some n) | Tlink {desc = Tvar (Some n)}) when n = tvar_name
+                           ->
+                           true
+                         | _ -> false)
+                | _ -> None in
               let rec extract t = match t.desc with
                 | Tpoly(t, []) -> extract t
                 | _ -> Ctype.repr t in
-              let mkLbl (l: Types.label_declaration) (ld_type: Typedtree.core_type) : Typedtree.label_declaration =
-                { ld_id = l.ld_id;
+              let mkLbl (l: Types.label_declaration) (ld_type: Typedtree.core_type) (type_vars: Types.type_expr list) : Typedtree.label_declaration =
+                let lbl = {
+                  ld_id = l.ld_id;
                   ld_name = {txt = Ident.name l.ld_id; loc = l.ld_loc};
                   ld_mutable = l.ld_mutable;
-                  ld_type = {ld_type with ctyp_type = l.ld_type};
+                  ld_type =
+                    (match substitute_type_vars type_vars l.ld_type with
+                    | None -> {ld_type with ctyp_type = l.ld_type}
+                    | Some tvar -> {ld_type with ctyp_type = tvar});
                   ld_loc = l.ld_loc;
-                  ld_attributes = l.ld_attributes; } in
+                  ld_attributes = l.ld_attributes;
+                } in
+                lbl in
               let rec process_lbls acc lbls lbls' = match lbls, lbls' with
                 | {ld_name = {txt = "..."}; ld_type} :: rest, _ :: rest' ->
+                  let type_vars =
+                    match ld_type.ctyp_type with
+                    | {desc = Tpoly ({desc = Tconstr (_, tvars, _)}, _)} -> tvars
+                    | _ -> [] in
                   (match Ctype.extract_concrete_typedecl env (extract ld_type.ctyp_type) with
                     (_p0, _p, {type_kind=Type_record (fields, _repr)}) ->
-                      process_lbls (fst acc @ (fields |> List.map (fun l -> mkLbl l ld_type)), snd acc @ fields) rest rest'
+                      process_lbls
+                        ( fst acc @ (fields |> List.map (fun l -> mkLbl l ld_type type_vars)),
+                          snd acc
+                          @ (fields
+                            |> List.map (fun (l : Types.label_declaration) ->
+                                  {
+                                    l with
+                                    ld_type =
+                                      substitute_type_vars type_vars l.ld_type
+                                      |> Option.value ~default:l.ld_type;
+                                  })) )
+                        rest rest'
                     | _ -> assert false
                     | exception _ -> None)
                 | lbl::rest, lbl'::rest' -> process_lbls (fst acc @ [lbl], snd acc @ [lbl']) rest rest'
@@ -1356,7 +1389,7 @@ let transl_type_decl env rec_flag sdecl_list =
     (fun sdecl tdecl ->
       let decl = tdecl.typ_type in
        match Ctype.closed_type_decl decl with
-         Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
+       | Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
        | None   -> ())
     sdecl_list tdecls;
   (* Check that constraints are enforced *)

jscomp/test/record_type_spread.res

@@ -9,3 +9,17 @@ let getY = (v: y) => v.y
 let getX = (v: y) => v.x
 
 let v: y = {y: 3, x: 3}
+
+type f<'a> = {
+  a: string,
+  b: 'a,
+}
+
+type d<'a> = {
+  ...f<'a>,
+}
+
+let d: d<int> = {
+  a: "",
+  b: 1,
+}