Add surface syntax for partial application of uncurried functions

CHANGELOG.md

@@ -12,6 +12,9 @@
 
 # 11.0.0-alpha.4 (Unreleased)
 
+#### :rocket: Main New Feature
+- Add surface syntax for partial application of uncurried functions: `foo(1, ...)`. This corresponds to curried application in the old mode. https://github.com/rescript-lang/rescript-compiler/pull/6166
+
 #### :bug: Bug Fix
 
 - Fix broken formatting in uncurried mode for functions with _ placeholder args. https://github.com/rescript-lang/rescript-compiler/pull/6148

res_syntax/src/res_core.ml

@@ -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
 

res_syntax/src/res_grammar.ml

@@ -299,7 +299,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),

res_syntax/src/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;

res_syntax/src/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;

res_syntax/src/res_printer.ml

@@ -3970,6 +3970,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 +4587,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 +4601,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 +4629,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 +4649,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 =

res_syntax/tests/printer/expr/UncurriedByDefault.res

@@ -157,3 +157,5 @@ let fnU = (_x): ((unit) => unit) => fooC
 let aU = (() => "foo")->Ok
 
 Ok("_")->Belt.Result.map(concatStrings(_, "foo"))
+
+let ptl1 =  add(1, ...)

res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt

@@ -157,3 +157,5 @@ let fnU = (_x): (unit => unit) => fooC
 let aU = (() => "foo")->Ok
 
 Ok("_")->Belt.Result.map(concatStrings(_, "foo"))
+
+let ptl1 = add(1, ...)