From 5f08d1ced7fa10e3c36bd81124856a456c900d12 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 9 Dec 2022 14:03:50 +0100 Subject: [PATCH] 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. --- CHANGELOG.md | 2 +- jscomp/frontend/ast_core_type.ml | 8 ++++---- jscomp/frontend/ast_external_process.ml | 7 ++++++- jscomp/test/UncurriedExternals.js | 23 ++++++++++++++++++++++- jscomp/test/UncurriedExternals.res | 17 +++++++++++++---- 5 files changed, 46 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b5b191fdb2..25193b2674 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/jscomp/frontend/ast_core_type.ml b/jscomp/frontend/ast_core_type.ml index bdb1924b3e..226bd2737c 100644 --- a/jscomp/frontend/ast_core_type.ml +++ b/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 = diff --git a/jscomp/frontend/ast_external_process.ml b/jscomp/frontend/ast_external_process.ml index ddb74a2f30..f9164f161c 100644 --- a/jscomp/frontend/ast_external_process.ml +++ b/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 diff --git a/jscomp/test/UncurriedExternals.js b/jscomp/test/UncurriedExternals.js index 6a3cbf9c40..73837d340d 100644 --- a/jscomp/test/UncurriedExternals.js +++ b/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 */ diff --git a/jscomp/test/UncurriedExternals.res b/jscomp/test/UncurriedExternals.res index c3795352d1..5a9b875453 100644 --- a/jscomp/test/UncurriedExternals.res +++ b/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)