Wasm native effects (Stack Switching proposal)

.github/workflows/js_of_ocaml.yml

@@ -168,6 +168,19 @@ jobs:
           opam pin add opam-core -n 2.5.1+ox
         if: ${{ endsWith(matrix.ocaml-compiler, '+ox') }}
 
+      # oxcaml-dune-patches pins dune <= 3.21, but the project requires
+      # dune >= 3.23. Re-pin the package with the dune version constraint
+      # stripped — opam re-checks dependency constraints on every install,
+      # so a one-shot --ignore-constraints-on flag isn't enough.
+      - name: Drop dune version constraint from oxcaml-dune-patches (OxCaml)
+        if: ${{ endsWith(matrix.ocaml-compiler, '+ox') }}
+        run: |
+          DIR=$(mktemp -d)
+          opam show --raw oxcaml-dune-patches \
+            | perl -0777 -pe 's/"dune"\s+\{build & \([^)]+\)\}/"dune" {build}/' \
+            > "$DIR/oxcaml-dune-patches.opam"
+          opam pin add oxcaml-dune-patches "$DIR" -k path -n -y
+
       - run: opam install . --deps-only --with-test
         # Install the test dependencies
         if: ${{ !matrix.skip-test }}

.github/workflows/lint.yml

@@ -26,6 +26,7 @@ jobs:
         with:
           token: ${{ github.token }}
       - run: sh tools/make_opam_dune_lint_dir.sh
+      - run: opam pin -n opam-dune-lint --dev-repo
       - uses: ocaml/setup-ocaml/lint-opam@v3
 
   lint-fmt:

.github/workflows/wasm_of_ocaml.yml

@@ -101,7 +101,7 @@ jobs:
       - name: Set-up Node.js
         uses: actions/setup-node@v6
         with:
-          node-version: latest
+          node-version: ${{ matrix.os == 'windows-latest' && 'latest' || 'v26.0.0-v8-canary20260216631fb6e5ef' }}
 
       - name: Set-up OCaml ${{ matrix.ocaml-compiler }}
         uses: ocaml/setup-ocaml@v3
@@ -141,6 +141,19 @@ jobs:
           opam pin add sedlex -n 3.6+ox
         if: ${{ endsWith(matrix.ocaml-compiler, '+ox') }}
 
+      # oxcaml-dune-patches pins dune <= 3.21, but the project requires
+      # dune >= 3.23. Re-pin the package with the dune version constraint
+      # stripped — opam re-checks dependency constraints on every install,
+      # so a one-shot --ignore-constraints-on flag isn't enough.
+      - name: Drop dune version constraint from oxcaml-dune-patches (OxCaml)
+        if: ${{ endsWith(matrix.ocaml-compiler, '+ox') }}
+        run: |
+          DIR=$(mktemp -d)
+          opam show --raw oxcaml-dune-patches \
+            | perl -0777 -pe 's/"dune"\s+\{build & \([^)]+\)\}/"dune" {build}/' \
+            > "$DIR/oxcaml-dune-patches.opam"
+          opam pin add oxcaml-dune-patches "$DIR" -k path -n -y
+
       # Add some packaged to the opam invariant;
       # opam makes wrong choices otherwise
       - name: Hold some packages
@@ -192,6 +205,11 @@ jobs:
         working-directory: ./wasm_of_ocaml
         run: opam exec -- dune build @runtest-wasm --profile with-effects
 
+      - name: Run tests with native effects
+        if: ${{ matrix.ocaml-compiler >= '5.' && matrix.separate_compilation && matrix.os != 'windows-latest' }}
+        working-directory: ./wasm_of_ocaml
+        run: opam exec -- dune build @runtest-wasm --profile with-native-effects
+
       - name: Run Base tests
         if: matrix.all_jane_street_tests
         continue-on-error: ${{ matrix.os == 'windows-latest' }}

CHANGES.md

