Fix Dynlink and limit use of --enable=effects

README.md

@@ -92,7 +92,8 @@ optimized:
   [More](http://ocsigen.org/js_of_ocaml/dev/manual/tailcall) about tail call
   optimization.
 
-Effect handlers are supported with the `--enable=effects` flag.
+Effect handlers are supported with the `--effects={cps,double-translation}`
+flag.
 
 ## Data representation
 

README_wasm_of_ocaml.md

@@ -13,8 +13,8 @@ In particular, the output code requires the following [Wasm extensions](https://
 
 OCaml 5.x code using effect handlers can be compiled in two different ways:
 One can enable the CPS transformation from `js_of_ocaml` by passing the
-`--enable=effects` flag. Without the flag `wasm_of_ocaml` will instead emit code
-utilizing
+`--effects=cps` flag. Without the flag `wasm_of_ocaml` will instead default to
+`--effects=jspi` and emit code utilizing
 - [the JavaScript-Promise Integration extension](https://github.com/WebAssembly/js-promise-integration/blob/main/proposals/js-promise-integration/Overview.md)
 
 

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -514,6 +514,20 @@ let options_runtime_only =
       & opt (some string) None
       & info [ "ofs" ] ~docs:filesystem_section ~docv:"FILE" ~doc)
   in
+  let effects =
+    let doc =
+      "Select an implementation of effect handlers. [$(docv)] should be one of $(b,cps) \
+       or $(b,double-translation). Effects are not allowed by default."
+    in
+    Arg.(
+      value
+      & opt
+          (some
+             (enum
+                [ "cps", Config.Cps; "double-translation", Double_translation ]))
+          None
+      & info [ "effects" ] ~docv:"KIND" ~doc)
+  in
   let build_t
       common
       toplevel
@@ -533,7 +547,8 @@ let options_runtime_only =
       sourcemap_root
       target_env
       output_file
-      js_files =
+      js_files
+      effects =
     let inline_source_content = not sourcemap_don't_inline_content in
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
     let runtime_files = js_files in
@@ -585,7 +600,7 @@ let options_runtime_only =
       ; bytecode = `None
       ; source_map
       ; keep_unit_names = false
-      ; effects = None
+      ; effects
       }
   in
   let t =
@@ -609,6 +624,7 @@ let options_runtime_only =
       $ sourcemap_root
       $ target_env
       $ output_file
-      $ js_files)
+      $ js_files
+      $ effects)
   in
   Term.ret t

compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml

@@ -39,7 +39,12 @@ let () =
   | Sys.(Native | Bytecode | Other _) -> failwith "Expected backend `js_of_ocaml`");
   let global = J.pure_js_expr "globalThis" in
   Config.Flag.set "use-js-string" (Jsoo_runtime.Sys.Config.use_js_string ());
-  Config.Flag.set "effects" (Jsoo_runtime.Sys.Config.effects ());
+  Config.set_effects_backend
+    (match Jsoo_runtime.Sys.Config.effects () with
+    | None -> None
+    | Some Jsoo_runtime.Sys.Config.Cps -> Some Config.Cps
+    | Some Jsoo_runtime.Sys.Config.Double_translation -> Some Config.Double_translation
+    );
   Linker.reset ();
   (* this needs to stay synchronized with toplevel.js *)
   let toplevel_compile (s : string) (debug : Instruct.debug_event list array) :

compiler/lib-runtime-files/gen/gen.ml

@@ -48,7 +48,11 @@ let rec list_product l =
       let tail = list_product xs in
       List.concat_map values ~f:(fun v -> List.map tail ~f:(fun l -> (key, v) :: l))
 
-let bool = [ true; false ]
+let bool = [ `Bool true; `Bool false ]
+
+let effects_backends =
+  let open Js_of_ocaml_compiler.Config in
+  [ `Effects None; `Effects (Some Cps); `Effects (Some Double_translation) ]
 
 let () =
   Js_of_ocaml_compiler.Config.set_target `JavaScript;
@@ -60,11 +64,13 @@ let () =
       let fragments =
         List.map rest ~f:(fun f -> f, Js_of_ocaml_compiler.Linker.Fragment.parse_file f)
       in
-      let variants = list_product [ "use-js-string", bool; "effects", bool ] in
+      let variants = list_product [ "use-js-string", bool; "effects", effects_backends ] in
       (* load all files to make sure they are valid *)
       List.iter variants ~f:(fun setup ->
-          List.iter setup ~f:(fun (name, b) ->
-              Js_of_ocaml_compiler.Config.Flag.set name b);
+          List.iter setup ~f:(fun (name, v) ->
+              match v with
+              | `Bool b -> Js_of_ocaml_compiler.Config.Flag.set name b
+              | `Effects b -> Js_of_ocaml_compiler.Config.set_effects_backend b);
           List.iter Js_of_ocaml_compiler.Target_env.all ~f:(fun target_env ->
               Js_of_ocaml_compiler.Linker.reset ();
               List.iter fragments ~f:(fun (filename, frags) ->

compiler/lib/generate.ml

@@ -1413,7 +1413,7 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t
             then (
               warn
                 "Warning: your program contains effect handlers; you should probably run \
-                 js_of_ocaml with option '--enable=effects'@.";
+                 js_of_ocaml with option '--effects=cps'@.";
               ctx.effect_warning := true);
             let name = "jsoo_effect_not_supported" in
             let prim = Share.get_prim (runtime_fun ctx) name ctx.Ctx.share in

compiler/lib/link_js.ml

@@ -343,7 +343,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
                     warn_effects := true;
                     warn
                       "Warning: your program contains effect handlers; you should \
-                       probably run js_of_ocaml with option '--enable=effects'@.");
+                       probably run js_of_ocaml with option '--effects=cps'@.");
                   (if mklib
                    then
                      let u = if linkall then { u with force_link = true } else u in

compiler/tests-compiler/direct_calls.ml

@@ -18,7 +18,7 @@
 
 open Util
 
-let%expect_test "direct calls without --enable effects" =
+let%expect_test "direct calls without --effects=cps" =
   let code =
     compile_and_parse
       {|
@@ -99,7 +99,7 @@ let%expect_test "direct calls without --enable effects" =
     }
     //end |}]
 
-let%expect_test "direct calls with --enable effects" =
+let%expect_test "direct calls with --effects=cps" =
   let code =
     compile_and_parse
       ~effects:true

compiler/tests-ocaml/lib-effects/double-translation/dune

@@ -1,5 +1,5 @@
 (env
- (using-effects
+ (with-effects
   (flags
    (:standard -w -38))
   (js_of_ocaml
@@ -10,14 +10,17 @@
    ;; separate compilation doesn't work when using
    ;; features such as 'effects', 'doubletranslate' or 'use-js-string'
    ;; because dune doesn't know that it should compile
-   ;; multiple versions of the dependencies
+   ;; multiple versions of the dependencies as is doesn't know about
+   ;; '--effects=double-translation'.
    (compilation_mode whole_program)))
  (_
   (flags
    (:standard -w -38))
   (js_of_ocaml
    (flags
     (:standard --effects=double-translation))
+   (build_runtime_flags
+    (:standard --effects=double-translation))
    ;; separate compilation doesn't work when using
    ;; features such as 'effects' or 'use-js-string'
    ;; because dune doesn't know that it should compile

compiler/tests-ocaml/lib-effects/dune

@@ -4,7 +4,9 @@
    (:standard -w -38))
   (js_of_ocaml
    (flags
-    (:standard --enable effects)))))
+    (:standard --enable=effects))
+   (build_runtime_flags
+     (:standard --enable=effects)))))
 
 (tests
  (build_if

lib/runtime/jsoo_runtime.ml

@@ -127,7 +127,16 @@ module Sys = struct
   module Config = struct
     external use_js_string : unit -> bool = "caml_jsoo_flags_use_js_string"
 
-    external effects : unit -> bool = "caml_jsoo_flags_effects"
+    type effects_backend = Cps | Double_translation
+
+    external effects_ : unit -> string = "caml_jsoo_flags_effects"
+
+    let effects () =
+      match effects_ () with
+      | "none" -> None
+      | "cps" -> Some Cps
+      | "double-translation" -> Some Double_translation
+      | _ -> assert false
   end
 
   let version = Runtime_version.s

manual/effects.wiki

@@ -1,7 +1,7 @@
 == Effect handlers ==
 
-Js_of_ocaml supports effect handlers with the {{{--enable=effects}}}
-flag. This is based on partially transforming the program to
+Js_of_ocaml supports effect handlers with the {{{--effects={cps,double-translation}}}}
+flag. The {{cps}} option is based on partially transforming the program to
 continuation-passing style.
 As a consequence, [[tailcall|tail calls]] are also fully optimized.
 This is not the default for now since the generated code can be slower,
@@ -11,6 +11,8 @@ The analysis is especially effective on monomorphic code. It is not so effective
 We hope to improve on this by trying alternative compilation
 strategies.
 
+The {{double-translation}} option does a similar CPS transform, but also keeps a direct-style version of the transformed functions. The choice of running the CPS version is delayed to run time. Since CPS code is usually slower, this can avoid degradations. In addition, one can ensure that some code is run in direct style by using {{Js_of_ocaml.Js.assume_no_perform}}.
+
 === Dune integration ===
 
 We're still working on dune support for compiling js_of_ocaml programs
@@ -25,7 +27,7 @@ Put the following in a {{{dune}}} (or {{{dune-workspace}}}) file at the root of
 (env
  (_
   (js_of_ocaml
-   (flags (:standard --enable effects))
+   (flags (:standard --effects=cps))
    (build_runtime_flags (:standard --enable effects)))))
 }}}
 
@@ -50,7 +52,7 @@ Then pass the rights {{{js_of_ocaml}}} flags to the executable stanza
 {{{
 (executable
   (name main)
-  (js_of_ocaml (flags (:standard --enable effects)))
+  (js_of_ocaml (flags (:standard --effects=cps)))
 )
 }}}
 

manual/overview.wiki

@@ -84,7 +84,11 @@ functions are optimized:
   * trampolines are used otherwise.
 <<a_manual chapter="tailcall" |More about tail call optimization>>.
 
-Effect handlers are fully supported with the {{{--enable=effects}}} flag. This is not the default for now since effects are not widely used at the moment and the generated code can be slower, larger and less readable.
+Effect handlers are fully supported with the
+{{{--effects={cps,double-translation}}}} flag. Effect support is disabled by
+default for now since effects are not widely used at the moment and the
+generated code can be slower, larger and less readable. See the dedicated
+manual section about effects for details.
 
 Data representation differs from the usual one. Most notably,
 integers are 32 bits (rather than 31 bits or 63 bits), which is their

manual/tailcall.wiki

@@ -3,7 +3,7 @@ JavaScript does not (yet) support tail call optimization.
 To circumvent this limitation, and mitigate stack overflows, the Js_of_ocaml
 compiler optimizes some common tail call patterns.
 Besides, all tail calls are optimized when you set the flag
-{{{--enable=effects}}}, at the cost of some performance degradation.
+{{{--effects=cps}}}, at the cost of some performance degradation.
 
 === Self tail recursive
 Self tail recursive function are compiled into a loop.

runtime/js/jslib.js

@@ -139,8 +139,23 @@ function caml_jsoo_flags_use_js_string(unit) {
 }
 
 //Provides: caml_jsoo_flags_effects
+//If: !effects
+function caml_jsoo_flags_effects(unit) {
+  return "none";
+}
+
+//Provides: caml_jsoo_flags_effects
+//If: effects
+//If: !doubletranslate
+function caml_jsoo_flags_effects(unit) {
+  return "cps";
+}
+
+//Provides: caml_jsoo_flags_effects
+//If: effects
+//If: doubletranslate
 function caml_jsoo_flags_effects(unit) {
-  return FLAG("effects");
+  return "double-translation";
 }
 
 //Provides: caml_wrap_exception const (mutable)