Special case uncurried fun with 1 arg of unit type

CHANGELOG.md

@@ -12,6 +12,9 @@
 
 # 11.0.0-alpha.2 (Unreleased)
 
+#### :bug: Bug Fix
+- Special case generation of uncurried functions with 1 argument of unit type so they don't take a parameter. https://github.com/rescript-lang/rescript-compiler/pull/6131
+
 ## :rocket: Main New Features
 
 - Add support for type coercion `:>` for records. https://github.com/rescript-lang/rescript-compiler/pull/5721

jscomp/core/js_exp_make.ml

@@ -204,7 +204,8 @@ let unit : t = { expression_desc = Undefined; comment = None }
    [Js_fun_env.empty] is a mutable state ..
 *)
 
-let ocaml_fun ?comment ?immutable_mask ~return_unit ~async params body : t =
+let ocaml_fun ?comment ?immutable_mask ~return_unit ~async ~oneUnitArg params body : t =
+  let params = if oneUnitArg then [] else params in
   let len = List.length params in
   {
     expression_desc =

jscomp/core/js_exp_make.mli

@@ -89,6 +89,7 @@ val ocaml_fun :
   ?immutable_mask:bool array ->
   return_unit:bool ->
   async:bool ->
+  oneUnitArg:bool ->
   J.ident list ->
   J.block ->
   t

jscomp/core/lam.ml

@@ -273,7 +273,7 @@ let rec is_eta_conversion_exn params inner_args outer_args : t list =
   | x :: xs, Lvar y :: ys, r :: rest when Ident.same x y ->
       r :: is_eta_conversion_exn xs ys rest
   | ( x :: xs,
-      Lprim ({ primitive = Pjs_fn_make _; args = [ Lvar y ] } as p) :: ys,
+      Lprim ({ primitive = Pjs_fn_make _ | Pjs_fn_make_unit; args = [ Lvar y ] } as p) :: ys,
       r :: rest )
     when Ident.same x y ->
       Lprim { p with args = [ r ] } :: is_eta_conversion_exn xs ys rest

jscomp/core/lam_analysis.ml

@@ -59,7 +59,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
           | _ -> false)
       | Pcreate_extension _ | Pjs_typeof | Pis_null | Pis_not_none | Psome
       | Psome_not_nest | Pis_undefined | Pis_null_undefined | Pnull_to_opt
-      | Pundefined_to_opt | Pnull_undefined_to_opt | Pjs_fn_make _
+      | Pundefined_to_opt | Pnull_undefined_to_opt | Pjs_fn_make _ | Pjs_fn_make_unit
       | Pjs_object_create _
       (* TODO: check *)
       | Pbytes_to_string | Pmakeblock _

jscomp/core/lam_compile.ml

@@ -55,7 +55,7 @@ let rec apply_with_arity_aux (fn : J.expression) (arity : int list)
           let params =
             Ext_list.init (x - len) (fun _ -> Ext_ident.create "param")
           in
-          E.ocaml_fun params ~return_unit:false (* unknown info *) ~async:false
+          E.ocaml_fun params ~return_unit:false (* unknown info *) ~async:false ~oneUnitArg:false
             [
               S.return_stmt
                 (E.call
@@ -315,7 +315,7 @@ and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t)
 and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t)
     (id : Ident.t) (arg : Lam.t) : Js_output.t * initialization =
   match arg with
-  | Lfunction { params; body; attr = { return_unit; async } } ->
+  | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } ->
       let continue_label = Lam_util.generate_label ~name:id.name () in
       (* TODO: Think about recursive value
          {[
@@ -355,7 +355,7 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t)
              it will be renamed into [method]
              when it is detected by a primitive
           *)
-            ~return_unit ~async ~immutable_mask:ret.immutable_mask
+            ~return_unit ~async ~oneUnitArg ~immutable_mask:ret.immutable_mask
             (Ext_list.map params (fun x ->
                  Map_ident.find_default ret.new_params x x))
             [
@@ -366,7 +366,7 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t)
             ]
         else
           (* TODO:  save computation of length several times *)
