Update object method parsing and printer for ReScript 9

src/res_ast_conversion.ml

@@ -421,7 +421,7 @@ let normalize =
                   pexp_attributes = [];
                   pexp_desc = Pexp_ident (Location.mknoloc (Longident.Lident "x"))
                 },
-                (default_mapper.cases mapper cases)
+                (mapper.cases mapper cases)
               )
 
             }
@@ -435,21 +435,19 @@ let normalize =
         {
           pexp_loc = expr.pexp_loc;
           pexp_attributes = expr.pexp_attributes;
-          pexp_desc = Pexp_field (operand, (Location.mknoloc (Longident.Lident "contents")))
+          pexp_desc = Pexp_field (mapper.expr mapper operand, (Location.mknoloc (Longident.Lident "contents")))
         }
       | Pexp_apply (
-          {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}} as op,
-          [Asttypes.Nolabel, lhs; Nolabel, ({pexp_desc = Pexp_constant (Pconst_string (txt, None))} as stringExpr)]
+          {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}},
+          [
+            Asttypes.Nolabel, lhs; Nolabel,
+            ({pexp_desc = Pexp_constant (Pconst_string (txt, None)) | (Pexp_ident ({txt = Longident.Lident txt})); pexp_loc = labelLoc})]
         ) ->
-        let ident = {
-          Parsetree.pexp_loc = stringExpr.pexp_loc;
-          pexp_attributes = [];
-          pexp_desc = Pexp_ident (Location.mkloc (Longident.Lident txt) stringExpr.pexp_loc)
-        } in
+        let label = Location.mkloc txt labelLoc in
         {
           pexp_loc = expr.pexp_loc;
           pexp_attributes = expr.pexp_attributes;
-          pexp_desc = Pexp_apply (op, [Asttypes.Nolabel, lhs; Nolabel, ident])
+          pexp_desc = Pexp_send (mapper.expr mapper lhs, label)
         }
       | Pexp_match (
           condition,
@@ -461,9 +459,9 @@ let normalize =
         let ternaryMarker = (Location.mknoloc "ns.ternary", Parsetree.PStr []) in
         {Parsetree.pexp_loc = expr.pexp_loc;
           pexp_desc = Pexp_ifthenelse (
-            default_mapper.expr mapper condition,
-            default_mapper.expr mapper thenExpr,
-            (Some (default_mapper.expr mapper elseExpr))
+            mapper.expr mapper condition,
+            mapper.expr mapper thenExpr,
+            (Some (mapper.expr mapper elseExpr))
           );
           pexp_attributes = ternaryMarker::expr.pexp_attributes;
         }

src/res_core.ml

@@ -112,6 +112,18 @@ Solution: directly use `concat`."
 
   let stringInterpolationInPattern =
     "String interpolation is not supported in pattern matching."
+
+  let spreadInRecordDeclaration =
+    "A record type declaration doesn't support the ... spread. Only an object (with quoted field names) does."
+
+  let objectQuotedFieldName name =
+    "An object type declaration needs quoted field names. Did you mean \"" ^ name ^ "\"?"
+
+  let forbiddenInlineRecordDeclaration =
+    "An inline record type declaration is only allowed in a variant constructor's declaration"
+
+  let sameTypeSpread =
+    "You're using a ... spread without extra fields. This is the same type."
 end
 
 
@@ -1943,9 +1955,7 @@ and parseBracketAccess p expr startPos =
     let e =
       let identLoc = mkLoc stringStart stringEnd in
       let loc = mkLoc lbracket rbracket in
-      Ast_helper.Exp.apply ~loc
-      (Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "##") loc))
-      [Nolabel, expr; Nolabel, (Ast_helper.Exp.ident ~loc:identLoc (Location.mkloc (Longident.Lident s) identLoc))]
+      Ast_helper.Exp.send ~loc expr (Location.mkloc s identLoc)
     in
     let e = parsePrimaryExpr ~operand:e p in
     let equalStart = p.startPos in
