diff --git a/CHANGELOG.md b/CHANGELOG.md index a079759d6d..893e5fc2c6 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index da16a57592..cebb6805dc 100644 --- a/res_syntax/src/res_core.ml +++ b/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 diff --git a/res_syntax/src/res_grammar.ml b/res_syntax/src/res_grammar.ml index f40cd62642..dcc448ce5a 100644 --- a/res_syntax/src/res_grammar.ml +++ b/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), diff --git a/res_syntax/src/res_parsetree_viewer.ml b/res_syntax/src/res_parsetree_viewer.ml index 30d24b7ccb..6f951f376a 100644 --- a/res_syntax/src/res_parsetree_viewer.ml +++ b/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; diff --git a/res_syntax/src/res_parsetree_viewer.mli b/res_syntax/src/res_parsetree_viewer.mli index 1cc0f5995d..15ca9e150b 100644 --- a/res_syntax/src/res_parsetree_viewer.mli +++ b/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; diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index 2f6ef766d3..476463200e 100644 --- a/res_syntax/src/res_printer.ml +++ b/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 = diff --git a/res_syntax/tests/printer/expr/UncurriedByDefault.res b/res_syntax/tests/printer/expr/UncurriedByDefault.res index 81ac92dbb5..86e593442f 100644 --- a/res_syntax/tests/printer/expr/UncurriedByDefault.res +++ b/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, ...) diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index 4f9f758204..de3aab0162 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/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, ...)