Infer record vs object at type checking time.

Some syntax is ambiguous:
  `type t = {...t1, ...t2}`
could be either a record or an object, and there's no way to tell.
This PR assumes it is a record and at type-checking time detects if it is not, in which case it type checks the definition as an object.

This is an attempt to get around ambiguity in the syntax that does not seem to be solvable given how crowded the syntax real estate of the language already is.

Author: cristianoc

jscomp/frontend/ast_attributes.ml

@@ -332,7 +332,6 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
       | _ -> ());
   !st
 
-
 let locg = Location.none
 (* let bs : attr
    =  {txt = "bs" ; loc = locg}, Ast_payload.empty *)

jscomp/frontend/lam_constant.ml

@@ -22,7 +22,11 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type constructor_tag = {cstr_name: Ast_untagged_variants.literal; const: int; non_const: int}
+type constructor_tag = {
+  cstr_name: Ast_untagged_variants.literal;
+  const: int;
+  non_const: int;
+}
 
 type pointer_info =
   | None

jscomp/frontend/lam_constant.mli

@@ -22,7 +22,11 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type constructor_tag = {cstr_name: Ast_untagged_variants.literal; const: int; non_const: int}
+type constructor_tag = {
+  cstr_name: Ast_untagged_variants.literal;
+  const: int;
+  non_const: int;
+}
 
 type pointer_info =
   | None

jscomp/ml/typedecl.ml

@@ -290,7 +290,7 @@ let make_constructor env type_path type_params sargs sret_type =
 *)
 
 
-let transl_declaration env sdecl id =
+let transl_declaration ~foundObject env sdecl id =
   (* Bind type parameters *)
   reset_type_variables();
   Ctype.begin_def ();
@@ -358,9 +358,9 @@ let transl_declaration env sdecl id =
       unboxed_false_default_false
   in
   let unbox = unboxed_status.unboxed in
-  let (tkind, kind) =
+  let (tkind, kind, sdecl) =
     match sdecl.ptype_kind with
-      | Ptype_abstract -> Ttype_abstract, Type_abstract
+      | Ptype_abstract -> Ttype_abstract, Type_abstract, sdecl
       | Ptype_variant scstrs ->
         assert (scstrs <> []);
         if List.exists (fun cstr -> cstr.pcd_res <> None) scstrs then begin
@@ -423,15 +423,15 @@ let transl_declaration env sdecl id =
         let tcstrs, cstrs = List.split (List.map make_cstr scstrs) in
         let isUntaggedDef = Ast_untagged_variants.has_untagged sdecl.ptype_attributes in
         Ast_untagged_variants.check_well_formed ~isUntaggedDef cstrs;
-        Ttype_variant tcstrs, Type_variant cstrs
-      | Ptype_record lbls ->
+        Ttype_variant tcstrs, Type_variant cstrs, sdecl
+      | Ptype_record lbls_ ->
           let has_optional attrs = Ext_list.exists attrs (fun ({txt },_) -> txt = "res.optional") in
           let optionalLabels =
-              Ext_list.filter_map lbls
+              Ext_list.filter_map lbls_
               (fun lbl -> if has_optional lbl.pld_attributes then Some lbl.pld_name.txt else None) in
           let lbls =
