Merge pull request #48 from ocaml-wasm/updated-jspi

Update to new JavaScript-Promise Integration API

Author: vouillon

.github/workflows/build-wasm_of_ocaml.yml

@@ -42,7 +42,7 @@ jobs:
       - name: Install node
         uses: actions/setup-node@v4
         with:
-          node-version: 22
+          node-version: 23
 
       - name: Restore cached binaryen
         id: cache-binaryen

compiler/lib-wasm/gc_target.ml

@@ -1703,26 +1703,23 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
 let post_process_function_body = Initialize_locals.f
 
 let entry_point ~toplevel_fun =
-  let suspender = Code.Var.fresh () in
   let code =
-    let* f =
-      register_import
-        ~name:
-          (if Config.Flag.effects ()
-           then "caml_cps_initialize_effects"
-           else "caml_initialize_effects")
-        (Fun { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] })
+    let* () =
+      if Config.Flag.effects ()
+      then
+        let* f =
+          register_import
+            ~name:"caml_cps_initialize_effects"
+            (Fun { W.params = []; result = [] })
+        in
+        instr (W.CallInstr (f, []))
+      else return ()
     in
-    let* _ = add_var suspender in
-    let* s = load suspender in
-    let* () = instr (W.CallInstr (f, [ s ])) in
     let* main =
       register_import
         ~name:"caml_main"
         (Fun { params = [ W.Ref { nullable = false; typ = Func } ]; result = [] })
     in
     instr (W.CallInstr (main, [ RefFunc toplevel_fun ]))
   in
-  ( { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] }
-  , [ suspender ]
-  , code )
+  { W.params = []; result = [] }, [], code

runtime/wasm/effect.wat

@@ -33,8 +33,7 @@
    (import "bindings" "start_fiber" (func $start_fiber (param (ref eq))))
    (import "bindings" "suspend_fiber"
       (func $suspend_fiber
-         (param externref) (param $f funcref) (param $env eqref)
-         (result eqref)))
+         (param $f funcref) (param $env eqref) (result anyref)))
    (import "bindings" "resume_fiber"
       (func $resume_fiber (param externref) (param (ref eq))))
 
@@ -60,9 +59,6 @@
 
    ;; Low-level primitives
 
-   (global $current_suspender (export "current_suspender") (mut externref)
-      (ref.null extern))
-
    ;; Capturing the current continuation
 
    (type $cont_func (func (param (ref $pair)) (param (ref eq))))
@@ -102,7 +98,6 @@
       (return_call $apply_pair
          (ref.cast (ref $pair)
             (call $suspend_fiber
-               (global.get $current_suspender)
                (ref.func $apply_continuation)
                (struct.new $thunk (local.get $f) (local.get $v))))))
 
@@ -121,7 +116,6 @@
          (struct
             (field $handlers (mut (ref $handlers)))
             (field $cont (ref $cont))
-            (field $suspender externref)
             (field $next (ref null $fiber)))))
 
    (data $effect_unhandled "Effect.Unhandled")
@@ -178,7 +172,6 @@
                (ref.func $dummy_fun)
                (ref.func $uncaught_effect_handler)))
          (struct.new $cont (ref.func $default_continuation))
-         (ref.null extern)
          (ref.null $fiber)))
 
    ;; Utility functions moving fibers between a continuation and the
@@ -189,8 +182,6 @@
       (local.set $f (ref.as_non_null (global.get $stack)))
       (global.set $stack
          (struct.get $fiber $next (local.get $f)))
-      (global.set $current_suspender
-         (struct.get $fiber $suspender (local.get $f)))
       (struct.get $fiber $cont (local.get $f)))
 
    (func $push_stack
@@ -202,10 +193,7 @@
                (struct.new $fiber
                   (struct.get $fiber $handlers (local.get $stack))
                   (local.get $k)
-                  (global.get $current_suspender)
                   (global.get $stack)))
