Workaround for @asin labels in uncurried externals. (#6527)

* Workaround for `@as`in labels in uncurried externals.

Examples like this:
```
@obj
external makeOptions: (
  ~objectMode: @as(json`false`) _,
  ~name: string,
  unit,
) => int = ""
```

change the arity of the function.
The arity of uncurried functions is determined at parsing type.
This means that this peculiarity of externals affects parsing.
This PR gives an approximate workaround based on the labelled arg having `@as`, and the type being `_` (the any type).

Fixes #6517

* Example with 2 default args.

* Add example outside externals, which should not fail.

* Restrict workaround to only fire inside an external.

Author: cristianoc

CHANGELOG.md

@@ -22,6 +22,7 @@
 - GenType: only export types (not values) from module types. https://github.com/rescript-lang/rescript-compiler/pull/6516
 - Fix compiler crash with unboxed variant definition with only 1 constructor. https://github.com/rescript-lang/rescript-compiler/pull/6523
 - GenType: support mutual recursive types inside modules. https://github.com/rescript-lang/rescript-compiler/pull/6528
+- Workaround for `@as`in labels in uncurried externals, which was broken. https://github.com/rescript-lang/rescript-compiler/pull/6527
 
 # 11.0.0-rc.7
 

jscomp/syntax/src/res_core.ml

@@ -151,6 +151,10 @@ module ErrorMessages = struct
      mean `#" ^ number ^ "`?"
 end
 
+module InExternal = struct
+  let status = ref false
+end
+
 let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr [])
 let uncurriedAppAttr = (Location.mknoloc "res.uapp", Parsetree.PStr [])
 let ternaryAttr = (Location.mknoloc "res.ternary", Parsetree.PStr [])
@@ -4276,6 +4280,22 @@ and parseEs6ArrowType ~attrs p =
             p.uncurried_config |> Res_uncurried.fromDotted ~dotted
           in
           let loc = mkLoc startPos endPos in
+          let arity =
+            (* Workaround for ~lbl: @as(json`false`) _, which changes the arity *)
+            match argLbl with
+            | Labelled _s ->
+              let typ_is_any =
+                match typ.ptyp_desc with
+                | Ptyp_any -> true
+                | _ -> false
+              in
+              let has_as =
+                Ext_list.exists typ.ptyp_attributes (fun (x, _) -> x.txt = "as")
+              in
+              if !InExternal.status && typ_is_any && has_as then arity - 1
+              else arity
+            | _ -> arity
+          in
           let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in
           if uncurried && (paramNum = 1 || p.uncurried_config = Legacy) then
             (paramNum - 1, Ast_uncurried.uncurriedType ~loc ~arity tArg, 1)
@@ -5441,6 +5461,8 @@ and parseTypeDefinitionOrExtension ~attrs p =
 
 (* external value-name : typexp = external-declaration *)
 and parseExternalDef ~attrs ~startPos p =
+  let inExternal = !InExternal.status in
+  InExternal.status := true;
   Parser.leaveBreadcrumb p Grammar.External;
   Parser.expect Token.External p;
   let name, loc = parseLident p in
@@ -5465,6 +5487,7 @@ and parseExternalDef ~attrs ~startPos p =
   let loc = mkLoc startPos p.prevEndPos in
   let vb = Ast_helper.Val.mk ~loc ~attrs ~prim name typExpr in
   Parser.eatBreadcrumb p;
+  InExternal.status := inExternal;
   vb
 
 (* constr-def ::=

jscomp/test/AsInUncurriedExternals.js

@@ -0,0 +1,16 @@
+@@uncurried
+
+@obj
+external makeOptions: (
+  ~objectMode: @as(json`false`) _,
+  ~name: string,
+  ~someOther: @as(json`true`) _,
+  unit,
+) => int = ""
+
+let mo = makeOptions
+
+let options = mo(~name="foo", ())
+
+let shouldNotFail: (~objectMode: @as(json`false`) _, ~name: string) => int = (~objectMode, ~name) =>
+  3