From 34c509abbd704274ae479b87ba56c9e6512525f5 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 18 Nov 2022 08:37:53 +0100 Subject: [PATCH 1/7] Test: don't emit arity zero from the parser. --- jscomp/frontend/ast_uncurry_apply.ml | 12 +++++ jscomp/test/UncurriedExternals.js | 8 ++- jscomp/test/UncurriedExternals.res | 6 +++ jscomp/test/reactTestUtils.js | 4 +- jscomp/test/uncurried_cast.js | 2 +- lib/4.06.1/unstable/js_compiler.ml | 23 +++++--- lib/4.06.1/unstable/js_playground_compiler.ml | 53 +++++++++---------- lib/4.06.1/whole_compiler.ml | 53 +++++++++---------- res_syntax/src/res_core.ml | 30 ++++------- res_syntax/src/res_printer.ml | 11 ++-- .../expressions/UncurriedByDefault.res | 4 ++ .../expressions/expected/apply.res.txt | 2 +- .../expressions/expected/argument.res.txt | 4 +- .../expressions/expected/arrow.res.txt | 4 +- .../typexpr/expected/uncurried.res.txt | 4 +- .../expression/expected/infinite.res.txt | 2 +- .../expr/expected/UncurriedByDefault.res.txt | 16 +++--- 17 files changed, 126 insertions(+), 112 deletions(-) diff --git a/jscomp/frontend/ast_uncurry_apply.ml b/jscomp/frontend/ast_uncurry_apply.ml index 1032974506..a77a0f3baf 100644 --- a/jscomp/frontend/ast_uncurry_apply.ml +++ b/jscomp/frontend/ast_uncurry_apply.ml @@ -59,6 +59,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }); ] -> [] + | [ + ( Nolabel, + ({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) } + as e) ); + ] -> + [ + ( Asttypes.Nolabel, + { + e with + pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None); + } ); + ] | _ -> args in let arity = List.length args in diff --git a/jscomp/test/UncurriedExternals.js b/jscomp/test/UncurriedExternals.js index 2feda2f6d5..2ad6c4a52d 100644 --- a/jscomp/test/UncurriedExternals.js +++ b/jscomp/test/UncurriedExternals.js @@ -32,6 +32,8 @@ var te = (function (prim) { RE_EXN_ID: "Not_found" }); +var tcr = {}; + var StandardNotation = { dd: dd, h: h, @@ -40,7 +42,8 @@ var StandardNotation = { mf: mf, tg: tg, tc: tc, - te: te + te: te, + tcr: tcr }; function dd$1(param) { @@ -74,6 +77,8 @@ var te$1 = (function (prim) { RE_EXN_ID: "Not_found" }); +var tcr$1 = {}; + exports.StandardNotation = StandardNotation; exports.dd = dd$1; exports.h = h$1; @@ -83,4 +88,5 @@ exports.mf = mf$1; exports.tg = tg$1; exports.tc = tc$1; exports.te = te$1; +exports.tcr = tcr$1; /* h Not a pure module */ diff --git a/jscomp/test/UncurriedExternals.res b/jscomp/test/UncurriedExternals.res index e09a2faece..5158b442ea 100644 --- a/jscomp/test/UncurriedExternals.res +++ b/jscomp/test/UncurriedExternals.res @@ -23,6 +23,9 @@ module StandardNotation = { external toException: (. exn) => exn = "%identity" let te = toException(. Not_found) + + @obj external ccreate : () => string = "" + let tcr = ccreate() } @@uncurried @@ -51,3 +54,6 @@ let tc = copy("abc") external toException: exn => exn = "%identity" let te = toException(Not_found) + +@obj external ucreate : unit => string = "" +let tcr = ucreate( (():unit)) diff --git a/jscomp/test/reactTestUtils.js b/jscomp/test/reactTestUtils.js index 4ce3c32b85..a8dfcef1f7 100644 --- a/jscomp/test/reactTestUtils.js +++ b/jscomp/test/reactTestUtils.js @@ -7,14 +7,14 @@ var Caml_option = require("../../lib/js/caml_option.js"); var TestUtils = require("react-dom/test-utils"); function act(func) { - var reactFunc = function () { + var reactFunc = function (param) { Curry._1(func, undefined); }; TestUtils.act(reactFunc); } function actAsync(func) { - return TestUtils.act(function () { + return TestUtils.act(function (param) { return Curry._1(func, undefined); }); } diff --git a/jscomp/test/uncurried_cast.js b/jscomp/test/uncurried_cast.js index acc25f8ddb..7356f89cff 100644 --- a/jscomp/test/uncurried_cast.js +++ b/jscomp/test/uncurried_cast.js @@ -76,7 +76,7 @@ var StandardNotation = { anInt: anInt }; -function testRaise$1() { +function testRaise$1(param) { return raise({ RE_EXN_ID: E }); diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index ac890e7f44..060114180f 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -54768,12 +54768,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_object (fields, openFlag) -> printObject ~state ~inline:false fields openFlag cmtTbl | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr - | Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()" - | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> - let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in - let tUnit = Ast_helper.Typ.constr parensConstr [] in - printArrow ~uncurried:true ~arity:1 - {tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)} | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg]) when String.length arity >= 5 && (String.sub [@doesNotRaise]) arity 0 5 = "arity" -> @@ -55797,7 +55791,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> printJsxFragment ~state e cmtTbl - | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" + | Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) -> + Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] @@ -57628,7 +57623,7 @@ and printArguments ~state ~dotted | [ ( Nolabel, { - pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); + pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _); pexp_loc = loc; } ); ] -> ( @@ -148508,6 +148503,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }); ] -> [] + | [ + ( Nolabel, + ({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) } + as e) ); + ] -> + [ + ( Asttypes.Nolabel, + { + e with + pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None); + } ); + ] | _ -> args in let arity = List.length args in diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 1f44615640..567f09fc23 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -54768,12 +54768,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_object (fields, openFlag) -> printObject ~state ~inline:false fields openFlag cmtTbl | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr - | Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()" - | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> - let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in - let tUnit = Ast_helper.Typ.constr parensConstr [] in - printArrow ~uncurried:true ~arity:1 - {tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)} | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg]) when String.length arity >= 5 && (String.sub [@doesNotRaise]) arity 0 5 = "arity" -> @@ -55797,7 +55791,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> printJsxFragment ~state e cmtTbl - | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" + | Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) -> + Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] @@ -57628,7 +57623,7 @@ and printArguments ~state ~dotted | [ ( Nolabel, { - pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); + pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _); pexp_loc = loc; } ); ] -> ( @@ -148508,6 +148503,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }); ] -> [] + | [ + ( Nolabel, + ({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) } + as e) ); + ] -> + [ + ( Asttypes.Nolabel, + { + e with + pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None); + } ); + ] | _ -> args in let arity = List.length args in @@ -163990,11 +163997,6 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context if p.uncurried_by_default then not dotted else dotted in if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - let arirtForFn = - match pat.ppat_desc with - | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 - | _ -> arity - in ( paramNum - 1, (if true then Ast_helper.Exp.record ~loc @@ -164002,8 +164004,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context ( { txt = Ldot - ( Ldot (Lident "Js", "Fn"), - "I" ^ string_of_int arirtForFn ); + (Ldot (Lident "Js", "Fn"), "I" ^ string_of_int arity); loc; }, funExpr ); @@ -165923,7 +165924,9 @@ and parseArgument p : argument option = | Rparen -> let unitExpr = Ast_helper.Exp.construct - (Location.mknoloc (Longident.Lident "()")) + (Location.mknoloc + (Longident.Lident + (if p.uncurried_by_default then "()" else "(u)"))) None in Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} @@ -166016,7 +166019,10 @@ and parseCallExpr p funExpr = label = Nolabel; expr = Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident "()") loc) + (Location.mkloc + (Longident.Lident + (if p.uncurried_by_default then "(u)" else "()")) + loc) None; }; ] @@ -166674,23 +166680,14 @@ and parseEs6ArrowType ~attrs p = if p.uncurried_by_default then not dotted else dotted in if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - let isParens = - match typ.ptyp_desc with - | Ptyp_constr ({txt = Lident "unit"; loc}, []) -> - loc.loc_end.pos_cnum - loc.loc_start.pos_cnum = 2 (* () *) - | _ -> false - in let loc = mkLoc startPos endPos in - let fnArity, tArg = - if isParens && arity = 1 then (0, t) - else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) - in + let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in ( paramNum - 1, Ast_helper.Typ.constr ~loc { txt = Ldot - (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity); + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); loc; } [tArg], diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index ba4d946e27..7e0b93209c 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -109766,12 +109766,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_object (fields, openFlag) -> printObject ~state ~inline:false fields openFlag cmtTbl | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr - | Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()" - | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> - let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in - let tUnit = Ast_helper.Typ.constr parensConstr [] in - printArrow ~uncurried:true ~arity:1 - {tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)} | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg]) when String.length arity >= 5 && (String.sub [@doesNotRaise]) arity 0 5 = "arity" -> @@ -110795,7 +110789,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> printJsxFragment ~state e cmtTbl - | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" + | Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) -> + Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] @@ -112626,7 +112621,7 @@ and printArguments ~state ~dotted | [ ( Nolabel, { - pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); + pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _); pexp_loc = loc; } ); ] -> ( @@ -158792,6 +158787,18 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }); ] -> [] + | [ + ( Nolabel, + ({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) } + as e) ); + ] -> + [ + ( Asttypes.Nolabel, + { + e with + pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None); + } ); + ] | _ -> args in let arity = List.length args in @@ -177422,11 +177429,6 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context if p.uncurried_by_default then not dotted else dotted in if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - let arirtForFn = - match pat.ppat_desc with - | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 - | _ -> arity - in ( paramNum - 1, (if true then Ast_helper.Exp.record ~loc @@ -177434,8 +177436,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context ( { txt = Ldot - ( Ldot (Lident "Js", "Fn"), - "I" ^ string_of_int arirtForFn ); + (Ldot (Lident "Js", "Fn"), "I" ^ string_of_int arity); loc; }, funExpr ); @@ -179355,7 +179356,9 @@ and parseArgument p : argument option = | Rparen -> let unitExpr = Ast_helper.Exp.construct - (Location.mknoloc (Longident.Lident "()")) + (Location.mknoloc + (Longident.Lident + (if p.uncurried_by_default then "()" else "(u)"))) None in Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} @@ -179448,7 +179451,10 @@ and parseCallExpr p funExpr = label = Nolabel; expr = Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident "()") loc) + (Location.mkloc + (Longident.Lident + (if p.uncurried_by_default then "(u)" else "()")) + loc) None; }; ] @@ -180106,23 +180112,14 @@ and parseEs6ArrowType ~attrs p = if p.uncurried_by_default then not dotted else dotted in if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - let isParens = - match typ.ptyp_desc with - | Ptyp_constr ({txt = Lident "unit"; loc}, []) -> - loc.loc_end.pos_cnum - loc.loc_start.pos_cnum = 2 (* () *) - | _ -> false - in let loc = mkLoc startPos endPos in - let fnArity, tArg = - if isParens && arity = 1 then (0, t) - else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) - in + let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in ( paramNum - 1, Ast_helper.Typ.constr ~loc { txt = Ldot - (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity); + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); loc; } [tArg], diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 4833d3ebec..335793738b 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -1576,11 +1576,6 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context if p.uncurried_by_default then not dotted else dotted in if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - let arirtForFn = - match pat.ppat_desc with - | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 - | _ -> arity - in ( paramNum - 1, (if true then Ast_helper.Exp.record ~loc @@ -1588,8 +1583,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context ( { txt = Ldot - ( Ldot (Lident "Js", "Fn"), - "I" ^ string_of_int arirtForFn ); + (Ldot (Lident "Js", "Fn"), "I" ^ string_of_int arity); loc; }, funExpr ); @@ -3509,7 +3503,9 @@ and parseArgument p : argument option = | Rparen -> let unitExpr = Ast_helper.Exp.construct - (Location.mknoloc (Longident.Lident "()")) + (Location.mknoloc + (Longident.Lident + (if p.uncurried_by_default then "()" else "(u)"))) None in Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} @@ -3602,7 +3598,10 @@ and parseCallExpr p funExpr = label = Nolabel; expr = Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident "()") loc) + (Location.mkloc + (Longident.Lident + (if p.uncurried_by_default then "(u)" else "()")) + loc) None; }; ] @@ -4260,23 +4259,14 @@ and parseEs6ArrowType ~attrs p = if p.uncurried_by_default then not dotted else dotted in if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - let isParens = - match typ.ptyp_desc with - | Ptyp_constr ({txt = Lident "unit"; loc}, []) -> - loc.loc_end.pos_cnum - loc.loc_start.pos_cnum = 2 (* () *) - | _ -> false - in let loc = mkLoc startPos endPos in - let fnArity, tArg = - if isParens && arity = 1 then (0, t) - else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) - in + let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in ( paramNum - 1, Ast_helper.Typ.constr ~loc { txt = Ldot - (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity); + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); loc; } [tArg], diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index 54c246f2ab..c14c42afa3 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -1657,12 +1657,6 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_object (fields, openFlag) -> printObject ~state ~inline:false fields openFlag cmtTbl | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr - | Ptyp_constr ({txt = Lident "()"}, []) -> Doc.text "()" - | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> - let parensConstr = Location.mkloc (Longident.Lident "()") tArg.ptyp_loc in - let tUnit = Ast_helper.Typ.constr parensConstr [] in - printArrow ~uncurried:true ~arity:1 - {tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)} | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg]) when String.length arity >= 5 && (String.sub [@doesNotRaise]) arity 0 5 = "arity" -> @@ -2686,7 +2680,8 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> printJsxFragment ~state e cmtTbl - | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" + | Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) -> + Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] @@ -4517,7 +4512,7 @@ and printArguments ~state ~dotted | [ ( Nolabel, { - pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); + pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _); pexp_loc = loc; } ); ] -> ( diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 3b61aa41ac..881094a59a 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -90,3 +90,7 @@ let _ = @att x => 34 let _ = @att async x => 34 let _ = preserveAttr(@att x => 34) let _ = preserveAttr(@att async x => 34) + +let foo : unit =>string = () => "abc" + +let s = foo() diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt index d9a01f8f05..dfefc417fc 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt @@ -4,5 +4,5 @@ ;;foo (fun _ -> bla) (fun _ -> blaz) ;;List.map (fun x -> x + 1) myList ;;List.reduce (fun acc -> fun curr -> acc + curr) 0 myList -let unitUncurried = ((apply ())[@bs ]) +let unitUncurried = ((apply (u))[@bs ]) ;;call ~a:(((((a)[@ns.namedArgLoc ]) : int))[@ns.namedArgLoc ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt index 2f12cf4e4e..56a1d6c677 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt @@ -1,6 +1,6 @@ let foo ~a:((a)[@ns.namedArgLoc ]) = ((a (let __res_unit = () in __res_unit))[@bs ]) +. 1. -let a = { Js.Fn.I0 = (fun () -> 2) } +let a = { Js.Fn.I1 = (fun () -> 2) } let bar = foo ~a:((a)[@ns.namedArgLoc ]) let comparisonResult = ((compare currentNode.value ~targetValue:((targetValue)[@ns.namedArgLoc ])) @@ -9,5 +9,5 @@ let comparisonResult = ;;((document.createElementWithOptions {js|div|js} (elementProps ~onClick:((fun _ -> Js.log {js|hello world|js}) [@ns.namedArgLoc ])))[@bs ]) -;;((resolve ())[@bs ]) +;;((resolve (u))[@bs ]) ;;((resolve (let __res_unit = () in __res_unit))[@bs ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/arrow.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/arrow.res.txt index ed1d7067c4..08844ba502 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/arrow.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/arrow.res.txt @@ -40,8 +40,8 @@ let f ?a:(((x : int option))[@ns.namedArgLoc ]) ?b:(((y : int option))[@ns.namedArgLoc ]) c = match (x, y) with | (Some a, Some b) -> (a + b) + c | _ -> 3 let f a b = a + b -let f = { Js.Fn.I0 = (fun () -> ()) } -let f = { Js.Fn.I0 = (fun () -> ()) } +let f = { Js.Fn.I1 = (fun () -> ()) } +let f = { Js.Fn.I1 = (fun () -> ()) } let f = { Js.Fn.I3 = (fun a -> fun b -> fun c -> ()) } let f = { Js.Fn.I2 = (fun a -> fun b -> { Js.Fn.I2 = (fun c -> fun d -> ()) }) } diff --git a/res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt b/res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt index d1e5009181..413302962a 100644 --- a/res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt +++ b/res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt @@ -16,7 +16,7 @@ type nonrec t = ((int)[@attr2 ]) -> (((bool)[@attr3 ]) -> ((string)[@attr4 ]) -> unit) Js.Fn.arity2) Js.Fn.arity2 -external setTimeout : unit Js.Fn.arity0 -> int -> timerId = "setTimeout" -[@@bs.val ] +external setTimeout : + (unit -> unit) Js.Fn.arity1 -> int -> timerId = "setTimeout"[@@bs.val ] external setTimeout : ((unit -> unit) -> int -> timerId) Js.Fn.arity2 = "setTimeout" \ No newline at end of file diff --git a/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt b/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt index 53f278cc9a..4b375a15b6 100644 --- a/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt +++ b/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt @@ -1 +1 @@ -let smallest = ((heap.compare ())[@bs ]) < (a |. (f b)) \ No newline at end of file +let smallest = ((heap.compare (u))[@bs ]) < (a |. (f b)) \ No newline at end of file diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index 0714ad2fc4..b061eb46cf 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -23,11 +23,11 @@ type cpp = (unit, unit) => int type cu2 = (unit, unit) => unit type cp2 = (unit, unit) => unit type uu = (. unit) => int -type up = (. ()) => int +type up = (. unit) => int type uuu = (. unit) => (. unit) => int -type upu = (. ()) => (. unit) => int -type uup = (. unit) => (. ()) => int -type upp = (. ()) => (. ()) => int +type upu = (. unit) => (. unit) => int +type uup = (. unit) => (. unit) => int +type upp = (. unit) => (. unit) => int type uu2 = (. unit, unit) => unit type up2 = (. unit, unit) => unit @@ -77,11 +77,11 @@ type cpp = (. unit, unit) => int type cu2 = (. unit, unit) => unit type cp2 = (. unit, unit) => unit type uu = unit => int -type up = () => int +type up = unit => int type uuu = unit => unit => int -type upu = () => unit => int -type uup = unit => () => int -type upp = () => () => int +type upu = unit => unit => int +type uup = unit => unit => int +type upp = unit => unit => int type uu2 = (unit, unit) => unit type up2 = (unit, unit) => unit From e98175628aef0ae3df56e6807082e80a0529f38f Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 18 Nov 2022 14:24:10 +0100 Subject: [PATCH 2/7] Clean up: remove "(u)" encoding for uncurried unariy application. --- jscomp/frontend/ast_exp_apply.ml | 6 +-- jscomp/frontend/ast_uncurry_apply.ml | 26 ++++------ jscomp/frontend/ast_uncurry_apply.mli | 1 + lib/4.06.1/unstable/js_compiler.ml | 38 ++++++--------- lib/4.06.1/unstable/js_playground_compiler.ml | 47 +++++++------------ lib/4.06.1/whole_compiler.ml | 47 +++++++------------ res_syntax/src/res_core.ml | 9 +--- res_syntax/src/res_printer.ml | 5 +- .../expressions/expected/apply.res.txt | 2 +- .../expressions/expected/argument.res.txt | 2 +- .../expression/expected/infinite.res.txt | 2 +- 11 files changed, 65 insertions(+), 120 deletions(-) diff --git a/jscomp/frontend/ast_exp_apply.ml b/jscomp/frontend/ast_exp_apply.ml index d909647372..ffbec52a46 100644 --- a/jscomp/frontend/ast_exp_apply.ml +++ b/jscomp/frontend/ast_exp_apply.ml @@ -173,7 +173,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) fn1.pexp_attributes; { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn1 + Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op="|.") e.pexp_loc self fn1 ((Nolabel, a) :: args); pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; @@ -183,7 +183,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Uncurried unary application *) { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self f + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false e.pexp_loc self f [ (Nolabel, a) ]; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes; @@ -288,6 +288,6 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) { e with pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args; + Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc self fn args; pexp_attributes; })) diff --git a/jscomp/frontend/ast_uncurry_apply.ml b/jscomp/frontend/ast_uncurry_apply.ml index a77a0f3baf..8d8d70eed0 100644 --- a/jscomp/frontend/ast_uncurry_apply.ml +++ b/jscomp/frontend/ast_uncurry_apply.ml @@ -44,8 +44,9 @@ let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc = [ (Nolabel, e) ], Typ.any ~loc () ) -let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) - (args : Ast_compatible.args) (cb : loc -> exp -> exp) = +let generic_apply ~arity0 loc (self : Bs_ast_mapper.mapper) + (obj : Parsetree.expression) (args : Ast_compatible.args) + (cb : loc -> exp -> exp) = let obj = self.expr self obj in let args = Ext_list.map args (fun (lbl, e) -> @@ -57,20 +58,9 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) match args with | [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }); - ] -> + ] + when arity0 -> [] - | [ - ( Nolabel, - ({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) } - as e) ); - ] -> - [ - ( Asttypes.Nolabel, - { - e with - pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None); - } ); - ] | _ -> args in let arity = List.length args in @@ -140,9 +130,9 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) ]) args) -let uncurry_fn_apply loc self fn args = - generic_apply loc self fn args (fun _ obj -> obj) +let uncurry_fn_apply ~arity0 loc self fn args = + generic_apply ~arity0 loc self fn args (fun _ obj -> obj) let property_apply loc self obj name args = - generic_apply loc self obj args (fun loc obj -> + generic_apply ~arity0:true loc self obj args (fun loc obj -> Exp.send ~loc obj { txt = name; loc }) diff --git a/jscomp/frontend/ast_uncurry_apply.mli b/jscomp/frontend/ast_uncurry_apply.mli index 81827af52b..a402c08004 100644 --- a/jscomp/frontend/ast_uncurry_apply.mli +++ b/jscomp/frontend/ast_uncurry_apply.mli @@ -25,6 +25,7 @@ (* TODO: the interface is not reusable, it depends on too much context *) val uncurry_fn_apply : + arity0:bool -> Location.t -> Bs_ast_mapper.mapper -> Parsetree.expression -> diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 060114180f..12f9f5545e 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -55791,8 +55791,7 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> printJsxFragment ~state e cmtTbl - | Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) -> - Doc.text "()" + | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] @@ -57623,7 +57622,7 @@ and printArguments ~state ~dotted | [ ( Nolabel, { - pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _); + pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); pexp_loc = loc; } ); ] -> ( @@ -148415,6 +148414,7 @@ module Ast_uncurry_apply : sig (* TODO: the interface is not reusable, it depends on too much context *) val uncurry_fn_apply : + arity0:bool -> Location.t -> Bs_ast_mapper.mapper -> Parsetree.expression -> @@ -148488,8 +148488,9 @@ let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc = [ (Nolabel, e) ], Typ.any ~loc () ) -let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) - (args : Ast_compatible.args) (cb : loc -> exp -> exp) = +let generic_apply ~arity0 loc (self : Bs_ast_mapper.mapper) + (obj : Parsetree.expression) (args : Ast_compatible.args) + (cb : loc -> exp -> exp) = let obj = self.expr self obj in let args = Ext_list.map args (fun (lbl, e) -> @@ -148501,20 +148502,9 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) match args with | [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }); - ] -> + ] + when arity0 -> [] - | [ - ( Nolabel, - ({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) } - as e) ); - ] -> - [ - ( Asttypes.Nolabel, - { - e with - pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None); - } ); - ] | _ -> args in let arity = List.length args in @@ -148584,11 +148574,11 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) ]) args) -let uncurry_fn_apply loc self fn args = - generic_apply loc self fn args (fun _ obj -> obj) +let uncurry_fn_apply ~arity0 loc self fn args = + generic_apply ~arity0 loc self fn args (fun _ obj -> obj) let property_apply loc self obj name args = - generic_apply loc self obj args (fun loc obj -> + generic_apply ~arity0:true loc self obj args (fun loc obj -> Exp.send ~loc obj { txt = name; loc }) end @@ -150490,7 +150480,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) fn1.pexp_attributes; { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn1 + Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op="|.") e.pexp_loc self fn1 ((Nolabel, a) :: args); pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; @@ -150500,7 +150490,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Uncurried unary application *) { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self f + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false e.pexp_loc self f [ (Nolabel, a) ]; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes; @@ -150605,7 +150595,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) { e with pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args; + Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc self fn args; pexp_attributes; })) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 567f09fc23..2e002e0bc7 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -55791,8 +55791,7 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> printJsxFragment ~state e cmtTbl - | Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) -> - Doc.text "()" + | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] @@ -57623,7 +57622,7 @@ and printArguments ~state ~dotted | [ ( Nolabel, { - pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _); + pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); pexp_loc = loc; } ); ] -> ( @@ -148415,6 +148414,7 @@ module Ast_uncurry_apply : sig (* TODO: the interface is not reusable, it depends on too much context *) val uncurry_fn_apply : + arity0:bool -> Location.t -> Bs_ast_mapper.mapper -> Parsetree.expression -> @@ -148488,8 +148488,9 @@ let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc = [ (Nolabel, e) ], Typ.any ~loc () ) -let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) - (args : Ast_compatible.args) (cb : loc -> exp -> exp) = +let generic_apply ~arity0 loc (self : Bs_ast_mapper.mapper) + (obj : Parsetree.expression) (args : Ast_compatible.args) + (cb : loc -> exp -> exp) = let obj = self.expr self obj in let args = Ext_list.map args (fun (lbl, e) -> @@ -148501,20 +148502,9 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) match args with | [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }); - ] -> + ] + when arity0 -> [] - | [ - ( Nolabel, - ({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) } - as e) ); - ] -> - [ - ( Asttypes.Nolabel, - { - e with - pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None); - } ); - ] | _ -> args in let arity = List.length args in @@ -148584,11 +148574,11 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) ]) args) -let uncurry_fn_apply loc self fn args = - generic_apply loc self fn args (fun _ obj -> obj) +let uncurry_fn_apply ~arity0 loc self fn args = + generic_apply ~arity0 loc self fn args (fun _ obj -> obj) let property_apply loc self obj name args = - generic_apply loc self obj args (fun loc obj -> + generic_apply ~arity0:true loc self obj args (fun loc obj -> Exp.send ~loc obj { txt = name; loc }) end @@ -150490,7 +150480,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) fn1.pexp_attributes; { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn1 + Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op="|.") e.pexp_loc self fn1 ((Nolabel, a) :: args); pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; @@ -150500,7 +150490,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Uncurried unary application *) { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self f + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false e.pexp_loc self f [ (Nolabel, a) ]; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes; @@ -150605,7 +150595,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) { e with pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args; + Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc self fn args; pexp_attributes; })) @@ -165924,9 +165914,7 @@ and parseArgument p : argument option = | Rparen -> let unitExpr = Ast_helper.Exp.construct - (Location.mknoloc - (Longident.Lident - (if p.uncurried_by_default then "()" else "(u)"))) + (Location.mknoloc (Longident.Lident "()")) None in Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} @@ -166019,10 +166007,7 @@ and parseCallExpr p funExpr = label = Nolabel; expr = Ast_helper.Exp.construct ~loc - (Location.mkloc - (Longident.Lident - (if p.uncurried_by_default then "(u)" else "()")) - loc) + (Location.mkloc (Longident.Lident "()") loc) None; }; ] diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 7e0b93209c..268dbc900b 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -110789,8 +110789,7 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> printJsxFragment ~state e cmtTbl - | Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) -> - Doc.text "()" + | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] @@ -112621,7 +112620,7 @@ and printArguments ~state ~dotted | [ ( Nolabel, { - pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _); + pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); pexp_loc = loc; } ); ] -> ( @@ -158699,6 +158698,7 @@ module Ast_uncurry_apply : sig (* TODO: the interface is not reusable, it depends on too much context *) val uncurry_fn_apply : + arity0:bool -> Location.t -> Bs_ast_mapper.mapper -> Parsetree.expression -> @@ -158772,8 +158772,9 @@ let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc = [ (Nolabel, e) ], Typ.any ~loc () ) -let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) - (args : Ast_compatible.args) (cb : loc -> exp -> exp) = +let generic_apply ~arity0 loc (self : Bs_ast_mapper.mapper) + (obj : Parsetree.expression) (args : Ast_compatible.args) + (cb : loc -> exp -> exp) = let obj = self.expr self obj in let args = Ext_list.map args (fun (lbl, e) -> @@ -158785,20 +158786,9 @@ let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) match args with | [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }); - ] -> + ] + when arity0 -> [] - | [ - ( Nolabel, - ({ pexp_desc = Pexp_construct (({ txt = Lident "(u)" } as lid), None) } - as e) ); - ] -> - [ - ( Asttypes.Nolabel, - { - e with - pexp_desc = Pexp_construct ({ lid with txt = Lident "()" }, None); - } ); - ] | _ -> args in let arity = List.length args in @@ -158868,11 +158858,11 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression) ]) args) -let uncurry_fn_apply loc self fn args = - generic_apply loc self fn args (fun _ obj -> obj) +let uncurry_fn_apply ~arity0 loc self fn args = + generic_apply ~arity0 loc self fn args (fun _ obj -> obj) let property_apply loc self obj name args = - generic_apply loc self obj args (fun loc obj -> + generic_apply ~arity0:true loc self obj args (fun loc obj -> Exp.send ~loc obj { txt = name; loc }) end @@ -160774,7 +160764,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) fn1.pexp_attributes; { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn1 + Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op="|.") e.pexp_loc self fn1 ((Nolabel, a) :: args); pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; @@ -160784,7 +160774,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Uncurried unary application *) { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self f + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false e.pexp_loc self f [ (Nolabel, a) ]; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes; @@ -160889,7 +160879,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) { e with pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args; + Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc self fn args; pexp_attributes; })) @@ -179356,9 +179346,7 @@ and parseArgument p : argument option = | Rparen -> let unitExpr = Ast_helper.Exp.construct - (Location.mknoloc - (Longident.Lident - (if p.uncurried_by_default then "()" else "(u)"))) + (Location.mknoloc (Longident.Lident "()")) None in Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} @@ -179451,10 +179439,7 @@ and parseCallExpr p funExpr = label = Nolabel; expr = Ast_helper.Exp.construct ~loc - (Location.mkloc - (Longident.Lident - (if p.uncurried_by_default then "(u)" else "()")) - loc) + (Location.mkloc (Longident.Lident "()") loc) None; }; ] diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 335793738b..138888c382 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -3503,9 +3503,7 @@ and parseArgument p : argument option = | Rparen -> let unitExpr = Ast_helper.Exp.construct - (Location.mknoloc - (Longident.Lident - (if p.uncurried_by_default then "()" else "(u)"))) + (Location.mknoloc (Longident.Lident "()")) None in Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} @@ -3598,10 +3596,7 @@ and parseCallExpr p funExpr = label = Nolabel; expr = Ast_helper.Exp.construct ~loc - (Location.mkloc - (Longident.Lident - (if p.uncurried_by_default then "(u)" else "()")) - loc) + (Location.mkloc (Longident.Lident "()") loc) None; }; ] diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index c14c42afa3..1e700b9f5e 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -2680,8 +2680,7 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> printJsxFragment ~state e cmtTbl - | Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _) -> - Doc.text "()" + | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] @@ -4512,7 +4511,7 @@ and printArguments ~state ~dotted | [ ( Nolabel, { - pexp_desc = Pexp_construct ({txt = Longident.Lident ("()" | "(u)")}, _); + pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); pexp_loc = loc; } ); ] -> ( diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt index dfefc417fc..d9a01f8f05 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt @@ -4,5 +4,5 @@ ;;foo (fun _ -> bla) (fun _ -> blaz) ;;List.map (fun x -> x + 1) myList ;;List.reduce (fun acc -> fun curr -> acc + curr) 0 myList -let unitUncurried = ((apply (u))[@bs ]) +let unitUncurried = ((apply ())[@bs ]) ;;call ~a:(((((a)[@ns.namedArgLoc ]) : int))[@ns.namedArgLoc ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt index 56a1d6c677..bac3de888f 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt @@ -9,5 +9,5 @@ let comparisonResult = ;;((document.createElementWithOptions {js|div|js} (elementProps ~onClick:((fun _ -> Js.log {js|hello world|js}) [@ns.namedArgLoc ])))[@bs ]) -;;((resolve (u))[@bs ]) +;;((resolve ())[@bs ]) ;;((resolve (let __res_unit = () in __res_unit))[@bs ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt b/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt index 4b375a15b6..53f278cc9a 100644 --- a/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt +++ b/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt @@ -1 +1 @@ -let smallest = ((heap.compare (u))[@bs ]) < (a |. (f b)) \ No newline at end of file +let smallest = ((heap.compare ())[@bs ]) < (a |. (f b)) \ No newline at end of file From 06be27b79f97f452f61e425aca597c71a7aaa65d Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 18 Nov 2022 14:27:38 +0100 Subject: [PATCH 3/7] Update CHANGELOG.md --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d87c86130b..0320ca9b1e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,8 @@ - Add support for partial application of uncurried functions: with uncurried application one can provide a subset of the arguments, and return a curried type with the remaining ones https://github.com/rescript-lang/rescript-compiler/pull/5805 - Add support for uncurried externals https://github.com/rescript-lang/rescript-compiler/pull/5815 https://github.com/rescript-lang/rescript-compiler/pull/5819 +- Unify uncurried functions of arity 0 with functions of arity 1 taking unit. They're now equivalent. https://github.com/rescript-lang/rescript-compiler/pull/5825 + #### :boom: Breaking Change @@ -32,7 +34,6 @@ subset of the arguments, and return a curried type with the remaining ones https - Curried after uncurried is not fused anymore: `(. x) => y => 3` is not equivalent to `(. x, y) => 3` anymore. It's instead equivalent to `(. x) => { y => 3 }`. Also, `(. int) => string => bool` is not equivalen to `(. int, string) => bool` anymore. These are only breaking changes for unformatted code. -- Distinguish between uncurried type `(. ()) => int`, whch takes 0 arguments, and `(. unit) => int` which takes 1 argument of type `unit` https://github.com/rescript-lang/rescript-compiler/pull/5821 #### :bug: Bug Fix From 131b944f29799f7320c325d06e53d9f5ce4475bf Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 18 Nov 2022 15:28:51 +0100 Subject: [PATCH 4/7] Use `res.uapp` for uncurried app attribute coming from the parser. --- jscomp/frontend/ast_attributes.ml | 10 ++- jscomp/frontend/ast_attributes.mli | 2 + jscomp/frontend/ast_exp_apply.ml | 32 ++++++-- jscomp/test/UncurriedExternals.res | 6 +- lib/4.06.1/unstable/js_compiler.ml | 74 +++++++++++++---- lib/4.06.1/unstable/js_playground_compiler.ml | 80 ++++++++++++++----- lib/4.06.1/whole_compiler.ml | 80 ++++++++++++++----- res_syntax/src/res_core.ml | 6 +- res_syntax/src/res_parsetree_viewer.ml | 25 ++++-- res_syntax/src/res_parsetree_viewer.mli | 3 + res_syntax/src/res_printer.ml | 2 +- .../expected/UncurriedByDefault.res.txt | 27 ++++--- .../expressions/expected/apply.res.txt | 2 +- .../expressions/expected/argument.res.txt | 12 +-- .../expressions/expected/async.res.txt | 15 +++- .../expressions/expected/binary.res.txt | 2 +- .../expressions/expected/uncurried.res.txt | 4 +- .../expected/equalAfterBinaryExpr.res.txt | 2 +- .../expression/expected/infinite.res.txt | 2 +- 19 files changed, 282 insertions(+), 104 deletions(-) diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index e64a32ae2e..b22b8fbb5d 100644 --- a/jscomp/frontend/ast_attributes.ml +++ b/jscomp/frontend/ast_attributes.ml @@ -305,9 +305,12 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = _; }; ] - when Ast_utf8_string_interp.parse_processed_delim delim_ <> None -> ( + when Ast_utf8_string_interp.parse_processed_delim delim_ + <> None -> ( let delim = - match Ast_utf8_string_interp.parse_processed_delim delim_ with + match + Ast_utf8_string_interp.parse_processed_delim delim_ + with | None -> assert false | Some delim -> delim in @@ -338,6 +341,9 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false +let is_uncurried_app (attr : attr) = + match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false + let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty) let bs_get_index : attr = diff --git a/jscomp/frontend/ast_attributes.mli b/jscomp/frontend/ast_attributes.mli index 85b84adbed..8f86ecd79a 100644 --- a/jscomp/frontend/ast_attributes.mli +++ b/jscomp/frontend/ast_attributes.mli @@ -72,6 +72,8 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) +val is_uncurried_app : attr -> bool + val bs_get : attr val bs_get_index : attr diff --git a/jscomp/frontend/ast_exp_apply.ml b/jscomp/frontend/ast_exp_apply.ml index ffbec52a46..9fd18c03f2 100644 --- a/jscomp/frontend/ast_exp_apply.ml +++ b/jscomp/frontend/ast_exp_apply.ml @@ -158,8 +158,9 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) }) | _ -> ( match - ( Ext_list.exclude_with_val f_.pexp_attributes - Ast_attributes.is_bs, + ( Ext_list.exclude_with_val f_.pexp_attributes (fun a -> + Ast_attributes.is_bs a + || Ast_attributes.is_uncurried_app a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -173,8 +174,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) fn1.pexp_attributes; { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op="|.") e.pexp_loc self fn1 - ((Nolabel, a) :: args); + Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op = "|.") + e.pexp_loc self fn1 ((Nolabel, a) :: args); pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; } @@ -183,7 +184,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Uncurried unary application *) { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:false e.pexp_loc self f + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false + e.pexp_loc self f [ (Nolabel, a) ]; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes; @@ -283,11 +285,25 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) match Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs with - | None -> default_expr_mapper self e | Some pexp_attributes -> { e with pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc self fn args; + Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc + self fn args; pexp_attributes; - })) + } + | None -> ( + match + Ext_list.exclude_with_val e.pexp_attributes + Ast_attributes.is_uncurried_app + with + | Some pexp_attributes -> + { + e with + pexp_desc = + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false + e.pexp_loc self fn args; + pexp_attributes; + } + | None -> default_expr_mapper self e))) diff --git a/jscomp/test/UncurriedExternals.res b/jscomp/test/UncurriedExternals.res index 5158b442ea..befcde30a8 100644 --- a/jscomp/test/UncurriedExternals.res +++ b/jscomp/test/UncurriedExternals.res @@ -24,8 +24,8 @@ module StandardNotation = { external toException: (. exn) => exn = "%identity" let te = toException(. Not_found) - @obj external ccreate : () => string = "" - let tcr = ccreate() + @obj external ccreate : (. unit) => string = "" + let tcr = ccreate(.) } @@uncurried @@ -56,4 +56,4 @@ external toException: exn => exn = "%identity" let te = toException(Not_found) @obj external ucreate : unit => string = "" -let tcr = ucreate( (():unit)) +let tcr = ucreate() diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 12f9f5545e..0a0e525490 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -49432,6 +49432,9 @@ val functorType : (* filters @bs out of the provided attributes *) val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val processUncurriedAppAttribute : + Parsetree.attributes -> bool * Parsetree.attributes + type functionAttributesInfo = { async: bool; bs: bool; @@ -49633,6 +49636,21 @@ let processBsAttribute attrs = in process false [] attrs +let processUncurriedAppAttribute attrs = + let rec process bsSpotted acc attrs = + match attrs with + | [] -> (bsSpotted, List.rev acc) + | ( { + Location.txt = + "bs" (* still support @bs to convert .ml files *) | "res.uapp"; + }, + _ ) + :: rest -> + process true acc rest + | attr :: rest -> process bsSpotted (attr :: acc) rest + in + process false [] attrs + type functionAttributesInfo = { async: bool; bs: bool; @@ -49762,7 +49780,7 @@ let filterParsingAttrs attrs = match attr with | ( { Location.txt = - ( "bs" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc" + ( "bs" | "res.uapp" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc" | "ns.optional" | "ns.ternary" | "res.async" | "res.await" | "res.template" ); }, @@ -49911,8 +49929,8 @@ let hasAttributes attrs = match attr with | ( { Location.txt = - ( "bs" | "ns.braces" | "ns.iflet" | "ns.ternary" | "res.async" - | "res.await" | "res.template" ); + ( "bs" | "res.uapp" | "ns.braces" | "ns.iflet" | "ns.ternary" + | "res.async" | "res.await" | "res.template" ); }, _ ) -> false @@ -50093,8 +50111,8 @@ let isPrintableAttribute attr = match attr with | ( { Location.txt = - ( "bs" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" | "res.await" - | "res.template" | "ns.ternary" ); + ( "bs" | "res.uapp" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" + | "res.await" | "res.template" | "ns.ternary" ); }, _ ) -> false @@ -57064,7 +57082,7 @@ and printPexpApply ~state expr cmtTbl = args in let hasBs, attrs = - ParsetreeViewer.processBsAttribute expr.pexp_attributes + ParsetreeViewer.processUncurriedAppAttribute expr.pexp_attributes in let dotted = if state.State.uncurried_by_default then not hasBs else hasBs @@ -145082,6 +145100,8 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) +val is_uncurried_app : attr -> bool + val bs_get : attr val bs_get_index : attr @@ -145408,9 +145428,12 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = _; }; ] - when Ast_utf8_string_interp.parse_processed_delim delim_ <> None -> ( + when Ast_utf8_string_interp.parse_processed_delim delim_ + <> None -> ( let delim = - match Ast_utf8_string_interp.parse_processed_delim delim_ with + match + Ast_utf8_string_interp.parse_processed_delim delim_ + with | None -> assert false | Some delim -> delim in @@ -145441,6 +145464,9 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false +let is_uncurried_app (attr : attr) = + match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false + let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty) let bs_get_index : attr = @@ -150465,8 +150491,9 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) }) | _ -> ( match - ( Ext_list.exclude_with_val f_.pexp_attributes - Ast_attributes.is_bs, + ( Ext_list.exclude_with_val f_.pexp_attributes (fun a -> + Ast_attributes.is_bs a + || Ast_attributes.is_uncurried_app a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -150480,8 +150507,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) fn1.pexp_attributes; { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op="|.") e.pexp_loc self fn1 - ((Nolabel, a) :: args); + Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op = "|.") + e.pexp_loc self fn1 ((Nolabel, a) :: args); pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; } @@ -150490,7 +150517,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Uncurried unary application *) { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:false e.pexp_loc self f + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false + e.pexp_loc self f [ (Nolabel, a) ]; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes; @@ -150590,14 +150618,28 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) match Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs with - | None -> default_expr_mapper self e | Some pexp_attributes -> { e with pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc self fn args; + Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc + self fn args; pexp_attributes; - })) + } + | None -> ( + match + Ext_list.exclude_with_val e.pexp_attributes + Ast_attributes.is_uncurried_app + with + | Some pexp_attributes -> + { + e with + pexp_desc = + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false + e.pexp_loc self fn args; + pexp_attributes; + } + | None -> default_expr_mapper self e))) end module Ast_exp : sig diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 2e002e0bc7..4ccbeff3d9 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -49432,6 +49432,9 @@ val functorType : (* filters @bs out of the provided attributes *) val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val processUncurriedAppAttribute : + Parsetree.attributes -> bool * Parsetree.attributes + type functionAttributesInfo = { async: bool; bs: bool; @@ -49633,6 +49636,21 @@ let processBsAttribute attrs = in process false [] attrs +let processUncurriedAppAttribute attrs = + let rec process bsSpotted acc attrs = + match attrs with + | [] -> (bsSpotted, List.rev acc) + | ( { + Location.txt = + "bs" (* still support @bs to convert .ml files *) | "res.uapp"; + }, + _ ) + :: rest -> + process true acc rest + | attr :: rest -> process bsSpotted (attr :: acc) rest + in + process false [] attrs + type functionAttributesInfo = { async: bool; bs: bool; @@ -49762,7 +49780,7 @@ let filterParsingAttrs attrs = match attr with | ( { Location.txt = - ( "bs" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc" + ( "bs" | "res.uapp" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc" | "ns.optional" | "ns.ternary" | "res.async" | "res.await" | "res.template" ); }, @@ -49911,8 +49929,8 @@ let hasAttributes attrs = match attr with | ( { Location.txt = - ( "bs" | "ns.braces" | "ns.iflet" | "ns.ternary" | "res.async" - | "res.await" | "res.template" ); + ( "bs" | "res.uapp" | "ns.braces" | "ns.iflet" | "ns.ternary" + | "res.async" | "res.await" | "res.template" ); }, _ ) -> false @@ -50093,8 +50111,8 @@ let isPrintableAttribute attr = match attr with | ( { Location.txt = - ( "bs" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" | "res.await" - | "res.template" | "ns.ternary" ); + ( "bs" | "res.uapp" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" + | "res.await" | "res.template" | "ns.ternary" ); }, _ ) -> false @@ -57064,7 +57082,7 @@ and printPexpApply ~state expr cmtTbl = args in let hasBs, attrs = - ParsetreeViewer.processBsAttribute expr.pexp_attributes + ParsetreeViewer.processUncurriedAppAttribute expr.pexp_attributes in let dotted = if state.State.uncurried_by_default then not hasBs else hasBs @@ -145082,6 +145100,8 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) +val is_uncurried_app : attr -> bool + val bs_get : attr val bs_get_index : attr @@ -145408,9 +145428,12 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = _; }; ] - when Ast_utf8_string_interp.parse_processed_delim delim_ <> None -> ( + when Ast_utf8_string_interp.parse_processed_delim delim_ + <> None -> ( let delim = - match Ast_utf8_string_interp.parse_processed_delim delim_ with + match + Ast_utf8_string_interp.parse_processed_delim delim_ + with | None -> assert false | Some delim -> delim in @@ -145441,6 +145464,9 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false +let is_uncurried_app (attr : attr) = + match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false + let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty) let bs_get_index : attr = @@ -150465,8 +150491,9 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) }) | _ -> ( match - ( Ext_list.exclude_with_val f_.pexp_attributes - Ast_attributes.is_bs, + ( Ext_list.exclude_with_val f_.pexp_attributes (fun a -> + Ast_attributes.is_bs a + || Ast_attributes.is_uncurried_app a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -150480,8 +150507,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) fn1.pexp_attributes; { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op="|.") e.pexp_loc self fn1 - ((Nolabel, a) :: args); + Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op = "|.") + e.pexp_loc self fn1 ((Nolabel, a) :: args); pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; } @@ -150490,7 +150517,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Uncurried unary application *) { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:false e.pexp_loc self f + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false + e.pexp_loc self f [ (Nolabel, a) ]; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes; @@ -150590,14 +150618,28 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) match Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs with - | None -> default_expr_mapper self e | Some pexp_attributes -> { e with pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc self fn args; + Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc + self fn args; pexp_attributes; - })) + } + | None -> ( + match + Ext_list.exclude_with_val e.pexp_attributes + Ast_attributes.is_uncurried_app + with + | Some pexp_attributes -> + { + e with + pexp_desc = + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false + e.pexp_loc self fn args; + pexp_attributes; + } + | None -> default_expr_mapper self e))) end module Ast_exp : sig @@ -162559,7 +162601,7 @@ module ErrorMessages = struct end let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr []) -let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr []) +let uncurriedAppAttr = (Location.mknoloc "res.uapp", Parsetree.PStr []) let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr []) let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr []) let optionalAttr = (Location.mknoloc "ns.optional", Parsetree.PStr []) @@ -164007,7 +164049,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - let attrs = if uncurried then uncurryAttr :: attrs else attrs in + let attrs = if uncurried then uncurriedAppAttr :: attrs else attrs in ( paramNum - 1, makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity )) @@ -166076,7 +166118,7 @@ and parseCallExpr p funExpr = if p.uncurried_by_default then not dotted else dotted in if uncurried then - let attrs = [uncurryAttr] in + let attrs = [uncurriedAppAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args else Ast_helper.Exp.apply ~loc callBody args in diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 268dbc900b..d2b30e8f50 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -104430,6 +104430,9 @@ val functorType : (* filters @bs out of the provided attributes *) val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val processUncurriedAppAttribute : + Parsetree.attributes -> bool * Parsetree.attributes + type functionAttributesInfo = { async: bool; bs: bool; @@ -104631,6 +104634,21 @@ let processBsAttribute attrs = in process false [] attrs +let processUncurriedAppAttribute attrs = + let rec process bsSpotted acc attrs = + match attrs with + | [] -> (bsSpotted, List.rev acc) + | ( { + Location.txt = + "bs" (* still support @bs to convert .ml files *) | "res.uapp"; + }, + _ ) + :: rest -> + process true acc rest + | attr :: rest -> process bsSpotted (attr :: acc) rest + in + process false [] attrs + type functionAttributesInfo = { async: bool; bs: bool; @@ -104760,7 +104778,7 @@ let filterParsingAttrs attrs = match attr with | ( { Location.txt = - ( "bs" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc" + ( "bs" | "res.uapp" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc" | "ns.optional" | "ns.ternary" | "res.async" | "res.await" | "res.template" ); }, @@ -104909,8 +104927,8 @@ let hasAttributes attrs = match attr with | ( { Location.txt = - ( "bs" | "ns.braces" | "ns.iflet" | "ns.ternary" | "res.async" - | "res.await" | "res.template" ); + ( "bs" | "res.uapp" | "ns.braces" | "ns.iflet" | "ns.ternary" + | "res.async" | "res.await" | "res.template" ); }, _ ) -> false @@ -105091,8 +105109,8 @@ let isPrintableAttribute attr = match attr with | ( { Location.txt = - ( "bs" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" | "res.await" - | "res.template" | "ns.ternary" ); + ( "bs" | "res.uapp" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" + | "res.await" | "res.template" | "ns.ternary" ); }, _ ) -> false @@ -112062,7 +112080,7 @@ and printPexpApply ~state expr cmtTbl = args in let hasBs, attrs = - ParsetreeViewer.processBsAttribute expr.pexp_attributes + ParsetreeViewer.processUncurriedAppAttribute expr.pexp_attributes in let dotted = if state.State.uncurried_by_default then not hasBs else hasBs @@ -155366,6 +155384,8 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) +val is_uncurried_app : attr -> bool + val bs_get : attr val bs_get_index : attr @@ -155692,9 +155712,12 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = _; }; ] - when Ast_utf8_string_interp.parse_processed_delim delim_ <> None -> ( + when Ast_utf8_string_interp.parse_processed_delim delim_ + <> None -> ( let delim = - match Ast_utf8_string_interp.parse_processed_delim delim_ with + match + Ast_utf8_string_interp.parse_processed_delim delim_ + with | None -> assert false | Some delim -> delim in @@ -155725,6 +155748,9 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false +let is_uncurried_app (attr : attr) = + match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false + let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty) let bs_get_index : attr = @@ -160749,8 +160775,9 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) }) | _ -> ( match - ( Ext_list.exclude_with_val f_.pexp_attributes - Ast_attributes.is_bs, + ( Ext_list.exclude_with_val f_.pexp_attributes (fun a -> + Ast_attributes.is_bs a + || Ast_attributes.is_uncurried_app a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -160764,8 +160791,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) fn1.pexp_attributes; { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op="|.") e.pexp_loc self fn1 - ((Nolabel, a) :: args); + Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op = "|.") + e.pexp_loc self fn1 ((Nolabel, a) :: args); pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; } @@ -160774,7 +160801,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Uncurried unary application *) { pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:false e.pexp_loc self f + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false + e.pexp_loc self f [ (Nolabel, a) ]; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes; @@ -160874,14 +160902,28 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) match Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs with - | None -> default_expr_mapper self e | Some pexp_attributes -> { e with pexp_desc = - Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc self fn args; + Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc + self fn args; pexp_attributes; - })) + } + | None -> ( + match + Ext_list.exclude_with_val e.pexp_attributes + Ast_attributes.is_uncurried_app + with + | Some pexp_attributes -> + { + e with + pexp_desc = + Ast_uncurry_apply.uncurry_fn_apply ~arity0:false + e.pexp_loc self fn args; + pexp_attributes; + } + | None -> default_expr_mapper self e))) end module Ast_exp : sig @@ -175991,7 +176033,7 @@ module ErrorMessages = struct end let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr []) -let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr []) +let uncurriedAppAttr = (Location.mknoloc "res.uapp", Parsetree.PStr []) let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr []) let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr []) let optionalAttr = (Location.mknoloc "ns.optional", Parsetree.PStr []) @@ -177439,7 +177481,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - let attrs = if uncurried then uncurryAttr :: attrs else attrs in + let attrs = if uncurried then uncurriedAppAttr :: attrs else attrs in ( paramNum - 1, makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity )) @@ -179508,7 +179550,7 @@ and parseCallExpr p funExpr = if p.uncurried_by_default then not dotted else dotted in if uncurried then - let attrs = [uncurryAttr] in + let attrs = [uncurriedAppAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args else Ast_helper.Exp.apply ~loc callBody args in diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 138888c382..a294e55848 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -148,7 +148,7 @@ module ErrorMessages = struct end let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr []) -let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr []) +let uncurriedAppAttr = (Location.mknoloc "res.uapp", Parsetree.PStr []) let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr []) let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr []) let optionalAttr = (Location.mknoloc "ns.optional", Parsetree.PStr []) @@ -1596,7 +1596,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - let attrs = if uncurried then uncurryAttr :: attrs else attrs in + let attrs = if uncurried then uncurriedAppAttr :: attrs else attrs in ( paramNum - 1, makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity )) @@ -3665,7 +3665,7 @@ and parseCallExpr p funExpr = if p.uncurried_by_default then not dotted else dotted in if uncurried then - let attrs = [uncurryAttr] in + let attrs = [uncurriedAppAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args else Ast_helper.Exp.apply ~loc callBody args in diff --git a/res_syntax/src/res_parsetree_viewer.ml b/res_syntax/src/res_parsetree_viewer.ml index 0cfbed1141..cb2bf5bcc4 100644 --- a/res_syntax/src/res_parsetree_viewer.ml +++ b/res_syntax/src/res_parsetree_viewer.ml @@ -57,6 +57,21 @@ let processBsAttribute attrs = in process false [] attrs +let processUncurriedAppAttribute attrs = + let rec process bsSpotted acc attrs = + match attrs with + | [] -> (bsSpotted, List.rev acc) + | ( { + Location.txt = + "bs" (* still support @bs to convert .ml files *) | "res.uapp"; + }, + _ ) + :: rest -> + process true acc rest + | attr :: rest -> process bsSpotted (attr :: acc) rest + in + process false [] attrs + type functionAttributesInfo = { async: bool; bs: bool; @@ -186,7 +201,7 @@ let filterParsingAttrs attrs = match attr with | ( { Location.txt = - ( "bs" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc" + ( "bs" | "res.uapp" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc" | "ns.optional" | "ns.ternary" | "res.async" | "res.await" | "res.template" ); }, @@ -335,8 +350,8 @@ let hasAttributes attrs = match attr with | ( { Location.txt = - ( "bs" | "ns.braces" | "ns.iflet" | "ns.ternary" | "res.async" - | "res.await" | "res.template" ); + ( "bs" | "res.uapp" | "ns.braces" | "ns.iflet" | "ns.ternary" + | "res.async" | "res.await" | "res.template" ); }, _ ) -> false @@ -517,8 +532,8 @@ let isPrintableAttribute attr = match attr with | ( { Location.txt = - ( "bs" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" | "res.await" - | "res.template" | "ns.ternary" ); + ( "bs" | "res.uapp" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" + | "res.await" | "res.template" | "ns.ternary" ); }, _ ) -> false diff --git a/res_syntax/src/res_parsetree_viewer.mli b/res_syntax/src/res_parsetree_viewer.mli index 7d513d8339..e41b692482 100644 --- a/res_syntax/src/res_parsetree_viewer.mli +++ b/res_syntax/src/res_parsetree_viewer.mli @@ -17,6 +17,9 @@ val functorType : (* filters @bs out of the provided attributes *) val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val processUncurriedAppAttribute : + 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 1e700b9f5e..e3793f7f1b 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -3953,7 +3953,7 @@ and printPexpApply ~state expr cmtTbl = args in let hasBs, attrs = - ParsetreeViewer.processBsAttribute expr.pexp_attributes + ParsetreeViewer.processUncurriedAppAttribute expr.pexp_attributes in let dotted = if state.State.uncurried_by_default then not hasBs else hasBs diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt index aff8d8dac9..6cc9900c20 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -1,5 +1,5 @@ let cApp = foo 3 -let uApp = ((foo 3)[@bs ]) +let uApp = ((foo 3)[@res.uapp ]) let cFun x = 3 let uFun = { Js.Fn.I1 = (fun x -> 3) } let mixFun a = @@ -33,11 +33,11 @@ type nonrec cpp = unit -> unit -> int type nonrec cu2 = unit -> unit -> unit type nonrec cp2 = unit -> unit -> unit type nonrec uu = (unit -> int) Js.Fn.arity1 -type nonrec up = int Js.Fn.arity0 +type nonrec up = (unit -> int) Js.Fn.arity1 type nonrec uuu = (unit -> (unit -> int) Js.Fn.arity1) Js.Fn.arity1 -type nonrec upu = (unit -> int) Js.Fn.arity1 Js.Fn.arity0 -type nonrec uup = (unit -> int Js.Fn.arity0) Js.Fn.arity1 -type nonrec upp = int Js.Fn.arity0 Js.Fn.arity0 +type nonrec upu = (unit -> (unit -> int) Js.Fn.arity1) Js.Fn.arity1 +type nonrec uup = (unit -> (unit -> int) Js.Fn.arity1) Js.Fn.arity1 +type nonrec upp = (unit -> (unit -> int) Js.Fn.arity1) Js.Fn.arity1 type nonrec uu2 = (unit -> unit -> unit) Js.Fn.arity2 type nonrec up2 = (unit -> unit -> unit) Js.Fn.arity2 type nonrec cnested = (string -> unit) -> unit @@ -50,7 +50,7 @@ let _ = preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@att ]) } let _ = preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@res.async ][@att ]) } [@@@uncurried ] let cApp = foo 3 -let uApp = ((foo 3)[@bs ]) +let uApp = ((foo 3)[@res.uapp ]) let cFun x = 3 let uFun = { Js.Fn.I1 = (fun x -> 3) } let mixFun a = @@ -85,11 +85,11 @@ type nonrec cpp = unit -> unit -> int type nonrec cu2 = unit -> unit -> unit type nonrec cp2 = unit -> unit -> unit type nonrec uu = (unit -> int) Js.Fn.arity1 -type nonrec up = int Js.Fn.arity0 +type nonrec up = (unit -> int) Js.Fn.arity1 type nonrec uuu = (unit -> (unit -> int) Js.Fn.arity1) Js.Fn.arity1 -type nonrec upu = (unit -> int) Js.Fn.arity1 Js.Fn.arity0 -type nonrec uup = (unit -> int Js.Fn.arity0) Js.Fn.arity1 -type nonrec upp = int Js.Fn.arity0 Js.Fn.arity0 +type nonrec upu = (unit -> (unit -> int) Js.Fn.arity1) Js.Fn.arity1 +type nonrec uup = (unit -> (unit -> int) Js.Fn.arity1) Js.Fn.arity1 +type nonrec upp = (unit -> (unit -> int) Js.Fn.arity1) Js.Fn.arity1 type nonrec uu2 = (unit -> unit -> unit) Js.Fn.arity2 type nonrec up2 = (unit -> unit -> unit) Js.Fn.arity2 type nonrec cnested = (string -> unit) -> unit @@ -99,6 +99,9 @@ let (uannpoly : ('a -> string) Js.Fn.arity1) = xx let (uannint : (int -> string) Js.Fn.arity1) = xx let _ = { Js.Fn.I1 = ((fun x -> 34)[@att ]) } let _ = { Js.Fn.I1 = ((fun x -> 34)[@res.async ][@att ]) } -let _ = ((preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@att ]) })[@bs ]) +let _ = ((preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@att ]) })[@res.uapp ]) let _ = ((preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@res.async ][@att ]) }) - [@bs ]) \ No newline at end of file + [@res.uapp ]) +let (foo : (unit -> string) Js.Fn.arity1) = + { Js.Fn.I1 = (fun () -> {js|abc|js}) } +let s = ((foo ())[@res.uapp ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt index d9a01f8f05..df4d3772fe 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt @@ -4,5 +4,5 @@ ;;foo (fun _ -> bla) (fun _ -> blaz) ;;List.map (fun x -> x + 1) myList ;;List.reduce (fun acc -> fun curr -> acc + curr) 0 myList -let unitUncurried = ((apply ())[@bs ]) +let unitUncurried = ((apply ())[@res.uapp ]) ;;call ~a:(((((a)[@ns.namedArgLoc ]) : int))[@ns.namedArgLoc ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt index bac3de888f..95177eac2c 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/argument.res.txt @@ -1,13 +1,13 @@ let foo ~a:((a)[@ns.namedArgLoc ]) = - ((a (let __res_unit = () in __res_unit))[@bs ]) +. 1. + ((a (let __res_unit = () in __res_unit))[@res.uapp ]) +. 1. let a = { Js.Fn.I1 = (fun () -> 2) } let bar = foo ~a:((a)[@ns.namedArgLoc ]) let comparisonResult = ((compare currentNode.value ~targetValue:((targetValue)[@ns.namedArgLoc ])) - [@bs ]) -;;((callback firstNode ~y:((y)[@ns.namedArgLoc ]))[@bs ]) + [@res.uapp ]) +;;((callback firstNode ~y:((y)[@ns.namedArgLoc ]))[@res.uapp ]) ;;((document.createElementWithOptions {js|div|js} (elementProps ~onClick:((fun _ -> Js.log {js|hello world|js}) - [@ns.namedArgLoc ])))[@bs ]) -;;((resolve ())[@bs ]) -;;((resolve (let __res_unit = () in __res_unit))[@bs ]) \ No newline at end of file + [@ns.namedArgLoc ])))[@res.uapp ]) +;;((resolve ())[@res.uapp ]) +;;((resolve (let __res_unit = () in __res_unit))[@res.uapp ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/async.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/async.res.txt index 5d01cdb04a..b3af84f96a 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/async.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/async.res.txt @@ -1,16 +1,23 @@ let greetUser = ((fun userId -> - ((let name = ((getUserName userId)[@res.await ][@bs ]) in + ((let name = ((getUserName userId)[@res.await ][@res.uapp ]) in ({js|Hello |js} ^ name) ^ {js|!|js}) [@ns.braces ])) [@res.async ]) ;;((fun () -> 123)[@res.async ]) let fetch = - (({ Js.Fn.I1 = ((fun url -> ((browserFetch url)[@bs ]))[@res.async ]) }) + (({ Js.Fn.I1 = ((fun url -> ((browserFetch url)[@res.uapp ]))[@res.async ]) + }) [@ns.braces ]) let fetch2 = - (({ Js.Fn.I1 = (((fun url -> ((browserFetch url)[@bs ])))[@res.async ]) }; - { Js.Fn.I1 = (((fun url -> ((browserFetch2 url)[@bs ])))[@res.async ]) }) + (({ + Js.Fn.I1 = (((fun url -> ((browserFetch url)[@res.uapp ]))) + [@res.async ]) + }; + { + Js.Fn.I1 = (((fun url -> ((browserFetch2 url)[@res.uapp ]))) + [@res.async ]) + }) [@ns.braces ]) let async = ((let f = async () in diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/binary.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/binary.res.txt index 3319ffda1a..ef4bc8252d 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/binary.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/binary.res.txt @@ -20,5 +20,5 @@ let x = a -. b ;;Constructor (a, b) ;;`Constructor (a, b) let _ = ((Constructor (a, b); `Constructor (a, b))[@ns.braces ]) -;;((library.getBalance account)[@bs ]) |. +;;((library.getBalance account)[@res.uapp ]) |. (Promise.Js.catch (fun _ -> ((Promise.resolved None)[@ns.braces ]))) \ No newline at end of file diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt index 290944856f..1d22121439 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt @@ -30,5 +30,5 @@ let f = fun ((b)[@attr2 ]) -> { Js.Fn.I2 = (fun ((c)[@attr3 ]) -> fun ((d)[@attr4 ]) -> ()) }) } -;;((add 1 2)[@bs ]) -;;((((((add 2 3 4)[@bs ]) 5 6 7)[@bs ]) 8 9 10)[@bs ]) \ No newline at end of file +;;((add 1 2)[@res.uapp ]) +;;((((((add 2 3 4)[@res.uapp ]) 5 6 7)[@res.uapp ]) 8 9 10)[@res.uapp ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/infiniteLoops/expected/equalAfterBinaryExpr.res.txt b/res_syntax/tests/parsing/infiniteLoops/expected/equalAfterBinaryExpr.res.txt index f0e099c408..ac367d67b3 100644 --- a/res_syntax/tests/parsing/infiniteLoops/expected/equalAfterBinaryExpr.res.txt +++ b/res_syntax/tests/parsing/infiniteLoops/expected/equalAfterBinaryExpr.res.txt @@ -151,6 +151,6 @@ let removeNode rbt node = ((sibling.left |. castNotOption).color <- Black; rotateLeft rbt successorParent)))) done)); - if ((isLeaf successor)[@bs ]) + if ((isLeaf successor)[@res.uapp ]) then (if (rbt |. root) == (Some successor) then (rbt |. root) = None)) [@ns.braces ]) \ No newline at end of file diff --git a/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt b/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt index 53f278cc9a..ae2bb486a9 100644 --- a/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt +++ b/res_syntax/tests/parsing/recovery/expression/expected/infinite.res.txt @@ -1 +1 @@ -let smallest = ((heap.compare ())[@bs ]) < (a |. (f b)) \ No newline at end of file +let smallest = ((heap.compare ())[@res.uapp ]) < (a |. (f b)) \ No newline at end of file From 94dfb8c406427e458e07bf64f517cb58fb14840a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 19 Nov 2022 10:31:22 +0100 Subject: [PATCH 5/7] Clean up test. --- .../tests/parsing/grammar/expressions/UncurriedByDefault.res | 4 ---- .../grammar/expressions/expected/UncurriedByDefault.res.txt | 5 +---- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 881094a59a..3b61aa41ac 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -90,7 +90,3 @@ let _ = @att x => 34 let _ = @att async x => 34 let _ = preserveAttr(@att x => 34) let _ = preserveAttr(@att async x => 34) - -let foo : unit =>string = () => "abc" - -let s = foo() diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt index 6cc9900c20..1c585d60e5 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -101,7 +101,4 @@ let _ = { Js.Fn.I1 = ((fun x -> 34)[@att ]) } let _ = { Js.Fn.I1 = ((fun x -> 34)[@res.async ][@att ]) } let _ = ((preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@att ]) })[@res.uapp ]) let _ = ((preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@res.async ][@att ]) }) - [@res.uapp ]) -let (foo : (unit -> string) Js.Fn.arity1) = - { Js.Fn.I1 = (fun () -> {js|abc|js}) } -let s = ((foo ())[@res.uapp ]) \ No newline at end of file + [@res.uapp ]) \ No newline at end of file From 4e3083c9af47e61f04154d3f9bbba430d12ed408 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 19 Nov 2022 10:34:57 +0100 Subject: [PATCH 6/7] rename --- jscomp/frontend/ast_attributes.ml | 2 +- jscomp/frontend/ast_attributes.mli | 3 ++- jscomp/frontend/ast_exp_apply.ml | 4 ++-- lib/4.06.1/unstable/js_compiler.ml | 9 +++++---- lib/4.06.1/unstable/js_playground_compiler.ml | 9 +++++---- lib/4.06.1/whole_compiler.ml | 9 +++++---- 6 files changed, 20 insertions(+), 16 deletions(-) diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index b22b8fbb5d..957ba112d2 100644 --- a/jscomp/frontend/ast_attributes.ml +++ b/jscomp/frontend/ast_attributes.ml @@ -341,7 +341,7 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false -let is_uncurried_app (attr : attr) = +let is_res_uapp (attr : attr) = match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty) diff --git a/jscomp/frontend/ast_attributes.mli b/jscomp/frontend/ast_attributes.mli index 8f86ecd79a..15b780a8fe 100644 --- a/jscomp/frontend/ast_attributes.mli +++ b/jscomp/frontend/ast_attributes.mli @@ -72,7 +72,8 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) -val is_uncurried_app : attr -> bool +(* Attribute for uncurried application coming from the ReScript parser *) +val is_res_uapp : attr -> bool val bs_get : attr diff --git a/jscomp/frontend/ast_exp_apply.ml b/jscomp/frontend/ast_exp_apply.ml index 9fd18c03f2..1ec8148298 100644 --- a/jscomp/frontend/ast_exp_apply.ml +++ b/jscomp/frontend/ast_exp_apply.ml @@ -160,7 +160,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) match ( Ext_list.exclude_with_val f_.pexp_attributes (fun a -> Ast_attributes.is_bs a - || Ast_attributes.is_uncurried_app a), + || Ast_attributes.is_res_uapp a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -296,7 +296,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) | None -> ( match Ext_list.exclude_with_val e.pexp_attributes - Ast_attributes.is_uncurried_app + Ast_attributes.is_res_uapp with | Some pexp_attributes -> { diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 0a0e525490..dc4736fcd8 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -145100,7 +145100,8 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) -val is_uncurried_app : attr -> bool +(* Attribute for uncurried application coming from the ReScript parser *) +val is_res_uapp : attr -> bool val bs_get : attr @@ -145464,7 +145465,7 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false -let is_uncurried_app (attr : attr) = +let is_res_uapp (attr : attr) = match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty) @@ -150493,7 +150494,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) match ( Ext_list.exclude_with_val f_.pexp_attributes (fun a -> Ast_attributes.is_bs a - || Ast_attributes.is_uncurried_app a), + || Ast_attributes.is_res_uapp a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -150629,7 +150630,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) | None -> ( match Ext_list.exclude_with_val e.pexp_attributes - Ast_attributes.is_uncurried_app + Ast_attributes.is_res_uapp with | Some pexp_attributes -> { diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 4ccbeff3d9..e770e16478 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -145100,7 +145100,8 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) -val is_uncurried_app : attr -> bool +(* Attribute for uncurried application coming from the ReScript parser *) +val is_res_uapp : attr -> bool val bs_get : attr @@ -145464,7 +145465,7 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false -let is_uncurried_app (attr : attr) = +let is_res_uapp (attr : attr) = match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty) @@ -150493,7 +150494,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) match ( Ext_list.exclude_with_val f_.pexp_attributes (fun a -> Ast_attributes.is_bs a - || Ast_attributes.is_uncurried_app a), + || Ast_attributes.is_res_uapp a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -150629,7 +150630,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) | None -> ( match Ext_list.exclude_with_val e.pexp_attributes - Ast_attributes.is_uncurried_app + Ast_attributes.is_res_uapp with | Some pexp_attributes -> { diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index d2b30e8f50..66f6cbe8ed 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -155384,7 +155384,8 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) -val is_uncurried_app : attr -> bool +(* Attribute for uncurried application coming from the ReScript parser *) +val is_res_uapp : attr -> bool val bs_get : attr @@ -155748,7 +155749,7 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false -let is_uncurried_app (attr : attr) = +let is_res_uapp (attr : attr) = match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty) @@ -160777,7 +160778,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) match ( Ext_list.exclude_with_val f_.pexp_attributes (fun a -> Ast_attributes.is_bs a - || Ast_attributes.is_uncurried_app a), + || Ast_attributes.is_res_uapp a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -160913,7 +160914,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) | None -> ( match Ext_list.exclude_with_val e.pexp_attributes - Ast_attributes.is_uncurried_app + Ast_attributes.is_res_uapp with | Some pexp_attributes -> { From c0aeef94a74b41574de8fa544baacab33df2fbee Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 19 Nov 2022 10:38:15 +0100 Subject: [PATCH 7/7] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0320ca9b1e..f603f2ce72 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,7 +20,7 @@ - Add support for partial application of uncurried functions: with uncurried application one can provide a subset of the arguments, and return a curried type with the remaining ones https://github.com/rescript-lang/rescript-compiler/pull/5805 - Add support for uncurried externals https://github.com/rescript-lang/rescript-compiler/pull/5815 https://github.com/rescript-lang/rescript-compiler/pull/5819 -- Unify uncurried functions of arity 0 with functions of arity 1 taking unit. They're now equivalent. https://github.com/rescript-lang/rescript-compiler/pull/5825 +- Parser/Printer: unify uncurried functions of arity 0, and of arity 1 taking unit. There's now only arity 1 in the source language. https://github.com/rescript-lang/rescript-compiler/pull/5825 #### :boom: Breaking Change