@@ -3766,7 +3776,7 @@ and parseAtomicTypExpr ~attrs p =
     let loc = mkLoc startPos p.prevEndPos in
     Ast_helper.Typ.extension ~attrs ~loc extension
   | Lbrace ->
-    parseRecordOrBsObjectType ~attrs p
+    parseRecordOrObjectType ~attrs p
   | token ->
     Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
     begin match skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicTypExprStart with
@@ -3825,7 +3835,7 @@ and parsePackageConstraint p =
     Some (typeConstr, typ)
   | _ -> None
 
-and parseRecordOrBsObjectType ~attrs p =
+and parseRecordOrObjectType ~attrs p =
   (* for inline record in constructor *)
   let startPos = p.Parser.startPos in
   Parser.expect Lbrace p;
@@ -3834,13 +3844,26 @@ and parseRecordOrBsObjectType ~attrs p =
   | Dot -> Parser.next p; Asttypes.Closed
   | _ -> Asttypes.Closed
   in
+  let () = match p.token with
+  | Lident _ ->
+    Parser.err p (Diagnostics.message ErrorMessages.forbiddenInlineRecordDeclaration)
+  | _ -> ()
+  in
+  let startFirstField = p.startPos in
   let fields =
     parseCommaDelimitedRegion
       ~grammar:Grammar.StringFieldDeclarations
       ~closing:Rbrace
       ~f:parseStringFieldDeclaration
       p
   in
+  let () = match fields with
+  | [Parsetree.Oinherit {ptyp_loc}] ->
+    (* {...x}, spread without extra fields *)
+    Parser.err p ~startPos:startFirstField ~endPos:ptyp_loc.loc_end
+      (Diagnostics.message ErrorMessages.sameTypeSpread)
+  | _ -> ()
+  in
   Parser.expect Rbrace p;
   let loc = mkLoc startPos p.prevEndPos in
   Ast_helper.Typ.object_ ~loc ~attrs fields closedFlag
@@ -4130,9 +4153,13 @@ and parseStringFieldDeclaration p =
     Parser.expect ~grammar:Grammar.TypeExpression Colon p;
     let typ = parsePolyTypeExpr p in
     Some(Parsetree.Otag (fieldName, attrs, typ))
+  | DotDotDot ->
+    Parser.next p;
+    let typ = parseTypExpr p in
+    Some(Parsetree.Oinherit typ)
   | Lident name ->
     let nameLoc = mkLoc p.startPos p.endPos in
-    Parser.err p (Diagnostics.message "An inline record type declaration is only allowed in a variant constructor's declaration");
+    Parser.err p (Diagnostics.message (ErrorMessages.objectQuotedFieldName name));
     Parser.next p;
     let fieldName = Location.mkloc name nameLoc in
     Parser.expect ~grammar:Grammar.TypeExpression Colon p;
@@ -4256,6 +4283,50 @@ and parseConstrDeclArgs p =
         in
         Parser.expect Rparen p;
         Parsetree.Pcstr_tuple (typ::moreArgs)
+      | DotDotDot ->
+        let dotdotdotStart = p.startPos in
+        let dotdotdotEnd = p.endPos in
+        (* start of object type spreading, e.g. `User({...a, "u": int})` *)
+        Parser.next p;
+        let typ = parseTypExpr p in
+        let () = match p.token with
+        | Rbrace ->
+          (* {...x}, spread without extra fields *)
+          Parser.err ~startPos:dotdotdotStart ~endPos:dotdotdotEnd p
+            (Diagnostics.message ErrorMessages.sameTypeSpread);
+          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
+        Parser.optional p Comma |> ignore;
+        let moreArgs =
+          parseCommaDelimitedRegion
+            ~grammar:Grammar.TypExprList
+            ~closing:Rparen
+            ~f:parseTypExprRegion p
+        in
+        Parser.expect Rparen p;
+        Parsetree.Pcstr_tuple (typ::moreArgs)
       | _ ->
         let attrs = parseAttributes p in
         begin match p.Parser.token with
