Fix parsing/printing uncurried functions with type parameters

Author: cristianoc

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
+
 #### :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

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 ->

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 ->