Wasm: dispatch lifecycle events when async instantiation completes

CHANGES.md

@@ -43,6 +43,13 @@
   API, plus a `fonts` property on `Dom_html.document` (#2255)
 * Lib: `Lwt_js_events` `load`/`error`/`abort` and their `seq_loop` variants now
   accept any element, not only images (#2404)
+* Runtime/wasm: dispatch `wasmoocaml:loaded` and `wasmoocaml:error`
+  `CustomEvent`s on `globalThis` so that surrounding JavaScript can wait
+  for the asynchronous Wasm instantiation to complete
+* Compiler: standalone executables now dispatch `jsoocaml:loaded` and
+  `jsoocaml:error` `CustomEvent`s on `globalThis`, mirroring the Wasm
+  lifecycle events, so that surrounding JavaScript can wait for the
+  program to run the same way with either backend
 
 ## Bug fixes
 * Compiler/Wasm runtime: fix toplevels built on Windows — the embedded cmi

compiler/bin-js_of_ocaml/compile.ml

@@ -263,6 +263,7 @@ let run
       (one : Parse_bytecode.one)
       ~check_sourcemap
       ~standalone
+      ~lifecycle_events
       ~shapes
       ~(source_map : Source_map.Encoding_spec.t option)
       ~link
@@ -282,6 +283,7 @@ let run
           let code = Code.prepend one.code instr in
           Driver.f
             ~standalone
+            ~lifecycle_events
             ~shapes
             ?profile
             ~link
@@ -306,6 +308,7 @@ let run
           let res =
             Driver.f
               ~standalone
+              ~lifecycle_events
               ~shapes
               ?profile
               ~link
@@ -342,6 +345,7 @@ let run
       ~check_sourcemap:true
       ~source_map
       ~standalone
+      ~lifecycle_events:false
       ~shapes
       ~link:`No
       output_file
@@ -372,6 +376,7 @@ let run
       ~check_sourcemap:false
       ~source_map
       ~standalone
+      ~lifecycle_events:false
       ~link:(`All_from runtime_files_from_cmdline)
       output_file
   in
@@ -409,6 +414,7 @@ let run
             ~check_sourcemap:false
             ~source_map
             ~standalone
+            ~lifecycle_events:false
             ~shapes
             ~link:`All
             output_file
@@ -456,6 +462,7 @@ let run
                 code
                 ~check_sourcemap:true
                 ~standalone
+                ~lifecycle_events:true
                 ~shapes
                 ~source_map
                 ~link:(if linkall then `All else `Needed)

compiler/lib/driver.ml

@@ -534,7 +534,11 @@ let output formatter ~source_map () js =
   if times () then Format.eprintf "  write: %a@." Timer.print t;
   sm
 
-let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_codes } =
+let pack
+    ~wrap_with_fun
+    ~standalone
+    ~lifecycle_events
+    { Linker.runtime_code = js; always_required_codes } =
   let module J = Javascript in
   let t = Timer.make () in
   if times () then Format.eprintf "Start Optimizing js...@.";
@@ -628,6 +632,35 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_
   in
   let runtime_js = wrap_in_iife ~use_strict:(Config.Flag.strictmode ()) js in
   let js = always_required_js @ [ runtime_js ] in
+  (* Dispatch lifecycle events on [globalThis], mirroring the Wasm
+     launcher ([runtime/wasm/runtime.js]), so that surrounding JavaScript
+     can wait for the program the same way with either backend. *)
+  let wrap_with_lifecycle_events js =
+    let s =
+      {|
+try {
+  0;
+  if (typeof globalThis.dispatchEvent === 'function'
+      && typeof CustomEvent === 'function') {
+    globalThis.dispatchEvent(new CustomEvent('jsoocaml:loaded'));
+  }
+} catch (jsoo_lifecycle_error) {
+  if (typeof globalThis.dispatchEvent === 'function'
+      && typeof CustomEvent === 'function') {
+    globalThis.dispatchEvent(
+      new CustomEvent('jsoocaml:error',
+                      { detail: { error: jsoo_lifecycle_error } }));
+  }
+  throw jsoo_lifecycle_error;
+}
+|}
+    in
+    let lex = Parse_js.Lexer.of_string s in
+    match Parse_js.parse `Script lex with
+    | [ (J.Try_statement (_placeholder :: on_loaded, catch_clause, None), loc) ] ->
+        [ J.Try_statement (js @ on_loaded, catch_clause, None), loc ]
+    | _ -> assert false
+  in
   let js =
     match wrap_with_fun, standalone with
     | `Named name, (true | false) ->
@@ -672,6 +705,7 @@ if (typeof module === 'object' && module.exports) {
           let lex = Parse_js.Lexer.of_string s in
           Parse_js.parse `Script lex
         in
+        let js = if lifecycle_events then wrap_with_lifecycle_events js else js in
         e @ js
   in
   if times () then Format.eprintf "  packing: %a@." Timer.print t;
@@ -694,15 +728,20 @@ let configure formatter =
   let pretty = Config.Flag.pretty () in
   Pretty_print.set_compact formatter (not pretty)
 
-let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p =
+let link_and_pack
+    ?(standalone = true)
+    ?(wrap_with_fun = `Iife)
+    ?(lifecycle_events = false)
+    ?(link = `No)
+    p =
   let export_runtime =
     match link with
     | `All | `All_from _ -> true
     | `Needed | `No -> false
   in
   p
   |> link' ~export_runtime ~standalone ~link
-  |> pack ~wrap_with_fun ~standalone
+  |> pack ~wrap_with_fun ~standalone ~lifecycle_events
   |> check_js
 
 let optimize ~shapes ~profile ~keep_flow_data p =
@@ -744,12 +783,21 @@ let optimize_for_wasm ~shapes ~profile p =
     | Some data -> data
     | None -> Global_flow.f ~fast:false optimized_code.program )
 