@@ -4608,7 +4679,7 @@ and parseTypeEquationOrConstrDecl p =
     (* TODO: is this a good idea? *)
     (None, Asttypes.Public, Parsetree.Ptype_abstract)
 
-and parseRecordOrBsObjectDecl p =
+and parseRecordOrObjectDecl p =
   let startPos = p.Parser.startPos in
   Parser.expect Lbrace p;
   match p.Parser.token with
@@ -4633,6 +4704,42 @@ and parseRecordOrBsObjectDecl p =
     in
     let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in
     (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)
+   | DotDotDot ->
+    let dotdotdotStart = p.startPos in
+    let dotdotdotEnd = p.endPos in
+    (* start of object type spreading, e.g. `type u = {...a, "u": int}` *)
+    Parser.next p;
+    let typ = parseTypExpr p in
+    let () = match p.token with
+    | Rbrace ->
+      (* {...x}, spread without extra fields *)
+      Parser.err ~startPos:dotdotdotStart ~endPos:dotdotdotEnd p
+        (Diagnostics.message ErrorMessages.sameTypeSpread);
+      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)
   | _ ->
     let attrs = parseAttributes p in
     begin match p.Parser.token with
@@ -4723,7 +4830,7 @@ and parsePrivateEqOrRepr p =
   Parser.expect Private p;
   match p.Parser.token with
   | Lbrace ->
-    let (manifest, _ ,kind) = parseRecordOrBsObjectDecl p in
+    let (manifest, _ ,kind) = parseRecordOrObjectDecl p in
     (manifest, Asttypes.Private, kind)
   | Uident _ ->
     let (manifest, _, kind) = parseTypeEquationOrConstrDecl p in
@@ -4925,7 +5032,7 @@ and parseTypeEquationAndRepresentation p =
     | Uident _ ->
       parseTypeEquationOrConstrDecl p
     | Lbrace ->
-      parseRecordOrBsObjectDecl p
+      parseRecordOrObjectDecl p
     | Private ->
       parsePrivateEqOrRepr p
     | Bar | DotDot ->

src/res_grammar.ml

@@ -211,7 +211,7 @@ let isParameterStart = function
 
 (* TODO: overparse Uident ? *)
 let isStringFieldDeclStart = function
-  | Token.String _ | Lident _ | At -> true
+  | Token.String _ | Lident _ | At | DotDotDot -> true
   | _ -> false
 
 (* TODO: overparse Uident ? *)

src/res_printer.ml

