New internal representation for uncurried types. (#5870)

* Rough test of different runtime representation for uncurried types.

Only for arity 5.
The representation of `(. int, int) => string` would be `Js.uncurried( ((int,int)=>int,  [unit, unit])` where the second type parameter encodes the arity.
Does not require to pre-declare all the arities.

* More cases.

* Remove code duplication.

* Translcore has code to translate uncurried function definitions with `#fn_mk`.

* Use variant for arity.

* More cases where the uncurried representation is hardcoded.

* Change representation: pass arity in an attribute.

Using a constraint to determine the arity in a function definition is problematic as the constraint limits type propagation during inference.
Instead, pass the arity via an attribute @res.arity on the Js.Uncurried variant.
And specialize the type checker to handle that arity and use type unification to propagate the arity.

* Use built-in type `uncurried$` with one variant `Uncurried$`.

* Move arity 0 onto new representation.

* Adapt error messages to new uncurried representation.

* Rename `[#2]` to `[#Has_arity2]`

* Rename uncurried$ to function$

* More robust cycle1 test w.r.t. stale artifacts.

* Turn on new uncurried representation for all arities.

* Update outcome printer tests to new uncurried representation.

* Adapt genType to new uncurried representation.

* Remove old uses of Js.Fn.

* Unused `js_fn`.

* Single source of truth for uncurried ast operations shared with syntax.

* Update CHANGELOG.md

Author: cristianoc

CHANGELOG.md

@@ -56,6 +56,7 @@ These are only breaking changes for unformatted code.
 - Treat `@meth` annotation as making the type uncurried for backwards compatibitly with some examples https://github.com/rescript-lang/rescript-compiler/pull/5845
 - Process `@set` annotation for field update as generating an uncurried function https://github.com/rescript-lang/rescript-compiler/pull/5846
 - Treat uncurried application of primitives like curried application, which produces better output https://github.com/rescript-lang/rescript-compiler/pull/5851
+- New internal representation for uncurried functions using built-in type `function$<fun_type, arity>` this avoids having to declare all the possible arities ahead of time https://github.com/rescript-lang/rescript-compiler/pull/5870
 
 # 10.1.1
 

Makefile

@@ -34,7 +34,7 @@ test-syntax-roundtrip: build
 	bash ./scripts/testok.sh
 
 test-gentype: build
-	make -C jscomp/gentype_tests/typescript-react-example test
+	make -C jscomp/gentype_tests/typescript-react-example clean test
 
 test-all: test test-gentype
 

jscomp/build_tests/cycle1/input.js

@@ -5,6 +5,8 @@ const fs = require('fs')
 const path = require('path')
 var rescript_exe = require("../../../scripts/bin_path").rescript_exe
 
+cp.execSync(`${rescript_exe} clean -with-deps`, { cwd: __dirname, });
+
 var output = cp.spawnSync(rescript_exe, { encoding: "utf8", shell: true });
 
 assert(/is dangling/.test(output.stdout));

jscomp/frontend/ast_core_type.ml

@@ -132,7 +132,7 @@ let get_uncurry_arity (ty : t) =
 
 let get_curry_arity (ty : t) =
   match ty.ptyp_desc with
-  | Ptyp_constr ({ txt = Ldot (Ldot (Lident "Js", "Fn"), _) }, [ t ]) ->
+  | Ptyp_constr ({ txt = Lident "function$" }, [ t; _ ]) ->
       get_uncurry_arity_aux t 0
   | _ -> get_uncurry_arity_aux ty 0
 

jscomp/frontend/ast_core_type_class_type.ml

@@ -71,9 +71,9 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
    ptyp_desc =
      ( Ptyp_arrow (label, args, body)
      | Ptyp_constr
-         (* Js.Fn.xx is re-wrapped around only in case Nothing below *)
-         ( { txt = Ldot (Ldot (Lident "Js", "Fn"), _) },
-           [ { ptyp_desc = Ptyp_arrow (label, args, body) } ] ) );
+         (* function$<...> is re-wrapped around only in case Nothing below *)
+         ( { txt = Lident "function$" },
+           [ { ptyp_desc = Ptyp_arrow (label, args, body) }; _ ] ) );
    (* let it go without regard label names,
       it will report error later when the label is not empty
    *)

jscomp/frontend/ast_external_process.ml

@@ -868,15 +868,19 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
     Location.raise_errorf ~loc
       "%@uncurry can not be applied to the whole definition";
   let prim_name_with_source = { name = prim_name; source = External } in