-let full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p =
+let full
+    ~standalone
+    ~wrap_with_fun
+    ~lifecycle_events
+    ~shapes
+    ~profile
+    ~link
+    ~source_map
+    ~formatter
+    p =
   let optimized_code, _ = optimize ~shapes ~profile ~keep_flow_data:false p in
   let exported_runtime = not standalone in
   let emit formatter =
     generate ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
-    +> link_and_pack ~standalone ~wrap_with_fun ~link
+    +> link_and_pack ~standalone ~wrap_with_fun ~lifecycle_events ~link
     +> simplify_js
     +> name_variables
     +> output formatter ~source_map ()
@@ -767,20 +815,39 @@ let full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatte
 
 let full_no_source_map ~formatter ~shapes ~standalone ~wrap_with_fun ~profile ~link p =
   let (_ : Source_map.info * _) =
-    full ~shapes ~standalone ~wrap_with_fun ~profile ~link ~source_map:false ~formatter p
+    full
+      ~shapes
+      ~standalone
+      ~wrap_with_fun
+      ~lifecycle_events:false
+      ~profile
+      ~link
+      ~source_map:false
+      ~formatter
+      p
   in
   ()
 
 let f
     ?(standalone = true)
     ?(wrap_with_fun = `Iife)
+    ?(lifecycle_events = false)
     ?(profile = Profile.O1)
     ?(shapes = false)
     ~link
     ~source_map
     ~formatter
     p =
-  full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p
+  full
+    ~standalone
+    ~wrap_with_fun
+    ~lifecycle_events
+    ~shapes
+    ~profile
+    ~link
+    ~source_map
+    ~formatter
+    p
 
 let f'
     ?(standalone = true)

compiler/lib/driver.mli

@@ -38,6 +38,7 @@ val optimize_for_wasm :
 val f :
      ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
+  -> ?lifecycle_events:bool
   -> ?profile:Profile.t
   -> ?shapes:bool
   -> link:[ `All | `All_from of string list | `Needed | `No ]
@@ -65,6 +66,7 @@ val from_string :
 val link_and_pack :
      ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
+  -> ?lifecycle_events:bool
   -> ?link:[ `All | `All_from of string list | `Needed | `No ]
   -> Javascript.statement_list
   -> Javascript.statement_list

compiler/lib/reserved.ml

@@ -143,6 +143,7 @@ let provided =
     ; "btoa"
     ; "clearInterval"
     ; "console"
+    ; "CustomEvent"
     ; "global" (* only available in node *)
     ; "importScripts" (* only available in WebWorker *)
     ; "performance" (* Not available in node until v16+ *)

compiler/tests-compiler/exports.ml

@@ -50,6 +50,22 @@ let%expect_test "static eval of string get" =
                 ( Expression_statement
                     (ECall (EFun (name, (k, param, body, loc1)), ANormal, a, l))
                 , loc ))
+      | Try_statement (body, _, _), loc -> (
+          (* Standalone executables are wrapped in a try/catch dispatching
+             lifecycle events; look for the program inside it. *)
+          let body =
+            List.filter_map
+              (fun st ->
+                match st with
+                | Function_declaration _, _
+                | Expression_statement (ECall (EFun _, _, _, _)), _ -> clean_statement st
+                | _ -> None)
+              body
+          in
+          match body with
+          | [] -> None
+          | [ st ] -> Some st
+          | sts -> Some (Block sts, loc))
       | _, _ -> Some st
     in
     List.filter_map clean_statement program

runtime/wasm/runtime.js

@@ -914,34 +914,49 @@
     }
     return { instance: { exports: Object.assign(imports.env, imports.OCaml) } };
   }
-  const wasmModule = await instantiateFromDir();
-
-  var {
-    caml_callback,
-    caml_alloc_times,
-    caml_alloc_tm,
-    caml_alloc_stat,
-    caml_start_fiber,
-    caml_handle_uncaught_exception,
-    caml_buffer,
-    caml_extract_bytes,
-    _initialize,
-  } = wasmModule.instance.exports;
-
-  var buffer = caml_buffer?.buffer;
-  var out_buffer = buffer && new Uint8Array(buffer, 0, buffer.length);
-
-  start_fiber = make_promising(caml_start_fiber);
-  var _initialize = make_promising(_initialize);
-  if (globalThis.process?.on) {
-    globalThis.process.on("uncaughtException", (err, _origin) =>
-      caml_handle_uncaught_exception(err),
-    );
-  } else if (globalThis.addEventListener) {
-    globalThis.addEventListener(
-      "error",
-      (event) => event.error && caml_handle_uncaught_exception(event.error),
-    );
+  function dispatchLifecycleEvent(name, detail) {
+    if (
+      typeof globalThis.dispatchEvent === "function" &&
+      typeof CustomEvent === "function"
+    ) {
+      globalThis.dispatchEvent(new CustomEvent(name, { detail }));
+    }
+  }
+
+  try {
+    const wasmModule = await instantiateFromDir();
+
+    var {
+      caml_callback,
+      caml_alloc_times,
+      caml_alloc_tm,
+      caml_alloc_stat,
+      caml_start_fiber,
+      caml_handle_uncaught_exception,
+      caml_buffer,
+      caml_extract_bytes,
+      _initialize,
+    } = wasmModule.instance.exports;
+
+    var buffer = caml_buffer?.buffer;
+    var out_buffer = buffer && new Uint8Array(buffer, 0, buffer.length);
+
+    start_fiber = make_promising(caml_start_fiber);
+    var _initialize = make_promising(_initialize);
+    if (globalThis.process?.on) {
+      globalThis.process.on("uncaughtException", (err, _origin) =>
+        caml_handle_uncaught_exception(err),
+      );
+    } else if (globalThis.addEventListener) {
+      globalThis.addEventListener(
+        "error",
+        (event) => event.error && caml_handle_uncaught_exception(event.error),
+      );
+    }
+    await _initialize();
+    dispatchLifecycleEvent("wasmoocaml:loaded", { src });
+  } catch (error) {
+    dispatchLifecycleEvent("wasmoocaml:error", { src, error });
+    throw error;
   }
-  await _initialize();
 };