-          E.ocaml_fun params (Js_output.output_as_block output) ~return_unit ~async
+          E.ocaml_fun params (Js_output.output_as_block output) ~return_unit ~async ~oneUnitArg
       in
       ( Js_output.output_of_expression
           (Declare (Alias, id))
@@ -1458,6 +1458,7 @@ and compile_apply (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) =
             *)
           (* TODO: use [fold]*)
           let _, assigned_params, new_params =
+            let args = if ret.params = [] then [] else args in
             Ext_list.fold_left2 ret.params args (0, [], Map_ident.empty)
               (fun param arg (i, assigns, new_params) ->
                 match arg with
@@ -1628,6 +1629,8 @@ and compile_prim (prim_info : Lam.prim_info)
   | { primitive = Pjs_fn_make arity; args = [ fn ]; loc } ->
       compile_lambda lambda_cxt
         (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:arity ?from:None fn)
+  | { primitive = Pjs_fn_make_unit; args = [ fn ]; loc } ->
+    compile_lambda lambda_cxt fn
   | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false
   | { primitive = Pjs_object_create labels; args } ->
       let args_block, args_expr =
@@ -1666,10 +1669,10 @@ and compile_prim (prim_info : Lam.prim_info)
 and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) :
     Js_output.t =
   match cur_lam with
-  | Lfunction { params; body; attr = { return_unit; async } } ->
+  | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } ->
       Js_output.output_of_expression lambda_cxt.continuation
         ~no_effects:no_effects_const
