Fix parsing type annotations starting with 'a in uncurried mode.

Author: cristianoc

CHANGELOG.md

@@ -40,7 +40,7 @@ These are only breaking changes for unformatted code.
 
 #### :nail_care: Polish
 
-- Syntax: process uncurried types explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5784
+- 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
 - Syntax: process uncurried function declarations explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5794
 - PPX V4: allow uncurried `make` function and treat it like a curried one [#5802](https://github.com/rescript-lang/rescript-compiler/pull/5802) [#5808](https://github.com/rescript-lang/rescript-compiler/pull/5808) [#5812](https://github.com/rescript-lang/rescript-compiler/pull/5812)
 

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -166277,6 +166277,7 @@ and parsePolyTypeExpr p =
   let startPos = p.Parser.startPos in
   match p.Parser.token with
   | SingleQuote -> (
+    (* XX here *)
     let vars = parseTypeVarList p in
     match vars with
     | _v1 :: _v2 :: _ ->
@@ -166296,7 +166297,12 @@ and parsePolyTypeExpr p =
         let typ = Ast_helper.Typ.var ~loc:var.loc var.txt in
         let returnType = parseTypExpr ~alias:false p in
         let loc = mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos in
-        Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType
+        let tFun = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in
+        if p.uncurried_by_default then
+          Ast_helper.Typ.constr ~loc
+            {txt = Ldot (Ldot (Lident "Js", "Fn"), "arity1"); loc}
+            [tFun]
+        else tFun
       | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt)
     | _ -> assert false)
   | _ -> parseTypExpr p

lib/4.06.1/whole_compiler.ml

@@ -179709,6 +179709,7 @@ and parsePolyTypeExpr p =
   let startPos = p.Parser.startPos in
   match p.Parser.token with
   | SingleQuote -> (
+    (* XX here *)
     let vars = parseTypeVarList p in
     match vars with
     | _v1 :: _v2 :: _ ->
@@ -179728,7 +179729,12 @@ and parsePolyTypeExpr p =
         let typ = Ast_helper.Typ.var ~loc:var.loc var.txt in
         let returnType = parseTypExpr ~alias:false p in
         let loc = mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos in
-        Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType
+        let tFun = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in
+        if p.uncurried_by_default then
+          Ast_helper.Typ.constr ~loc
+            {txt = Ldot (Ldot (Lident "Js", "Fn"), "arity1"); loc}
+            [tFun]
+        else tFun
       | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt)
     | _ -> assert false)
   | _ -> parseTypExpr p

res_syntax/src/res_core.ml

@@ -3890,6 +3890,7 @@ and parsePolyTypeExpr p =
   let startPos = p.Parser.startPos in
   match p.Parser.token with
   | SingleQuote -> (
+    (* XX here *)
     let vars = parseTypeVarList p in
     match vars with
     | _v1 :: _v2 :: _ ->
@@ -3909,7 +3910,12 @@ and parsePolyTypeExpr p =
         let typ = Ast_helper.Typ.var ~loc:var.loc var.txt in
         let returnType = parseTypExpr ~alias:false p in
         let loc = mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos in
-        Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType
+        let tFun = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in
+        if p.uncurried_by_default then
+          Ast_helper.Typ.constr ~loc
+            {txt = Ldot (Ldot (Lident "Js", "Fn"), "arity1"); loc}
+            [tFun]
+        else tFun
       | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt)
     | _ -> assert false)
   | _ -> parseTypExpr p

res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res

@@ -31,6 +31,9 @@ type upp = (. ()) => (. ()) => int
 type uu2 = (. unit, unit) => unit
 type up2 = (. (), ()) => unit
 
+let uannpoly: (. 'a) => string = xx
+let uannint: (. int) => string = xx
+
 @@uncurried
 
 let cApp = foo(. 3)
@@ -67,4 +70,7 @@ type upp = () => () => int
 type uu2 = (unit, unit) => unit
 type up2 = ((), ()) => unit
 
-let pipe1 = 3->f
+let pipe1 = 3->f
+
+let uannpoly: 'a => string = xx
+let uannint: int => string = xx

res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt

@@ -40,6 +40,8 @@ type nonrec uup = (unit -> int Js.Fn.arity0) Js.Fn.arity1
 type nonrec upp = int Js.Fn.arity0 Js.Fn.arity0
 type nonrec uu2 = (unit -> unit -> unit) Js.Fn.arity2
 type nonrec up2 = (unit -> unit -> unit) Js.Fn.arity2
+let (uannpoly : ('a -> string) Js.Fn.arity1) = xx
+let (uannint : (int -> string) Js.Fn.arity1) = xx
 [@@@uncurried ]
 let cApp = foo 3
 let uApp = ((foo 3)[@bs ])
@@ -84,4 +86,6 @@ type nonrec uup = (unit -> int Js.Fn.arity0) Js.Fn.arity1
 type nonrec upp = int Js.Fn.arity0 Js.Fn.arity0
 type nonrec uu2 = (unit -> unit -> unit) Js.Fn.arity2
 type nonrec up2 = (unit -> unit -> unit) Js.Fn.arity2
-let pipe1 = 3 |.u f
+let pipe1 = 3 |.u f
+let (uannpoly : ('a -> string) Js.Fn.arity1) = xx
+let (uannint : (int -> string) Js.Fn.arity1) = xx