-  let type_annotation, build_uncurried_type = match type_annotation.ptyp_desc with
-    | Ptyp_constr ({txt = Ldot(Ldot(Lident "Js", "Fn"), arity_);_} as lid, [t]) ->
-      t, fun ~arity x ->
-          let arity = match arity with
-            | Some arity -> "arity" ^ string_of_int arity
-            | None -> arity_ in
-          let lid = {lid with txt = Longident.Ldot(Ldot(Lident "Js", "Fn"), arity)} in
-          {x with Parsetree.ptyp_desc = Ptyp_constr (lid, [x])}
-    | _ -> type_annotation, fun ~arity:_ x -> x in
+  let type_annotation, build_uncurried_type =
+    match type_annotation.ptyp_desc with
+    | Ptyp_constr (({ txt = Lident "function$"; _ } as lid), [ t; arity_ ]) ->
+        ( t,
+          fun ~arity x ->
+            let tArity =
+              match arity with
+              | Some arity -> Ast_uncurried.arityType ~loc arity
+              | None -> arity_
+            in
+            { x with Parsetree.ptyp_desc = Ptyp_constr (lid, [ x; tArity ]) } )
+    | _ -> (type_annotation, fun ~arity:_ x -> x)
+  in
   let result_type, arg_types_ty =
     (* Note this assumes external type is syntatic (no abstraction)*)
     Ast_core_type.list_of_arrow type_annotation

jscomp/frontend/ast_literal.ml

@@ -55,8 +55,6 @@ module Lid = struct
 
   let opaque : t = Ldot (js_internal, "opaque")
 
-  let js_fn : t = Ldot (Lident "Js", "Fn")
-
   let js_oo : t = Lident "Js_OO"
 
   let js_meth_callback : t = Ldot (js_oo, "Callback")

jscomp/frontend/ast_literal.mli

@@ -39,8 +39,6 @@ module Lid : sig
 
   val type_int : t
 
-  val js_fn : t
-
   val js_internal_full_apply : t
 
   val opaque : t

jscomp/frontend/ast_typ_uncurry.ml

@@ -23,9 +23,7 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 type typ = Parsetree.core_type
-
 type 'a cxt = Ast_helper.loc -> Bs_ast_mapper.mapper -> 'a
-
 type uncurry_type_gen = (Asttypes.arg_label -> typ -> typ -> typ) cxt
 
 module Typ = Ast_helper.Typ
@@ -63,10 +61,5 @@ let to_uncurry_type loc (mapper : Bs_ast_mapper.mapper)
   let fn_type = Typ.arrow ~loc label first_arg typ in
   let arity = Ast_core_type.get_uncurry_arity fn_type in
   match arity with
-  | Some 0 ->
-      Typ.constr { txt = Ldot (Ast_literal.Lid.js_fn, "arity0"); loc } [ typ ]
-  | Some n ->
-      Typ.constr
-        { txt = Ldot (Ast_literal.Lid.js_fn, "arity" ^ string_of_int n); loc }
-        [ fn_type ]
+  | Some arity -> Ast_uncurried.uncurriedType ~loc ~arity fn_type
   | None -> assert false

jscomp/frontend/ast_uncurry_gen.ml

@@ -67,8 +67,9 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label
                [ Typ.any ~loc () ]) );
       ] )
 
-let to_uncurry_fn loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label)
-    pat body async : Parsetree.expression_desc =
+let to_uncurry_fn (e : Parsetree.expression) (self : Bs_ast_mapper.mapper)
+    (label : Asttypes.arg_label) pat body async : Parsetree.expression =
+  let loc = e.pexp_loc in
   Bs_syntaxerr.optional_err loc label;
   let rec aux acc (body : Parsetree.expression) =
     match Ast_attributes.process_attributes_rev body.pexp_attributes with
@@ -97,7 +98,9 @@ let to_uncurry_fn loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label)
     | _ -> len
   in
   Bs_syntaxerr.err_large_arity loc arity;
-  let arity_s = string_of_int arity in
-  Pexp_record
-    ( [ ({ txt = Ldot (Ast_literal.Lid.js_fn, "I" ^ arity_s); loc }, body) ],
-      None )
+  let fun_exp = Ast_uncurried.uncurriedFun ~loc ~arity body in
+  {
+    e with
+    pexp_desc = fun_exp.pexp_desc;
+    pexp_attributes = fun_exp.pexp_attributes @ e.pexp_attributes;
+  }