From ae1e8971ff4dc77598bc482f5f9fd84f41767422 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 16 Apr 2023 06:22:16 +0200 Subject: [PATCH 1/4] Add surface syntax for partial application of uncurried functions Fixes https://github.com/rescript-lang/rescript-compiler/issues/6165 This PR introduces a new surface syntax for partial application of uncurried functions in ReScript. The syntax allows developers to partially apply uncurried functions more easily and concisely using the ... token in argument lists. The implementation includes changes to the parser, grammar, and printer to handle the new syntax properly. Example: res Copy code let add = (a, b) => a + b let ptl1 = add(1, ...) let result = ptl1(2) // result will be 3 This example demonstrates the new syntax for partial application of the uncurried add function. --- CHANGELOG.md | 3 ++ res_syntax/src/res_core.ml | 26 +++++++++----- res_syntax/src/res_grammar.ml | 2 +- res_syntax/src/res_parsetree_viewer.ml | 9 +++++ res_syntax/src/res_parsetree_viewer.mli | 3 ++ res_syntax/src/res_printer.ml | 34 +++++++++++++------ .../tests/printer/expr/UncurriedByDefault.res | 2 ++ .../expr/expected/UncurriedByDefault.res.txt | 2 ++ 8 files changed, 61 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a079759d6d..4cf0d917f5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,9 @@ # 11.0.0-alpha.4 (Unreleased) +#### :rocket: Main New Feature +- Add surface synyax for partial application of uncurried functions. + #### :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, ...) From 81b31fa808d63d6a587229eb86e75f63a269aa1f Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 16 Apr 2023 09:23:06 +0200 Subject: [PATCH 2/4] Update CHANGELOG.md Co-authored-by: Christoph Knittel --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4cf0d917f5..a9380855df 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,7 +13,7 @@ # 11.0.0-alpha.4 (Unreleased) #### :rocket: Main New Feature -- Add surface synyax for partial application of uncurried functions. +- Add surface syntax for partial application of uncurried functions. #### :bug: Bug Fix From 23eadf81b6b8dccb5eb3c3a7c923740383bb7695 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 17 Apr 2023 03:24:44 +0200 Subject: [PATCH 3/4] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a9380855df..e8919cba1a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,7 +13,7 @@ # 11.0.0-alpha.4 (Unreleased) #### :rocket: Main New Feature -- Add surface syntax for partial application of uncurried functions. +- Add surface syntax for partial application of uncurried functions: `foo(1, ...)`. This corresponds to curried application in the old mode. #### :bug: Bug Fix From ba3265fdcd474b134d5d8d479f8915384f44c905 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 17 Apr 2023 03:25:25 +0200 Subject: [PATCH 4/4] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e8919cba1a..893e5fc2c6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,7 +13,7 @@ # 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. +- 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