-        (E.ocaml_fun params ~return_unit ~async
+        (E.ocaml_fun params ~return_unit ~async ~oneUnitArg
            (* Invariant:  jmp_table can not across function boundary,
               here we share env
            *)

jscomp/core/lam_compile_primitive.ml

@@ -84,7 +84,7 @@ let translate loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t)
   | Pis_undefined -> E.is_undef (Ext_list.singleton_exn args)
   | Pis_null_undefined -> E.is_null_undefined (Ext_list.singleton_exn args)
   | Pjs_typeof -> E.typeof (Ext_list.singleton_exn args)
-  | Pjs_unsafe_downgrade _ | Pdebugger | Pvoid_run | Pfull_apply | Pjs_fn_make _
+  | Pjs_unsafe_downgrade _ | Pdebugger | Pvoid_run | Pfull_apply | Pjs_fn_make _ | Pjs_fn_make_unit
     ->
       assert false (* already handled by {!Lam_compile} *)
   | Pjs_fn_method -> assert false

jscomp/core/lam_convert.ml

@@ -493,6 +493,8 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
           | "#run" -> Pvoid_run
           | "#fn_mk" ->
               Pjs_fn_make (Ext_pervasives.nat_of_string_exn p.prim_native_name)
+          | "#fn_mk_unit" ->
+              Pjs_fn_make_unit
           | "#fn_method" -> Pjs_fn_method
           | "#unsafe_downgrade" ->
               Pjs_unsafe_downgrade { name = Ext_string.empty; setter = false }

jscomp/core/lam_pass_alpha_conversion.ml

@@ -69,6 +69,12 @@ let alpha_conversion (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
             let arg = simpl arg in
             Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:len ~from:x arg
         | None -> Lam.prim ~primitive ~args:[ simpl arg ] loc)
+    | Lprim { primitive = Pjs_fn_make_unit; args = [ arg ]; loc } ->
+      let arg = match arg with
+      | Lfunction ({arity=1; params=[x]; attr; body}) ->
+        Lam.function_ ~params:[x] ~attr:{attr with oneUnitArg=true} ~body ~arity:1
+      | _ -> arg in
+      simpl arg
     | Lprim { primitive; args; loc } ->
         Lam.prim ~primitive ~args:(Ext_list.map args simpl) loc
     | Lfunction { arity; params; body; attr } ->

jscomp/core/lam_primitive.ml

@@ -129,6 +129,7 @@ type t =
   | Pupdate_mod
   | Praw_js_code of Js_raw_info.t
   | Pjs_fn_make of int
+  | Pjs_fn_make_unit
   | Pvoid_run
   | Pfull_apply
   (* we wrap it when do the conversion to prevent
@@ -307,6 +308,7 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
       | Pjs_unsafe_downgrade rhs -> name = rhs.name && setter = rhs.setter
       | _ -> false)
   | Pjs_fn_make i -> ( match rhs with Pjs_fn_make i1 -> i = i1 | _ -> false)
+  | Pjs_fn_make_unit -> rhs = Pjs_fn_make_unit
   | Pvoid_run -> rhs = Pvoid_run
   | Pfull_apply -> rhs = Pfull_apply
   | Pjs_fn_method -> rhs = Pjs_fn_method

jscomp/core/lam_primitive.mli

@@ -121,6 +121,7 @@ type t =
   | Pupdate_mod
   | Praw_js_code of Js_raw_info.t
   | Pjs_fn_make of int
+  | Pjs_fn_make_unit
   | Pvoid_run
   | Pfull_apply
   | Pjs_fn_method

jscomp/core/lam_print.ml

@@ -63,6 +63,7 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Pvoid_run -> fprintf ppf "#run"
   | Pfull_apply -> fprintf ppf "#full_apply"
   | Pjs_fn_make i -> fprintf ppf "js_fn_make_%i" i
+  | Pjs_fn_make_unit -> fprintf ppf "js_fn_make_unit"
   | Pjs_fn_method -> fprintf ppf "js_fn_method"
   | Pdebugger -> fprintf ppf "debugger"
   | Praw_js_code _ -> fprintf ppf "[raw]"

jscomp/ml/lambda.ml

@@ -270,6 +270,7 @@ type function_attribute = {
   stub: bool;
   return_unit : bool;
   async : bool;
+  oneUnitArg : bool;
 }
 
 type lambda =
@@ -298,7 +299,8 @@ and lfunction =
     params: Ident.t list;
     body: lambda;
     attr: function_attribute; (* specified with [@inline] attribute *)
-    loc: Location.t; }
+    loc: Location.t;
+ }
 
 and lambda_apply =
   { ap_func : lambda;
@@ -338,6 +340,7 @@ let default_function_attribute = {
   stub = false;
   return_unit = false;
   async = false;
+  oneUnitArg = false;
 }
 
 let default_stub_attribute =

jscomp/ml/lambda.mli

@@ -271,6 +271,7 @@ type function_attribute = {
   stub: bool;
   return_unit : bool;
   async : bool;
+  oneUnitArg : bool;
 }
 
 type lambda =

jscomp/ml/translcore.ml

@@ -781,9 +781,17 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
       (* ReScript uncurried encoding *)
       let loc = expr.exp_loc in
       let lambda = transl_exp expr in
-      let arity_s = Ast_uncurried.uncurried_type_get_arity ~env:e.exp_env e.exp_type |> string_of_int in
+      let arity = Ast_uncurried.uncurried_type_get_arity ~env:e.exp_env e.exp_type in
+      let arity_s = arity |> string_of_int in
+      let name = match (Ctype.expand_head expr.exp_env expr.exp_type).desc with
+      | Tarrow (Nolabel, t, _, _) -> (
+        match (Ctype.expand_head expr.exp_env t).desc with
+        | Tconstr (Pident {name= "unit"}, [], _) -> "#fn_mk_unit"
+        | _ -> "#fn_mk"
+      )
+      | _ -> "#fn_mk" in
       let prim =
-        Primitive.make ~name:"#fn_mk" ~alloc:true ~native_name:arity_s
+        Primitive.make ~name ~alloc:true ~native_name:arity_s
           ~native_repr_args:[ Same_as_ocaml_repr ]
           ~native_repr_res:Same_as_ocaml_repr
       in

jscomp/ml/translmod.ml

@@ -277,6 +277,7 @@ let rec compile_functor mexp coercion root_path loc =
           stub = false;
           return_unit = false;
           async = false;
+          oneUnitArg = false;
         };
       loc;
       body;

jscomp/test/UncurriedExternals.js

@@ -123,7 +123,7 @@ function tsiU$1(c) {
     });
 }
 
