Special case uncurried fun with 1 arg of unit type

jscomp/core/lam_compile.ml

@@ -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

jscomp/ml/translcore.ml

@@ -781,7 +781,15 @@ 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 = 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"}, [], _) -> "0"
+        | _ -> arity |> string_of_int
+      )
+      | _ ->
+         arity |> string_of_int in
       let prim =
         Primitive.make ~name:"#fn_mk" ~alloc:true ~native_name:arity_s
           ~native_repr_args:[ Same_as_ocaml_repr ]

jscomp/stdlib-406/camlinternalLazy.res

@@ -0,0 +1,92 @@
+/* Copyright (C) 2017 Hongbo Zhang, Authors of ReScript
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+@@bs.config({flags: ["-bs-no-cross-module-opt"]})
+
+/* Internals of forcing lazy values. */
+type t<'a> = {
+  @as("LAZY_DONE") mutable tag: bool,
+  /* Invariant: name */
+  @as("VAL") mutable value: 'a,
+  /* its type is ['a] or [unit -> 'a ] */
+}
+
+%%private(external fnToVal: ((. unit) => 'a) => 'a = "%identity")
+%%private(external valToFn: 'a => (. unit) => 'a = "%identity")
+%%private(external castToConcrete: lazy_t<'a> => t<'a> = "%identity")
+
+let is_val = (type a, l: lazy_t<a>): bool => castToConcrete(l).tag
+
+exception Undefined
+
+%%private(
+  let forward_with_closure = (type a, blk: t<a>, closure: (. unit) => a): a => {
+    let result = closure(.)
+    blk.value = result
+    blk.tag = true
+    result
+  }
+)
+
+%%private(let raise_undefined = (. ()) => raise(Undefined))
+
+/* Assume [blk] is a block with tag lazy */
+%%private(
+  let force_lazy_block = (type a, blk: t<a>): a => {
+    let closure = valToFn(blk.value)
+    blk.value = fnToVal(raise_undefined)
+    try forward_with_closure(blk, closure) catch {
+    | e =>
+      blk.value = fnToVal((. ()) => raise(e))
+      raise(e)
+    }
+  }
+)
+
+/* Assume [blk] is a block with tag lazy */
+%%private(
+  let force_val_lazy_block = (type a, blk: t<a>): a => {
+    let closure = valToFn(blk.value)
+    blk.value = fnToVal(raise_undefined)
+    forward_with_closure(blk, closure)
+  }
+)
+
+let force = (type a, lzv: lazy_t<a>): a => {
+  let lzv: t<_> = castToConcrete(lzv)
+  if lzv.tag {
+    lzv.value
+  } else {
+    force_lazy_block(lzv)
+  }
+}
+
+let force_val = (type a, lzv: lazy_t<a>): a => {
+  let lzv: t<_> = castToConcrete(lzv)
+  if lzv.tag {
+    lzv.value
+  } else {
+    force_val_lazy_block(lzv)
+  }
+}

jscomp/stdlib-406/camlinternalLazy.resi

@@ -0,0 +1,27 @@
+@@ocaml.text(/* ************************************************************************ */
+/*  */
+/* OCaml */
+/*  */
+/* Damien Doligez, projet Para, INRIA Rocquencourt */
+/*  */
+/* Copyright 1997 Institut National de Recherche en Informatique et */
+/* en Automatique. */
+/*  */
+/* All rights reserved.  This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/*  */
+/* ************************************************************************ */
+
+" Run-time support for lazy values.
+    All functions in this module are for system use only, not for the
+    casual user. ")
+
+exception Undefined
+
+let force: lazy_t<'a> => 'a
+/* instrumented by {!Matching} */
+
+let force_val: lazy_t<'a> => 'a
+
+let is_val: lazy_t<'a> => bool

jscomp/stdlib-406/release.ninja

@@ -26,8 +26,8 @@ o stdlib-406/bytesLabels.cmj : cc_cmi stdlib-406/bytesLabels.ml | stdlib-406/byt
 o stdlib-406/bytesLabels.cmi : cc stdlib-406/bytesLabels.mli | stdlib-406/pervasives.cmj $bsc others
 o stdlib-406/callback.cmj : cc_cmi stdlib-406/callback.ml | stdlib-406/callback.cmi $bsc others
 o stdlib-406/callback.cmi : cc stdlib-406/callback.mli | stdlib-406/pervasives.cmj $bsc others
-o stdlib-406/camlinternalLazy.cmj : cc_cmi stdlib-406/camlinternalLazy.ml | stdlib-406/camlinternalLazy.cmi $bsc others
-o stdlib-406/camlinternalLazy.cmi : cc stdlib-406/camlinternalLazy.mli | stdlib-406/pervasives.cmj $bsc others
+o stdlib-406/camlinternalLazy.cmj : cc_cmi stdlib-406/camlinternalLazy.res | stdlib-406/camlinternalLazy.cmi $bsc others
+o stdlib-406/camlinternalLazy.cmi : cc stdlib-406/camlinternalLazy.resi | stdlib-406/pervasives.cmj $bsc others
 o stdlib-406/camlinternalMod.cmj : cc_cmi stdlib-406/camlinternalMod.ml | stdlib-406/camlinternalMod.cmi stdlib-406/obj.cmj $bsc others
 o stdlib-406/camlinternalMod.cmi : cc stdlib-406/camlinternalMod.mli | stdlib-406/obj.cmi stdlib-406/pervasives.cmj $bsc others
 o stdlib-406/char.cmj : cc_cmi stdlib-406/char.ml | stdlib-406/char.cmi $bsc others

jscomp/test/UncurriedExternals.js

@@ -1,5 +1,6 @@
 'use strict';
 
+var Curry = require("../../lib/js/curry.js");
 var React = require("react");
 
 function dd(param) {
@@ -124,7 +125,7 @@ function tsiU$1(c) {
 }
 
 var match$1 = React.useState(function (param) {
-      return 3;
+      return Curry._1(3, param);
     });
 
 function methodWithAsyncU() {

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,8 +53,8 @@ function fff(param) {
   vvv.contents = vvv.contents + 1 | 0;
 }
 
-function g(param) {
-  fff(undefined);
+function g() {
+  return fff(undefined);
 }
 
 function abc(x, y, z) {
@@ -65,7 +65,7 @@ function abc(x, y, z) {
 
 var abc_u = abc;
 
-fff(undefined);
+g(undefined);
 
 Mt.from_pair_suites("Ffi_arity_test", {
       hd: [

jscomp/test/mt.js

@@ -230,17 +230,17 @@ 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) {
-              List.iter((function (param) {
-                      var code = param[1];
-                      it(param[0], (function (param) {
-                              var arg1 = function (x) {
-                                handleCode(x);
-                                return val_unit;
-                              };
-                              return code.then(arg1);
-                            }));
-                    }), suites);
+      describe(name, (function () {
+              return List.iter((function (param) {
+                            var code = param[1];
+                            it(param[0], (function (param) {
+                                    var arg1 = function (x) {
+                                      handleCode(x);
+                                      return val_unit;
+                                    };
+                                    return code.then(arg1);
+                                  }));
+                          }), suites);
             }));
     } else {
       console.log("promise suites");

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));