-            if optionalLabels = [] then lbls
-            else Ext_list.map lbls (fun lbl ->
+            if optionalLabels = [] then lbls_
+            else Ext_list.map lbls_ (fun lbl ->
               let typ = lbl.pld_type in
               let typ =
                 if has_optional lbl.pld_attributes then
@@ -446,7 +446,7 @@ let transl_declaration env sdecl id =
               then Record_optional_labels optionalLabels
               else Record_regular
           in
-          let lbls, lbls' = match lbls, lbls' with
+          let lbls_opt = match lbls, lbls' with
             | {ld_name = {txt = "..."}; ld_type} :: _, _ :: _ ->
               let rec extract t = match t.desc with
                 | Tpoly(t, []) -> extract t
@@ -464,21 +464,36 @@ let transl_declaration env sdecl id =
                     (_p0, _p, {type_kind=Type_record (fields, _repr)}) ->
                       process_lbls (fst acc @ (fields |> List.map mkLbl), snd acc @ fields) rest rest'
                     | _ -> assert false
-                    | exception _ -> assert false)
+                    | exception _ -> None)
                 | lbl::rest, lbl'::rest' -> process_lbls (fst acc @ [lbl], snd acc @ [lbl']) rest rest'
-                | _ -> acc
+                | _ -> Some acc
               in
               process_lbls ([], []) lbls lbls'
-            | _ -> lbls, lbls' in
+            | _ -> Some (lbls, lbls') in
           let rec check_duplicates (lbls : Typedtree.label_declaration list) seen = match lbls with
           | [] -> ()
           | lbl::rest ->
             let name = lbl.ld_id.name in
             if StringSet.mem name seen then raise(Error(lbl.ld_loc, Duplicate_label name));
             check_duplicates rest (StringSet.add name seen) in
-          check_duplicates lbls StringSet.empty;
-          Ttype_record lbls, Type_record(lbls', rep)
-      | Ptype_open -> Ttype_open, Type_open
+          (match lbls_opt with
+          | Some (lbls, lbls') ->
+            check_duplicates lbls StringSet.empty;
+            Ttype_record lbls, Type_record(lbls', rep), sdecl
+          | None ->
+             (* Could not fine type decl for ...t: assume t is an object type and this is syntax ambiguity *)
+             foundObject := true;
+             let fields = Ext_list.map lbls_ (fun ld ->
+              match ld.pld_name.txt with
+              | "..." -> Parsetree.Oinherit ld.pld_type
+              | _ -> Otag (ld.pld_name, ld.pld_attributes, ld.pld_type)) in
+             let sdecl =
+              {sdecl with
+               ptype_kind = Ptype_abstract;
+               ptype_manifest = Some (Ast_helper.Typ.object_ ~loc:sdecl.ptype_loc fields Closed);
+              } in
+             (Ttype_abstract, Type_abstract, sdecl))
+      | Ptype_open -> Ttype_open, Type_open, sdecl
       in
     let (tman, man) = match sdecl.ptype_manifest with
         None -> None, None
@@ -587,7 +602,7 @@ let check_constraints_labels env visited l pl =
        check_constraints_rec env (get_loc (Ident.name name) pl) visited ty)
     l
 
-let check_constraints env sdecl (_, decl) =
+let check_constraints ~foundObject env sdecl (_, decl) =
   let visited = ref TypeSet.empty in
   begin match decl.type_kind with
   | Type_abstract -> ()
@@ -636,10 +651,12 @@ let check_constraints env sdecl (_, decl) =
   begin match decl.type_manifest with
   | None -> ()
   | Some ty ->
+    if not !foundObject then 
       let sty =
         match sdecl.ptype_manifest with Some sty -> sty | _ -> assert false
       in
       check_constraints_rec env sty.ptyp_loc visited ty
+  
   end
 
 (*
@@ -1294,14 +1311,15 @@ let transl_type_decl env rec_flag sdecl_list =
     | Asttypes.Recursive | Asttypes.Nonrecursive ->
         id, None
   in
+  let foundObject = ref false in
   let transl_declaration name_sdecl (id, slot) =
     current_slot := slot;
     Builtin_attributes.warning_scope
       name_sdecl.ptype_attributes
       (fun () -> transl_declaration temp_env name_sdecl id)
   in
   let tdecls =
-    List.map2 transl_declaration sdecl_list (List.map id_slots id_list) in
+    List.map2 (transl_declaration ~foundObject) sdecl_list (List.map id_slots id_list) in
   let decls =
     List.map (fun tdecl -> (tdecl.typ_id, tdecl.typ_type)) tdecls in
   current_slot := None;
@@ -1349,7 +1367,7 @@ let transl_type_decl env rec_flag sdecl_list =
        | None   -> ())
     sdecl_list tdecls;
   (* Check that constraints are enforced *)
-  List.iter2 (check_constraints newenv) sdecl_list decls;
+  List.iter2 (check_constraints ~foundObject newenv) sdecl_list decls;
   (* Name recursion *)
   let decls =
     List.map2 (fun sdecl (id, decl) -> id, name_recursion sdecl id decl)

jscomp/test/RecordOrObject.js

@@ -0,0 +1,15 @@
+'use strict';
+
+
+var vxy = {
+  x: 10,
+  y: "abc"
+};
+
+var xxi = {
+  x: 10
+};
+
+exports.vxy = vxy;
+exports.xxi = xxi;
+/* No side effect */

jscomp/test/RecordOrObject.res

@@ -0,0 +1,12 @@
+type rx = {x: int}
+type ry = {y: string}
+type rxi = {...rx, i?:int}
+type rxy = {...rx, ...ry} // this is a record
+
+let vxy: rxy = {x: 10, y: "abc"}
+let xxi : rxi = {x:10}
+
+type ox = {"x": int}
+type oy = {"y": int}
+type oxz = {...ox, "z": int}
+type oxy = {...ox, ...oy} // this starts as a record but type checking infers that it is an object

jscomp/test/build.ninja

@@ -4453,14 +4453,28 @@ and parseFieldDeclaration p =
   let loc = mkLoc startPos typ.ptyp_loc.loc_end in
   (optional, Ast_helper.Type.field ~attrs ~loc ~mut name typ)
 
-and parseFieldDeclarationRegion p =
+and parseFieldDeclarationRegion ?foundObjectField p =
   let startPos = p.Parser.startPos in
   let attrs = parseAttributes p in
   let mut =
     if Parser.optional p Token.Mutable then Asttypes.Mutable
     else Asttypes.Immutable
   in
   match p.token with
+  | DotDotDot ->
+    Parser.next p;
+    let name = Location.mkloc "..." (mkLoc startPos p.prevEndPos) in
+    let typ = parsePolyTypeExpr p in
+    let loc = mkLoc startPos typ.ptyp_loc.loc_end in
+    Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ)
+  | String s when foundObjectField <> None ->
+    Option.get foundObjectField := true;
+    Parser.next p;
+    let name = Location.mkloc s (mkLoc startPos p.prevEndPos) in
+    Parser.expect Colon p;
+    let typ = parsePolyTypeExpr p in
+    let loc = mkLoc startPos typ.ptyp_loc.loc_end in
+    Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ)
   | Lident _ ->
     let lident, loc = parseLident p in
     let name = Location.mkloc lident loc in
@@ -4969,7 +4983,7 @@ and parseRecordOrObjectDecl p =
     in
     let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in
     (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)
-  | DotDotDot ->
+  | DotDotDot -> (
     let dotdotdotStart = p.startPos in
     let dotdotdotEnd = p.endPos in
     (* start of object type spreading, e.g. `type u = {...a, "u": int}` *)
@@ -4984,25 +4998,36 @@ and parseRecordOrObjectDecl p =
         Parser.next p
       | _ -> Parser.expect Comma p
     in
-    let () =
-      match p.token with
-      | Lident _ ->
-        Parser.err ~startPos:dotdotdotStart ~endPos:dotdotdotEnd p
-          (Diagnostics.message ErrorMessages.spreadInRecordDeclaration)
-      | _ -> ()
-    in
-    let fields =
-      Parsetree.Oinherit typ
-      :: parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations
-           ~closing:Rbrace ~f:parseStringFieldDeclaration p
-    in
-    Parser.expect Rbrace p;
-    let loc = mkLoc startPos p.prevEndPos in
-    let typ =
-      Ast_helper.Typ.object_ ~loc fields Asttypes.Closed |> parseTypeAlias p
-    in
-    let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in
-    (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)
+    match p.token with
+    | _ ->
+      let loc = mkLoc startPos p.prevEndPos in
+      let dotField =
+        Ast_helper.Type.field ~loc
+          {txt = "..."; loc = mkLoc dotdotdotStart dotdotdotEnd}
+          typ
+      in
+      let foundObjectField = ref false in
+      let fields =
+        parseCommaDelimitedRegion ~grammar:Grammar.RecordDecl ~closing:Rbrace
+          ~f:(parseFieldDeclarationRegion ~foundObjectField)
+          p
+      in
+      Parser.expect Rbrace p;
+      if !foundObjectField then
+        let fields =
+          Ext_list.map fields (fun ld ->
+              match ld.pld_name.txt with
+              | "..." -> Parsetree.Oinherit ld.pld_type
+              | _ -> Otag (ld.pld_name, ld.pld_attributes, ld.pld_type))
+        in
+        let dotField = Parsetree.Oinherit typ in
+        let typ_obj = Ast_helper.Typ.object_ (dotField :: fields) Closed in
+        let typ_obj = parseTypeAlias p typ_obj in
+        let typ_obj = parseArrowTypeRest ~es6Arrow:true ~startPos typ_obj p in
+        (Some typ_obj, Public, Ptype_abstract)
+      else
+        let kind = Parsetree.Ptype_record (dotField :: fields) in
+        (None, Public, kind))
   | _ -> (
     let attrs = parseAttributes p in
     match p.Parser.token with

res_syntax/src/res_core.ml

@@ -192,7 +192,7 @@ let isFieldDeclStart = function
   | _ -> false
 
 let isRecordDeclStart = function
-  | Token.At | Mutable | Lident _ -> true
+  | Token.At | Mutable | Lident _ | DotDotDot | String _ -> true
   | _ -> false
 
 let isTypExprStart = function

res_syntax/src/res_grammar.ml

@@ -1531,9 +1531,12 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
     | Mutable -> Doc.text "mutable "
     | Immutable -> Doc.nil
   in
-  let name =
-    let doc = printIdentLike ld.pld_name.txt in
-    printComments doc cmtTbl ld.pld_name.loc
+  let name, isDot =
+    let doc, isDot =
+      if ld.pld_name.txt = "..." then (Doc.text ld.pld_name.txt, true)
+      else (printIdentLike ld.pld_name.txt, false)
+    in
+    (printComments doc cmtTbl ld.pld_name.loc, isDot)
   in
   let optional = printOptionalLabel ld.pld_attributes in
   Doc.group
@@ -1543,7 +1546,7 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
          mutableFlag;
          name;
          optional;
-         Doc.text ": ";
+         (if isDot then Doc.nil else Doc.text ": ");
          printTypExpr ~state ld.pld_type cmtTbl;
        ])
 

res_syntax/src/res_printer.ml

@@ -101,7 +101,8 @@ let [|arr;_|] = [|1;2;3|]
 let record = { x with y }
 let { x; y } = myRecord
 let x::y = myList
-type nonrec t = < a  > 
+type nonrec t = {
+  ...: a }
 type nonrec t =
   | Foo of < a  >  
 type nonrec t = (foo, < x  > ) option