-var match$1 = React.useState(function (param) {
+var match$1 = React.useState(function () {
       return 3;
     });
 

jscomp/test/async_await.js

@@ -6,7 +6,7 @@ function next(n) {
   return n + 1 | 0;
 }
 
-async function useNext(param) {
+async function useNext() {
   return 4;
 }
 
@@ -19,7 +19,7 @@ function Make(I) {
         };
 }
 
-async function topFoo(param) {
+async function topFoo() {
   return 1;
 }
 

jscomp/test/event_ffi.js

@@ -38,7 +38,7 @@ function ocaml_run(b, c) {
   return (x + b | 0) + c | 0;
 }
 
-function a0(param) {
+function a0() {
   console.log("hi");
 }
 

jscomp/test/ffi_arity_test.js

@@ -39,7 +39,7 @@ var hh = [
       return parseInt(x);
     });
 
-function u(param) {
+function u() {
   return 3;
 }
 
@@ -53,7 +53,7 @@ function fff(param) {
   vvv.contents = vvv.contents + 1 | 0;
 }
 
-function g(param) {
+function g() {
   fff(undefined);
 }
 

jscomp/test/mt.js

@@ -230,7 +230,7 @@ function old_from_promise_suites_donotuse(name, suites) {
   var match = $$Array.to_list(Process.argv);
   if (match) {
     if (is_mocha(undefined)) {
-      describe(name, (function (param) {
+      describe(name, (function () {
               List.iter((function (param) {
                       var code = param[1];
                       it(param[0], (function (param) {

jscomp/test/pipe_send_readline.js

@@ -4,7 +4,7 @@
 function u(rl) {
   return rl.on("line", (function (x) {
                   console.log(x);
-                })).on("close", (function (param) {
+                })).on("close", (function () {
                 console.log("finished");
               }));
 }

jscomp/test/ppx_apply_test.js

@@ -29,7 +29,7 @@ function eq(loc, x, y) {
 
 var u = 3;
 
-function nullary(param) {
+function nullary() {
   return 3;
 }
 

jscomp/test/raw_output_test.js

@@ -8,7 +8,7 @@ function mk(fn) {
 
 (((_)=> console.log('should works'))(undefined));
 
-console.log((function (param) {
+console.log((function () {
           return 1;
         })(undefined));
 

jscomp/test/reactTestUtils.js

@@ -7,14 +7,14 @@ var Caml_option = require("../../lib/js/caml_option.js");
 var TestUtils = require("react-dom/test-utils");
 
 function act(func) {
-  var reactFunc = function (param) {
+  var reactFunc = function () {
     Curry._1(func, undefined);
   };
   TestUtils.act(reactFunc);
 }
 
 function actAsync(func) {
-  return TestUtils.act(function (param) {
+  return TestUtils.act(function () {
               return Curry._1(func, undefined);
             });
 }

jscomp/test/tramp_fib.js

@@ -20,7 +20,7 @@ function fib(n, k) {
   } else {
     return {
             TAG: "Suspend",
-            _0: (function (param) {
+            _0: (function () {
                 return fib(n - 1 | 0, (function (v0) {
                               return fib(n - 2 | 0, (function (v1) {
                                             return k(v0 + v1 | 0);
@@ -54,7 +54,7 @@ function isEven(n) {
     if (n !== 1) {
       return {
               TAG: "Suspend",
-              _0: (function (param) {
+              _0: (function () {
                   return isOdd(n - 1 | 0);
                 })
             };

jscomp/test/uncurried_cast.js

@@ -76,7 +76,7 @@ var StandardNotation = {
   anInt: anInt
 };
 
-function testRaise$1(param) {
+function testRaise$1() {
   throw {
         RE_EXN_ID: E,
         Error: new Error()

jscomp/test/uncurry_glob_test.js

@@ -8,7 +8,7 @@ function M(U) {
         };
 }
 
-function f(param) {
+function f() {
   return 3;
 }
 

jscomp/test/uncurry_test.js

@@ -1,7 +1,7 @@
 'use strict';
 
 
-function f0(param) {
+function f0() {
   return 0;
 }
 
@@ -25,7 +25,7 @@ console.log([
       1
     ]);
 
-function xx(_param) {
+function xx() {
   while(true) {
     _param = undefined;
     continue ;