From 95bf8ff4bbbb33b62e0ab34f6b680af7aa083559 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 13:23:30 +0100 Subject: [PATCH 01/10] process uncurried function declarations explicitly in the parser/printer --- CHANGELOG.md | 2 + lib/4.06.1/unstable/js_compiler.ml | 174 ++++++------ lib/4.06.1/unstable/js_playground_compiler.ml | 267 ++++++++++-------- lib/4.06.1/whole_compiler.ml | 267 ++++++++++-------- res_syntax/src/res_core.ml | 93 +++--- res_syntax/src/res_printer.ml | 174 ++++++------ .../expressions/expected/apply.res.txt | 2 +- .../expressions/expected/argument.res.txt | 2 +- .../expressions/expected/arrow.res.txt | 44 ++- .../expressions/expected/async.res.txt | 11 +- .../expressions/expected/uncurried.res.txt | 42 ++- .../printer/expr/expected/callback.res.txt | 6 +- 12 files changed, 591 insertions(+), 493 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f2d8355387..f8d57c938e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,6 +24,8 @@ #### :nail_care: Polish - Syntax: process uncurried types explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5784 +- Syntax: process uncurried function declarations explicitly in the parser/printer + # 10.1.0-rc.5 diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 42d05ad1ef..45f037db63 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -55712,6 +55712,79 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = Doc.concat [printAttributes ~customLayout attrs cmtTbl; ifDocs; elseDoc] and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = + let printArrow ~isUncurried e = + let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in + let ParsetreeViewer.{async; uncurried; attributes = attrs} = + ParsetreeViewer.processFunctionAttributes attrsOnArrow + in + let uncurried = uncurried || isUncurried in + let returnExpr, typConstraint = + match returnExpr.pexp_desc with + | Pexp_constraint (expr, typ) -> + ( { + expr with + pexp_attributes = + List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; + }, + Some typ ) + | _ -> (returnExpr, None) + in + let hasConstraint = + match typConstraint with + | Some _ -> true + | None -> false + in + let parametersDoc = + printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried + ~async ~hasConstraint parameters cmtTbl + in + let returnExprDoc = + let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in + let shouldInline = + match (returnExpr.pexp_desc, optBraces) with + | _, Some _ -> true + | ( ( Pexp_array _ | Pexp_tuple _ + | Pexp_construct (_, Some _) + | Pexp_record _ ), + _ ) -> + true + | _ -> false + in + let shouldIndent = + match returnExpr.pexp_desc with + | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ + | Pexp_open _ -> + false + | _ -> true + in + let returnDoc = + let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + match Parens.expr returnExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc returnExpr braces + | Nothing -> doc + in + if shouldInline then Doc.concat [Doc.space; returnDoc] + else + Doc.group + (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) + else Doc.concat [Doc.space; returnDoc]) + in + let typConstraintDoc = + match typConstraint with + | Some typ -> + let typDoc = + let doc = printTypExpr ~customLayout typ cmtTbl in + if Parens.arrowReturnTypExpr typ then addParens doc else doc + in + Doc.concat [Doc.text ": "; typDoc] + | _ -> Doc.nil + in + let attrs = printAttributes ~customLayout attrs cmtTbl in + Doc.group + (Doc.concat + [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) + in let printedExpression = match e.pexp_desc with | Parsetree.Pexp_constant c -> @@ -55967,6 +56040,19 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] in Doc.group (Doc.concat [variantName; args]) + | Pexp_fun + ( Nolabel, + None, + {ppat_desc = Ppat_var {txt = "__x"}}, + {pexp_desc = Pexp_apply _} ) -> + (* (__x) => f(a, __x, c) -----> f(a, _, c) *) + printExpressionWithComments ~customLayout + (ParsetreeViewer.rewriteUnderscoreApply e) + cmtTbl + | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e + | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + when String.length name >= 1 && name.[0] = 'I' -> + printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> if rows = [] then Doc.concat @@ -56255,94 +56341,6 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | Pexp_sequence _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl | Pexp_let _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl - | Pexp_fun - ( Nolabel, - None, - {ppat_desc = Ppat_var {txt = "__x"}}, - {pexp_desc = Pexp_apply _} ) -> - (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~customLayout - (ParsetreeViewer.rewriteUnderscoreApply e) - cmtTbl - | Pexp_fun _ | Pexp_newtype _ -> - let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in - let ParsetreeViewer.{async; uncurried; attributes = attrs} = - ParsetreeViewer.processFunctionAttributes attrsOnArrow - in - let returnExpr, typConstraint = - match returnExpr.pexp_desc with - | Pexp_constraint (expr, typ) -> - ( { - expr with - pexp_attributes = - List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; - }, - Some typ ) - | _ -> (returnExpr, None) - in - let hasConstraint = - match typConstraint with - | Some _ -> true - | None -> false - in - let parametersDoc = - printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried - ~async ~hasConstraint parameters cmtTbl - in - let returnExprDoc = - let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in - let shouldInline = - match (returnExpr.pexp_desc, optBraces) with - | _, Some _ -> true - | ( ( Pexp_array _ | Pexp_tuple _ - | Pexp_construct (_, Some _) - | Pexp_record _ ), - _ ) -> - true - | _ -> false - in - let shouldIndent = - match returnExpr.pexp_desc with - | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ - | Pexp_letexception _ | Pexp_open _ -> - false - | _ -> true - in - let returnDoc = - let doc = - printExpressionWithComments ~customLayout returnExpr cmtTbl - in - match Parens.expr returnExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc returnExpr braces - | Nothing -> doc - in - if shouldInline then Doc.concat [Doc.space; returnDoc] - else - Doc.group - (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) - else Doc.concat [Doc.space; returnDoc]) - in - let typConstraintDoc = - match typConstraint with - | Some typ -> - let typDoc = - let doc = printTypExpr ~customLayout typ cmtTbl in - if Parens.arrowReturnTypExpr typ then addParens doc else doc - in - Doc.concat [Doc.text ": "; typDoc] - | _ -> Doc.nil - in - let attrs = printAttributes ~customLayout attrs cmtTbl in - Doc.group - (Doc.concat - [ - attrs; - parametersDoc; - typConstraintDoc; - Doc.text " =>"; - returnExprDoc; - ]) | Pexp_try (expr, cases) -> let exprDoc = let doc = printExpressionWithComments ~customLayout expr cmtTbl in diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index b0fc94aa38..5312f69e4e 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -55712,6 +55712,79 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = Doc.concat [printAttributes ~customLayout attrs cmtTbl; ifDocs; elseDoc] and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = + let printArrow ~isUncurried e = + let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in + let ParsetreeViewer.{async; uncurried; attributes = attrs} = + ParsetreeViewer.processFunctionAttributes attrsOnArrow + in + let uncurried = uncurried || isUncurried in + let returnExpr, typConstraint = + match returnExpr.pexp_desc with + | Pexp_constraint (expr, typ) -> + ( { + expr with + pexp_attributes = + List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; + }, + Some typ ) + | _ -> (returnExpr, None) + in + let hasConstraint = + match typConstraint with + | Some _ -> true + | None -> false + in + let parametersDoc = + printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried + ~async ~hasConstraint parameters cmtTbl + in + let returnExprDoc = + let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in + let shouldInline = + match (returnExpr.pexp_desc, optBraces) with + | _, Some _ -> true + | ( ( Pexp_array _ | Pexp_tuple _ + | Pexp_construct (_, Some _) + | Pexp_record _ ), + _ ) -> + true + | _ -> false + in + let shouldIndent = + match returnExpr.pexp_desc with + | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ + | Pexp_open _ -> + false + | _ -> true + in + let returnDoc = + let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + match Parens.expr returnExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc returnExpr braces + | Nothing -> doc + in + if shouldInline then Doc.concat [Doc.space; returnDoc] + else + Doc.group + (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) + else Doc.concat [Doc.space; returnDoc]) + in + let typConstraintDoc = + match typConstraint with + | Some typ -> + let typDoc = + let doc = printTypExpr ~customLayout typ cmtTbl in + if Parens.arrowReturnTypExpr typ then addParens doc else doc + in + Doc.concat [Doc.text ": "; typDoc] + | _ -> Doc.nil + in + let attrs = printAttributes ~customLayout attrs cmtTbl in + Doc.group + (Doc.concat + [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) + in let printedExpression = match e.pexp_desc with | Parsetree.Pexp_constant c -> @@ -55967,6 +56040,19 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] in Doc.group (Doc.concat [variantName; args]) + | Pexp_fun + ( Nolabel, + None, + {ppat_desc = Ppat_var {txt = "__x"}}, + {pexp_desc = Pexp_apply _} ) -> + (* (__x) => f(a, __x, c) -----> f(a, _, c) *) + printExpressionWithComments ~customLayout + (ParsetreeViewer.rewriteUnderscoreApply e) + cmtTbl + | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e + | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + when String.length name >= 1 && name.[0] = 'I' -> + printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> if rows = [] then Doc.concat @@ -56255,94 +56341,6 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | Pexp_sequence _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl | Pexp_let _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl - | Pexp_fun - ( Nolabel, - None, - {ppat_desc = Ppat_var {txt = "__x"}}, - {pexp_desc = Pexp_apply _} ) -> - (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~customLayout - (ParsetreeViewer.rewriteUnderscoreApply e) - cmtTbl - | Pexp_fun _ | Pexp_newtype _ -> - let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in - let ParsetreeViewer.{async; uncurried; attributes = attrs} = - ParsetreeViewer.processFunctionAttributes attrsOnArrow - in - let returnExpr, typConstraint = - match returnExpr.pexp_desc with - | Pexp_constraint (expr, typ) -> - ( { - expr with - pexp_attributes = - List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; - }, - Some typ ) - | _ -> (returnExpr, None) - in - let hasConstraint = - match typConstraint with - | Some _ -> true - | None -> false - in - let parametersDoc = - printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried - ~async ~hasConstraint parameters cmtTbl - in - let returnExprDoc = - let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in - let shouldInline = - match (returnExpr.pexp_desc, optBraces) with - | _, Some _ -> true - | ( ( Pexp_array _ | Pexp_tuple _ - | Pexp_construct (_, Some _) - | Pexp_record _ ), - _ ) -> - true - | _ -> false - in - let shouldIndent = - match returnExpr.pexp_desc with - | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ - | Pexp_letexception _ | Pexp_open _ -> - false - | _ -> true - in - let returnDoc = - let doc = - printExpressionWithComments ~customLayout returnExpr cmtTbl - in - match Parens.expr returnExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc returnExpr braces - | Nothing -> doc - in - if shouldInline then Doc.concat [Doc.space; returnDoc] - else - Doc.group - (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) - else Doc.concat [Doc.space; returnDoc]) - in - let typConstraintDoc = - match typConstraint with - | Some typ -> - let typDoc = - let doc = printTypExpr ~customLayout typ cmtTbl in - if Parens.arrowReturnTypExpr typ then addParens doc else doc - in - Doc.concat [Doc.text ": "; typDoc] - | _ -> Doc.nil - in - let attrs = printAttributes ~customLayout attrs cmtTbl in - Doc.group - (Doc.concat - [ - attrs; - parametersDoc; - typConstraintDoc; - Doc.text " =>"; - returnExprDoc; - ]) | Pexp_try (expr, cases) -> let exprDoc = let doc = printExpressionWithComments ~customLayout expr cmtTbl in @@ -284720,7 +284718,8 @@ and parseTernaryExpr leftOperand p = (Some falseBranch) | _ -> leftOperand -and parseEs6ArrowExpression ?context ?parameters p = +and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context + ?parameters p = let startPos = p.Parser.startPos in Parser.leaveBreadcrumb p Grammar.Es6ArrowExpr; (* Parsing function parameters and attributes: @@ -284734,6 +284733,32 @@ and parseEs6ArrowExpression ?context ?parameters p = | Some params -> params | None -> parseParameters p in + let parameters = + match parameters with + | TermParameter p :: rest -> + TermParameter + { + p with + attrs = arrowAttrs @ p.attrs; + pos = + (match arrowStartPos with + | Some startPos -> startPos + | None -> p.pos); + } + :: rest + | TypeParameter p :: rest -> + TypeParameter + { + p with + attrs = arrowAttrs @ p.attrs; + pos = + (match arrowStartPos with + | Some startPos -> startPos + | None -> p.pos); + } + :: rest + | [] -> parameters + in let returnType = match p.Parser.token with | Colon -> @@ -284753,9 +284778,9 @@ and parseEs6ArrowExpression ?context ?parameters p = in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in - let arrowExpr = + let arrowExpr, _arity = List.fold_right - (fun parameter expr -> + (fun parameter (expr, arity) -> match parameter with | TermParameter { @@ -284766,13 +284791,34 @@ and parseEs6ArrowExpression ?context ?parameters p = pat; pos = startPos; } -> - let attrs = if uncurried then uncurryAttr :: attrs else attrs in - Ast_helper.Exp.fun_ ~loc:(mkLoc startPos endPos) ~attrs lbl - defaultExpr pat expr + let loc = mkLoc startPos endPos in + let funExpr = + Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr + in + if uncurried then + let arirtForFn = + match pat.ppat_desc with + | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 + | _ -> arity + in + ( Ast_helper.Exp.record ~loc + [ + ( { + txt = + Ldot + ( Ldot (Lident "Js", "Fn"), + "I" ^ string_of_int arirtForFn ); + loc; + }, + funExpr ); + ] + None, + 1 ) + else (funExpr, arity + 1) | TypeParameter {uncurried; attrs; locs = newtypes; pos = startPos} -> let attrs = if uncurried then uncurryAttr :: attrs else attrs in - makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr) - parameters body + (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) + parameters (body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} @@ -284991,25 +285037,8 @@ and parseParameters p = ] | _ -> ( match parseParameterList p with - | TermParameter - { - attrs; - label = lbl; - expr = defaultExpr; - pat = pattern; - pos = startPos; - } - :: rest -> - TermParameter - { - uncurried = true; - attrs; - label = lbl; - expr = defaultExpr; - pat = pattern; - pos = startPos; - } - :: rest + | TermParameter p :: rest -> + TermParameter {p with uncurried = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> @@ -286393,12 +286422,8 @@ and parseAsyncArrowExpression p = let startPos = p.Parser.startPos in Parser.expect (Lident "async") p; let asyncAttr = makeAsyncAttr (mkLoc startPos p.prevEndPos) in - let expr = parseEs6ArrowExpression p in - { - expr with - pexp_attributes = asyncAttr :: expr.pexp_attributes; - pexp_loc = {expr.pexp_loc with loc_start = startPos}; - } + parseEs6ArrowExpression ~arrowAttrs:[asyncAttr] ~arrowStartPos:(Some startPos) + p and parseAwaitExpression p = let awaitLoc = mkLoc p.Parser.startPos p.endPos in diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 59e4cc031f..afb38b11cd 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -231574,6 +231574,79 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = Doc.concat [printAttributes ~customLayout attrs cmtTbl; ifDocs; elseDoc] and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = + let printArrow ~isUncurried e = + let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in + let ParsetreeViewer.{async; uncurried; attributes = attrs} = + ParsetreeViewer.processFunctionAttributes attrsOnArrow + in + let uncurried = uncurried || isUncurried in + let returnExpr, typConstraint = + match returnExpr.pexp_desc with + | Pexp_constraint (expr, typ) -> + ( { + expr with + pexp_attributes = + List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; + }, + Some typ ) + | _ -> (returnExpr, None) + in + let hasConstraint = + match typConstraint with + | Some _ -> true + | None -> false + in + let parametersDoc = + printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried + ~async ~hasConstraint parameters cmtTbl + in + let returnExprDoc = + let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in + let shouldInline = + match (returnExpr.pexp_desc, optBraces) with + | _, Some _ -> true + | ( ( Pexp_array _ | Pexp_tuple _ + | Pexp_construct (_, Some _) + | Pexp_record _ ), + _ ) -> + true + | _ -> false + in + let shouldIndent = + match returnExpr.pexp_desc with + | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ + | Pexp_open _ -> + false + | _ -> true + in + let returnDoc = + let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + match Parens.expr returnExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc returnExpr braces + | Nothing -> doc + in + if shouldInline then Doc.concat [Doc.space; returnDoc] + else + Doc.group + (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) + else Doc.concat [Doc.space; returnDoc]) + in + let typConstraintDoc = + match typConstraint with + | Some typ -> + let typDoc = + let doc = printTypExpr ~customLayout typ cmtTbl in + if Parens.arrowReturnTypExpr typ then addParens doc else doc + in + Doc.concat [Doc.text ": "; typDoc] + | _ -> Doc.nil + in + let attrs = printAttributes ~customLayout attrs cmtTbl in + Doc.group + (Doc.concat + [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) + in let printedExpression = match e.pexp_desc with | Parsetree.Pexp_constant c -> @@ -231829,6 +231902,19 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] in Doc.group (Doc.concat [variantName; args]) + | Pexp_fun + ( Nolabel, + None, + {ppat_desc = Ppat_var {txt = "__x"}}, + {pexp_desc = Pexp_apply _} ) -> + (* (__x) => f(a, __x, c) -----> f(a, _, c) *) + printExpressionWithComments ~customLayout + (ParsetreeViewer.rewriteUnderscoreApply e) + cmtTbl + | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e + | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + when String.length name >= 1 && name.[0] = 'I' -> + printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> if rows = [] then Doc.concat @@ -232117,94 +232203,6 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | Pexp_sequence _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl | Pexp_let _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl - | Pexp_fun - ( Nolabel, - None, - {ppat_desc = Ppat_var {txt = "__x"}}, - {pexp_desc = Pexp_apply _} ) -> - (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~customLayout - (ParsetreeViewer.rewriteUnderscoreApply e) - cmtTbl - | Pexp_fun _ | Pexp_newtype _ -> - let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in - let ParsetreeViewer.{async; uncurried; attributes = attrs} = - ParsetreeViewer.processFunctionAttributes attrsOnArrow - in - let returnExpr, typConstraint = - match returnExpr.pexp_desc with - | Pexp_constraint (expr, typ) -> - ( { - expr with - pexp_attributes = - List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; - }, - Some typ ) - | _ -> (returnExpr, None) - in - let hasConstraint = - match typConstraint with - | Some _ -> true - | None -> false - in - let parametersDoc = - printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried - ~async ~hasConstraint parameters cmtTbl - in - let returnExprDoc = - let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in - let shouldInline = - match (returnExpr.pexp_desc, optBraces) with - | _, Some _ -> true - | ( ( Pexp_array _ | Pexp_tuple _ - | Pexp_construct (_, Some _) - | Pexp_record _ ), - _ ) -> - true - | _ -> false - in - let shouldIndent = - match returnExpr.pexp_desc with - | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ - | Pexp_letexception _ | Pexp_open _ -> - false - | _ -> true - in - let returnDoc = - let doc = - printExpressionWithComments ~customLayout returnExpr cmtTbl - in - match Parens.expr returnExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc returnExpr braces - | Nothing -> doc - in - if shouldInline then Doc.concat [Doc.space; returnDoc] - else - Doc.group - (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) - else Doc.concat [Doc.space; returnDoc]) - in - let typConstraintDoc = - match typConstraint with - | Some typ -> - let typDoc = - let doc = printTypExpr ~customLayout typ cmtTbl in - if Parens.arrowReturnTypExpr typ then addParens doc else doc - in - Doc.concat [Doc.text ": "; typDoc] - | _ -> Doc.nil - in - let attrs = printAttributes ~customLayout attrs cmtTbl in - Doc.group - (Doc.concat - [ - attrs; - parametersDoc; - typConstraintDoc; - Doc.text " =>"; - returnExprDoc; - ]) | Pexp_try (expr, cases) -> let exprDoc = let doc = printExpressionWithComments ~customLayout expr cmtTbl in @@ -298152,7 +298150,8 @@ and parseTernaryExpr leftOperand p = (Some falseBranch) | _ -> leftOperand -and parseEs6ArrowExpression ?context ?parameters p = +and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context + ?parameters p = let startPos = p.Parser.startPos in Parser.leaveBreadcrumb p Grammar.Es6ArrowExpr; (* Parsing function parameters and attributes: @@ -298166,6 +298165,32 @@ and parseEs6ArrowExpression ?context ?parameters p = | Some params -> params | None -> parseParameters p in + let parameters = + match parameters with + | TermParameter p :: rest -> + TermParameter + { + p with + attrs = arrowAttrs @ p.attrs; + pos = + (match arrowStartPos with + | Some startPos -> startPos + | None -> p.pos); + } + :: rest + | TypeParameter p :: rest -> + TypeParameter + { + p with + attrs = arrowAttrs @ p.attrs; + pos = + (match arrowStartPos with + | Some startPos -> startPos + | None -> p.pos); + } + :: rest + | [] -> parameters + in let returnType = match p.Parser.token with | Colon -> @@ -298185,9 +298210,9 @@ and parseEs6ArrowExpression ?context ?parameters p = in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in - let arrowExpr = + let arrowExpr, _arity = List.fold_right - (fun parameter expr -> + (fun parameter (expr, arity) -> match parameter with | TermParameter { @@ -298198,13 +298223,34 @@ and parseEs6ArrowExpression ?context ?parameters p = pat; pos = startPos; } -> - let attrs = if uncurried then uncurryAttr :: attrs else attrs in - Ast_helper.Exp.fun_ ~loc:(mkLoc startPos endPos) ~attrs lbl - defaultExpr pat expr + let loc = mkLoc startPos endPos in + let funExpr = + Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr + in + if uncurried then + let arirtForFn = + match pat.ppat_desc with + | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 + | _ -> arity + in + ( Ast_helper.Exp.record ~loc + [ + ( { + txt = + Ldot + ( Ldot (Lident "Js", "Fn"), + "I" ^ string_of_int arirtForFn ); + loc; + }, + funExpr ); + ] + None, + 1 ) + else (funExpr, arity + 1) | TypeParameter {uncurried; attrs; locs = newtypes; pos = startPos} -> let attrs = if uncurried then uncurryAttr :: attrs else attrs in - makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr) - parameters body + (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) + parameters (body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} @@ -298423,25 +298469,8 @@ and parseParameters p = ] | _ -> ( match parseParameterList p with - | TermParameter - { - attrs; - label = lbl; - expr = defaultExpr; - pat = pattern; - pos = startPos; - } - :: rest -> - TermParameter - { - uncurried = true; - attrs; - label = lbl; - expr = defaultExpr; - pat = pattern; - pos = startPos; - } - :: rest + | TermParameter p :: rest -> + TermParameter {p with uncurried = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> @@ -299825,12 +299854,8 @@ and parseAsyncArrowExpression p = let startPos = p.Parser.startPos in Parser.expect (Lident "async") p; let asyncAttr = makeAsyncAttr (mkLoc startPos p.prevEndPos) in - let expr = parseEs6ArrowExpression p in - { - expr with - pexp_attributes = asyncAttr :: expr.pexp_attributes; - pexp_loc = {expr.pexp_loc with loc_start = startPos}; - } + parseEs6ArrowExpression ~arrowAttrs:[asyncAttr] ~arrowStartPos:(Some startPos) + p and parseAwaitExpression p = let awaitLoc = mkLoc p.Parser.startPos p.endPos in diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index f99378fa64..8be8259e91 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -1455,7 +1455,8 @@ and parseTernaryExpr leftOperand p = (Some falseBranch) | _ -> leftOperand -and parseEs6ArrowExpression ?context ?parameters p = +and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context + ?parameters p = let startPos = p.Parser.startPos in Parser.leaveBreadcrumb p Grammar.Es6ArrowExpr; (* Parsing function parameters and attributes: @@ -1469,6 +1470,32 @@ and parseEs6ArrowExpression ?context ?parameters p = | Some params -> params | None -> parseParameters p in + let parameters = + match parameters with + | TermParameter p :: rest -> + TermParameter + { + p with + attrs = arrowAttrs @ p.attrs; + pos = + (match arrowStartPos with + | Some startPos -> startPos + | None -> p.pos); + } + :: rest + | TypeParameter p :: rest -> + TypeParameter + { + p with + attrs = arrowAttrs @ p.attrs; + pos = + (match arrowStartPos with + | Some startPos -> startPos + | None -> p.pos); + } + :: rest + | [] -> parameters + in let returnType = match p.Parser.token with | Colon -> @@ -1488,9 +1515,9 @@ and parseEs6ArrowExpression ?context ?parameters p = in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in - let arrowExpr = + let arrowExpr, _arity = List.fold_right - (fun parameter expr -> + (fun parameter (expr, arity) -> match parameter with | TermParameter { @@ -1501,13 +1528,34 @@ and parseEs6ArrowExpression ?context ?parameters p = pat; pos = startPos; } -> - let attrs = if uncurried then uncurryAttr :: attrs else attrs in - Ast_helper.Exp.fun_ ~loc:(mkLoc startPos endPos) ~attrs lbl - defaultExpr pat expr + let loc = mkLoc startPos endPos in + let funExpr = + Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr + in + if uncurried then + let arirtForFn = + match pat.ppat_desc with + | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 + | _ -> arity + in + ( Ast_helper.Exp.record ~loc + [ + ( { + txt = + Ldot + ( Ldot (Lident "Js", "Fn"), + "I" ^ string_of_int arirtForFn ); + loc; + }, + funExpr ); + ] + None, + 1 ) + else (funExpr, arity + 1) | TypeParameter {uncurried; attrs; locs = newtypes; pos = startPos} -> let attrs = if uncurried then uncurryAttr :: attrs else attrs in - makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr) - parameters body + (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) + parameters (body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} @@ -1726,25 +1774,8 @@ and parseParameters p = ] | _ -> ( match parseParameterList p with - | TermParameter - { - attrs; - label = lbl; - expr = defaultExpr; - pat = pattern; - pos = startPos; - } - :: rest -> - TermParameter - { - uncurried = true; - attrs; - label = lbl; - expr = defaultExpr; - pat = pattern; - pos = startPos; - } - :: rest + | TermParameter p :: rest -> + TermParameter {p with uncurried = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> @@ -3128,12 +3159,8 @@ and parseAsyncArrowExpression p = let startPos = p.Parser.startPos in Parser.expect (Lident "async") p; let asyncAttr = makeAsyncAttr (mkLoc startPos p.prevEndPos) in - let expr = parseEs6ArrowExpression p in - { - expr with - pexp_attributes = asyncAttr :: expr.pexp_attributes; - pexp_loc = {expr.pexp_loc with loc_start = startPos}; - } + parseEs6ArrowExpression ~arrowAttrs:[asyncAttr] ~arrowStartPos:(Some startPos) + p and parseAwaitExpression p = let awaitLoc = mkLoc p.Parser.startPos p.endPos in diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index 86bc017c55..3f4808f1ae 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -2647,6 +2647,79 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = Doc.concat [printAttributes ~customLayout attrs cmtTbl; ifDocs; elseDoc] and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = + let printArrow ~isUncurried e = + let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in + let ParsetreeViewer.{async; uncurried; attributes = attrs} = + ParsetreeViewer.processFunctionAttributes attrsOnArrow + in + let uncurried = uncurried || isUncurried in + let returnExpr, typConstraint = + match returnExpr.pexp_desc with + | Pexp_constraint (expr, typ) -> + ( { + expr with + pexp_attributes = + List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; + }, + Some typ ) + | _ -> (returnExpr, None) + in + let hasConstraint = + match typConstraint with + | Some _ -> true + | None -> false + in + let parametersDoc = + printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried + ~async ~hasConstraint parameters cmtTbl + in + let returnExprDoc = + let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in + let shouldInline = + match (returnExpr.pexp_desc, optBraces) with + | _, Some _ -> true + | ( ( Pexp_array _ | Pexp_tuple _ + | Pexp_construct (_, Some _) + | Pexp_record _ ), + _ ) -> + true + | _ -> false + in + let shouldIndent = + match returnExpr.pexp_desc with + | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ + | Pexp_open _ -> + false + | _ -> true + in + let returnDoc = + let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + match Parens.expr returnExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc returnExpr braces + | Nothing -> doc + in + if shouldInline then Doc.concat [Doc.space; returnDoc] + else + Doc.group + (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) + else Doc.concat [Doc.space; returnDoc]) + in + let typConstraintDoc = + match typConstraint with + | Some typ -> + let typDoc = + let doc = printTypExpr ~customLayout typ cmtTbl in + if Parens.arrowReturnTypExpr typ then addParens doc else doc + in + Doc.concat [Doc.text ": "; typDoc] + | _ -> Doc.nil + in + let attrs = printAttributes ~customLayout attrs cmtTbl in + Doc.group + (Doc.concat + [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) + in let printedExpression = match e.pexp_desc with | Parsetree.Pexp_constant c -> @@ -2902,6 +2975,19 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] in Doc.group (Doc.concat [variantName; args]) + | Pexp_fun + ( Nolabel, + None, + {ppat_desc = Ppat_var {txt = "__x"}}, + {pexp_desc = Pexp_apply _} ) -> + (* (__x) => f(a, __x, c) -----> f(a, _, c) *) + printExpressionWithComments ~customLayout + (ParsetreeViewer.rewriteUnderscoreApply e) + cmtTbl + | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e + | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + when String.length name >= 1 && name.[0] = 'I' -> + printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> if rows = [] then Doc.concat @@ -3190,94 +3276,6 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | Pexp_sequence _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl | Pexp_let _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl - | Pexp_fun - ( Nolabel, - None, - {ppat_desc = Ppat_var {txt = "__x"}}, - {pexp_desc = Pexp_apply _} ) -> - (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~customLayout - (ParsetreeViewer.rewriteUnderscoreApply e) - cmtTbl - | Pexp_fun _ | Pexp_newtype _ -> - let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in - let ParsetreeViewer.{async; uncurried; attributes = attrs} = - ParsetreeViewer.processFunctionAttributes attrsOnArrow - in - let returnExpr, typConstraint = - match returnExpr.pexp_desc with - | Pexp_constraint (expr, typ) -> - ( { - expr with - pexp_attributes = - List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; - }, - Some typ ) - | _ -> (returnExpr, None) - in - let hasConstraint = - match typConstraint with - | Some _ -> true - | None -> false - in - let parametersDoc = - printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried - ~async ~hasConstraint parameters cmtTbl - in - let returnExprDoc = - let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in - let shouldInline = - match (returnExpr.pexp_desc, optBraces) with - | _, Some _ -> true - | ( ( Pexp_array _ | Pexp_tuple _ - | Pexp_construct (_, Some _) - | Pexp_record _ ), - _ ) -> - true - | _ -> false - in - let shouldIndent = - match returnExpr.pexp_desc with - | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ - | Pexp_letexception _ | Pexp_open _ -> - false - | _ -> true - in - let returnDoc = - let doc = - printExpressionWithComments ~customLayout returnExpr cmtTbl - in - match Parens.expr returnExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc returnExpr braces - | Nothing -> doc - in - if shouldInline then Doc.concat [Doc.space; returnDoc] - else - Doc.group - (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) - else Doc.concat [Doc.space; returnDoc]) - in - let typConstraintDoc = - match typConstraint with - | Some typ -> - let typDoc = - let doc = printTypExpr ~customLayout typ cmtTbl in - if Parens.arrowReturnTypExpr typ then addParens doc else doc - in - Doc.concat [Doc.text ": "; typDoc] - | _ -> Doc.nil - in - let attrs = printAttributes ~customLayout attrs cmtTbl in - Doc.group - (Doc.concat - [ - attrs; - parametersDoc; - typConstraintDoc; - Doc.text " =>"; - returnExprDoc; - ]) | Pexp_try (expr, cases) -> let exprDoc = let doc = printExpressionWithComments ~customLayout expr cmtTbl in 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 4f490c5f6b..d9a01f8f05 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/apply.res.txt @@ -1,6 +1,6 @@ ;;foo (fun _ -> bla) blaz ;;foo (fun _ -> bla) blaz -;;foo ((fun _ -> bla)[@bs ]) blaz +;;foo { Js.Fn.I1 = (fun _ -> bla) } blaz ;;foo (fun _ -> bla) (fun _ -> blaz) ;;List.map (fun x -> x + 1) myList ;;List.reduce (fun acc -> fun curr -> acc + curr) 0 myList 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 7bc23ec629..2f12cf4e4e 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 = ((fun () -> 2)[@bs ]) +let a = { Js.Fn.I0 = (fun () -> 2) } let bar = foo ~a:((a)[@ns.namedArgLoc ]) let comparisonResult = ((compare currentNode.value ~targetValue:((targetValue)[@ns.namedArgLoc ])) 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 9ce7fb3db4..ed1d7067c4 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/arrow.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/arrow.res.txt @@ -40,23 +40,37 @@ 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 = ((fun () -> ())[@bs ]) -let f = ((fun () -> ())[@bs ]) -let f = ((fun a -> fun b -> fun c -> ())[@bs ]) -let f = ((fun a -> fun b -> ((fun c -> fun d -> ())[@bs ]))[@bs ]) -let f = ((fun a -> ((fun b -> ((fun c -> ())[@bs ]))[@bs ]))[@bs ]) +let f = { Js.Fn.I0 = (fun () -> ()) } +let f = { Js.Fn.I0 = (fun () -> ()) } +let f = { Js.Fn.I3 = (fun a -> fun b -> fun c -> ()) } let f = - ((fun ~a:((a)[@ns.namedArgLoc ][@attr ]) -> - fun b -> ((fun ~c:((c)[@ns.namedArgLoc ][@attr ]) -> fun d -> ()) - [@bs ])) - [@bs ]) + { Js.Fn.I2 = (fun a -> fun b -> { Js.Fn.I2 = (fun c -> fun d -> ()) }) } let f = - ((fun ~a:((a)[@ns.namedArgLoc ][@attr ]) -> - fun ((b)[@attrOnB ]) -> - ((fun ~c:((c)[@ns.namedArgLoc ][@attr ]) -> - fun ((d)[@attrOnD ]) -> ()) - [@bs ])) - [@bs ]) + { + Js.Fn.I1 = + (fun a -> { Js.Fn.I1 = (fun b -> { Js.Fn.I1 = (fun c -> ()) }) }) + } +let f = + { + Js.Fn.I2 = + (fun ~a:((a)[@ns.namedArgLoc ][@attr ]) -> + fun b -> + { + Js.Fn.I2 = + (fun ~c:((c)[@ns.namedArgLoc ][@attr ]) -> fun d -> ()) + }) + } +let f = + { + Js.Fn.I2 = + (fun ~a:((a)[@ns.namedArgLoc ][@attr ]) -> + fun ((b)[@attrOnB ]) -> + { + Js.Fn.I2 = + (fun ~c:((c)[@ns.namedArgLoc ][@attr ]) -> + fun ((d)[@attrOnD ]) -> ()) + }) + } let f list = list () ;;match colour with | Red when 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 fe86bf4da7..5d01cdb04a 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/async.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/async.res.txt @@ -5,13 +5,12 @@ let greetUser = [@ns.braces ])) [@res.async ]) ;;((fun () -> 123)[@res.async ]) -let fetch = ((fun url -> ((browserFetch url)[@bs ])) - [@ns.braces ][@res.async ][@bs ]) +let fetch = + (({ Js.Fn.I1 = ((fun url -> ((browserFetch url)[@bs ]))[@res.async ]) }) + [@ns.braces ]) let fetch2 = - (((((fun url -> ((browserFetch url)[@bs ]))) - [@res.async ][@bs ]); - (((fun url -> ((browserFetch2 url)[@bs ]))) - [@res.async ][@bs ])) + (({ Js.Fn.I1 = (((fun url -> ((browserFetch url)[@bs ])))[@res.async ]) }; + { Js.Fn.I1 = (((fun url -> ((browserFetch2 url)[@bs ])))[@res.async ]) }) [@ns.braces ]) let async = ((let f = async () in 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 d99d0d95d3..b31f86e971 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt @@ -1,20 +1,32 @@ -let f = ((fun a -> fun b -> a + b)[@bs ]) -let f = ((fun a -> ((fun b -> a + b)[@bs ]))[@bs ]) -let f = ((fun a -> fun b -> ((fun c -> fun d -> ((a + b) + c) + d)[@bs ])) - [@bs ]) +let f = { Js.Fn.I2 = (fun a -> fun b -> a + b) } +let f = { Js.Fn.I1 = (fun a -> { Js.Fn.I1 = (fun b -> a + b) }) } let f = - ((fun a -> ((fun b -> ((fun c -> ((fun d -> ())[@attr4 ]))[@bs ][@attr3 ])) - [@attr2 ])) - [@bs ][@attr ]) + { + Js.Fn.I2 = + (fun a -> fun b -> { Js.Fn.I2 = (fun c -> fun d -> ((a + b) + c) + d) }) + } let f = - ((fun ((a)[@attr ]) -> - fun ((b)[@attr2 ]) -> ((fun ((c)[@attr3 ]) -> fun ((d)[@attr4 ]) -> ()) - [@bs ])) - [@bs ]) + (({ + Js.Fn.I1 = + (fun a -> + ((fun b -> (({ Js.Fn.I1 = (fun c -> ((fun d -> ())[@attr4 ])) }) + [@attr3 ])) + [@attr2 ])) + }) + [@attr ]) let f = - ((fun ((a)[@attr ]) -> - fun ((b)[@attr2 ]) -> ((fun ((c)[@attr3 ]) -> fun ((d)[@attr4 ]) -> ()) - [@bs ])) - [@bs ]) + { + Js.Fn.I2 = + (fun ((a)[@attr ]) -> + fun ((b)[@attr2 ]) -> + { Js.Fn.I2 = (fun ((c)[@attr3 ]) -> fun ((d)[@attr4 ]) -> ()) }) + } +let f = + { + Js.Fn.I2 = + (fun ((a)[@attr ]) -> + 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 diff --git a/res_syntax/tests/printer/expr/expected/callback.res.txt b/res_syntax/tests/printer/expr/expected/callback.res.txt index 50393c396b..f6250dbbe4 100644 --- a/res_syntax/tests/printer/expr/expected/callback.res.txt +++ b/res_syntax/tests/printer/expr/expected/callback.res.txt @@ -62,8 +62,7 @@ let _ = { let trees = possibilities->Belt.Array.mapU((. combination) => - combination->Belt.Array.reduceU(Nil, (. tree, curr) => tree->insert(curr)) - ) + combination->Belt.Array.reduceU(Nil, (. tree, curr) => tree->insert(curr))) let set = mapThatHasAVeryLongName->Belt.Map.String.getExn(website)->Belt.Set.Int.add(user) @@ -84,8 +83,7 @@ let add2 = (y: coll, e: key) => let add2 = (y: coll, e: key) => if ( possibilities->Belt.Array.mapU((. combination) => - combination->Belt.Array.reduceU(Nil, (. tree, curr) => tree->insert(curr)) - ) + combination->Belt.Array.reduceU(Nil, (. tree, curr) => tree->insert(curr))) ) { y } else { From e3b3229f61f4be41dce815598fe80a86c8930003 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 13:24:50 +0100 Subject: [PATCH 02/10] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f8d57c938e..782b4de5c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,7 +24,7 @@ #### :nail_care: Polish - Syntax: process uncurried types explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5784 -- Syntax: process uncurried function declarations explicitly in the parser/printer +- Syntax: process uncurried function declarations explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5794 # 10.1.0-rc.5 From 6d1bb3a2d65fa7d9c4555b3e2a2500653f91d673 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 13:48:54 +0100 Subject: [PATCH 03/10] Remove example that is not idempotent This is not idempotent: let c2 = (. x) => y => x+y --- res_syntax/src/res_printer.ml | 3 ++- res_syntax/tests/printer/expr/asyncAwait.res | 8 ++++++-- res_syntax/tests/printer/expr/expected/asyncAwait.res.txt | 4 ++++ 3 files changed, 12 insertions(+), 3 deletions(-) diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index 3f4808f1ae..3dbc2e0588 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -2985,7 +2985,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e - | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + | Pexp_record + ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) when String.length name >= 1 && name.[0] = 'I' -> printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> diff --git a/res_syntax/tests/printer/expr/asyncAwait.res b/res_syntax/tests/printer/expr/asyncAwait.res index c80d6f1fb4..1e67410f7f 100644 --- a/res_syntax/tests/printer/expr/asyncAwait.res +++ b/res_syntax/tests/printer/expr/asyncAwait.res @@ -115,5 +115,9 @@ let b3 = await (foo->bar(~arg)) let b4 = await (foo.bar.baz) let c1 = @foo x => @bar y => x + y -let c2 = (. x) => y => x+y -let c3 = (. x) => @foo y => x+y \ No newline at end of file + +// This is not idempotent: +// let c2 = (. x) => y => x+y + +let c2 = (. x, y) => x+y +let c3 = (. x) => @foo y => x+y diff --git a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt index 4a51a963a1..32a489d36c 100644 --- a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt +++ b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt @@ -137,5 +137,9 @@ let b3 = await foo->bar(~arg) let b4 = await foo.bar.baz let c1 = @foo x => @bar y => x + y + +// This is not idempotent: +// let c2 = (. x) => y => x+y + let c2 = (. x, y) => x + y let c3 = (. x) => @foo y => x + y From c9b696fe07c352f194941e109592173260b4d231 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 14:34:36 +0100 Subject: [PATCH 04/10] Interpred arity of uncurried explicitly. Interpret the arity of uncurried functions explicitly so this is a unary function: ``` (. x) => y => x+y ``` The parser adds braces to the body to make this explicit. This is a breaking change. And solves the lack of idempotency in https://github.com/rescript-lang/rescript-compiler/pull/5794 --- lib/4.06.1/unstable/js_compiler.ml | 3 ++- lib/4.06.1/unstable/js_playground_compiler.ml | 3 ++- lib/4.06.1/whole_compiler.ml | 3 ++- res_syntax/src/res_core.ml | 12 ++++++++++++ .../grammar/expressions/expected/uncurried.res.txt | 8 ++++++-- res_syntax/tests/printer/expr/asyncAwait.res | 6 +----- .../tests/printer/expr/expected/asyncAwait.res.txt | 8 ++------ 7 files changed, 27 insertions(+), 16 deletions(-) diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 45f037db63..9abdaf92fa 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -56050,7 +56050,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e - | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + | Pexp_record + ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) when String.length name >= 1 && name.[0] = 'I' -> printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 5312f69e4e..25c87c8fff 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -56050,7 +56050,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e - | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + | Pexp_record + ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) when String.length name >= 1 && name.[0] = 'I' -> printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index afb38b11cd..7519def19d 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -231912,7 +231912,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e - | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + | Pexp_record + ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) when String.length name >= 1 && name.[0] = 'I' -> printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 8be8259e91..d02320e101 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -1515,6 +1515,18 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in + let body = + match parameters with + | TermParameter {uncurried = true} :: _ + when match body.pexp_desc with + | Pexp_fun _ -> true + | _ -> false -> + { + body with + pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; + } + | _ -> body + in let arrowExpr, _arity = List.fold_right (fun parameter (expr, arity) -> 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 b31f86e971..ccfd5dc7c7 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt @@ -9,9 +9,13 @@ let f = (({ Js.Fn.I1 = (fun a -> - ((fun b -> (({ Js.Fn.I1 = (fun c -> ((fun d -> ())[@attr4 ])) }) + ((fun b -> + (({ + Js.Fn.I1 = + (fun c -> ((fun d -> ())[@ns.braces ][@attr4 ])) + }) [@attr3 ])) - [@attr2 ])) + [@ns.braces ][@attr2 ])) }) [@attr ]) let f = diff --git a/res_syntax/tests/printer/expr/asyncAwait.res b/res_syntax/tests/printer/expr/asyncAwait.res index 1e67410f7f..36f59137bc 100644 --- a/res_syntax/tests/printer/expr/asyncAwait.res +++ b/res_syntax/tests/printer/expr/asyncAwait.res @@ -115,9 +115,5 @@ let b3 = await (foo->bar(~arg)) let b4 = await (foo.bar.baz) let c1 = @foo x => @bar y => x + y - -// This is not idempotent: -// let c2 = (. x) => y => x+y - -let c2 = (. x, y) => x+y +let c2 = (. x) => y => x+y let c3 = (. x) => @foo y => x+y diff --git a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt index 32a489d36c..f99ce11883 100644 --- a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt +++ b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt @@ -137,9 +137,5 @@ let b3 = await foo->bar(~arg) let b4 = await foo.bar.baz let c1 = @foo x => @bar y => x + y - -// This is not idempotent: -// let c2 = (. x) => y => x+y - -let c2 = (. x, y) => x + y -let c3 = (. x) => @foo y => x + y +let c2 = (. x) => {y => x + y} +let c3 = (. x) => {@foo y => x + y} From 8dfd0a06f8e1f9cd4c717e2a86cf29d38b166262 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 19:19:59 +0100 Subject: [PATCH 05/10] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 782b4de5c5..94395faecf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,7 @@ - Remove obsolete built-in project templates and the "rescript init" functionality. This will be replaced by the create-rescript-app project that is maintained separately. - Parse the attributes of labelled argument to the pattern attributes of argument instead of function. - Made pinned dependencies transitive: if *a* is a pinned dependency of *b* and *b* is a pinned dependency of *c*, then *a* is implicitly a pinned dependency of *c*. This change is only breaking if your build process assumes non-transitivity. +- 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 }`. #### :nail_care: Polish From 39e579a0d750116991923eb6ac9ef1f82c540373 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 14:34:36 +0100 Subject: [PATCH 06/10] Interpred arity of uncurried explicitly. Interpret the arity of uncurried functions explicitly so this is a unary function: ``` (. x) => y => x+y ``` The parser adds braces to the body to make this explicit. This is a breaking change. And solves the lack of idempotency in https://github.com/rescript-lang/rescript-compiler/pull/5794 --- lib/4.06.1/unstable/js_compiler.ml | 3 ++- lib/4.06.1/unstable/js_playground_compiler.ml | 3 ++- lib/4.06.1/whole_compiler.ml | 3 ++- res_syntax/src/res_core.ml | 12 ++++++++++++ .../grammar/expressions/expected/uncurried.res.txt | 8 ++++++-- res_syntax/tests/printer/expr/asyncAwait.res | 6 +----- .../tests/printer/expr/expected/asyncAwait.res.txt | 8 ++------ 7 files changed, 27 insertions(+), 16 deletions(-) diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 45f037db63..9abdaf92fa 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -56050,7 +56050,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e - | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + | Pexp_record + ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) when String.length name >= 1 && name.[0] = 'I' -> printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 5312f69e4e..25c87c8fff 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -56050,7 +56050,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e - | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + | Pexp_record + ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) when String.length name >= 1 && name.[0] = 'I' -> printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index afb38b11cd..7519def19d 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -231912,7 +231912,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e - | Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) + | Pexp_record + ([({txt = Ldot (Ldot (Lident "Js", "Fn"), name)}, funExpr)], None) when String.length name >= 1 && name.[0] = 'I' -> printArrow ~isUncurried:true funExpr | Pexp_record (rows, spreadExpr) -> diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 8be8259e91..d02320e101 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -1515,6 +1515,18 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in + let body = + match parameters with + | TermParameter {uncurried = true} :: _ + when match body.pexp_desc with + | Pexp_fun _ -> true + | _ -> false -> + { + body with + pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; + } + | _ -> body + in let arrowExpr, _arity = List.fold_right (fun parameter (expr, arity) -> 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 b31f86e971..ccfd5dc7c7 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/uncurried.res.txt @@ -9,9 +9,13 @@ let f = (({ Js.Fn.I1 = (fun a -> - ((fun b -> (({ Js.Fn.I1 = (fun c -> ((fun d -> ())[@attr4 ])) }) + ((fun b -> + (({ + Js.Fn.I1 = + (fun c -> ((fun d -> ())[@ns.braces ][@attr4 ])) + }) [@attr3 ])) - [@attr2 ])) + [@ns.braces ][@attr2 ])) }) [@attr ]) let f = diff --git a/res_syntax/tests/printer/expr/asyncAwait.res b/res_syntax/tests/printer/expr/asyncAwait.res index 1e67410f7f..36f59137bc 100644 --- a/res_syntax/tests/printer/expr/asyncAwait.res +++ b/res_syntax/tests/printer/expr/asyncAwait.res @@ -115,9 +115,5 @@ let b3 = await (foo->bar(~arg)) let b4 = await (foo.bar.baz) let c1 = @foo x => @bar y => x + y - -// This is not idempotent: -// let c2 = (. x) => y => x+y - -let c2 = (. x, y) => x+y +let c2 = (. x) => y => x+y let c3 = (. x) => @foo y => x+y diff --git a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt index 32a489d36c..f99ce11883 100644 --- a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt +++ b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt @@ -137,9 +137,5 @@ let b3 = await foo->bar(~arg) let b4 = await foo.bar.baz let c1 = @foo x => @bar y => x + y - -// This is not idempotent: -// let c2 = (. x) => y => x+y - -let c2 = (. x, y) => x + y -let c3 = (. x) => @foo y => x + y +let c2 = (. x) => {y => x + y} +let c3 = (. x) => {@foo y => x + y} From 890fe817e29726f5874f9e16d32f8a9a1f49f257 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 19:19:59 +0100 Subject: [PATCH 07/10] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 782b4de5c5..94395faecf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,7 @@ - Remove obsolete built-in project templates and the "rescript init" functionality. This will be replaced by the create-rescript-app project that is maintained separately. - Parse the attributes of labelled argument to the pattern attributes of argument instead of function. - Made pinned dependencies transitive: if *a* is a pinned dependency of *b* and *b* is a pinned dependency of *c*, then *a* is implicitly a pinned dependency of *c*. This change is only breaking if your build process assumes non-transitivity. +- 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 }`. #### :nail_care: Polish From 8ccb0eae635e787f23fdbb2955885423c290f450 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 19:26:20 +0100 Subject: [PATCH 08/10] snap --- lib/4.06.1/unstable/js_playground_compiler.ml | 12 ++++++++++++ lib/4.06.1/whole_compiler.ml | 12 ++++++++++++ 2 files changed, 24 insertions(+) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 25c87c8fff..7a251c02bd 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -284779,6 +284779,18 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in + let body = + match parameters with + | TermParameter {uncurried = true} :: _ + when match body.pexp_desc with + | Pexp_fun _ -> true + | _ -> false -> + { + body with + pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; + } + | _ -> body + in let arrowExpr, _arity = List.fold_right (fun parameter (expr, arity) -> diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 7519def19d..25bbd7a14f 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -298211,6 +298211,18 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in + let body = + match parameters with + | TermParameter {uncurried = true} :: _ + when match body.pexp_desc with + | Pexp_fun _ -> true + | _ -> false -> + { + body with + pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; + } + | _ -> body + in let arrowExpr, _arity = List.fold_right (fun parameter (expr, arity) -> From 8aebe388a90aa519a6ad81ed0eb47905e508a168 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 19:31:51 +0100 Subject: [PATCH 09/10] Added analogous tests for types. --- res_syntax/tests/printer/expr/asyncAwait.res | 3 +++ res_syntax/tests/printer/expr/expected/asyncAwait.res.txt | 3 +++ 2 files changed, 6 insertions(+) diff --git a/res_syntax/tests/printer/expr/asyncAwait.res b/res_syntax/tests/printer/expr/asyncAwait.res index 36f59137bc..b8063228d7 100644 --- a/res_syntax/tests/printer/expr/asyncAwait.res +++ b/res_syntax/tests/printer/expr/asyncAwait.res @@ -117,3 +117,6 @@ let b4 = await (foo.bar.baz) let c1 = @foo x => @bar y => x + y let c2 = (. x) => y => x+y let c3 = (. x) => @foo y => x+y + +type t1 = (. int) => string => bool +type t2 = (. int, string) => bool diff --git a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt index f99ce11883..4a346a2b4b 100644 --- a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt +++ b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt @@ -139,3 +139,6 @@ let b4 = await foo.bar.baz let c1 = @foo x => @bar y => x + y let c2 = (. x) => {y => x + y} let c3 = (. x) => {@foo y => x + y} + +type t1 = (. int, string) => bool +type t2 = (. int, string) => bool From 02f0cf73d92a8626b06c426789ce31c8c0b4fe43 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2022 19:35:11 +0100 Subject: [PATCH 10/10] Update CHANGELOG.md --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 94395faecf..bdaae9c849 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,8 @@ - Parse the attributes of labelled argument to the pattern attributes of argument instead of function. - Made pinned dependencies transitive: if *a* is a pinned dependency of *b* and *b* is a pinned dependency of *c*, then *a* is implicitly a pinned dependency of *c*. This change is only breaking if your build process assumes non-transitivity. - 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. #### :nail_care: Polish