diff --git a/CHANGELOG.md b/CHANGELOG.md index 209e577af8..7365413ff1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -42,7 +42,8 @@ These are only breaking changes for unformatted code. - Fix printing of nested types in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/5826 - Fix issue in printing uncurried callbacks https://github.com/rescript-lang/rescript-compiler/pull/5828 - Fix formatting uncurried functions with attributes https://github.com/rescript-lang/rescript-compiler/pull/5829 - +- Fix parsing/printing uncurried functions with type parameters https://github.com/rescript-lang/rescript-compiler/pull/5849 + #### :nail_care: Polish - Syntax: process uncurried types explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5784 https://github.com/rescript-lang/rescript-compiler/pull/5822 diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 4a8661df36..8caaab84f9 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -49806,7 +49806,7 @@ let funExpr expr = collectNewTypes (stringLoc :: acc) returnExpr | returnExpr -> (List.rev acc, returnExpr) in - let rec collect ~uncurried attrsBefore acc expr = + let rec collect ~uncurried ~nFun attrsBefore acc expr = match expr with | { pexp_desc = @@ -49820,29 +49820,36 @@ let funExpr expr = | {pexp_desc = Pexp_newtype (stringLoc, rest); pexp_attributes = attrs} -> let stringLocs, returnExpr = collectNewTypes [stringLoc] rest in let param = NewTypes {attrs; locs = stringLocs} in - collect ~uncurried attrsBefore (param :: acc) returnExpr + collect ~uncurried ~nFun attrsBefore (param :: acc) returnExpr | { pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = []; } -> let parameter = Parameter {attrs = []; lbl; defaultExpr; pat = pattern} in - collect ~uncurried attrsBefore (parameter :: acc) returnExpr + collect ~uncurried ~nFun:(nFun + 1) attrsBefore (parameter :: acc) + returnExpr (* If a fun has an attribute, then it stops here and makes currying. i.e attributes outside of (...), uncurried `(.)` and `async` make currying *) | {pexp_desc = Pexp_fun _} -> (uncurried, attrsBefore, List.rev acc, expr) + | { + pexp_desc = + Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, expr)], None); + } + when nFun = 0 -> + collect ~uncurried:true ~nFun attrsBefore acc expr | expr -> (uncurried, attrsBefore, List.rev acc, expr) in match expr with | {pexp_desc = Pexp_fun _} -> - collect ~uncurried:false expr.pexp_attributes [] + collect ~uncurried:false ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} | { pexp_desc = Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, expr)], None); } -> - collect ~uncurried:true expr.pexp_attributes [] + collect ~uncurried:true ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} - | _ -> collect ~uncurried:false [] [] expr + | _ -> collect ~uncurried:false ~nFun:0 [] [] expr let processBracesAttr expr = match expr.pexp_attributes with @@ -58043,6 +58050,7 @@ and printExpFunParameter ~state parameter cmtTbl = [ printAttributes ~state attrs cmtTbl; Doc.text "type "; + (* XX *) Doc.join ~sep:Doc.space (List.map (fun lbl -> diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 4e61120664..f0eb935612 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -49806,7 +49806,7 @@ let funExpr expr = collectNewTypes (stringLoc :: acc) returnExpr | returnExpr -> (List.rev acc, returnExpr) in - let rec collect ~uncurried attrsBefore acc expr = + let rec collect ~uncurried ~nFun attrsBefore acc expr = match expr with | { pexp_desc = @@ -49820,29 +49820,36 @@ let funExpr expr = | {pexp_desc = Pexp_newtype (stringLoc, rest); pexp_attributes = attrs} -> let stringLocs, returnExpr = collectNewTypes [stringLoc] rest in let param = NewTypes {attrs; locs = stringLocs} in - collect ~uncurried attrsBefore (param :: acc) returnExpr + collect ~uncurried ~nFun attrsBefore (param :: acc) returnExpr | { pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = []; } -> let parameter = Parameter {attrs = []; lbl; defaultExpr; pat = pattern} in - collect ~uncurried attrsBefore (parameter :: acc) returnExpr + collect ~uncurried ~nFun:(nFun + 1) attrsBefore (parameter :: acc) + returnExpr (* If a fun has an attribute, then it stops here and makes currying. i.e attributes outside of (...), uncurried `(.)` and `async` make currying *) | {pexp_desc = Pexp_fun _} -> (uncurried, attrsBefore, List.rev acc, expr) + | { + pexp_desc = + Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, expr)], None); + } + when nFun = 0 -> + collect ~uncurried:true ~nFun attrsBefore acc expr | expr -> (uncurried, attrsBefore, List.rev acc, expr) in match expr with | {pexp_desc = Pexp_fun _} -> - collect ~uncurried:false expr.pexp_attributes [] + collect ~uncurried:false ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} | { pexp_desc = Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, expr)], None); } -> - collect ~uncurried:true expr.pexp_attributes [] + collect ~uncurried:true ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} - | _ -> collect ~uncurried:false [] [] expr + | _ -> collect ~uncurried:false ~nFun:0 [] [] expr let processBracesAttr expr = match expr.pexp_attributes with @@ -58043,6 +58050,7 @@ and printExpFunParameter ~state parameter cmtTbl = [ printAttributes ~state attrs cmtTbl; Doc.text "type "; + (* XX *) Doc.join ~sep:Doc.space (List.map (fun lbl -> @@ -163461,31 +163469,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context | None -> parseParameters p in let parameters = + let updateAttrs attrs = arrowAttrs @ attrs in + let updatePos pos = + match arrowStartPos with + | Some startPos -> startPos + | None -> pos + in match parameters with | TermParameter p :: rest -> - TermParameter - { - p with - attrs = arrowAttrs @ p.attrs; - pos = - (match arrowStartPos with - | Some startPos -> startPos - | None -> p.pos); - } + TermParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} :: rest | TypeParameter p :: rest -> - TypeParameter - { - p with - attrs = arrowAttrs @ p.attrs; - pos = - (match arrowStartPos with - | Some startPos -> startPos - | None -> p.pos); - } + TypeParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} :: rest | [] -> parameters in + let parameters = + (* Propagate any dots from type parameters to the first term *) + let rec loop ~dotInType params = + match params with + | (TypeParameter {dotted} as p) :: rest -> + p :: loop ~dotInType:(dotInType || dotted) rest + | TermParameter termParam :: rest -> + TermParameter {termParam with dotted = dotInType || termParam.dotted} + :: rest + | [] -> [] + in + loop ~dotInType:false parameters + in let returnType = match p.Parser.token with | Colon -> @@ -163505,13 +163516,19 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in + let termParameters = + parameters + |> List.filter (function + | TermParameter _ -> true + | TypeParameter _ -> false) + in let bodyNeedsBraces = let isFun = match body.pexp_desc with | Pexp_fun _ -> true | _ -> false in - match parameters with + match termParameters with | TermParameter {dotted} :: _ when (if p.uncurried_by_default then not dotted else dotted) && isFun -> true @@ -163532,7 +163549,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in let _paramNum, arrowExpr, _arity = List.fold_right - (fun parameter (paramNum, expr, arity) -> + (fun parameter (termParamNum, expr, arity) -> match parameter with | TermParameter { @@ -163550,8 +163567,8 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - ( paramNum - 1, + if uncurried && (termParamNum = 1 || not p.uncurried_by_default) then + ( termParamNum - 1, (if true then Ast_helper.Exp.record ~loc [ @@ -163566,17 +163583,13 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context None else funExpr), 1 ) - else (paramNum - 1, funExpr, arity + 1) - | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> - let uncurried = - if p.uncurried_by_default then not dotted else dotted - in - let attrs = if uncurried then uncurriedAppAttr :: attrs else attrs in - ( paramNum - 1, + else (termParamNum - 1, funExpr, arity + 1) + | TypeParameter {dotted = _; attrs; locs = newtypes; pos = startPos} -> + ( termParamNum, makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity )) parameters - (List.length parameters, body, 1) + (List.length termParameters, body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} @@ -163797,6 +163810,8 @@ and parseParameters p = match parseParameterList p with | TermParameter p :: rest -> TermParameter {p with dotted = true; pos = startPos} :: rest + | TypeParameter p :: rest -> + TypeParameter {p with dotted = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 6ca99951ef..4bd0071deb 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -104800,7 +104800,7 @@ let funExpr expr = collectNewTypes (stringLoc :: acc) returnExpr | returnExpr -> (List.rev acc, returnExpr) in - let rec collect ~uncurried attrsBefore acc expr = + let rec collect ~uncurried ~nFun attrsBefore acc expr = match expr with | { pexp_desc = @@ -104814,29 +104814,36 @@ let funExpr expr = | {pexp_desc = Pexp_newtype (stringLoc, rest); pexp_attributes = attrs} -> let stringLocs, returnExpr = collectNewTypes [stringLoc] rest in let param = NewTypes {attrs; locs = stringLocs} in - collect ~uncurried attrsBefore (param :: acc) returnExpr + collect ~uncurried ~nFun attrsBefore (param :: acc) returnExpr | { pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = []; } -> let parameter = Parameter {attrs = []; lbl; defaultExpr; pat = pattern} in - collect ~uncurried attrsBefore (parameter :: acc) returnExpr + collect ~uncurried ~nFun:(nFun + 1) attrsBefore (parameter :: acc) + returnExpr (* If a fun has an attribute, then it stops here and makes currying. i.e attributes outside of (...), uncurried `(.)` and `async` make currying *) | {pexp_desc = Pexp_fun _} -> (uncurried, attrsBefore, List.rev acc, expr) + | { + pexp_desc = + Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, expr)], None); + } + when nFun = 0 -> + collect ~uncurried:true ~nFun attrsBefore acc expr | expr -> (uncurried, attrsBefore, List.rev acc, expr) in match expr with | {pexp_desc = Pexp_fun _} -> - collect ~uncurried:false expr.pexp_attributes [] + collect ~uncurried:false ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} | { pexp_desc = Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, expr)], None); } -> - collect ~uncurried:true expr.pexp_attributes [] + collect ~uncurried:true ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} - | _ -> collect ~uncurried:false [] [] expr + | _ -> collect ~uncurried:false ~nFun:0 [] [] expr let processBracesAttr expr = match expr.pexp_attributes with @@ -113037,6 +113044,7 @@ and printExpFunParameter ~state parameter cmtTbl = [ printAttributes ~state attrs cmtTbl; Doc.text "type "; + (* XX *) Doc.join ~sep:Doc.space (List.map (fun lbl -> @@ -176893,31 +176901,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context | None -> parseParameters p in let parameters = + let updateAttrs attrs = arrowAttrs @ attrs in + let updatePos pos = + match arrowStartPos with + | Some startPos -> startPos + | None -> pos + in match parameters with | TermParameter p :: rest -> - TermParameter - { - p with - attrs = arrowAttrs @ p.attrs; - pos = - (match arrowStartPos with - | Some startPos -> startPos - | None -> p.pos); - } + TermParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} :: rest | TypeParameter p :: rest -> - TypeParameter - { - p with - attrs = arrowAttrs @ p.attrs; - pos = - (match arrowStartPos with - | Some startPos -> startPos - | None -> p.pos); - } + TypeParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} :: rest | [] -> parameters in + let parameters = + (* Propagate any dots from type parameters to the first term *) + let rec loop ~dotInType params = + match params with + | (TypeParameter {dotted} as p) :: rest -> + p :: loop ~dotInType:(dotInType || dotted) rest + | TermParameter termParam :: rest -> + TermParameter {termParam with dotted = dotInType || termParam.dotted} + :: rest + | [] -> [] + in + loop ~dotInType:false parameters + in let returnType = match p.Parser.token with | Colon -> @@ -176937,13 +176948,19 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in + let termParameters = + parameters + |> List.filter (function + | TermParameter _ -> true + | TypeParameter _ -> false) + in let bodyNeedsBraces = let isFun = match body.pexp_desc with | Pexp_fun _ -> true | _ -> false in - match parameters with + match termParameters with | TermParameter {dotted} :: _ when (if p.uncurried_by_default then not dotted else dotted) && isFun -> true @@ -176964,7 +176981,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in let _paramNum, arrowExpr, _arity = List.fold_right - (fun parameter (paramNum, expr, arity) -> + (fun parameter (termParamNum, expr, arity) -> match parameter with | TermParameter { @@ -176982,8 +176999,8 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - ( paramNum - 1, + if uncurried && (termParamNum = 1 || not p.uncurried_by_default) then + ( termParamNum - 1, (if true then Ast_helper.Exp.record ~loc [ @@ -176998,17 +177015,13 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context None else funExpr), 1 ) - else (paramNum - 1, funExpr, arity + 1) - | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> - let uncurried = - if p.uncurried_by_default then not dotted else dotted - in - let attrs = if uncurried then uncurriedAppAttr :: attrs else attrs in - ( paramNum - 1, + else (termParamNum - 1, funExpr, arity + 1) + | TypeParameter {dotted = _; attrs; locs = newtypes; pos = startPos} -> + ( termParamNum, makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity )) parameters - (List.length parameters, body, 1) + (List.length termParameters, body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} @@ -177229,6 +177242,8 @@ and parseParameters p = match parseParameterList p with | TermParameter p :: rest -> TermParameter {p with dotted = true; pos = startPos} :: rest + | TypeParameter p :: rest -> + TypeParameter {p with dotted = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index a294e55848..6cac365f2f 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -1486,31 +1486,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context | None -> parseParameters p in let parameters = + let updateAttrs attrs = arrowAttrs @ attrs in + let updatePos pos = + match arrowStartPos with + | Some startPos -> startPos + | None -> pos + in match parameters with | TermParameter p :: rest -> - TermParameter - { - p with - attrs = arrowAttrs @ p.attrs; - pos = - (match arrowStartPos with - | Some startPos -> startPos - | None -> p.pos); - } + TermParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} :: rest | TypeParameter p :: rest -> - TypeParameter - { - p with - attrs = arrowAttrs @ p.attrs; - pos = - (match arrowStartPos with - | Some startPos -> startPos - | None -> p.pos); - } + TypeParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} :: rest | [] -> parameters in + let parameters = + (* Propagate any dots from type parameters to the first term *) + let rec loop ~dotInType params = + match params with + | (TypeParameter {dotted} as p) :: rest -> + p :: loop ~dotInType:(dotInType || dotted) rest + | TermParameter termParam :: rest -> + TermParameter {termParam with dotted = dotInType || termParam.dotted} + :: rest + | [] -> [] + in + loop ~dotInType:false parameters + in let returnType = match p.Parser.token with | Colon -> @@ -1530,13 +1533,19 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in + let termParameters = + parameters + |> List.filter (function + | TermParameter _ -> true + | TypeParameter _ -> false) + in let bodyNeedsBraces = let isFun = match body.pexp_desc with | Pexp_fun _ -> true | _ -> false in - match parameters with + match termParameters with | TermParameter {dotted} :: _ when (if p.uncurried_by_default then not dotted else dotted) && isFun -> true @@ -1557,7 +1566,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in let _paramNum, arrowExpr, _arity = List.fold_right - (fun parameter (paramNum, expr, arity) -> + (fun parameter (termParamNum, expr, arity) -> match parameter with | TermParameter { @@ -1575,8 +1584,8 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried && (paramNum = 1 || not p.uncurried_by_default) then - ( paramNum - 1, + if uncurried && (termParamNum = 1 || not p.uncurried_by_default) then + ( termParamNum - 1, (if true then Ast_helper.Exp.record ~loc [ @@ -1591,17 +1600,13 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context None else funExpr), 1 ) - else (paramNum - 1, funExpr, arity + 1) - | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> - let uncurried = - if p.uncurried_by_default then not dotted else dotted - in - let attrs = if uncurried then uncurriedAppAttr :: attrs else attrs in - ( paramNum - 1, + else (termParamNum - 1, funExpr, arity + 1) + | TypeParameter {dotted = _; attrs; locs = newtypes; pos = startPos} -> + ( termParamNum, makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity )) parameters - (List.length parameters, body, 1) + (List.length termParameters, body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} @@ -1822,6 +1827,8 @@ and parseParameters p = match parseParameterList p with | TermParameter p :: rest -> TermParameter {p with dotted = true; pos = startPos} :: rest + | TypeParameter p :: rest -> + TypeParameter {p with dotted = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> diff --git a/res_syntax/src/res_parsetree_viewer.ml b/res_syntax/src/res_parsetree_viewer.ml index cb2bf5bcc4..32f74e2f5c 100644 --- a/res_syntax/src/res_parsetree_viewer.ml +++ b/res_syntax/src/res_parsetree_viewer.ml @@ -151,7 +151,7 @@ let funExpr expr = collectNewTypes (stringLoc :: acc) returnExpr | returnExpr -> (List.rev acc, returnExpr) in - let rec collect ~uncurried attrsBefore acc expr = + let rec collect ~uncurried ~nFun attrsBefore acc expr = match expr with | { pexp_desc = @@ -165,29 +165,36 @@ let funExpr expr = | {pexp_desc = Pexp_newtype (stringLoc, rest); pexp_attributes = attrs} -> let stringLocs, returnExpr = collectNewTypes [stringLoc] rest in let param = NewTypes {attrs; locs = stringLocs} in - collect ~uncurried attrsBefore (param :: acc) returnExpr + collect ~uncurried ~nFun attrsBefore (param :: acc) returnExpr | { pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = []; } -> let parameter = Parameter {attrs = []; lbl; defaultExpr; pat = pattern} in - collect ~uncurried attrsBefore (parameter :: acc) returnExpr + collect ~uncurried ~nFun:(nFun + 1) attrsBefore (parameter :: acc) + returnExpr (* If a fun has an attribute, then it stops here and makes currying. i.e attributes outside of (...), uncurried `(.)` and `async` make currying *) | {pexp_desc = Pexp_fun _} -> (uncurried, attrsBefore, List.rev acc, expr) + | { + pexp_desc = + Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, expr)], None); + } + when nFun = 0 -> + collect ~uncurried:true ~nFun attrsBefore acc expr | expr -> (uncurried, attrsBefore, List.rev acc, expr) in match expr with | {pexp_desc = Pexp_fun _} -> - collect ~uncurried:false expr.pexp_attributes [] + collect ~uncurried:false ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} | { pexp_desc = Pexp_record ([({txt = Ldot (Ldot (Lident "Js", "Fn"), _)}, expr)], None); } -> - collect ~uncurried:true expr.pexp_attributes [] + collect ~uncurried:true ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} - | _ -> collect ~uncurried:false [] [] expr + | _ -> collect ~uncurried:false ~nFun:0 [] [] expr let processBracesAttr expr = match expr.pexp_attributes with diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index e3793f7f1b..c4ab4777e3 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -4838,6 +4838,7 @@ and printExpFunParameter ~state parameter cmtTbl = [ printAttributes ~state attrs cmtTbl; Doc.text "type "; + (* XX *) Doc.join ~sep:Doc.space (List.map (fun lbl -> diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 3b61aa41ac..797a2fc43b 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -42,6 +42,14 @@ let _ = @att async (. x) => 34 let _ = preserveAttr(@att (. x) => 34) let _ = preserveAttr(@att async (. x) => 34) +let t0 = (type a b, l: list, x: a) => list{x, ...l} +let t1 = (. type a b, l: list, x: a) => list{x, ...l} +let t2 = (type a b, . l: list, x: a) => list{x, ...l} +let t3 = (. type a b, . l: list, x: a) => list{x, ...l} +let t4 = (. type a b) => (l: list, x: a) => list{x, ...l} +let t5 = (type a b) => (. l: list, x: a) => list{x, ...l} +let t6 = (. type a b) => (. l: list, x: a) => list{x, ...l} + @@uncurried let cApp = foo(. 3) @@ -90,3 +98,8 @@ let _ = @att x => 34 let _ = @att async x => 34 let _ = preserveAttr(@att x => 34) let _ = preserveAttr(@att async x => 34) + +let t0 = (type a b, l: list, x: a) => list{x, ...l} +let t1 = (. type a b, l: list, x: a) => list{x, ...l} +let t2 = (type a b, . l: list, x: a) => list{x, ...l} +let t3 = (. type a b, . l: list, x: a) => list{x, ...l} 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 1c585d60e5..0352fb445c 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -48,6 +48,18 @@ 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 ]) } let _ = preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@res.async ][@att ]) } +let t0 (type a) (type b) (l : a list) (x : a) = x :: l +let t1 (type a) (type b) = + { Js.Fn.I2 = (fun (l : a list) -> fun (x : a) -> x :: l) } +let t2 (type a) (type b) = + { Js.Fn.I2 = (fun (l : a list) -> fun (x : a) -> x :: l) } +let t3 (type a) (type b) = + { Js.Fn.I2 = (fun (l : a list) -> fun (x : a) -> x :: l) } +let t4 (type a) (type b) (l : a list) (x : a) = x :: l +let t5 (type a) (type b) = + { Js.Fn.I2 = (fun (l : a list) -> fun (x : a) -> x :: l) } +let t6 (type a) (type b) = + { Js.Fn.I2 = (fun (l : a list) -> fun (x : a) -> x :: l) } [@@@uncurried ] let cApp = foo 3 let uApp = ((foo 3)[@res.uapp ]) @@ -101,4 +113,9 @@ let _ = { Js.Fn.I1 = ((fun x -> 34)[@att ]) } let _ = { Js.Fn.I1 = ((fun x -> 34)[@res.async ][@att ]) } let _ = ((preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@att ]) })[@res.uapp ]) let _ = ((preserveAttr { Js.Fn.I1 = ((fun x -> 34)[@res.async ][@att ]) }) - [@res.uapp ]) \ No newline at end of file + [@res.uapp ]) +let t0 (type a) (type b) = + { Js.Fn.I2 = (fun (l : a list) -> fun (x : a) -> x :: l) } +let t1 (type a) (type b) (l : a list) (x : a) = x :: l +let t2 (type a) (type b) (l : a list) (x : a) = x :: l +let t3 (type a) (type b) (l : a list) (x : a) = x :: l \ 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 b10dabd023..5fff9ed943 100644 --- a/res_syntax/tests/printer/expr/UncurriedByDefault.res +++ b/res_syntax/tests/printer/expr/UncurriedByDefault.res @@ -49,6 +49,14 @@ let _ = @att async (. x) => 34 let _ = preserveAttr(@att (. x) => 34) let _ = preserveAttr(@att async (. x) => 34) +let t0 = (type a b, l: list, x: a) => list{x, ...l} +let t1 = (. type a b, l: list, x: a) => list{x, ...l} +let t2 = (type a b, . l: list, x: a) => list{x, ...l} +let t3 = (. type a b, . l: list, x: a) => list{x, ...l} +let t4 = (. type a b) => (l: list, x: a) => list{x, ...l} +let t5 = (type a b) => (. l: list, x: a) => list{x, ...l} +let t6 = (. type a b) => (. l: list, x: a) => list{x, ...l} + @@uncurried let cApp = foo(. 3) @@ -102,3 +110,8 @@ let _ = @att x => 34 let _ = @att async x => 34 let _ = preserveAttr(@att x => 34) let _ = preserveAttr(@att async x => 34) + +let t0 = (type a b, l: list, x: a) => list{x, ...l} +let t1 = (. type a b, l: list, x: a) => list{x, ...l} +let t2 = (type a b, . l: list, x: a) => list{x, ...l} +let t3 = (. type a b, . l: list, x: a) => list{x, ...l} diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index b061eb46cf..a6b95d53a4 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -49,6 +49,14 @@ let _ = @att async (. x) => 34 let _ = preserveAttr(@att (. x) => 34) let _ = preserveAttr(@att async (. x) => 34) +let t0 = (type a b, l: list, x: a) => list{x, ...l} +let t1 = (. type a b, l: list, x: a) => list{x, ...l} +let t2 = (. type a b, l: list, x: a) => list{x, ...l} +let t3 = (. type a b, l: list, x: a) => list{x, ...l} +let t4 = (type a b, l: list, x: a) => list{x, ...l} +let t5 = (. type a b, l: list, x: a) => list{x, ...l} +let t6 = (. type a b, l: list, x: a) => list{x, ...l} + @@uncurried let cApp = foo(. 3) @@ -102,3 +110,8 @@ let _ = @att x => 34 let _ = @att async x => 34 let _ = preserveAttr(@att x => 34) let _ = preserveAttr(@att async x => 34) + +let t0 = (type a b, l: list, x: a) => list{x, ...l} +let t1 = (. type a b, l: list, x: a) => list{x, ...l} +let t2 = (. type a b, l: list, x: a) => list{x, ...l} +let t3 = (. type a b, l: list, x: a) => list{x, ...l}