@@ -14,6 +14,7 @@
 * Lib: add `Performance` module (#2221)
 * Put more values into global variables (#2211)
 * Runtime: intial support for quickjs-ng
+* Wasm_of_ocaml: alternative effect implementation based on the Stack Switching proposal (#2189)
 
 ## Bug fixes
 * Compiler: fix reference unboxing (#2210)

VERSION

@@ -1 +1 @@
-6.3.2
+6.4.0~alpha~dev

compiler/bin-wasm_of_ocaml/cmd_arg.ml

@@ -38,7 +38,7 @@ let trim_trailing_dir_sep s =
 
 let normalize_include_dirs dirs = List.map dirs ~f:trim_trailing_dir_sep
 
-let normalize_effects (effects : [ `Disabled | `Cps | `Jspi ] option) common :
+let normalize_effects (effects : [ `Disabled | `Cps | `Jspi | `Native ] option) common :
     Config.effects_backend =
   match effects with
   | None ->
@@ -47,7 +47,7 @@ let normalize_effects (effects : [ `Disabled | `Cps | `Jspi ] option) common :
       if List.mem ~eq:String.equal "effects" common.Jsoo_cmdline.Arg.optim.enable
       then `Cps
       else `Jspi
-  | Some ((`Disabled | `Cps | `Jspi) as e) -> e
+  | Some ((`Disabled | `Cps | `Jspi | `Native) as e) -> e
 
 type t =
   { common : Jsoo_cmdline.Arg.t
@@ -182,11 +182,15 @@ let options () =
   let effects =
     let doc =
       "Select an implementation of effect handlers. [$(docv)] should be one of $(b,jspi) \
-       (the default), $(b,cps), or $(b,disabled)."
+       (the default), $(b,cps), $(b,native) or $(b,disabled)."
     in
     Arg.(
       value
-      & opt (some (enum [ "jspi", `Jspi; "cps", `Cps; "disabled", `Disabled ])) None
+      & opt
+          (some
+             (enum
+                [ "jspi", `Jspi; "cps", `Cps; "native", `Native; "disabled", `Disabled ]))
+          None
       & info [ "effects" ] ~docv:"KIND" ~doc)
   in
   let build_t
@@ -330,11 +334,15 @@ let options_runtime_only () =
   let effects =
     let doc =
       "Select an implementation of effect handlers. [$(docv)] should be one of $(b,jspi) \
-       (the default), $(b,cps), or $(b,disabled)."
+       (the default), $(b,cps), $(b,native) or $(b,disabled)."
     in
     Arg.(
       value
-      & opt (some (enum [ "jspi", `Jspi; "cps", `Cps; "disabled", `Disabled ])) None
+      & opt
+          (some
+             (enum
+                [ "jspi", `Jspi; "cps", `Cps; "native", `Native; "disabled", `Disabled ]))
+          None
       & info [ "effects" ] ~docv:"KIND" ~doc)
   in
   let build_config = Jsoo_cmdline.Arg.build_config in

compiler/bin-wasm_of_ocaml/compile.ml

@@ -83,6 +83,7 @@ let preprocessor_variables () =
         (match Config.effects () with
         | `Disabled | `Jspi -> "jspi"
         | `Cps -> "cps"
+        | `Native -> "native"
         | `Double_translation -> assert false) )
   ]
 

compiler/bin-wasm_of_ocaml/link_wasm.ml

@@ -32,6 +32,7 @@ type options =
   ; variables : Preprocess.variables
   ; allowed_imports : string list option
   ; binaryen_options : binaryen_options
+  ; effects_backend : Js_of_ocaml_compiler.Config.effects_backend
   }
 
 let options =
@@ -71,13 +72,30 @@ let options =
     let allowed_imports =
       if List.is_empty allowed_imports then None else Some (List.concat allowed_imports)
     in
-    `Ok
-      { input_modules
-      ; output_file
-      ; variables
-      ; allowed_imports
-      ; binaryen_options = { common; opt; merge }
-      }
+    let effects_backend =
+      match
+        List.find_map
+          ~f:(fun (k, v) -> if String.equal k "effects" then Some v else None)
+          variables.Preprocess.set
+      with
+      | Some "native" -> Ok (`Native : Js_of_ocaml_compiler.Config.effects_backend)
+      | Some "cps" -> Ok `Cps
+      | Some "jspi" | None -> Ok `Jspi
+      | Some "double-translation" -> Ok `Double_translation
+      | Some "disabled" -> Ok `Disabled
+      | Some other -> Error other
+    in
+    match effects_backend with
+    | Ok effects_backend ->
+        `Ok
+          { input_modules
+          ; output_file
+          ; variables
+          ; allowed_imports
+          ; binaryen_options = { common; opt; merge }
+          ; effects_backend
+          }
+    | Error other -> `Error (false, Printf.sprintf "unknown effects backend %s" other)
   in
   let t =
     Term.(
@@ -98,7 +116,11 @@ let link
     ; variables
     ; allowed_imports
     ; binaryen_options = { common; merge; opt }
+    ; effects_backend
     } =
+  (* So that the --enable-stack-switching option is passed to Binaryen
+     tools for native effects. *)
+  Js_of_ocaml_compiler.Config.set_effects_backend effects_backend;
   let inputs =
     List.map
       ~f:(fun (module_name, file) -> { Wat_preprocess.module_name; file; source = File })

compiler/lib-wasm/binaryen.ml

@@ -40,6 +40,11 @@ let common_options () =
     ; "--enable-strings"
     ]
   in
+  let l =
+    match Config.effects () with
+    | `Native -> "--enable-stack-switching" :: l
+    | `Disabled | `Jspi | `Cps | `Double_translation -> l
+  in
   let l = if Config.Flag.pretty () then "-g" :: l else l in
   let l = if times () then "--no-validation" :: l else l in
   l

compiler/lib-wasm/generate.ml

@@ -26,7 +26,7 @@ let times = Debug.find "times"
 let effects_cps () =
   match Config.effects () with
   | `Cps -> true
-  | `Disabled | `Jspi -> false
+  | `Disabled | `Jspi | `Native -> false
   | `Double_translation -> assert false
 
 module Generate (Target : Target_sig.S) = struct

compiler/lib-wasm/link.ml

@@ -193,7 +193,20 @@ module Wasm_binary = struct
 
   let reftype' i ch =
     match i with
-    | 0x6a | 0x6b | 0x6c | 0x6d | 0x6e | 0x6f | 0x70 | 0x71 | 0x72 | 0x73 -> ()
+    | 0x68
+    | 0x69
+    | 0x6a
+    | 0x6b
+    | 0x6c
+    | 0x6d
+    | 0x6e
+    | 0x6f
+    | 0x70
+    | 0x71
+    | 0x72
+    | 0x73
+    | 0x74
+    | 0x75 -> ()
     | 0x63 | 0x64 -> heaptype ch
     | _ ->
         Format.eprintf "Unknown reftype %x@." i;
@@ -550,7 +563,7 @@ let build_runtime_arguments
   let props =
     match Config.effects () with
     | `Disabled -> ("disable_effects", Javascript.EBool true) :: props
-    | `Jspi | `Cps -> props
+    | `Jspi | `Cps | `Native -> props
     | `Double_translation -> assert false
   in
   let props =