@@ -1712,7 +1712,14 @@ and printObject ~inline fields openFlag cmtTbl =
       Doc.lbrace;
       (match openFlag with
       | Asttypes.Closed -> Doc.nil
-      | Open -> Doc.dotdot);
+      | Open ->
+        begin match fields with
+        (* handle `type t = {.. ...objType, "x": int}`
+         * .. and ... should have a space in between *)
+        | (Oinherit _)::_ -> Doc.text ".. "
+        | _ -> Doc.dotdot
+        end
+      );
       Doc.indent (
         Doc.concat [
           Doc.softLine;
@@ -1761,7 +1768,11 @@ and printObjectField (field : Parsetree.object_field) cmtTbl =
     ] in
     let cmtLoc = {labelLoc.loc with loc_end = typ.ptyp_loc.loc_end} in
     printComments doc cmtTbl cmtLoc
-  | _ -> Doc.nil
+  | Oinherit typexpr ->
+    Doc.concat [
+      Doc.dotdotdot;
+      printTypExpr typexpr cmtTbl
+    ]
 
 (* es6 arrow type arg
  * type t = (~foo: string, ~bar: float=?, unit) => unit
@@ -3126,8 +3137,26 @@ and printExpression (e : Parsetree.expression) cmtTbl =
       Doc.concat [Doc.text ": "; printTypExpr typ1 cmtTbl]
     in
     Doc.concat [Doc.lparen; docExpr; ofType; Doc.text " :> "; docTyp; Doc.rparen]
-  | Pexp_send _ ->
-    Doc.text "Pexp_send not impemented in printer"
+  | Pexp_send (parentExpr, label) ->
+    let parentDoc =
+      let doc = printExpressionWithComments parentExpr cmtTbl in
+      match Parens.unaryExprOperand parentExpr with
+      | Parens.Parenthesized -> addParens doc
+      | Braced braces  -> printBraces doc parentExpr braces
+      | Nothing -> doc
+    in
+    let member =
+      let memberDoc = printComments (Doc.text label.txt) cmtTbl label.loc in
+      Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""]
+    in
+    Doc.group (
+      Doc.concat [
+        parentDoc;
+        Doc.lbracket;
+        member;
+        Doc.rbracket;
+      ]
+    )
   | Pexp_new _ ->
     Doc.text "Pexp_new not impemented in printer"
   | Pexp_setinstvar _ ->

tests/conversion/reason/__snapshots__/render.spec.js.snap

@@ -1285,6 +1285,17 @@ type propField<'a> = Js.nullable<{..} as 'a>
 type propField<'a> = {\\"a\\": b}
 type propField<'a> = {..\\"a\\": b}
 type propField<'a> = {\\"a\\": {\\"b\\": c}}
+
+user[\\"address\\"]
+user[\\"address\\"][\\"street\\"]
+user[\\"address\\"][\\"street\\"][\\"log\\"]
+
+user[\\"address\\"] = \\"Avenue 1\\"
+user[\\"address\\"][\\"street\\"] = \\"Avenue\\"
+user[\\"address\\"][\\"street\\"][\\"number\\"] = \\"1\\"
+
+school[\\"print\\"](direction[\\"name\\"], studentHead[\\"name\\"])
+city[\\"getSchool\\"]()[\\"print\\"](direction[\\"name\\"], studentHead[\\"name\\"])
 "
 `;
 
@@ -1430,6 +1441,14 @@ let make = (
 "
 `;
 
+exports[`object.ml 1`] = `
+"type hi = {\\"z\\": int}
+type u<'a> = {.. ...hi, \\"x\\": int, \\"y\\": int} as 'a
+type u1<'a> = {.. ...hi} as 'a
+type u2<'a> = {.. ...hi, ...hi, \\"y\\": int, ...hi} as 'a
+"
+`;
+
 exports[`openPattern.re 1`] = `
 "let {T.a: a} = a()
 let [Color.Blue] = a()

tests/conversion/reason/expected/object.ml.txt

@@ -0,0 +1,4 @@
+type hi = {"z": int}
+type u<'a> = {.. ...hi, "x": int, "y": int} as 'a
+type u1<'a> = {.. ...hi} as 'a
+type u2<'a> = {.. ...hi, ...hi, "y": int, ...hi} as 'a

tests/conversion/reason/jsObject.re

@@ -13,3 +13,15 @@ type propField('a) = Js.nullable(Js.t({..} as 'a))
 type propField('a) = {. "a": b}
 type propField('a) = {.. "a": b}
 type propField('a) = Js.t(Js.t({. "a": Js.t({. "b": c})}))
+
+user##address;
+user##address##street;
+user##address##street##log;
+
+user##address #= "Avenue 1";
+user##address##street #= "Avenue" ;
+user##address##street##number #= "1";
+
+school##print(direction##name, studentHead##name);
+(city##getSchool())##print(direction##name, studentHead##name);
+

tests/conversion/reason/object.ml

@@ -0,0 +1,4 @@
+type hi = < z : int >
+type 'a u = < hi ; x : int ; y : int; .. >  as 'a
+type 'a u1 = < hi; .. > as 'a
+type 'a u2 = < hi ; hi; y : int ; hi; .. >  as 'a