diff --git a/CHANGELOG.md b/CHANGELOG.md index d87c86130b..f603f2ce72 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 +- 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 @@ -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 diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index e64a32ae2e..957ba112d2 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_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) let bs_get_index : attr = diff --git a/jscomp/frontend/ast_attributes.mli b/jscomp/frontend/ast_attributes.mli index 85b84adbed..15b780a8fe 100644 --- a/jscomp/frontend/ast_attributes.mli +++ b/jscomp/frontend/ast_attributes.mli @@ -72,6 +72,9 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) +(* Attribute for uncurried application coming from the ReScript parser *) +val is_res_uapp : 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 d909647372..1ec8148298 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_res_uapp 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 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 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 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_res_uapp + 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/frontend/ast_uncurry_apply.ml b/jscomp/frontend/ast_uncurry_apply.ml index 1032974506..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,7 +58,8 @@ 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 -> [] | _ -> args in @@ -128,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/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..befcde30a8 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 : (. unit) => 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() 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..dc4736fcd8 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 @@ -54768,12 +54786,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" -> @@ -57070,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 @@ -145088,6 +145100,9 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) +(* Attribute for uncurried application coming from the ReScript parser *) +val is_res_uapp : attr -> bool + val bs_get : attr val bs_get_index : attr @@ -145414,9 +145429,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 @@ -145447,6 +145465,9 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false +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) let bs_get_index : attr = @@ -148420,6 +148441,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 -> @@ -148493,8 +148515,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) -> @@ -148506,7 +148529,8 @@ 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 -> [] | _ -> args in @@ -148577,11 +148601,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 @@ -150468,8 +150492,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_res_uapp a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -150483,8 +150508,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 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; } @@ -150493,7 +150518,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 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; @@ -150593,14 +150619,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 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_res_uapp + 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 1f44615640..e770e16478 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 @@ -54768,12 +54786,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" -> @@ -57070,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 @@ -145088,6 +145100,9 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) +(* Attribute for uncurried application coming from the ReScript parser *) +val is_res_uapp : attr -> bool + val bs_get : attr val bs_get_index : attr @@ -145414,9 +145429,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 @@ -145447,6 +145465,9 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false +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) let bs_get_index : attr = @@ -148420,6 +148441,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 -> @@ -148493,8 +148515,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) -> @@ -148506,7 +148529,8 @@ 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 -> [] | _ -> args in @@ -148577,11 +148601,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 @@ -150468,8 +150492,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_res_uapp a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -150483,8 +150508,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 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; } @@ -150493,7 +150518,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 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; @@ -150593,14 +150619,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 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_res_uapp + 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 @@ -162562,7 +162602,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 []) @@ -163990,11 +164030,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 +164037,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 ); @@ -164016,7 +164050,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 )) @@ -166085,7 +166119,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 @@ -166674,23 +166708,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..66f6cbe8ed 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 @@ -109766,12 +109784,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" -> @@ -112068,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 @@ -155372,6 +155384,9 @@ val is_bs : attr -> bool (* val is_optional : attr -> bool val is_bs_as : attr -> bool *) +(* Attribute for uncurried application coming from the ReScript parser *) +val is_res_uapp : attr -> bool + val bs_get : attr val bs_get_index : attr @@ -155698,9 +155713,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 @@ -155731,6 +155749,9 @@ let locg = Location.none let is_bs (attr : attr) = match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false +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) let bs_get_index : attr = @@ -158704,6 +158725,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 -> @@ -158777,8 +158799,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) -> @@ -158790,7 +158813,8 @@ 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 -> [] | _ -> args in @@ -158861,11 +158885,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 @@ -160752,8 +160776,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_res_uapp a), f_.pexp_desc ) with | Some other_attributes, Pexp_apply (fn1, args) -> @@ -160767,8 +160792,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 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; } @@ -160777,7 +160802,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 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; @@ -160877,14 +160903,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 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_res_uapp + 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 @@ -175994,7 +176034,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 []) @@ -177422,11 +177462,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 +177469,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 ); @@ -177448,7 +177482,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 )) @@ -179517,7 +179551,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 @@ -180106,23 +180140,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..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 []) @@ -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 ); @@ -1602,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 )) @@ -3671,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 @@ -4260,23 +4254,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_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 54c246f2ab..e3793f7f1b 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" -> @@ -3959,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..1c585d60e5 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,6 @@ 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 ]) \ 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 2f12cf4e4e..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. -let a = { Js.Fn.I0 = (fun () -> 2) } + ((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/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/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/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/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 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