-            (global.set $current_suspender
-               (struct.get $fiber $suspender (local.get $stack)))
             (local.set $k
                (struct.get $fiber $cont (local.get $stack)))
             (local.set $stack
@@ -292,7 +280,6 @@
          (struct.new $fiber
              (struct.get $fiber $handlers (global.get $stack))
              (local.get $k0)
-             (global.get $current_suspender)
              (if (result (ref null $fiber))
                  (ref.test (ref $fiber) (local.get $next_fiber))
                 (then (ref.cast (ref $fiber) (local.get $next_fiber)))
@@ -331,12 +318,10 @@
          (local.tee $cont (call $pop_fiber))
          (struct.get $cont $cont_func (local.get $cont))))
 
-   (func (export "caml_start_fiber")
-      (param $suspender externref) (param $p eqref)
+   (func (export "caml_start_fiber") (param $p eqref)
       ;; Start executing some code in a new fiber
       (local $exn (ref eq))
       (local $res (ref eq))
-      (global.set $current_suspender (local.get $suspender))
       (local.set $res
          (try (result (ref eq))
             (do
@@ -366,7 +351,6 @@
       (struct.new $fiber
          (struct.new $handlers (local.get $hv) (local.get $hx) (local.get $hf))
          (struct.new $cont (ref.func $initial_cont))
-         (ref.null extern)
          (ref.null $fiber)))
 
    ;; Other functions
@@ -414,9 +398,6 @@
                (ref.i31 (global.get $cont_tag))))))
       (i32.const 0))
 
-   (func (export "caml_initialize_effects") (param $s externref)
-      (global.set $current_suspender (local.get $s)))
-
    ;; Effects through CPS transformation
 
    (type $function_2
@@ -749,6 +730,6 @@
             (local.get $ms)))
       (call $raise_unhandled (local.get $eff) (ref.i31 (i32.const 0))))
 
-   (func (export "caml_cps_initialize_effects") (param externref)
+   (func (export "caml_cps_initialize_effects")
       (global.set $caml_trampoline_ref (ref.func $caml_trampoline)))
 )

runtime/wasm/runtime.js

@@ -111,14 +111,11 @@
 
   var start_fiber;
 
-  function wrap_fun(t, f, a) {
-    // Don't wrap if js-promise-integration is not enabled
-    // There is no way to check this without calling WebAssembly.Function
-    try {
-      return new WebAssembly.Function(t, f, a);
-    } catch (e) {
-      return f;
-    }
+  function make_suspending(f) {
+    return WebAssembly?.Suspending ? new WebAssembly.Suspending(f) : f;
+  }
+  function make_promising(f) {
+    return WebAssembly?.promising && f ? WebAssembly.promising(f) : f;
   }
 
   const decoder = new TextDecoder("utf-8", { ignoreBOM: 1 });
@@ -445,11 +442,7 @@
       throw e;
     },
     start_fiber: (x) => start_fiber(x),
-    suspend_fiber: wrap_fun(
-      { parameters: ["externref", "funcref", "eqref"], results: ["eqref"] },
-      (f, env) => new Promise((k) => f(k, env)),
-      { suspending: "first" },
-    ),
+    suspend_fiber: make_suspending((f, env) => new Promise((k) => f(k, env))),
     resume_fiber: (k, v) => k(v),
     weak_new: (v) => new WeakRef(v),
     weak_deref: (w) => {
@@ -553,16 +546,8 @@
   var buffer = caml_buffer?.buffer;
   var out_buffer = buffer && new Uint8Array(buffer, 0, buffer.length);
 
-  start_fiber = wrap_fun(
-    { parameters: ["eqref"], results: ["externref"] },
-    caml_start_fiber,
-    { promising: "first" },
-  );
-  var _initialize = wrap_fun(
-    { parameters: [], results: ["externref"] },
-    _initialize,
-    { promising: "first" },
-  );
+  start_fiber = make_promising(caml_start_fiber);
+  var _initialize = make_promising(_initialize);
   var process = globalThis.process;
   if (process && process.on) {
     process.on("uncaughtException", (err, origin) =>