From c907500383d7f69acff17d53663d916a72ee8705 Mon Sep 17 00:00:00 2001 From: mununki Date: Tue, 10 Nov 2026 00:21:48 +0900 Subject: [PATCH 1/6] Pass undefined for an optional external argument or JSX key that is None MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Why: An optional argument of an external passed as `~x=?e`, where `e` is a call, a dict or array lookup, a conditional or anything else that cannot be read twice to test it first, is compiled to `Primitive_option.valFromOption(e)`. `valFromOption` reads a property of its argument to find a nested `None`, so it threw a `TypeError` when `e` was `None`, though its doc comment says that it keeps `undefined`. #8380 replaced `Primitive_option.toUndefined`, which tested for `undefined` before calling `valFromOption`, on that premise. The same call is emitted for a JSX key, also with `-bs-jsx-preserve`, for the argument of an inlined function that forwards `~x?` to an external, and for an optional `@int` argument, or `@string` argument with `@as`, which switches on it. `valFromOption` now returns `undefined` for `undefined`, as it does for `null`, which fixes all of them. JS modified (Primitive_option.valFromOption): Before (js): function valFromOption(x) { if (x === null || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) { return x; } … } After (js): function valFromOption(x) { if ((x == null) || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) { return x; } … } Output modified (optional argument that is None): Example: %%raw(`function greet(name) { return name === undefined ? "Hello" : "Hello " + name }`) @val external greet: (~name: string=?, unit) => string = "greet" let greetUser = (names: dict, id) => greet(~name=?names->Dict.get(id), ()) Console.log(greetUser(dict{"1": "Ann"}, "2")) Before (js): function greetUser(names, id) { return greet(Primitive_option.valFromOption(names[id])); } After (js): function greetUser(names, id) { return greet(Primitive_option.valFromOption(names[id])); } Before (text): TypeError: Cannot read properties of undefined (reading 'BS_PRIVATE_NESTED_SOME_NONE') After (text): Hello Review: Why change the runtime and not the compiler? Every path that emits the unchecked call goes through `valFromOption`: `Arg_optional` in `ocaml_to_js_eff`, the JSX key in `Lam_compile_primitive`, inlined functions, and `@int` and `@as` arguments, which switch on its result. `get_default_undefined_from_optional` returns an expression, so a test in the compiler needs the argument bound to a temporary: a statement for each such argument, through `hold_arg` for calls and separately for JSX keys, plus temporaries for the arguments to its left (see `sequence_arguments`). Bringing back `toUndefined` would undo #8380 for one comparison. This way the generated code stays as it is, and code that 13.0.0-alpha.5 or later already compiled works once the runtime is updated. Review: Does the extra test cost the other callers anything? They pass a value known to be `Some`: a match on a nested option (`Pval_from_option`), and the branch after `x !== undefined` of an `@obj` assignment or of an optional argument that can be read twice. For them `x == null` replaces `x === null`, still one comparison; in a micro-benchmark of 2×10^8 calls the difference is within noise for objects or numbers alone and under 0.3 ns a call for mixed inputs. The runtime grows by one character, and no other compiled module of the runtime, the stdlib or the tests changes. Review: Could an argument that can be read twice now be compiled to `valFromOption(x)` alone, without `x !== undefined ? … : undefined`? It could, but that would change much output and call the runtime for `None`. The next commit does it only for a JS property read, which may run a getter. Signed-off-by: mununki --- .../optional-external-argument-none.fix.md | 1 + compiler/core/js_of_lam_option.ml | 4 +- .../@rescript/runtime/Primitive_option.res | 2 +- .../runtime/lib/es6/Primitive_option.mjs | 2 +- .../runtime/lib/js/Primitive_option.cjs | 2 +- .../src/optional_external_arg_none_test.mjs | 148 ++++++++++++++++++ .../src/optional_external_arg_none_test.res | 105 +++++++++++++ 7 files changed, 260 insertions(+), 4 deletions(-) create mode 100644 changes/optional-external-argument-none.fix.md create mode 100644 tests/tests/src/optional_external_arg_none_test.mjs create mode 100644 tests/tests/src/optional_external_arg_none_test.res diff --git a/changes/optional-external-argument-none.fix.md b/changes/optional-external-argument-none.fix.md new file mode 100644 index 00000000000..f4682822ead --- /dev/null +++ b/changes/optional-external-argument-none.fix.md @@ -0,0 +1 @@ +- Fix a `TypeError` when an optional external argument such as `~x=?dict->Dict.get(k)`, or an optional JSX key, is `None`. diff --git a/compiler/core/js_of_lam_option.ml b/compiler/core/js_of_lam_option.ml index ef9afc1fa3e..b0179790ed6 100644 --- a/compiler/core/js_of_lam_option.ml +++ b/compiler/core/js_of_lam_option.ml @@ -77,7 +77,9 @@ let get_default_undefined_from_optional (arg : J.expression) : J.expression = if Js_analyzer.is_okay_to_duplicate arg then (* FIXME: no need do such inlining*) E.econd (is_not_none arg) (val_from_option arg) E.undefined - else E.runtime_call Primitive_modules.option "valFromOption" [arg] + else + (* [valFromOption] returns [undefined] for [None] as well *) + E.runtime_call Primitive_modules.option "valFromOption" [arg] let option_unwrap (arg : J.expression) : J.expression = let desc = arg.expression_desc in diff --git a/packages/@rescript/runtime/Primitive_option.res b/packages/@rescript/runtime/Primitive_option.res index 05b4e65f71b..d348909a6d7 100644 --- a/packages/@rescript/runtime/Primitive_option.res +++ b/packages/@rescript/runtime/Primitive_option.res @@ -63,7 +63,7 @@ let fromNull = (type t, x: Primitive_js_extern.null): option => /** Preserves `None`/`undefined` and unwraps one outer option layer. Nested `Some` values stay encoded one level deeper. */ let valFromOption = (x: Obj.t): Obj.t => - if x !== Obj.repr(Primitive_js_extern.null) && isNested(x) { + if !Primitive_js_extern.testAny(x) && isNested(x) { let {depth}: nested = Obj.magic(x) if depth == 0 { Obj.magic(None) diff --git a/packages/@rescript/runtime/lib/es6/Primitive_option.mjs b/packages/@rescript/runtime/lib/es6/Primitive_option.mjs index 9fe7522ae00..13be2c44f1a 100644 --- a/packages/@rescript/runtime/lib/es6/Primitive_option.mjs +++ b/packages/@rescript/runtime/lib/es6/Primitive_option.mjs @@ -46,7 +46,7 @@ function fromNull(x) { } function valFromOption(x) { - if (x === null || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) { + if ((x == null) || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) { return x; } let depth = x.BS_PRIVATE_NESTED_SOME_NONE; diff --git a/packages/@rescript/runtime/lib/js/Primitive_option.cjs b/packages/@rescript/runtime/lib/js/Primitive_option.cjs index 5b50ebc6680..e297a59a405 100644 --- a/packages/@rescript/runtime/lib/js/Primitive_option.cjs +++ b/packages/@rescript/runtime/lib/js/Primitive_option.cjs @@ -46,7 +46,7 @@ function fromNull(x) { } function valFromOption(x) { - if (x === null || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) { + if ((x == null) || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) { return x; } let depth = x.BS_PRIVATE_NESTED_SOME_NONE; diff --git a/tests/tests/src/optional_external_arg_none_test.mjs b/tests/tests/src/optional_external_arg_none_test.mjs new file mode 100644 index 00000000000..5b5b448b867 --- /dev/null +++ b/tests/tests/src/optional_external_arg_none_test.mjs @@ -0,0 +1,148 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + +import * as Mocha from "mocha"; +import * as Test_utils from "./test_utils.mjs"; +import * as Primitive_option from "@rescript/runtime/lib/es6/Primitive_option.mjs"; +import * as JsxRuntime from "react/jsx-runtime"; + +function greet(name) { + return name === undefined ? "Hello" : "Hello " + name +} + +function Greeting(name) { + this.text = greet(name) +} +; + +let makeTarget = (() => { + const calls = [] + const record = (...args) => { + calls.push(args.map(String).join(" ")) + } + return { calls, greet, setLevel: record, setMode: record } +}); + +let opaque = (x => x); + +function greetUser(names, id) { + return greet(Primitive_option.valFromOption(names[id])); +} + +function hello(name, param) { + return greet(name !== undefined ? Primitive_option.valFromOption(name) : undefined); +} + +function helloUser(names, id) { + return greet(Primitive_option.valFromOption(names[id])); +} + +function item(keys, id) { + return JsxRuntime.jsx("li", { + children: id + }, Primitive_option.valFromOption(keys[id])); +} + +Mocha.describe("Optional_external_arg_none_test", () => { + Mocha.test("None from a call, a lookup or a conditional", () => { + let names = { + ann: "Ann" + }; + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 68, characters 7-14", "Hello Ann", greetUser(names, "ann")); + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 69, characters 7-14", "Hello", greetUser(names, "bob")); + let list = ["Ann"]; + let at = i => greet(Primitive_option.valFromOption(list[i])); + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 72, characters 7-14", [ + "Hello Ann", + "Hello" + ], [ + at(0), + at(1) + ]); + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 73, characters 7-14", "Hello", greet(Primitive_option.valFromOption(opaque(undefined)))); + let pick = (b, name) => greet(Primitive_option.valFromOption(b ? name : undefined)); + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 75, characters 7-14", [ + "Hello Ann", + "Hello" + ], [ + pick(true, "Ann"), + pick(false, "Ann") + ]); + }); + Mocha.test("None passed to @send and @new externals", () => { + let t = makeTarget(); + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 80, characters 7-14", "Hello", t.greet(Primitive_option.valFromOption(opaque(undefined)))); + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 81, characters 7-14", "Hello", new Greeting(Primitive_option.valFromOption(opaque(undefined))).text); + }); + Mocha.test("None forwarded by an inlined function", () => { + let names = { + ann: "Ann" + }; + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 86, characters 7-14", [ + "Hello Ann", + "Hello" + ], [ + helloUser(names, "ann"), + helloUser(names, "bob") + ]); + }); + Mocha.test("None for @int and @string arguments", () => { + let t = makeTarget(); + let levels = ["high"]; + let modes = ["dark"]; + t.setLevel((() => { + switch (Primitive_option.valFromOption(levels[0])) { + case "low" : + return 0; + case "high" : + return 10; + } + })()); + t.setLevel((() => { + switch (Primitive_option.valFromOption(levels[1])) { + case "low" : + return 0; + case "high" : + return 10; + } + })()); + t.setMode((() => { + switch (Primitive_option.valFromOption(modes[0])) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })()); + t.setMode((() => { + switch (Primitive_option.valFromOption(modes[1])) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })()); + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 97, characters 7-14", [ + "10", + "undefined", + "dark-mode", + "undefined" + ], t.calls); + }); + Mocha.test("a JSX key that is None", () => { + let keys = { + a: "key-a" + }; + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 102, characters 7-14", "key-a", Primitive_option.fromNullable(item(keys, "a").key)); + Test_utils.eq("File \"optional_external_arg_none_test.res\", line 103, characters 7-14", undefined, Primitive_option.fromNullable(item(keys, "b").key)); + }); +}); + +export { + makeTarget, + opaque, + greetUser, + hello, + helloUser, + item, +} +/* Not a pure module */ diff --git a/tests/tests/src/optional_external_arg_none_test.res b/tests/tests/src/optional_external_arg_none_test.res new file mode 100644 index 00000000000..9ffedc59676 --- /dev/null +++ b/tests/tests/src/optional_external_arg_none_test.res @@ -0,0 +1,105 @@ +@@config({flags: ["-bs-jsx", "4"]}) + +open Mocha +open Test_utils + +// An optional argument of an external passed as `~x=?e` is left out, that +// is passed as undefined, when `e` is None, and so is a JSX key. A call, a +// lookup or a conditional cannot be read twice to test it first, so it is +// unwrapped by Primitive_option.valFromOption, which keeps undefined. + +%%raw(` +function greet(name) { + return name === undefined ? "Hello" : "Hello " + name +} + +function Greeting(name) { + this.text = greet(name) +} +`) + +@val external greet: (~name: string=?, unit) => string = "greet" + +type greeting +@new external makeGreeting: (~name: string=?, unit) => greeting = "Greeting" +@get external text: greeting => string = "text" + +type target + +let makeTarget: unit => target = %raw(`() => { + const calls = [] + const record = (...args) => { + calls.push(args.map(String).join(" ")) + } + return { calls, greet, setLevel: record, setMode: record } +}`) + +@get external calls: target => array = "calls" + +@send external greetWith: (target, ~name: string=?, unit) => string = "greet" + +@send +external setLevel: (target, ~level: @int [#low | @as(10) #high]=?, unit) => unit = "setLevel" + +@send +external setMode: ( + target, + ~mode: @string [@as("light-mode") #light | @as("dark-mode") #dark]=?, + unit, +) => unit = "setMode" + +// Opaque, so that the optimizer cannot tell the argument is None. +let opaque: 'a => 'a = %raw(`x => x`) + +let greetUser = (names: dict, id) => greet(~name=?names->Dict.get(id), ()) + +// Inlined into its callers, where the argument replaces [name]. +let hello = (~name=?, ()) => greet(~name?, ()) + +let helloUser = (names: dict, id) => hello(~name=?names->Dict.get(id), ()) + +let item = (keys: dict, id) =>
  • Dict.get(id)}>{React.string(id)}
  • + +@get external elementKey: React.element => Nullable.t = "key" + +describe(__MODULE__, () => { + test("None from a call, a lookup or a conditional", () => { + let names = dict{"ann": "Ann"} + eq(__LOC__, "Hello Ann", greetUser(names, "ann")) + eq(__LOC__, "Hello", greetUser(names, "bob")) + let list = ["Ann"] + let at = i => greet(~name=?list->Array.get(i), ()) + eq(__LOC__, ("Hello Ann", "Hello"), (at(0), at(1))) + eq(__LOC__, "Hello", greet(~name=?opaque(None), ())) + let pick = (b, name) => greet(~name=?b ? Some(name) : None, ()) + eq(__LOC__, ("Hello Ann", "Hello"), (pick(true, "Ann"), pick(false, "Ann"))) + }) + + test("None passed to @send and @new externals", () => { + let t = makeTarget() + eq(__LOC__, "Hello", t->greetWith(~name=?opaque(None), ())) + eq(__LOC__, "Hello", makeGreeting(~name=?opaque(None), ())->text) + }) + + test("None forwarded by an inlined function", () => { + let names = dict{"ann": "Ann"} + eq(__LOC__, ("Hello Ann", "Hello"), (helloUser(names, "ann"), helloUser(names, "bob"))) + }) + + test("None for @int and @string arguments", () => { + let t = makeTarget() + let levels = [#high] + let modes = [#dark] + t->setLevel(~level=?levels->Array.get(0), ()) + t->setLevel(~level=?levels->Array.get(1), ()) + t->setMode(~mode=?modes->Array.get(0), ()) + t->setMode(~mode=?modes->Array.get(1), ()) + eq(__LOC__, ["10", "undefined", "dark-mode", "undefined"], calls(t)) + }) + + test("a JSX key that is None", () => { + let keys = dict{"a": "key-a"} + eq(__LOC__, Some("key-a"), item(keys, "a")->elementKey->Nullable.toOption) + eq(__LOC__, None, item(keys, "b")->elementKey->Nullable.toOption) + }) +}) From 308b45686d3097e54acab46e83021041e82db15f Mon Sep 17 00:00:00 2001 From: mununki Date: Tue, 10 Nov 2026 00:21:48 +0900 Subject: [PATCH 2/6] Evaluate optional @obj arguments in source order and read properties once MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Why: An `@obj` external builds its object as a literal and assigns an optional argument whose presence is not known after it, under `if (tmp !== undefined)`. So that argument was evaluated after the arguments that follow it: `make(~size=?size(), ~mode=mode(), ())` called `mode()` first, and a later argument with side effects could change what the optional argument read, such as a `@get` getter, a `@val` global, `Dict.get`, an array element, a mutable field or a ref. `hold_obj_args` now binds such an argument to a temporary after its statements, unless evaluating it after the literal gives the same values and effects. As with the temporaries of #9217, `sequence_arguments` then evaluates the arguments to the left of the temporary before it, with `evaluate_now`. That bound an optional argument known to be present as a whole, so that it lost its presence and was assigned after the literal too, and it bound variables and fields of records although defining a temporary as such a value cannot change them. `evaluate_now` now evaluates the value in an `Optional_block` and keeps the block, and `sequence_arguments` leaves an argument that runs no code, a variable, a constant or a field of a record, in place when the statements after it only define variables as such values. A JS property read may run a getter, so it does not count. An optional argument that is a JS property read, as from a `@get` external or a `@val` name with a dot, was read twice, to test it for `None` and to unwrap it, by a call, a JSX key and an `@obj` external alike. A getter ran twice, and one that returned a value and then `undefined` made the call throw a `TypeError`. Such an argument is now read once: a call and a JSX key give it to `Primitive_option.valFromOption`, which returns `undefined` for `None` since the previous commit, and an `@obj` external binds it. `Js_analyzer.is_okay_to_duplicate ~property_reads:false` tells these arguments apart. JS modified (optional argument with side effects): Example: @obj external make: (~size: int=?, ~mode: string, unit) => {..} = "" let o = (size, mode) => make(~size=?size(), ~mode=mode(), ()) Before (js): function o(size, mode) { let tmp = { mode: mode() }; let tmp$1 = size(); if (tmp$1 !== undefined) { tmp.size = tmp$1; } return tmp; } After (js): function o(size, mode) { let tmp = size(); let tmp$1 = { mode: mode() }; if (tmp !== undefined) { tmp$1.size = tmp; } return tmp$1; } JS modified (optional argument that a later argument changes): Example: type source @get external name: source => option = "name" @obj external makeName: (~name: string=?, ~mode: string, unit) => {..} = "" let n = (s, rename) => makeName(~name=?name(s), ~mode=rename(s), ()) Before (js): function n(s, rename) { let tmp = { mode: rename(s) }; if (s.name !== undefined) { tmp.name = s.name; } return tmp; } After (js): function n(s, rename) { let tmp = s.name; let tmp$1 = { mode: rename(s) }; if (tmp !== undefined) { tmp$1.name = tmp; } return tmp$1; } JS modified (arguments before a bound optional argument): Example: type props = {color: string, width?: string} @obj external style: (~color: string=?, ~icon: string=?, ~width: string=?, ~height: string, unit) => {..} = "" let a = (props, height) => style(~color=props.color, ~width=?props.width, ~height=height(), ()) let b = (icon, width, height) => style(~icon=icon(), ~width=?width(), ~height=height(), ()) Before (js): function a(props, height) { let tmp = { color: props.color, height: height() }; if (props.width !== undefined) { tmp.width = props.width; } return tmp; } function b(icon, width, height) { let tmp = { icon: icon(), height: height() }; let tmp$1 = width(); if (tmp$1 !== undefined) { tmp.width = tmp$1; } return tmp; } After (js): function a(props, height) { let tmp = props.width; let tmp$1 = { color: props.color, height: height() }; if (tmp !== undefined) { tmp$1.width = tmp; } return tmp$1; } function b(icon, width, height) { let tmp = icon(); let tmp$1 = width(); let tmp$2 = { icon: tmp, height: height() }; if (tmp$1 !== undefined) { tmp$2.width = tmp$1; } return tmp$2; } JS modified (optional argument known to be present before a temporary): Example: type item = {id: int} @obj external mk: (~item: item=?, ~level: @int [#low | @as(10) #high], unit) => {..} = "" let k = async (f, p) => mk(~item=f(), ~level=await p, ()) Before (js): async function k(f, p) { let tmp = f(); let tmp$1 = await p; let tmp$2 = { level: (() => { switch (tmp$1) { … } })() }; if (tmp !== undefined) { tmp$2.item = Primitive_option.valFromOption(tmp); } return tmp$2; } After (js): async function k(f, p) { let tmp = f(); let tmp$1 = await p; return { item: tmp, level: (() => { switch (tmp$1) { … } })() }; } JS modified (optional property read): Example: type source @get external name: source => option = "name" @val external greet: (~name: string=?, unit) => string = "greet" @val external userName: option = "window.userName" @obj external makeName: (~name: string=?, ~mode: string, unit) => {..} = "" let g = s => greet(~name=?name(s), ()) let u = () => greet(~name=?userName, ()) let m = (o: {"name": option}) => makeName(~name=?o["name"], ~mode="dark", ()) Before (js): function g(s) { return greet(s.name !== undefined ? Primitive_option.valFromOption(s.name) : undefined); } function u() { return greet(window.userName !== undefined ? Primitive_option.valFromOption(window.userName) : undefined); } function m(o) { let tmp = { mode: "dark" }; if (o.name !== undefined) { tmp.name = o.name; } return tmp; } After (js): function g(s) { return greet(Primitive_option.valFromOption(s.name)); } function u() { return greet(Primitive_option.valFromOption(window.userName)); } function m(o) { let tmp = { mode: "dark" }; let tmp$1 = o.name; if (tmp$1 !== undefined) { tmp.name = tmp$1; } return tmp; } JS modified (temporaries for optional arguments of an @obj external): Before (representation): Lam_compile_external_obj.hold_obj_args ~x=?f(), ~m=g() ↦ after the literal ~x=?p.x, ~m=g() ↦ after the literal ~x=?f(), ~m=p.m ↦ after the literal ~x=?f(), g() ↦ after the literal ~x=?p.x, ~m=p.m ↦ after the literal ~x=?f(), ~m="dark" ↦ after the literal ~x=?v, ~m=g() ↦ after the literal ~x=?f(), ~y=?g() ↦ after the literal note: p.x stands for a field, a global or a lookup, and v for an immutable variable After (representation): ~x=?f(), ~m=g() ↦ temporary ~x=?p.x, ~m=g() ↦ temporary ~x=?f(), ~m=p.m ↦ temporary ~x=?f(), g() ↦ temporary ~x=?p.x, ~m=p.m ↦ after the literal ~x=?f(), ~m="dark" ↦ after the literal ~x=?v, ~m=g() ↦ after the literal ~x=?f(), ~y=?g() ↦ after the literal note: p.x stands for a field, a global or a lookup, and v for an immutable variable JS modified (arguments before a statement): Before (representation): Lam_compile.sequence_arguments r.c, then let tmp = r.x ↦ temporary r.c, then let tmp = s.x ↦ temporary s.c, then let tmp = r.x ↦ temporary f(), then let tmp = r.x ↦ temporary r.c, then let tmp = g() ↦ temporary ~c=f(), then a statement ↦ temporary for the option note: r.c is a variable or a field of a record, s.x a JS property read, and ~c=f() an optional argument known to be present After (representation): r.c, then let tmp = r.x ↦ in place r.c, then let tmp = s.x ↦ temporary s.c, then let tmp = r.x ↦ temporary f(), then let tmp = r.x ↦ temporary r.c, then let tmp = g() ↦ temporary ~c=f(), then a statement ↦ temporary for f(), option in place note: r.c is a variable or a field of a record, s.x a JS property read, and ~c=f() an optional argument known to be present JS modified (optional arguments read twice): Before (representation): Js_analyzer.is_okay_to_duplicate x, M.x, globalName ↦ test, then unwrap r.field ↦ test, then unwrap s.prop, o["prop"], window.x ↦ test, then unwrap f(), a[i], c ? x : y ↦ unwrap once After (representation): Js_analyzer.is_okay_to_duplicate ~property_reads:false x, M.x, globalName ↦ test, then unwrap r.field ↦ test, then unwrap s.prop, o["prop"], window.x ↦ unwrap once f(), a[i], c ? x : y ↦ unwrap once note: r.field is a field of a record, s.prop a JS property read, such as a `@get` getter, and window.x a `@val` name with a dot Review: Which calls keep their output? An `@obj` call in which nothing that the literal evaluates after the optional argument can change it or be changed by it: constants, immutable variables and functions, reads without side effects when the optional argument has none either, as in `make(~x=?p.x, ~m=p.m, ())`, and other optional arguments whose presence is not known, which are assigned after it, in order. Variables and fields of records are still tested and unwrapped in place. No checked-in output changes besides the new tests. Review: Which arguments get a temporary they do not need? A later argument is taken to change an optional one unless it is `delay_safe` or neither has side effects, and the JS IR does not say whether a field is mutable or a call pure. So `make(~a=?props.a, ~b=Int.toString(n), ())` binds `props.a`, as `a` above binds `props.width`. A field of a JS object type, `o["x"]`, cannot be told from a getter, so an `@obj` external binds it even when no later argument can change it, as `m` above, while a call no longer tests it inline. Review: Why in `hold_obj_args` and not in `hold_arg`? Whether the argument has to be bound depends on the arguments after it, which `hold_arg` does not see, and only an object-creating external evaluates an argument after the ones that follow it. The binding does not depend on the type of the argument, so an optional polymorphic variant argument keeps its place whether or not `hold_arg` binds a later argument. Review: Why is `delay_safe` passed to `hold_obj_args`? It is `Lam_compile.delay_safe`, which needs the variables the function assigns, and `Lam_compile` depends on this module. Review: Why change `evaluate_now` and `sequence_arguments` here? Before this commit only the temporaries of #9217 for polymorphic variant arguments made `sequence_arguments` bind the arguments to their left, as in `k` above, where `item` lost its place in `Object.keys`. Binding optional arguments of any type would make that common: without the two changes, `b` above would assign `icon` after the literal as well, and `a` would bind `props.color`. Both functions are in `lam_compile.ml`, which #9231 does not change. Review: Why a flag on `is_okay_to_duplicate` and not another predicate? The two differ only in property reads, and its other callers, `min` and `max` of booleans and the object of a `Pjs_object_get`, keep the default. `Js_ast_util.named_expression` takes the same flag, which `assemble_obj_args` passes. Review: Is a `@val` global still read twice? Yes, a plain one is, like a value of a JS module: only a property read is taken to run a getter, as a `@get` external is there to do. A `@val` name with a dot and a global with `@scope` compile to a property read and are read once. Review: What still runs out of order? The side effects of a `unit` or `@ignore` argument are put before the literal or the call, so `mk(~a=f(), g())` calls `g()` first, as before. A getter is taken to have no side effects, so `make(~name=?name(s), ~count=count(s), ())` with two `@get` externals still reads `count` first. Signed-off-by: mununki --- .../optional-external-argument-once.fix.md | 2 + compiler/core/js_analyzer.ml | 9 +- compiler/core/js_analyzer.mli | 11 +- compiler/core/js_ast_util.ml | 5 +- compiler/core/js_ast_util.mli | 5 +- compiler/core/js_of_lam_option.ml | 2 +- compiler/core/lam_compile.ml | 33 +- compiler/core/lam_compile_external_obj.ml | 72 ++- compiler/core/lam_compile_external_obj.mli | 7 +- .../src/optional_external_arg_once_test.mjs | 440 ++++++++++++++++++ .../src/optional_external_arg_once_test.res | 356 ++++++++++++++ 11 files changed, 914 insertions(+), 28 deletions(-) create mode 100644 changes/optional-external-argument-once.fix.md create mode 100644 tests/tests/src/optional_external_arg_once_test.mjs create mode 100644 tests/tests/src/optional_external_arg_once_test.res diff --git a/changes/optional-external-argument-once.fix.md b/changes/optional-external-argument-once.fix.md new file mode 100644 index 00000000000..aec248a9582 --- /dev/null +++ b/changes/optional-external-argument-once.fix.md @@ -0,0 +1,2 @@ +- Evaluate an optional `@obj` argument such as `~x=?f()` in source order. +- Read an optional external argument that is a JS property, such as a `@get` getter, only once. diff --git a/compiler/core/js_analyzer.ml b/compiler/core/js_analyzer.ml index 85f46a68a8a..9eab7e1e39d 100644 --- a/compiler/core/js_analyzer.ml +++ b/compiler/core/js_analyzer.ml @@ -365,8 +365,13 @@ let rev_toplevel_flatten block = is_constant a && is_constant b | _ -> false *) -let rec is_okay_to_duplicate (e : J.expression) = +let rec is_okay_to_duplicate ?(property_reads = true) (e : J.expression) = match e.expression_desc with + | Var (Id id) + when (not property_reads) && Ext_ident.is_js id + && String.contains id.name '.' -> + false | Var _ | Bool _ | Str _ | Template_literal _ | Number _ -> true - | Static_index (e, _s, _off) -> is_okay_to_duplicate e + | Static_index (e, _s, off) -> + (property_reads || off <> None) && is_okay_to_duplicate ~property_reads e | _ -> false diff --git a/compiler/core/js_analyzer.mli b/compiler/core/js_analyzer.mli index 281ec6c4127..e325033937f 100644 --- a/compiler/core/js_analyzer.mli +++ b/compiler/core/js_analyzer.mli @@ -70,8 +70,9 @@ val rev_toplevel_flatten : J.block -> J.block (* val is_constant : J.expression -> bool *) -(** Simple expression, - no computation involved so that it is okay to be duplicated -*) - -val is_okay_to_duplicate : J.expression -> bool +val is_okay_to_duplicate : ?property_reads:bool -> J.expression -> bool +(** Simple expression, no computation involved so that it is okay to be + duplicated. With [~property_reads:false], reading it twice also gives the + same value twice: it reads no JS property, which may run a getter each + time, as one from a [@get] external or a [@val] name with a dot does. + Fields of records count. *) diff --git a/compiler/core/js_ast_util.ml b/compiler/core/js_ast_util.ml index c761a060067..ad164470fe1 100644 --- a/compiler/core/js_ast_util.ml +++ b/compiler/core/js_ast_util.ml @@ -26,8 +26,9 @@ module S = Js_stmt_make -let named_expression (e : J.expression) : (J.statement * Ident.t) option = - if Js_analyzer.is_okay_to_duplicate e then None +let named_expression ?property_reads (e : J.expression) : + (J.statement * Ident.t) option = + if Js_analyzer.is_okay_to_duplicate ?property_reads e then None else let obj = Ext_ident.create_tmp () in let obj_code = S.define_variable ~kind:Strict obj e in diff --git a/compiler/core/js_ast_util.mli b/compiler/core/js_ast_util.mli index 3977f0e4831..24cde0e1816 100644 --- a/compiler/core/js_ast_util.mli +++ b/compiler/core/js_ast_util.mli @@ -22,4 +22,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val named_expression : J.expression -> (J.statement * Ident.t) option +val named_expression : + ?property_reads:bool -> J.expression -> (J.statement * Ident.t) option +(** A temporary bound to the expression, unless + {!Js_analyzer.is_okay_to_duplicate} holds for it *) diff --git a/compiler/core/js_of_lam_option.ml b/compiler/core/js_of_lam_option.ml index b0179790ed6..5ad8ee143a7 100644 --- a/compiler/core/js_of_lam_option.ml +++ b/compiler/core/js_of_lam_option.ml @@ -74,7 +74,7 @@ let get_default_undefined_from_optional (arg : J.expression) : J.expression = match desc with | Optional_block (x, _) -> x (* invariant: option encoding *) | _ -> - if Js_analyzer.is_okay_to_duplicate arg then + if Js_analyzer.is_okay_to_duplicate ~property_reads:false arg then (* FIXME: no need do such inlining*) E.econd (is_not_none arg) (val_from_option arg) E.undefined else diff --git a/compiler/core/lam_compile.ml b/compiler/core/lam_compile.ml index f4841957cba..c0859e2184e 100644 --- a/compiler/core/lam_compile.ml +++ b/compiler/core/lam_compile.ml @@ -282,7 +282,8 @@ let rec delay_safe ~assignable (e : J.expression) = Building an array, block or object literal is pure, so a literal stays in place and its elements are evaluated now instead. That also keeps the literal visible to translations that look into their arguments, such as - the rows of a dict literal or a [@variadic] array. *) + the rows of a dict literal or a [@variadic] array. So does an + [Optional_block], which keeps an optional argument known to be present. *) let rec evaluate_now ~assignable (e : J.expression) : J.block * J.expression = match e.expression_desc with | _ when delay_safe ~assignable e -> ([], e) @@ -291,6 +292,9 @@ let rec evaluate_now ~assignable (e : J.expression) : J.block * J.expression = if Js_analyzer.no_side_effect_expression a then (rest, b) else ({J.statement_desc = Exp a; comment = None; source_loc = None} :: rest, b) + | Optional_block (a, identity) -> + let held, a = evaluate_now ~assignable a in + (held, {e with expression_desc = Optional_block (a, identity)}) | Array xs -> let held, xs = evaluate_all_now ~assignable xs in (held, {e with expression_desc = Array xs}) @@ -327,12 +331,29 @@ and evaluate_all_now ~assignable (xs : J.expression list) : let blocks, xs = Ext_list.split_map xs (evaluate_now ~assignable) in (List.concat blocks, xs) +(* Whether evaluating [e] runs no code: it has no side effects and reads no JS + property, which may run a getter. A record field counts. *) +let runs_no_code (e : J.expression) = + Js_analyzer.is_okay_to_duplicate ~property_reads:false e + +(* Whether [block] only defines variables as values that run no code, as a + temporary bound to a record field does *) +let defines_pure_values (block : J.block) = + Ext_list.for_all block (fun (s : J.statement) -> + match s.statement_desc with + | Variable {value = None} -> true + | Variable {value = Some e} -> runs_no_code e + | _ -> false) + (* Assembles compiled arguments for a call or a literal that evaluates them left to right. Each argument comes with the statements that have to run before its value is read. Putting all statements first and then the values would move the statements of an argument in front of the values of the arguments to its left, so when an argument has statements, every - argument to its left is evaluated before them with [evaluate_now]. + argument to its left is evaluated before them with [evaluate_now]. An + argument that runs no code stays in place when the statements after it + only define values that run none either, since then neither can change + the other. With [~method_callee:true], the first argument is a JS method read [obj.m] being called: the object is held and the property read stays in @@ -351,7 +372,8 @@ let sequence_arguments ?(method_callee = false) ~assignable Ext_list.fold_right args (last, [], []) (fun (block, value) (i, code, values) -> let held, value = - if code = [] then ([], value) + if code = [] || (runs_no_code value && defines_pure_values code) + then ([], value) else match value.expression_desc with | Static_index (obj, name, pos) when method_callee && i = 0 -> @@ -1908,7 +1930,10 @@ let compile output_prefix = | {primitive = Pjs_object_create labels; args} -> let args_code, args_expr = compile_arguments - ~hold:(Lam_compile_external_obj.hold_obj_args labels) + ~hold: + (Lam_compile_external_obj.hold_obj_args + ~delay_safe:(delay_safe ~assignable:lambda_cxt.meta.assignable) + labels) lambda_cxt args in let block, exp = diff --git a/compiler/core/lam_compile_external_obj.ml b/compiler/core/lam_compile_external_obj.ml index ebb97c50c85..3187fd15f7e 100644 --- a/compiler/core/lam_compile_external_obj.ml +++ b/compiler/core/lam_compile_external_obj.ml @@ -36,24 +36,72 @@ module S = Js_stmt_make But the default to be undefined seems reasonable *) +(* Whether [assemble_obj_args] assigns the optional argument [arg] after the + object literal, since its presence is not known *) +let presence_unknown (arg : J.expression) = + Js_of_lam_option.destruct_optional arg ~for_sure_none:false + ~for_sure_some:(fun _ -> false) + ~not_sure:(fun () -> true) + +(* The arguments that [assemble_obj_args] evaluates in the object literal or + before it, which are all but the optional ones whose presence is not + known *) +let rec literal_args (labels : External_arg_spec.obj_params) + (args : (J.block * J.expression) list) = + match (labels, args) with + | {obj_arg_label = Obj_label _; obj_arg_type = Arg_cst _} :: labels, args -> + literal_args labels args + | {obj_arg_label = Obj_optional _} :: labels, (_, arg) :: args + when presence_unknown arg -> + literal_args labels args + | ( {obj_arg_label = Obj_empty | Obj_label _ | Obj_optional _} :: labels, + (_, arg) :: args ) -> + arg :: literal_args labels args + | [], [] -> [] + | [], _ :: _ | _ :: _, [] -> assert false + (* [Lam_compile_external_call.hold_arg] for the compiled arguments of an object-creating external, which pair with the labels as in - [assemble_obj_args] *) -let rec hold_obj_args (labels : External_arg_spec.obj_params) + [assemble_obj_args]. That function assigns an optional argument whose + presence is not known after the object literal, so it evaluates the + argument after the arguments that follow it. Unless that gives the same + values and effects, the argument is bound to a temporary after its + statements, which keeps it in its place. It does when the argument is + [delay_safe], and when each argument that the literal evaluates after it + is [delay_safe] or neither of the two has side effects. *) +let rec hold_obj_args ~(delay_safe : J.expression -> bool) + (labels : External_arg_spec.obj_params) (args : (J.block * J.expression) list) = match (labels, args) with | {obj_arg_label = Obj_label _; obj_arg_type = Arg_cst _} :: labels, args -> - hold_obj_args labels args + hold_obj_args ~delay_safe labels args | {obj_arg_label = Obj_empty} :: labels, arg :: args -> - arg :: hold_obj_args labels args + arg :: hold_obj_args ~delay_safe labels args | {obj_arg_label = Obj_label _; obj_arg_type} :: labels, arg :: args -> Lam_compile_external_call.hold_arg ~arg_label:Arg_label ~arg_type:obj_arg_type arg - :: hold_obj_args labels args + :: hold_obj_args ~delay_safe labels args | {obj_arg_label = Obj_optional _; obj_arg_type} :: labels, arg :: args -> - Lam_compile_external_call.hold_arg ~arg_label:Arg_optional - ~arg_type:obj_arg_type arg - :: hold_obj_args labels args + let ((block, value) as held) = + Lam_compile_external_call.hold_arg ~arg_label:Arg_optional + ~arg_type:obj_arg_type arg + in + let order_matters (later : J.expression) = + not + (delay_safe later + || Js_analyzer.no_side_effect_expression value + && Js_analyzer.no_side_effect_expression later) + in + (if + presence_unknown value + && (not (delay_safe value)) + && List.exists order_matters (literal_args labels args) + then + let tmp = Ext_ident.create_tmp () in + ( Ext_list.append_one block (S.define_variable ~kind:Strict tmp value), + E.var tmp ) + else held) + :: hold_obj_args ~delay_safe labels args | [], [] -> [] | [], _ :: _ | _ :: _, [] -> assert false @@ -130,10 +178,10 @@ let assemble_obj_args (labels : External_arg_spec.obj_params) obj_arg_label = Obj_optional {name = label; for_sure_no_nested_option}; } -> ( - (* Need make sure whether assignment is effectful or not - to avoid code duplication - *) - match Js_ast_util.named_expression arg with + (* [arg] is read for its presence and for its value, so it is + bound to a temporary unless reading it twice gives the + same value twice *) + match Js_ast_util.named_expression ~property_reads:false arg with | None -> ( let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff diff --git a/compiler/core/lam_compile_external_obj.mli b/compiler/core/lam_compile_external_obj.mli index 22ef0262938..86f9b40f901 100644 --- a/compiler/core/lam_compile_external_obj.mli +++ b/compiler/core/lam_compile_external_obj.mli @@ -26,11 +26,16 @@ object literal. *) val hold_obj_args : + delay_safe:(J.expression -> bool) -> External_arg_spec.obj_params -> (J.block * J.expression) list -> (J.block * J.expression) list (** {!Lam_compile_external_call.hold_arg} for the compiled arguments of an - object-creating external *) + object-creating external. An optional argument whose presence is not + known is also bound to a temporary when evaluating it after the object + literal, as {!assemble_obj_args} does, could change a value or the order + of effects. [delay_safe] tells whether evaluating an argument after other + code gives the same value and effects. *) val assemble_obj_args : External_arg_spec.obj_params -> J.expression list -> J.block * J.expression diff --git a/tests/tests/src/optional_external_arg_once_test.mjs b/tests/tests/src/optional_external_arg_once_test.mjs new file mode 100644 index 00000000000..a7f7dec24ae --- /dev/null +++ b/tests/tests/src/optional_external_arg_once_test.mjs @@ -0,0 +1,440 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + +import * as Mocha from "mocha"; +import * as Test_utils from "./test_utils.mjs"; +import * as Stdlib_Dict from "@rescript/runtime/lib/es6/Stdlib_Dict.mjs"; +import * as Primitive_option from "@rescript/runtime/lib/es6/Primitive_option.mjs"; +import * as JsxRuntime from "react/jsx-runtime"; + +let makeSource = (() => ({ + reads: 0, + value: "first", + get name() { + this.reads++ + return this.value + }, + get level() { + this.reads++ + return this.reads === 1 ? "high" : undefined + } +})); + +let makeBumper = (c => ({ + get bump() { + c.count = c.count + 1 + return "bumped" + } +})); + +let setGlobalSource = (s => { + globalThis.optionalExternalArgOnceSource = s +}); + +let setGlobalName = (v => { + globalThis.optionalExternalArgOnceName = v +}); + +function greet(name) { + return name === undefined ? "Hello" : "Hello " + name +} +; + +let makeTarget = (() => { + const calls = [] + return { calls, setLevel: (...args) => { calls.push(args.map(String).join(" ")) } } +}); + +let call = (f => f()); + +function keys(o) { + return Object.keys(o); +} + +Mocha.describe("Optional_external_arg_once_test", () => { + Mocha.test("a getter passed as an optional argument", () => { + let s = makeSource(); + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 150, characters 7-14", [ + "Hello first", + 1 + ], [ + greet(Primitive_option.valFromOption(s.name)), + s.reads + ]); + let s$1 = makeSource(); + let t = makeTarget(); + t.setLevel((() => { + switch (Primitive_option.valFromOption(s$1.level)) { + case "low" : + return 0; + case "high" : + return 10; + } + })()); + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 155, characters 7-14", [ + ["10"], + 1 + ], [ + t.calls, + s$1.reads + ]); + let s$2 = makeSource(); + let key = JsxRuntime.jsx("li", { + children: "item" + }, Primitive_option.valFromOption(s$2.name)).key; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 159, characters 7-14", [ + "first", + 1 + ], [ + (key == null) ? undefined : Primitive_option.some(key), + s$2.reads + ]); + let s$3 = makeSource(); + let tmp = { + mode: "m" + }; + let tmp$1 = s$3.name; + if (tmp$1 !== undefined) { + tmp.name = tmp$1; + } + let o = tmp; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 163, characters 7-14", [ + "first", + 1 + ], [ + o.name, + s$3.reads + ]); + }); + Mocha.test("a global with a dot passed as an optional argument", () => { + let s = makeSource(); + setGlobalSource(s); + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 169, characters 7-14", [ + "Hello first", + 1 + ], [ + greet(Primitive_option.valFromOption(optionalExternalArgOnceSource.name)), + s.reads + ]); + let s$1 = makeSource(); + setGlobalSource(s$1); + let tmp = { + mode: "m" + }; + let tmp$1 = optionalExternalArgOnceSource.name; + if (tmp$1 !== undefined) { + tmp.name = tmp$1; + } + let o = tmp; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 174, characters 7-14", [ + "first", + 1 + ], [ + o.name, + s$1.reads + ]); + }); + Mocha.test("an optional field before a field with side effects", () => { + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let tmp = mark("size", 1); + let tmp$1 = { + mode: mark("mode", "dark") + }; + if (tmp !== undefined) { + tmp$1.size = tmp; + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 184, characters 7-14", [ + "size", + "mode" + ], log); + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 185, characters 7-14", [ + 1, + "dark" + ], [ + o.size, + o.mode + ]); + }); + Mocha.test("an optional field between fields with side effects", () => { + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let tmp = mark("first", "a"); + let tmp$1 = mark("size", undefined); + let tmp$2 = { + first: tmp, + mode: mark("mode", "b") + }; + if (tmp$1 !== undefined) { + tmp$2.size = tmp$1; + } + let o = tmp$2; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 200, characters 7-14", [ + "first", + "size", + "mode" + ], log); + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 201, characters 7-14", [ + "a", + undefined, + "b" + ], [ + o.first, + o.size, + o.mode + ]); + }); + Mocha.test("an optional field before a unit argument with side effects", () => { + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let tmp = mark("size", 2); + let tmp$1 = (mark("unit", undefined), {}); + if (tmp !== undefined) { + tmp$1.size = tmp; + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 211, characters 7-14", [ + "size", + "unit" + ], log); + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 212, characters 7-14", 2, o.size); + }); + Mocha.test("an optional field known to be present stays in the literal", () => { + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let tmp = mark("first", 1); + let tmp$1 = mark("size", 2); + let tmp$2 = { + first: tmp, + mode: mark("mode", "m") + }; + if (tmp$1 !== undefined) { + tmp$2.size = tmp$1; + } + let o = tmp$2; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 227, characters 7-14", [ + "first", + "size", + "mode" + ], log); + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 228, characters 7-14", [ + "first", + "mode", + "size" + ], Object.keys(o)); + }); + Mocha.test("a getter that a later field changes", () => { + let s = makeSource(); + let tmp = s.name; + let tmp$1 = { + mode: call(() => { + s.value = "second"; + return "getter"; + }) + }; + if (tmp !== undefined) { + tmp$1.name = tmp; + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 243, characters 7-14", "first", o.name); + }); + Mocha.test("a field before a getter that changes it", () => { + let c = { + count: 1 + }; + let s = makeBumper(c); + let tmp = c.count; + let tmp$1 = s.bump; + let tmp$2 = { + count: tmp, + mode: call(() => "m") + }; + if (tmp$1 !== undefined) { + tmp$2.name = tmp$1; + } + let o = tmp$2; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 250, characters 7-14", [ + 1, + "bumped", + 2 + ], [ + o.count, + o.name, + c.count + ]); + }); + Mocha.test("a global that a later field changes", () => { + setGlobalName("first"); + let tmp = optionalExternalArgOnceName; + let tmp$1 = { + mode: call(() => { + setGlobalName("second"); + return "global"; + }) + }; + if (tmp !== undefined) { + tmp$1.name = tmp; + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 265, characters 7-14", "first", o.name); + }); + Mocha.test("a dict entry that a later field changes", () => { + let d = { + k: "first" + }; + let tmp = d["k"]; + let tmp$1 = { + mode: call(() => { + Stdlib_Dict.$$delete(d, "k"); + return "dict"; + }) + }; + if (tmp !== undefined) { + tmp$1.name = tmp; + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 280, characters 7-14", "first", o.name); + }); + Mocha.test("an array element that a later field changes", () => { + let a = ["first"]; + let tmp = a[0]; + let tmp$1 = { + mode: call(() => { + a[0] = "second"; + return "array"; + }) + }; + if (tmp !== undefined) { + tmp$1.name = tmp; + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 295, characters 7-14", "first", o.name); + }); + Mocha.test("a ref that a later field changes", () => { + let r = "first"; + let tmp = r; + let tmp$1 = { + mode: call(() => { + r = undefined; + return "ref"; + }) + }; + if (tmp !== undefined) { + tmp$1.name = tmp; + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 310, characters 7-14", "first", o.name); + }); + Mocha.test("a record field that a later field changes", () => { + let item = call(() => ({ + label: "item", + name: "first" + })); + let tmp = item.name; + let tmp$1 = { + label: item.label, + mode: call(() => { + item.name = undefined; + return "record"; + }) + }; + if (tmp !== undefined) { + tmp$1.name = tmp; + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 326, characters 7-14", [ + "item", + "first", + "record" + ], [ + o.label, + o.name, + o.mode + ]); + }); + Mocha.test("optional polymorphic variant fields", () => { + let level = "high"; + let tmp = level; + let tmp$1 = { + mode: call(() => { + level = "low"; + return "level"; + }) + }; + if (tmp !== undefined) { + tmp$1.level = (() => { + switch (tmp) { + case "low" : + return 0; + case "high" : + return 10; + } + })(); + } + let o = tmp$1; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 341, characters 7-14", [ + 10, + "level" + ], [ + o.level, + o.mode + ]); + let mode = "light"; + let tmp$2 = mode; + let tmp$3 = call(() => { + mode = "dark"; + return "high"; + }); + let tmp$4 = { + level: (() => { + switch (tmp$3) { + case "low" : + return 0; + case "high" : + return 10; + } + })() + }; + if (tmp$2 !== undefined) { + tmp$4.mode = (() => { + switch (tmp$2) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })(); + } + let o$1 = tmp$4; + Test_utils.eq("File \"optional_external_arg_once_test.res\", line 354, characters 7-14", [ + "light-mode", + 10 + ], [ + o$1.mode, + o$1.level + ]); + }); +}); + +export { + makeSource, + makeBumper, + setGlobalSource, + setGlobalName, + makeTarget, + call, + keys, +} +/* Not a pure module */ diff --git a/tests/tests/src/optional_external_arg_once_test.res b/tests/tests/src/optional_external_arg_once_test.res new file mode 100644 index 00000000000..3cb13c21133 --- /dev/null +++ b/tests/tests/src/optional_external_arg_once_test.res @@ -0,0 +1,356 @@ +@@config({flags: ["-bs-jsx", "4"]}) + +open Mocha +open Test_utils + +// An optional argument of an external whose presence is not known is +// evaluated once, in source order. A JS property read, which may run a getter, +// is read once, to test it for None and to unwrap it. An object-creating +// external assigns such an argument after the object literal is built, but +// evaluates it before the arguments that follow it when they have side +// effects, or read what its side effects change. The arguments before it, and +// optional arguments known to be present, stay in the literal. + +@obj +external make: (~size: int=?, ~mode: string, unit) => {"size": option, "mode": string} = "" + +@obj +external makeBetween: ( + ~first: string, + ~size: int=?, + ~mode: string, + unit, +) => {"first": string, "size": option, "mode": string} = "" + +@obj +external makeKnown: ( + ~first: int=?, + ~size: int=?, + ~mode: string, + unit, +) => {"first": option, "size": option, "mode": string} = "" + +@obj external makeSize: (~size: int=?, unit) => {"size": option} = "" + +@obj +external makeName: ( + ~name: string=?, + ~mode: string, + unit, +) => {"name": option, "mode": string} = "" + +@obj +external makeCounted: ( + ~count: int, + ~name: string=?, + ~mode: string, + unit, +) => {"count": int, "name": option, "mode": string} = "" + +@obj +external makeLabelled: ( + ~label: string, + ~name: string=?, + ~mode: string, + unit, +) => {"label": string, "name": option, "mode": string} = "" + +@obj +external makeLevel: ( + ~level: @int [#low | @as(10) #high]=?, + ~mode: string, + unit, +) => {"level": option, "mode": string} = "" + +@obj +external makeModeFirst: ( + ~mode: @string [@as("light-mode") #light | @as("dark-mode") #dark]=?, + ~level: @int [#low | @as(10) #high], + unit, +) => {"mode": option, "level": int} = "" + +type source + +// [level] is present on the first read only. +let makeSource: unit => source = %raw(`() => ({ + reads: 0, + value: "first", + get name() { + this.reads++ + return this.value + }, + get level() { + this.reads++ + return this.reads === 1 ? "high" : undefined + } +})`) + +@get external name: source => option = "name" + +type counter = {mutable count: int} + +// Reading [bump] increments the count of the counter it was made with. +let makeBumper: counter => source = %raw(`c => ({ + get bump() { + c.count = c.count + 1 + return "bumped" + } +})`) + +@get external bump: source => option = "bump" +@get external level: source => option<[#low | #high]> = "level" +@get external reads: source => int = "reads" +@set external setValue: (source, string) => unit = "value" + +let setGlobalSource: source => unit = %raw(`s => { + globalThis.optionalExternalArgOnceSource = s +}`) + +// A property read, though it compiles to a JS name. +@val external globalSourceName: option = "optionalExternalArgOnceSource.name" + +@val external globalName: option = "optionalExternalArgOnceName" + +let setGlobalName: string => unit = %raw(`v => { + globalThis.optionalExternalArgOnceName = v +}`) + +%%raw(` +function greet(name) { + return name === undefined ? "Hello" : "Hello " + name +} +`) + +@val external greet: (~name: string=?, unit) => string = "greet" + +type target + +let makeTarget: unit => target = %raw(`() => { + const calls = [] + return { calls, setLevel: (...args) => { calls.push(args.map(String).join(" ")) } } +}`) + +@get external calls: target => array = "calls" + +@send +external setLevel: (target, ~level: @int [#low | @as(10) #high]=?, unit) => unit = "setLevel" + +@get external elementKey: React.element => Nullable.t = "key" + +type item = {label: string, mutable name: option} + +// Calls the function, which the optimizer cannot inline then. +let call: (unit => 'a) => 'a = %raw(`f => f()`) + +let keys = (o: {..}) => Object.keysToArray(Obj.magic(o)) + +describe(__MODULE__, () => { + test("a getter passed as an optional argument", () => { + let s = makeSource() + eq(__LOC__, ("Hello first", 1), (greet(~name=?name(s), ()), reads(s))) + + let s = makeSource() + let t = makeTarget() + t->setLevel(~level=?level(s), ()) + eq(__LOC__, (["10"], 1), (calls(t), reads(s))) + + let s = makeSource() + let key =
  • {React.string("item")}
  • ->elementKey + eq(__LOC__, (Some("first"), 1), (key->Nullable.toOption, reads(s))) + + let s = makeSource() + let o = makeName(~name=?name(s), ~mode="m", ()) + eq(__LOC__, (Some("first"), 1), (o["name"], reads(s))) + }) + + test("a global with a dot passed as an optional argument", () => { + let s = makeSource() + setGlobalSource(s) + eq(__LOC__, ("Hello first", 1), (greet(~name=?globalSourceName, ()), reads(s))) + + let s = makeSource() + setGlobalSource(s) + let o = makeName(~name=?globalSourceName, ~mode="m", ()) + eq(__LOC__, (Some("first"), 1), (o["name"], reads(s))) + }) + + test("an optional field before a field with side effects", () => { + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + let o = make(~size=?mark("size", Some(1)), ~mode=mark("mode", "dark"), ()) + eq(__LOC__, ["size", "mode"], log) + eq(__LOC__, (Some(1), "dark"), (o["size"], o["mode"])) + }) + + test("an optional field between fields with side effects", () => { + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + let o = makeBetween( + ~first=mark("first", "a"), + ~size=?mark("size", None), + ~mode=mark("mode", "b"), + (), + ) + eq(__LOC__, ["first", "size", "mode"], log) + eq(__LOC__, ("a", None, "b"), (o["first"], o["size"], o["mode"])) + }) + + test("an optional field before a unit argument with side effects", () => { + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + let o = makeSize(~size=?mark("size", Some(2)), mark("unit", ())) + eq(__LOC__, ["size", "unit"], log) + eq(__LOC__, Some(2), o["size"]) + }) + + test("an optional field known to be present stays in the literal", () => { + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + let o = makeKnown( + ~first=mark("first", 1), + ~size=?mark("size", Some(2)), + ~mode=mark("mode", "m"), + (), + ) + eq(__LOC__, ["first", "size", "mode"], log) + eq(__LOC__, ["first", "mode", "size"], keys(o)) + }) + + test("a getter that a later field changes", () => { + let s = makeSource() + let o = makeName( + ~name=?name(s), + ~mode=call( + () => { + setValue(s, "second") + "getter" + }, + ), + (), + ) + eq(__LOC__, Some("first"), o["name"]) + }) + + test("a field before a getter that changes it", () => { + let c = {count: 1} + let s = makeBumper(c) + let o = makeCounted(~count=c.count, ~name=?bump(s), ~mode=call(() => "m"), ()) + eq(__LOC__, (1, Some("bumped"), 2), (o["count"], o["name"], c.count)) + }) + + test("a global that a later field changes", () => { + setGlobalName("first") + let o = makeName( + ~name=?globalName, + ~mode=call( + () => { + setGlobalName("second") + "global" + }, + ), + (), + ) + eq(__LOC__, Some("first"), o["name"]) + }) + + test("a dict entry that a later field changes", () => { + let d = dict{"k": "first"} + let o = makeName( + ~name=?d->Dict.get("k"), + ~mode=call( + () => { + d->Dict.delete("k") + "dict" + }, + ), + (), + ) + eq(__LOC__, Some("first"), o["name"]) + }) + + test("an array element that a later field changes", () => { + let a = ["first"] + let o = makeName( + ~name=?a->Array.get(0), + ~mode=call( + () => { + a[0] = "second" + "array" + }, + ), + (), + ) + eq(__LOC__, Some("first"), o["name"]) + }) + + test("a ref that a later field changes", () => { + let r = ref(Some("first")) + let o = makeName( + ~name=?r.contents, + ~mode=call( + () => { + r := None + "ref" + }, + ), + (), + ) + eq(__LOC__, Some("first"), o["name"]) + }) + + test("a record field that a later field changes", () => { + let item = call(() => {label: "item", name: Some("first")}) + let o = makeLabelled( + ~label=item.label, + ~name=?item.name, + ~mode=call( + () => { + item.name = None + "record" + }, + ), + (), + ) + eq(__LOC__, ("item", Some("first"), "record"), (o["label"], o["name"], o["mode"])) + }) + + test("optional polymorphic variant fields", () => { + let level = ref(Some(#high)) + let o = makeLevel( + ~level=?level.contents, + ~mode=call( + () => { + level := Some(#low) + "level" + }, + ), + (), + ) + eq(__LOC__, (Some(10), "level"), (o["level"], o["mode"])) + + let mode = ref(Some(#light)) + let o = makeModeFirst( + ~mode=?mode.contents, + ~level=call( + () => { + mode := Some(#dark) + #high + }, + ), + (), + ) + eq(__LOC__, (Some("light-mode"), 10), (o["mode"], o["level"])) + }) +}) From 8a914c9f842773a5d533c771b71ef4c26cf93889 Mon Sep 17 00:00:00 2001 From: mununki Date: Thu, 5 Nov 2026 05:50:17 +0900 Subject: [PATCH 3/6] Read @val globals and synchronous dispatch arguments of externals in place MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Why: The review of #9217 asked for two changes. A `@val` global passed as an event-style argument was bound to a temporary because it may run a getter, while a `@module` value, which may be a getter as well, was read in place. Reading both in place is simpler and keeps the output globals had before #9217. And an `@int` argument, or a `@string` argument with `@as`, was bound whenever it had side effects, along with the arguments to its left, though the arrow function that switches on it is called where the argument is. Only an `await`, a syntax error in that function, has to be evaluated before it. JS modified (@val global as an event-style argument): Example: type t @val external ev: [#click(int => unit) | #keydown(int => unit)] = "ev" @send external on: (t, @string [#click(int => unit) | #keydown(int => unit)]) => unit = "on" let listen = t => on(t, ev) Before (js): function listen(t) { let tmp = ev; t.on(tmp.NAME, tmp.VAL); } After (js): function listen(t) { t.on(ev.NAME, ev.VAL); } JS modified (@int argument with side effects between others): Example: type t @send external set: (t, string, @int [#low | #high], string) => unit = "set" let update = (t, g, f, h) => set(t, g(), f(), h()) Before (js): function update(t, g, f, h) { let tmp = g(); let tmp$1 = f(); t.set(tmp, (() => { switch (tmp$1) { case "low" : return 0; case "high" : return 1; } })(), h()); } After (js): function update(t, g, f, h) { t.set(g(), (() => { switch (f()) { case "low" : return 0; case "high" : return 1; } })(), h()); } JS modified (temporaries for @int and @as arguments): Before (representation): Lam_compile_external_call.hold_arg f() ↦ temporary pick(async () => await p) ↦ temporary %raw(`"low"`) ↦ temporary await p ↦ temporary %raw(`await p`) ↦ temporary ~l=?f(), presence not known ↦ temporary x, x.contents, b ? x : y ↦ in place After (representation): Lam_compile_external_call.hold_arg f() ↦ in place pick(async () => await p) ↦ in place %raw(`"low"`) ↦ in place await p ↦ temporary %raw(`await p`) ↦ temporary ~l=?f(), presence not known ↦ in place x, x.contents, b ? x : y ↦ in place Tests: `polyvar_external_arg_test.res` now expects a `@val` global passed as an event-style argument to be read for the tag and again for the payload. It adds tests for the order of the arguments around synchronous and awaited `@string` and `@int` arguments; an optional `@int` argument and an optional `@obj` field whose presence is not known, including `None`; and an async function and raw code in an `@int` or `@as` argument. Compiled with the previous commit, only the getter test fails. Review: What is still bound? An `@int` or `@as` argument with an `await` outside the functions it contains, as `setLevel(t, await p)`, and the arguments to its left, so that they still run first. Raw JS code counts as awaiting unless it is a function or a literal, since the compiler cannot see what it does; that is the output #9217 gave it. An event-style argument with side effects is still bound, since it is read twice, and so is a JS property read: a `@get` getter, and a `@val` or `@module` value with `@scope`, which compiles to the same property read and cannot be told from it. Review: Why is an optional argument whose presence is not known read in place too? #9283, which this branch builds on, made the temporary unnecessary. `lvlOpt(t, ~l=?f(), ())` compiles to `Primitive_option.valFromOption(f())`, which returns `undefined` for `None` since then instead of throwing a TypeError, and `hold_obj_args` binds such a field of an `@obj` external itself when evaluating it after the literal could change a value or the order of effects. Review: Why is there no changelog fragment? #9217 was released in 13.0.0-alpha.7 with the entry "Fix an `@string` or `@int` argument of an external being evaluated twice, as in `on(t, mk())`, or breaking `await`", which still holds: an argument with side effects is still evaluated once, and an awaited one is still bound. This commit brings back the output that compilers before #9217 gave a `@val` global, and otherwise only drops temporaries. Signed-off-by: mununki --- compiler/core/js_of_lam_variant.ml | 44 ++- .../src/optional_external_arg_once_test.mjs | 15 +- tests/tests/src/polyvar_external_arg_test.mjs | 335 ++++++++++++++++-- tests/tests/src/polyvar_external_arg_test.res | 145 +++++++- 4 files changed, 474 insertions(+), 65 deletions(-) diff --git a/compiler/core/js_of_lam_variant.ml b/compiler/core/js_of_lam_variant.ml index 43861209824..946c0c7d872 100644 --- a/compiler/core/js_of_lam_variant.ml +++ b/compiler/core/js_of_lam_variant.ml @@ -27,25 +27,51 @@ module S = Js_stmt_make type arg_expression = Splice0 | Splice1 of E.t | Splice2 of E.t * E.t +(* Whether evaluating [e] may await, other than in a function it contains. + Raw JS code may, unless it is a function or a literal: the compiler does not + see what else it does. *) +let awaits (e : J.expression) = + let super = Js_record_iter.super in + let iter = + { + super with + expression = + (fun self e -> + match e.expression_desc with + | Await _ | Raw_js_code {code_info = Exp Js_exp_unknown | Stmt _} -> + raise_notrace Exit + | Fun _ | Raw_js_code {code_info = Exp (Js_function _ | Js_literal _)} + -> + () + | _ -> super.expression self e); + } + in + match iter.expression iter e with + | () -> false + | exception Exit -> true + (* [eval] and [eval_as_int] read an argument other than a literal once, - inside the function that dispatches on it. That is the same as reading it - in place when the read has no effect and cannot await. *) -let eval_in_place (arg : J.expression) = - Js_analyzer.no_side_effect_expression arg + inside an arrow function that dispatches on it and is called where the + argument is. That is the same as evaluating the argument in place, side + effects included, since an arrow function shares [this] and [arguments] + with the code around it, and an expression cannot [break], [continue] or + [return] other than in a function of its own. Only an [await] cannot move + there: it is a syntax error in the arrow function. *) +let eval_in_place (arg : J.expression) = not (awaits arg) (* [eval_as_event] reads an argument other than a literal twice, for the tag (inside the function that dispatches on it, with [@as]) and for the payload. That is the same as reading it once, in place, for constants, variables, and fields, array elements and conditionals of them. A JS global - ([@val]) or a JS property read, as from a [@get] external, may run a getter - each time, so it does not count. *) + ([@val]) counts as a variable, like a value of a JS module ([@module]), + though either may be a getter. A JS property read does not count: a [@get] + external is there to run a getter, and a [@val] or [@module] value with + [@scope] is a property read as well, which cannot be told from it. *) let eval_as_event_in_place (arg : J.expression) = let rec duplicable (e : J.expression) = match e.expression_desc with - | Undefined _ | Bool _ | Number _ | Str _ | Template_literal _ - | Var (Qualified _) -> + | Undefined _ | Bool _ | Number _ | Str _ | Template_literal _ | Var _ -> true - | Var (Id id) -> not (Ext_ident.is_js id) | Static_index (e, _, Some _) -> duplicable e | Array_index (a, b) -> duplicable a && duplicable b | Cond (a, b, c) -> duplicable a && duplicable b && duplicable c diff --git a/tests/tests/src/optional_external_arg_once_test.mjs b/tests/tests/src/optional_external_arg_once_test.mjs index a7f7dec24ae..8e1b9f4e634 100644 --- a/tests/tests/src/optional_external_arg_once_test.mjs +++ b/tests/tests/src/optional_external_arg_once_test.mjs @@ -393,13 +393,12 @@ Mocha.describe("Optional_external_arg_once_test", () => { ]); let mode = "light"; let tmp$2 = mode; - let tmp$3 = call(() => { - mode = "dark"; - return "high"; - }); - let tmp$4 = { + let tmp$3 = { level: (() => { - switch (tmp$3) { + switch (call(() => { + mode = "dark"; + return "high"; + })) { case "low" : return 0; case "high" : @@ -408,7 +407,7 @@ Mocha.describe("Optional_external_arg_once_test", () => { })() }; if (tmp$2 !== undefined) { - tmp$4.mode = (() => { + tmp$3.mode = (() => { switch (tmp$2) { case "light" : return "light-mode"; @@ -417,7 +416,7 @@ Mocha.describe("Optional_external_arg_once_test", () => { } })(); } - let o$1 = tmp$4; + let o$1 = tmp$3; Test_utils.eq("File \"optional_external_arg_once_test.res\", line 354, characters 7-14", [ "light-mode", 10 diff --git a/tests/tests/src/polyvar_external_arg_test.mjs b/tests/tests/src/polyvar_external_arg_test.mjs index 4990ffe2608..ed4c450fcc2 100644 --- a/tests/tests/src/polyvar_external_arg_test.mjs +++ b/tests/tests/src/polyvar_external_arg_test.mjs @@ -13,7 +13,10 @@ let makeTarget = (() => { record(...args) return args[0] === "click" } - return { calls, has, on: record, onAfter: record, onBefore: record, setMode: record, setLevel: record, setLevelOpt: record } + return { + calls, has, on: record, onAfter: record, onBefore: record, + setMode: record, setModeBetween: record, setLevel: record, setLevelBetween: record, setLevelOpt: record + } }); let makeSource = (() => ({ @@ -78,11 +81,11 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(), tmp$1.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 121, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 144, characters 7-14", [ "event", "dispatch" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 122, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 145, characters 7-14", [ "keydown keydown 1", "click! click 1" ], t.calls); @@ -95,54 +98,237 @@ Mocha.describe("Polyvar_external_arg_test", () => { return v; }; t.on("click", mark("payload", click)); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 133, characters 7-14", ["payload"], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 134, characters 7-14", ["click click 1"], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 156, characters 7-14", ["payload"], log); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 157, characters 7-14", ["click click 1"], t.calls); }); - Mocha.test("@string and @int arguments with side effects in temporaries", () => { + Mocha.test("@string and @int arguments with side effects", () => { let t = makeTarget(); let log = []; let mark = (s, v) => { log.push(s); return v; }; - let tmp = mark("mode", opaque("dark")); t.setMode((() => { - switch (tmp) { + switch (mark("mode", opaque("dark"))) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } })()); - let tmp$1 = mark("level", opaque("high")); t.setLevel((() => { - switch (tmp$1) { + switch (mark("level", opaque("high"))) { case "low" : return 0; case "high" : return 10; } })()); - let tmp$2 = mark("optional", opaque("low")); t.setLevelOpt((() => { - switch (tmp$2 !== undefined ? Primitive_option.valFromOption(tmp$2) : undefined) { + switch (Primitive_option.valFromOption(mark("optional", opaque("low")))) { case "low" : return 0; case "high" : return 10; } })()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 147, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 170, characters 7-14", [ "mode", "level", "optional" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 148, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 171, characters 7-14", [ "dark-mode", "10", "0" ], t.calls); }); + Mocha.test("optional @string and @int arguments whose presence is not known", () => { + let t = makeTarget(); + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + t.setLevelOpt((() => { + switch (Primitive_option.valFromOption(mark("some", opaque("high")))) { + case "low" : + return 0; + case "high" : + return 10; + } + })()); + t.setLevelOpt((() => { + switch (Primitive_option.valFromOption(mark("none", opaque(undefined)))) { + case "low" : + return 0; + case "high" : + return 10; + } + })()); + let tmp = mark("mode field", opaque("dark")); + let tmp$1 = { + level: (() => { + switch (mark("level field", opaque("high"))) { + case "low" : + return 0; + case "high" : + return 10; + } + })() + }; + if (tmp !== undefined) { + tmp$1.mode = (() => { + switch (tmp) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })(); + } + let options = tmp$1; + let tmp$2 = mark("no mode field", opaque(undefined)); + let tmp$3 = { + level: (() => { + switch (mark("low field", opaque("low"))) { + case "low" : + return 0; + case "high" : + return 10; + } + })() + }; + if (tmp$2 !== undefined) { + tmp$3.mode = (() => { + switch (tmp$2) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })(); + } + let noMode = tmp$3; + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 193, characters 7-14", [ + "some", + "none", + "mode field", + "level field", + "no mode field", + "low field" + ], log); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 194, characters 7-14", [ + "10", + "undefined" + ], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 195, characters 7-14", [ + 10, + "dark-mode" + ], [ + options.level, + options.mode + ]); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 196, characters 7-14", [ + 0, + undefined + ], [ + noMode.level, + noMode.mode + ]); + }); + Mocha.test("@string and @int arguments that hold an async function or raw code", () => { + let t = makeTarget(); + let pending = []; + let defer = (f, v) => { + pending.push(f); + return v; + }; + t.setLevel((() => { + switch (defer(async () => await Promise.resolve(), opaque("high"))) { + case "low" : + return 0; + case "high" : + return 10; + } + })()); + t.setMode((() => { + switch ("light") { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })()); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 210, characters 7-14", 1, pending.length); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 211, characters 7-14", [ + "10", + "light-mode" + ], t.calls); + }); + Mocha.test("the arguments around @string and @int arguments run in order", () => { + let t = makeTarget(); + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + t.setModeBetween(mark("first", "a"), (() => { + switch (mark("mode", opaque("light"))) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })(), mark("second", "b")); + t.setLevelBetween(mark("third", "c"), (() => { + switch (mark("level", opaque("high"))) { + case "low" : + return 0; + case "high" : + return 10; + } + })(), mark("fourth", "d")); + let options = { + level: (() => { + switch (mark("level field", opaque("low"))) { + case "low" : + return 0; + case "high" : + return 10; + } + })(), + mode: (() => { + switch (mark("mode field", opaque("dark"))) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })() + }; + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 229, characters 6-13", [ + "first", + "mode", + "second", + "third", + "level", + "fourth", + "level field", + "mode field" + ], log); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 233, characters 7-14", [ + "a light-mode b", + "c 10 d" + ], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 234, characters 7-14", [ + 0, + "dark-mode" + ], [ + options.level, + options.mode + ]); + }); Mocha.test("the arguments around an event-style argument run in order", () => { let t = makeTarget(); let log = []; @@ -161,13 +347,13 @@ Mocha.describe("Polyvar_external_arg_test", () => { VAL: keydown })); t.onBefore(tmp$2.NAME, tmp$2.VAL, mark("fourth", "b")); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 160, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 246, characters 7-14", [ "first", "second", "third", "fourth" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 161, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 247, characters 7-14", [ "a click click 1", "keydown keydown 1 b" ], t.calls); @@ -177,14 +363,32 @@ Mocha.describe("Polyvar_external_arg_test", () => { let s = makeSource(); let tmp = s.current; t.on(tmp.NAME, tmp.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 168, characters 7-14", 1, s.reads); + let tmp$1 = s.current; + t.on((() => { + switch (tmp$1.NAME) { + case "click" : + return "click!"; + case "keydown" : + return "keydown!"; + } + })(), tmp$1.VAL); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 255, characters 7-14", 2, s.reads); let globalReads = defineGlobalEvent(); - let tmp$1 = polyvarExternalArgEvent; - t.on(tmp$1.NAME, tmp$1.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 171, characters 7-14", 1, globalReads()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 172, characters 7-14", [ + t.on(polyvarExternalArgEvent.NAME, polyvarExternalArgEvent.VAL); + t.on((() => { + switch (polyvarExternalArgEvent.NAME) { + case "click" : + return "click!"; + case "keydown" : + return "keydown!"; + } + })(), polyvarExternalArgEvent.VAL); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 260, characters 7-14", 4, globalReads()); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 262, characters 6-13", [ "keydown keydown 1", - "click click 1" + "keydown! keydown 1", + "click click 1", + "click! click 1" ], t.calls); }); Mocha.test("refs read as event-style arguments", () => { @@ -219,7 +423,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(), lastEvent.contents.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 185, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 278, characters 6-13", [ "click click 1", "keydown! keydown 1", "keydown keydown 1", @@ -268,16 +472,77 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 202, characters 7-14", [ + let tmp$4 = await mark("optional", Promise.resolve(opaque("high"))); + t.setLevelOpt((() => { + switch (tmp$4 !== undefined ? Primitive_option.valFromOption(tmp$4) : undefined) { + case "low" : + return 0; + case "high" : + return 10; + } + })()); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 296, characters 7-14", [ "event", "dispatch", "mode", - "level" + "level", + "optional" ], log); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 203, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 297, characters 7-14", [ "keydown keydown 1", "click! click 1", "light-mode", + "10", + "10" + ], t.calls); + }); + Mocha.test("awaits in @string and @int arguments between others", async () => { + let t = makeTarget(); + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let tmp = mark("first", "a"); + let tmp$1 = mark("mode", await Promise.resolve(opaque("dark"))); + t.setModeBetween(tmp, (() => { + switch (tmp$1) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })(), mark("second", "b")); + let tmp$2 = mark("third", "c"); + let tmp$3 = await mark("level", Promise.resolve(opaque("low"))); + t.setLevelBetween(tmp$2, (() => { + switch (tmp$3) { + case "low" : + return 0; + case "high" : + return 10; + } + })(), mark("fourth", "d")); + let tmp$4 = (await Promise.resolve("high")); + t.setLevel((() => { + switch (tmp$4) { + case "low" : + return 0; + case "high" : + return 10; + } + })()); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 321, characters 7-14", [ + "first", + "mode", + "second", + "third", + "level", + "fourth" + ], log); + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 322, characters 7-14", [ + "a dark-mode b", + "c 0 d", "10" ], t.calls); }); @@ -318,8 +583,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { ]); }; }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 231, characters 7-14", 3, i); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 232, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 350, characters 7-14", 3, i); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 351, characters 7-14", [ [ 1, 1 @@ -329,7 +594,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { 1 ] ], seen); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 233, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 352, characters 7-14", [ "event", "event", "event" @@ -357,8 +622,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { } n = n + 1 | 0; }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 247, characters 7-14", 3, n); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 248, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 366, characters 7-14", 3, n); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 367, characters 7-14", [ "event", "event", "event" @@ -377,7 +642,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { while (await Promise.resolve(true) && i < events.length && t.has(events[i].NAME, events[i].VAL)) { i = i + 1 | 0; }; - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 260, characters 7-14", 1, i); + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 379, characters 7-14", 1, i); }); Mocha.test("awaited fields of an object-creating external", async () => { let log = []; @@ -428,20 +693,20 @@ Mocha.describe("Polyvar_external_arg_test", () => { })(); } let optional = tmp$4; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 279, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 398, characters 7-14", [ "level", "mode", "level", "mode" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 280, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 399, characters 7-14", [ 10, "dark-mode" ], [ options.level, options.mode ]); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 281, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 400, characters 7-14", [ 0, "light-mode" ], [ diff --git a/tests/tests/src/polyvar_external_arg_test.res b/tests/tests/src/polyvar_external_arg_test.res index cb57b3e50b4..36283470eb2 100644 --- a/tests/tests/src/polyvar_external_arg_test.res +++ b/tests/tests/src/polyvar_external_arg_test.res @@ -5,12 +5,13 @@ open Test_utils external testAsync: (string, unit => promise) => unit = "test" // A polymorphic variant argument of an external is evaluated once, in its -// place among the arguments, and not inside a function the compiler creates. -// An event-style argument is passed as its tag and its payload, and an @as or -// @int dispatch switches on the argument in a function, so an argument with -// side effects is read from a temporary, as is a getter passed as an -// event-style argument. In a while condition, the temporary is bound inside -// the loop. +// place among the arguments. An event-style argument is passed as its tag and +// its payload, so an argument with side effects is read from a temporary, as +// is a JS property read such as a @get getter, while a JS global is read in +// place, like a value of a JS module. An @as or @int dispatch switches on the +// argument in an arrow function called in its place, so the argument is read +// from a temporary only if it awaits. In a while condition, the temporary is +// bound inside the loop. type target @@ -23,7 +24,10 @@ let makeTarget: unit => target = %raw(`() => { record(...args) return args[0] === "click" } - return { calls, has, on: record, onAfter: record, onBefore: record, setMode: record, setLevel: record, setLevelOpt: record } + return { + calls, has, on: record, onAfter: record, onBefore: record, + setMode: record, setModeBetween: record, setLevel: record, setLevelBetween: record, setLevelOpt: record + } }`) @get external calls: target => array = "calls" @@ -44,8 +48,20 @@ external onAs: ( external setMode: (target, @string [@as("light-mode") #light | @as("dark-mode") #dark]) => unit = "setMode" +@send +external setModeBetween: ( + target, + string, + @string [@as("light-mode") #light | @as("dark-mode") #dark], + string, +) => unit = "setModeBetween" + @send external setLevel: (target, @int [#low | @as(10) #high]) => unit = "setLevel" +@send +external setLevelBetween: (target, string, @int [#low | @as(10) #high], string) => unit = + "setLevelBetween" + @send external setLevelOpt: (target, ~level: @int [#low | @as(10) #high]=?, unit) => unit = "setLevelOpt" @@ -70,6 +86,13 @@ external makeOptions: ( unit, ) => _ = "" +@obj +external makeModeFirst: ( + ~mode: @string [@as("light-mode") #light | @as("dark-mode") #dark]=?, + ~level: @int [#low | @as(10) #high], + unit, +) => _ = "" + type source let makeSource: unit => source = %raw(`() => ({ @@ -134,7 +157,7 @@ describe(__MODULE__, () => { eq(__LOC__, ["click click 1"], calls(t)) }) - test("@string and @int arguments with side effects in temporaries", () => { + test("@string and @int arguments with side effects", () => { let t = makeTarget() let log = [] let mark = (s, v) => { @@ -148,6 +171,69 @@ describe(__MODULE__, () => { eq(__LOC__, ["dark-mode", "10", "0"], calls(t)) }) + test("optional @string and @int arguments whose presence is not known", () => { + let t = makeTarget() + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + setLevelOpt(t, ~level=?mark("some", opaque(Some(#high))), ()) + setLevelOpt(t, ~level=?mark("none", opaque(None)), ()) + let options = makeModeFirst( + ~mode=?mark("mode field", opaque(Some(#dark))), + ~level=mark("level field", opaque(#high)), + (), + ) + let noMode = makeModeFirst( + ~mode=?mark("no mode field", opaque(None)), + ~level=mark("low field", opaque(#low)), + (), + ) + eq(__LOC__, ["some", "none", "mode field", "level field", "no mode field", "low field"], log) + eq(__LOC__, ["10", "undefined"], calls(t)) + eq(__LOC__, (10, Some("dark-mode")), (options["level"], options["mode"]->toOption)) + eq(__LOC__, (0, None), (noMode["level"], noMode["mode"]->toOption)) + }) + + test("@string and @int arguments that hold an async function or raw code", () => { + let t = makeTarget() + let pending = [] + let defer = (f, v) => { + pending->Array.push(f) + v + } + // An await in a function of the argument stays there + setLevel(t, defer(async () => await Promise.resolve(), opaque(#high))) + // Raw JS code that is a literal cannot await + setMode(t, %raw(`"light"`)) + eq(__LOC__, 1, Array.length(pending)) + eq(__LOC__, ["10", "light-mode"], calls(t)) + }) + + test("the arguments around @string and @int arguments run in order", () => { + let t = makeTarget() + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + setModeBetween(t, mark("first", "a"), mark("mode", opaque(#light)), mark("second", "b")) + setLevelBetween(t, mark("third", "c"), mark("level", opaque(#high)), mark("fourth", "d")) + let options = makeOptions( + ~level=mark("level field", opaque(#low)), + ~mode=mark("mode field", opaque(#dark)), + (), + ) + eq( + __LOC__, + ["first", "mode", "second", "third", "level", "fourth", "level field", "mode field"], + log, + ) + eq(__LOC__, ["a light-mode b", "c 10 d"], calls(t)) + eq(__LOC__, (0, Some("dark-mode")), (options["level"], options["mode"]->toOption)) + }) + test("the arguments around an event-style argument run in order", () => { let t = makeTarget() let log = [] @@ -165,11 +251,18 @@ describe(__MODULE__, () => { let t = makeTarget() let s = makeSource() on(t, current(s)) - eq(__LOC__, 1, reads(s)) + onAs(t, current(s)) + eq(__LOC__, 2, reads(s)) + // A JS global is read in place, for the tag and for the payload let globalReads = defineGlobalEvent() on(t, globalEvent) - eq(__LOC__, 1, globalReads()) - eq(__LOC__, ["keydown keydown 1", "click click 1"], calls(t)) + onAs(t, globalEvent) + eq(__LOC__, 4, globalReads()) + eq( + __LOC__, + ["keydown keydown 1", "keydown! keydown 1", "click click 1", "click! click 1"], + calls(t), + ) }) test("refs read as event-style arguments", () => { @@ -199,8 +292,34 @@ describe(__MODULE__, () => { onAs(t, await mark("dispatch", Promise.resolve(opaque(#click(click))))) setMode(t, await mark("mode", Promise.resolve(opaque(#light)))) setLevel(t, await mark("level", Promise.resolve(opaque(#high)))) - eq(__LOC__, ["event", "dispatch", "mode", "level"], log) - eq(__LOC__, ["keydown keydown 1", "click! click 1", "light-mode", "10"], calls(t)) + setLevelOpt(t, ~level=?await mark("optional", Promise.resolve(opaque(Some(#high)))), ()) + eq(__LOC__, ["event", "dispatch", "mode", "level", "optional"], log) + eq(__LOC__, ["keydown keydown 1", "click! click 1", "light-mode", "10", "10"], calls(t)) + }) + + testAsync("awaits in @string and @int arguments between others", async () => { + let t = makeTarget() + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + setModeBetween( + t, + mark("first", "a"), + mark("mode", await Promise.resolve(opaque(#dark))), + mark("second", "b"), + ) + setLevelBetween( + t, + mark("third", "c"), + await mark("level", Promise.resolve(opaque(#low))), + mark("fourth", "d"), + ) + // Raw JS code may await + setLevel(t, %raw(`await Promise.resolve("high")`)) + eq(__LOC__, ["first", "mode", "second", "third", "level", "fourth"], log) + eq(__LOC__, ["a dark-mode b", "c 0 d", "10"], calls(t)) }) test("a while condition with a temporary, and break and continue", () => { From c4e1528198e5ffdfc3047599c2be23f29e66f37b Mon Sep 17 00:00:00 2001 From: mununki Date: Tue, 10 Nov 2026 00:32:51 +0900 Subject: [PATCH 4/6] Pass @int and @as arguments of externals to the function that switches on them MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Why: The arrow function that switches on an `@int` argument, or a `@string` argument with `@as`, took no parameter and read the argument inside, so it captured the variables the argument reads. V8 keeps a captured variable alive for as long as any closure created in the same call is, so in the review of #9231 twenty callbacks kept 160 MB alive. 11.1 and 12.3 do this too, with pure arguments as well. Reading the argument inside the function also made an `await` in it a syntax error, which is why #9217 bound awaited arguments to temporaries. Calling the function with the argument evaluates it in the caller, where an `await` is legal, and captures nothing. JS modified (@int argument): Example: type t @send external setLevel: (t, @int [#low | @as(10) #high]) => unit = "setLevel" let setup = (t, classify, big) => { setLevel(t, classify(big)) () => t } let later = async (t, p) => setLevel(t, await p) Before (js): function setup(t, classify, big) { t.setLevel((() => { switch (classify(big)) { case "low" : return 0; case "high" : return 10; } })()); return () => t; } async function later(t, p) { let tmp = await p; t.setLevel((() => { switch (tmp) { … } })()); } After (js): function setup(t, classify, big) { t.setLevel((x => { switch (x) { case "low" : return 0; case "high" : return 10; } })(classify(big))); return () => t; } async function later(t, p) { t.setLevel((x => { switch (x) { … } })(await p)); } JS modified (where an @int or @as argument is evaluated): Before (representation): Lam_compile_external_call.hold_arg setLevel(t, f()) ↦ read inside the function setLevel(t, await p) ↦ temporary setLevel(t, %raw(`await p`)) ↦ temporary setLevelOpt(t, ~level=?f(), ()) ↦ read inside the function After (representation): Lam_compile_external_call.hold_arg setLevel(t, f()) ↦ passed to the function setLevel(t, await p) ↦ passed to the function setLevel(t, %raw(`await p`)) ↦ passed to the function setLevelOpt(t, ~level=?f(), ()) ↦ passed to the function Tests: `polyvar_external_arg_test.res` checks with a `WeakRef` and `gc()` that a closure returned next to an `@int` argument does not keep the record the argument reads alive. Compiled with #9217 or the previous commit, that test fails. Its output, the outputs of the tests of #9283 and `ImportJsValue.res.js` in the gentype tests show the function called with the argument. Review: How does the test call `gc()`? `v8.setFlagsFromString` with `--expose-gc` gives new contexts a `gc` function, which `vm.runInNewContext("gc")` returns, as Jest's leak detection does. A `WeakRef` keeps its target until the end of the current task, so the test waits for a timer before it collects. It failed 20 runs out of 20 with the previous commit and passed 20 out of 20 with this one. Review: Why does raw code that ends in a line comment, such as `"light" // default mode`, still break the module as an `@int` or `@as` argument? The line comment hides the parenthesis that closes the call, as it does for any argument: a `string` argument given that raw code compiles to `t.setName("light" // default mode)` with every compiler. #9217 put such an argument in a temporary on a line of its own, which hid the bug. The previous commit, like compilers before #9217, left it inside the `switch`, where it hid the rest of the line, as the review of #9231 found. Ending raw code that ends in a line comment with a line break belongs in the printer, as a fix of its own. Review: What goes? `Js_of_lam_variant.awaits` and `eval_in_place`, the temporaries for awaited arguments, and `Js_exp_make.of_block`, which had no other use. `hold_arg` now binds only an event-style argument, which cannot be optional, so it loses its `arg_label` parameter. Signed-off-by: mununki --- .../external-int-argument-retention.fix.md | 1 + compiler/core/js_exp_make.ml | 24 -- compiler/core/js_exp_make.mli | 3 - compiler/core/js_of_lam_variant.ml | 119 ++----- compiler/core/js_of_lam_variant.mli | 8 +- compiler/core/lam_compile_external_call.ml | 43 +-- compiler/core/lam_compile_external_call.mli | 8 +- compiler/core/lam_compile_external_obj.ml | 6 +- .../src/ImportJsValue.res.js | 12 +- .../src/optional_external_arg_none_test.mjs | 24 +- .../src/optional_external_arg_once_test.mjs | 30 +- tests/tests/src/polyvar_external_arg_test.mjs | 331 ++++++++++-------- tests/tests/src/polyvar_external_arg_test.res | 52 ++- 13 files changed, 317 insertions(+), 344 deletions(-) create mode 100644 changes/external-int-argument-retention.fix.md diff --git a/changes/external-int-argument-retention.fix.md b/changes/external-int-argument-retention.fix.md new file mode 100644 index 00000000000..31f60c7fb50 --- /dev/null +++ b/changes/external-int-argument-retention.fix.md @@ -0,0 +1 @@ +- Fix an `@int` or `@as` argument of an external keeping what it reads alive for as long as a closure created next to it. diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index ae1a4273aed..14e65935c0b 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -1767,30 +1767,6 @@ let bigint_mod ~checked (e0 : t) (e1 : t) = if checked then runtime_call Primitive_modules.bigint "mod_" [e0; e1] else bigint_op Mod e0 e1 -(* TODO -- alpha conversion - remember to add parens.. -*) -let of_block block : t = - let return_unit = false in - (* This case is not hit that much*) - call ~info:Js_call_info.ml_full_call - { - comment = None; - source_loc = None; - expression_desc = - Fun - { - is_method = false; - params = []; - body = block; - env = Js_fun_env.make 0; - return_unit; - async = false; - directive = None; - }; - } - [] - let is_null (x : t) = triple_equal x nil let is_null_undefined_constant (x : t) = diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli index 2bfc4709c51..2817d6c764b 100644 --- a/compiler/core/js_exp_make.mli +++ b/compiler/core/js_exp_make.mli @@ -307,9 +307,6 @@ val in_ : t -> t -> t val dummy_obj : Lambda.tag_info -> t -val of_block : J.statement list -> t -(** convert a block to expresion by using IIFE *) - val raw_js_code : Js_raw_info.code_info -> string -> t val nil : t diff --git a/compiler/core/js_of_lam_variant.ml b/compiler/core/js_of_lam_variant.ml index 946c0c7d872..27f0fb165c4 100644 --- a/compiler/core/js_of_lam_variant.ml +++ b/compiler/core/js_of_lam_variant.ml @@ -27,46 +27,14 @@ module S = Js_stmt_make type arg_expression = Splice0 | Splice1 of E.t | Splice2 of E.t * E.t -(* Whether evaluating [e] may await, other than in a function it contains. - Raw JS code may, unless it is a function or a literal: the compiler does not - see what else it does. *) -let awaits (e : J.expression) = - let super = Js_record_iter.super in - let iter = - { - super with - expression = - (fun self e -> - match e.expression_desc with - | Await _ | Raw_js_code {code_info = Exp Js_exp_unknown | Stmt _} -> - raise_notrace Exit - | Fun _ | Raw_js_code {code_info = Exp (Js_function _ | Js_literal _)} - -> - () - | _ -> super.expression self e); - } - in - match iter.expression iter e with - | () -> false - | exception Exit -> true - -(* [eval] and [eval_as_int] read an argument other than a literal once, - inside an arrow function that dispatches on it and is called where the - argument is. That is the same as evaluating the argument in place, side - effects included, since an arrow function shares [this] and [arguments] - with the code around it, and an expression cannot [break], [continue] or - [return] other than in a function of its own. Only an [await] cannot move - there: it is a syntax error in the arrow function. *) -let eval_in_place (arg : J.expression) = not (awaits arg) - (* [eval_as_event] reads an argument other than a literal twice, for the tag - (inside the function that dispatches on it, with [@as]) and for the - payload. That is the same as reading it once, in place, for constants, - variables, and fields, array elements and conditionals of them. A JS global - ([@val]) counts as a variable, like a value of a JS module ([@module]), - though either may be a getter. A JS property read does not count: a [@get] - external is there to run a getter, and a [@val] or [@module] value with - [@scope] is a property read as well, which cannot be told from it. *) + and for the payload. That is the same as reading it once, in place, for + constants, variables, and fields, array elements and conditionals of them. + A JS global ([@val]) counts as a variable, like a value of a JS module + ([@module]), though either may be a getter. A JS property read does not + count: a [@get] external is there to run a getter, and a [@val] or + [@module] value with [@scope] is a property read as well, which cannot be + told from it. *) let eval_as_event_in_place (arg : J.expression) = let rec duplicable (e : J.expression) = match e.expression_desc with @@ -81,6 +49,31 @@ let eval_as_event_in_place (arg : J.expression) = | Caml_block ([{expression_desc = Str _}; _], _, Blk_poly_var) -> true | _ -> duplicable arg +(* [(x => { switch (x) { case s: return r; ... } })(arg)]: the result [r] for + the case [s] that [arg] matches. [arg] is an argument of the call, so it is + evaluated once and in its place, and an [await] in it belongs to the code + around it. The function captures no variable of that code, so it keeps + none of them alive for the closures that code creates. *) +let dispatch (arg : J.expression) (cases : (string * 'a) list) + (result : 'a -> J.expression) : J.expression = + let x = Ident.create "x" in + E.call ~info:Js_call_info.ml_full_call + (E.ocaml_fun ~return_unit:false ~async:false ~one_unit_arg:false [x] + [ + S.string_switch (E.var x) + (Ext_list.map cases (fun (s, r) -> + ( Variant_runtime.Literal (String s), + J. + { + switch_body = [S.return_stmt (result r)]; + should_break = false; + (* FIXME: if true, still print break*) + comment = None; + source_loc = None; + } ))); + ]) + [arg] + (* we need destruct [undefined] when input is optional *) let eval (arg : J.expression) (dispatches : (string * string) list) : E.t = if arg == E.undefined then E.undefined @@ -89,21 +82,7 @@ let eval (arg : J.expression) (dispatches : (string * string) list) : E.t = | Str txt -> let s = Ext_list.assoc_by_string dispatches txt None in E.str s - | _ -> - E.of_block - [ - S.string_switch arg - (Ext_list.map dispatches (fun (s, r) -> - ( Variant_runtime.Literal (String s), - J. - { - switch_body = [S.return_stmt (E.str r)]; - should_break = false; - (* FIXME: if true, still print break*) - comment = None; - source_loc = None; - } ))); - ] + | _ -> dispatch arg dispatches E.str (* invariant: optional is not allowed in this case *) (* arg is a polyvar *) @@ -125,21 +104,7 @@ let eval_as_event (arg : J.expression) Splice2 ( (match dispatches with | Some dispatches -> - E.of_block - [ - S.string_switch - (E.poly_var_tag_access arg) - (Ext_list.map dispatches (fun (s, r) -> - ( Variant_runtime.Literal (String s), - J. - { - switch_body = [S.return_stmt (E.str r)]; - should_break = false; - (* FIXME: if true, still print break*) - comment = None; - source_loc = None; - } ))); - ] + dispatch (E.poly_var_tag_access arg) dispatches E.str | None -> E.poly_var_tag_access arg), E.poly_var_value_access arg ) @@ -150,21 +115,7 @@ let eval_as_int (arg : J.expression) (dispatches : (string * int) list) : E.t = match arg.expression_desc with | Str txt -> E.int (Int32.of_int (Ext_list.assoc_by_string dispatches txt None)) - | _ -> - E.of_block - [ - S.string_switch arg - (Ext_list.map dispatches (fun (s, r) -> - ( Variant_runtime.Literal (String s), - J. - { - switch_body = [S.return_stmt (E.int (Int32.of_int r))]; - should_break = false; - (* FIXME: if true, still print break*) - comment = None; - source_loc = None; - } ))); - ] + | _ -> dispatch arg dispatches (fun r -> E.int (Int32.of_int r)) let eval_as_unwrap (arg : J.expression) : E.t = match arg.expression_desc with diff --git a/compiler/core/js_of_lam_variant.mli b/compiler/core/js_of_lam_variant.mli index 47f3cf76736..03fc722053d 100644 --- a/compiler/core/js_of_lam_variant.mli +++ b/compiler/core/js_of_lam_variant.mli @@ -29,19 +29,19 @@ type arg_expression = | Splice1 of J.expression | Splice2 of J.expression * J.expression -val eval_in_place : J.expression -> bool -(** Whether [eval] and [eval_as_int] can be given the argument as it is, - rather than a variable bound to it: they may read it inside a function *) - val eval_as_event_in_place : J.expression -> bool (** Whether [eval_as_event] can be given the argument as it is, rather than a variable bound to it: it may read it twice *) val eval : J.expression -> (string * string) list -> J.expression +(** The string that a [@string] argument stands for. The argument is + evaluated once, in its place: a function that switches on it is called + with it. *) val eval_as_event : J.expression -> (string * string) list option -> arg_expression val eval_as_int : J.expression -> (string * int) list -> J.expression +(** The integer that an [@int] argument stands for, evaluated like [eval] *) val eval_as_unwrap : J.expression -> J.expression diff --git a/compiler/core/lam_compile_external_call.ml b/compiler/core/lam_compile_external_call.ml index 1a63ba8642e..321cd457e50 100644 --- a/compiler/core/lam_compile_external_call.ml +++ b/compiler/core/lam_compile_external_call.ml @@ -115,35 +115,22 @@ let ocaml_to_js_eff ~(arg_label : External_arg_spec.label_noname) (Splice1 single_arg, []) | Nothing -> (Splice1 arg, []) -(* The translation of a polymorphic variant argument other than a literal - reads it twice, as [e.NAME] and [e.VAL], or inside the function that a - dispatch on its tag builds, where an [await] is a syntax error. So unless - the translation can read it in place, the argument is bound to a temporary +(* The translation of an event-style polymorphic variant argument other than + a literal reads it twice, as [e.NAME] and [e.VAL]. So unless reading it + twice is the same as reading it once, the argument is bound to a temporary after its statements, which keeps it in its place among the arguments (see - [sequence_arguments] in [Lam_compile]). Of an optional argument known to be - present, only the payload is bound, so that the translation still knows it - is present. *) -let hold_arg ~(arg_label : External_arg_spec.label_noname) - ~(arg_type : External_arg_spec.attr) + [sequence_arguments] in [Lam_compile]). An [@int] or [@as] argument is + passed, in its place, to a function that switches on it. *) +let hold_arg ~(arg_type : External_arg_spec.attr) ((block, arg) as compiled : J.block * E.t) : J.block * E.t = - let needs_temporary (e : E.t) = - match arg_type with - | Poly_var _ -> not (Js_of_lam_variant.eval_as_event_in_place e) - | Poly_var_string _ | Int _ -> not (Js_of_lam_variant.eval_in_place e) - | Arg_cst _ | Extern_unit | Nothing | Ignore | Unwrap -> false - in - let hold (e : E.t) = + match arg_type with + | Poly_var _ when not (Js_of_lam_variant.eval_as_event_in_place arg) -> let tmp = Ext_ident.create_tmp () in - (Ext_list.append_one block (S.define_variable ~kind:Strict tmp e), E.var tmp) - in - match (arg_label, arg.expression_desc) with - | Arg_optional, Optional_block (x, identity) -> - if needs_temporary x then - let block, x = hold x in - (block, {arg with expression_desc = Optional_block (x, identity)}) - else compiled - | (Arg_optional | Arg_label | Arg_empty), _ -> - if needs_temporary arg then hold arg else compiled + ( Ext_list.append_one block (S.define_variable ~kind:Strict tmp arg), + E.var tmp ) + | Poly_var _ | Poly_var_string _ | Int _ | Arg_cst _ | Extern_unit | Nothing + | Ignore | Unwrap -> + compiled (* [hold_arg] for the compiled arguments of a call, which have the statements that run before their values are read. The specs pair with the @@ -154,8 +141,8 @@ let hold_args (arg_types : External_arg_spec.params) let rec aux (arg_types : External_arg_spec.params) args = match (arg_types, args) with | {arg_type = Arg_cst _; _} :: arg_types, args -> aux arg_types args - | {arg_label; arg_type} :: arg_types, arg :: args -> - hold_arg ~arg_label ~arg_type arg :: aux arg_types args + | {arg_type; _} :: arg_types, arg :: args -> + hold_arg ~arg_type arg :: aux arg_types args | [], args -> args | _ :: _, [] -> assert false in diff --git a/compiler/core/lam_compile_external_call.mli b/compiler/core/lam_compile_external_call.mli index 2b73daa2168..4ce4b7cc2fe 100644 --- a/compiler/core/lam_compile_external_call.mli +++ b/compiler/core/lam_compile_external_call.mli @@ -30,13 +30,13 @@ val ocaml_to_js_eff : (** Compile ocaml external function call to JS IR. *) val hold_arg : - arg_label:External_arg_spec.label_noname -> arg_type:External_arg_spec.attr -> J.block * J.expression -> J.block * J.expression -(** Binds a compiled argument, after its statements, to a temporary unless - [ocaml_to_js_eff] can read it in place: it reads a polymorphic variant - argument twice, or inside a function it builds *) +(** Binds a compiled argument, after its statements, to a temporary when + [ocaml_to_js_eff] would otherwise read it twice: an event-style + polymorphic variant argument, unless reading it twice is the same as + reading it once *) val hold_args : External_arg_spec.params -> diff --git a/compiler/core/lam_compile_external_obj.ml b/compiler/core/lam_compile_external_obj.ml index 3187fd15f7e..de5993cbc5d 100644 --- a/compiler/core/lam_compile_external_obj.ml +++ b/compiler/core/lam_compile_external_obj.ml @@ -78,13 +78,11 @@ let rec hold_obj_args ~(delay_safe : J.expression -> bool) | {obj_arg_label = Obj_empty} :: labels, arg :: args -> arg :: hold_obj_args ~delay_safe labels args | {obj_arg_label = Obj_label _; obj_arg_type} :: labels, arg :: args -> - Lam_compile_external_call.hold_arg ~arg_label:Arg_label - ~arg_type:obj_arg_type arg + Lam_compile_external_call.hold_arg ~arg_type:obj_arg_type arg :: hold_obj_args ~delay_safe labels args | {obj_arg_label = Obj_optional _; obj_arg_type} :: labels, arg :: args -> let ((block, value) as held) = - Lam_compile_external_call.hold_arg ~arg_label:Arg_optional - ~arg_type:obj_arg_type arg + Lam_compile_external_call.hold_arg ~arg_type:obj_arg_type arg in let order_matters (later : J.expression) = not diff --git a/tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js b/tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js index c31daa8a0c4..f9224b1ff38 100644 --- a/tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js +++ b/tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js @@ -48,21 +48,21 @@ function useColor(prim) { } function useEscapedInlineVariant(prim) { - return ImportJsValueGen.useEscapedInlineVariant((() => { - switch (prim) { + return ImportJsValueGen.useEscapedInlineVariant((x => { + switch (x) { case "illegalName" : return "Illegal\"Name"; } - })()); + })(prim)); } function useUtf8InlineVariant(prim) { - return ImportJsValueGen.useUtf8InlineVariant((() => { - switch (prim) { + return ImportJsValueGen.useUtf8InlineVariant((x => { + switch (x) { case "utf8" : return "café\npath\\name"; } - })()); + })(prim)); } function higherOrder(prim) { diff --git a/tests/tests/src/optional_external_arg_none_test.mjs b/tests/tests/src/optional_external_arg_none_test.mjs index 5b5b448b867..b7474fac07c 100644 --- a/tests/tests/src/optional_external_arg_none_test.mjs +++ b/tests/tests/src/optional_external_arg_none_test.mjs @@ -89,38 +89,38 @@ Mocha.describe("Optional_external_arg_none_test", () => { let t = makeTarget(); let levels = ["high"]; let modes = ["dark"]; - t.setLevel((() => { - switch (Primitive_option.valFromOption(levels[0])) { + t.setLevel((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - t.setLevel((() => { - switch (Primitive_option.valFromOption(levels[1])) { + })(Primitive_option.valFromOption(levels[0]))); + t.setLevel((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - t.setMode((() => { - switch (Primitive_option.valFromOption(modes[0])) { + })(Primitive_option.valFromOption(levels[1]))); + t.setMode((x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })()); - t.setMode((() => { - switch (Primitive_option.valFromOption(modes[1])) { + })(Primitive_option.valFromOption(modes[0]))); + t.setMode((x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })()); + })(Primitive_option.valFromOption(modes[1]))); Test_utils.eq("File \"optional_external_arg_none_test.res\", line 97, characters 7-14", [ "10", "undefined", diff --git a/tests/tests/src/optional_external_arg_once_test.mjs b/tests/tests/src/optional_external_arg_once_test.mjs index 8e1b9f4e634..783ebe0347e 100644 --- a/tests/tests/src/optional_external_arg_once_test.mjs +++ b/tests/tests/src/optional_external_arg_once_test.mjs @@ -62,14 +62,14 @@ Mocha.describe("Optional_external_arg_once_test", () => { ]); let s$1 = makeSource(); let t = makeTarget(); - t.setLevel((() => { - switch (Primitive_option.valFromOption(s$1.level)) { + t.setLevel((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); + })(Primitive_option.valFromOption(s$1.level))); Test_utils.eq("File \"optional_external_arg_once_test.res\", line 155, characters 7-14", [ ["10"], 1 @@ -374,14 +374,14 @@ Mocha.describe("Optional_external_arg_once_test", () => { }) }; if (tmp !== undefined) { - tmp$1.level = (() => { - switch (tmp) { + tmp$1.level = (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })(); + })(tmp); } let o = tmp$1; Test_utils.eq("File \"optional_external_arg_once_test.res\", line 341, characters 7-14", [ @@ -394,27 +394,27 @@ Mocha.describe("Optional_external_arg_once_test", () => { let mode = "light"; let tmp$2 = mode; let tmp$3 = { - level: (() => { - switch (call(() => { - mode = "dark"; - return "high"; - })) { + level: (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })() + })(call(() => { + mode = "dark"; + return "high"; + })) }; if (tmp$2 !== undefined) { - tmp$3.mode = (() => { - switch (tmp$2) { + tmp$3.mode = (x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })(); + })(tmp$2); } let o$1 = tmp$3; Test_utils.eq("File \"optional_external_arg_once_test.res\", line 354, characters 7-14", [ diff --git a/tests/tests/src/polyvar_external_arg_test.mjs b/tests/tests/src/polyvar_external_arg_test.mjs index ed4c450fcc2..a4641c1846b 100644 --- a/tests/tests/src/polyvar_external_arg_test.mjs +++ b/tests/tests/src/polyvar_external_arg_test.mjs @@ -1,6 +1,8 @@ // Generated by ReScript, PLEASE EDIT WITH CARE import * as Mocha from "mocha"; +import * as Nodev8 from "node:v8"; +import * as Nodevm from "node:vm"; import * as Test_utils from "./test_utils.mjs"; import * as Primitive_option from "@rescript/runtime/lib/es6/Primitive_option.mjs"; @@ -56,6 +58,41 @@ let lastEvent = { }) }; +function setLevelAndKeep(t, levels) { + t.setLevel((x => { + switch (x) { + case "low" : + return 0; + case "high" : + return 10; + } + })(levels.level)); + return () => t; +} + +function keepClosure(t) { + let levels_level = opaque("high"); + let levels_data = [ + 1, + 2, + 3 + ]; + let levels = { + level: levels_level, + data: levels_data + }; + return [ + new WeakRef(levels), + setLevelAndKeep(t, levels) + ]; +} + +function nextTask() { + return new Promise((resolve, param) => { + setTimeout(() => resolve(), 0); + }); +} + Mocha.describe("Polyvar_external_arg_test", () => { Mocha.test("an event-style argument with side effects", () => { let t = makeTarget(); @@ -73,19 +110,19 @@ Mocha.describe("Polyvar_external_arg_test", () => { NAME: "click", VAL: click })); - t.on((() => { - switch (tmp$1.NAME) { + t.on((x => { + switch (x) { case "click" : return "click!"; case "keydown" : return "keydown!"; } - })(), tmp$1.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 144, characters 7-14", [ + })(tmp$1.NAME), tmp$1.VAL); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 167, characters 7-14", [ "event", "dispatch" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 145, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 168, characters 7-14", [ "keydown keydown 1", "click! click 1" ], t.calls); @@ -98,8 +135,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { return v; }; t.on("click", mark("payload", click)); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 156, characters 7-14", ["payload"], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 157, characters 7-14", ["click click 1"], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 179, characters 7-14", ["payload"], log); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 180, characters 7-14", ["click click 1"], t.calls); }); Mocha.test("@string and @int arguments with side effects", () => { let t = makeTarget(); @@ -108,36 +145,36 @@ Mocha.describe("Polyvar_external_arg_test", () => { log.push(s); return v; }; - t.setMode((() => { - switch (mark("mode", opaque("dark"))) { + t.setMode((x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })()); - t.setLevel((() => { - switch (mark("level", opaque("high"))) { + })(mark("mode", opaque("dark")))); + t.setLevel((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - t.setLevelOpt((() => { - switch (Primitive_option.valFromOption(mark("optional", opaque("low")))) { + })(mark("level", opaque("high")))); + t.setLevelOpt((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 170, characters 7-14", [ + })(Primitive_option.valFromOption(mark("optional", opaque("low"))))); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 193, characters 7-14", [ "mode", "level", "optional" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 171, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 194, characters 7-14", [ "dark-mode", "10", "0" @@ -150,67 +187,67 @@ Mocha.describe("Polyvar_external_arg_test", () => { log.push(s); return v; }; - t.setLevelOpt((() => { - switch (Primitive_option.valFromOption(mark("some", opaque("high")))) { + t.setLevelOpt((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - t.setLevelOpt((() => { - switch (Primitive_option.valFromOption(mark("none", opaque(undefined)))) { + })(Primitive_option.valFromOption(mark("some", opaque("high"))))); + t.setLevelOpt((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); + })(Primitive_option.valFromOption(mark("none", opaque(undefined))))); let tmp = mark("mode field", opaque("dark")); let tmp$1 = { - level: (() => { - switch (mark("level field", opaque("high"))) { + level: (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })() + })(mark("level field", opaque("high"))) }; if (tmp !== undefined) { - tmp$1.mode = (() => { - switch (tmp) { + tmp$1.mode = (x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })(); + })(tmp); } let options = tmp$1; let tmp$2 = mark("no mode field", opaque(undefined)); let tmp$3 = { - level: (() => { - switch (mark("low field", opaque("low"))) { + level: (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })() + })(mark("low field", opaque("low"))) }; if (tmp$2 !== undefined) { - tmp$3.mode = (() => { - switch (tmp$2) { + tmp$3.mode = (x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })(); + })(tmp$2); } let noMode = tmp$3; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 193, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 216, characters 7-14", [ "some", "none", "mode field", @@ -218,18 +255,18 @@ Mocha.describe("Polyvar_external_arg_test", () => { "no mode field", "low field" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 194, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 217, characters 7-14", [ "10", "undefined" ], t.calls); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 195, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 218, characters 7-14", [ 10, "dark-mode" ], [ options.level, options.mode ]); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 196, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 219, characters 7-14", [ 0, undefined ], [ @@ -237,34 +274,34 @@ Mocha.describe("Polyvar_external_arg_test", () => { noMode.mode ]); }); - Mocha.test("@string and @int arguments that hold an async function or raw code", () => { + Mocha.test("an @int argument that holds an async function", () => { let t = makeTarget(); let pending = []; let defer = (f, v) => { pending.push(f); return v; }; - t.setLevel((() => { - switch (defer(async () => await Promise.resolve(), opaque("high"))) { + t.setLevel((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - t.setMode((() => { - switch ("light") { - case "light" : - return "light-mode"; - case "dark" : - return "dark-mode"; - } - })()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 210, characters 7-14", 1, pending.length); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 211, characters 7-14", [ - "10", - "light-mode" - ], t.calls); + })(defer(async () => await Promise.resolve(), opaque("high")))); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 231, characters 7-14", 1, pending.length); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 232, characters 7-14", ["10"], t.calls); + }); + Mocha.test("a closure created next to an @int argument does not keep it alive", async () => { + Nodev8.setFlagsFromString("--expose-gc"); + let gc = Nodevm.runInNewContext("gc"); + let t = makeTarget(); + let match = keepClosure(t); + await nextTask(); + gc(); + Test_utils.ok("File \"polyvar_external_arg_test.res\", line 243, characters 7-14", match[0].deref() === undefined); + Test_utils.ok("File \"polyvar_external_arg_test.res\", line 244, characters 7-14", match[1]() === t); + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 245, characters 7-14", ["10"], t.calls); }); Mocha.test("the arguments around @string and @int arguments run in order", () => { let t = makeTarget(); @@ -273,41 +310,41 @@ Mocha.describe("Polyvar_external_arg_test", () => { log.push(s); return v; }; - t.setModeBetween(mark("first", "a"), (() => { - switch (mark("mode", opaque("light"))) { + t.setModeBetween(mark("first", "a"), (x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })(), mark("second", "b")); - t.setLevelBetween(mark("third", "c"), (() => { - switch (mark("level", opaque("high"))) { + })(mark("mode", opaque("light"))), mark("second", "b")); + t.setLevelBetween(mark("third", "c"), (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })(), mark("fourth", "d")); + })(mark("level", opaque("high"))), mark("fourth", "d")); let options = { - level: (() => { - switch (mark("level field", opaque("low"))) { + level: (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })(), - mode: (() => { - switch (mark("mode field", opaque("dark"))) { + })(mark("level field", opaque("low"))), + mode: (x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })() + })(mark("mode field", opaque("dark"))) }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 229, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 263, characters 6-13", [ "first", "mode", "second", @@ -317,11 +354,11 @@ Mocha.describe("Polyvar_external_arg_test", () => { "level field", "mode field" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 233, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 267, characters 7-14", [ "a light-mode b", "c 10 d" ], t.calls); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 234, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 268, characters 7-14", [ 0, "dark-mode" ], [ @@ -347,13 +384,13 @@ Mocha.describe("Polyvar_external_arg_test", () => { VAL: keydown })); t.onBefore(tmp$2.NAME, tmp$2.VAL, mark("fourth", "b")); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 246, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 280, characters 7-14", [ "first", "second", "third", "fourth" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 247, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 281, characters 7-14", [ "a click click 1", "keydown keydown 1 b" ], t.calls); @@ -364,27 +401,27 @@ Mocha.describe("Polyvar_external_arg_test", () => { let tmp = s.current; t.on(tmp.NAME, tmp.VAL); let tmp$1 = s.current; - t.on((() => { - switch (tmp$1.NAME) { + t.on((x => { + switch (x) { case "click" : return "click!"; case "keydown" : return "keydown!"; } - })(), tmp$1.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 255, characters 7-14", 2, s.reads); + })(tmp$1.NAME), tmp$1.VAL); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 289, characters 7-14", 2, s.reads); let globalReads = defineGlobalEvent(); t.on(polyvarExternalArgEvent.NAME, polyvarExternalArgEvent.VAL); - t.on((() => { - switch (polyvarExternalArgEvent.NAME) { + t.on((x => { + switch (x) { case "click" : return "click!"; case "keydown" : return "keydown!"; } - })(), polyvarExternalArgEvent.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 260, characters 7-14", 4, globalReads()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 262, characters 6-13", [ + })(polyvarExternalArgEvent.NAME), polyvarExternalArgEvent.VAL); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 294, characters 7-14", 4, globalReads()); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 296, characters 6-13", [ "keydown keydown 1", "keydown! keydown 1", "click click 1", @@ -402,28 +439,28 @@ Mocha.describe("Polyvar_external_arg_test", () => { NAME: "keydown", VAL: keydown }); - t.on((() => { - switch (r.NAME) { + t.on((x => { + switch (x) { case "click" : return "click!"; case "keydown" : return "keydown!"; } - })(), r.VAL); + })(r.NAME), r.VAL); t.on(lastEvent.contents.NAME, lastEvent.contents.VAL); lastEvent.contents = opaque({ NAME: "click", VAL: click }); - t.on((() => { - switch (lastEvent.contents.NAME) { + t.on((x => { + switch (x) { case "click" : return "click!"; case "keydown" : return "keydown!"; } - })(), lastEvent.contents.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 278, characters 6-13", [ + })(lastEvent.contents.NAME), lastEvent.contents.VAL); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 312, characters 6-13", [ "click click 1", "keydown! keydown 1", "keydown keydown 1", @@ -446,49 +483,46 @@ Mocha.describe("Polyvar_external_arg_test", () => { NAME: "click", VAL: click }))); - t.on((() => { - switch (tmp$1.NAME) { + t.on((x => { + switch (x) { case "click" : return "click!"; case "keydown" : return "keydown!"; } - })(), tmp$1.VAL); - let tmp$2 = await mark("mode", Promise.resolve(opaque("light"))); - t.setMode((() => { - switch (tmp$2) { + })(tmp$1.NAME), tmp$1.VAL); + t.setMode((x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })()); - let tmp$3 = await mark("level", Promise.resolve(opaque("high"))); - t.setLevel((() => { - switch (tmp$3) { + })(await mark("mode", Promise.resolve(opaque("light"))))); + t.setLevel((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - let tmp$4 = await mark("optional", Promise.resolve(opaque("high"))); - t.setLevelOpt((() => { - switch (tmp$4 !== undefined ? Primitive_option.valFromOption(tmp$4) : undefined) { + })(await mark("level", Promise.resolve(opaque("high"))))); + t.setLevelOpt((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 296, characters 7-14", [ + })(Primitive_option.valFromOption(await mark("optional", Promise.resolve(opaque("high")))))); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 330, characters 7-14", [ "event", "dispatch", "mode", "level", "optional" ], log); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 297, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 331, characters 7-14", [ "keydown keydown 1", "click! click 1", "light-mode", @@ -503,36 +537,31 @@ Mocha.describe("Polyvar_external_arg_test", () => { log.push(s); return v; }; - let tmp = mark("first", "a"); - let tmp$1 = mark("mode", await Promise.resolve(opaque("dark"))); - t.setModeBetween(tmp, (() => { - switch (tmp$1) { + t.setModeBetween(mark("first", "a"), (x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })(), mark("second", "b")); - let tmp$2 = mark("third", "c"); - let tmp$3 = await mark("level", Promise.resolve(opaque("low"))); - t.setLevelBetween(tmp$2, (() => { - switch (tmp$3) { + })(mark("mode", await Promise.resolve(opaque("dark")))), mark("second", "b")); + t.setLevelBetween(mark("third", "c"), (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })(), mark("fourth", "d")); - let tmp$4 = (await Promise.resolve("high")); - t.setLevel((() => { - switch (tmp$4) { + })(await mark("level", Promise.resolve(opaque("low")))), mark("fourth", "d")); + t.setLevel((x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 321, characters 7-14", [ + })((await Promise.resolve("high")))); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 355, characters 7-14", [ "first", "mode", "second", @@ -540,7 +569,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { "level", "fourth" ], log); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 322, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 356, characters 7-14", [ "a dark-mode b", "c 0 d", "10" @@ -583,8 +612,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { ]); }; }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 350, characters 7-14", 3, i); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 351, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 384, characters 7-14", 3, i); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 385, characters 7-14", [ [ 1, 1 @@ -594,7 +623,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { 1 ] ], seen); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 352, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 386, characters 7-14", [ "event", "event", "event" @@ -622,8 +651,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { } n = n + 1 | 0; }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 366, characters 7-14", 3, n); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 367, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 400, characters 7-14", 3, n); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 401, characters 7-14", [ "event", "event", "event" @@ -642,7 +671,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { while (await Promise.resolve(true) && i < events.length && t.has(events[i].NAME, events[i].VAL)) { i = i + 1 | 0; }; - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 379, characters 7-14", 1, i); + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 413, characters 7-14", 1, i); }); Mocha.test("awaited fields of an object-creating external", async () => { let log = []; @@ -650,63 +679,60 @@ Mocha.describe("Polyvar_external_arg_test", () => { log.push(s); return v; }; - let tmp = await mark("level", Promise.resolve(opaque("high"))); - let tmp$1 = await mark("mode", Promise.resolve(opaque("dark"))); let options = { - level: (() => { - switch (tmp) { + level: (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })(), - mode: (() => { - switch (tmp$1) { + })(await mark("level", Promise.resolve(opaque("high")))), + mode: (x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })() + })(await mark("mode", Promise.resolve(opaque("dark")))) }; - let tmp$2 = await mark("level", Promise.resolve(opaque("low"))); - let tmp$3 = await mark("mode", Promise.resolve(opaque("light"))); - let tmp$4 = { - level: (() => { - switch (tmp$2) { + let tmp = { + level: (x => { + switch (x) { case "low" : return 0; case "high" : return 10; } - })() + })(await mark("level", Promise.resolve(opaque("low")))) }; - if (tmp$3 !== undefined) { - tmp$4.mode = (() => { - switch (tmp$3) { + let tmp$1 = await mark("mode", Promise.resolve(opaque("light"))); + if (tmp$1 !== undefined) { + tmp.mode = (x => { + switch (x) { case "light" : return "light-mode"; case "dark" : return "dark-mode"; } - })(); + })(tmp$1); } - let optional = tmp$4; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 398, characters 7-14", [ + let optional = tmp; + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 432, characters 7-14", [ "level", "mode", "level", "mode" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 399, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 433, characters 7-14", [ 10, "dark-mode" ], [ options.level, options.mode ]); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 400, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 434, characters 7-14", [ 0, "light-mode" ], [ @@ -724,5 +750,8 @@ export { click, keydown, lastEvent, + setLevelAndKeep, + keepClosure, + nextTask, } /* lastEvent Not a pure module */ diff --git a/tests/tests/src/polyvar_external_arg_test.res b/tests/tests/src/polyvar_external_arg_test.res index 36283470eb2..3d87b123380 100644 --- a/tests/tests/src/polyvar_external_arg_test.res +++ b/tests/tests/src/polyvar_external_arg_test.res @@ -8,10 +8,11 @@ external testAsync: (string, unit => promise) => unit = "test" // place among the arguments. An event-style argument is passed as its tag and // its payload, so an argument with side effects is read from a temporary, as // is a JS property read such as a @get getter, while a JS global is read in -// place, like a value of a JS module. An @as or @int dispatch switches on the -// argument in an arrow function called in its place, so the argument is read -// from a temporary only if it awaits. In a while condition, the temporary is -// bound inside the loop. +// place, like a value of a JS module. An @as or @int dispatch is a function +// that switches on the argument and is called with it, so the argument, an +// await in it included, is evaluated where it is. Like any argument, it is +// read from a temporary only if an argument after it has statements to run +// first. In a while condition, the temporary is bound inside the loop. type target @@ -131,6 +132,28 @@ let keydown = x => "keydown " ++ Int.toString(x) let lastEvent = ref(opaque(#keydown(keydown))) +type weakRef<'a> +@new external makeWeakRef: 'a => weakRef<'a> = "WeakRef" +@send external deref: weakRef<'a> => option<'a> = "deref" +@module("node:v8") external setV8Flags: string => unit = "setFlagsFromString" +@module("node:vm") external runInNewContext: string => unit => unit = "runInNewContext" + +type levels = {level: [#low | #high], data: array} + +// The function that switches on the argument is called with it and captures +// no variable, so the closure returned does not keep [levels] alive. +let setLevelAndKeep = (t, levels) => { + setLevel(t, levels.level) + () => t +} + +let keepClosure = t => { + let levels = {level: opaque(#high), data: [1, 2, 3]} + (makeWeakRef(levels), setLevelAndKeep(t, levels)) +} + +let nextTask = () => Promise.make((resolve, _) => setTimeout(() => resolve(), 0)->ignore) + describe(__MODULE__, () => { test("an event-style argument with side effects", () => { let t = makeTarget() @@ -196,7 +219,7 @@ describe(__MODULE__, () => { eq(__LOC__, (0, None), (noMode["level"], noMode["mode"]->toOption)) }) - test("@string and @int arguments that hold an async function or raw code", () => { + test("an @int argument that holds an async function", () => { let t = makeTarget() let pending = [] let defer = (f, v) => { @@ -205,10 +228,21 @@ describe(__MODULE__, () => { } // An await in a function of the argument stays there setLevel(t, defer(async () => await Promise.resolve(), opaque(#high))) - // Raw JS code that is a literal cannot await - setMode(t, %raw(`"light"`)) eq(__LOC__, 1, Array.length(pending)) - eq(__LOC__, ["10", "light-mode"], calls(t)) + eq(__LOC__, ["10"], calls(t)) + }) + + testAsync("a closure created next to an @int argument does not keep it alive", async () => { + setV8Flags("--expose-gc") + let gc = runInNewContext("gc") + let t = makeTarget() + let (levels, keep) = keepClosure(t) + // A WeakRef keeps its target until the end of the current task + await nextTask() + gc() + ok(__LOC__, levels->deref == None) + ok(__LOC__, keep() === t) + eq(__LOC__, ["10"], calls(t)) }) test("the arguments around @string and @int arguments run in order", () => { @@ -316,7 +350,7 @@ describe(__MODULE__, () => { await mark("level", Promise.resolve(opaque(#low))), mark("fourth", "d"), ) - // Raw JS code may await + // Raw JS code that awaits is evaluated in its place as well setLevel(t, %raw(`await Promise.resolve("high")`)) eq(__LOC__, ["first", "mode", "second", "third", "level", "fourth"], log) eq(__LOC__, ["a dark-mode b", "c 0 d", "10"], calls(t)) From f9f501b97ea4ea4cf7770c5a0707fb192e401cfe Mon Sep 17 00:00:00 2001 From: mununki Date: Tue, 10 Nov 2026 00:38:36 +0900 Subject: [PATCH 5/6] Evaluate the effects of unit and @ignore arguments of externals in their place MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Why: An external leaves a `unit` or `@ignore` argument out of the JS call, and `translate_ffi` and `assemble_obj_args` evaluated the effects of one before the whole call or object. So `setX(t, f(), g())` called `g()` before `f()`, with 11.1 and 12.3 and with every kind of external. The temporaries of #9217 hid it only after a polymorphic variant argument with side effects, and the previous commits brought it back there (regressions 2 and 5 in the review of #9231). `hold_arg` now makes the effects a statement of the argument, so `sequence_arguments` evaluates the arguments to its left first, binding only those that the statement could change, as it does for any argument with statements. Nothing is hoisted any more, so the effect lists of `ocaml_to_js_eff`, `assemble_args_*` and `assemble_obj_args` go, with `add_eff` and `Js_exp_make.fuse_to_seq`, which had no other use, and `ocaml_to_js_eff` becomes `ocaml_to_js`. JS modified (unit argument): Example: type t @send external setX: (t, int, unit) => unit = "setX" let update = (t, f, g) => setX(t, f(), g()) Before (js): function update(t, f, g) { g(); t.setX(f()); } After (js): function update(t, f, g) { let tmp = f(); g(); t.setX(tmp); } JS modified (unit argument in a while condition): Example: type t @send external ready: (t, unit) => bool = "ready" let wait = (t, g) => while ready(t, g()) { () } Before (js): function wait(t, g) { while (g(), t.ready()) { }; } After (js): function wait(t, g) { while (true) { g(); if (!t.ready()) { break; } }; } JS modified (optional @ignore argument): Example: type t @send external push: (t, int, ~extra: @ignore int=?, unit) => unit = "push" let add = (t, g) => push(t, 1, ~extra=?g(), ()) Before (js): function add(t, g) { Primitive_option.valFromOption(g()); t.push(1); } After (js): function add(t, g) { g(); t.push(1); } JS modified (external whose arguments are all @ignore): Example: @val external count: (@ignore int, @ignore int) => int = "count" @module external path: @ignore int => {..} = "node:path" let counted = (f, g) => count(f(), g()) let loaded = g => path(g()) Before (js): function counted(f, g) { return count(f(), g()); } function loaded(g) { return Nodepath; } After (js): function counted(f, g) { f(); g(); return count(); } function loaded(g) { g(); return Nodepath; } JS modified (where the effects of a unit or @ignore argument run): Before (representation): Lam_compile_external_call.ocaml_to_js_eff setX(t, f(), g()), the unit argument g() ↦ before the whole call makeThen(~a=f(), g()), the unit argument g() ↦ before the object push(t, 1, ~extra=?g(), ()) ↦ valFromOption(g()), before the call count(f(), g()) ↦ passed to count path(g()) ↦ dropped After (representation): Lam_compile_external_call.hold_arg setX(t, f(), g()), the unit argument g() ↦ statement in its place makeThen(~a=f(), g()), the unit argument g() ↦ statement in its place push(t, 1, ~extra=?g(), ()) ↦ g(), statement in its place count(f(), g()) ↦ statements in their place, not passed path(g()) ↦ statement in its place Tests: `bs_ignore_effect_test.res` checks the order of `unit` and `@ignore` arguments after others, with `@send` and `@obj` externals, a `unit` argument that changes an earlier one, an absent optional `@ignore` argument, and externals whose arguments are all `@ignore`. `polyvar_external_arg_test.res` checks the order after `@string` and `@int` arguments, labelled, optional and in an `@obj` literal, whose optional field known to be present stays in the literal, and a `unit` argument that changes an event-style `@val` global before it is read. Compiled with #9217 or the previous commit, these tests fail. `bs_ignore_effect_test.res` also checks that a `@send` external whose object is marked `@ignore` still calls the method on that object. Review: Why does some output get bigger? A `unit` argument with side effects now has a statement. A while condition with statements becomes a loop that breaks, and a call with one, as an element of an array or an argument of another call, evaluates the elements or arguments to its left first, binding those with side effects: `[ready(t, g()), ready(t, h())]` compiles to `g(); let tmp = t.ready(); h(); return [tmp, t.ready()];` instead of `[(g(), t.ready()), (h(), t.ready())]`. Hoisting the effects as before is right only when every argument to their left can be read after them, which would keep the effect lists that this commit removes; the old order was wrong whenever that did not hold. Outside the new tests, three such sequences in checked-in outputs become statements, two in `bs_ignore_effect_test.mjs` and one in `optional_external_arg_once_test.mjs` of #9283. Review: Why does `hold_args` take the declaration of the external? `translate_ffi` calls the method of a `@send` external on its first argument whatever that argument's spec says, and the frontend accepts `@ignore` there, as in a `@send` external `push` of type `(@ignore array, int) => int`. So `hold_args` leaves that argument as it is, where it would replace an `@ignore` one with `undefined`, and `push(arr, 1)` still compiles to `arr.push(1)`. Review: Why are the arguments of an external whose arguments are all `@ignore` no longer passed? Every other external leaves `@ignore` arguments out. `translate_ffi` took such an external for a JS value and called it with the arguments it got, which `hold_arg` now replaces with `undefined`. A JS value whose type is a function type it does not spell out, such as `@val external v: u = "v"` with `type u = (int, int) => int`, has no argument specs and still gets its arguments, as `ExternalArity.res` checks. A `@module` external of the module itself still is the module, but it no longer drops the effects of its arguments. Review: What about an optional `@ignore` argument? Only its payload is evaluated, for its effects, so it no longer goes through `Primitive_option.valFromOption`, whose result was dropped. One without side effects, such as a variable, a field or a `@get` property, is not read at all, where it was tested for `None` and unwrapped, or given to `valFromOption`. Signed-off-by: mununki --- ...rnal-unit-argument-effects-in-place.fix.md | 3 + compiler/core/js_exp_make.ml | 2 - compiler/core/js_exp_make.mli | 2 - compiler/core/lam_compile.ml | 4 +- compiler/core/lam_compile_external_call.ml | 256 +++++++----------- compiler/core/lam_compile_external_call.mli | 22 +- compiler/core/lam_compile_external_obj.ml | 94 +++---- tests/tests/src/bs_ignore_effect_test.mjs | 125 ++++++++- tests/tests/src/bs_ignore_effect_test.res | 83 ++++++ .../src/optional_external_arg_once_test.mjs | 3 +- tests/tests/src/polyvar_external_arg_test.mjs | 205 +++++++++++--- tests/tests/src/polyvar_external_arg_test.res | 80 ++++++ 12 files changed, 607 insertions(+), 272 deletions(-) create mode 100644 changes/external-unit-argument-effects-in-place.fix.md diff --git a/changes/external-unit-argument-effects-in-place.fix.md b/changes/external-unit-argument-effects-in-place.fix.md new file mode 100644 index 00000000000..6c6f7fbe4f9 --- /dev/null +++ b/changes/external-unit-argument-effects-in-place.fix.md @@ -0,0 +1,3 @@ +- Evaluate a `unit` or `@ignore` argument of an external in source order, as in `setX(t, f(), g())`. +- Call an external whose arguments are all `@ignore` without them, like other externals. +- Keep the effects of the `@ignore` arguments of a `@module` external that is the module itself. diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index 14e65935c0b..84d4e6c256a 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -406,8 +406,6 @@ let rec seq ?comment (e0 : t) (e1 : t) : t = | (Number _ | Var _ | Undefined _), _ -> e1 | _ -> {expression_desc = Seq (e0, e1); comment; source_loc = None} -let fuse_to_seq x xs = if xs = [] then x else Ext_list.fold_left xs x seq - let zero_int_literal : t = { expression_desc = Number (Int {i = 0l; c = None}); diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli index 2817d6c764b..5994f2a6488 100644 --- a/compiler/core/js_exp_make.mli +++ b/compiler/core/js_exp_make.mli @@ -269,8 +269,6 @@ val make_block : val seq : ?comment:string -> t -> t -> t -val fuse_to_seq : t -> t list -> t - val object_entries : ?dup:J.expression -> J.property_map -> J.object_entry list val obj : ?dup:J.expression -> J.property_map -> t diff --git a/compiler/core/lam_compile.ml b/compiler/core/lam_compile.ml index c0859e2184e..a6b8a517516 100644 --- a/compiler/core/lam_compile.ml +++ b/compiler/core/lam_compile.ml @@ -1942,9 +1942,9 @@ let compile output_prefix = Js_output.output_of_block_and_expression lambda_cxt.continuation (Ext_list.append args_code block) exp - | {primitive = Pjs_call {arg_types} as primitive; args; loc} -> + | {primitive = Pjs_call {arg_types; ffi} as primitive; args; loc} -> compile_primitive_default - ~hold:(Lam_compile_external_call.hold_args arg_types) + ~hold:(Lam_compile_external_call.hold_args ffi arg_types) primitive args loc | {primitive; args; loc} -> compile_primitive_default primitive args loc and collect_dup_overrides (copy_id : Ident.t) (lam : Lambda.t) diff --git a/compiler/core/lam_compile_external_call.ml b/compiler/core/lam_compile_external_call.ml index 321cd457e50..4e6d02c0857 100644 --- a/compiler/core/lam_compile_external_call.ml +++ b/compiler/core/lam_compile_external_call.ml @@ -47,31 +47,14 @@ let append_list x xs = | Splice1 a -> a :: xs | Splice2 (a, b) -> a :: b :: xs -(* The first return value is value, the second argument is side effect expressions - Only the [unit] with no label will be ignored - When we are passing a boxed value to external(optional), we need - unbox it in the first place. - - Note when optional value is not passed, the unboxed value would be - [undefined], with the combination of `[@int]` it would be still be - [undefined], this by default is still correct.. - {[ - (function () { - switch (undefined) { - case 97 : - return "a"; - case 98 : - return "b"; - - } - }()) === undefined - ]} - - This would not work with [NonNullString] -*) -let ocaml_to_js_eff ~(arg_label : External_arg_spec.label_noname) - ~(arg_type : External_arg_spec.attr) (raw_arg : E.t) : - arg_expression * E.t list = +(* The JS arguments that a compiled argument of an external is passed as. A + [unit] argument, which has no label, and an [@ignore] argument are left + out: [hold_arg] has already made their effects a statement of the + argument. An optional argument is passed as its payload, or [undefined] + when it is absent, which an [@int] or [@as] dispatch passes on as + [undefined]. *) +let ocaml_to_js ~(arg_label : External_arg_spec.label_noname) + ~(arg_type : External_arg_spec.attr) (raw_arg : E.t) : arg_expression = let arg = match arg_label with | Arg_optional -> @@ -81,21 +64,15 @@ let ocaml_to_js_eff ~(arg_label : External_arg_spec.label_noname) match arg_type with | Arg_cst _ -> assert false (* has to be preprocessed by {!Lambda} first *) - | Extern_unit -> - ( (if arg_label = Arg_empty then Splice0 else Splice1 E.unit), - if Js_analyzer.no_side_effect_expression arg then [] else [arg] ) - (* leave up later to decide *) - | Ignore -> - (Splice0, if Js_analyzer.no_side_effect_expression arg then [] else [arg]) - | Poly_var_string {descr} -> (Splice1 (Js_of_lam_variant.eval arg descr), []) - | Poly_var {descr} -> (Js_of_lam_variant.eval_as_event arg descr, []) + | Extern_unit | Ignore -> Splice0 + | Poly_var_string {descr} -> Splice1 (Js_of_lam_variant.eval arg descr) + | Poly_var {descr} -> Js_of_lam_variant.eval_as_event arg descr (* FIXME: encode invariant below in the signature*) (* length of 2 - the poly var tag - the value *) - | Int dispatches -> - (Splice1 (Js_of_lam_variant.eval_as_int arg dispatches), []) + | Int dispatches -> Splice1 (Js_of_lam_variant.eval_as_int arg dispatches) | Unwrap -> let single_arg = match arg_label with @@ -112,15 +89,23 @@ let ocaml_to_js_eff ~(arg_label : External_arg_spec.label_noname) Js_of_lam_option.option_unwrap raw_arg | _ -> Js_of_lam_variant.eval_as_unwrap raw_arg in - (Splice1 single_arg, []) - | Nothing -> (Splice1 arg, []) + Splice1 single_arg + | Nothing -> Splice1 arg + +(* Prepares a compiled argument, with the statements that run before its value + is read, for [ocaml_to_js], so that it is evaluated once and in its place + among the arguments (see [sequence_arguments] in [Lam_compile]). -(* The translation of an event-style polymorphic variant argument other than - a literal reads it twice, as [e.NAME] and [e.VAL]. So unless reading it - twice is the same as reading it once, the argument is bound to a temporary - after its statements, which keeps it in its place among the arguments (see - [sequence_arguments] in [Lam_compile]). An [@int] or [@as] argument is - passed, in its place, to a function that switches on it. *) + - The translation of an event-style polymorphic variant argument other + than a literal reads it twice, as [e.NAME] and [e.VAL]. So unless + reading it twice is the same as reading it once, the argument is bound + to a temporary after its statements. + - An [@int] or [@as] argument is passed, in its place, to a function that + switches on it. + - A [unit] or [@ignore] argument is not passed, so its effects become a + statement of the argument, and its value [undefined]. Of an optional + one, only the payload is evaluated, since its presence does not + matter. *) let hold_arg ~(arg_type : External_arg_spec.attr) ((block, arg) as compiled : J.block * E.t) : J.block * E.t = match arg_type with @@ -128,16 +113,26 @@ let hold_arg ~(arg_type : External_arg_spec.attr) let tmp = Ext_ident.create_tmp () in ( Ext_list.append_one block (S.define_variable ~kind:Strict tmp arg), E.var tmp ) - | Poly_var _ | Poly_var_string _ | Int _ | Arg_cst _ | Extern_unit | Nothing - | Ignore | Unwrap -> + | Extern_unit | Ignore -> + let effects = + match arg.expression_desc with + | Optional_block (x, _) -> x + | _ -> arg + in + ( (if Js_analyzer.no_side_effect_expression effects then block + else Ext_list.append_one block (S.exp effects)), + E.unit ) + | Poly_var _ | Poly_var_string _ | Int _ | Arg_cst _ | Nothing | Unwrap -> compiled (* [hold_arg] for the compiled arguments of a call, which have the statements that run before their values are read. The specs pair with the arguments as in [assemble_args_no_splice], and no spec translates an - argument past them. *) -let hold_args (arg_types : External_arg_spec.params) - (args : (J.block * E.t) list) = + argument past them. The object of a [@send] call is left as it is, since + [translate_ffi] calls the method on it whatever its spec, such as + [@ignore], says. *) +let hold_args (decl : External_ffi_types.external_decl) + (arg_types : External_arg_spec.params) (args : (J.block * E.t) list) = let rec aux (arg_types : External_arg_spec.params) args = match (arg_types, args) with | {arg_type = Arg_cst _; _} :: arg_types, args -> aux arg_types args @@ -146,14 +141,14 @@ let hold_args (arg_types : External_arg_spec.params) | [], args -> args | _ :: _, [] -> assert false in - aux arg_types args - -let empty_pair = ([], []) - -let add_eff eff e = - match eff with - | None -> e - | Some v -> E.seq v e + match decl.kind with + | Decl_send _ -> ( + match (arg_types, args) with + | _self_type :: arg_types, self :: args -> self :: aux arg_types args + | [], _ | _, [] -> assert false) + | Decl_val _ | Decl_new _ | Decl_get _ | Decl_set _ | Decl_get_index + | Decl_set_index -> + aux arg_types args type specs = External_arg_spec.params @@ -185,62 +180,42 @@ let keep_non_undefined_args (arg_types : specs) (args : exprs) = otherwise, we should provide a good error message here, no compiler failure here Invariant : Array encoding - @return arguments and effect *) -let assemble_args_no_splice (arg_types : specs) (args : exprs) : - exprs * E.t option = - let rec aux (labels : specs) (args : exprs) : exprs * exprs = +let assemble_args_no_splice (arg_types : specs) (args : exprs) : exprs = + let rec aux (labels : specs) (args : exprs) : exprs = match (labels, args) with | [], _ -> assert (args = []); - empty_pair + [] | {arg_type = Arg_cst cst; _} :: labels, args -> (* can not be Optional *) - let accs, eff = aux labels args in - (Lam_compile_const.translate_arg_cst cst :: accs, eff) + Lam_compile_const.translate_arg_cst cst :: aux labels args | {arg_label; arg_type} :: labels, arg :: args -> - let accs, eff = aux labels args in - let acc, new_eff = ocaml_to_js_eff ~arg_label ~arg_type arg in - (append_list acc accs, Ext_list.append new_eff eff) + append_list (ocaml_to_js ~arg_label ~arg_type arg) (aux labels args) | _ :: _, [] -> assert false in - let args, eff = aux arg_types args in - ( keep_non_undefined_args arg_types args, - match eff with - | [] -> None - | x :: xs -> - (* FIXME: the order of effects? *) - Some (E.fuse_to_seq x xs) ) + keep_non_undefined_args arg_types (aux arg_types args) -let assemble_args_has_splice (arg_types : specs) (args : exprs) : - exprs * E.t option * bool = +let assemble_args_has_splice (arg_types : specs) (args : exprs) : exprs * bool = let dynamic = ref false in - let rec aux (labels : specs) (args : exprs) = + let rec aux (labels : specs) (args : exprs) : exprs = match (labels, args) with | [], _ -> assert (args = []); - empty_pair + [] | {arg_type = Arg_cst cst; _} :: labels, args -> - let accs, eff = aux labels args in - (Lam_compile_const.translate_arg_cst cst :: accs, eff) + Lam_compile_const.translate_arg_cst cst :: aux labels args | {arg_label; arg_type} :: labels, arg :: args -> ( - let accs, eff = aux labels args in + let accs = aux labels args in match (args, (arg : E.t)) with - | [], {expression_desc = Array ls; _} -> (Ext_list.append ls accs, eff) + | [], {expression_desc = Array ls; _} -> Ext_list.append ls accs | _ -> if args = [] then dynamic := true; - let acc, new_eff = ocaml_to_js_eff ~arg_type ~arg_label arg in - (append_list acc accs, Ext_list.append new_eff eff)) + append_list (ocaml_to_js ~arg_type ~arg_label arg) accs) | _ :: _, [] -> assert false in - let args, eff = aux arg_types args in - ( args, - (match eff with - | [] -> None - | x :: xs -> - (* FIXME: the order of effects? *) - Some (E.fuse_to_seq x xs)), - !dynamic ) + let args = aux arg_types args in + (args, !dynamic) let translate_scoped_module_val (module_name : External_ffi_types.external_module_name option) (fn : string) @@ -313,6 +288,13 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types ~(prim_name : string) | Some (Module_named emn) -> Some emn | Some Module_itself | None -> None in + (* the JS arguments of a call, spread when [@variadic] needs it *) + let assemble_args arg_types args = + if splice then + let args, dynamic = assemble_args_has_splice arg_types args in + if dynamic then E.variadic_args args else args + else assemble_args_no_splice arg_types args + in let mark_new_object () = (* handle [@@new]: mark the bound identifier (if any) as an object; order matters, since the property affects later code generation *) @@ -327,53 +309,37 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types ~(prim_name : string) | Decl_val _, Some Module_itself -> (* the module itself, called as a function *) let fn = external_var (module_itself_name ()) in - if splice then - let args, eff, dynamic = assemble_args_has_splice arg_types args in - let args = if dynamic then E.variadic_args args else args in - add_eff eff (E.call ~info:Js_call_info.na_full_call fn args) - else - let args, eff = assemble_args_no_splice arg_types args in - (* TODO: fix in rest calling convention *) - add_eff eff (E.call ~info:Js_call_info.na_full_call fn args) + E.call ~info:Js_call_info.na_full_call fn (assemble_args arg_types args) | Decl_new _, Some Module_itself -> (* the module itself, as a class *) let fn = external_var (module_itself_name ()) in - let args, eff = assemble_args_no_splice arg_types args in + let args = assemble_args_no_splice arg_types args in (* TODO: fix in rest calling convention *) - add_eff eff - (mark_new_object (); - E.new_ fn args) + mark_new_object (); + E.new_ fn args | ( (Decl_send _ | Decl_get _ | Decl_set _ | Decl_get_index | Decl_set_index), Some Module_itself ) -> assert false (* rejected during digestion *) - | Decl_val {name}, _ when decl.effective_arity = 0 -> - (* a global value *) + | Decl_val {name}, _ when decl.effective_arity = 0 -> ( + (* a global value. A call applies it to the arguments of a function type + that the external does not spell out, or to the [@ignore] arguments + of one that it does, which are not passed. *) let e = translate_scoped_module_val named_module name scopes in - if args = [] then e else E.call ~info:Js_call_info.na_full_call e args + match (arg_types, args) with + | _, [] -> e + | [], _ -> E.call ~info:Js_call_info.na_full_call e args + | _ :: _, _ -> + E.call ~info:Js_call_info.na_full_call e + (assemble_args_no_splice arg_types args)) | Decl_val {name = fn}, _ -> (* a global (possibly module-scoped) function call *) let fn = translate_scoped_module_val named_module fn scopes in - if splice then - let args, eff, dynamic = assemble_args_has_splice arg_types args in - let args = if dynamic then E.variadic_args args else args in - add_eff eff (E.call ~info:Js_call_info.na_full_call fn args) - else - let args, eff = assemble_args_no_splice arg_types args in - add_eff eff @@ E.call ~info:Js_call_info.na_full_call fn args + E.call ~info:Js_call_info.na_full_call fn (assemble_args arg_types args) | Decl_new {name = fn}, _ -> - if splice then - let args, eff, dynamic = assemble_args_has_splice arg_types args in - let args = if dynamic then E.variadic_args args else args in - let fn = translate_scoped_module_val named_module fn scopes in - add_eff eff - (mark_new_object (); - E.new_ fn args) - else - let args, eff = assemble_args_no_splice arg_types args in - let fn = translate_scoped_module_val named_module fn scopes in - add_eff eff - (mark_new_object (); - E.new_ fn args) + let args = assemble_args arg_types args in + let fn = translate_scoped_module_val named_module fn scopes in + mark_new_object (); + E.new_ fn args | Decl_send {name}, _ -> ( match args with | self :: args -> @@ -384,23 +350,12 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types ~(prim_name : string) | _self_type :: arg_types -> arg_types | [] -> assert false in - if splice then - let args, eff, dynamic = assemble_args_has_splice arg_types args in - let args = if dynamic then E.variadic_args args else args in - add_eff eff - (let self = translate_scoped_access scopes self in - E.call ~info:Js_call_info.na_full_call (E.dot self name) args) - else - let args, eff = assemble_args_no_splice arg_types args in - add_eff eff - (let self = translate_scoped_access scopes self in - E.call ~info:Js_call_info.na_full_call (E.dot self name) args) + let args = assemble_args arg_types args in + let self = translate_scoped_access scopes self in + E.call ~info:Js_call_info.na_full_call (E.dot self name) args | _ -> assert false) | Decl_get {name}, _ -> ( - let args, cur_eff = assemble_args_no_splice arg_types args in - add_eff cur_eff - @@ - match args with + match assemble_args_no_splice arg_types args with | [obj] -> let obj = translate_scoped_access scopes obj in E.dot obj name @@ -409,29 +364,20 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types ~(prim_name : string) invalid_arg "Internal compiler error: @get external called with wrong number of \ arguments. Expected exactly one object argument." - (* Note these assertion happens in call site *)) + (* Note these assertion happens in call site *)) | Decl_set {name}, _ -> ( - let args, cur_eff = assemble_args_no_splice arg_types args in - add_eff cur_eff - @@ - match (args, arg_types) with - | [obj; v], _ -> + match assemble_args_no_splice arg_types args with + | [obj; v] -> let obj = translate_scoped_access scopes obj in E.assign (E.dot obj name) v | _ -> assert false) | Decl_get_index, _ -> ( - let args, cur_eff = assemble_args_no_splice arg_types args in - add_eff cur_eff - @@ - match args with + match assemble_args_no_splice arg_types args with | [obj; v] -> Js_of_lam_array.ref_array (translate_scoped_access scopes obj) v | _ -> assert false) | Decl_set_index, _ -> ( - let args, cur_eff = assemble_args_no_splice arg_types args in - add_eff cur_eff - @@ - match args with + match assemble_args_no_splice arg_types args with | [obj; v; value] -> Js_of_lam_array.set_array (translate_scoped_access scopes obj) v value | _ -> assert false) diff --git a/compiler/core/lam_compile_external_call.mli b/compiler/core/lam_compile_external_call.mli index 4ce4b7cc2fe..e893272720b 100644 --- a/compiler/core/lam_compile_external_call.mli +++ b/compiler/core/lam_compile_external_call.mli @@ -22,27 +22,33 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val ocaml_to_js_eff : +val ocaml_to_js : arg_label:External_arg_spec.label_noname -> arg_type:External_arg_spec.attr -> J.expression -> - Js_of_lam_variant.arg_expression * J.expression list -(** Compile ocaml external function call to JS IR. *) + Js_of_lam_variant.arg_expression +(** The JS arguments that an argument of an external, prepared by + [hold_arg], is passed as *) val hold_arg : arg_type:External_arg_spec.attr -> J.block * J.expression -> J.block * J.expression -(** Binds a compiled argument, after its statements, to a temporary when - [ocaml_to_js_eff] would otherwise read it twice: an event-style - polymorphic variant argument, unless reading it twice is the same as - reading it once *) +(** Prepares a compiled argument and its statements for [ocaml_to_js], so + that it is evaluated once and in its place among the arguments. An + event-style polymorphic variant argument, which [ocaml_to_js] reads + twice, is bound to a temporary after the statements unless reading it + twice is the same as reading it once. The effects of a [unit] or + [@ignore] argument, which [ocaml_to_js] leaves out, become a statement + of the argument. *) val hold_args : + External_ffi_types.external_decl -> External_arg_spec.params -> (J.block * J.expression) list -> (J.block * J.expression) list -(** [hold_arg] for the compiled arguments of a call to an external *) +(** [hold_arg] for the compiled arguments of a call to an external, but for + the object of a [@send] call, which [translate_ffi] uses as it is *) val translate_ffi : Lam_compile_context.t -> diff --git a/compiler/core/lam_compile_external_obj.ml b/compiler/core/lam_compile_external_obj.ml index de5993cbc5d..b7bff47d0ee 100644 --- a/compiler/core/lam_compile_external_obj.ml +++ b/compiler/core/lam_compile_external_obj.ml @@ -75,9 +75,8 @@ let rec hold_obj_args ~(delay_safe : J.expression -> bool) match (labels, args) with | {obj_arg_label = Obj_label _; obj_arg_type = Arg_cst _} :: labels, args -> hold_obj_args ~delay_safe labels args - | {obj_arg_label = Obj_empty} :: labels, arg :: args -> - arg :: hold_obj_args ~delay_safe labels args - | {obj_arg_label = Obj_label _; obj_arg_type} :: labels, arg :: args -> + | ( {obj_arg_label = Obj_empty | Obj_label _; obj_arg_type} :: labels, + arg :: args ) -> Lam_compile_external_call.hold_arg ~arg_type:obj_arg_type arg :: hold_obj_args ~delay_safe labels args | {obj_arg_label = Obj_optional _; obj_arg_type} :: labels, arg :: args -> @@ -107,67 +106,54 @@ let rec hold_obj_args ~(delay_safe : J.expression -> bool) let assemble_obj_args (labels : External_arg_spec.obj_params) (args : J.expression list) : J.block * J.expression = let rec aux (labels : External_arg_spec.obj_params) args : - (Js_op.property_name * E.t) list * J.expression list * _ = + (Js_op.property_name * E.t) list * _ = match (labels, args) with - | [], [] -> ([], [], []) + | [], [] -> ([], []) | ( {obj_arg_label = Obj_label {name = label}; obj_arg_type = Arg_cst cst} :: labels, args ) -> - let accs, eff, assign = aux labels args in + let accs, assign = aux labels args in ( (Js_op.Lit label, Lam_compile_const.translate_arg_cst cst) :: accs, - eff, assign ) (* | {obj_arg_label = EmptyCst _ } :: rest , args -> assert false *) - | {obj_arg_label = Obj_empty} :: labels, arg :: args -> - (* unit type*) - let ((accs, eff, assign) as r) = aux labels args in - if Js_analyzer.no_side_effect_expression arg then r - else (accs, arg :: eff, assign) + | {obj_arg_label = Obj_empty} :: labels, _ :: args -> + (* a [unit] or [@ignore] argument, whose effects [hold_obj_args] made a + statement *) + aux labels args | ( ({obj_arg_label = Obj_label {name = label}} as arg_kind) :: labels, arg :: args ) -> ( - let accs, eff, assign = aux labels args in - let acc, new_eff = - Lam_compile_external_call.ocaml_to_js_eff ~arg_label:Arg_label + let accs, assign = aux labels args in + match + Lam_compile_external_call.ocaml_to_js ~arg_label:Arg_label ~arg_type:arg_kind.obj_arg_type arg - in - match acc with + with | Splice2 _ | Splice0 -> assert false - | Splice1 x -> - ((Js_op.Lit label, x) :: accs, Ext_list.append new_eff eff, assign) + | Splice1 x -> ((Js_op.Lit label, x) :: accs, assign) (* evaluation order is undefined *)) | ( ({obj_arg_label = Obj_optional {name = label}; obj_arg_type} as arg_kind) :: labels, arg :: args ) -> - let ((accs, eff, assign) as r) = aux labels args in + let ((accs, assign) as r) = aux labels args in Js_of_lam_option.destruct_optional arg ~for_sure_none:r ~for_sure_some:(fun x -> - let acc, new_eff = - Lam_compile_external_call.ocaml_to_js_eff ~arg_label:Arg_label + match + Lam_compile_external_call.ocaml_to_js ~arg_label:Arg_label ~arg_type:obj_arg_type x - in - match acc with + with | Splice2 _ | Splice0 -> assert false - | Splice1 x -> - ((Js_op.Lit label, x) :: accs, Ext_list.append new_eff eff, assign)) - ~not_sure:(fun _ -> (accs, eff, (arg_kind, arg) :: assign)) + | Splice1 x -> ((Js_op.Lit label, x) :: accs, assign)) + ~not_sure:(fun _ -> (accs, (arg_kind, arg) :: assign)) | {obj_arg_label = Obj_empty | Obj_label _ | Obj_optional _} :: _, [] -> assert false | [], _ :: _ -> assert false in - let map, eff, assignment = aux labels args in + let map, assignment = aux labels args in match assignment with - | [] -> - ( [], - match eff with - | [] -> E.obj map - | x :: xs -> E.seq (E.fuse_to_seq x xs) (E.obj map) ) + | [] -> ([], E.obj map) | _ -> let v = Ext_ident.create_tmp () in let var_v = E.var v in - ( S.define_variable ~kind:Variable v - (match eff with - | [] -> E.obj map - | x :: xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)) + ( S.define_variable ~kind:Variable v (E.obj map) :: Ext_list.flat_map assignment (fun ((xlabel : External_arg_spec.obj_param), (arg : J.expression)) -> @@ -181,48 +167,34 @@ let assemble_obj_args (labels : External_arg_spec.obj_params) same value twice *) match Js_ast_util.named_expression ~property_reads:false arg with | None -> ( - let acc, new_eff = - Lam_compile_external_call.ocaml_to_js_eff - ~arg_label:Arg_empty ~arg_type:xlabel.obj_arg_type + match + Lam_compile_external_call.ocaml_to_js ~arg_label:Arg_empty + ~arg_type:xlabel.obj_arg_type (if for_sure_no_nested_option then arg else Js_of_lam_option.val_from_option arg) - in - match acc with + with | Splice1 v -> [ S.if_ (Js_of_lam_option.is_not_none arg) - [ - S.exp - (E.assign (E.dot var_v label) - (match new_eff with - | [] -> v - | x :: xs -> E.seq (E.fuse_to_seq x xs) v)); - ]; + [S.exp (E.assign (E.dot var_v label) v)]; ] | Splice0 | Splice2 _ -> assert false) | Some (st, id) -> ( (* FIXME: see #2503 *) let arg = E.var id in - let acc, new_eff = - Lam_compile_external_call.ocaml_to_js_eff - ~arg_label:Arg_empty ~arg_type:xlabel.obj_arg_type + match + Lam_compile_external_call.ocaml_to_js ~arg_label:Arg_empty + ~arg_type:xlabel.obj_arg_type (if for_sure_no_nested_option then arg else Js_of_lam_option.val_from_option arg) - in - match acc with + with | Splice1 v -> [ st; S.if_ (Js_of_lam_option.is_not_none arg) - [ - S.exp - (E.assign (E.dot var_v label) - (match new_eff with - | [] -> v - | x :: xs -> E.seq (E.fuse_to_seq x xs) v)); - ]; + [S.exp (E.assign (E.dot var_v label) v)]; ] | Splice0 | Splice2 _ -> assert false)) | _ -> assert false), diff --git a/tests/tests/src/bs_ignore_effect_test.mjs b/tests/tests/src/bs_ignore_effect_test.mjs index a9ca8204ead..947f87ff90a 100644 --- a/tests/tests/src/bs_ignore_effect_test.mjs +++ b/tests/tests/src/bs_ignore_effect_test.mjs @@ -1,6 +1,7 @@ // Generated by ReScript, PLEASE EDIT WITH CARE import * as Mocha from "mocha"; +import * as Nodepath from "node:path"; import * as Test_utils from "./test_utils.mjs"; function add(x,y){ @@ -12,21 +13,137 @@ let v = { contents: 0 }; -let h = (v.contents = v.contents + 1 | 0, { +v.contents = v.contents + 1 | 0; + +let h = { hi: 2, lo: 0 +}; + +v.contents = v.contents + 1 | 0; + +let z = add(3.0, 2.0); + +let defineCountArgs = (() => { + globalThis.bsIgnoreEffectCountArgs = (...args) => args.length }); -let z = (v.contents = v.contents + 1 | 0, "Float", add(3.0, 2.0)); +let counter = { + contents: 0 +}; + +function bump() { + counter.contents = counter.contents + 1 | 0; +} Mocha.describe("Bs_ignore_effect_test", () => { - Mocha.test("ignore effect 1", () => Test_utils.eq("File \"bs_ignore_effect_test.res\", line 32, characters 35-42", v.contents, 2)); - Mocha.test("ignore effect 2", () => Test_utils.eq("File \"bs_ignore_effect_test.res\", line 33, characters 35-42", z, 5.0)); + Mocha.test("ignore effect 1", () => Test_utils.eq("File \"bs_ignore_effect_test.res\", line 54, characters 35-42", v.contents, 2)); + Mocha.test("ignore effect 2", () => Test_utils.eq("File \"bs_ignore_effect_test.res\", line 55, characters 35-42", z, 5.0)); + Mocha.test("unit and @ignore arguments after others", () => { + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let arr = []; + let tmp = mark("value", 1); + mark("unit", undefined); + arr.push(tmp); + let tmp$1 = mark("value", 2); + mark("ignored", 0); + arr.push(tmp$1); + let tmp$2 = mark("field", 3); + mark("unit", undefined); + let o = { + a: tmp$2 + }; + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 67, characters 7-14", [ + "value", + "unit", + "value", + "ignored", + "field", + "unit" + ], log); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 68, characters 7-14", [ + 1, + 2 + ], arr); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 69, characters 7-14", 3, o.a); + }); + Mocha.test("an optional @ignore argument that is absent", () => { + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let arr = []; + let tmp = mark("value", 1); + mark("absent", undefined); + arr.push(tmp); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 80, characters 7-14", [ + "value", + "absent" + ], log); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 81, characters 7-14", [1], arr); + }); + Mocha.test("a unit argument that changes an earlier argument", () => { + let arr = []; + let tmp = counter.contents; + bump(); + arr.push(tmp); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 87, characters 7-14", [0], arr); + }); + Mocha.test("the object of a @send call marked @ignore", () => { + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let arr = []; + arr.push(1); + mark("object", arr).push(2); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 99, characters 7-14", ["object"], log); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 100, characters 7-14", [ + 1, + 2 + ], arr); + }); + Mocha.test("an external whose arguments are all @ignore", () => { + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + defineCountArgs(); + let pure = bsIgnoreEffectCountArgs(); + mark("first", 1); + mark("second", 2); + let effectful = bsIgnoreEffectCountArgs(); + mark("module", 0); + let path = Nodepath; + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 113, characters 7-14", [ + 0, + 0 + ], [ + pure, + effectful + ]); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 114, characters 7-14", [ + "first", + "second", + "module" + ], log); + Test_utils.eq("File \"bs_ignore_effect_test.res\", line 115, characters 7-14", true, path.sep === "/" || path.sep === "\\"); + }); }); export { v, h, z, + defineCountArgs, + counter, + bump, } /* Not a pure module */ diff --git a/tests/tests/src/bs_ignore_effect_test.res b/tests/tests/src/bs_ignore_effect_test.res index c0e2e91f02b..736fba1ace2 100644 --- a/tests/tests/src/bs_ignore_effect_test.res +++ b/tests/tests/src/bs_ignore_effect_test.res @@ -28,7 +28,90 @@ let z = add( 2.0, ) +// The effects of a unit or @ignore argument run in its place among the +// arguments, after the arguments to its left. +@send external pushThen: (array, int, unit) => int = "push" +@send external pushIgnoring: (array, int, @ignore int) => int = "push" +@send external pushIgnoringOpt: (array, int, ~extra: @ignore int=?, unit) => int = "push" +@obj external makeThen: (~a: int, unit) => {"a": int} = "" + +// The object of a @send call is the object whatever its spec says. +@send external pushOnIgnored: (@ignore array, int) => int = "push" + +// An external whose arguments are all @ignore is called without them, or is +// a value when it is a JS module. +@val external countArgs: (@ignore int, @ignore int) => int = "bsIgnoreEffectCountArgs" +@module external pathModule: @ignore int => {"sep": string} = "node:path" + +let defineCountArgs: unit => unit = %raw(`() => { + globalThis.bsIgnoreEffectCountArgs = (...args) => args.length +}`) + +let counter = ref(0) +let bump = () => counter := counter.contents + 1 + describe(__MODULE__, () => { test("ignore effect 1", () => eq(__LOC__, v.contents, 2)) test("ignore effect 2", () => eq(__LOC__, z, 5.0)) + + test("unit and @ignore arguments after others", () => { + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + let arr = [] + arr->pushThen(mark("value", 1), mark("unit", ()))->ignore + arr->pushIgnoring(mark("value", 2), mark("ignored", 0))->ignore + let o = makeThen(~a=mark("field", 3), mark("unit", ())) + eq(__LOC__, ["value", "unit", "value", "ignored", "field", "unit"], log) + eq(__LOC__, [1, 2], arr) + eq(__LOC__, 3, o["a"]) + }) + + test("an optional @ignore argument that is absent", () => { + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + let arr = [] + arr->pushIgnoringOpt(mark("value", 1), ~extra=?mark("absent", None), ())->ignore + eq(__LOC__, ["value", "absent"], log) + eq(__LOC__, [1], arr) + }) + + test("a unit argument that changes an earlier argument", () => { + let arr = [] + arr->pushThen(counter.contents, bump())->ignore + eq(__LOC__, [0], arr) + }) + + test("the object of a @send call marked @ignore", () => { + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + let arr = [] + arr->pushOnIgnored(1)->ignore + mark("object", arr)->pushOnIgnored(2)->ignore + eq(__LOC__, ["object"], log) + eq(__LOC__, [1, 2], arr) + }) + + test("an external whose arguments are all @ignore", () => { + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + defineCountArgs() + let pure = countArgs(1, 2) + let effectful = countArgs(mark("first", 1), mark("second", 2)) + let path = pathModule(mark("module", 0)) + eq(__LOC__, (0, 0), (pure, effectful)) + eq(__LOC__, ["first", "second", "module"], log) + eq(__LOC__, true, path["sep"] == "/" || path["sep"] == "\\") + }) }) diff --git a/tests/tests/src/optional_external_arg_once_test.mjs b/tests/tests/src/optional_external_arg_once_test.mjs index 783ebe0347e..1085effc195 100644 --- a/tests/tests/src/optional_external_arg_once_test.mjs +++ b/tests/tests/src/optional_external_arg_once_test.mjs @@ -197,7 +197,8 @@ Mocha.describe("Optional_external_arg_once_test", () => { return v; }; let tmp = mark("size", 2); - let tmp$1 = (mark("unit", undefined), {}); + mark("unit", undefined); + let tmp$1 = {}; if (tmp !== undefined) { tmp$1.size = tmp; } diff --git a/tests/tests/src/polyvar_external_arg_test.mjs b/tests/tests/src/polyvar_external_arg_test.mjs index a4641c1846b..53db1c8e08a 100644 --- a/tests/tests/src/polyvar_external_arg_test.mjs +++ b/tests/tests/src/polyvar_external_arg_test.mjs @@ -41,6 +41,10 @@ let defineGlobalEvent = (() => { return () => reads }); +let setCurrentEvent = (e => { + globalThis.polyvarExternalArgCurrentEvent = e +}); + let opaque = (x => x); function click(x) { @@ -118,11 +122,11 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(tmp$1.NAME), tmp$1.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 167, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 198, characters 7-14", [ "event", "dispatch" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 168, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 199, characters 7-14", [ "keydown keydown 1", "click! click 1" ], t.calls); @@ -135,8 +139,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { return v; }; t.on("click", mark("payload", click)); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 179, characters 7-14", ["payload"], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 180, characters 7-14", ["click click 1"], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 210, characters 7-14", ["payload"], log); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 211, characters 7-14", ["click click 1"], t.calls); }); Mocha.test("@string and @int arguments with side effects", () => { let t = makeTarget(); @@ -169,12 +173,12 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })(Primitive_option.valFromOption(mark("optional", opaque("low"))))); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 193, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 224, characters 7-14", [ "mode", "level", "optional" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 194, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 225, characters 7-14", [ "dark-mode", "10", "0" @@ -247,7 +251,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { })(tmp$2); } let noMode = tmp$3; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 216, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 247, characters 7-14", [ "some", "none", "mode field", @@ -255,18 +259,18 @@ Mocha.describe("Polyvar_external_arg_test", () => { "no mode field", "low field" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 217, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 248, characters 7-14", [ "10", "undefined" ], t.calls); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 218, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 249, characters 7-14", [ 10, "dark-mode" ], [ options.level, options.mode ]); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 219, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 250, characters 7-14", [ 0, undefined ], [ @@ -289,8 +293,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })(defer(async () => await Promise.resolve(), opaque("high")))); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 231, characters 7-14", 1, pending.length); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 232, characters 7-14", ["10"], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 262, characters 7-14", 1, pending.length); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 263, characters 7-14", ["10"], t.calls); }); Mocha.test("a closure created next to an @int argument does not keep it alive", async () => { Nodev8.setFlagsFromString("--expose-gc"); @@ -299,9 +303,135 @@ Mocha.describe("Polyvar_external_arg_test", () => { let match = keepClosure(t); await nextTask(); gc(); - Test_utils.ok("File \"polyvar_external_arg_test.res\", line 243, characters 7-14", match[0].deref() === undefined); - Test_utils.ok("File \"polyvar_external_arg_test.res\", line 244, characters 7-14", match[1]() === t); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 245, characters 7-14", ["10"], t.calls); + Test_utils.ok("File \"polyvar_external_arg_test.res\", line 274, characters 7-14", match[0].deref() === undefined); + Test_utils.ok("File \"polyvar_external_arg_test.res\", line 275, characters 7-14", match[1]() === t); + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 276, characters 7-14", ["10"], t.calls); + }); + Mocha.test("the effects of unit and @ignore arguments after @string and @int arguments", () => { + let t = makeTarget(); + let log = []; + let mark = (s, v) => { + log.push(s); + return v; + }; + let tmp = mark("mode", opaque("dark")); + mark("unit", undefined); + t.setMode((x => { + switch (x) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })(tmp)); + let tmp$1 = mark("level", opaque("high")); + mark("unit", undefined); + t.setLevel((x => { + switch (x) { + case "low" : + return 0; + case "high" : + return 10; + } + })(tmp$1)); + let tmp$2 = mark("level", opaque("low")); + mark("ignored", 1); + t.setLevel((x => { + switch (x) { + case "low" : + return 0; + case "high" : + return 10; + } + })(tmp$2)); + let tmp$3 = mark("labelled", opaque("high")); + mark("unit", undefined); + t.setLevel((x => { + switch (x) { + case "low" : + return 0; + case "high" : + return 10; + } + })(tmp$3)); + let tmp$4 = mark("optional", opaque("low")); + mark("unit", undefined); + t.setLevel((x => { + switch (x) { + case "low" : + return 0; + case "high" : + return 10; + } + })(tmp$4)); + let tmp$5 = mark("mode field", opaque("dark")); + let tmp$6 = mark("level field", opaque("high")); + mark("unit", undefined); + let options = { + mode: (x => { + switch (x) { + case "light" : + return "light-mode"; + case "dark" : + return "dark-mode"; + } + })(tmp$5), + level: (x => { + switch (x) { + case "low" : + return 0; + case "high" : + return 10; + } + })(tmp$6) + }; + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 297, characters 6-13", [ + "mode", + "unit", + "level", + "unit", + "level", + "ignored", + "labelled", + "unit", + "optional", + "unit", + "mode field", + "level field", + "unit" + ], log); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 315, characters 7-14", [ + "dark-mode", + "10", + "0", + "10", + "0" + ], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 317, characters 7-14", [ + "mode", + "level" + ], Object.keys(options)); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 318, characters 7-14", [ + 10, + "dark-mode" + ], [ + options.level, + options.mode + ]); + }); + Mocha.test("a later argument that changes an event-style JS global", () => { + let t = makeTarget(); + setCurrentEvent({ + NAME: "click", + VAL: click + }); + let tmp = polyvarExternalArgCurrentEvent; + setCurrentEvent({ + NAME: "keydown", + VAL: keydown + }); + t.on(tmp.NAME, tmp.VAL); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 325, characters 7-14", ["click click 1"], t.calls); }); Mocha.test("the arguments around @string and @int arguments run in order", () => { let t = makeTarget(); @@ -344,7 +474,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { } })(mark("mode field", opaque("dark"))) }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 263, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 343, characters 6-13", [ "first", "mode", "second", @@ -354,11 +484,11 @@ Mocha.describe("Polyvar_external_arg_test", () => { "level field", "mode field" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 267, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 347, characters 7-14", [ "a light-mode b", "c 10 d" ], t.calls); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 268, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 348, characters 7-14", [ 0, "dark-mode" ], [ @@ -384,13 +514,13 @@ Mocha.describe("Polyvar_external_arg_test", () => { VAL: keydown })); t.onBefore(tmp$2.NAME, tmp$2.VAL, mark("fourth", "b")); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 280, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 360, characters 7-14", [ "first", "second", "third", "fourth" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 281, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 361, characters 7-14", [ "a click click 1", "keydown keydown 1 b" ], t.calls); @@ -409,7 +539,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(tmp$1.NAME), tmp$1.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 289, characters 7-14", 2, s.reads); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 369, characters 7-14", 2, s.reads); let globalReads = defineGlobalEvent(); t.on(polyvarExternalArgEvent.NAME, polyvarExternalArgEvent.VAL); t.on((x => { @@ -420,8 +550,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(polyvarExternalArgEvent.NAME), polyvarExternalArgEvent.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 294, characters 7-14", 4, globalReads()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 296, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 374, characters 7-14", 4, globalReads()); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 376, characters 6-13", [ "keydown keydown 1", "keydown! keydown 1", "click click 1", @@ -460,7 +590,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(lastEvent.contents.NAME), lastEvent.contents.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 312, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 392, characters 6-13", [ "click click 1", "keydown! keydown 1", "keydown keydown 1", @@ -515,14 +645,14 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })(Primitive_option.valFromOption(await mark("optional", Promise.resolve(opaque("high")))))); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 330, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 410, characters 7-14", [ "event", "dispatch", "mode", "level", "optional" ], log); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 331, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 411, characters 7-14", [ "keydown keydown 1", "click! click 1", "light-mode", @@ -561,7 +691,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })((await Promise.resolve("high")))); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 355, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 435, characters 7-14", [ "first", "mode", "second", @@ -569,7 +699,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { "level", "fourth" ], log); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 356, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 436, characters 7-14", [ "a dark-mode b", "c 0 d", "10" @@ -612,8 +742,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { ]); }; }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 384, characters 7-14", 3, i); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 385, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 464, characters 7-14", 3, i); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 465, characters 7-14", [ [ 1, 1 @@ -623,7 +753,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { 1 ] ], seen); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 386, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 466, characters 7-14", [ "event", "event", "event" @@ -651,8 +781,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { } n = n + 1 | 0; }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 400, characters 7-14", 3, n); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 401, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 480, characters 7-14", 3, n); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 481, characters 7-14", [ "event", "event", "event" @@ -671,7 +801,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { while (await Promise.resolve(true) && i < events.length && t.has(events[i].NAME, events[i].VAL)) { i = i + 1 | 0; }; - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 413, characters 7-14", 1, i); + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 493, characters 7-14", 1, i); }); Mocha.test("awaited fields of an object-creating external", async () => { let log = []; @@ -719,20 +849,20 @@ Mocha.describe("Polyvar_external_arg_test", () => { })(tmp$1); } let optional = tmp; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 432, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 512, characters 7-14", [ "level", "mode", "level", "mode" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 433, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 513, characters 7-14", [ 10, "dark-mode" ], [ options.level, options.mode ]); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 434, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 514, characters 7-14", [ 0, "light-mode" ], [ @@ -746,6 +876,7 @@ export { makeTarget, makeSource, defineGlobalEvent, + setCurrentEvent, opaque, click, keydown, diff --git a/tests/tests/src/polyvar_external_arg_test.res b/tests/tests/src/polyvar_external_arg_test.res index 3d87b123380..302d4cee5e6 100644 --- a/tests/tests/src/polyvar_external_arg_test.res +++ b/tests/tests/src/polyvar_external_arg_test.res @@ -80,6 +80,29 @@ external onBefore: ( string, ) => unit = "onBefore" +@send +external onThen: (target, @string [#click(int => string) | #keydown(int => string)], unit) => unit = + "on" + +@send +external setModeThen: ( + target, + @string [@as("light-mode") #light | @as("dark-mode") #dark], + unit, +) => unit = "setMode" + +@send +external setLevelThen: (target, @int [#low | @as(10) #high], unit) => unit = "setLevel" + +@send +external setLevelIgnoring: (target, @int [#low | @as(10) #high], @ignore int) => unit = "setLevel" + +@send +external setLevelLabelled: (target, ~level: @int [#low | @as(10) #high], unit) => unit = "setLevel" + +@send +external setLevelOptThen: (target, ~level: @int [#low | @as(10) #high]=?, unit) => unit = "setLevel" + @obj external makeOptions: ( ~level: @int [#low | @as(10) #high], @@ -122,6 +145,14 @@ let defineGlobalEvent: unit => unit => int = %raw(`() => { return () => reads }`) +@val +external currentEvent: [#click(int => string) | #keydown(int => string)] = + "polyvarExternalArgCurrentEvent" + +let setCurrentEvent: [#click(int => string) | #keydown(int => string)] => unit = %raw(`e => { + globalThis.polyvarExternalArgCurrentEvent = e +}`) + // Opaque, so that the optimizer cannot tell the argument is a literal. let opaque: 'a => 'a = %raw(`x => x`) @@ -245,6 +276,55 @@ describe(__MODULE__, () => { eq(__LOC__, ["10"], calls(t)) }) + test("the effects of unit and @ignore arguments after @string and @int arguments", () => { + let t = makeTarget() + let log = [] + let mark = (s, v) => { + log->Array.push(s) + v + } + setModeThen(t, mark("mode", opaque(#dark)), mark("unit", ())) + setLevelThen(t, mark("level", opaque(#high)), mark("unit", ())) + setLevelIgnoring(t, mark("level", opaque(#low)), mark("ignored", 1)) + setLevelLabelled(t, ~level=mark("labelled", opaque(#high)), mark("unit", ())) + setLevelOptThen(t, ~level=mark("optional", opaque(#low)), mark("unit", ())) + let options = makeModeFirst( + ~mode=mark("mode field", opaque(#dark)), + ~level=mark("level field", opaque(#high)), + mark("unit", ()), + ) + eq( + __LOC__, + [ + "mode", + "unit", + "level", + "unit", + "level", + "ignored", + "labelled", + "unit", + "optional", + "unit", + "mode field", + "level field", + "unit", + ], + log, + ) + eq(__LOC__, ["dark-mode", "10", "0", "10", "0"], calls(t)) + // The optional field is known to be present, so it stays in the literal + eq(__LOC__, ["mode", "level"], Object.keysToArray(Obj.magic(options))) + eq(__LOC__, (10, Some("dark-mode")), (options["level"], options["mode"]->toOption)) + }) + + test("a later argument that changes an event-style JS global", () => { + let t = makeTarget() + setCurrentEvent(#click(click)) + onThen(t, currentEvent, setCurrentEvent(#keydown(keydown))) + eq(__LOC__, ["click click 1"], calls(t)) + }) + test("the arguments around @string and @int arguments run in order", () => { let t = makeTarget() let log = [] From 28b9c605b63550a712e33ab7897f31181bb90cc9 Mon Sep 17 00:00:00 2001 From: mununki Date: Tue, 10 Nov 2026 00:40:40 +0900 Subject: [PATCH 6/6] Bind dotted @val event arguments of externals MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Why: The first commit reads a `@val` global in place for the tag and for the payload of an event-style argument, like a `@module` value. A `@val` with a dotted name such as `"window.ev"` compiles to a variable printed as `window.ev`, so it was read in place too, though it is the same property read as `@val @scope("window") external ev: … = "ev"`, which keeps its temporary (a lower-severity regression in the review of #9231). `Js_analyzer.is_okay_to_duplicate ~property_reads:false`, which #9283 added for optional arguments, already tells such a name from a variable, so `duplicable` now defers to it, as the review suggested, and adds array elements and conditionals, and fields of them. JS modified (@val with a dotted name as an event-style argument): Example: type t @val external ev: [#click(int => unit) | #keydown(int => unit)] = "window.ev" @send external on: (t, @string [#click(int => unit) | #keydown(int => unit)]) => unit = "on" let listen = t => on(t, ev) Before (js): function listen(t) { t.on(window.ev.NAME, window.ev.VAL); } After (js): function listen(t) { let tmp = window.ev; t.on(tmp.NAME, tmp.VAL); } JS modified (event-style arguments read twice): Before (representation): Js_of_lam_variant.eval_as_event_in_place x, r.ev, ev, M.ev ↦ read twice window.ev, as @val "window.ev" ↦ read twice window.ev, as @val @scope("window") "ev" ↦ temporary s.ev, as @get ↦ temporary arr[i], c ? x : y, rs[i].ev ↦ read twice f() ↦ temporary note: ev is a @val global and M.ev a @module value After (representation): Js_of_lam_variant.eval_as_event_in_place x, r.ev, ev, M.ev ↦ read twice window.ev, as @val "window.ev" ↦ temporary window.ev, as @val @scope("window") "ev" ↦ temporary s.ev, as @get ↦ temporary arr[i], c ? x : y, rs[i].ev ↦ read twice f() ↦ temporary note: ev is a @val global and M.ev a @module value Tests: `polyvar_external_arg_test.res` checks that a `@val` with a dotted name is read once, like the same name with `@scope`. Compiled with the previous commit, it fails. Review: Why does `duplicable` add array elements and conditionals, and fields of them, to `is_okay_to_duplicate`? That predicate leaves them out, and the other callers that pass `~property_reads:false` read such an argument once instead: an optional argument of a call goes to `Primitive_option.valFromOption`, and one of an `@obj` external to a temporary after the literal. The alternative for an event-style argument is a temporary before the call, a statement that makes `sequence_arguments` bind the arguments to its left that have side effects, so these reads without side effects stay in place, as #9217 left them. A field of a variable is already in `is_okay_to_duplicate`; `duplicable` takes fields itself only to reach the array element or conditional under them, as in `rs[i].ev`. No other output changes. Review: Why is a `@val` global without a dot still read twice, though a getter may then give the tag of one event and the payload of another? The review of #9217 asked to treat a `@val` global like a `@module` value, which Babel or TypeScript may compile to a getter as well, and to read both in place, as compilers before #9217 did. A later argument that changes the global is no longer a problem since the previous commit: its effects are statements, before which the global is bound. Review: Why no changelog fragment? A dotted `@val` was bound in 13.0.0-alpha.7 as well, so this only takes back what the first commit changed for it. Signed-off-by: mununki --- compiler/core/js_of_lam_variant.ml | 22 ++-- tests/tests/src/polyvar_external_arg_test.mjs | 106 +++++++++++------- tests/tests/src/polyvar_external_arg_test.res | 45 ++++++-- 3 files changed, 113 insertions(+), 60 deletions(-) diff --git a/compiler/core/js_of_lam_variant.ml b/compiler/core/js_of_lam_variant.ml index 27f0fb165c4..97d44c9b261 100644 --- a/compiler/core/js_of_lam_variant.ml +++ b/compiler/core/js_of_lam_variant.ml @@ -28,22 +28,24 @@ module S = Js_stmt_make type arg_expression = Splice0 | Splice1 of E.t | Splice2 of E.t * E.t (* [eval_as_event] reads an argument other than a literal twice, for the tag - and for the payload. That is the same as reading it once, in place, for - constants, variables, and fields, array elements and conditionals of them. - A JS global ([@val]) counts as a variable, like a value of a JS module - ([@module]), though either may be a getter. A JS property read does not - count: a [@get] external is there to run a getter, and a [@val] or - [@module] value with [@scope] is a property read as well, which cannot be - told from it. *) + and for the payload. That is the same as reading it once, in place, when + [Js_analyzer.is_okay_to_duplicate ~property_reads:false] holds for it: for + constants, variables and fields of records. A JS global ([@val]) counts as + a variable, like a value of a JS module ([@module]), though either may be + a getter. A JS property read does not count: a [@get] external is there to + run a getter, and a [@val] or [@module] value with [@scope], or a [@val] + with a dotted name such as ["window.ev"], is a property read as well, + which cannot be told from it. Array elements and conditionals of such + arguments, and their fields, count too, though [is_okay_to_duplicate] + leaves them out: here the alternative is a temporary, a statement that + also binds the arguments to its left that have side effects. *) let eval_as_event_in_place (arg : J.expression) = let rec duplicable (e : J.expression) = match e.expression_desc with - | Undefined _ | Bool _ | Number _ | Str _ | Template_literal _ | Var _ -> - true | Static_index (e, _, Some _) -> duplicable e | Array_index (a, b) -> duplicable a && duplicable b | Cond (a, b, c) -> duplicable a && duplicable b && duplicable c - | _ -> false + | _ -> Js_analyzer.is_okay_to_duplicate ~property_reads:false e in match arg.expression_desc with | Caml_block ([{expression_desc = Str _}; _], _, Blk_poly_var) -> true diff --git a/tests/tests/src/polyvar_external_arg_test.mjs b/tests/tests/src/polyvar_external_arg_test.mjs index 53db1c8e08a..65a6f14e77e 100644 --- a/tests/tests/src/polyvar_external_arg_test.mjs +++ b/tests/tests/src/polyvar_external_arg_test.mjs @@ -45,6 +45,17 @@ let setCurrentEvent = (e => { globalThis.polyvarExternalArgCurrentEvent = e }); +let defineScopedEvent = (() => { + let reads = 0 + globalThis.polyvarExternalArgScope = { + get event() { + reads++ + return { NAME: "keydown", VAL: x => "keydown " + x } + } + } + return () => reads +}); + let opaque = (x => x); function click(x) { @@ -122,11 +133,11 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(tmp$1.NAME), tmp$1.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 198, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 217, characters 7-14", [ "event", "dispatch" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 199, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 218, characters 7-14", [ "keydown keydown 1", "click! click 1" ], t.calls); @@ -139,8 +150,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { return v; }; t.on("click", mark("payload", click)); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 210, characters 7-14", ["payload"], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 211, characters 7-14", ["click click 1"], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 229, characters 7-14", ["payload"], log); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 230, characters 7-14", ["click click 1"], t.calls); }); Mocha.test("@string and @int arguments with side effects", () => { let t = makeTarget(); @@ -173,12 +184,12 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })(Primitive_option.valFromOption(mark("optional", opaque("low"))))); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 224, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 243, characters 7-14", [ "mode", "level", "optional" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 225, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 244, characters 7-14", [ "dark-mode", "10", "0" @@ -251,7 +262,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { })(tmp$2); } let noMode = tmp$3; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 247, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 266, characters 7-14", [ "some", "none", "mode field", @@ -259,18 +270,18 @@ Mocha.describe("Polyvar_external_arg_test", () => { "no mode field", "low field" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 248, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 267, characters 7-14", [ "10", "undefined" ], t.calls); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 249, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 268, characters 7-14", [ 10, "dark-mode" ], [ options.level, options.mode ]); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 250, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 269, characters 7-14", [ 0, undefined ], [ @@ -293,8 +304,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })(defer(async () => await Promise.resolve(), opaque("high")))); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 262, characters 7-14", 1, pending.length); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 263, characters 7-14", ["10"], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 281, characters 7-14", 1, pending.length); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 282, characters 7-14", ["10"], t.calls); }); Mocha.test("a closure created next to an @int argument does not keep it alive", async () => { Nodev8.setFlagsFromString("--expose-gc"); @@ -303,9 +314,9 @@ Mocha.describe("Polyvar_external_arg_test", () => { let match = keepClosure(t); await nextTask(); gc(); - Test_utils.ok("File \"polyvar_external_arg_test.res\", line 274, characters 7-14", match[0].deref() === undefined); - Test_utils.ok("File \"polyvar_external_arg_test.res\", line 275, characters 7-14", match[1]() === t); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 276, characters 7-14", ["10"], t.calls); + Test_utils.ok("File \"polyvar_external_arg_test.res\", line 293, characters 7-14", match[0].deref() === undefined); + Test_utils.ok("File \"polyvar_external_arg_test.res\", line 294, characters 7-14", match[1]() === t); + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 295, characters 7-14", ["10"], t.calls); }); Mocha.test("the effects of unit and @ignore arguments after @string and @int arguments", () => { let t = makeTarget(); @@ -385,7 +396,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { } })(tmp$6) }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 297, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 316, characters 6-13", [ "mode", "unit", "level", @@ -400,18 +411,18 @@ Mocha.describe("Polyvar_external_arg_test", () => { "level field", "unit" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 315, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 334, characters 7-14", [ "dark-mode", "10", "0", "10", "0" ], t.calls); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 317, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 336, characters 7-14", [ "mode", "level" ], Object.keys(options)); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 318, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 337, characters 7-14", [ 10, "dark-mode" ], [ @@ -431,7 +442,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { VAL: keydown }); t.on(tmp.NAME, tmp.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 325, characters 7-14", ["click click 1"], t.calls); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 344, characters 7-14", ["click click 1"], t.calls); }); Mocha.test("the arguments around @string and @int arguments run in order", () => { let t = makeTarget(); @@ -474,7 +485,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { } })(mark("mode field", opaque("dark"))) }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 343, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 362, characters 6-13", [ "first", "mode", "second", @@ -484,11 +495,11 @@ Mocha.describe("Polyvar_external_arg_test", () => { "level field", "mode field" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 347, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 366, characters 7-14", [ "a light-mode b", "c 10 d" ], t.calls); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 348, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 367, characters 7-14", [ 0, "dark-mode" ], [ @@ -514,13 +525,13 @@ Mocha.describe("Polyvar_external_arg_test", () => { VAL: keydown })); t.onBefore(tmp$2.NAME, tmp$2.VAL, mark("fourth", "b")); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 360, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 379, characters 7-14", [ "first", "second", "third", "fourth" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 361, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 380, characters 7-14", [ "a click click 1", "keydown keydown 1 b" ], t.calls); @@ -539,7 +550,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(tmp$1.NAME), tmp$1.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 369, characters 7-14", 2, s.reads); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 388, characters 7-14", 2, s.reads); let globalReads = defineGlobalEvent(); t.on(polyvarExternalArgEvent.NAME, polyvarExternalArgEvent.VAL); t.on((x => { @@ -550,12 +561,20 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(polyvarExternalArgEvent.NAME), polyvarExternalArgEvent.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 374, characters 7-14", 4, globalReads()); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 376, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 393, characters 7-14", 4, globalReads()); + let scopedReads = defineScopedEvent(); + let tmp$2 = polyvarExternalArgScope.event; + t.on(tmp$2.NAME, tmp$2.VAL); + let tmp$3 = polyvarExternalArgScope.event; + t.on(tmp$3.NAME, tmp$3.VAL); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 398, characters 7-14", 2, scopedReads()); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 400, characters 6-13", [ "keydown keydown 1", "keydown! keydown 1", "click click 1", - "click! click 1" + "click! click 1", + "keydown keydown 1", + "keydown keydown 1" ], t.calls); }); Mocha.test("refs read as event-style arguments", () => { @@ -590,7 +609,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { return "keydown!"; } })(lastEvent.contents.NAME), lastEvent.contents.VAL); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 392, characters 6-13", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 423, characters 6-13", [ "click click 1", "keydown! keydown 1", "keydown keydown 1", @@ -645,14 +664,14 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })(Primitive_option.valFromOption(await mark("optional", Promise.resolve(opaque("high")))))); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 410, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 441, characters 7-14", [ "event", "dispatch", "mode", "level", "optional" ], log); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 411, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 442, characters 7-14", [ "keydown keydown 1", "click! click 1", "light-mode", @@ -691,7 +710,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { return 10; } })((await Promise.resolve("high")))); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 435, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 466, characters 7-14", [ "first", "mode", "second", @@ -699,7 +718,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { "level", "fourth" ], log); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 436, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 467, characters 7-14", [ "a dark-mode b", "c 0 d", "10" @@ -742,8 +761,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { ]); }; }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 464, characters 7-14", 3, i); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 465, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 495, characters 7-14", 3, i); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 496, characters 7-14", [ [ 1, 1 @@ -753,7 +772,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { 1 ] ], seen); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 466, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 497, characters 7-14", [ "event", "event", "event" @@ -781,8 +800,8 @@ Mocha.describe("Polyvar_external_arg_test", () => { } n = n + 1 | 0; }; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 480, characters 7-14", 3, n); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 481, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 511, characters 7-14", 3, n); + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 512, characters 7-14", [ "event", "event", "event" @@ -801,7 +820,7 @@ Mocha.describe("Polyvar_external_arg_test", () => { while (await Promise.resolve(true) && i < events.length && t.has(events[i].NAME, events[i].VAL)) { i = i + 1 | 0; }; - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 493, characters 7-14", 1, i); + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 524, characters 7-14", 1, i); }); Mocha.test("awaited fields of an object-creating external", async () => { let log = []; @@ -849,20 +868,20 @@ Mocha.describe("Polyvar_external_arg_test", () => { })(tmp$1); } let optional = tmp; - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 512, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 543, characters 7-14", [ "level", "mode", "level", "mode" ], log); - Test_utils.eq("File \"polyvar_external_arg_test.res\", line 513, characters 7-14", [ + Test_utils.eq("File \"polyvar_external_arg_test.res\", line 544, characters 7-14", [ 10, "dark-mode" ], [ options.level, options.mode ]); - return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 514, characters 7-14", [ + return Test_utils.eq("File \"polyvar_external_arg_test.res\", line 545, characters 7-14", [ 0, "light-mode" ], [ @@ -877,6 +896,7 @@ export { makeSource, defineGlobalEvent, setCurrentEvent, + defineScopedEvent, opaque, click, keydown, diff --git a/tests/tests/src/polyvar_external_arg_test.res b/tests/tests/src/polyvar_external_arg_test.res index 302d4cee5e6..973a353788a 100644 --- a/tests/tests/src/polyvar_external_arg_test.res +++ b/tests/tests/src/polyvar_external_arg_test.res @@ -7,12 +7,13 @@ external testAsync: (string, unit => promise) => unit = "test" // A polymorphic variant argument of an external is evaluated once, in its // place among the arguments. An event-style argument is passed as its tag and // its payload, so an argument with side effects is read from a temporary, as -// is a JS property read such as a @get getter, while a JS global is read in -// place, like a value of a JS module. An @as or @int dispatch is a function -// that switches on the argument and is called with it, so the argument, an -// await in it included, is evaluated where it is. Like any argument, it is -// read from a temporary only if an argument after it has statements to run -// first. In a while condition, the temporary is bound inside the loop. +// is a JS property read such as a @get getter or a @val with a dotted name, +// while a JS global is read in place, like a value of a JS module. An @as or +// @int dispatch is a function that switches on the argument and is called +// with it, so the argument, an await in it included, is evaluated where it +// is. Like any argument, it is read from a temporary only if an argument after +// it has statements to run first. In a while condition, the temporary is +// bound inside the loop. type target @@ -153,6 +154,24 @@ let setCurrentEvent: [#click(int => string) | #keydown(int => string)] => unit = globalThis.polyvarExternalArgCurrentEvent = e }`) +@val +external dottedEvent: [#click(int => string) | #keydown(int => string)] = + "polyvarExternalArgScope.event" + +@val @scope("polyvarExternalArgScope") +external scopedEvent: [#click(int => string) | #keydown(int => string)] = "event" + +let defineScopedEvent: unit => unit => int = %raw(`() => { + let reads = 0 + globalThis.polyvarExternalArgScope = { + get event() { + reads++ + return { NAME: "keydown", VAL: x => "keydown " + x } + } + } + return () => reads +}`) + // Opaque, so that the optimizer cannot tell the argument is a literal. let opaque: 'a => 'a = %raw(`x => x`) @@ -372,9 +391,21 @@ describe(__MODULE__, () => { on(t, globalEvent) onAs(t, globalEvent) eq(__LOC__, 4, globalReads()) + // A @val with a dotted name is a property read, like one with @scope + let scopedReads = defineScopedEvent() + on(t, dottedEvent) + on(t, scopedEvent) + eq(__LOC__, 2, scopedReads()) eq( __LOC__, - ["keydown keydown 1", "keydown! keydown 1", "click click 1", "click! click 1"], + [ + "keydown keydown 1", + "keydown! keydown 1", + "click click 1", + "click! click 1", + "keydown keydown 1", + "keydown keydown 1", + ], calls(t), ) })