From d2e39c20a5e8affa28e69d6483116f661f223e18 Mon Sep 17 00:00:00 2001 From: mununki Date: Thu, 5 Nov 2026 05:50:17 +0900 Subject: [PATCH 1/4] 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 4386120982..946c0c7d87 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 a7f7dec24a..8e1b9f4e63 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 4990ffe260..ed4c450fcc 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 cb57b3e50b..36283470eb 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 48a6bf11a4d9bfb87165b5bd2949636f4af89468 Mon Sep 17 00:00:00 2001 From: mununki Date: Tue, 10 Nov 2026 00:32:51 +0900 Subject: [PATCH 2/4] 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 0000000000..31f60c7fb5 --- /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 ae1a4273ae..14e65935c0 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 2bfc4709c5..2817d6c764 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 946c0c7d87..27f0fb165c 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 47f3cf7673..03fc722053 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 1a63ba8642..321cd457e5 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 2b73daa216..4ce4b7cc2f 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 3187fd15f7..de5993cbc5 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 c31daa8a0c..f9224b1ff3 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 5b5b448b86..b7474fac07 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 8e1b9f4e63..783ebe0347 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 ed4c450fcc..a4641c1846 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 36283470eb..3d87b12338 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 b7b961b8c1a538b5b5ccd3898adb2e77585c1cd3 Mon Sep 17 00:00:00 2001 From: mununki Date: Tue, 10 Nov 2026 00:38:36 +0900 Subject: [PATCH 3/4] 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 0000000000..6c6f7fbe4f --- /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 14e65935c0..84d4e6c256 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 2817d6c764..5994f2a648 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 c0859e2184..a6b8a51751 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 321cd457e5..4e6d02c085 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 4ce4b7cc2f..e893272720 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 de5993cbc5..b7bff47d0e 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 a9ca8204ea..947f87ff90 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 c0e2e91f02..736fba1ace 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 783ebe0347..1085effc19 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 a4641c1846..53db1c8e08 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 3d87b12338..302d4cee5e 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 bd47f010ccbc157b13b1edfd58bee1474fd2c27a Mon Sep 17 00:00:00 2001 From: mununki Date: Tue, 10 Nov 2026 00:40:40 +0900 Subject: [PATCH 4/4] 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 27f0fb165c..97d44c9b26 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 53db1c8e08..65a6f14e77 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 302d4cee5e..973a353788 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), ) })