Support @uncurry externals with uncurried types.

So existing externals can be used without change in uncurried mode, without giving an error. That said, the `@uncurry` annotation becomes redundant in those cases.

Author: cristianoc

CHANGELOG.md

@@ -19,7 +19,7 @@
 - Add support for unary uncurried pipe in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/5804
 - Add support for partial application of uncurried functions: with uncurried application one can provide a
 subset of the arguments, and return a curried type with the remaining ones https://github.com/rescript-lang/rescript-compiler/pull/5805
-- Add support for uncurried externals https://github.com/rescript-lang/rescript-compiler/pull/5815 https://github.com/rescript-lang/rescript-compiler/pull/5819 https://github.com/rescript-lang/rescript-compiler/pull/5830
+- Add support for uncurried externals https://github.com/rescript-lang/rescript-compiler/pull/5815 https://github.com/rescript-lang/rescript-compiler/pull/5819 https://github.com/rescript-lang/rescript-compiler/pull/5830 https://github.com/rescript-lang/rescript-compiler/pull/5894
 - Parser/Printer: unify uncurried functions of arity 0, and of arity 1 taking unit. There's now only arity 1 in the source language. https://github.com/rescript-lang/rescript-compiler/pull/5825
 - Add support for default arguments in uncurried functions https://github.com/rescript-lang/rescript-compiler/pull/5835
 - Inline uncurried application when it is safe https://github.com/rescript-lang/rescript-compiler/pull/5847

jscomp/frontend/ast_core_type.ml

@@ -131,10 +131,10 @@ let get_uncurry_arity (ty : t) =
   | _ -> None
 
 let get_curry_arity (ty : t) =
-  match ty.ptyp_desc with
-  | Ptyp_constr ({ txt = Lident "function$" }, [ t; _ ]) ->
-      get_uncurry_arity_aux t 0
-  | _ -> get_uncurry_arity_aux ty 0
+  if Ast_uncurried.typeIsUncurriedFun ty then
+    let arity, _ = Ast_uncurried.typeExtractUncurriedFun ty in
+    arity
+  else get_uncurry_arity_aux ty 0
 
 (* add hoc for bs.send.pipe *)
 let rec get_curry_labels (ty : t) acc =

jscomp/frontend/ast_external_process.ml

@@ -67,7 +67,12 @@ let spec_of_ptyp (nolabel : bool) (ptyp : Parsetree.core_type) :
       (* Unwrap attribute can only be attached to things like `[a of a0 | b of b0]` *)
       | _ -> Bs_syntaxerr.err ptyp.ptyp_loc Invalid_bs_unwrap_type)
   | `Uncurry opt_arity -> (
-      let real_arity = Ast_core_type.get_uncurry_arity ptyp in
+      let real_arity =
+        if Ast_uncurried.typeIsUncurriedFun ptyp then
+          let arity, _ = Ast_uncurried.typeExtractUncurriedFun ptyp in
+          Some arity
+        else
+          Ast_core_type.get_uncurry_arity ptyp in
       match (opt_arity, real_arity) with
       | Some arity, None -> Fn_uncurry_arity arity
       | None, None -> Bs_syntaxerr.err ptyp.ptyp_loc Canot_infer_arity_by_syntax

jscomp/test/UncurriedExternals.js

@@ -1,5 +1,6 @@
 'use strict';
 
+var React = require("react");
 
 function dd(param) {
   throw {
@@ -46,6 +47,14 @@ function tsiU(c) {
     });
 }
 
+var match = React.useState(function () {
+      return 3;
+    });
+
+var StandardNotation_get = match[0];
+
+var StandardNotation_set = match[1];
+
 var StandardNotation = {
   dd: dd,
   h: h,
@@ -57,7 +66,9 @@ var StandardNotation = {
   te: te,
   tcr: tcr,
   tsiC: tsiC,
-  tsiU: tsiU
+  tsiU: tsiU,
+  get: StandardNotation_get,
+  set: StandardNotation_set
 };
 
 function dd$1(param) {
@@ -105,6 +116,14 @@ function tsiU$1(c) {
     });
 }
 
+var match$1 = React.useState(function (param) {
+      return 3;
+    });
+
+var get = match$1[0];
+
+var set = match$1[1];
+
 exports.StandardNotation = StandardNotation;
 exports.dd = dd$1;
 exports.h = h$1;
@@ -117,4 +136,6 @@ exports.te = te$1;
 exports.tcr = tcr$1;
 exports.tsiC = tsiC$1;
 exports.tsiU = tsiU$1;
+exports.get = get;
+exports.set = set;
 /* h Not a pure module */

jscomp/test/UncurriedExternals.res

@@ -24,14 +24,19 @@ module StandardNotation = {
   external toException: (. exn) => exn = "%identity"
   let te = toException(. Not_found)
 
-  @obj external ccreate : (. unit) => string = ""
+  @obj external ccreate: (. unit) => string = ""
   let tcr = ccreate(.)
 
   type counter
   @set external setIncrementC: (counter, @this (counter, int) => unit) => unit = "increment"
   let tsiC = c => setIncrementC(c, @this (me, amount) => Js.log(me))
   @set external setIncrementU: (. counter, @this (. counter, int) => unit) => unit = "increment"
-  let tsiU = c => setIncrementU(. c, @this (. me, amount) => Js.log(me))
+  let tsiU = c => setIncrementU(.c, @this (. me, amount) => Js.log(me))
+
+  @module("react")
+  external useState: (@uncurry (unit => 'state)) => ('state, ('state => 'state) => unit) =
+    "useState"
+  let (get, set) = useState(() => 3)
 }
 
 @@uncurried
@@ -61,11 +66,15 @@ let tc = copy("abc")
 external toException: exn => exn = "%identity"
 let te = toException(Not_found)
 
-@obj external ucreate : unit => string = ""
+@obj external ucreate: unit => string = ""
 let tcr = ucreate()
 
 type counter
 @set external setIncrementC: (. counter, @this (. counter, int) => unit) => unit = "increment"
-let tsiC = c => setIncrementC(. c, @this (. me, amount) => Js.log(. me))
+let tsiC = c => setIncrementC(.c, @this (. me, amount) => Js.log(. me))
 @set external setIncrementU: (counter, @this (counter, int) => unit) => unit = "increment"
 let tsiU = c => setIncrementU(c, @this (me, amount) => Js.log(. me))
+
+@module("react")
+external useState: (@uncurry (unit => 'state)) => ('state, ('state => 'state) => unit) = "useState"
+let (get, set) = useState(() => 3)