Wasm_of_ocaml: make it possible to disable effects with --effects disabled

There can be a significant cost to call a JavaScript function from Wasm
due to stack switching when JSPI is enabled (which will happen with node
25).

Author: vouillon

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -39,16 +39,16 @@ let trim_trailing_dir_sep s =
 
 let normalize_include_dirs dirs = List.map dirs ~f:trim_trailing_dir_sep
 
-let normalize_effects (effects : [ `Cps | `Double_translation ] option) common :
-    Config.effects_backend =
+let normalize_effects (effects : [ `Disabled | `Cps | `Double_translation ] option) common
+    : Config.effects_backend =
   match effects with
   | None ->
       (* For backward compatibility, consider that [--enable effects] alone means
          [--effects cps] *)
       if List.mem ~eq:String.equal "effects" common.Jsoo_cmdline.Arg.optim.enable
       then `Cps
       else `Disabled
-  | Some ((`Cps | `Double_translation) as e) -> (e :> Config.effects_backend)
+  | Some ((`Disabled | `Cps | `Double_translation) as e) -> e
 
 type t =
   { common : Jsoo_cmdline.Arg.t
@@ -273,12 +273,20 @@ let options =
   in
   let effects =
     let doc =
-      "Select an implementation of effect handlers. [$(docv)] should be one of $(b,cps) \
-       or $(b,double-translation). Effects won't be supported if unspecified."
+      "Select an implementation of effect handlers. [$(docv)] should be one of $(b,cps), \
+       $(b,double-translation) or $(b,disabled) (the default). Effects won't be \
+       supported if unspecified."
     in
     Arg.(
       value
-      & opt (some (enum [ "cps", `Cps; "double-translation", `Double_translation ])) None
+      & opt
+          (some
+             (enum
+                [ "cps", `Cps
+                ; "double-translation", `Double_translation
+                ; "disabled", `Disabled
+                ]))
+          None
       & info [ "effects" ] ~docv:"KIND" ~doc)
   in
   let build_t
@@ -543,12 +551,20 @@ let options_runtime_only =
   in
   let effects =
     let doc =
-      "Select an implementation of effect handlers. [$(docv)] should be one of $(b,cps) \
-       or $(b,double-translation). Effects won't be supported if unspecified."
+      "Select an implementation of effect handlers. [$(docv)] should be one of $(b,cps), \
+       $(b,double-translation), or $(b,disabled) (the default). Effects won't be \
+       supported if unspecified."
     in
     Arg.(
       value
-      & opt (some (enum [ "cps", `Cps; "double-translation", `Double_translation ])) None
+      & opt
+          (some
+             (enum
+                [ "cps", `Cps
+                ; "double-translation", `Double_translation
+                ; "disabled", `Disabled
+                ]))
+          None
       & info [ "effects" ] ~docv:"KIND" ~doc)
   in
   let build_t

compiler/bin-wasm_of_ocaml/cmd_arg.ml

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

compiler/bin-wasm_of_ocaml/compile.ml

@@ -90,9 +90,9 @@ let build_runtime ~runtime_file =
     [ ( "effects"
       , Wat_preprocess.String
           (match Config.effects () with
-          | `Jspi -> "jspi"
+          | `Disabled | `Jspi -> "jspi"
           | `Cps -> "cps"
-          | `Disabled | `Double_translation -> assert false) )
+          | `Double_translation -> assert false) )
     ]
   in
   match

compiler/lib-wasm/generate.ml

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

compiler/lib-wasm/link.ml

@@ -533,7 +533,7 @@ let build_runtime_arguments
         [ EVar (Javascript.ident Global_constant.global_object_) ]
         N
   in
-  obj
+  let props : (string * Javascript.expression) list =
     [ ( "link"
       , EArr
           (List.map
@@ -559,6 +559,14 @@ let build_runtime_arguments
     ; "generated", generated_js
     ; "src", EStr (Utf8_string.of_string_exn (Filename.basename wasm_dir))
     ]
+  in
+  let props =
+    match Config.effects () with
+    | `Disabled -> ("disable_effects", Javascript.EBool true) :: props
+    | `Jspi | `Cps -> props
+    | `Double_translation -> assert false
+  in
+  obj props
 
 let source_name i j file =
   let prefix =

compiler/lib/driver.ml

@@ -628,8 +628,9 @@ let optimize ~profile p =
     +> map_fst
          (match Config.target (), Config.effects () with
          | `JavaScript, `Disabled -> Generate_closure.f
-         | `JavaScript, (`Cps | `Double_translation) | `Wasm, (`Jspi | `Cps) -> Fun.id
-         | `JavaScript, `Jspi | `Wasm, (`Disabled | `Double_translation) -> assert false)
+         | `JavaScript, (`Cps | `Double_translation) | `Wasm, (`Disabled | `Jspi | `Cps)
+           -> Fun.id
+         | `JavaScript, `Jspi | `Wasm, `Double_translation -> assert false)
     +> map_fst deadcode'
   in
   if times () then Format.eprintf "Start Optimizing...@.";

runtime/wasm/runtime.js

@@ -18,7 +18,7 @@
 (js) => async (args) => {
   // biome-ignore lint/suspicious/noRedundantUseStrict:
   "use strict";
-  const { link, src, generated } = args;
+  const { link, src, generated, disable_effects } = args;
 
   const isNode = globalThis.process?.versions?.node;
 
@@ -124,7 +124,9 @@
     return WebAssembly?.Suspending ? new WebAssembly.Suspending(f) : f;
   }
   function make_promising(f) {
-    return WebAssembly?.promising && f ? WebAssembly.promising(f) : f;
+    return !disable_effects && WebAssembly?.promising && f
+      ? WebAssembly.promising(f)
+      : f;
   }
 
   const decoder = new TextDecoder("utf-8", { ignoreBOM: 1 });