From 5625955ed59eff659ea460828cf91a6994b9a684 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 14 Nov 2022 13:10:11 +0100 Subject: [PATCH] Add support for unary uncurried pipe in uncurried mode In normal mode, there is syntax for unary curried pipe (`x->f`) but not for unary uncurried. In uncurried mode, after this PR, unary uncurried pipe is supported in uncurried mode (still `x->f`). --- CHANGELOG.md | 1 + jscomp/frontend/ast_exp_apply.ml | 14 ++++++- jscomp/test/uncurried_pipe.js | 10 ++++- jscomp/test/uncurried_pipe.res | 4 ++ lib/4.06.1/unstable/js_compiler.ml | 39 +++++++++++------ lib/4.06.1/unstable/js_playground_compiler.ml | 42 ++++++++++++------- lib/4.06.1/whole_compiler.ml | 42 ++++++++++++------- res_syntax/src/res_comments_table.ml | 2 +- res_syntax/src/res_core.ml | 3 +- res_syntax/src/res_parsetree_viewer.ml | 8 ++-- res_syntax/src/res_printer.ml | 15 ++++--- .../expressions/UncurriedByDefault.res | 2 + .../expected/UncurriedByDefault.res.txt | 3 +- .../tests/printer/expr/UncurriedByDefault.res | 4 ++ .../expr/expected/UncurriedByDefault.res.txt | 4 ++ 15 files changed, 136 insertions(+), 57 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e2ec07fc15..6c47f0161b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,7 @@ - Introduce experimental uncurried by default mode. Can be turned on mid-file by adding standalone annotation `@@uncurried`. For experimentation only. https://github.com/rescript-lang/rescript-compiler/pull/5796 - Adding `@@toUncurried` to the file and reformat will convert to uncurried syntax https://github.com/rescript-lang/rescript-compiler/pull/5800 +- Add support for unary uncurried pipe in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/5804 #### :boom: Breaking Change diff --git a/jscomp/frontend/ast_exp_apply.ml b/jscomp/frontend/ast_exp_apply.ml index a5d7b4cce1..d909647372 100644 --- a/jscomp/frontend/ast_exp_apply.ml +++ b/jscomp/frontend/ast_exp_apply.ml @@ -70,7 +70,7 @@ let view_as_app (fn : exp) (s : string list) : app_pattern option = | _ -> None let inner_ops = [ "##"; "#@" ] -let infix_ops = [ "|."; "#="; "##" ] +let infix_ops = [ "|."; "|.u"; "#="; "##" ] let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) (args : Ast_compatible.args) : exp = @@ -95,7 +95,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Location.raise_errorf ~loc "%s expect f%sproperty arg0 arg2 form" op op | None -> ( match view_as_app e infix_ops with - | Some { op = "|."; args = [ a_; f_ ]; loc } -> ( + | Some { op = ("|." | "|.u") as op; args = [ a_; f_ ]; loc } -> ( (* a |. f a |. f b c [@bs] --> f a b c [@bs] @@ -178,6 +178,16 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; } + | _ when op = "|.u" -> + (* a |.u f + Uncurried unary application *) + { + pexp_desc = + Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self f + [ (Nolabel, a) ]; + pexp_loc = e.pexp_loc; + pexp_attributes = e.pexp_attributes; + } | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a)) | Some { op = "##"; loc; args = [ obj; rest ] } -> ( (* - obj##property diff --git a/jscomp/test/uncurried_pipe.js b/jscomp/test/uncurried_pipe.js index 6a049973a9..419c08ca24 100644 --- a/jscomp/test/uncurried_pipe.js +++ b/jscomp/test/uncurried_pipe.js @@ -17,13 +17,18 @@ var v27 = add(20, 7); var v37 = 30 + add(3, 4) | 0; +function unary(x) { + return x + 1 | 0; +} + var StandardNotation = { add: add, addC: addC, v7: v7, v17: v17, v27: v27, - v37: v37 + v37: v37, + unary: unary }; var v7$1 = add(3, 4); @@ -34,9 +39,12 @@ var v27$1 = add(20, 7); var v37$1 = 30 + add(3, 4) | 0; +var v100 = unary(99); + exports.StandardNotation = StandardNotation; exports.v7 = v7$1; exports.v17 = v17$1; exports.v27 = v27$1; exports.v37 = v37$1; +exports.v100 = v100; /* v7 Not a pure module */ diff --git a/jscomp/test/uncurried_pipe.res b/jscomp/test/uncurried_pipe.res index fe7bb4b9ec..3cd23ee883 100644 --- a/jscomp/test/uncurried_pipe.res +++ b/jscomp/test/uncurried_pipe.res @@ -6,6 +6,8 @@ module StandardNotation = { let v17 = 10->add(. 3->add(. 4)) let v27 = 20->add(. 3->addC(4)) let v37 = 30->addC(3->add(. 4)) + + let unary = (. x) => x + 1 } @@uncurried @@ -16,3 +18,5 @@ let v7 = 3->add(4) let v17 = 10->add(3->add(4)) let v27 = 20->add(3->addC(. 4)) let v37 = 30->addC(. 3->add(4)) + +let v100 = 99->unary diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 3956e6125d..3c74462f90 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -49796,7 +49796,7 @@ let operatorPrecedence operator = | "+" | "+." | "-" | "-." | "^" -> 5 | "*" | "*." | "/" | "/." -> 6 | "**" -> 7 - | "#" | "##" | "|." -> 8 + | "#" | "##" | "|." | "|.u" -> 8 | _ -> 0 let isUnaryOperator operator = @@ -49818,7 +49818,7 @@ let isBinaryOperator operator = match operator with | ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "^" | "*" | "*." | "/" | "/." | "**" | "|." - | "<>" -> + | "|.u" | "<>" -> true | _ -> false @@ -50184,14 +50184,14 @@ let isSinglePipeExpr expr = let isPipeExpr expr = match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>")}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, _operand1); (Nolabel, _operand2)] ) -> true | _ -> false in match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>")}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, operand1); (Nolabel, _operand2)] ) when not (isPipeExpr operand1) -> true @@ -51499,7 +51499,7 @@ and walkExpression expr t comments = Longident.Lident ( ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "++" | "^" - | "*" | "*." | "/" | "/." | "**" | "|." | "<>" ); + | "*" | "*." | "/" | "/." | "**" | "|." | "|.u" | "<>" ); }; }, [(Nolabel, operand1); (Nolabel, operand2)] ) -> @@ -56548,7 +56548,7 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = let printBinaryOperator ~inlineRhs operator = let operatorTxt = match operator with - | "|." -> "->" + | "|." | "|.u" -> "->" | "^" -> "++" | "=" -> "==" | "==" -> "===" @@ -56557,12 +56557,12 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = | txt -> txt in let spacingBeforeOperator = - if operator = "|." then Doc.softLine + if operator = "|." || operator = "|.u" then Doc.softLine else if operator = "|>" then Doc.line else Doc.space in let spacingAfterOperator = - if operator = "|." then Doc.nil + if operator = "|." || operator = "|.u" then Doc.nil else if operator = "|>" then Doc.space else if inlineRhs then Doc.space else Doc.line @@ -56712,7 +56712,10 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = in match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident (("|." | "|>") as op)}}, + ( { + pexp_desc = + Pexp_ident {txt = Longident.Lident (("|." | "|.u" | "|>") as op)}; + }, [(Nolabel, lhs); (Nolabel, rhs)] ) when not (ParsetreeViewer.isBinaryExpression lhs @@ -56727,8 +56730,8 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = printAttributes ~state expr.pexp_attributes cmtTbl; lhsDoc; (match (lhsHasCommentBelow, op) with - | true, "|." -> Doc.concat [Doc.softLine; Doc.text "->"] - | false, "|." -> Doc.text "->" + | true, ("|." | "|.u") -> Doc.concat [Doc.softLine; Doc.text "->"] + | false, ("|." | "|.u") -> Doc.text "->" | true, "|>" -> Doc.concat [Doc.line; Doc.text "|> "] | false, "|>" -> Doc.text " |> " | _ -> Doc.nil); @@ -150303,7 +150306,7 @@ let view_as_app (fn : exp) (s : string list) : app_pattern option = | _ -> None let inner_ops = [ "##"; "#@" ] -let infix_ops = [ "|."; "#="; "##" ] +let infix_ops = [ "|."; "|.u"; "#="; "##" ] let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) (args : Ast_compatible.args) : exp = @@ -150328,7 +150331,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Location.raise_errorf ~loc "%s expect f%sproperty arg0 arg2 form" op op | None -> ( match view_as_app e infix_ops with - | Some { op = "|."; args = [ a_; f_ ]; loc } -> ( + | Some { op = ("|." | "|.u") as op; args = [ a_; f_ ]; loc } -> ( (* a |. f a |. f b c [@bs] --> f a b c [@bs] @@ -150411,6 +150414,16 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; } + | _ when op = "|.u" -> + (* a |.u f + Uncurried unary application *) + { + pexp_desc = + Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self f + [ (Nolabel, a) ]; + pexp_loc = e.pexp_loc; + pexp_attributes = e.pexp_attributes; + } | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a)) | Some { op = "##"; loc; args = [ obj; rest ] } -> ( (* - obj##property diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index c5d0fcf644..91c0dcbee8 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -49796,7 +49796,7 @@ let operatorPrecedence operator = | "+" | "+." | "-" | "-." | "^" -> 5 | "*" | "*." | "/" | "/." -> 6 | "**" -> 7 - | "#" | "##" | "|." -> 8 + | "#" | "##" | "|." | "|.u" -> 8 | _ -> 0 let isUnaryOperator operator = @@ -49818,7 +49818,7 @@ let isBinaryOperator operator = match operator with | ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "^" | "*" | "*." | "/" | "/." | "**" | "|." - | "<>" -> + | "|.u" | "<>" -> true | _ -> false @@ -50184,14 +50184,14 @@ let isSinglePipeExpr expr = let isPipeExpr expr = match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>")}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, _operand1); (Nolabel, _operand2)] ) -> true | _ -> false in match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>")}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, operand1); (Nolabel, _operand2)] ) when not (isPipeExpr operand1) -> true @@ -51499,7 +51499,7 @@ and walkExpression expr t comments = Longident.Lident ( ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "++" | "^" - | "*" | "*." | "/" | "/." | "**" | "|." | "<>" ); + | "*" | "*." | "/" | "/." | "**" | "|." | "|.u" | "<>" ); }; }, [(Nolabel, operand1); (Nolabel, operand2)] ) -> @@ -56548,7 +56548,7 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = let printBinaryOperator ~inlineRhs operator = let operatorTxt = match operator with - | "|." -> "->" + | "|." | "|.u" -> "->" | "^" -> "++" | "=" -> "==" | "==" -> "===" @@ -56557,12 +56557,12 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = | txt -> txt in let spacingBeforeOperator = - if operator = "|." then Doc.softLine + if operator = "|." || operator = "|.u" then Doc.softLine else if operator = "|>" then Doc.line else Doc.space in let spacingAfterOperator = - if operator = "|." then Doc.nil + if operator = "|." || operator = "|.u" then Doc.nil else if operator = "|>" then Doc.space else if inlineRhs then Doc.space else Doc.line @@ -56712,7 +56712,10 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = in match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident (("|." | "|>") as op)}}, + ( { + pexp_desc = + Pexp_ident {txt = Longident.Lident (("|." | "|.u" | "|>") as op)}; + }, [(Nolabel, lhs); (Nolabel, rhs)] ) when not (ParsetreeViewer.isBinaryExpression lhs @@ -56727,8 +56730,8 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = printAttributes ~state expr.pexp_attributes cmtTbl; lhsDoc; (match (lhsHasCommentBelow, op) with - | true, "|." -> Doc.concat [Doc.softLine; Doc.text "->"] - | false, "|." -> Doc.text "->" + | true, ("|." | "|.u") -> Doc.concat [Doc.softLine; Doc.text "->"] + | false, ("|." | "|.u") -> Doc.text "->" | true, "|>" -> Doc.concat [Doc.line; Doc.text "|> "] | false, "|>" -> Doc.text " |> " | _ -> Doc.nil); @@ -150303,7 +150306,7 @@ let view_as_app (fn : exp) (s : string list) : app_pattern option = | _ -> None let inner_ops = [ "##"; "#@" ] -let infix_ops = [ "|."; "#="; "##" ] +let infix_ops = [ "|."; "|.u"; "#="; "##" ] let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) (args : Ast_compatible.args) : exp = @@ -150328,7 +150331,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Location.raise_errorf ~loc "%s expect f%sproperty arg0 arg2 form" op op | None -> ( match view_as_app e infix_ops with - | Some { op = "|."; args = [ a_; f_ ]; loc } -> ( + | Some { op = ("|." | "|.u") as op; args = [ a_; f_ ]; loc } -> ( (* a |. f a |. f b c [@bs] --> f a b c [@bs] @@ -150411,6 +150414,16 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; } + | _ when op = "|.u" -> + (* a |.u f + Uncurried unary application *) + { + pexp_desc = + Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self f + [ (Nolabel, a) ]; + pexp_loc = e.pexp_loc; + pexp_attributes = e.pexp_attributes; + } | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a)) | Some { op = "##"; loc; args = [ obj; rest ] } -> ( (* - obj##property @@ -162691,7 +162704,8 @@ let buildLongident words = let makeInfixOperator p token startPos endPos = let stringifiedToken = - if token = Token.MinusGreater then "|." + if token = Token.MinusGreater then + if p.Parser.uncurried_by_default then "|.u" else "|." else if token = Token.PlusPlus then "^" else if token = Token.BangEqual then "<>" else if token = Token.BangEqualEqual then "!=" diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 19c2f31d2b..7454d21dbe 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -104791,7 +104791,7 @@ let operatorPrecedence operator = | "+" | "+." | "-" | "-." | "^" -> 5 | "*" | "*." | "/" | "/." -> 6 | "**" -> 7 - | "#" | "##" | "|." -> 8 + | "#" | "##" | "|." | "|.u" -> 8 | _ -> 0 let isUnaryOperator operator = @@ -104813,7 +104813,7 @@ let isBinaryOperator operator = match operator with | ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "^" | "*" | "*." | "/" | "/." | "**" | "|." - | "<>" -> + | "|.u" | "<>" -> true | _ -> false @@ -105179,14 +105179,14 @@ let isSinglePipeExpr expr = let isPipeExpr expr = match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>")}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, _operand1); (Nolabel, _operand2)] ) -> true | _ -> false in match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>")}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, operand1); (Nolabel, _operand2)] ) when not (isPipeExpr operand1) -> true @@ -106494,7 +106494,7 @@ and walkExpression expr t comments = Longident.Lident ( ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "++" | "^" - | "*" | "*." | "/" | "/." | "**" | "|." | "<>" ); + | "*" | "*." | "/" | "/." | "**" | "|." | "|.u" | "<>" ); }; }, [(Nolabel, operand1); (Nolabel, operand2)] ) -> @@ -111543,7 +111543,7 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = let printBinaryOperator ~inlineRhs operator = let operatorTxt = match operator with - | "|." -> "->" + | "|." | "|.u" -> "->" | "^" -> "++" | "=" -> "==" | "==" -> "===" @@ -111552,12 +111552,12 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = | txt -> txt in let spacingBeforeOperator = - if operator = "|." then Doc.softLine + if operator = "|." || operator = "|.u" then Doc.softLine else if operator = "|>" then Doc.line else Doc.space in let spacingAfterOperator = - if operator = "|." then Doc.nil + if operator = "|." || operator = "|.u" then Doc.nil else if operator = "|>" then Doc.space else if inlineRhs then Doc.space else Doc.line @@ -111707,7 +111707,10 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = in match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident (("|." | "|>") as op)}}, + ( { + pexp_desc = + Pexp_ident {txt = Longident.Lident (("|." | "|.u" | "|>") as op)}; + }, [(Nolabel, lhs); (Nolabel, rhs)] ) when not (ParsetreeViewer.isBinaryExpression lhs @@ -111722,8 +111725,8 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = printAttributes ~state expr.pexp_attributes cmtTbl; lhsDoc; (match (lhsHasCommentBelow, op) with - | true, "|." -> Doc.concat [Doc.softLine; Doc.text "->"] - | false, "|." -> Doc.text "->" + | true, ("|." | "|.u") -> Doc.concat [Doc.softLine; Doc.text "->"] + | false, ("|." | "|.u") -> Doc.text "->" | true, "|>" -> Doc.concat [Doc.line; Doc.text "|> "] | false, "|>" -> Doc.text " |> " | _ -> Doc.nil); @@ -160587,7 +160590,7 @@ let view_as_app (fn : exp) (s : string list) : app_pattern option = | _ -> None let inner_ops = [ "##"; "#@" ] -let infix_ops = [ "|."; "#="; "##" ] +let infix_ops = [ "|."; "|.u"; "#="; "##" ] let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) (args : Ast_compatible.args) : exp = @@ -160612,7 +160615,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) Location.raise_errorf ~loc "%s expect f%sproperty arg0 arg2 form" op op | None -> ( match view_as_app e infix_ops with - | Some { op = "|."; args = [ a_; f_ ]; loc } -> ( + | Some { op = ("|." | "|.u") as op; args = [ a_; f_ ]; loc } -> ( (* a |. f a |. f b c [@bs] --> f a b c [@bs] @@ -160695,6 +160698,16 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ other_attributes; } + | _ when op = "|.u" -> + (* a |.u f + Uncurried unary application *) + { + pexp_desc = + Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self f + [ (Nolabel, a) ]; + pexp_loc = e.pexp_loc; + pexp_attributes = e.pexp_attributes; + } | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a)) | Some { op = "##"; loc; args = [ obj; rest ] } -> ( (* - obj##property @@ -176123,7 +176136,8 @@ let buildLongident words = let makeInfixOperator p token startPos endPos = let stringifiedToken = - if token = Token.MinusGreater then "|." + if token = Token.MinusGreater then + if p.Parser.uncurried_by_default then "|.u" else "|." else if token = Token.PlusPlus then "^" else if token = Token.BangEqual then "<>" else if token = Token.BangEqualEqual then "!=" diff --git a/res_syntax/src/res_comments_table.ml b/res_syntax/src/res_comments_table.ml index 3078505ba3..05148c7b27 100644 --- a/res_syntax/src/res_comments_table.ml +++ b/res_syntax/src/res_comments_table.ml @@ -1281,7 +1281,7 @@ and walkExpression expr t comments = Longident.Lident ( ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "++" | "^" - | "*" | "*." | "/" | "/." | "**" | "|." | "<>" ); + | "*" | "*." | "/" | "/." | "**" | "|." | "|.u" | "<>" ); }; }, [(Nolabel, operand1); (Nolabel, operand2)] ) -> diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 4720101cb4..f1bc8e2892 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -378,7 +378,8 @@ let buildLongident words = let makeInfixOperator p token startPos endPos = let stringifiedToken = - if token = Token.MinusGreater then "|." + if token = Token.MinusGreater then + if p.Parser.uncurried_by_default then "|.u" else "|." else if token = Token.PlusPlus then "^" else if token = Token.BangEqual then "<>" else if token = Token.BangEqualEqual then "!=" diff --git a/res_syntax/src/res_parsetree_viewer.ml b/res_syntax/src/res_parsetree_viewer.ml index 3b533d6953..fd9a26df50 100644 --- a/res_syntax/src/res_parsetree_viewer.ml +++ b/res_syntax/src/res_parsetree_viewer.ml @@ -255,7 +255,7 @@ let operatorPrecedence operator = | "+" | "+." | "-" | "-." | "^" -> 5 | "*" | "*." | "/" | "/." -> 6 | "**" -> 7 - | "#" | "##" | "|." -> 8 + | "#" | "##" | "|." | "|.u" -> 8 | _ -> 0 let isUnaryOperator operator = @@ -277,7 +277,7 @@ let isBinaryOperator operator = match operator with | ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "^" | "*" | "*." | "/" | "/." | "**" | "|." - | "<>" -> + | "|.u" | "<>" -> true | _ -> false @@ -643,14 +643,14 @@ let isSinglePipeExpr expr = let isPipeExpr expr = match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>")}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, _operand1); (Nolabel, _operand2)] ) -> true | _ -> false in match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>")}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, operand1); (Nolabel, _operand2)] ) when not (isPipeExpr operand1) -> true diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index d13d7b9d73..57b7da2393 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -3482,7 +3482,7 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = let printBinaryOperator ~inlineRhs operator = let operatorTxt = match operator with - | "|." -> "->" + | "|." | "|.u" -> "->" | "^" -> "++" | "=" -> "==" | "==" -> "===" @@ -3491,12 +3491,12 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = | txt -> txt in let spacingBeforeOperator = - if operator = "|." then Doc.softLine + if operator = "|." || operator = "|.u" then Doc.softLine else if operator = "|>" then Doc.line else Doc.space in let spacingAfterOperator = - if operator = "|." then Doc.nil + if operator = "|." || operator = "|.u" then Doc.nil else if operator = "|>" then Doc.space else if inlineRhs then Doc.space else Doc.line @@ -3646,7 +3646,10 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = in match expr.pexp_desc with | Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident (("|." | "|>") as op)}}, + ( { + pexp_desc = + Pexp_ident {txt = Longident.Lident (("|." | "|.u" | "|>") as op)}; + }, [(Nolabel, lhs); (Nolabel, rhs)] ) when not (ParsetreeViewer.isBinaryExpression lhs @@ -3661,8 +3664,8 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = printAttributes ~state expr.pexp_attributes cmtTbl; lhsDoc; (match (lhsHasCommentBelow, op) with - | true, "|." -> Doc.concat [Doc.softLine; Doc.text "->"] - | false, "|." -> Doc.text "->" + | true, ("|." | "|.u") -> Doc.concat [Doc.softLine; Doc.text "->"] + | false, ("|." | "|.u") -> Doc.text "->" | true, "|>" -> Doc.concat [Doc.line; Doc.text "|> "] | false, "|>" -> Doc.text " |> " | _ -> Doc.nil); diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 92d1b7e697..dff440cc41 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -34,3 +34,5 @@ type mixTyp = (.string) => (string, string) => (.string, string, string, string) type bTyp = string => (. string) => int type cTyp2 = (.string, string) => int type uTyp2 = (string, string) => int + +let pipe1 = 3->f \ No newline at end of file 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 102224bc38..2f5a251c6e 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -51,4 +51,5 @@ type nonrec mixTyp = Js.Fn.arity2 type nonrec bTyp = (string -> string -> int) Js.Fn.arity1 type nonrec cTyp2 = string -> string -> int -type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2 \ No newline at end of file +type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2 +let pipe1 = 3 |.u f \ No newline at end of file diff --git a/res_syntax/tests/printer/expr/UncurriedByDefault.res b/res_syntax/tests/printer/expr/UncurriedByDefault.res index ca654c2659..d2aa195153 100644 --- a/res_syntax/tests/printer/expr/UncurriedByDefault.res +++ b/res_syntax/tests/printer/expr/UncurriedByDefault.res @@ -15,6 +15,8 @@ type bTyp = (. string) => string => int type cTyp2 = (string, string) => int type uTyp2 = (.string, string) => int +let pipe = a->foo(. b, c) + @@uncurried let cApp = foo(. 3) @@ -34,3 +36,5 @@ type mixTyp = (.string) => (string, string) => (.string, string, string, string) type bTyp = string => (. string) => int type cTyp2 = (. string, string) => int type uTyp2 = (string, string) => int + +let pipe = a->foo(b, c) diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index f324439a67..fde3ab6f6b 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -15,6 +15,8 @@ type bTyp = (. string) => string => int type cTyp2 = (string, string) => int type uTyp2 = (. string, string) => int +let pipe = a->foo(. b, c) + @@uncurried let cApp = foo(. 3) @@ -34,3 +36,5 @@ type mixTyp = (. string) => (string, string) => (. string, string, string, strin type bTyp = string => (. string) => int type cTyp2 = (. string, string) => int type uTyp2 = (string, string) => int + +let pipe = a->foo(b, c)