sync latest parser

Author: zth

analysis/vendor/res_syntax/res_core.ml

@@ -2110,7 +2110,7 @@ and parseOperandExpr ~context p =
     match p.Parser.token with
     | Assert ->
       Parser.next p;
-      let expr = parseUnaryExpr p in
+      let expr = parseExpr p in
       let loc = mkLoc startPos p.prevEndPos in
       Ast_helper.Exp.assert_ ~loc expr
     | Lident "async"
@@ -3598,6 +3598,17 @@ and parseCallExpr p funExpr =
     parseCommaDelimitedRegion ~grammar:Grammar.ArgumentList ~closing:Rparen
       ~f:parseArgument p
   in
+  let resPartialAttr =
+    let loc = mkLoc startPos p.prevEndPos in
+    (Location.mkloc "res.partial" loc, Parsetree.PStr [])
+  in
+  let isPartial =
+    match p.token with
+    | DotDotDot when args <> [] ->
+      Parser.next p;
+      true
+    | _ -> false
+  in
   Parser.expect Rparen p;
   let args =
     match args with
@@ -3626,7 +3637,8 @@ and parseCallExpr p funExpr =
          } as expr;
      };
     ]
-      when (not loc.loc_ghost) && p.mode = ParseForTypeChecker ->
+      when (not loc.loc_ghost) && p.mode = ParseForTypeChecker && not isPartial
+      ->
       (*  Since there is no syntax space for arity zero vs arity one,
        *  we expand
        *    `fn(. ())` into
@@ -3670,22 +3682,20 @@ and parseCallExpr p funExpr =
     | [] -> []
   in
   let apply =
-    List.fold_left
-      (fun callBody group ->
+    Ext_list.fold_left args funExpr (fun callBody group ->
         let dotted, args = group in
         let args, wrap = processUnderscoreApplication p args in
         let exp =
           let uncurried =
             p.uncurried_config |> Res_uncurried.fromDotted ~dotted
           in
-          if uncurried then
-            let attrs = [uncurriedAppAttr] in
-            Ast_helper.Exp.apply ~loc ~attrs callBody args
-          else Ast_helper.Exp.apply ~loc callBody args
+          let attrs = if uncurried then [uncurriedAppAttr] else [] in
+          let attrs = if isPartial then resPartialAttr :: attrs else attrs in
+          Ast_helper.Exp.apply ~loc ~attrs callBody args
         in
         wrap exp)
-      funExpr args
   in
+
   Parser.eatBreadcrumb p;
   apply
 
@@ -4488,7 +4498,18 @@ and parseFieldDeclarationRegion ?foundObjectField p =
     let loc = mkLoc startPos typ.ptyp_loc.loc_end in
     let attrs = if optional then optionalAttr :: attrs else attrs in
     Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ)
-  | _ -> None
+  | _ ->
+    if attrs <> [] then
+      Parser.err ~startPos p
+        (Diagnostics.message
+           "Attributes and doc comments can only be used at the beginning of a \
+            field declaration");
+    if mut = Mutable then
+      Parser.err ~startPos p
+        (Diagnostics.message
+           "The `mutable` qualifier can only be used at the beginning of a \
+            field declaration");
+    None
 
 (* record-decl ::=
  *  | { field-decl }
@@ -5773,7 +5794,22 @@ and parseFunctorModuleExpr p =
  *  | extension
  *  | attributes module-expr *)
 and parseModuleExpr p =
+  let hasAwait, loc_await =
+    let startPos = p.startPos in
+    match p.Parser.token with
+    | Await ->
+      Parser.expect Await p;
+      let endPos = p.endPos in
+      (true, mkLoc startPos endPos)
+    | _ -> (false, mkLoc startPos startPos)
+  in
   let attrs = parseAttributes p in
+  let attrs =
+    if hasAwait then
+      (({txt = "res.await"; loc = loc_await}, PStr []) : Parsetree.attribute)
+      :: attrs
+    else attrs
+  in
   let modExpr =
     if isEs6ArrowFunctor p then parseFunctorModuleExpr p
     else parsePrimaryModExpr p
@@ -6490,4 +6526,4 @@ let parseSpecification p : Parsetree.signature =
 
 (* module structure on the file level *)
 let parseImplementation p : Parsetree.structure =
-  parseRegion p ~grammar:Grammar.Implementation ~f:parseStructureItemRegion
+  parseRegion p ~grammar:Grammar.Implementation ~f:parseStructureItemRegion

analysis/vendor/res_syntax/res_grammar.ml

@@ -215,7 +215,8 @@ let isFunctorArgStart = function
   | _ -> false
 
 let isModExprStart = function
-  | Token.At | Percent | Uident _ | Lbrace | Lparen | Lident "unpack" -> true
+  | Token.At | Percent | Uident _ | Lbrace | Lparen | Lident "unpack" | Await ->
+    true
   | _ -> false
 
 let isRecordRowStart = function
@@ -299,7 +300,7 @@ let isListTerminator grammar token =
   | _, Token.Eof
   | ExprList, (Rparen | Forwardslash | Rbracket)
   | ListExpr, Rparen
-  | ArgumentList, Rparen
+  | ArgumentList, (Rparen | DotDotDot)
   | TypExprList, (Rparen | Forwardslash | GreaterThan | Equal)
   | ModExprList, Rparen
   | ( (PatternList | PatternOcamlList | PatternRecord),

analysis/vendor/res_syntax/res_parsetree_viewer.ml

@@ -72,6 +72,15 @@ let processUncurriedAppAttribute attrs =
   in
   process false [] attrs
 
+let processPartialAppAttribute attrs =
+  let rec process partialApp acc attrs =
+    match attrs with
+    | [] -> (partialApp, List.rev acc)
+    | ({Location.txt = "res.partial"}, _) :: rest -> process true acc rest
+    | attr :: rest -> process partialApp (attr :: acc) rest
+  in
+  process false [] attrs
+
 type functionAttributesInfo = {
   async: bool;
   bs: bool;

analysis/vendor/res_syntax/res_parsetree_viewer.mli

@@ -20,6 +20,9 @@ val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes
 val processUncurriedAppAttribute :
   Parsetree.attributes -> bool * Parsetree.attributes
 
+val processPartialAppAttribute :
+  Parsetree.attributes -> bool * Parsetree.attributes
+
 type functionAttributesInfo = {
   async: bool;
   bs: bool;

analysis/vendor/res_syntax/res_printer.ml

@@ -710,6 +710,11 @@ and printModuleBinding ~state ~isRec moduleBinding cmtTbl i =
         Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl] )
     | modExpr -> (printModExpr ~state modExpr cmtTbl, Doc.nil)
   in
+  let modExprDoc =
+    if ParsetreeViewer.hasAwaitAttribute moduleBinding.pmb_expr.pmod_attributes
+    then Doc.concat [Doc.text "await "; modExprDoc]
+    else modExprDoc
+  in
   let modName =
     let doc = Doc.text moduleBinding.pmb_name.Location.txt in
     printComments doc cmtTbl moduleBinding.pmb_name.loc
@@ -3187,14 +3192,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
     | Pexp_letexception (_extensionConstructor, _expr) ->
       printExpressionBlock ~state ~braces:true e cmtTbl
     | Pexp_assert expr ->
-      let rhs =
-        let doc = printExpressionWithComments ~state expr cmtTbl in
-        match Parens.lazyOrAssertOrAwaitExprRhs expr with
-        | Parens.Parenthesized -> addParens doc
-        | Braced braces -> printBraces doc expr braces
-        | Nothing -> doc
-      in
-      Doc.concat [Doc.text "assert "; rhs]
+      let expr = printExpressionWithComments ~state expr cmtTbl in
+      Doc.concat [Doc.text "assert("; expr; Doc.text ")"]
     | Pexp_lazy expr ->
       let rhs =
         let doc = printExpressionWithComments ~state expr cmtTbl in
@@ -3970,6 +3969,13 @@ and printPexpApply ~state expr cmtTbl =
     let uncurried, attrs =
       ParsetreeViewer.processUncurriedAppAttribute expr.pexp_attributes
     in
+    let partial, attrs = ParsetreeViewer.processPartialAppAttribute attrs in
+    let args =
+      if partial then
+        let dummy = Ast_helper.Exp.constant (Ast_helper.Const.int 0) in
+        args @ [(Asttypes.Labelled "...", dummy)]
+      else args
+    in
     let dotted = state.uncurried_config |> Res_uncurried.getDotted ~uncurried in
     let callExprDoc =
       let doc = printExpressionWithComments ~state callExpr cmtTbl in
@@ -4580,7 +4586,7 @@ and printArguments ~state ~dotted
 and printArgument ~state (argLbl, arg) cmtTbl =
   match (argLbl, arg) with
   (* ~a (punned)*)
-  | ( Asttypes.Labelled lbl,
+  | ( Labelled lbl,
       ({
          pexp_desc = Pexp_ident {txt = Longident.Lident name};
          pexp_attributes = [] | [({Location.txt = "res.namedArgLoc"}, _)];
@@ -4594,7 +4600,7 @@ and printArgument ~state (argLbl, arg) cmtTbl =
     let doc = Doc.concat [Doc.tilde; printIdentLike lbl] in
     printComments doc cmtTbl loc
   (* ~a: int (punned)*)
-  | ( Asttypes.Labelled lbl,
+  | ( Labelled lbl,
       {
         pexp_desc =
           Pexp_constraint
@@ -4622,7 +4628,7 @@ and printArgument ~state (argLbl, arg) cmtTbl =
     in
     printComments doc cmtTbl loc
   (* ~a? (optional lbl punned)*)
-  | ( Asttypes.Optional lbl,
+  | ( Optional lbl,
       {
         pexp_desc = Pexp_ident {txt = Longident.Lident name};
         pexp_attributes = [] | [({Location.txt = "res.namedArgLoc"}, _)];
@@ -4642,27 +4648,32 @@ and printArgument ~state (argLbl, arg) cmtTbl =
         (loc, {expr with pexp_attributes = attrs})
       | _ -> (expr.pexp_loc, expr)
     in
-    let printedLbl =
+    let printedLbl, dotdotdot =
       match argLbl with
-      | Asttypes.Nolabel -> Doc.nil
-      | Asttypes.Labelled lbl ->
+      | Nolabel -> (Doc.nil, false)
+      | Labelled "..." ->
+        let doc = Doc.text "..." in
+        (printComments doc cmtTbl argLoc, true)
+      | Labelled lbl ->
         let doc = Doc.concat [Doc.tilde; printIdentLike lbl; Doc.equal] in
-        printComments doc cmtTbl argLoc
-      | Asttypes.Optional lbl ->
+        (printComments doc cmtTbl argLoc, false)
+      | Optional lbl ->
         let doc =
           Doc.concat [Doc.tilde; printIdentLike lbl; Doc.equal; Doc.question]
         in
-        printComments doc cmtTbl argLoc
+        (printComments doc cmtTbl argLoc, false)
     in
     let printedExpr =
       let doc = printExpressionWithComments ~state expr cmtTbl in
       match Parens.expr expr with
-      | Parens.Parenthesized -> addParens doc
+      | Parenthesized -> addParens doc
       | Braced braces -> printBraces doc expr braces
       | Nothing -> doc
     in
     let loc = {argLoc with loc_end = expr.pexp_loc.loc_end} in
-    let doc = Doc.concat [printedLbl; printedExpr] in
+    let doc =
+      if dotdotdot then printedLbl else Doc.concat [printedLbl; printedExpr]
+    in
     printComments doc cmtTbl loc
 
 and printCases ~state (cases : Parsetree.case list) cmtTbl =