Update to new JavaScript-Promise Integration API

.github/workflows/build-wasm_of_ocaml.yml

@@ -31,7 +31,7 @@ jobs:
       - name: Install node
         uses: actions/setup-node@v4
         with:
-          node-version: 22
+          node-version: v23.0.0-v8-canary202404260b5958504f
 
       - name: Restore cached binaryen
         id: cache-binaryen

compiler/lib/wasm/wa_gc_target.ml

@@ -1717,26 +1717,23 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
 let post_process_function_body = Wa_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

@@ -71,14 +71,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?WebAssembly.promising(f):f
     }
 
     const decoder = new TextDecoder('utf-8', {ignoreBOM: 1});
@@ -336,10 +333,7 @@
          throw:(e)=>{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"}),
+         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)=>{var v = w.deref(); return v==undefined?null:v},
@@ -419,14 +413,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) =>