diff --git a/.github/workflows/js_of_ocaml.yml b/.github/workflows/js_of_ocaml.yml index d123e315bc..988277ff7b 100644 --- a/.github/workflows/js_of_ocaml.yml +++ b/.github/workflows/js_of_ocaml.yml @@ -24,7 +24,6 @@ jobs: ocaml-name: - "" ocaml-compiler: - - "4.13" - "5.0" - "5.1" - "5.2" diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml index 00cdd669fe..714b254e23 100644 --- a/.github/workflows/lint.yml +++ b/.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: diff --git a/.github/workflows/wasm_of_ocaml.yml b/.github/workflows/wasm_of_ocaml.yml index 6be447a240..077e265634 100644 --- a/.github/workflows/wasm_of_ocaml.yml +++ b/.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 @@ -183,6 +183,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' }} diff --git a/CHANGES.md b/CHANGES.md index e7481e2973..80245009f2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -10,6 +10,7 @@ * Compiler: improved shape computation (#2198) * Add the --build-config and --apply-build-config flags (#2177) * Runtime/wasm: optimized some bigstring primitives (#2144) +* Wasm_of_ocaml: alternative effect implementation based on the Stack Switching proposal (#2189) ## Bug fixes * Compiler: fix reference unboxing (#2210) diff --git a/CLAUDE.md b/CLAUDE.md index e3455ec5e9..51a9802692 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -80,7 +80,7 @@ opam install odoc lwt_log yojson ocp-indent graphics higlo ``` **Requirements:** -- OCaml 4.13 to 5.4 +- OCaml 4.14 to 5.4 - Dune 3.19+ - For wasm_of_ocaml: Binaryen 119+ diff --git a/VERSION b/VERSION index 91e4a9f262..ed2ca09d46 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -6.3.2 +6.4.0~alpha~dev diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml index e6c8602f6b..15df070b82 100644 --- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml +++ b/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 diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml index 73d6df565b..5a3b3e1702 100644 --- a/compiler/bin-wasm_of_ocaml/compile.ml +++ b/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) ) ] diff --git a/compiler/bin-wasm_of_ocaml/link_wasm.ml b/compiler/bin-wasm_of_ocaml/link_wasm.ml index 07032da073..47e185b2f2 100644 --- a/compiler/bin-wasm_of_ocaml/link_wasm.ml +++ b/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 }) diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml index 1089330ef2..0420f95aa9 100644 --- a/compiler/lib-wasm/binaryen.ml +++ b/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 diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index 9a049ab9aa..65b215cf56 100644 --- a/compiler/lib-wasm/generate.ml +++ b/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 diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml index 6df7065435..04661f1940 100644 --- a/compiler/lib-wasm/link.ml +++ b/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 = diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml index 8502268a11..02fa54e1ca 100644 --- a/compiler/lib-wasm/wasm_link.ml +++ b/compiler/lib-wasm/wasm_link.ml @@ -23,6 +23,10 @@ type heaptype = | Nofunc | Extern | Noextern + | Exn + | Noexn + | Cont + | Nocont | Any | Eq | I31 @@ -66,6 +70,7 @@ type comptype = } | Struct of fieldtype array | Array of fieldtype + | Cont of int type subtype = { final : bool @@ -164,6 +169,8 @@ module Write = struct let heaptype st ch typ = match (typ : heaptype) with + | Nocont -> byte ch 0x75 + | Noexn -> byte ch 0x74 | Nofunc -> byte ch 0x73 | Noextern -> byte ch 0x72 | None_ -> byte ch 0x71 @@ -174,6 +181,8 @@ module Write = struct | I31 -> byte ch 0x6C | Struct -> byte ch 0x6B | Array -> byte ch 0x6A + | Exn -> byte ch 0x69 + | Cont -> byte ch 0x68 | Type idx -> sint ch (typeidx st idx) let reftype st ch { nullable; typ } = @@ -219,6 +228,9 @@ module Write = struct byte ch 1; uint ch (typeidx st supertype)); match typ with + | Cont idx -> + byte ch 0x5D; + sint ch (typeidx st idx) | Array field_type -> byte ch 0x5E; fieldtype st ch field_type @@ -571,7 +583,9 @@ module Read = struct let heaptype st ch = let i = sint ch in match i + 128 with - | 0X73 -> Nofunc + | 0x75 -> Nocont + | 0x74 -> Noexn + | 0x73 -> Nofunc | 0x72 -> Noextern | 0x71 -> None_ | 0x70 -> Func @@ -581,6 +595,8 @@ module Read = struct | 0x6C -> I31 | 0x6B -> Struct | 0x6A -> Array + | 0x69 -> Exn + | 0x68 -> Cont | _ -> if i < 0 then failwith (Printf.sprintf "Unknown heaptype %x@." i); let i = @@ -598,7 +614,9 @@ module Read = struct let reftype' st i ch = match i with - | 0X73 -> nullable Nofunc + | 0x75 -> nullable Nocont + | 0x74 -> nullable Noexn + | 0x73 -> nullable Nofunc | 0x72 -> nullable Noextern | 0x71 -> nullable None_ | 0x70 -> nullable Func @@ -608,6 +626,8 @@ module Read = struct | 0x6C -> nullable I31 | 0x6B -> nullable Struct | 0x6A -> nullable Array + | 0x69 -> nullable Exn + | 0x68 -> nullable Cont | 0x63 -> nullable (heaptype st ch) | 0x64 -> { nullable = false; typ = heaptype st ch } | _ -> failwith (Printf.sprintf "Unknown reftype %x@." i) @@ -654,6 +674,14 @@ module Read = struct let comptype st i ch = match i with + | 0x5D -> + let i = sint ch in + let i = + if i >= st.type_index_count + then lnot (i - st.type_index_count) + else st.type_mapping.(i) + in + Cont i | 0x5E -> Array (fieldtype st ch) | 0x5F -> Struct (vec (fieldtype st) ch) | 0x60 -> @@ -1260,6 +1288,13 @@ module Scan = struct | 0xD1 (* ref.is_null *) | 0xD3 (* ref.eq *) | 0xD4 (* ref.as_non_null *) -> pos + 1 |> instructions | 0xD2 (* ref.func *) -> pos + 1 |> funcidx |> instructions + | 0xE0 (* cont.new *) -> pos + 1 |> typeidx |> instructions + | 0xE1 (* cont.bind *) -> pos + 1 |> typeidx |> typeidx |> instructions + | 0xE2 (* suspend *) -> pos + 1 |> tagidx |> instructions + | 0xE3 (* resume *) -> pos + 1 |> typeidx |> vector on_clause |> instructions + | 0xE4 (* resume_throw *) -> + pos + 1 |> typeidx |> tagidx |> vector on_clause |> instructions + | 0xE5 (* switch *) -> pos + 1 |> typeidx |> tagidx |> instructions | 0xFB -> pos + 1 |> gc_instruction | 0xFC -> ( if debug then Format.eprintf " %d@." (get (pos + 1)); @@ -1393,7 +1428,12 @@ module Scan = struct match get pos with | 0 (* catch *) | 1 (* catch_ref *) -> pos + 1 |> tagidx |> labelidx | 2 (* catch_all *) | 3 (* catch_all_ref *) -> pos + 1 |> labelidx - | c -> failwith (Printf.sprintf "bad catch 0x02%d@." c) + | c -> failwith (Printf.sprintf "bad catch 0x%02x@." c) + and on_clause pos = + match get pos with + | 0 (* on *) -> pos + 1 |> tagidx |> labelidx + | 1 (* on .. switch *) -> pos + 1 |> tagidx + | c -> failwith (Printf.sprintf "bad on clause 0x%02x@." c) and block_end pos = if debug then Format.eprintf "0x%02X (@%d) block end@." (get pos) pos; match get pos with @@ -1552,6 +1592,10 @@ let heap_subtype (subtyping_info : subtype array) (ty : heaptype) (ty' : heaptyp | Nofunc, Nofunc | (Extern | Noextern), Extern | Noextern, Noextern + | (Exn | Noexn), Exn + | Noexn, Noexn + | (Cont | Nocont), Cont + | Nocont, Nocont | (Any | Eq | I31 | Struct | Array | None_), Any | (Eq | I31 | Struct | Array | None_), Eq | (I31 | None_), I31 @@ -1561,27 +1605,35 @@ let heap_subtype (subtyping_info : subtype array) (ty : heaptype) (ty' : heaptyp | Type i, (Any | Eq) -> ( match subtyping_info.(i).typ with | Struct _ | Array _ -> true - | Func _ -> false) + | Func _ | Cont _ -> false) | Type i, Struct -> ( match subtyping_info.(i).typ with | Struct _ -> true - | Array _ | Func _ -> false) + | Array _ | Func _ | Cont _ -> false) | Type i, Array -> ( match subtyping_info.(i).typ with | Array _ -> true - | Struct _ | Func _ -> false) + | Struct _ | Func _ | Cont _ -> false) | Type i, Func -> ( match subtyping_info.(i).typ with | Func _ -> true - | Struct _ | Array _ -> false) + | Struct _ | Array _ | Cont _ -> false) + | Type i, Cont -> ( + match subtyping_info.(i).typ with + | Cont _ -> true + | Struct _ | Array _ | Func _ -> false) | None_, Type i -> ( match subtyping_info.(i).typ with | Struct _ | Array _ -> true - | Func _ -> false) + | Func _ | Cont _ -> false) | Nofunc, Type i -> ( match subtyping_info.(i).typ with | Func _ -> true - | Struct _ | Array _ -> false) + | Struct _ | Array _ | Cont _ -> false) + | Nocont, Type i -> ( + match subtyping_info.(i).typ with + | Cont _ -> true + | Struct _ | Array _ | Func _ -> false) | Type i, Type i' -> subtype subtyping_info i i' | _ -> false @@ -2465,7 +2517,6 @@ let f files ~output_file = (* LATER - testsuite : import/export matching, source maps, multiple start functions, ... -- missing instructions ==> typed continuations (?) - check features? MAYBE diff --git a/compiler/lib/build_info.ml b/compiler/lib/build_info.ml index eba95dfd9e..7ce27c1831 100644 --- a/compiler/lib/build_info.ml +++ b/compiler/lib/build_info.ml @@ -41,12 +41,14 @@ let string_of_effects_backend : Config.effects_backend -> string = function | `Cps -> "cps" | `Double_translation -> "double-translation" | `Jspi -> "jspi" + | `Native -> "native" let effects_backend_of_string = function | "disabled" -> `Disabled | "cps" -> `Cps | "double-translation" -> `Double_translation | "jspi" -> `Jspi + | "native" -> `Native | _ -> invalid_arg "effects_backend_of_string" type config_key = @@ -73,7 +75,7 @@ let config_keys target = ( [ "disabled"; "cps"; "double-translation" ] , fun () -> string_of_effects_backend (Config.effects ()) ) | `Wasm -> - ( [ "disabled"; "cps"; "jspi" ] + ( [ "disabled"; "cps"; "jspi"; "native" ] , fun () -> string_of_effects_backend (Config.effects ()) ) in [ Enum_key diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml index 69db92887d..e95dd673ce 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -236,6 +236,7 @@ type effects_backend = | `Cps | `Double_translation | `Jspi + | `Native ] let effects_ : [< `None | effects_backend ] ref = ref `None @@ -243,7 +244,7 @@ let effects_ : [< `None | effects_backend ] ref = ref `None let effects () = match !effects_ with | `None -> failwith "effects was not set" - | (`Jspi | `Cps | `Disabled | `Double_translation) as b -> b + | (`Jspi | `Cps | `Native | `Disabled | `Double_translation) as b -> b let set_effects_backend (backend : effects_backend) = effects_ := (backend :> [ `None | effects_backend ]) diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli index 2a540f68bc..d9f0fe2a4b 100644 --- a/compiler/lib/config.mli +++ b/compiler/lib/config.mli @@ -128,6 +128,7 @@ type effects_backend = | `Cps | `Double_translation | `Jspi + | `Native ] val effects : unit -> effects_backend diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index 5573acae27..bb712eee16 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -178,7 +178,7 @@ let effects_and_exact_calls | `JavaScript -> Lambda_lifting.f p in p, trampolined_calls, in_cps, None, shapes - | `Disabled | `Jspi -> + | `Disabled | `Jspi | `Native -> let p = Specialize.f ~shape:(fun f -> @@ -719,9 +719,9 @@ let optimize ~shapes ~profile ~keep_flow_data p = +> map_fst5 (match Config.target (), Config.effects () with | `JavaScript, `Disabled -> Generate_closure.f - | `JavaScript, (`Cps | `Double_translation) | `Wasm, (`Disabled | `Jspi | `Cps) - -> Fun.id - | `JavaScript, `Jspi | `Wasm, `Double_translation -> assert false) + | `JavaScript, (`Cps | `Double_translation) + | `Wasm, (`Disabled | `Jspi | `Cps | `Native) -> Fun.id + | `JavaScript, (`Jspi | `Native) | `Wasm, `Double_translation -> assert false) +> map_fst5 deadcode' in if times () then Format.eprintf "Start Optimizing...@."; diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml index fbb90c9aa4..d5e1b9dfdf 100644 --- a/compiler/lib/effects.ml +++ b/compiler/lib/effects.ml @@ -40,7 +40,7 @@ let debug = Debug.find "effects" let double_translate () = match Config.effects () with - | `Disabled | `Jspi -> assert false + | `Disabled | `Jspi | `Native -> assert false | `Cps -> false | `Double_translation -> true diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index 123a2279b2..647b19545a 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -28,7 +28,7 @@ let cps_transform () = match Config.effects () with | `Cps | `Double_translation -> true | `Disabled -> false - | `Jspi -> assert false + | `Jspi | `Native -> assert false open Code module J = Javascript @@ -1092,7 +1092,7 @@ let apply_fun_raw = (* Effects enabled, CPS version, not single-version *) J.EDot (f, J.ANormal, cps_field) | `Cps | `Double_translation | `Disabled -> f - | `Jspi -> assert false + | `Jspi | `Native -> assert false in (* We skip the arity check when we know that we have the right number of parameters, since this test is expensive. *) @@ -1119,7 +1119,7 @@ let apply_fun_raw = (match Config.effects () with | `Double_translation when cps -> "caml_call_gen_cps" | `Double_translation | `Cps | `Disabled -> "caml_call_gen" - | `Jspi -> assert false)) + | `Jspi | `Native -> assert false)) [ f; J.array params ] J.N ) in @@ -1135,7 +1135,7 @@ let apply_fun_raw = [ apply ~cps:false f (fst (List.take (n - 1) params)) ] J.N ) | `Double_translation | `Cps | `Disabled -> apply ~cps f params - | `Jspi -> assert false + | `Jspi | `Native -> assert false in if trampolined then ( diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml index 659a5a6479..34bc2b775f 100644 --- a/compiler/lib/generate_closure.ml +++ b/compiler/lib/generate_closure.ml @@ -337,7 +337,7 @@ let f p : Code.program = let f p = assert ( match Config.effects () with - | `Disabled | `Jspi -> true + | `Disabled | `Jspi | `Native -> true | `Cps | `Double_translation -> false); let open Config.Param in match tailcall_optim () with diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml index 6da3837a9f..f7546a58e8 100644 --- a/compiler/lib/inline.ml +++ b/compiler/lib/inline.ml @@ -454,7 +454,7 @@ and should_inline ~context info args = || (not (Lazy.force !(context.has_closures))) && Option.equal Var.equal info.enclosing_function context.enclosing_function | `Wasm, _ | `JavaScript, `Double_translation -> true - | `JavaScript, `Jspi -> assert false) + | `JavaScript, (`Jspi | `Native) -> assert false) && (functor_like ~context info || (context.live_vars.(Var.idx info.f) = 1 && diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index 47b7d44f51..3b33f9c80a 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -2229,7 +2229,7 @@ let program ?(accept_unnamed_var = false) ?(source_map = false) f p = PP.set_needed_space_function f need_space; (match Config.effects () with | `Cps | `Double_translation -> PP.set_adjust_indentation_function f (fun n -> n mod 40) - | `Disabled | `Jspi | (exception Failure _) -> ()); + | `Disabled | `Jspi | `Native | (exception Failure _) -> ()); PP.start_group f 0; O.program f p; PP.end_group f; diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml index 1fbc0f90ed..d17823cb60 100644 --- a/compiler/lib/linker.ml +++ b/compiler/lib/linker.ml @@ -205,13 +205,13 @@ module Fragment = struct ; ( "effects" , fun () -> match Config.effects () with - | `Disabled | `Jspi -> false + | `Disabled | `Jspi | `Native -> false | `Cps | `Double_translation -> true ) ; ( "doubletranslate" , fun () -> match Config.effects () with | `Double_translation -> true - | `Jspi | `Cps | `Disabled -> false ) + | `Jspi | `Cps | `Native | `Disabled -> false ) ; ( "wasm" , fun () -> match Config.target () with diff --git a/compiler/lib/magic_number.ml b/compiler/lib/magic_number.ml index 403280afc0..1bd4478e59 100644 --- a/compiler/lib/magic_number.ml +++ b/compiler/lib/magic_number.ml @@ -66,8 +66,8 @@ let equal a b = compare a b = 0 let () = let current = Ocaml_version.current in - if Ocaml_version.compare current [ 4; 13 ] < 0 - then failwith "OCaml version unsupported. Upgrade to OCaml 4.13 or newer." + if Ocaml_version.compare current [ 4; 14 ] < 0 + then failwith "OCaml version unsupported. Upgrade to OCaml 4.14 or newer." else if Ocaml_version.compare current [ 5; 6 ] >= 0 then failwith "OCaml version unsupported. Upgrade js_of_ocaml." diff --git a/compiler/lib/partial_cps_analysis.ml b/compiler/lib/partial_cps_analysis.ml index df7eeb8fcd..bc92f52965 100644 --- a/compiler/lib/partial_cps_analysis.ml +++ b/compiler/lib/partial_cps_analysis.ml @@ -24,7 +24,7 @@ let times = Debug.find "times" let double_translate () = match Config.effects () with - | `Disabled | `Jspi -> assert false + | `Disabled | `Jspi | `Native -> assert false | `Cps -> false | `Double_translation -> true diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml index 2d19410f84..ecbba2d1e5 100644 --- a/compiler/lib/specialize_js.ml +++ b/compiler/lib/specialize_js.ml @@ -553,7 +553,7 @@ let f_once_after p = match Config.target (), Config.effects () with | `JavaScript, `Disabled -> true | `JavaScript, (`Cps | `Double_translation) | `Wasm, _ -> false - | `JavaScript, `Jspi -> assert false + | `JavaScript, (`Jspi | `Native) -> assert false in let f = function | Let (x, Closure (l, (pc, []), _)) as i -> ( diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml index f5f52459aa..84e351e3a9 100644 --- a/compiler/lib/unit_info.ml +++ b/compiler/lib/unit_info.ml @@ -56,7 +56,7 @@ let of_cmo (cmo : Ocaml_compiler.Cmo_format.t) = let requires = Global_name.Compunit_set.diff requires provides in let effects_without_cps = (match Config.effects () with - | `Disabled | `Jspi -> true + | `Disabled | `Jspi | `Native -> true | `Cps | `Double_translation -> false) && List.exists (Cmo_format.primitives cmo) ~f:(function | "%resume" | "%reperform" | "%perform" -> true diff --git a/compiler/tests-check-prim/gen_dune.ml b/compiler/tests-check-prim/gen_dune.ml index 471d2bae1a..78bde85519 100644 --- a/compiler/tests-check-prim/gen_dune.ml +++ b/compiler/tests-check-prim/gen_dune.ml @@ -1,8 +1,7 @@ (** *) type version = - [ `V4_13 - | `V4_14 + [ `V4_14 | `V5_0 | `V5_1 | `V5_2 @@ -18,7 +17,6 @@ type variant = ] let string_of_version : version -> string = function - | `V4_13 -> "4.13" | `V4_14 -> "4.14" | `V5_0 -> "5.0" | `V5_1 -> "5.1" @@ -29,7 +27,6 @@ let string_of_version : version -> string = function | `V5_6 -> "5.6" let next_version : version -> version option = function - | `V4_13 -> Some `V4_14 | `V4_14 -> Some `V5_0 | `V5_0 -> Some `V5_1 | `V5_1 -> Some `V5_2 diff --git a/compiler/tests-compiler/double-translation/dune b/compiler/tests-compiler/double-translation/dune index 063207b8a9..7a16010230 100644 --- a/compiler/tests-compiler/double-translation/dune +++ b/compiler/tests-compiler/double-translation/dune @@ -6,7 +6,7 @@ (action (with-stdout-to dune.inc.gen - (run ../gen-rules/gen.exe jsoo_compiler_test)))) + (run ../gen-rules/gen.exe compiler/tests-compiler/double-translation)))) (rule (alias runtest) diff --git a/compiler/tests-compiler/dune b/compiler/tests-compiler/dune index bf40299a44..6702f7246f 100644 --- a/compiler/tests-compiler/dune +++ b/compiler/tests-compiler/dune @@ -6,7 +6,7 @@ (action (with-stdout-to dune.inc.gen - (run gen-rules/gen.exe jsoo_compiler_test)))) + (run gen-rules/gen.exe compiler/tests-compiler)))) (rule (alias runtest) diff --git a/compiler/tests-compiler/gen-rules/gen.ml b/compiler/tests-compiler/gen-rules/gen.ml index d5fd09d9d2..c261aa45ef 100644 --- a/compiler/tests-compiler/gen-rules/gen.ml +++ b/compiler/tests-compiler/gen-rules/gen.ml @@ -14,20 +14,14 @@ let is_implem x = let () = set_binary_mode_out stdout true +(* Project-relative path to this directory, passed by dune *) let prefix : string = - let rec loop acc rem = - let basename = Filename.basename rem in - let dirname = Filename.dirname rem in - if - String.equal dirname rem - || String.ends_with ~suffix:"_build" dirname - || Sys.file_exists (Filename.concat rem "dune-project") - then acc - else - let acc = basename :: acc in - loop acc dirname - in - loop [ "" ] (Sys.getcwd ()) |> String.concat ~sep:"/" + if Array.length Sys.argv < 2 + then failwith "gen.exe: expected source directory as first argument"; + let p = Sys.argv.(1) in + if String.length p > 0 && not (Char.equal p.[String.length p - 1] '/') + then p ^ "/" + else p type lang = | Not of lang diff --git a/compiler/tests-dynlink-wasm/dune b/compiler/tests-dynlink-wasm/dune index dc5fea7c01..cabbf6ecff 100644 --- a/compiler/tests-dynlink-wasm/dune +++ b/compiler/tests-dynlink-wasm/dune @@ -54,7 +54,9 @@ (rule (target main.out) - (deps plugin.wasmo) + (deps + plugin.wasmo + (glob_files main.bc.wasm.assets/*)) (enabled_if %{env:WASM_OF_OCAML=false}) (action (with-outputs-to @@ -90,7 +92,9 @@ (rule (target main_compile_and_load.out) - (deps plugin_compiled.wasmo) + (deps + plugin_compiled.wasmo + (glob_files main_compile_and_load.bc.wasm.assets/*)) (enabled_if %{env:WASM_OF_OCAML=false}) (action (with-outputs-to @@ -115,7 +119,10 @@ (rule (target dynlink_loadfile.out) - (deps plugin.cmo plugin2.cma) + (deps + plugin.cmo + plugin2.cma + (glob_files dynlink_loadfile.bc.wasm.assets/*)) (enabled_if %{env:WASM_OF_OCAML=false}) (action (with-outputs-to @@ -181,7 +188,12 @@ (rule (target dynlink_loadfile_wp.out) - (deps plugin.cmo plugin2.cma plugin_uses_dep.cmo plugin_js.cmo) + (deps + plugin.cmo + plugin2.cma + plugin_uses_dep.cmo + plugin_js.cmo + (glob_files dynlink_loadfile_wp.assets/*)) (enabled_if %{env:WASM_OF_OCAML=false}) (action (with-outputs-to diff --git a/compiler/tests-linkall/dune b/compiler/tests-linkall/dune index dbfe6e4c78..6132a16e81 100644 --- a/compiler/tests-linkall/dune +++ b/compiler/tests-linkall/dune @@ -13,6 +13,8 @@ (test (name test) (modes byte js wasm) + (enabled_if + (<> %{profile} with-native-effects)) (libraries dynlink) ;; It doesn't seem possible to create a pack-ed module with dune. ;; However, dynlink uses pack to embed a copy diff --git a/compiler/tests-ocaml/basic-io/dune b/compiler/tests-ocaml/basic-io/dune index 0dda8c0246..ddcc2a4241 100644 --- a/compiler/tests-ocaml/basic-io/dune +++ b/compiler/tests-ocaml/basic-io/dune @@ -1,5 +1,6 @@ (tests (names wc) (modes js wasm) + (deps wc.ml) (action (run node %{test} wc.ml))) diff --git a/compiler/tests-ocaml/lib-arg/dune b/compiler/tests-ocaml/lib-arg/dune index 1fee099413..7a856b8d3f 100644 --- a/compiler/tests-ocaml/lib-arg/dune +++ b/compiler/tests-ocaml/lib-arg/dune @@ -18,6 +18,8 @@ (rule (target test_rest_all_wasm.ml.corrected) (enabled_if %{env:WASM_OF_OCAML=false}) + (deps + (glob_files ../expect_wasm.bc.wasm.assets/*)) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_rest_all_wasm.ml}))) diff --git a/compiler/tests-ocaml/lib-array/dune b/compiler/tests-ocaml/lib-array/dune index c281ad438c..ed7265081d 100644 --- a/compiler/tests-ocaml/lib-array/dune +++ b/compiler/tests-ocaml/lib-array/dune @@ -16,6 +16,8 @@ (rule (target test_array_wasm.ml.corrected) (enabled_if %{env:WASM_OF_OCAML=false}) + (deps + (glob_files ../expect_wasm.bc.wasm.assets/*)) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_array_wasm.ml}))) diff --git a/compiler/tests-ocaml/lib-either/dune b/compiler/tests-ocaml/lib-either/dune index febf0dccb0..31e95afd55 100644 --- a/compiler/tests-ocaml/lib-either/dune +++ b/compiler/tests-ocaml/lib-either/dune @@ -14,6 +14,8 @@ (rule (target test_wasm.ml.corrected) (enabled_if %{env:WASM_OF_OCAML=false}) + (deps + (glob_files ../expect_wasm.bc.wasm.assets/*)) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) diff --git a/compiler/tests-ocaml/lib-internalformat/dune b/compiler/tests-ocaml/lib-internalformat/dune index febf0dccb0..31e95afd55 100644 --- a/compiler/tests-ocaml/lib-internalformat/dune +++ b/compiler/tests-ocaml/lib-internalformat/dune @@ -14,6 +14,8 @@ (rule (target test_wasm.ml.corrected) (enabled_if %{env:WASM_OF_OCAML=false}) + (deps + (glob_files ../expect_wasm.bc.wasm.assets/*)) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) diff --git a/compiler/tests-ocaml/lib-lazy/dune b/compiler/tests-ocaml/lib-lazy/dune index febf0dccb0..31e95afd55 100644 --- a/compiler/tests-ocaml/lib-lazy/dune +++ b/compiler/tests-ocaml/lib-lazy/dune @@ -14,6 +14,8 @@ (rule (target test_wasm.ml.corrected) (enabled_if %{env:WASM_OF_OCAML=false}) + (deps + (glob_files ../expect_wasm.bc.wasm.assets/*)) (action (run node %{dep:../expect_wasm.bc.wasm.js} %{dep:test_wasm.ml}))) diff --git a/compiler/tests-predef/dune b/compiler/tests-predef/dune index 80d7337edf..2ea5508b71 100644 --- a/compiler/tests-predef/dune +++ b/compiler/tests-predef/dune @@ -43,6 +43,8 @@ (rule (target main-wasm.out) (enabled_if %{env:WASM_OF_OCAML=false}) + (deps + (glob_files main.bc.wasm.assets/*)) (action (with-stdout-to %{target} diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune index c94fcc24ef..2b5d755520 100644 --- a/compiler/tests-toplevel/dune +++ b/compiler/tests-toplevel/dune @@ -7,6 +7,15 @@ (flags :standard --toplevel)) (modes byte js)) +(rule + (target cmi_include_dirs.txt) + (deps + (package js_of_ocaml-compiler)) + (action + (with-stdout-to + %{target} + (run ocamlfind query -format "-I\n%d" -r js_of_ocaml-compiler.dynlink)))) + (rule (targets test_toplevel.js) (action @@ -15,6 +24,7 @@ --toplevel -w no-missing-effects-backend + %{read-strings:cmi_include_dirs.txt} %{dep:test_toplevel.bc} -o %{targets}))) @@ -60,6 +70,16 @@ (action (copy %{dep:test_toplevel.ml} %{target}))) +(rule + (target cmi_include_dirs_wasm.txt) + (deps + (package js_of_ocaml-compiler) + (package wasm_of_ocaml-compiler)) + (action + (with-stdout-to + %{target} + (run ocamlfind query -format "-I\n%d" -r wasm_of_ocaml-compiler.dynlink)))) + (rule (targets test_toplevel_wasm.js @@ -71,6 +91,7 @@ --toplevel -w no-missing-effects-backend + %{read-strings:cmi_include_dirs_wasm.txt} %{dep:test_toplevel_wasm.bc} -o test_toplevel_wasm.js))) @@ -81,6 +102,8 @@ (and %{env:WASM_OF_OCAML=false} (>= %{ocaml_version} 5.4))) + (deps + (glob_files test_toplevel_wasm.bc.wasm.assets/*)) (action (with-stdout-to %{target} diff --git a/dune b/dune index fa9ca7d14d..a2780093f9 100644 --- a/dune +++ b/dune @@ -36,6 +36,17 @@ (binaries (tools/node_wrapper.exe as node) (tools/node_wrapper.exe as node.exe))) + (with-native-effects + (js_of_ocaml + ;; Native effects is not supported in js + (enabled_if false)) + (wasm_of_ocaml + (compilation_mode separate) + (flags + (:standard --effects native))) + (binaries + (tools/node_wrapper.exe as node) + (tools/node_wrapper.exe as node.exe))) (bench_no_debug (flags (:standard \ -g)) diff --git a/dune-project b/dune-project index e35053e5c4..f8d4352296 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 3.20) +(lang dune 3.23) (using menhir 3.0) (using directory-targets 0.1) (using oxcaml 0.1) @@ -19,7 +19,7 @@ (description "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends - (ocaml (and (>= 4.13) (< 5.6))) + (ocaml (and (>= 4.14) (< 5.6))) (num :with-test) (ppx_expect (and (>= v0.16.1) :with-test)) (ppxlib (>= 0.33)) @@ -28,7 +28,7 @@ (cmdliner (>= 2.0)) (sedlex (>= 3.3)) (qcheck :with-test) - menhir + (menhir (>= 20180523)) menhirLib menhirSdk (yojson (>= 2.1))) @@ -45,13 +45,14 @@ (description "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends - (ocaml (>= 4.13)) + (ocaml (>= 4.14)) (js_of_ocaml (= :version)) (js_of_ocaml-ppx (= :version)) (lwt (and (>= 2.4.4) (<> 5.9.2))) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) - (re (and (>= 1.9.0) :with-test))) + (re (and (>= 1.9.0) :with-test)) + (menhir (>= 20180523))) (depopts graphics lwt_log @@ -63,12 +64,13 @@ (description "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends - (ocaml (>= 4.13)) + (ocaml (>= 4.14)) (js_of_ocaml (= :version)) (ppxlib (>= 0.33)) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) (re (and (>= 1.9.0) :with-test)) + (menhir (>= 20180523)) )) (package @@ -77,12 +79,13 @@ (description "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends - (ocaml (>= 4.13)) + (ocaml (>= 4.14)) (js_of_ocaml (= :version)) (ppxlib (>= 0.33)) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) (re (and (>= 1.9.0) :with-test)) + (menhir (>= 20180523)) )) (package @@ -91,7 +94,7 @@ (description "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends - (ocaml (>= 4.13)) + (ocaml (>= 4.14)) (js_of_ocaml-compiler (= :version)) (ocamlfind (>= 1.5.1)) ;;(cohttp-lwt-unix (and (>= 6.0.0) :with-test)) @@ -100,6 +103,7 @@ (ppx_expect (and (>= v0.14.2) :with-test)) (ppxlib (>= 0.33)) (re (and (>= 1.9.0) :with-test)) + (menhir (>= 20180523)) )) (package @@ -108,7 +112,7 @@ (description "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends - (ocaml (>= 4.13)) + (ocaml (>= 4.14)) (js_of_ocaml (= :version)) (js_of_ocaml-ppx (= :version)) (react (>= 1.2.2)) @@ -117,6 +121,7 @@ (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) (re (and (>= 1.9.0) :with-test)) + (menhir (>= 20180523)) )) (package @@ -125,12 +130,13 @@ (description "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends - (ocaml (>= 4.13)) + (ocaml (>= 4.14)) (js_of_ocaml-compiler (= :version)) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) (ppxlib (>= 0.33)) (re (and (>= 1.9.0) :with-test)) + (menhir (>= 20180523)) )) (package @@ -148,7 +154,7 @@ (cmdliner (>= 2.0)) (opam-format :with-test) (sedlex (>= 2.3)) - menhir + (menhir (>= 20180523)) menhirLib menhirSdk (yojson (>= 2.1)) diff --git a/dune-workspace.dev b/dune-workspace.dev index fd0e58234d..f7352b536c 100644 --- a/dune-workspace.dev +++ b/dune-workspace.dev @@ -7,10 +7,6 @@ ;; ;; This will build js_of_ocaml against all these version of OCaml -(context - (opam - (switch 4.13.1))) - (context (opam (switch 4.14.0))) diff --git a/js_of_ocaml-compiler.opam b/js_of_ocaml-compiler.opam index 1c7e4f20eb..4d7254f15c 100644 --- a/js_of_ocaml-compiler.opam +++ b/js_of_ocaml-compiler.opam @@ -12,8 +12,8 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "4.13" & < "5.6"} + "dune" {>= "3.23"} + "ocaml" {>= "4.14" & < "5.6"} "num" {with-test} "ppx_expect" {>= "v0.16.1" & with-test} "ppxlib" {>= "0.33"} diff --git a/js_of_ocaml-lwt.opam b/js_of_ocaml-lwt.opam index f3360433a3..bf648baf5a 100644 --- a/js_of_ocaml-lwt.opam +++ b/js_of_ocaml-lwt.opam @@ -12,16 +12,16 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "4.13"} + "dune" {>= "3.23"} + "ocaml" {>= "4.14"} "js_of_ocaml" {= version} "js_of_ocaml-ppx" {= version} "lwt" {>= "2.4.4" & != "5.9.2"} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} "re" {>= "1.9.0" & with-test} - "odoc" {with-doc} "menhir" {>= "20180523"} + "odoc" {with-doc} ] depopts: ["graphics" "lwt_log"] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" diff --git a/js_of_ocaml-ppx.opam b/js_of_ocaml-ppx.opam index 5b29455456..fb86d883a4 100644 --- a/js_of_ocaml-ppx.opam +++ b/js_of_ocaml-ppx.opam @@ -12,15 +12,15 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "4.13"} + "dune" {>= "3.23"} + "ocaml" {>= "4.14"} "js_of_ocaml" {= version} "ppxlib" {>= "0.33"} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} "re" {>= "1.9.0" & with-test} - "odoc" {with-doc} "menhir" {>= "20180523"} + "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" x-maintenance-intent: ["(latest)"] diff --git a/js_of_ocaml-ppx_deriving_json.opam b/js_of_ocaml-ppx_deriving_json.opam index 5b29455456..fb86d883a4 100644 --- a/js_of_ocaml-ppx_deriving_json.opam +++ b/js_of_ocaml-ppx_deriving_json.opam @@ -12,15 +12,15 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "4.13"} + "dune" {>= "3.23"} + "ocaml" {>= "4.14"} "js_of_ocaml" {= version} "ppxlib" {>= "0.33"} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} "re" {>= "1.9.0" & with-test} - "odoc" {with-doc} "menhir" {>= "20180523"} + "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" x-maintenance-intent: ["(latest)"] diff --git a/js_of_ocaml-toplevel.opam b/js_of_ocaml-toplevel.opam index 3a7662e1f1..b01647d84a 100644 --- a/js_of_ocaml-toplevel.opam +++ b/js_of_ocaml-toplevel.opam @@ -12,8 +12,8 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "4.13"} + "dune" {>= "3.23"} + "ocaml" {>= "4.14"} "js_of_ocaml-compiler" {= version} "ocamlfind" {>= "1.5.1"} "graphics" {with-test} @@ -21,8 +21,8 @@ depends: [ "ppx_expect" {>= "v0.14.2" & with-test} "ppxlib" {>= "0.33"} "re" {>= "1.9.0" & with-test} - "odoc" {with-doc} "menhir" {>= "20180523"} + "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" x-maintenance-intent: ["(latest)"] diff --git a/js_of_ocaml-tyxml.opam b/js_of_ocaml-tyxml.opam index 0abc0cd3b7..6364219381 100644 --- a/js_of_ocaml-tyxml.opam +++ b/js_of_ocaml-tyxml.opam @@ -12,8 +12,8 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "4.13"} + "dune" {>= "3.23"} + "ocaml" {>= "4.14"} "js_of_ocaml" {= version} "js_of_ocaml-ppx" {= version} "react" {>= "1.2.2"} @@ -22,8 +22,8 @@ depends: [ "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} "re" {>= "1.9.0" & with-test} - "odoc" {with-doc} "menhir" {>= "20180523"} + "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" x-maintenance-intent: ["(latest)"] diff --git a/js_of_ocaml.opam b/js_of_ocaml.opam index 4b52d11364..c764cb0349 100644 --- a/js_of_ocaml.opam +++ b/js_of_ocaml.opam @@ -12,15 +12,15 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "4.13"} + "dune" {>= "3.23"} + "ocaml" {>= "4.14"} "js_of_ocaml-compiler" {= version} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} "ppxlib" {>= "0.33"} "re" {>= "1.9.0" & with-test} - "odoc" {with-doc} "menhir" {>= "20180523"} + "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" x-maintenance-intent: ["(latest)"] diff --git a/lib/tests/dune b/lib/tests/dune index f4902cdc3a..30c19e35c1 100644 --- a/lib/tests/dune +++ b/lib/tests/dune @@ -6,7 +6,7 @@ (action (with-stdout-to dune.inc.gen - (run gen-rules/gen.exe jsoo_lib_expect_tests)))) + (run gen-rules/gen.exe lib/tests)))) (rule (alias runtest) diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml index 2899edb21e..f02a880746 100644 --- a/lib/tests/gen-rules/gen.ml +++ b/lib/tests/gen-rules/gen.ml @@ -32,20 +32,14 @@ let is_implem x = let () = set_binary_mode_out stdout true +(* Project-relative path to this directory, passed by dune *) let prefix : string = - let rec loop acc rem = - let basename = Filename.basename rem in - let dirname = Filename.dirname rem in - if - String.equal dirname rem - || String.ends_with ~suffix:"_build" dirname - || Sys.file_exists (Filename.concat rem "dune-project") - then acc - else - let acc = basename :: acc in - loop acc dirname - in - loop [ "" ] (Sys.getcwd ()) |> String.concat ~sep:"/" + if Array.length Sys.argv < 2 + then failwith "gen.exe: expected source directory as first argument"; + let p = Sys.argv.(1) in + if String.length p > 0 && not (Char.equal p.[String.length p - 1] '/') + then p ^ "/" + else p type enabled_if = | GE5 diff --git a/manual/effects.wiki b/manual/effects.wiki index 2bd6742489..ae36c19e69 100644 --- a/manual/effects.wiki +++ b/manual/effects.wiki @@ -21,6 +21,19 @@ Since CPS code is usually slower, this can avoid performance degradations. You c also ensure that some code runs in direct style using <>. +==@@id="wasm"@@ Wasm_of_ocaml + +Wasm_of_ocaml provides three effect handler implementations: + +* **{{{--effects=jspi}}}** (default) uses the JavaScript-Promise Integration extension. + It does not require any code transformation but requires a runtime that supports JSPI. +* **{{{--effects=cps}}}** uses the same CPS transformation as js_of_ocaml. +* **{{{--effects=native}}}** uses the + [[https://github.com/WebAssembly/stack-switching|WebAssembly Stack Switching proposal]] + (typed continuations). It provides the best performance but requires a runtime with + support for the WasmFX extension (currently available in V8/Node.js behind the + {{{--experimental-wasm-wasmfx}}} flag). + ==@@id="dune"@@ Dune integration Dune is aware of the {{{--effects}}} option. You can add it to the diff --git a/manual/install.wiki b/manual/install.wiki index 6e488b3f26..9d77a5dfbd 100644 --- a/manual/install.wiki +++ b/manual/install.wiki @@ -2,7 +2,7 @@ ==@@id="requirements"@@ Requirements -**OCaml**: 4.13 to 5.4 +**OCaml**: 4.14 to 5.4 **Build tools**: * dune >= 3.19 @@ -61,4 +61,4 @@ See <> for usage. == See also * <> — Get started with a simple example -* <> — Learn what js_of_ocaml can do \ No newline at end of file +* <> — Learn what js_of_ocaml can do diff --git a/manual/options.wiki b/manual/options.wiki index 78d8309662..3a0fd87c3d 100644 --- a/manual/options.wiki +++ b/manual/options.wiki @@ -45,6 +45,7 @@ For **js_of_ocaml** (default: {{{disabled}}}): For **wasm_of_ocaml** (default: {{{jspi}}}): * **{{{jspi}}}** - JavaScript-Promise Integration (default). Available in Chrome 137, Node.js 25, and higher. Use {{{cps}}} for other browsers. Performing effects is slower than with {{{cps}}}. * **{{{cps}}}** - CPS transformation for effect support +* **{{{native}}}** - WebAssembly stack switching (wasm_of_ocaml only, requires WasmFX runtime support) * **{{{disabled}}}** - No effect handler support See <> for details. diff --git a/manual/wasm_overview.wiki b/manual/wasm_overview.wiki index 3424d75571..f8f9ae54a8 100644 --- a/manual/wasm_overview.wiki +++ b/manual/wasm_overview.wiki @@ -68,16 +68,22 @@ Compared to js_of_ocaml: === Effect handlers -OCaml 5.x code using effect handlers can be compiled in two ways: +OCaml 5.x code using effect handlers can be compiled in three ways: * **{{{--effects=cps}}}** - Uses the CPS transformation from js_of_ocaml * **{{{--effects=jspi}}}** (default) - Uses the [[https://github.com/WebAssembly/js-promise-integration|JavaScript-Promise Integration extension]] +* **{{{--effects=native}}}** - Uses the [[https://github.com/WebAssembly/stack-switching|WebAssembly Stack Switching proposal]] The CPS transformation is not the default since the generated code is slower, larger, and less readable. However, the JSPI extension is currently only available in Chrome 137 and Node.js 25 (or higher), and performing effects is slower when using it. Use {{{--effects=cps}}} for other browsers. +The native implementation is based on the WebAssembly typed continuations +proposal (stack switching). It provides the best performance but requires a +runtime with support for the WasmFX extension (currently available in +V8/Node.js behind the {{{--experimental-wasm-wasmfx}}} flag). + ==@@id="js-bindings"@@ Binding with JavaScript libraries Js_of_ocaml lets you bind code with JavaScript libraries by linking {{{.js}}} files. diff --git a/runtime/wasm/effect-native.wat b/runtime/wasm/effect-native.wat new file mode 100644 index 0000000000..9f3e0176e6 --- /dev/null +++ b/runtime/wasm/effect-native.wat @@ -0,0 +1,231 @@ +;; Wasm_of_ocaml runtime support +;; http://www.ocsigen.org/js_of_ocaml/ +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU Lesser General Public License as published by +;; the Free Software Foundation, with linking exception; +;; either version 2.1 of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(module +(@if (= effects "native") +(@then + (import "fail" "caml_raise_constant" + (func $caml_raise_constant (param (ref eq)))) + (import "fail" "caml_raise_with_arg" + (func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq)))) + (import "obj" "caml_fresh_oo_id" + (func $caml_fresh_oo_id (param (ref eq)) (result (ref eq)))) + (import "obj" "cont_tag" (global $cont_tag i32)) + (import "obj" "object_tag" (global $object_tag i32)) + (import "stdlib" "caml_named_value" + (func $caml_named_value (param (ref eq)) (result (ref null eq)))) + (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq)))) + (import "fail" "javascript_exception" + (tag $javascript_exception (param externref))) + (import "jslib" "caml_wrap_exception" + (func $caml_wrap_exception (param externref) (result (ref eq)))) + (import "stdlib" "caml_main_wrapper" + (global $caml_main_wrapper (mut (ref null $wrapper_func)))) + (import "effect" "effect_allowed" (global $effect_allowed (mut i32))) + + (type $block (array (mut (ref eq)))) + (type $bytes (array (mut i8))) + (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq)))) + (type $closure (sub (struct (;(field i32);) (field (ref $function_1))))) + (type $function_3 + (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq)))) + (type $closure_3 + (sub $closure + (struct (field (ref $function_1)) (field (ref $function_3))))) + + ;; Effect types + + (tag $effect (param (ref eq)) (result (ref eq) (ref eq))) + + (type $cont_function (func (param (ref eq) (ref eq)) (result (ref eq)))) + + (type $cont (cont $cont_function)) + + (type $generic_fiber + (sub + (struct + (field $value (mut (ref eq))) + (field $exn (mut (ref eq))) + (field $effect (mut (ref eq)))))) + + (type $fiber + (sub final $generic_fiber + (struct + (field $value (mut (ref eq))) + (field $exn (mut (ref eq))) + (field $effect (mut (ref eq))) + (field $cont (mut (ref $cont)))))) + + ;; Unhandled effects + + (@string $effect_unhandled "Effect.Unhandled") + + (func $raise_unhandled + (param $eff (ref eq)) (param (ref eq)) (result (ref eq)) + (block $null + (call $caml_raise_with_arg + (br_on_null $null + (call $caml_named_value (global.get $effect_unhandled))) + (local.get $eff))) + (call $caml_raise_constant + (array.new_fixed $block 3 (ref.i31 (global.get $object_tag)) + (global.get $effect_unhandled) + (call $caml_fresh_oo_id (ref.i31 (i32.const 0))))) + (ref.i31 (i32.const 0))) + + (global $raise_unhandled (ref $closure) + (struct.new $closure (ref.func $raise_unhandled))) + + (type $func (func (result (ref eq)))) + (type $wrapper_func (func (param (ref $func)))) + (type $func_closure (struct (field (ref $func)))) + + (func $wrapper_cont + (param $f (ref eq)) (param (ref eq)) (result (ref eq)) + (return_call_ref $func + (local.get $f) + (struct.get $func_closure 0 + (ref.cast (ref $func_closure) (local.get $f))))) + + (func $unhandled_effect_wrapper (param $start (ref $func)) + (local $cont (ref $cont)) + (local $f (ref eq)) (local $v (ref eq)) + (local $resume_res (tuple (ref eq) (ref $cont))) + (local.set $cont (cont.new $cont (ref.func $wrapper_cont))) + (local.set $f (struct.new $func_closure (local.get $start))) + (local.set $v (ref.i31 (i32.const 0))) + (loop $loop + (local.set $resume_res + (block $handle_effect (result (ref eq) (ref $cont)) + (resume $cont (on $effect $handle_effect) + (local.get $f) (local.get $v) (local.get $cont)) + (return))) + (local.set $cont (tuple.extract 2 1 (local.get $resume_res))) + (local.set $v (tuple.extract 2 0 (local.get $resume_res))) + (local.set $f (global.get $raise_unhandled)) + (br $loop))) + + (func $init + (global.set $caml_main_wrapper (ref.func $unhandled_effect_wrapper))) + + (start $init) + + ;; Resume + + (@string $already_resumed "Effect.Continuation_already_resumed") + + (func $resume (export "%resume") + (param $vfiber (ref eq)) (param $f (ref eq)) (param $v (ref eq)) + (param $tail (ref eq)) (result (ref eq)) + (local $fiber (ref $fiber)) + (local $res (ref eq)) + (local $exn (ref eq)) + (local $resume_res (tuple (ref eq) (ref $cont))) + (if (ref.eq (local.get $vfiber) (ref.i31 (i32.const 0))) + (then + (call $caml_raise_constant + (ref.as_non_null + (call $caml_named_value (global.get $already_resumed)))))) + (local.set $fiber (ref.cast (ref $fiber) (local.get $vfiber))) + (local.set $exn + (block $handle_exception (result (ref eq)) + (local.set $resume_res + (block $handle_effect (result (ref eq) (ref $cont)) + (local.set $res + (try (result (ref eq)) + (do + (resume $cont + (on $effect $handle_effect) + (local.get $f) (local.get $v) + (struct.get $fiber $cont (local.get $fiber)))) + (catch $javascript_exception + (br $handle_exception + (call $caml_wrap_exception (pop externref)))) + (catch $ocaml_exception + (br $handle_exception (pop (ref eq)))))) + ;; handle return + (return_call_ref $function_1 (local.get $res) + (local.tee $f + (struct.get $fiber $value (local.get $fiber))) + (struct.get $closure 0 + (ref.cast (ref $closure) (local.get $f)))))) + ;; handle effect + (struct.set $fiber $cont (local.get $fiber) + (tuple.extract 2 1 (local.get $resume_res))) + (return_call_ref $function_3 + (tuple.extract 2 0 (local.get $resume_res)) + (array.new_fixed $block 3 (ref.i31 (global.get $cont_tag)) + (local.get $fiber) + (local.get $fiber)) + (if (result (ref eq)) + (ref.eq (local.get $tail) (ref.i31 (i32.const 0))) + (then (local.get $fiber)) + (else (local.get $tail))) + (local.tee $f + (struct.get $fiber $effect (local.get $fiber))) + (struct.get $closure_3 1 + (ref.cast (ref $closure_3) (local.get $f)))))) + ;; handle exception + (return_call_ref $function_1 (local.get $exn) + (local.tee $f + (struct.get $fiber $exn (local.get $fiber))) + (struct.get $closure 0 (ref.cast (ref $closure) (local.get $f))))) + + ;; Perform + + (func (export "%reperform") + (param $eff (ref eq)) (param $cont (ref eq)) (param $tail (ref eq)) + (result (ref eq)) + (local $res (tuple (ref eq) (ref eq))) + (local.set $res (suspend $effect (local.get $eff))) + (return_call $resume + (ref.as_non_null + (array.get $block + (ref.cast (ref $block) (local.get $cont)) + (i32.const 1))) + (tuple.extract 2 0 (local.get $res)) + (tuple.extract 2 1 (local.get $res)) + (local.get $tail))) + + (func (export "%perform") (param $eff (ref eq)) (result (ref eq)) + (local $res (tuple (ref eq) (ref eq))) + (if (i32.eqz (global.get $effect_allowed)) + (then + (return_call $raise_unhandled + (local.get $eff) (ref.i31 (i32.const 0))))) + (local.set $res (suspend $effect (local.get $eff))) + (return_call_ref $function_1 (tuple.extract 2 1 (local.get $res)) + (tuple.extract 2 0 (local.get $res)) + (struct.get $closure 0 + (ref.cast (ref $closure) (tuple.extract 2 0 (local.get $res)))))) + + ;; Allocate a stack + + (func $initial_cont + (param $f (ref eq)) (param $x (ref eq)) (result (ref eq)) + (return_call_ref $function_1 (local.get $x) + (local.get $f) + (struct.get $closure 0 (ref.cast (ref $closure) (local.get $f))))) + + (func (export "caml_alloc_stack") + (param $hv (ref eq)) (param $hx (ref eq)) (param $hf (ref eq)) + (result (ref eq)) + (struct.new $fiber + (local.get $hv) (local.get $hx) (local.get $hf) + (cont.new $cont (ref.func $initial_cont)))) +)) +) diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat index 00ef85d8e8..8e9ec104a6 100644 --- a/runtime/wasm/effect.wat +++ b/runtime/wasm/effect.wat @@ -81,7 +81,7 @@ (global $raise_unhandled (ref $closure) (struct.new $closure (ref.func $raise_unhandled))) - (global $effect_allowed (mut i32) (i32.const 1)) + (global $effect_allowed (export "effect_allowed") (mut i32) (i32.const 1)) (func $caml_continuation_use_noexc (export "caml_continuation_use_noexc") (param (ref eq)) (result (ref eq)) diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat index b0e7708d91..88ca67e8d5 100644 --- a/runtime/wasm/stdlib.wat +++ b/runtime/wasm/stdlib.wat @@ -455,11 +455,21 @@ (global.set $uncaught_exception (local.get $exn)) (call $caml_main (ref.func $reraise_exception))) + (type $wrapper_func (func (param (ref $func)))) + (global $caml_main_wrapper (export "caml_main_wrapper") + (mut (ref null $wrapper_func)) + (ref.null $wrapper_func)) + (func $caml_main (export "caml_main") (param $start (ref func)) (local $exn (ref eq)) (local $msg (ref eq)) (try (do + (block $fallback + (call_ref $wrapper_func + (ref.cast (ref $func) (local.get $start)) + (br_on_null $fallback (global.get $caml_main_wrapper))) + (return)) (drop (call_ref $func (ref.cast (ref $func) (local.get $start))))) (catch $ocaml_exit) (catch $ocaml_exception diff --git a/tools/node_wrapper.ml b/tools/node_wrapper.ml index 0a3826fd7c..5f6bffb7cf 100644 --- a/tools/node_wrapper.ml +++ b/tools/node_wrapper.ml @@ -1,4 +1,4 @@ -let extra_args_for_wasoo = [ "--stack-size=10000" ] +let extra_args_for_wasoo = [ "--experimental-wasm-wasmfx"; "--stack-size=10000" ] let extra_args_for_jsoo = [] diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune index 117556031f..2e9999cb18 100644 --- a/toplevel/examples/lwt_toplevel/dune +++ b/toplevel/examples/lwt_toplevel/dune @@ -115,6 +115,7 @@ (rule (targets test_dynlink.js) + (deps test_dynlink.cmi) (action (run %{bin:js_of_ocaml} @@ -199,6 +200,33 @@ (or 0 1) (run grep -v ^$)))))) +(rule + (target cmi_include_dirs.txt) + (deps + (package js_of_ocaml) + (package js_of_ocaml-compiler) + (package js_of_ocaml-lwt) + (package js_of_ocaml-tyxml) + (package js_of_ocaml-toplevel) + (package js_of_ocaml-ppx)) + (action + (with-stdout-to + %{target} + (run + ocamlfind + query + -format + "-I\n%d" + -r + js_of_ocaml-compiler.runtime + js_of_ocaml-lwt + js_of_ocaml-lwt.graphics + js_of_ocaml-tyxml + js_of_ocaml-toplevel + js_of_ocaml-toplevel.common + js_of_ocaml-ppx.as-lib + js_of_ocaml.deriving)))) + (rule (targets toplevel.js) (action @@ -223,6 +251,7 @@ --toplevel --disable shortvar + %{read-strings:cmi_include_dirs.txt} %{read-strings:javascript_runtime_files.txt} %{dep:toplevel.bc} -o @@ -271,6 +300,7 @@ compile --toplevel --effects=cps + %{read-strings:cmi_include_dirs.txt} --file %{dep:examples.ml} --export diff --git a/toplevel/test/dune b/toplevel/test/dune index 71875c7974..f9c6e348ae 100644 --- a/toplevel/test/dune +++ b/toplevel/test/dune @@ -29,6 +29,24 @@ (action (run jsoo_mkcmis -o %{target} stdlib))) +(rule + (target cmi_include_dirs.txt) + (deps + (package js_of_ocaml) + (package js_of_ocaml-toplevel)) + (action + (with-stdout-to + %{target} + (run + ocamlfind + query + -format + "-I\n%d" + -r + js_of_ocaml-toplevel + js_of_ocaml-toplevel.common + re)))) + (rule (targets test_toplevel1.js) (action @@ -41,6 +59,7 @@ shortvar -w no-missing-effects-backend + %{read-strings:cmi_include_dirs.txt} %{dep:test_toplevel1.bc} -o %{targets}))) diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam index 2577bd563f..56582758a2 100644 --- a/wasm_of_ocaml-compiler.opam +++ b/wasm_of_ocaml-compiler.opam @@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.20"} + "dune" {>= "3.23"} "ocaml" {>= "4.14"} "js_of_ocaml" {= version} "num" {with-test}