From 5e978f9f2a15ba22ff91d9f83f81353d5a3da8c5 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 16:29:35 +0200 Subject: [PATCH 01/11] Specia case uncurried fun with 1 arg of unit type --- jscomp/core/lam_compile.ml | 1 + jscomp/ml/translcore.ml | 10 ++- jscomp/stdlib-406/camlinternalLazy.ml | 88 ----------------------- jscomp/stdlib-406/camlinternalLazy.mli | 27 -------- jscomp/stdlib-406/camlinternalLazy.res | 92 +++++++++++++++++++++++++ jscomp/stdlib-406/camlinternalLazy.resi | 27 ++++++++ jscomp/stdlib-406/release.ninja | 4 +- jscomp/test/UncurriedExternals.js | 3 +- jscomp/test/event_ffi.js | 2 +- jscomp/test/ffi_arity_test.js | 8 +-- jscomp/test/mt.js | 22 +++--- jscomp/test/pipe_send_readline.js | 2 +- jscomp/test/ppx_apply_test.js | 2 +- jscomp/test/raw_output_test.js | 2 +- jscomp/test/reactTestUtils.js | 4 +- jscomp/test/tramp_fib.js | 4 +- jscomp/test/uncurried_cast.js | 2 +- jscomp/test/uncurry_glob_test.js | 6 +- jscomp/test/uncurry_test.js | 7 +- lib/es6/camlinternalLazy.js | 6 +- lib/es6/pervasivesU.js | 14 ++-- lib/js/camlinternalLazy.js | 6 +- lib/js/pervasivesU.js | 14 ++-- tst.res | 4 ++ 24 files changed, 192 insertions(+), 165 deletions(-) delete mode 100644 jscomp/stdlib-406/camlinternalLazy.ml delete mode 100644 jscomp/stdlib-406/camlinternalLazy.mli create mode 100644 jscomp/stdlib-406/camlinternalLazy.res create mode 100644 jscomp/stdlib-406/camlinternalLazy.resi create mode 100644 tst.res diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 69526356fc..665f10e23f 100644 --- a/jscomp/core/lam_compile.ml +++ b/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 diff --git a/jscomp/ml/translcore.ml b/jscomp/ml/translcore.ml index 470c1008e4..c709c348df 100644 --- a/jscomp/ml/translcore.ml +++ b/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 ] diff --git a/jscomp/stdlib-406/camlinternalLazy.ml b/jscomp/stdlib-406/camlinternalLazy.ml deleted file mode 100644 index 2f2f4545b1..0000000000 --- a/jscomp/stdlib-406/camlinternalLazy.ml +++ /dev/null @@ -1,88 +0,0 @@ -(* 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 'a t = { - mutable tag : bool [@bs.as "LAZY_DONE"] ; - (* Invariant: name *) - mutable value : 'a [@bs.as "VAL"] - (* its type is ['a] or [unit -> 'a ] *) -} - - -external%private fnToVal : (unit -> 'a [@bs]) -> 'a = "%identity" -external%private valToFn : 'a -> (unit -> 'a [@bs]) = "%identity" -external%private castToConcrete : 'a lazy_t -> 'a t = "%identity" - -let is_val (type a ) (l : a lazy_t) : bool = - (castToConcrete l ).tag - - - -exception Undefined - -let%private forward_with_closure (type a ) (blk : a t) (closure : unit -> a [@bs]) : a = - let result = closure () [@bs] in - blk.value <- result; - blk.tag<- true; - result - - -let%private raise_undefined = (fun [@bs] () -> raise Undefined) - -(* Assume [blk] is a block with tag lazy *) -let%private force_lazy_block (type a ) (blk : a t) : a = - let closure = valToFn blk.value in - blk.value <- fnToVal raise_undefined; - try - forward_with_closure blk closure - with e -> - blk.value <- fnToVal (fun [@bs] () -> raise e); - raise e - - -(* Assume [blk] is a block with tag lazy *) -let%private force_val_lazy_block (type a ) (blk : a t) : a = - let closure = valToFn blk.value in - blk.value <- fnToVal raise_undefined; - forward_with_closure blk closure - - - -let force (type a ) (lzv : a lazy_t) : a = - let lzv = (castToConcrete lzv : _ t) in - if lzv.tag then lzv.value else - force_lazy_block lzv - - - - -let force_val (type a) (lzv : a lazy_t) : a = - let lzv : _ t = castToConcrete lzv in - if lzv.tag then lzv.value else - force_val_lazy_block lzv - - diff --git a/jscomp/stdlib-406/camlinternalLazy.mli b/jscomp/stdlib-406/camlinternalLazy.mli deleted file mode 100644 index e49104a921..0000000000 --- a/jscomp/stdlib-406/camlinternalLazy.mli +++ /dev/null @@ -1,27 +0,0 @@ -(**************************************************************************) -(* *) -(* 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 - -val force : 'a lazy_t -> 'a -(* instrumented by {!Matching} *) - -val force_val : 'a lazy_t -> 'a - -val is_val : 'a lazy_t -> bool \ No newline at end of file diff --git a/jscomp/stdlib-406/camlinternalLazy.res b/jscomp/stdlib-406/camlinternalLazy.res new file mode 100644 index 0000000000..e3727857da --- /dev/null +++ b/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): bool => castToConcrete(l).tag + +exception Undefined + +%%private( + let forward_with_closure = (type a, blk: t, 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 => { + 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 => { + let closure = valToFn(blk.value) + blk.value = fnToVal(raise_undefined) + forward_with_closure(blk, closure) + } +) + +let force = (type a, lzv: lazy_t): 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 => { + let lzv: t<_> = castToConcrete(lzv) + if lzv.tag { + lzv.value + } else { + force_val_lazy_block(lzv) + } +} diff --git a/jscomp/stdlib-406/camlinternalLazy.resi b/jscomp/stdlib-406/camlinternalLazy.resi new file mode 100644 index 0000000000..47944ef698 --- /dev/null +++ b/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 diff --git a/jscomp/stdlib-406/release.ninja b/jscomp/stdlib-406/release.ninja index 4cd3d18003..94954f40ea 100644 --- a/jscomp/stdlib-406/release.ninja +++ b/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 diff --git a/jscomp/test/UncurriedExternals.js b/jscomp/test/UncurriedExternals.js index 272b6b28d3..be577d6a2d 100644 --- a/jscomp/test/UncurriedExternals.js +++ b/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() { diff --git a/jscomp/test/event_ffi.js b/jscomp/test/event_ffi.js index 7cadfe9f2c..21c2012404 100644 --- a/jscomp/test/event_ffi.js +++ b/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"); } diff --git a/jscomp/test/ffi_arity_test.js b/jscomp/test/ffi_arity_test.js index 4503ab76a0..5bf7c64433 100644 --- a/jscomp/test/ffi_arity_test.js +++ b/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: [ diff --git a/jscomp/test/mt.js b/jscomp/test/mt.js index aab79db40e..9f67e949cd 100644 --- a/jscomp/test/mt.js +++ b/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"); diff --git a/jscomp/test/pipe_send_readline.js b/jscomp/test/pipe_send_readline.js index a5a9696d95..d62fffd68e 100644 --- a/jscomp/test/pipe_send_readline.js +++ b/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"); })); } diff --git a/jscomp/test/ppx_apply_test.js b/jscomp/test/ppx_apply_test.js index cbf197ba39..72ae69fa66 100644 --- a/jscomp/test/ppx_apply_test.js +++ b/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; } diff --git a/jscomp/test/raw_output_test.js b/jscomp/test/raw_output_test.js index 35928faa38..fb3b4abf3c 100644 --- a/jscomp/test/raw_output_test.js +++ b/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)); diff --git a/jscomp/test/reactTestUtils.js b/jscomp/test/reactTestUtils.js index a8dfcef1f7..4ce3c32b85 100644 --- a/jscomp/test/reactTestUtils.js +++ b/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); }); } diff --git a/jscomp/test/tramp_fib.js b/jscomp/test/tramp_fib.js index 8cc4cbf004..38d763a4db 100644 --- a/jscomp/test/tramp_fib.js +++ b/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); }) }; diff --git a/jscomp/test/uncurried_cast.js b/jscomp/test/uncurried_cast.js index 0205d44de9..5010bdf468 100644 --- a/jscomp/test/uncurried_cast.js +++ b/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() diff --git a/jscomp/test/uncurry_glob_test.js b/jscomp/test/uncurry_glob_test.js index 8006c02677..e4cf4eb0f8 100644 --- a/jscomp/test/uncurry_glob_test.js +++ b/jscomp/test/uncurry_glob_test.js @@ -8,10 +8,12 @@ function M(U) { }; } -function f(param) { +function f() { return 3; } +f(undefined); + function $plus$great(a, h) { return h(a); } @@ -24,4 +26,4 @@ exports.M = M; exports.f = f; exports.$plus$great = $plus$great; exports.u = u; -/* No side effect */ +/* Not a pure module */ diff --git a/jscomp/test/uncurry_test.js b/jscomp/test/uncurry_test.js index 8a8d1e3680..b1dfe59a5f 100644 --- a/jscomp/test/uncurry_test.js +++ b/jscomp/test/uncurry_test.js @@ -1,7 +1,7 @@ 'use strict'; -function f0(param) { +function f0() { return 0; } @@ -16,7 +16,7 @@ function f2(a0, a1) { ]; } -console.log(0); +console.log(f0(undefined)); console.log(0); @@ -25,9 +25,8 @@ console.log([ 1 ]); -function xx(_param) { +function xx() { while(true) { - _param = undefined; continue ; }; } diff --git a/lib/es6/camlinternalLazy.js b/lib/es6/camlinternalLazy.js index e6ea7bbc47..7b80d775fb 100644 --- a/lib/es6/camlinternalLazy.js +++ b/lib/es6/camlinternalLazy.js @@ -9,13 +9,13 @@ function is_val(l) { var Undefined = /* @__PURE__ */Caml_exceptions.create("CamlinternalLazy.Undefined"); function forward_with_closure(blk, closure) { - var result = closure(); + var result = closure(undefined); blk.VAL = result; blk.LAZY_DONE = true; return result; } -function raise_undefined(param) { +function raise_undefined() { throw { RE_EXN_ID: Undefined, Error: new Error() @@ -32,7 +32,7 @@ function force(lzv) { return forward_with_closure(lzv, closure); } catch (e){ - lzv.VAL = (function (param) { + lzv.VAL = (function () { throw e; }); throw e; diff --git a/lib/es6/pervasivesU.js b/lib/es6/pervasivesU.js index 293b70f45c..cfebec3f99 100644 --- a/lib/es6/pervasivesU.js +++ b/lib/es6/pervasivesU.js @@ -170,11 +170,11 @@ function $at(l1, l2) { } } -function print_newline(param) { +function print_newline() { console.log(""); } -function prerr_newline(param) { +function prerr_newline() { console.error(""); } @@ -198,14 +198,18 @@ var exit_function = { function at_exit(f) { var g = exit_function.contents; - exit_function.contents = (function (param) { + exit_function.contents = (function () { f(undefined); - g(undefined); + return g(undefined); }); } +function do_at_exit() { + return exit_function.contents(undefined); +} + function exit(retcode) { - exit_function.contents(undefined); + do_at_exit(undefined); return Caml_sys.sys_exit(retcode); } diff --git a/lib/js/camlinternalLazy.js b/lib/js/camlinternalLazy.js index 924db778a7..867d359675 100644 --- a/lib/js/camlinternalLazy.js +++ b/lib/js/camlinternalLazy.js @@ -9,13 +9,13 @@ function is_val(l) { var Undefined = /* @__PURE__ */Caml_exceptions.create("CamlinternalLazy.Undefined"); function forward_with_closure(blk, closure) { - var result = closure(); + var result = closure(undefined); blk.VAL = result; blk.LAZY_DONE = true; return result; } -function raise_undefined(param) { +function raise_undefined() { throw { RE_EXN_ID: Undefined, Error: new Error() @@ -32,7 +32,7 @@ function force(lzv) { return forward_with_closure(lzv, closure); } catch (e){ - lzv.VAL = (function (param) { + lzv.VAL = (function () { throw e; }); throw e; diff --git a/lib/js/pervasivesU.js b/lib/js/pervasivesU.js index 60583cbe0c..5d36c9bbdc 100644 --- a/lib/js/pervasivesU.js +++ b/lib/js/pervasivesU.js @@ -170,11 +170,11 @@ function $at(l1, l2) { } } -function print_newline(param) { +function print_newline() { console.log(""); } -function prerr_newline(param) { +function prerr_newline() { console.error(""); } @@ -198,14 +198,18 @@ var exit_function = { function at_exit(f) { var g = exit_function.contents; - exit_function.contents = (function (param) { + exit_function.contents = (function () { f(undefined); - g(undefined); + return g(undefined); }); } +function do_at_exit() { + return exit_function.contents(undefined); +} + function exit(retcode) { - exit_function.contents(undefined); + do_at_exit(undefined); return Caml_sys.sys_exit(retcode); } diff --git a/tst.res b/tst.res new file mode 100644 index 0000000000..99664c1861 --- /dev/null +++ b/tst.res @@ -0,0 +1,4 @@ +let foo : (. unit) => int = (. ()) => 34 + +let u = () +let d = foo(. u) \ No newline at end of file From 098db4e8cbde5608610ab8345202a8e2c05dc9ae Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 17:34:41 +0200 Subject: [PATCH 02/11] Update artifacts.txt --- packages/artifacts.txt | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/packages/artifacts.txt b/packages/artifacts.txt index ea3c960b5a..cd7b837e26 100644 --- a/packages/artifacts.txt +++ b/packages/artifacts.txt @@ -591,8 +591,8 @@ lib/ocaml/callback.mli lib/ocaml/camlinternalLazy.cmi lib/ocaml/camlinternalLazy.cmt lib/ocaml/camlinternalLazy.cmti -lib/ocaml/camlinternalLazy.ml -lib/ocaml/camlinternalLazy.mli +lib/ocaml/camlinternalLazy.res +lib/ocaml/camlinternalLazy.resi lib/ocaml/camlinternalMod.cmi lib/ocaml/camlinternalMod.cmt lib/ocaml/camlinternalMod.cmti @@ -965,10 +965,6 @@ linux/bsb_helper.exe linux/bsc.exe linux/ninja.exe linux/rescript.exe -linuxarm64/bsb_helper.exe -linuxarm64/bsc.exe -linuxarm64/ninja.exe -linuxarm64/rescript.exe ninja.COPYING package.json rescript From 4d80dda09b5788a2e317ec95affe7c93dbc9baf3 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 17:47:46 +0200 Subject: [PATCH 03/11] v2 --- jscomp/core/lam_analysis.ml | 2 +- jscomp/core/lam_compile.ml | 4 +- jscomp/core/lam_compile_primitive.ml | 2 +- jscomp/core/lam_convert.ml | 2 + jscomp/core/lam_primitive.ml | 2 + jscomp/core/lam_primitive.mli | 1 + jscomp/core/lam_print.ml | 1 + jscomp/ml/translcore.ml | 12 ++-- jscomp/stdlib-406/camlinternalLazy.ml | 88 +++++++++++++++++++++++ jscomp/stdlib-406/camlinternalLazy.mli | 27 ++++++++ jscomp/stdlib-406/camlinternalLazy.res | 92 ------------------------- jscomp/stdlib-406/camlinternalLazy.resi | 27 -------- jscomp/stdlib-406/release.ninja | 4 +- jscomp/test/UncurriedExternals.js | 8 ++- jscomp/test/uncurry_test.js | 4 +- lib/es6/camlinternalLazy.js | 2 +- lib/js/camlinternalLazy.js | 2 +- packages/artifacts.txt | 2 + tst.res | 4 -- 19 files changed, 144 insertions(+), 142 deletions(-) create mode 100644 jscomp/stdlib-406/camlinternalLazy.ml create mode 100644 jscomp/stdlib-406/camlinternalLazy.mli delete mode 100644 jscomp/stdlib-406/camlinternalLazy.res delete mode 100644 jscomp/stdlib-406/camlinternalLazy.resi delete mode 100644 tst.res diff --git a/jscomp/core/lam_analysis.ml b/jscomp/core/lam_analysis.ml index 1280a17dc8..c1f1d2dc83 100644 --- a/jscomp/core/lam_analysis.ml +++ b/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 _ diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 665f10e23f..b416d3e976 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -1458,7 +1458,6 @@ 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 @@ -1629,6 +1628,9 @@ 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 + (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:0 ?from:None fn) | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false | { primitive = Pjs_object_create labels; args } -> let args_block, args_expr = diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml index 6a54005e6a..c2b81cf98d 100644 --- a/jscomp/core/lam_compile_primitive.ml +++ b/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 diff --git a/jscomp/core/lam_convert.ml b/jscomp/core/lam_convert.ml index e3d0b1d4f1..87d88b6b67 100644 --- a/jscomp/core/lam_convert.ml +++ b/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 } diff --git a/jscomp/core/lam_primitive.ml b/jscomp/core/lam_primitive.ml index 7291b73fef..37a605a5eb 100644 --- a/jscomp/core/lam_primitive.ml +++ b/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 diff --git a/jscomp/core/lam_primitive.mli b/jscomp/core/lam_primitive.mli index d26119f092..165d9c2faa 100644 --- a/jscomp/core/lam_primitive.mli +++ b/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 diff --git a/jscomp/core/lam_print.ml b/jscomp/core/lam_print.ml index becd918e49..bf509e5fd2 100644 --- a/jscomp/core/lam_print.ml +++ b/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]" diff --git a/jscomp/ml/translcore.ml b/jscomp/ml/translcore.ml index c709c348df..c2c07b790a 100644 --- a/jscomp/ml/translcore.ml +++ b/jscomp/ml/translcore.ml @@ -782,16 +782,16 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda = let loc = expr.exp_loc in let lambda = transl_exp expr 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 + 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"}, [], _) -> "0" - | _ -> arity |> string_of_int + | Tconstr (Pident {name= "unit"}, [], _) -> "#fn_mk_unit" + | _ -> "#fn_mk" ) - | _ -> - arity |> string_of_int in + | _ -> "#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 diff --git a/jscomp/stdlib-406/camlinternalLazy.ml b/jscomp/stdlib-406/camlinternalLazy.ml new file mode 100644 index 0000000000..2f2f4545b1 --- /dev/null +++ b/jscomp/stdlib-406/camlinternalLazy.ml @@ -0,0 +1,88 @@ +(* 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 'a t = { + mutable tag : bool [@bs.as "LAZY_DONE"] ; + (* Invariant: name *) + mutable value : 'a [@bs.as "VAL"] + (* its type is ['a] or [unit -> 'a ] *) +} + + +external%private fnToVal : (unit -> 'a [@bs]) -> 'a = "%identity" +external%private valToFn : 'a -> (unit -> 'a [@bs]) = "%identity" +external%private castToConcrete : 'a lazy_t -> 'a t = "%identity" + +let is_val (type a ) (l : a lazy_t) : bool = + (castToConcrete l ).tag + + + +exception Undefined + +let%private forward_with_closure (type a ) (blk : a t) (closure : unit -> a [@bs]) : a = + let result = closure () [@bs] in + blk.value <- result; + blk.tag<- true; + result + + +let%private raise_undefined = (fun [@bs] () -> raise Undefined) + +(* Assume [blk] is a block with tag lazy *) +let%private force_lazy_block (type a ) (blk : a t) : a = + let closure = valToFn blk.value in + blk.value <- fnToVal raise_undefined; + try + forward_with_closure blk closure + with e -> + blk.value <- fnToVal (fun [@bs] () -> raise e); + raise e + + +(* Assume [blk] is a block with tag lazy *) +let%private force_val_lazy_block (type a ) (blk : a t) : a = + let closure = valToFn blk.value in + blk.value <- fnToVal raise_undefined; + forward_with_closure blk closure + + + +let force (type a ) (lzv : a lazy_t) : a = + let lzv = (castToConcrete lzv : _ t) in + if lzv.tag then lzv.value else + force_lazy_block lzv + + + + +let force_val (type a) (lzv : a lazy_t) : a = + let lzv : _ t = castToConcrete lzv in + if lzv.tag then lzv.value else + force_val_lazy_block lzv + + diff --git a/jscomp/stdlib-406/camlinternalLazy.mli b/jscomp/stdlib-406/camlinternalLazy.mli new file mode 100644 index 0000000000..e49104a921 --- /dev/null +++ b/jscomp/stdlib-406/camlinternalLazy.mli @@ -0,0 +1,27 @@ +(**************************************************************************) +(* *) +(* 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 + +val force : 'a lazy_t -> 'a +(* instrumented by {!Matching} *) + +val force_val : 'a lazy_t -> 'a + +val is_val : 'a lazy_t -> bool \ No newline at end of file diff --git a/jscomp/stdlib-406/camlinternalLazy.res b/jscomp/stdlib-406/camlinternalLazy.res deleted file mode 100644 index e3727857da..0000000000 --- a/jscomp/stdlib-406/camlinternalLazy.res +++ /dev/null @@ -1,92 +0,0 @@ -/* 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): bool => castToConcrete(l).tag - -exception Undefined - -%%private( - let forward_with_closure = (type a, blk: t, 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 => { - 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 => { - let closure = valToFn(blk.value) - blk.value = fnToVal(raise_undefined) - forward_with_closure(blk, closure) - } -) - -let force = (type a, lzv: lazy_t): 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 => { - let lzv: t<_> = castToConcrete(lzv) - if lzv.tag { - lzv.value - } else { - force_val_lazy_block(lzv) - } -} diff --git a/jscomp/stdlib-406/camlinternalLazy.resi b/jscomp/stdlib-406/camlinternalLazy.resi deleted file mode 100644 index 47944ef698..0000000000 --- a/jscomp/stdlib-406/camlinternalLazy.resi +++ /dev/null @@ -1,27 +0,0 @@ -@@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 diff --git a/jscomp/stdlib-406/release.ninja b/jscomp/stdlib-406/release.ninja index 94954f40ea..4cd3d18003 100644 --- a/jscomp/stdlib-406/release.ninja +++ b/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.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/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/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 diff --git a/jscomp/test/UncurriedExternals.js b/jscomp/test/UncurriedExternals.js index be577d6a2d..0d387af1e5 100644 --- a/jscomp/test/UncurriedExternals.js +++ b/jscomp/test/UncurriedExternals.js @@ -124,9 +124,11 @@ function tsiU$1(c) { }); } -var match$1 = React.useState(function (param) { - return Curry._1(3, param); - }); +function partial_arg() { + return 3; +} + +var match$1 = React.useState(Curry.__1(partial_arg)); function methodWithAsyncU() { var $$this = this ; diff --git a/jscomp/test/uncurry_test.js b/jscomp/test/uncurry_test.js index b1dfe59a5f..4022c67a4e 100644 --- a/jscomp/test/uncurry_test.js +++ b/jscomp/test/uncurry_test.js @@ -26,9 +26,7 @@ console.log([ ]); function xx() { - while(true) { - continue ; - }; + return xx(undefined); } function log2(logger, message, obj) { diff --git a/lib/es6/camlinternalLazy.js b/lib/es6/camlinternalLazy.js index 7b80d775fb..697cd9e5de 100644 --- a/lib/es6/camlinternalLazy.js +++ b/lib/es6/camlinternalLazy.js @@ -9,7 +9,7 @@ function is_val(l) { var Undefined = /* @__PURE__ */Caml_exceptions.create("CamlinternalLazy.Undefined"); function forward_with_closure(blk, closure) { - var result = closure(undefined); + var result = closure(); blk.VAL = result; blk.LAZY_DONE = true; return result; diff --git a/lib/js/camlinternalLazy.js b/lib/js/camlinternalLazy.js index 867d359675..f812859e83 100644 --- a/lib/js/camlinternalLazy.js +++ b/lib/js/camlinternalLazy.js @@ -9,7 +9,7 @@ function is_val(l) { var Undefined = /* @__PURE__ */Caml_exceptions.create("CamlinternalLazy.Undefined"); function forward_with_closure(blk, closure) { - var result = closure(undefined); + var result = closure(); blk.VAL = result; blk.LAZY_DONE = true; return result; diff --git a/packages/artifacts.txt b/packages/artifacts.txt index cd7b837e26..9d6020c85d 100644 --- a/packages/artifacts.txt +++ b/packages/artifacts.txt @@ -591,6 +591,8 @@ lib/ocaml/callback.mli lib/ocaml/camlinternalLazy.cmi lib/ocaml/camlinternalLazy.cmt lib/ocaml/camlinternalLazy.cmti +lib/ocaml/camlinternalLazy.ml +lib/ocaml/camlinternalLazy.mli lib/ocaml/camlinternalLazy.res lib/ocaml/camlinternalLazy.resi lib/ocaml/camlinternalMod.cmi diff --git a/tst.res b/tst.res deleted file mode 100644 index 99664c1861..0000000000 --- a/tst.res +++ /dev/null @@ -1,4 +0,0 @@ -let foo : (. unit) => int = (. ()) => 34 - -let u = () -let d = foo(. u) \ No newline at end of file From a28319c6ae37fd69e55afe8540d5d8d31ba9ea2a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 17:54:44 +0200 Subject: [PATCH 04/11] back --- jscomp/core/lam_compile.ml | 4 ++-- jscomp/test/UncurriedExternals.js | 9 +++------ jscomp/test/event_ffi.js | 2 +- jscomp/test/ffi_arity_test.js | 6 +++--- jscomp/test/mt.js | 22 +++++++++++----------- jscomp/test/pipe_send_readline.js | 2 +- jscomp/test/ppx_apply_test.js | 2 +- jscomp/test/raw_output_test.js | 2 +- jscomp/test/reactTestUtils.js | 4 ++-- jscomp/test/tramp_fib.js | 4 ++-- jscomp/test/uncurried_cast.js | 2 +- jscomp/test/uncurry_glob_test.js | 2 +- jscomp/test/uncurry_test.js | 4 ++-- lib/es6/camlinternalLazy.js | 4 ++-- lib/es6/pervasivesU.js | 12 ++++++------ lib/js/camlinternalLazy.js | 4 ++-- lib/js/pervasivesU.js | 12 ++++++------ 17 files changed, 47 insertions(+), 50 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index b416d3e976..1bd7c5b59c 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -1629,8 +1629,8 @@ and compile_prim (prim_info : Lam.prim_info) 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 - (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:0 ?from:None fn) + let fn = fn in + compile_lambda lambda_cxt fn | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false | { primitive = Pjs_object_create labels; args } -> let args_block, args_expr = diff --git a/jscomp/test/UncurriedExternals.js b/jscomp/test/UncurriedExternals.js index 0d387af1e5..272b6b28d3 100644 --- a/jscomp/test/UncurriedExternals.js +++ b/jscomp/test/UncurriedExternals.js @@ -1,6 +1,5 @@ 'use strict'; -var Curry = require("../../lib/js/curry.js"); var React = require("react"); function dd(param) { @@ -124,11 +123,9 @@ function tsiU$1(c) { }); } -function partial_arg() { - return 3; -} - -var match$1 = React.useState(Curry.__1(partial_arg)); +var match$1 = React.useState(function (param) { + return 3; + }); function methodWithAsyncU() { var $$this = this ; diff --git a/jscomp/test/event_ffi.js b/jscomp/test/event_ffi.js index 21c2012404..7cadfe9f2c 100644 --- a/jscomp/test/event_ffi.js +++ b/jscomp/test/event_ffi.js @@ -38,7 +38,7 @@ function ocaml_run(b, c) { return (x + b | 0) + c | 0; } -function a0() { +function a0(param) { console.log("hi"); } diff --git a/jscomp/test/ffi_arity_test.js b/jscomp/test/ffi_arity_test.js index 5bf7c64433..b3c16aa9e3 100644 --- a/jscomp/test/ffi_arity_test.js +++ b/jscomp/test/ffi_arity_test.js @@ -39,7 +39,7 @@ var hh = [ return parseInt(x); }); -function u() { +function u(param) { return 3; } @@ -53,8 +53,8 @@ function fff(param) { vvv.contents = vvv.contents + 1 | 0; } -function g() { - return fff(undefined); +function g(param) { + fff(undefined); } function abc(x, y, z) { diff --git a/jscomp/test/mt.js b/jscomp/test/mt.js index 9f67e949cd..aab79db40e 100644 --- a/jscomp/test/mt.js +++ b/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 () { - 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); + 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); })); } else { console.log("promise suites"); diff --git a/jscomp/test/pipe_send_readline.js b/jscomp/test/pipe_send_readline.js index d62fffd68e..a5a9696d95 100644 --- a/jscomp/test/pipe_send_readline.js +++ b/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 () { + })).on("close", (function (param) { console.log("finished"); })); } diff --git a/jscomp/test/ppx_apply_test.js b/jscomp/test/ppx_apply_test.js index 72ae69fa66..cbf197ba39 100644 --- a/jscomp/test/ppx_apply_test.js +++ b/jscomp/test/ppx_apply_test.js @@ -29,7 +29,7 @@ function eq(loc, x, y) { var u = 3; -function nullary() { +function nullary(param) { return 3; } diff --git a/jscomp/test/raw_output_test.js b/jscomp/test/raw_output_test.js index fb3b4abf3c..35928faa38 100644 --- a/jscomp/test/raw_output_test.js +++ b/jscomp/test/raw_output_test.js @@ -8,7 +8,7 @@ function mk(fn) { (((_)=> console.log('should works'))(undefined)); -console.log((function () { +console.log((function (param) { return 1; })(undefined)); diff --git a/jscomp/test/reactTestUtils.js b/jscomp/test/reactTestUtils.js index 4ce3c32b85..a8dfcef1f7 100644 --- a/jscomp/test/reactTestUtils.js +++ b/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 () { + var reactFunc = function (param) { Curry._1(func, undefined); }; TestUtils.act(reactFunc); } function actAsync(func) { - return TestUtils.act(function () { + return TestUtils.act(function (param) { return Curry._1(func, undefined); }); } diff --git a/jscomp/test/tramp_fib.js b/jscomp/test/tramp_fib.js index 38d763a4db..8cc4cbf004 100644 --- a/jscomp/test/tramp_fib.js +++ b/jscomp/test/tramp_fib.js @@ -20,7 +20,7 @@ function fib(n, k) { } else { return { TAG: "Suspend", - _0: (function () { + _0: (function (param) { 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 () { + _0: (function (param) { return isOdd(n - 1 | 0); }) }; diff --git a/jscomp/test/uncurried_cast.js b/jscomp/test/uncurried_cast.js index 5010bdf468..0205d44de9 100644 --- a/jscomp/test/uncurried_cast.js +++ b/jscomp/test/uncurried_cast.js @@ -76,7 +76,7 @@ var StandardNotation = { anInt: anInt }; -function testRaise$1() { +function testRaise$1(param) { throw { RE_EXN_ID: E, Error: new Error() diff --git a/jscomp/test/uncurry_glob_test.js b/jscomp/test/uncurry_glob_test.js index e4cf4eb0f8..0497e8b309 100644 --- a/jscomp/test/uncurry_glob_test.js +++ b/jscomp/test/uncurry_glob_test.js @@ -8,7 +8,7 @@ function M(U) { }; } -function f() { +function f(param) { return 3; } diff --git a/jscomp/test/uncurry_test.js b/jscomp/test/uncurry_test.js index 4022c67a4e..fb157cc3b5 100644 --- a/jscomp/test/uncurry_test.js +++ b/jscomp/test/uncurry_test.js @@ -1,7 +1,7 @@ 'use strict'; -function f0() { +function f0(param) { return 0; } @@ -25,7 +25,7 @@ console.log([ 1 ]); -function xx() { +function xx(param) { return xx(undefined); } diff --git a/lib/es6/camlinternalLazy.js b/lib/es6/camlinternalLazy.js index 697cd9e5de..e6ea7bbc47 100644 --- a/lib/es6/camlinternalLazy.js +++ b/lib/es6/camlinternalLazy.js @@ -15,7 +15,7 @@ function forward_with_closure(blk, closure) { return result; } -function raise_undefined() { +function raise_undefined(param) { throw { RE_EXN_ID: Undefined, Error: new Error() @@ -32,7 +32,7 @@ function force(lzv) { return forward_with_closure(lzv, closure); } catch (e){ - lzv.VAL = (function () { + lzv.VAL = (function (param) { throw e; }); throw e; diff --git a/lib/es6/pervasivesU.js b/lib/es6/pervasivesU.js index cfebec3f99..c2325c479d 100644 --- a/lib/es6/pervasivesU.js +++ b/lib/es6/pervasivesU.js @@ -170,11 +170,11 @@ function $at(l1, l2) { } } -function print_newline() { +function print_newline(param) { console.log(""); } -function prerr_newline() { +function prerr_newline(param) { console.error(""); } @@ -198,14 +198,14 @@ var exit_function = { function at_exit(f) { var g = exit_function.contents; - exit_function.contents = (function () { + exit_function.contents = (function (param) { f(undefined); - return g(undefined); + g(undefined); }); } -function do_at_exit() { - return exit_function.contents(undefined); +function do_at_exit(param) { + exit_function.contents(undefined); } function exit(retcode) { diff --git a/lib/js/camlinternalLazy.js b/lib/js/camlinternalLazy.js index f812859e83..924db778a7 100644 --- a/lib/js/camlinternalLazy.js +++ b/lib/js/camlinternalLazy.js @@ -15,7 +15,7 @@ function forward_with_closure(blk, closure) { return result; } -function raise_undefined() { +function raise_undefined(param) { throw { RE_EXN_ID: Undefined, Error: new Error() @@ -32,7 +32,7 @@ function force(lzv) { return forward_with_closure(lzv, closure); } catch (e){ - lzv.VAL = (function () { + lzv.VAL = (function (param) { throw e; }); throw e; diff --git a/lib/js/pervasivesU.js b/lib/js/pervasivesU.js index 5d36c9bbdc..544a2a6665 100644 --- a/lib/js/pervasivesU.js +++ b/lib/js/pervasivesU.js @@ -170,11 +170,11 @@ function $at(l1, l2) { } } -function print_newline() { +function print_newline(param) { console.log(""); } -function prerr_newline() { +function prerr_newline(param) { console.error(""); } @@ -198,14 +198,14 @@ var exit_function = { function at_exit(f) { var g = exit_function.contents; - exit_function.contents = (function () { + exit_function.contents = (function (param) { f(undefined); - return g(undefined); + g(undefined); }); } -function do_at_exit() { - return exit_function.contents(undefined); +function do_at_exit(param) { + exit_function.contents(undefined); } function exit(retcode) { From 5ee2d13e7d1b63bf98049b163e9b09bd537c960c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 17:59:20 +0200 Subject: [PATCH 05/11] back --- jscomp/core/lam_compile.ml | 4 ++-- jscomp/core/lam_pass_alpha_conversion.ml | 9 +++++++++ jscomp/test/ffi_arity_test.js | 2 +- jscomp/test/uncurry_glob_test.js | 4 +--- jscomp/test/uncurry_test.js | 9 ++++++--- lib/es6/pervasivesU.js | 6 +----- lib/js/pervasivesU.js | 6 +----- 7 files changed, 21 insertions(+), 19 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 1bd7c5b59c..df4b3e227d 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -1629,8 +1629,8 @@ and compile_prim (prim_info : Lam.prim_info) 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 } -> - let fn = fn in - compile_lambda lambda_cxt fn + compile_lambda lambda_cxt + (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:1 ?from:None fn) | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false | { primitive = Pjs_object_create labels; args } -> let args_block, args_expr = diff --git a/jscomp/core/lam_pass_alpha_conversion.ml b/jscomp/core/lam_pass_alpha_conversion.ml index e682821b60..7c11d32339 100644 --- a/jscomp/core/lam_pass_alpha_conversion.ml +++ b/jscomp/core/lam_pass_alpha_conversion.ml @@ -69,6 +69,15 @@ 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 as primitive; args = [ arg ]; loc } + -> ( + match + Lam_arity.get_first_arity (Lam_arity_analysis.get_arity meta arg) + with + | Some x -> + let arg = simpl arg in + Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:1 ~from:x arg + | None -> Lam.prim ~primitive ~args:[ simpl arg ] loc) | Lprim { primitive; args; loc } -> Lam.prim ~primitive ~args:(Ext_list.map args simpl) loc | Lfunction { arity; params; body; attr } -> diff --git a/jscomp/test/ffi_arity_test.js b/jscomp/test/ffi_arity_test.js index b3c16aa9e3..4503ab76a0 100644 --- a/jscomp/test/ffi_arity_test.js +++ b/jscomp/test/ffi_arity_test.js @@ -65,7 +65,7 @@ function abc(x, y, z) { var abc_u = abc; -g(undefined); +fff(undefined); Mt.from_pair_suites("Ffi_arity_test", { hd: [ diff --git a/jscomp/test/uncurry_glob_test.js b/jscomp/test/uncurry_glob_test.js index 0497e8b309..8006c02677 100644 --- a/jscomp/test/uncurry_glob_test.js +++ b/jscomp/test/uncurry_glob_test.js @@ -12,8 +12,6 @@ function f(param) { return 3; } -f(undefined); - function $plus$great(a, h) { return h(a); } @@ -26,4 +24,4 @@ exports.M = M; exports.f = f; exports.$plus$great = $plus$great; exports.u = u; -/* Not a pure module */ +/* No side effect */ diff --git a/jscomp/test/uncurry_test.js b/jscomp/test/uncurry_test.js index fb157cc3b5..8a8d1e3680 100644 --- a/jscomp/test/uncurry_test.js +++ b/jscomp/test/uncurry_test.js @@ -16,7 +16,7 @@ function f2(a0, a1) { ]; } -console.log(f0(undefined)); +console.log(0); console.log(0); @@ -25,8 +25,11 @@ console.log([ 1 ]); -function xx(param) { - return xx(undefined); +function xx(_param) { + while(true) { + _param = undefined; + continue ; + }; } function log2(logger, message, obj) { diff --git a/lib/es6/pervasivesU.js b/lib/es6/pervasivesU.js index c2325c479d..293b70f45c 100644 --- a/lib/es6/pervasivesU.js +++ b/lib/es6/pervasivesU.js @@ -204,12 +204,8 @@ function at_exit(f) { }); } -function do_at_exit(param) { - exit_function.contents(undefined); -} - function exit(retcode) { - do_at_exit(undefined); + exit_function.contents(undefined); return Caml_sys.sys_exit(retcode); } diff --git a/lib/js/pervasivesU.js b/lib/js/pervasivesU.js index 544a2a6665..60583cbe0c 100644 --- a/lib/js/pervasivesU.js +++ b/lib/js/pervasivesU.js @@ -204,12 +204,8 @@ function at_exit(f) { }); } -function do_at_exit(param) { - exit_function.contents(undefined); -} - function exit(retcode) { - do_at_exit(undefined); + exit_function.contents(undefined); return Caml_sys.sys_exit(retcode); } From e1a2f6f2f0249d731323a9f422ae3d24b9036950 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 18:00:52 +0200 Subject: [PATCH 06/11] Update artifacts.txt --- packages/artifacts.txt | 2 -- 1 file changed, 2 deletions(-) diff --git a/packages/artifacts.txt b/packages/artifacts.txt index 9d6020c85d..6057a77fd3 100644 --- a/packages/artifacts.txt +++ b/packages/artifacts.txt @@ -593,8 +593,6 @@ lib/ocaml/camlinternalLazy.cmt lib/ocaml/camlinternalLazy.cmti lib/ocaml/camlinternalLazy.ml lib/ocaml/camlinternalLazy.mli -lib/ocaml/camlinternalLazy.res -lib/ocaml/camlinternalLazy.resi lib/ocaml/camlinternalMod.cmi lib/ocaml/camlinternalMod.cmt lib/ocaml/camlinternalMod.cmti From d8dea1828ba09e2fb3cc5d0c6062332f0c4c45fb Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 18:03:58 +0200 Subject: [PATCH 07/11] simplify --- jscomp/core/lam_compile.ml | 3 +-- jscomp/core/lam_pass_alpha_conversion.ml | 11 ++--------- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index df4b3e227d..fca8c1c757 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -1629,8 +1629,7 @@ and compile_prim (prim_info : Lam.prim_info) 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 - (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:1 ?from:None fn) + compile_lambda lambda_cxt fn | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false | { primitive = Pjs_object_create labels; args } -> let args_block, args_expr = diff --git a/jscomp/core/lam_pass_alpha_conversion.ml b/jscomp/core/lam_pass_alpha_conversion.ml index 7c11d32339..b17e9b1a95 100644 --- a/jscomp/core/lam_pass_alpha_conversion.ml +++ b/jscomp/core/lam_pass_alpha_conversion.ml @@ -69,15 +69,8 @@ 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 as primitive; args = [ arg ]; loc } - -> ( - match - Lam_arity.get_first_arity (Lam_arity_analysis.get_arity meta arg) - with - | Some x -> - let arg = simpl arg in - Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:1 ~from:x arg - | None -> Lam.prim ~primitive ~args:[ simpl arg ] loc) + | Lprim { primitive = Pjs_fn_make_unit; args = [ arg ]; loc } + -> simpl arg | Lprim { primitive; args; loc } -> Lam.prim ~primitive ~args:(Ext_list.map args simpl) loc | Lfunction { arity; params; body; attr } -> From 47848cd0c5c566bd67f531d056ffc517e0c0b4bb Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 18:21:56 +0200 Subject: [PATCH 08/11] Seems to work with minimal changes. --- jscomp/core/lam_compile.ml | 1 + jscomp/core/lam_pass_alpha_conversion.ml | 8 ++++++-- jscomp/test/UncurriedExternals.js | 2 +- jscomp/test/async_await.js | 4 ++-- jscomp/test/event_ffi.js | 2 +- jscomp/test/ffi_arity_test.js | 6 +++--- jscomp/test/mt.js | 2 +- jscomp/test/pipe_send_readline.js | 2 +- jscomp/test/ppx_apply_test.js | 2 +- jscomp/test/raw_output_test.js | 2 +- jscomp/test/reactTestUtils.js | 4 ++-- jscomp/test/tramp_fib.js | 4 ++-- jscomp/test/uncurried_cast.js | 2 +- jscomp/test/uncurry_glob_test.js | 6 ++++-- jscomp/test/uncurry_test.js | 7 +++---- lib/es6/camlinternalLazy.js | 4 ++-- lib/es6/pervasivesU.js | 12 ++++++++---- lib/js/camlinternalLazy.js | 4 ++-- lib/js/pervasivesU.js | 12 ++++++++---- 19 files changed, 50 insertions(+), 36 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index fca8c1c757..bcdc49778b 100644 --- a/jscomp/core/lam_compile.ml +++ b/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 diff --git a/jscomp/core/lam_pass_alpha_conversion.ml b/jscomp/core/lam_pass_alpha_conversion.ml index b17e9b1a95..ac16929c09 100644 --- a/jscomp/core/lam_pass_alpha_conversion.ml +++ b/jscomp/core/lam_pass_alpha_conversion.ml @@ -69,8 +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 } - -> simpl arg + | Lprim { primitive = Pjs_fn_make_unit; args = [ arg ]; loc } -> + let arg = match arg with + | Lfunction ({arity=1; params=[_]; attr; body}) -> + Lam.function_ ~params:[] ~attr ~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 } -> diff --git a/jscomp/test/UncurriedExternals.js b/jscomp/test/UncurriedExternals.js index 272b6b28d3..96748710c9 100644 --- a/jscomp/test/UncurriedExternals.js +++ b/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; }); diff --git a/jscomp/test/async_await.js b/jscomp/test/async_await.js index 402afb48a5..d392d5d4b7 100644 --- a/jscomp/test/async_await.js +++ b/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; } diff --git a/jscomp/test/event_ffi.js b/jscomp/test/event_ffi.js index 7cadfe9f2c..21c2012404 100644 --- a/jscomp/test/event_ffi.js +++ b/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"); } diff --git a/jscomp/test/ffi_arity_test.js b/jscomp/test/ffi_arity_test.js index 4503ab76a0..575e5bf72b 100644 --- a/jscomp/test/ffi_arity_test.js +++ b/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); } @@ -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: [ diff --git a/jscomp/test/mt.js b/jscomp/test/mt.js index aab79db40e..f84bee3c69 100644 --- a/jscomp/test/mt.js +++ b/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) { diff --git a/jscomp/test/pipe_send_readline.js b/jscomp/test/pipe_send_readline.js index a5a9696d95..d62fffd68e 100644 --- a/jscomp/test/pipe_send_readline.js +++ b/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"); })); } diff --git a/jscomp/test/ppx_apply_test.js b/jscomp/test/ppx_apply_test.js index cbf197ba39..72ae69fa66 100644 --- a/jscomp/test/ppx_apply_test.js +++ b/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; } diff --git a/jscomp/test/raw_output_test.js b/jscomp/test/raw_output_test.js index 35928faa38..fb3b4abf3c 100644 --- a/jscomp/test/raw_output_test.js +++ b/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)); diff --git a/jscomp/test/reactTestUtils.js b/jscomp/test/reactTestUtils.js index a8dfcef1f7..4ce3c32b85 100644 --- a/jscomp/test/reactTestUtils.js +++ b/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); }); } diff --git a/jscomp/test/tramp_fib.js b/jscomp/test/tramp_fib.js index 8cc4cbf004..38d763a4db 100644 --- a/jscomp/test/tramp_fib.js +++ b/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); }) }; diff --git a/jscomp/test/uncurried_cast.js b/jscomp/test/uncurried_cast.js index 0205d44de9..5010bdf468 100644 --- a/jscomp/test/uncurried_cast.js +++ b/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() diff --git a/jscomp/test/uncurry_glob_test.js b/jscomp/test/uncurry_glob_test.js index 8006c02677..e4cf4eb0f8 100644 --- a/jscomp/test/uncurry_glob_test.js +++ b/jscomp/test/uncurry_glob_test.js @@ -8,10 +8,12 @@ function M(U) { }; } -function f(param) { +function f() { return 3; } +f(undefined); + function $plus$great(a, h) { return h(a); } @@ -24,4 +26,4 @@ exports.M = M; exports.f = f; exports.$plus$great = $plus$great; exports.u = u; -/* No side effect */ +/* Not a pure module */ diff --git a/jscomp/test/uncurry_test.js b/jscomp/test/uncurry_test.js index 8a8d1e3680..b1dfe59a5f 100644 --- a/jscomp/test/uncurry_test.js +++ b/jscomp/test/uncurry_test.js @@ -1,7 +1,7 @@ 'use strict'; -function f0(param) { +function f0() { return 0; } @@ -16,7 +16,7 @@ function f2(a0, a1) { ]; } -console.log(0); +console.log(f0(undefined)); console.log(0); @@ -25,9 +25,8 @@ console.log([ 1 ]); -function xx(_param) { +function xx() { while(true) { - _param = undefined; continue ; }; } diff --git a/lib/es6/camlinternalLazy.js b/lib/es6/camlinternalLazy.js index e6ea7bbc47..697cd9e5de 100644 --- a/lib/es6/camlinternalLazy.js +++ b/lib/es6/camlinternalLazy.js @@ -15,7 +15,7 @@ function forward_with_closure(blk, closure) { return result; } -function raise_undefined(param) { +function raise_undefined() { throw { RE_EXN_ID: Undefined, Error: new Error() @@ -32,7 +32,7 @@ function force(lzv) { return forward_with_closure(lzv, closure); } catch (e){ - lzv.VAL = (function (param) { + lzv.VAL = (function () { throw e; }); throw e; diff --git a/lib/es6/pervasivesU.js b/lib/es6/pervasivesU.js index 293b70f45c..e620aafc3a 100644 --- a/lib/es6/pervasivesU.js +++ b/lib/es6/pervasivesU.js @@ -170,11 +170,11 @@ function $at(l1, l2) { } } -function print_newline(param) { +function print_newline() { console.log(""); } -function prerr_newline(param) { +function prerr_newline() { console.error(""); } @@ -198,14 +198,18 @@ var exit_function = { function at_exit(f) { var g = exit_function.contents; - exit_function.contents = (function (param) { + exit_function.contents = (function () { f(undefined); g(undefined); }); } -function exit(retcode) { +function do_at_exit() { exit_function.contents(undefined); +} + +function exit(retcode) { + do_at_exit(undefined); return Caml_sys.sys_exit(retcode); } diff --git a/lib/js/camlinternalLazy.js b/lib/js/camlinternalLazy.js index 924db778a7..f812859e83 100644 --- a/lib/js/camlinternalLazy.js +++ b/lib/js/camlinternalLazy.js @@ -15,7 +15,7 @@ function forward_with_closure(blk, closure) { return result; } -function raise_undefined(param) { +function raise_undefined() { throw { RE_EXN_ID: Undefined, Error: new Error() @@ -32,7 +32,7 @@ function force(lzv) { return forward_with_closure(lzv, closure); } catch (e){ - lzv.VAL = (function (param) { + lzv.VAL = (function () { throw e; }); throw e; diff --git a/lib/js/pervasivesU.js b/lib/js/pervasivesU.js index 60583cbe0c..b4c9f752b3 100644 --- a/lib/js/pervasivesU.js +++ b/lib/js/pervasivesU.js @@ -170,11 +170,11 @@ function $at(l1, l2) { } } -function print_newline(param) { +function print_newline() { console.log(""); } -function prerr_newline(param) { +function prerr_newline() { console.error(""); } @@ -198,14 +198,18 @@ var exit_function = { function at_exit(f) { var g = exit_function.contents; - exit_function.contents = (function (param) { + exit_function.contents = (function () { f(undefined); g(undefined); }); } -function exit(retcode) { +function do_at_exit() { exit_function.contents(undefined); +} + +function exit(retcode) { + do_at_exit(undefined); return Caml_sys.sys_exit(retcode); } From 627181880d43ae3683bd1cbe65b1eeff7798dc98 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 11 Apr 2023 18:45:34 +0200 Subject: [PATCH 09/11] Update artifacts.txt --- packages/artifacts.txt | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/packages/artifacts.txt b/packages/artifacts.txt index cd7b837e26..ea3c960b5a 100644 --- a/packages/artifacts.txt +++ b/packages/artifacts.txt @@ -591,8 +591,8 @@ lib/ocaml/callback.mli lib/ocaml/camlinternalLazy.cmi lib/ocaml/camlinternalLazy.cmt lib/ocaml/camlinternalLazy.cmti -lib/ocaml/camlinternalLazy.res -lib/ocaml/camlinternalLazy.resi +lib/ocaml/camlinternalLazy.ml +lib/ocaml/camlinternalLazy.mli lib/ocaml/camlinternalMod.cmi lib/ocaml/camlinternalMod.cmt lib/ocaml/camlinternalMod.cmti @@ -965,6 +965,10 @@ linux/bsb_helper.exe linux/bsc.exe linux/ninja.exe linux/rescript.exe +linuxarm64/bsb_helper.exe +linuxarm64/bsc.exe +linuxarm64/ninja.exe +linuxarm64/rescript.exe ninja.COPYING package.json rescript From 46e4fbf123dc9d5a49bb6b9ec9018d68136b7bd7 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Wed, 12 Apr 2023 04:51:39 +0200 Subject: [PATCH 10/11] Pass the information oneUnitArg lower down the compiler stack. Instead of removing the arguments on the lambda layer, pass the information down via the lambda layer using the additional field oneUnitArg. When this reaches the Lam layer with ocaml_fun in Lam_compile, only then remove the param. This ensures the code emitted is the same, except for the parameter. --- jscomp/core/js_exp_make.ml | 3 ++- jscomp/core/js_exp_make.mli | 1 + jscomp/core/lam.ml | 2 +- jscomp/core/lam_compile.ml | 12 ++++++------ jscomp/core/lam_pass_alpha_conversion.ml | 4 ++-- jscomp/ml/lambda.ml | 5 ++++- jscomp/ml/lambda.mli | 1 + jscomp/ml/translmod.ml | 1 + jscomp/test/ffi_arity_test.js | 2 +- jscomp/test/uncurry_glob_test.js | 4 +--- jscomp/test/uncurry_test.js | 3 ++- lib/es6/pervasivesU.js | 6 +----- lib/js/pervasivesU.js | 6 +----- 13 files changed, 24 insertions(+), 26 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 12217daa8d..eb1c04efcd 100644 --- a/jscomp/core/js_exp_make.ml +++ b/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 = diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 854683c3bb..430b94645a 100644 --- a/jscomp/core/js_exp_make.mli +++ b/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 diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml index 53d821a10c..47dc60d70d 100644 --- a/jscomp/core/lam.ml +++ b/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 diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index bcdc49778b..4d8bfd175c 100644 --- a/jscomp/core/lam_compile.ml +++ b/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)) @@ -1669,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 *) diff --git a/jscomp/core/lam_pass_alpha_conversion.ml b/jscomp/core/lam_pass_alpha_conversion.ml index ac16929c09..1a4a02a99e 100644 --- a/jscomp/core/lam_pass_alpha_conversion.ml +++ b/jscomp/core/lam_pass_alpha_conversion.ml @@ -71,8 +71,8 @@ let alpha_conversion (meta : Lam_stats.t) (lam : Lam.t) : Lam.t = | 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=[_]; attr; body}) -> - Lam.function_ ~params:[] ~attr ~body ~arity:1 + | 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 } -> diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 680be5d5f9..037502950e 100644 --- a/jscomp/ml/lambda.ml +++ b/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 = diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 3126dbf2f8..af7b81e807 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -271,6 +271,7 @@ type function_attribute = { stub: bool; return_unit : bool; async : bool; + oneUnitArg : bool; } type lambda = diff --git a/jscomp/ml/translmod.ml b/jscomp/ml/translmod.ml index 533e281abf..8815209779 100644 --- a/jscomp/ml/translmod.ml +++ b/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; diff --git a/jscomp/test/ffi_arity_test.js b/jscomp/test/ffi_arity_test.js index 575e5bf72b..357d421316 100644 --- a/jscomp/test/ffi_arity_test.js +++ b/jscomp/test/ffi_arity_test.js @@ -65,7 +65,7 @@ function abc(x, y, z) { var abc_u = abc; -g(undefined); +fff(undefined); Mt.from_pair_suites("Ffi_arity_test", { hd: [ diff --git a/jscomp/test/uncurry_glob_test.js b/jscomp/test/uncurry_glob_test.js index e4cf4eb0f8..71ef0457c4 100644 --- a/jscomp/test/uncurry_glob_test.js +++ b/jscomp/test/uncurry_glob_test.js @@ -12,8 +12,6 @@ function f() { return 3; } -f(undefined); - function $plus$great(a, h) { return h(a); } @@ -26,4 +24,4 @@ exports.M = M; exports.f = f; exports.$plus$great = $plus$great; exports.u = u; -/* Not a pure module */ +/* No side effect */ diff --git a/jscomp/test/uncurry_test.js b/jscomp/test/uncurry_test.js index b1dfe59a5f..edc614b88d 100644 --- a/jscomp/test/uncurry_test.js +++ b/jscomp/test/uncurry_test.js @@ -16,7 +16,7 @@ function f2(a0, a1) { ]; } -console.log(f0(undefined)); +console.log(0); console.log(0); @@ -27,6 +27,7 @@ console.log([ function xx() { while(true) { + _param = undefined; continue ; }; } diff --git a/lib/es6/pervasivesU.js b/lib/es6/pervasivesU.js index e620aafc3a..98659ee37b 100644 --- a/lib/es6/pervasivesU.js +++ b/lib/es6/pervasivesU.js @@ -204,12 +204,8 @@ function at_exit(f) { }); } -function do_at_exit() { - exit_function.contents(undefined); -} - function exit(retcode) { - do_at_exit(undefined); + exit_function.contents(undefined); return Caml_sys.sys_exit(retcode); } diff --git a/lib/js/pervasivesU.js b/lib/js/pervasivesU.js index b4c9f752b3..2ebec348ac 100644 --- a/lib/js/pervasivesU.js +++ b/lib/js/pervasivesU.js @@ -204,12 +204,8 @@ function at_exit(f) { }); } -function do_at_exit() { - exit_function.contents(undefined); -} - function exit(retcode) { - do_at_exit(undefined); + exit_function.contents(undefined); return Caml_sys.sys_exit(retcode); } From 68585f9e11ddbcc20c61a71e3257ace8da051cd0 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Wed, 12 Apr 2023 05:06:51 +0200 Subject: [PATCH 11/11] Update CHANGELOG.md --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index fd16acd8ef..f156e999dc 100644 --- a/CHANGELOG.md +++ b/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 + # 11.0.0-alpha.1 ## :rocket: Main New Features