From 8122af89e2ab3eeaccd2b9cd90ff75ccb3bffc31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Mon, 21 Oct 2024 20:13:15 +0200 Subject: [PATCH] Wasm_of_ocaml support: alternative design --- .github/workflows/workflow.yml | 2 +- bin/printenv.ml | 20 +- src/dune_lang/binary_kind.ml | 8 +- src/dune_lang/binary_kind.mli | 1 - src/dune_rules/cinaps.ml | 2 +- src/dune_rules/compilation_context.ml | 2 +- src/dune_rules/compilation_context.mli | 4 +- src/dune_rules/dir_status.ml | 51 ++-- src/dune_rules/dir_status.mli | 10 +- src/dune_rules/dune_env.ml | 13 + src/dune_rules/dune_env.mli | 1 + src/dune_rules/exe.ml | 66 +++-- src/dune_rules/exe.mli | 5 +- src/dune_rules/exe_rules.ml | 51 +++- src/dune_rules/gen_rules.ml | 6 +- src/dune_rules/inline_tests.ml | 75 ++--- src/dune_rules/inline_tests_info.ml | 16 +- src/dune_rules/inline_tests_info.mli | 2 +- src/dune_rules/jsoo/js_of_ocaml.ml | 197 ++++++++----- src/dune_rules/jsoo/js_of_ocaml.mli | 79 +++-- src/dune_rules/jsoo/jsoo_rules.ml | 272 ++++++++++-------- src/dune_rules/jsoo/jsoo_rules.mli | 39 ++- src/dune_rules/lib_rules.ml | 8 +- src/dune_rules/mdx.ml | 2 +- src/dune_rules/melange/melange_rules.ml | 2 +- src/dune_rules/module_compilation.ml | 15 +- src/dune_rules/ppx_driver.ml | 2 +- src/dune_rules/stanzas/buildable.ml | 17 +- src/dune_rules/stanzas/buildable.mli | 2 +- src/dune_rules/stanzas/executables.ml | 42 ++- src/dune_rules/stanzas/executables.mli | 3 + src/dune_rules/stanzas/library.ml | 7 +- src/dune_rules/test_rules.ml | 49 ++-- src/dune_rules/toplevel.ml | 2 +- src/dune_rules/utop.ml | 2 +- .../gen-opam-install-file/stubs.t/dune | 3 +- .../jsoo/no-check-prim.t/lib/runtime.js | 2 +- .../test-cases/jsoo/simple.t/lib/runtime.js | 2 +- .../blackbox-tests/test-cases/meta-gen.t/dune | 2 + .../test-cases/meta-gen.t/run.t | 6 +- .../test-cases/wasmoo/build-info.t/run.t | 259 +++-------------- .../test-cases/wasmoo/build-info.t/src/dune | 3 +- .../test-cases/wasmoo/github3622.t | 3 +- .../wasmoo/inline-tests.t/wasm/dune | 4 +- .../test-cases/wasmoo/jsoo-config.t/bin/dune | 10 +- .../test-cases/wasmoo/jsoo-config.t/dune | 3 +- .../wasmoo/no-check-prim.t/bin/dune | 8 +- .../wasmoo/no-check-prim.t/lib/dune | 4 +- .../wasmoo/no-check-prim.t/lib/runtime.js | 2 +- .../test-cases/wasmoo/no-check-prim.t/run.t | 2 +- .../test-cases/wasmoo/public-libs.t/b/dune | 3 +- .../test-cases/wasmoo/simple.t/bin/dune | 8 +- .../test-cases/wasmoo/simple.t/lib/dune | 2 +- .../test-cases/wasmoo/simple.t/lib/runtime.js | 2 +- .../test-cases/wasmoo/submodes.t/dune | 6 +- .../test-cases/wasmoo/submodes.t/run.t | 10 +- .../test-cases/wasmoo/tests.t/dune | 5 +- .../workspaces/workspace-env.t/run.t | 3 + 58 files changed, 744 insertions(+), 683 deletions(-) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 527695f6f929..b1e1ef0be24a 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -258,7 +258,7 @@ jobs: uses: actions/checkout@v4 with: repository: ocaml-wasm/wasm_of_ocaml - ref: target-dir + ref: wasm-dune path: wasm_of_ocaml - name: Install Wasm_of_ocaml diff --git a/bin/printenv.ml b/bin/printenv.ml index 2489149d6493..709bf53c9b23 100644 --- a/bin/printenv.ml +++ b/bin/printenv.ml @@ -27,13 +27,25 @@ let dump sctx ~dir = |> Action_builder.of_memo >>= Dune_rules.Menhir_env.dump and+ coq_dump = Dune_rules.Coq.Coq_rules.coq_env ~dir >>| Dune_rules.Coq.Coq_flags.dump - and+ jsoo_dump = + and+ jsoo_js_dump = let module Js_of_ocaml = Dune_rules.Js_of_ocaml in - let* jsoo = Action_builder.of_memo (Dune_rules.Jsoo_rules.jsoo_env ~dir) in - Js_of_ocaml.Flags.dump jsoo.flags + let* jsoo = Action_builder.of_memo (Dune_rules.Jsoo_rules.jsoo_env ~dir ~mode:JS) in + Js_of_ocaml.Flags.dump ~mode:JS jsoo.flags + and+ jsoo_wasm_dump = + let module Js_of_ocaml = Dune_rules.Js_of_ocaml in + let* jsoo = Action_builder.of_memo (Dune_rules.Jsoo_rules.jsoo_env ~dir ~mode:Wasm) in + Js_of_ocaml.Flags.dump ~mode:Wasm jsoo.flags in let env = - List.concat [ o_dump; c_dump; link_flags_dump; menhir_dump; coq_dump; jsoo_dump ] + List.concat + [ o_dump + ; c_dump + ; link_flags_dump + ; menhir_dump + ; coq_dump + ; jsoo_js_dump + ; jsoo_wasm_dump + ] in Super_context.context sctx |> Context.name, env ;; diff --git a/src/dune_lang/binary_kind.ml b/src/dune_lang/binary_kind.ml index ea635dd8f611..781ee7b88cee 100644 --- a/src/dune_lang/binary_kind.ml +++ b/src/dune_lang/binary_kind.ml @@ -6,7 +6,6 @@ type t = | Object | Shared_object | Plugin - | Js let compare x y = match x, y with @@ -23,9 +22,6 @@ let compare x y = | Shared_object, _ -> Lt | _, Shared_object -> Gt | Plugin, Plugin -> Eq - | Plugin, _ -> Lt - | _, Plugin -> Gt - | Js, Js -> Eq ;; let decode = @@ -37,7 +33,6 @@ let decode = ; "object", return Object ; "shared_object", return Shared_object ; "plugin", Syntax.since Stanza.syntax (2, 4) >>> return Plugin - ; "js", Syntax.since Stanza.syntax (1, 11) >>> return Js ] ;; @@ -47,9 +42,8 @@ let to_string = function | Object -> "object" | Shared_object -> "shared_object" | Plugin -> "plugin" - | Js -> "js" ;; let to_dyn t = Dyn.variant (to_string t) [] let encode t = Dune_sexp.atom (to_string t) -let all = [ C; Exe; Object; Shared_object; Plugin; Js ] +let all = [ C; Exe; Object; Shared_object; Plugin ] diff --git a/src/dune_lang/binary_kind.mli b/src/dune_lang/binary_kind.mli index 8a06def5b422..019fd74f72ee 100644 --- a/src/dune_lang/binary_kind.mli +++ b/src/dune_lang/binary_kind.mli @@ -6,7 +6,6 @@ type t = | Object | Shared_object | Plugin - | Js val compare : t -> t -> Ordering.t diff --git a/src/dune_rules/cinaps.ml b/src/dune_rules/cinaps.ml index 4029e4804579..5d6ad7223abb 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -179,7 +179,7 @@ let gen_rules sctx t ~dir ~scope = ~requires_compile ~requires_link ~flags:(Ocaml_flags.of_list [ "-w"; "-24" ]) - ~js_of_ocaml:None + ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.make None) ~melange_package_name:None ~package:None in diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index 9e9e9e25db9f..4b3c64fde409 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -87,7 +87,7 @@ type t = ; preprocessing : Pp_spec.t ; opaque : bool ; stdlib : Ocaml_stdlib.t option - ; js_of_ocaml : Js_of_ocaml.In_context.t option + ; js_of_ocaml : Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t ; sandbox : Sandbox_config.t ; package : Package.t option ; vimpl : Vimpl.t option diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index 9924ea719a69..c6352430c82b 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -30,7 +30,7 @@ val create -> ?preprocessing:Pp_spec.t -> opaque:opaque -> ?stdlib:Ocaml_stdlib.t - -> js_of_ocaml:Js_of_ocaml.In_context.t option + -> js_of_ocaml:Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t -> package:Package.t option -> melange_package_name:Lib_name.t option -> ?vimpl:Vimpl.t @@ -61,7 +61,7 @@ val includes : t -> Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind val preprocessing : t -> Pp_spec.t val opaque : t -> bool val stdlib : t -> Ocaml_stdlib.t option -val js_of_ocaml : t -> Js_of_ocaml.In_context.t option +val js_of_ocaml : t -> Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t val sandbox : t -> Sandbox_config.t val set_sandbox : t -> Sandbox_config.t -> t val package : t -> Package.t option diff --git a/src/dune_rules/dir_status.ml b/src/dune_rules/dir_status.ml index 337a955aebda..eaa1136042c0 100644 --- a/src/dune_rules/dir_status.ml +++ b/src/dune_rules/dir_status.ml @@ -134,36 +134,25 @@ let directory_targets_of_rule ~dir { Rule_conf.targets; loc = rule_loc; enabled_ when_enabled ~dir ~enabled_if directory_targets ;; -let jsoo_wasm_enabled - ~(jsoo_submodes : - dir:Path.Build.t - -> submodes:Js_of_ocaml.Submode.Set.t option - -> Js_of_ocaml.Submode.t list Memo.t) - ~dir - ~submodes - = - let+ submodes = jsoo_submodes ~dir ~submodes in - List.mem ~equal:Js_of_ocaml.Submode.equal submodes Wasm +let jsoo_wasm_enabled ~jsoo_enabled ~dir ~(buildable : Buildable.t) = + let* expander = Expander0.get ~dir in + jsoo_enabled + ~eval:(Expander0.eval_blang expander) + ~dir + ~in_context:(Js_of_ocaml.In_context.make ~dir buildable.js_of_ocaml) + ~mode:Js_of_ocaml.Mode.Wasm ;; let directory_targets_of_executables - ~jsoo_submodes + ~jsoo_enabled ~dir { Executables.names; modes; enabled_if; buildable; _ } = let* directory_targets = (* CR-someday rgrinberg: we don't necessarily need to evalute - [explicit_js_mode] or [wasm_enabled] here *) - let+ wasm_enabled = - jsoo_wasm_enabled ~jsoo_submodes ~dir ~submodes:buildable.js_of_ocaml.submodes - and+ explicit_js_mode = - Scope.DB.find_by_dir dir >>| Scope.project >>| Dune_project.explicit_js_mode - in - match - Executables.Link_mode.( - Map.mem modes js || ((not explicit_js_mode) && Map.mem modes byte)) - && wasm_enabled - with + [wasm_enabled] here *) + let+ wasm_enabled = jsoo_wasm_enabled ~jsoo_enabled ~dir ~buildable in + match Executables.Link_mode.(Map.mem modes wasm) && wasm_enabled with | false -> Path.Build.Map.empty | true -> Nonempty_list.to_list names @@ -175,15 +164,15 @@ let directory_targets_of_executables ;; let directory_targets_of_library - ~jsoo_submodes + ~jsoo_enabled ~dir { Library.sub_systems; name; enabled_if; buildable; _ } = let* directory_targets = match Sub_system_name.Map.find sub_systems Inline_tests_info.Tests.name with | Some (Inline_tests_info.Tests.T { modes; loc; enabled_if; _ }) - when Inline_tests_info.Mode_conf.Set.mem modes Javascript -> - jsoo_wasm_enabled ~jsoo_submodes ~dir ~submodes:buildable.js_of_ocaml.submodes + when Inline_tests_info.Mode_conf.Set.mem modes (Jsoo Wasm) -> + jsoo_wasm_enabled ~jsoo_enabled ~dir ~buildable >>| (function | false -> Path.Build.Map.empty | true -> @@ -207,13 +196,13 @@ let directory_targets_of_library when_enabled ~dir ~enabled_if directory_targets ;; -let extract_directory_targets ~jsoo_submodes ~dir stanzas = +let extract_directory_targets ~jsoo_enabled ~dir stanzas = Memo.parallel_map stanzas ~f:(fun stanza -> match Stanza.repr stanza with | Rule_conf.T rule -> directory_targets_of_rule ~dir rule | Executables.T exes | Tests.T { exes; _ } -> - directory_targets_of_executables ~jsoo_submodes ~dir exes - | Library.T lib -> directory_targets_of_library ~jsoo_submodes ~dir lib + directory_targets_of_executables ~jsoo_enabled ~dir exes + | Library.T lib -> directory_targets_of_library ~jsoo_enabled ~dir lib | Coq_stanza.Theory.T m -> (* It's unfortunate that we need to pull in the coq rules here. But we don't have a generic mechanism for this yet. *) @@ -360,15 +349,15 @@ end = struct ;; end -let directory_targets t ~jsoo_submodes ~dir = +let directory_targets t ~jsoo_enabled ~dir = match t with | Lock_dir | Generated | Source_only _ | Is_component_of_a_group_but_not_the_root _ -> Memo.return Path.Build.Map.empty | Standalone (_, dune_file) -> - Dune_file.stanzas dune_file >>= extract_directory_targets ~jsoo_submodes ~dir + Dune_file.stanzas dune_file >>= extract_directory_targets ~jsoo_enabled ~dir | Group_root { components; dune_file; _ } -> let f ~dir stanzas acc = - extract_directory_targets ~jsoo_submodes ~dir stanzas + extract_directory_targets ~jsoo_enabled ~dir stanzas >>| Path.Build.Map.superpose acc in let* init = diff --git a/src/dune_rules/dir_status.mli b/src/dune_rules/dir_status.mli index 3c5497e7a457..f1b70b2b2c83 100644 --- a/src/dune_rules/dir_status.mli +++ b/src/dune_rules/dir_status.mli @@ -44,9 +44,11 @@ end val directory_targets : t - -> jsoo_submodes: - (dir:Path.Build.t - -> submodes:Js_of_ocaml.Submode.Set.t option - -> Js_of_ocaml.Submode.t list Memo.t) + -> jsoo_enabled: + (eval:(Blang.t -> bool Memo.t) + -> dir:Path.Build.t + -> in_context:Js_of_ocaml.In_context.t Js_of_ocaml.Mode.Pair.t + -> mode:Js_of_ocaml.Mode.t + -> bool Memo.t) -> dir:Path.Build.t -> Loc.t Path.Build.Map.t Memo.t diff --git a/src/dune_rules/dune_env.ml b/src/dune_rules/dune_env.ml index 8b3a018b08a1..7411f9b2d681 100644 --- a/src/dune_rules/dune_env.ml +++ b/src/dune_rules/dune_env.ml @@ -80,6 +80,7 @@ type config = ; menhir : Ordered_set_lang.Unexpanded.t Menhir_env.t ; odoc : Odoc.t ; js_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t + ; wasm_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t ; coq : Coq_env.t ; format_config : Format_config.t option ; error_on_use : User_message.t option @@ -102,6 +103,7 @@ let equal_config ; menhir ; odoc ; js_of_ocaml + ; wasm_of_ocaml ; coq ; format_config ; error_on_use @@ -124,6 +126,7 @@ let equal_config && Coq_env.equal coq t.coq && Option.equal Format_config.equal format_config t.format_config && Js_of_ocaml.Env.equal js_of_ocaml t.js_of_ocaml + && Js_of_ocaml.Env.equal wasm_of_ocaml t.wasm_of_ocaml && Option.equal User_message.equal error_on_use t.error_on_use && Option.equal User_message.equal warn_on_load t.warn_on_load && Option.equal Bool.equal bin_annot t.bin_annot @@ -141,6 +144,7 @@ let empty_config = ; menhir = Menhir_env.empty ; odoc = Odoc.empty ; js_of_ocaml = Js_of_ocaml.Env.empty + ; wasm_of_ocaml = Js_of_ocaml.Env.empty ; coq = Coq_env.default ; format_config = None ; error_on_use = None @@ -224,6 +228,13 @@ let js_of_ocaml_field = (Dune_lang.Syntax.since Stanza.syntax (3, 0) >>> Js_of_ocaml.Env.decode) ;; +let wasm_of_ocaml_field = + field + "wasm_of_ocaml" + ~default:Js_of_ocaml.Env.empty + (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> Js_of_ocaml.Env.decode) +;; + let bin_annot = field_o "bin_annot" (Dune_lang.Syntax.since Stanza.syntax (3, 8) >>> bool) let config = @@ -241,6 +252,7 @@ let config = and+ menhir_flags = menhir_flags ~since:(2, 1) ~deleted_in:Menhir_stanza.explain_since and+ odoc = odoc_field and+ js_of_ocaml = js_of_ocaml_field + and+ wasm_of_ocaml = wasm_of_ocaml_field and+ coq = Coq_env.decode and+ format_config = Format_config.field ~since:(2, 8) and+ bin_annot = bin_annot in @@ -261,6 +273,7 @@ let config = ; menhir ; odoc ; js_of_ocaml + ; wasm_of_ocaml ; coq ; format_config ; error_on_use = None diff --git a/src/dune_rules/dune_env.mli b/src/dune_rules/dune_env.mli index a1d46d8c330e..d904e237f7ff 100644 --- a/src/dune_rules/dune_env.mli +++ b/src/dune_rules/dune_env.mli @@ -30,6 +30,7 @@ type config = ; menhir : Ordered_set_lang.Unexpanded.t Menhir_env.t ; odoc : Odoc.t ; js_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t + ; wasm_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t ; coq : Coq_env.t ; format_config : Format_config.t option ; error_on_use : User_message.t option diff --git a/src/dune_rules/exe.ml b/src/dune_rules/exe.ml index 23941e5e22fe..3eaa16f1adf7 100644 --- a/src/dune_rules/exe.ml +++ b/src/dune_rules/exe.ml @@ -10,28 +10,47 @@ module Program = struct end module Linkage = struct + type mode = + | Ocaml of Link_mode.t + | Jsoo of Js_of_ocaml.Mode.t + type t = - { mode : Link_mode.t + { mode : mode ; ext : string ; flags : string list } - let byte = { mode = Byte; ext = ".bc"; flags = [] } + let byte = { mode = Ocaml Byte; ext = ".bc"; flags = [] } let byte_for_jsoo = - { mode = Byte_for_jsoo + { mode = Ocaml Byte_for_jsoo ; ext = ".bc-for-jsoo" ; flags = [ "-no-check-prims"; "-noautolink" ] } ;; - let native = { mode = Native; ext = ".exe"; flags = [] } - let is_native x = x.mode = Native - let is_js x = x.mode = Byte && x.ext = Js_of_ocaml.Ext.exe ~submode:JS - let is_byte x = x.mode = Byte && not (is_js x) + let native = { mode = Ocaml Native; ext = ".exe"; flags = [] } + + let is_native x = + match x.mode with + | Ocaml Native -> true + | _ -> false + ;; + + let is_jsoo ~mode x = + match x.mode with + | Jsoo m -> Js_of_ocaml.Mode.equal mode m + | _ -> false + ;; + + let is_byte x = + match x.mode with + | Ocaml Byte -> true + | _ -> false + ;; let custom_with_ext ~ext ocaml_version = - { mode = Byte_with_stubs_statically_linked_in + { mode = Ocaml Byte_with_stubs_statically_linked_in ; ext ; flags = [ Ocaml.Version.custom_or_output_complete_exe ocaml_version ] } @@ -45,7 +64,8 @@ module Linkage = struct | Ok _ -> native ;; - let js = { mode = Byte; ext = Js_of_ocaml.Ext.exe ~submode:JS; flags = [] } + let js = { mode = Jsoo JS; ext = Js_of_ocaml.Ext.exe ~mode:JS; flags = [] } + let wasm = { mode = Jsoo Wasm; ext = Js_of_ocaml.Ext.exe ~mode:Wasm; flags = [] } let is_plugin t = List.mem (List.map ~f:Mode.plugin_ext Mode.all) t.ext ~equal:String.equal @@ -65,7 +85,8 @@ module Linkage = struct (m : Executables.Link_mode.t) = match m with - | Other { mode = Byte; kind = Js } -> js + | Jsoo JS -> js + | Jsoo Wasm -> wasm | _ -> let link_mode : Link_mode.t = match m with @@ -85,6 +106,7 @@ module Linkage = struct if Result.is_ok ocaml.ocamlopt then Native else Byte_with_stubs_statically_linked_in) + | Jsoo _ -> assert false (* Handled above *) in let ext = let lib_config = ocaml.lib_config in @@ -100,7 +122,6 @@ module Linkage = struct | Other { kind; _ } -> (match kind with | C -> c_flags - | Js -> [] | Exe -> (match link_mode with | Byte_with_stubs_statically_linked_in -> @@ -126,8 +147,9 @@ module Linkage = struct List.concat_map native_c_libraries ~f:(fun flag -> [ "-cclib"; flag ]) @ so_flags | Byte | Byte_for_jsoo | Byte_with_stubs_statically_linked_in -> so_flags)) + | Jsoo _ -> assert false (* Handled above *) in - { ext; mode = link_mode; flags } + { ext; mode = Ocaml link_mode; flags } ;; end @@ -139,6 +161,7 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) + ~linkage_mode ~cm_files ~link_time_code_gen ~promote @@ -150,7 +173,7 @@ let link_exe let sctx = Compilation_context.super_context cctx in let ctx = Super_context.context sctx in let dir = Compilation_context.dir cctx in - let mode = Link_mode.mode linkage.mode in + let mode = Link_mode.mode linkage_mode in let exe = exe_path_from_name cctx ~name ~linkage in let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode in let fdo_linker_script = Fdo.Linker_script.create cctx (Path.build exe) in @@ -199,7 +222,7 @@ let link_exe sctx to_link ~lib_config:ocaml.lib_config - ~mode:linkage.mode + ~mode:linkage_mode ]) ; Deps o_files ; Dyn (Action_builder.map top_sorted_cms ~f:(fun x -> Command.Args.Deps x)) @@ -227,10 +250,12 @@ let link_js ~link_args ~promote ~link_time_code_gen + ~jsoo_mode cctx = let in_context = Compilation_context.js_of_ocaml cctx + |> Js_of_ocaml.Mode.Pair.select ~mode:jsoo_mode |> Option.value ~default:Js_of_ocaml.In_context.default in let src = exe_path_from_name cctx ~name ~linkage:Linkage.byte_for_jsoo in @@ -252,6 +277,7 @@ let link_js ~promote ~link_time_code_gen ~linkall + ~jsoo_mode ;; type dep_graphs = { for_exes : Module.t list Action_builder.t list } @@ -302,8 +328,8 @@ let link_many in let+ () = Memo.parallel_iter linkages ~f:(fun linkage -> - if Linkage.is_js linkage - then ( + match linkage.Linkage.mode with + | Jsoo jsoo_mode -> let obj_dir = Compilation_context.obj_dir cctx in link_js ~loc @@ -313,8 +339,9 @@ let link_many ~promote ~link_args cctx - ~link_time_code_gen) - else + ~link_time_code_gen + ~jsoo_mode + | Ocaml linkage_mode -> let* link_time_code_gen = match Linkage.is_plugin linkage with | false -> Memo.return link_time_code_gen @@ -328,7 +355,7 @@ let link_many in let link_args, o_files = let select_o_files = Mode.Map.Multi.for_only ~and_all:true o_files in - match linkage.mode with + match linkage_mode with | Native -> link_args, select_o_files Mode.Native | Byte | Byte_for_jsoo | Byte_with_stubs_statically_linked_in -> link_args, select_o_files Mode.Byte @@ -338,6 +365,7 @@ let link_many ~loc ~name ~linkage + ~linkage_mode ~cm_files ~link_time_code_gen ~promote diff --git a/src/dune_rules/exe.mli b/src/dune_rules/exe.mli index 0fdc14db1eda..a1e2fd6338e9 100644 --- a/src/dune_rules/exe.mli +++ b/src/dune_rules/exe.mli @@ -33,8 +33,11 @@ module Linkage : sig (** Javascript compilation, extension [.bc.js] *) val js : t + (** Wasm compilation, extension [.bc.wasm.js] *) + val wasm : t + val is_native : t -> bool - val is_js : t -> bool + val is_jsoo : mode:Js_of_ocaml.Mode.t -> t -> bool val is_byte : t -> bool val of_user_config diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 528c2fb768b8..6040869a2ad8 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -8,13 +8,19 @@ let linkages (ocaml : Ocaml_toolchain.t) ~(exes : Executables.t) ~explicit_js_mode - ~(jsoo_compilation_mode : Js_of_ocaml.Compilation_mode.t) + ~jsoo_enabled_modes + ~jsoo_is_whole_program = let module L = Executables.Link_mode in let l = let has_native = Result.is_ok ocaml.ocamlopt in let modes = L.Map.to_list exes.modes + |> List.filter ~f:(fun (mode, _) -> + match mode with + | Executables.Link_mode.Jsoo mode -> + Js_of_ocaml.Mode.Pair.select ~mode jsoo_enabled_modes + | Byte_complete | Other _ -> true) |> List.map ~f:(fun (mode, loc) -> Exe.Linkage.of_user_config ocaml ~dynamically_linked_foreign_archives ~loc mode) in @@ -24,20 +30,31 @@ let linkages else List.filter modes ~f:(fun x -> not (Exe.Linkage.is_native x)) in let modes = - if L.Map.mem exes.modes L.js + if L.Map.existsi ~f:(fun m _ -> L.is_jsoo m) exes.modes then ( - match jsoo_compilation_mode with - | Whole_program -> Exe.Linkage.byte_for_jsoo :: modes - | Separate_compilation -> modes) + let jsoo_bytecode_exe_needed = + Js_of_ocaml.Mode.Set.inter jsoo_enabled_modes jsoo_is_whole_program + in + let bytecode_exe_needed = + L.Map.foldi + ~f:(fun m _ p -> + match m with + | Executables.Link_mode.Jsoo mode -> + Js_of_ocaml.Mode.Pair.select ~mode jsoo_bytecode_exe_needed || p + | Byte_complete | Other _ -> p) + ~init:false + exes.modes + in + if bytecode_exe_needed then Exe.Linkage.byte_for_jsoo :: modes else modes) else if explicit_js_mode then modes else if L.Map.mem exes.modes L.byte then Exe.Linkage.js :: - (match jsoo_compilation_mode with - | Whole_program -> Exe.Linkage.byte_for_jsoo :: modes - | Separate_compilation -> modes) + (if Js_of_ocaml.Mode.Pair.select ~mode:JS jsoo_is_whole_program + then Exe.Linkage.byte_for_jsoo :: modes + else modes) else modes in modes @@ -143,8 +160,11 @@ let executables_rules let* ocaml = Context.ocaml ctx in let project = Scope.project scope in let explicit_js_mode = Dune_project.explicit_js_mode project in + let js_of_ocaml = Js_of_ocaml.In_context.make ~dir exes.buildable.js_of_ocaml in let* linkages = - let* jsoo_compilation_mode = Jsoo_rules.js_of_ocaml_compilation_mode sctx ~dir in + let* jsoo_enabled_modes = + Jsoo_rules.jsoo_enabled_modes ~expander ~dir ~in_context:js_of_ocaml + and* jsoo_is_whole_program = Jsoo_rules.jsoo_is_whole_program sctx ~dir in let+ dynamically_linked_foreign_archives = Context.dynamically_linked_foreign_archives ctx in @@ -153,7 +173,8 @@ let executables_rules ~dynamically_linked_foreign_archives ~exes ~explicit_js_mode - ~jsoo_compilation_mode + ~jsoo_enabled_modes + ~jsoo_is_whole_program in let* flags = Buildable_rules.ocaml_flags sctx ~dir exes.buildable.flags in let* modules, pp = @@ -173,10 +194,12 @@ let executables_rules let requires_compile = Lib.Compile.direct_requires compile_info in let requires_link = Lib.Compile.requires_link compile_info in let js_of_ocaml = - let js_of_ocaml = Js_of_ocaml.In_context.make ~dir exes.buildable.js_of_ocaml in - if explicit_js_mode - then Option.some_if (List.exists linkages ~f:Exe.Linkage.is_js) js_of_ocaml - else Some js_of_ocaml + Js_of_ocaml.Mode.Pair.mapi + ~f:(fun mode x -> + Option.some_if + ((not explicit_js_mode) || List.exists linkages ~f:(Exe.Linkage.is_jsoo ~mode)) + x) + js_of_ocaml in Compilation_context.create () diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 9e23ac387062..47bc054b2c70 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -137,8 +137,8 @@ end = struct js = Some (List.map (Nonempty_list.to_list exes.names) ~f:(fun (_, exe) -> - [ Path.Build.relative dir (exe ^ Js_of_ocaml.Ext.exe ~submode:JS) - ; Path.Build.relative dir (exe ^ Js_of_ocaml.Ext.exe ~submode:Wasm) + [ Path.Build.relative dir (exe ^ Js_of_ocaml.Ext.exe ~mode:JS) + ; Path.Build.relative dir (exe ^ Js_of_ocaml.Ext.exe ~mode:Wasm) ]) |> List.flatten) }) @@ -526,7 +526,7 @@ let gen_rules_regular_directory sctx ~src_dir ~components ~dir = let+ directory_targets = Dir_status.directory_targets dir_status - ~jsoo_submodes:Jsoo_rules.jsoo_submodes + ~jsoo_enabled:Jsoo_rules.jsoo_enabled ~dir in let allowed_subdirs = diff --git a/src/dune_rules/inline_tests.ml b/src/dune_rules/inline_tests.ml index b0373fae1806..6bd1406d518f 100644 --- a/src/dune_rules/inline_tests.ml +++ b/src/dune_rules/inline_tests.ml @@ -68,18 +68,6 @@ include Sub_system.Register_end_point (struct module Mode_conf = Inline_tests_info.Mode_conf module Info = Inline_tests_info.Tests - let configurations ~dir modes submodes = - let open Memo.O in - Memo.sequential_map (Mode_conf.Set.to_list modes) ~f:(fun (mode : Mode_conf.t) -> - match mode with - | Native | Best -> Memo.return [ mode, ".exe" ] - | Byte -> Memo.return [ mode, ".bc" ] - | Javascript -> - let+ submodes = Jsoo_rules.jsoo_submodes ~dir ~submodes in - List.map submodes ~f:(fun submode -> mode, Js_of_ocaml.Ext.exe ~submode)) - >>| List.flatten - ;; - let gen_rules c ~expander ~(info : Info.t) ~backends = let { Sub_system.Library_compilation_context.super_context = sctx ; dir @@ -119,6 +107,12 @@ include Sub_system.Register_end_point (struct Lib.closure ~linking:true ((lib :: libs) @ more_libs) in (* Generate the runner file *) + let js_of_ocaml = + Js_of_ocaml.Mode.Pair.map + ~f:(fun (x : Js_of_ocaml.In_context.t) -> + { x with javascript_files = []; wasm_files = [] }) + (Js_of_ocaml.In_context.make ~dir lib.buildable.js_of_ocaml) + in let* () = Super_context.add_rule sctx @@ -162,11 +156,6 @@ include Sub_system.Register_end_point (struct Buildable_rules.ocaml_flags sctx ~dir info.executable_ocaml_flags in let flags = Ocaml_flags.append_common ocaml_flags [ "-w"; "-24"; "-g" ] in - let js_of_ocaml = - Js_of_ocaml.In_context.make - ~dir - { lib.buildable.js_of_ocaml with javascript_files = []; wasm_files = [] } - in Compilation_context.create () ~super_context:sctx @@ -177,23 +166,37 @@ include Sub_system.Register_end_point (struct ~requires_compile:runner_libs ~requires_link:(Memo.lazy_ (fun () -> runner_libs)) ~flags - ~js_of_ocaml:(Some js_of_ocaml) + ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.map ~f:Option.some js_of_ocaml) ~melange_package_name:None ~package in + let* modes = + let+ jsoo_enabled_modes = + Jsoo_rules.jsoo_enabled_modes ~expander ~dir ~in_context:js_of_ocaml + in + Mode_conf.Set.to_list info.modes + |> List.filter ~f:(fun (mode : Mode_conf.t) -> + match mode with + | Native | Best | Byte -> true + | Jsoo mode -> Js_of_ocaml.Mode.Pair.select ~mode jsoo_enabled_modes) + in let* linkages = - let+ jsoo_compilation_mode = Jsoo_rules.js_of_ocaml_compilation_mode sctx ~dir in + let+ jsoo_is_whole_program = Jsoo_rules.jsoo_is_whole_program sctx ~dir in let ocaml = Compilation_context.ocaml cctx in - List.concat_map (Mode_conf.Set.to_list info.modes) ~f:(fun (mode : Mode_conf.t) -> + List.concat_map modes ~f:(fun (mode : Mode_conf.t) -> match mode with | Native -> [ Exe.Linkage.native ] | Best -> [ Exe.Linkage.native_or_custom ocaml ] | Byte -> [ Exe.Linkage.custom_with_ext ~ext:".bc" ocaml.version ] - | Javascript -> - (match jsoo_compilation_mode with - | Js_of_ocaml.Compilation_mode.Whole_program -> - [ Exe.Linkage.js; Exe.Linkage.byte_for_jsoo ] - | Separate_compilation -> [ Exe.Linkage.js ])) + | Jsoo jsoo_mode -> + let linkage = + match jsoo_mode with + | JS -> Exe.Linkage.js + | Wasm -> Exe.Linkage.wasm + in + if Js_of_ocaml.Mode.Pair.select ~mode:jsoo_mode jsoo_is_whole_program + then [ Exe.Linkage.byte_for_jsoo; linkage ] + else [ linkage ]) in let* (_ : Exe.dep_graphs) = let link_args = @@ -249,18 +252,21 @@ include Sub_system.Register_end_point (struct else Sandbox_config.needs_sandboxing in let deps, sandbox = Dep_conf_eval.unnamed ~sandbox info.deps ~expander in - let action - (mode : Mode_conf.t) - (ext : string) - (flags : string list Action_builder.t) + let action (mode : Mode_conf.t) (flags : string list Action_builder.t) : Action.t Action_builder.t = (* [action] needs to run from [dir] as we use [dir] to resolve the exe path in case of a custom [runner] *) + let ext = + match mode with + | Native | Best -> ".exe" + | Jsoo mode -> Js_of_ocaml.Ext.exe ~mode + | Byte -> ".bc" + in let custom_runner = match mode with | Native | Best | Byte -> None - | Javascript -> Some Jsoo_rules.runner + | Jsoo _ -> Some Jsoo_rules.runner in let exe = Path.build (Path.Build.relative inline_test_dir (name ^ ext)) in let open Action_builder.O in @@ -317,8 +323,7 @@ include Sub_system.Register_end_point (struct List.concat l in let source_files = List.concat_map source_modules ~f:Module.sources in - let* confs = configurations ~dir info.modes lib.buildable.js_of_ocaml.submodes in - Memo.parallel_iter confs ~f:(fun ((mode : Mode_conf.t), ext) -> + Memo.parallel_iter modes ~f:(fun (mode : Mode_conf.t) -> let partition_file = Path.Build.relative inline_test_dir ("partitions-" ^ Mode_conf.to_string mode) in @@ -327,7 +332,7 @@ include Sub_system.Register_end_point (struct | None -> Memo.return () | Some partitions_flags -> let open Action_builder.O in - action mode ext partitions_flags + action mode partitions_flags >>| Action.Full.make ~sandbox |> Action_builder.with_stdout_to partition_file |> Super_context.add_rule sctx ~dir ~loc @@ -335,7 +340,7 @@ include Sub_system.Register_end_point (struct let* runtest_alias = match mode with | Native | Best | Byte -> Memo.return Alias0.runtest - | Javascript -> Jsoo_rules.js_of_ocaml_runtest_alias ~dir + | Jsoo mode -> Jsoo_rules.js_of_ocaml_runtest_alias ~dir ~mode in Super_context.add_alias_action sctx @@ -351,7 +356,7 @@ include Sub_system.Register_end_point (struct let+ partitions = Action_builder.lines_of (Path.build partition_file) in List.map ~f:(fun x -> Some x) partitions in - List.map partitions_flags ~f:(fun p -> action mode ext (flags p)) + List.map partitions_flags ~f:(fun p -> action mode (flags p)) |> Action_builder.all and+ () = Action_builder.paths source_files in match actions with diff --git a/src/dune_rules/inline_tests_info.ml b/src/dune_rules/inline_tests_info.ml index 44772b2977f0..47e247aa7bac 100644 --- a/src/dune_rules/inline_tests_info.ml +++ b/src/dune_rules/inline_tests_info.ml @@ -68,7 +68,7 @@ module Mode_conf = struct module T = struct type t = | Byte - | Javascript + | Jsoo of Js_of_ocaml.Mode.t | Native | Best @@ -77,9 +77,9 @@ module Mode_conf = struct | Byte, Byte -> Eq | Byte, _ -> Lt | _, Byte -> Gt - | Javascript, Javascript -> Eq - | Javascript, _ -> Lt - | _, Javascript -> Gt + | Jsoo m, Jsoo m' -> Js_of_ocaml.Mode.compare m m' + | Jsoo _, _ -> Lt + | _, Jsoo _ -> Gt | Native, Native -> Eq | Native, _ -> Lt | _, Native -> Gt @@ -94,12 +94,16 @@ module Mode_conf = struct let to_string = function | Byte -> "byte" - | Javascript -> "js" + | Jsoo JS -> "js" + | Jsoo Wasm -> "wasm" | Native -> "native" | Best -> "best" ;; - let decode = enum [ "byte", Byte; "js", Javascript; "native", Native; "best", Best ] + let decode = + enum [ "byte", Byte; "js", Jsoo JS; "native", Native; "best", Best ] + <|> sum [ "wasm", Syntax.since Stanza.syntax (3, 17) >>> return (Jsoo Wasm) ] + ;; module O = Comparable.Make (T) module Map = O.Map diff --git a/src/dune_rules/inline_tests_info.mli b/src/dune_rules/inline_tests_info.mli index af486d637861..2135df4aa882 100644 --- a/src/dune_rules/inline_tests_info.mli +++ b/src/dune_rules/inline_tests_info.mli @@ -16,7 +16,7 @@ end module Mode_conf : sig type t = | Byte - | Javascript + | Jsoo of Js_of_ocaml.Mode.t | Native | Best diff --git a/src/dune_rules/jsoo/js_of_ocaml.ml b/src/dune_rules/jsoo/js_of_ocaml.ml index 3ee467e80bda..883c19437be1 100644 --- a/src/dune_rules/jsoo/js_of_ocaml.ml +++ b/src/dune_rules/jsoo/js_of_ocaml.ml @@ -1,8 +1,8 @@ open Import open Dune_lang.Decoder -(* (js_of_ocaml ...) options are also used when producing Wasm code - with wasm_of_ocaml, since the compilation process is similar and +(* We use the same set of options when producing Wasm code with + wasm_of_ocaml, since the compilation process is similar and generates a JavaScript file with basically the same behavior. *) let field_oslu name = Ordered_set_lang.Unexpanded.field name @@ -24,6 +24,78 @@ module Sourcemap = struct ;; end +module Mode = struct + type t = + | JS + | Wasm + + let equal = Poly.equal + + let select ~mode js wasm = + match mode with + | JS -> js + | Wasm -> wasm + ;; + + let compare m m' = + match m, m' with + | JS, JS -> Eq + | JS, _ -> Lt + | _, JS -> Gt + | Wasm, Wasm -> Eq + ;; + + let decode = + let open Dune_sexp in + let open Decoder in + sum [ "js", return JS; "wasm", return Wasm ] + ;; + + let to_string s = + match s with + | JS -> "js" + | Wasm -> "wasm" + ;; + + let to_dyn t = Dyn.variant (to_string t) [] + let encode t = Dune_sexp.atom (to_string t) + + module Pair = struct + type 'a t = + { js : 'a + ; wasm : 'a + } + + let select ~mode { js; wasm } = + match mode with + | JS -> js + | Wasm -> wasm + ;; + + let make v = { js = v; wasm = v } + let init ~f = { js = f JS; wasm = f Wasm } + let map ~f { js; wasm } = { js = f js; wasm = f wasm } + let mapi ~f { js; wasm } = { js = f JS js; wasm = f Wasm wasm } + + let map2 ~f { js; wasm } { js = js'; wasm = wasm' } = + { js = f js js'; wasm = f wasm wasm' } + ;; + end + + module Set = struct + type t = bool Pair.t + + let inter = Pair.map2 ~f:( && ) + let union = Pair.map2 ~f:( || ) + let is_empty (x : t) = not (x.js || x.wasm) + + let to_list (x : t) = + let l = if x.wasm then [ Wasm ] else [] in + if x.js then JS :: l else l + ;; + end +end + module Flags = struct type 'flags t = { build_runtime : 'flags @@ -81,55 +153,25 @@ module Flags = struct { build_runtime; compile; link } ;; - let dump t = + let dump ~mode t = let open Action_builder.O in let+ build_runtime = t.build_runtime and+ compile = t.compile and+ link = t.link in + let prefix = + match mode with + | Mode.JS -> "js" + | Wasm -> "wasm" + in List.map ~f:Dune_lang.Encoder.(pair string (list string)) - [ "js_of_ocaml_flags", compile - ; "js_of_ocaml_build_runtime_flags", build_runtime - ; "js_of_ocaml_link_flags", link + [ prefix ^ "_of_ocaml_flags", compile + ; prefix ^ "_of_ocaml_build_runtime_flags", build_runtime + ; prefix ^ "_of_ocaml_link_flags", link ] ;; end -module Submode = struct - type t = - | JS - | Wasm - - let equal = Poly.equal - - module Set = struct - type t = - { js : bool - ; wasm : bool - } - - let empty = { js = false; wasm = false } - - let add t = function - | JS -> { t with js = true } - | Wasm -> { t with wasm = true } - ;; - - let decode = - enum [ "js", JS; "wasm", Wasm ] - |> repeat1 - |> map ~f:(List.fold_left ~init:empty ~f:add) - ;; - - let equal x y = x.js = y.js && x.wasm = y.wasm - - let to_list x = - let l = if x.wasm then [ Wasm ] else [] in - if x.js then JS :: l else l - ;; - end -end - module Compilation_mode = struct type t = | Whole_program @@ -149,14 +191,14 @@ end module In_buildable = struct type t = { flags : Ordered_set_lang.Unexpanded.t Flags.t - ; submodes : Submode.Set.t option + ; enabled_if : Blang.t option ; javascript_files : string list ; wasm_files : string list ; compilation_mode : Compilation_mode.t option ; sourcemap : Sourcemap.t option } - let decode ~executable = + let decode ~executable ~mode = let* syntax_version = Dune_lang.Syntax.get_exn Stanza.syntax in if syntax_version < (3, 0) then @@ -168,7 +210,7 @@ module In_buildable = struct ; compile = flags ; link = flags (* we set link as well to preserve the old semantic *) } - ; submodes = None + ; enabled_if = Some Blang.true_ ; javascript_files ; wasm_files = [] ; compilation_mode = None @@ -177,16 +219,19 @@ module In_buildable = struct else fields (let+ flags = Flags.decode - and+ submodes = + and+ enabled_if = field_o - "submodes" - (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> Submode.Set.decode) + "enabled_if" + (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> Blang.decode) and+ javascript_files = field "javascript_files" (repeat string) ~default:[] and+ wasm_files = - field - "wasm_files" - (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> repeat string) - ~default:[] + match mode with + | Mode.JS -> return [] + | Wasm -> + field + "wasm_files" + (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> repeat string) + ~default:[] and+ compilation_mode = if executable then @@ -202,12 +247,12 @@ module In_buildable = struct (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> Sourcemap.decode) else return None in - { flags; submodes; javascript_files; wasm_files; compilation_mode; sourcemap }) + { flags; enabled_if; javascript_files; wasm_files; compilation_mode; sourcemap }) ;; let default = { flags = Flags.standard - ; submodes = None + ; enabled_if = None ; javascript_files = [] ; wasm_files = [] ; compilation_mode = None @@ -219,16 +264,16 @@ end module In_context = struct type t = { flags : Ordered_set_lang.Unexpanded.t Flags.t - ; submodes : Submode.Set.t option + ; enabled_if : Blang.t option ; javascript_files : Path.Build.t list ; wasm_files : Path.Build.t list ; compilation_mode : Compilation_mode.t option ; sourcemap : Sourcemap.t option } - let make ~(dir : Path.Build.t) (x : In_buildable.t) = + let make_one ~(dir : Path.Build.t) (x : In_buildable.t) = { flags = x.flags - ; submodes = x.submodes + ; enabled_if = x.enabled_if ; javascript_files = List.map ~f:(fun name -> Path.Build.relative dir name) x.javascript_files ; wasm_files = List.map ~f:(fun name -> Path.Build.relative dir name) x.wasm_files @@ -237,9 +282,11 @@ module In_context = struct } ;; + let make ~dir x = Mode.Pair.map ~f:(fun x -> make_one ~dir x) x + let default = { flags = Flags.standard - ; submodes = None + ; enabled_if = None ; javascript_files = [] ; wasm_files = [] ; compilation_mode = None @@ -251,16 +298,10 @@ end module Ext = struct type t = string - let select ~submode js wasm = - match submode with - | Submode.JS -> js - | Wasm -> wasm - ;; - - let exe ~submode = select ~submode ".bc.js" ".bc.wasm.js" - let cmo ~submode = select ~submode ".cmo.js" ".wasmo" - let cma ~submode = select ~submode ".cma.js" ".wasma" - let runtime ~submode = select ~submode ".bc.runtime.js" ".bc.runtime.wasma" + let exe ~mode = Mode.select ~mode ".bc.js" ".bc.wasm.js" + let cmo ~mode = Mode.select ~mode ".cmo.js" ".wasmo" + let cma ~mode = Mode.select ~mode ".cma.js" ".wasma" + let runtime ~mode = Mode.select ~mode ".bc.runtime.js" ".bc.runtime.wasma" let wasm_dir = ".bc.wasm.assets" end @@ -270,7 +311,7 @@ module Env = struct ; sourcemap : Sourcemap.t option ; runtest_alias : Alias.Name.t option ; flags : 'a Flags.t - ; submodes : Submode.Set.t option + ; enabled_if : Blang.t option } let decode = @@ -282,25 +323,25 @@ module Env = struct (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> Sourcemap.decode) and+ runtest_alias = field_o "runtest_alias" Dune_lang.Alias.decode and+ flags = Flags.decode - and+ submodes = + and+ enabled_if = field_o - "submodes" - (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> Submode.Set.decode) + "enabled_if" + (Dune_lang.Syntax.since Stanza.syntax (3, 17) >>> Blang.decode) in Option.iter ~f:Alias0.register_as_standard runtest_alias; - { compilation_mode; sourcemap; runtest_alias; flags; submodes } + { compilation_mode; sourcemap; runtest_alias; flags; enabled_if } ;; - let equal { compilation_mode; sourcemap; submodes; runtest_alias; flags } t = + let equal { compilation_mode; sourcemap; enabled_if; runtest_alias; flags } t = Option.equal Compilation_mode.equal compilation_mode t.compilation_mode && Option.equal Sourcemap.equal sourcemap t.sourcemap && Option.equal Alias.Name.equal runtest_alias t.runtest_alias && Flags.equal Ordered_set_lang.Unexpanded.equal flags t.flags - && Option.equal Submode.Set.equal submodes t.submodes + && Option.equal Blang.equal enabled_if t.enabled_if ;; - let map ~f { compilation_mode; sourcemap; runtest_alias; flags; submodes } = - { compilation_mode; sourcemap; runtest_alias; flags = Flags.map ~f flags; submodes } + let map ~f { compilation_mode; sourcemap; runtest_alias; flags; enabled_if } = + { compilation_mode; sourcemap; runtest_alias; flags = Flags.map ~f flags; enabled_if } ;; let empty = @@ -308,7 +349,7 @@ module Env = struct ; sourcemap = None ; runtest_alias = None ; flags = Flags.standard - ; submodes = None + ; enabled_if = None } ;; @@ -317,7 +358,7 @@ module Env = struct ; sourcemap = None ; runtest_alias = None ; flags = Flags.default ~profile - ; submodes = None + ; enabled_if = Some Blang.true_ } ;; end diff --git a/src/dune_rules/jsoo/js_of_ocaml.mli b/src/dune_rules/jsoo/js_of_ocaml.mli index 2294e9e8051f..429155fef4ec 100644 --- a/src/dune_rules/jsoo/js_of_ocaml.mli +++ b/src/dune_rules/jsoo/js_of_ocaml.mli @@ -1,5 +1,42 @@ open Import +module Mode : sig + type t = + | JS + | Wasm + + type mode := t + + val select : mode:t -> 'a -> 'a -> 'a + val equal : t -> t -> bool + val compare : t -> t -> Ordering.t + val decode : t Dune_lang.Decoder.t + val encode : t Dune_lang.Encoder.t + val to_dyn : t -> Dyn.t + + module Pair : sig + type 'a t = + { js : 'a + ; wasm : 'a + } + + val select : mode:mode -> 'a t -> 'a + val make : 'a -> 'a t + val init : f:(mode -> 'a) -> 'a t + val map : f:('a -> 'b) -> 'a t -> 'b t + val mapi : f:(mode -> 'a -> 'b) -> 'a t -> 'b t + end + + module Set : sig + type t = bool Pair.t + + val inter : t -> t -> t + val union : t -> t -> t + val to_list : t -> mode list + val is_empty : t -> bool + end +end + module Flags : sig type 'flags t = { build_runtime : 'flags @@ -26,7 +63,10 @@ module Flags : sig -> string list Action_builder.t) -> string list Action_builder.t t - val dump : string list Action_builder.t t -> Dune_lang.t list Action_builder.t + val dump + : mode:Mode.t + -> string list Action_builder.t t + -> Dune_lang.t list Action_builder.t end module Sourcemap : sig @@ -36,25 +76,6 @@ module Sourcemap : sig | File end -module Submode : sig - type t = - | JS - | Wasm - - type submode := t - - val equal : t -> t -> bool - - module Set : sig - type t = - { js : bool - ; wasm : bool - } - - val to_list : t -> submode list - end -end - module Compilation_mode : sig type t = | Whole_program @@ -64,38 +85,38 @@ end module In_buildable : sig type t = { flags : Flags.Spec.t - ; submodes : Submode.Set.t option + ; enabled_if : Blang.t option ; javascript_files : string list ; wasm_files : string list ; compilation_mode : Compilation_mode.t option ; sourcemap : Sourcemap.t option } - val decode : executable:bool -> t Dune_lang.Decoder.t + val decode : executable:bool -> mode:Mode.t -> t Dune_lang.Decoder.t val default : t end module In_context : sig type t = { flags : Flags.Spec.t - ; submodes : Submode.Set.t option + ; enabled_if : Blang.t option ; javascript_files : Path.Build.t list ; wasm_files : Path.Build.t list ; compilation_mode : Compilation_mode.t option ; sourcemap : Sourcemap.t option } - val make : dir:Path.Build.t -> In_buildable.t -> t + val make : dir:Path.Build.t -> In_buildable.t Mode.Pair.t -> t Mode.Pair.t val default : t end module Ext : sig type t = string - val exe : submode:Submode.t -> t - val cmo : submode:Submode.t -> t - val cma : submode:Submode.t -> t - val runtime : submode:Submode.t -> t + val exe : mode:Mode.t -> t + val cmo : mode:Mode.t -> t + val cma : mode:Mode.t -> t + val runtime : mode:Mode.t -> t val wasm_dir : t end @@ -105,7 +126,7 @@ module Env : sig ; sourcemap : Sourcemap.t option ; runtest_alias : Alias.Name.t option ; flags : 'a Flags.t - ; submodes : Submode.Set.t option + ; enabled_if : Blang.t option } val map : f:('a -> 'b) -> 'a t -> 'b t diff --git a/src/dune_rules/jsoo/jsoo_rules.ml b/src/dune_rules/jsoo/jsoo_rules.ml index 0b5e2b7ba4fd..aed29b644291 100644 --- a/src/dune_rules/jsoo/jsoo_rules.ml +++ b/src/dune_rules/jsoo/jsoo_rules.ml @@ -1,7 +1,7 @@ open Import open Memo.O -let jsoo_env = +let compute_env ~mode = let f = Env_stanza_db_flags.flags ~name:"jsoo-env" @@ -9,12 +9,21 @@ let jsoo_env = let+ profile = Per_context.profile ctx in Js_of_ocaml.Env.(map ~f:Action_builder.return (default ~profile))) ~f:(fun ~parent expander (local : Dune_env.config) -> - let local = local.js_of_ocaml in - let+ parent = parent in + let local = Js_of_ocaml.Mode.select ~mode local.js_of_ocaml local.wasm_of_ocaml in + let* parent = parent in + let+ enabled_if = + match local.enabled_if with + | None -> + Memo.return + (match parent.enabled_if with + | Some (Const default) -> default + | _ -> assert false) + | Some enabled_if -> Expander.eval_blang expander enabled_if + in { Js_of_ocaml.Env.compilation_mode = Option.first_some local.compilation_mode parent.compilation_mode ; sourcemap = Option.first_some local.sourcemap parent.sourcemap - ; submodes = Option.first_some local.submodes parent.submodes + ; enabled_if = Some (Const enabled_if) ; runtest_alias = Option.first_some local.runtest_alias parent.runtest_alias ; flags = Js_of_ocaml.Flags.make @@ -28,6 +37,10 @@ let jsoo_env = (Staged.unstage f) dir ;; +let js_env = compute_env ~mode:JS +let wasm_env = compute_env ~mode:Wasm +let jsoo_env ~dir ~mode = (Js_of_ocaml.Mode.select ~mode js_env wasm_env) ~dir + module Config : sig type t @@ -205,11 +218,11 @@ type sub_command = | Link | Build_runtime -let js_of_ocaml_flags t ~dir (spec : Js_of_ocaml.Flags.Spec.t) = +let js_of_ocaml_flags t ~dir ~mode (spec : Js_of_ocaml.Flags.Spec.t) = Action_builder.of_memo @@ let+ expander = Super_context.expander t ~dir - and+ js_of_ocaml = jsoo_env ~dir in + and+ js_of_ocaml = jsoo_env ~dir ~mode in Js_of_ocaml.Flags.make ~spec ~default:js_of_ocaml.flags @@ -218,7 +231,7 @@ let js_of_ocaml_flags t ~dir (spec : Js_of_ocaml.Flags.Spec.t) = let js_of_ocaml_rule sctx - ~(submode : Js_of_ocaml.Submode.t) + ~(mode : Js_of_ocaml.Mode.t) ~sub_command ~dir ~(flags : _ Js_of_ocaml.Flags.t) @@ -230,12 +243,12 @@ let js_of_ocaml_rule = let open Action_builder.O in let jsoo = - match submode with + match mode with | JS -> jsoo ~dir sctx | Wasm -> wasmoo ~dir sctx in let flags = - let* flags = js_of_ocaml_flags sctx ~dir flags in + let* flags = js_of_ocaml_flags sctx ~dir ~mode flags in match sub_command with | Compile -> flags.compile | Link -> flags.link @@ -248,7 +261,7 @@ let js_of_ocaml_rule | Compile -> S [] | Link -> A "link" | Build_runtime -> A "build-runtime") - ; (match (sourcemap : Js_of_ocaml.Sourcemap.t), submode with + ; (match (sourcemap : Js_of_ocaml.Sourcemap.t), mode with | No, _ -> A "--no-source-map" | Inline, _ | File, Wasm -> (* With wasm_of_ocaml, source maps are always inline *) @@ -273,19 +286,19 @@ let js_of_ocaml_rule |> Action_builder.With_targets.add_directories ~directory_targets ;; -let jsoo_runtime_files ~(submode : Js_of_ocaml.Submode.t) libs = +let jsoo_runtime_files ~(mode : Js_of_ocaml.Mode.t) libs = List.concat_map libs ~f:(fun t -> - (match submode with + (match mode with | JS -> Lib_info.jsoo_runtime | Wasm -> Lib_info.wasmoo_runtime) (Lib.info t)) ;; -let standalone_runtime_rule ~submode cc ~runtime_files ~target ~flags = +let standalone_runtime_rule ~mode cc ~runtime_files ~target ~flags = let dir = Compilation_context.dir cc in let sctx = Compilation_context.super_context cc in let config = - js_of_ocaml_flags sctx ~dir flags + js_of_ocaml_flags sctx ~dir ~mode flags |> Action_builder.bind ~f:(fun (x : _ Js_of_ocaml.Flags.t) -> x.compile) |> Action_builder.map ~f:Config.of_flags in @@ -295,14 +308,14 @@ let standalone_runtime_rule ~submode cc ~runtime_files ~target ~flags = [ Resolve.Memo.args (let open Resolve.Memo.O in let+ libs = libs in - Command.Args.Deps (jsoo_runtime_files ~submode libs)) + Command.Args.Deps (jsoo_runtime_files ~mode libs)) ; Deps (List.map ~f:Path.build runtime_files) ] in let dir = Compilation_context.dir cc in js_of_ocaml_rule (Compilation_context.super_context cc) - ~submode + ~mode ~sub_command:Build_runtime ~dir ~flags @@ -312,7 +325,7 @@ let standalone_runtime_rule ~submode cc ~runtime_files ~target ~flags = ~config:(Some config) ;; -let exe_rule ~submode cc ~linkall ~runtime_files ~src ~target ~directory_targets ~flags = +let exe_rule ~mode cc ~linkall ~runtime_files ~src ~target ~directory_targets ~flags = let dir = Compilation_context.dir cc in let sctx = Compilation_context.super_context cc in let libs = Compilation_context.requires_link cc in @@ -336,7 +349,7 @@ let exe_rule ~submode cc ~linkall ~runtime_files ~src ~target ~directory_targets [ Resolve.Memo.args (let open Resolve.Memo.O in let+ libs = libs in - Command.Args.Deps (jsoo_runtime_files ~submode libs)) + Command.Args.Deps (jsoo_runtime_files ~mode libs)) ; Deps (List.map ~f:Path.build runtime_files) ; Dep (Path.build src) ; Dyn linkall @@ -344,7 +357,7 @@ let exe_rule ~submode cc ~linkall ~runtime_files ~src ~target ~directory_targets in js_of_ocaml_rule sctx - ~submode + ~mode ~sub_command:Compile ~dir ~spec @@ -354,14 +367,14 @@ let exe_rule ~submode cc ~linkall ~runtime_files ~src ~target ~directory_targets ~config:None ;; -let with_js_ext ~submode s = +let with_js_ext ~mode s = match Filename.split_extension s with - | name, ".cma" -> name ^ Js_of_ocaml.Ext.cma ~submode - | name, ".cmo" -> name ^ Js_of_ocaml.Ext.cmo ~submode + | name, ".cma" -> name ^ Js_of_ocaml.Ext.cma ~mode + | name, ".cmo" -> name ^ Js_of_ocaml.Ext.cmo ~mode | _ -> assert false ;; -let jsoo_archives ~submode ctx config lib = +let jsoo_archives ~mode ctx config lib = let info = Lib.info lib in let archives = Lib_info.archives info in match Lib.is_local lib with @@ -371,7 +384,7 @@ let jsoo_archives ~submode ctx config lib = in_obj_dir' ~obj_dir ~config:(Some config) - [ with_js_ext ~submode (Path.basename archive) ]) + [ with_js_ext ~mode (Path.basename archive) ]) | false -> List.map archives.byte ~f:(fun archive -> Path.build @@ -379,12 +392,12 @@ let jsoo_archives ~submode ctx config lib = ctx ~config [ Lib_name.to_string (Lib.name lib) - ; with_js_ext ~submode (Path.basename archive) + ; with_js_ext ~mode (Path.basename archive) ])) ;; let link_rule - ~submode + ~mode cc ~runtime ~target @@ -400,13 +413,13 @@ let link_rule let mod_name m = Module_name.Unique.artifact_filename (Module.obj_name m) - ~ext:(Js_of_ocaml.Ext.cmo ~submode) + ~ext:(Js_of_ocaml.Ext.cmo ~mode) in let ctx = Super_context.context sctx |> Context.build_context in let get_all = let open Action_builder.O in let+ config = - js_of_ocaml_flags sctx ~dir flags + js_of_ocaml_flags sctx ~dir ~mode flags |> Action_builder.bind ~f:(fun (x : _ Js_of_ocaml.Flags.t) -> x.compile) |> Action_builder.map ~f:Config.of_flags and+ cm = cm @@ -422,21 +435,21 @@ let link_rule META *) let stdlib = Path.build - (in_build_dir ctx ~config [ "stdlib"; "stdlib" ^ Js_of_ocaml.Ext.cma ~submode ]) + (in_build_dir ctx ~config [ "stdlib"; "stdlib" ^ Js_of_ocaml.Ext.cma ~mode ]) in let special_units = List.concat_map to_link ~f:(function | Lib_flags.Lib_and_module.Lib _lib -> [] | Module (obj_dir, m) -> [ in_obj_dir' ~obj_dir ~config:None [ mod_name m ] ]) in - let all_libs = List.concat_map libs ~f:(jsoo_archives ~submode ctx config) in + let all_libs = List.concat_map libs ~f:(jsoo_archives ~mode ctx config) in let all_other_modules = List.map cm ~f:(fun m -> Path.build (in_obj_dir ~obj_dir ~config:None [ mod_name m ])) in let std_exit = Path.build - (in_build_dir ctx ~config [ "stdlib"; "std_exit" ^ Js_of_ocaml.Ext.cmo ~submode ]) + (in_build_dir ctx ~config [ "stdlib"; "std_exit" ^ Js_of_ocaml.Ext.cmo ~mode ]) in let linkall = force_linkall || linkall in Command.Args.S @@ -455,7 +468,7 @@ let link_rule let spec = Command.Args.S [ Dep (Path.build runtime); Dyn get_all ] in js_of_ocaml_rule sctx - ~submode + ~mode ~sub_command:Link ~dir ~spec @@ -465,12 +478,12 @@ let link_rule ~config:None ;; -let build_cm' sctx ~dir ~in_context ~submode ~src ~target ~config ~sourcemap = +let build_cm' sctx ~dir ~in_context ~mode ~src ~target ~config ~sourcemap = let spec = Command.Args.Dep src in let flags = in_context.Js_of_ocaml.In_context.flags in js_of_ocaml_rule sctx - ~submode + ~mode ~sub_command:Compile ~dir ~flags @@ -481,16 +494,16 @@ let build_cm' sctx ~dir ~in_context ~submode ~src ~target ~config ~sourcemap = ~sourcemap ;; -let iter_submodes ~f = Memo.parallel_iter [ Js_of_ocaml.Submode.JS; Wasm ] ~f +let iter_jsoo_modes ~f = Memo.parallel_iter [ Js_of_ocaml.Mode.JS; Wasm ] ~f -let build_cm sctx ~dir ~in_context ~submode ~src ~obj_dir ~config = - let name = with_js_ext ~submode (Path.basename src) in +let build_cm sctx ~dir ~in_context ~mode ~src ~obj_dir ~config = + let name = with_js_ext ~mode (Path.basename src) in let target = in_obj_dir ~obj_dir ~config [ name ] in build_cm' sctx ~dir ~in_context - ~submode + ~mode ~src ~target ~config:(Option.map config ~f:Action_builder.return) @@ -524,14 +537,14 @@ let setup_separate_compilation_rules sctx components = archive "stdlib.cma" :: archive "std_exit.cmo" :: archives | _ -> archives in - iter_submodes ~f:(fun submode -> + iter_jsoo_modes ~f:(fun mode -> Memo.parallel_iter archives ~f:(fun fn -> let build_context = Context.build_context ctx in let name = Path.basename fn in let dir = in_build_dir build_context ~config [ lib_name ] in let in_context = { Js_of_ocaml.In_context.flags = Js_of_ocaml.Flags.standard - ; submodes = None + ; enabled_if = Some Blang.true_ ; javascript_files = [] ; wasm_files = [] ; compilation_mode = None @@ -543,13 +556,13 @@ let setup_separate_compilation_rules sctx components = Path.relative src_dir name in let target = - in_build_dir build_context ~config [ lib_name; with_js_ext ~submode name ] + in_build_dir build_context ~config [ lib_name; with_js_ext ~mode name ] in build_cm' sctx ~dir ~in_context - ~submode + ~mode ~src ~target ~config:(Some (Action_builder.return config)) @@ -557,8 +570,8 @@ let setup_separate_compilation_rules sctx components = |> Super_context.add_rule sctx ~dir))) ;; -let js_of_ocaml_compilation_mode t ~dir = - let+ js_of_ocaml = jsoo_env ~dir in +let js_of_ocaml_compilation_mode t ~dir ~mode = + let+ js_of_ocaml = jsoo_env ~dir ~mode in match js_of_ocaml.compilation_mode with | Some m -> m | None -> @@ -567,8 +580,8 @@ let js_of_ocaml_compilation_mode t ~dir = else Whole_program ;; -let js_of_ocaml_sourcemap t ~dir = - let+ js_of_ocaml = jsoo_env ~dir in +let js_of_ocaml_sourcemap t ~dir ~mode = + let+ js_of_ocaml = jsoo_env ~dir ~mode in match js_of_ocaml.sourcemap with | Some sm -> sm | None -> @@ -577,15 +590,37 @@ let js_of_ocaml_sourcemap t ~dir = else No ;; -let jsoo_submodes ~dir ~submodes = - (match submodes with - | Some _ -> Memo.return submodes - | None -> - let+ js_of_ocaml = jsoo_env ~dir in - js_of_ocaml.submodes) - >>| function - | None -> [ Js_of_ocaml.Submode.JS ] - | Some m -> Js_of_ocaml.Submode.Set.to_list m +let jsoo_enabled + ~eval + ~dir + ~(in_context : Js_of_ocaml.In_context.t Js_of_ocaml.Mode.Pair.t) + ~mode + = + match (Js_of_ocaml.Mode.Pair.select ~mode in_context).enabled_if with + | Some enabled_if -> eval enabled_if + | None -> + let* js_of_ocaml = jsoo_env ~dir ~mode in + (match js_of_ocaml.enabled_if with + | Some (Const default) -> Memo.return default + | _ -> assert false) +;; + +let jsoo_enabled_modes ~expander ~dir ~in_context = + let eval = Expander.eval_blang expander in + let+ js = jsoo_enabled ~eval ~dir ~in_context ~mode:JS + and+ wasm = jsoo_enabled ~eval ~dir ~in_context ~mode:Wasm in + { Js_of_ocaml.Mode.Pair.js; wasm } +;; + +let jsoo_is_whole_program t ~dir = + let is_whole_program (mode : Js_of_ocaml.Compilation_mode.t) = + match mode with + | Whole_program -> true + | Separate_compilation -> false + in + let+ js = js_of_ocaml_compilation_mode t ~dir ~mode:JS + and+ wasm = js_of_ocaml_compilation_mode t ~dir ~mode:Wasm in + { Js_of_ocaml.Mode.Pair.js = is_whole_program js; wasm = is_whole_program wasm } ;; let build_exe @@ -598,111 +633,94 @@ let build_exe ~promote ~linkall ~link_time_code_gen + ~jsoo_mode:mode = let sctx = Compilation_context.super_context cc in let dir = Compilation_context.dir cc in let { Js_of_ocaml.In_context.javascript_files ; wasm_files ; flags - ; submodes ; compilation_mode ; sourcemap + ; _ } = in_context in - let mode : Rule.Mode.t = + let target = Path.Build.set_extension src ~ext:(Js_of_ocaml.Ext.exe ~mode) in + let standalone_runtime = + in_obj_dir + ~obj_dir + ~config:None + [ Path.Build.basename + (Path.Build.set_extension src ~ext:(Js_of_ocaml.Ext.runtime ~mode)) + ] + in + let rule_mode : Rule.Mode.t = match promote with | None -> Standard | Some p -> Promote p in let* cmode = match compilation_mode with - | None -> js_of_ocaml_compilation_mode sctx ~dir + | None -> js_of_ocaml_compilation_mode sctx ~dir ~mode | Some x -> Memo.return x and* sourcemap = match sourcemap with - | None -> js_of_ocaml_sourcemap sctx ~dir + | None -> js_of_ocaml_sourcemap sctx ~dir ~mode | Some x -> Memo.return x - and* submodes = jsoo_submodes ~dir ~submodes in - let* () = - if List.mem ~equal:Poly.equal submodes JS - then Memo.return () - else ( - let dst = Path.Build.set_extension src ~ext:(Js_of_ocaml.Ext.exe ~submode:JS) in - let src = - Path.build (Path.Build.set_extension src ~ext:(Js_of_ocaml.Ext.exe ~submode:Wasm)) - in - Super_context.add_rule ~loc ~dir ~mode sctx (Action_builder.copy ~src ~dst)) in - Memo.parallel_iter submodes ~f:(fun submode -> - let standalone_runtime = - in_obj_dir - ~obj_dir - ~config:None - [ Path.Build.basename - (Path.Build.set_extension src ~ext:(Js_of_ocaml.Ext.runtime ~submode)) - ] - in - let target = - let ext = Js_of_ocaml.Ext.exe ~submode in - Path.Build.set_extension src ~ext - in - let runtime_files = - match submode with - | JS -> javascript_files - | Wasm -> wasm_files - in - let directory_targets = - match submode with - | JS -> [] - | Wasm -> [ Path.Build.set_extension src ~ext:Js_of_ocaml.Ext.wasm_dir ] - in - match (cmode : Js_of_ocaml.Compilation_mode.t) with - | Separate_compilation -> - let+ () = - standalone_runtime_rule - ~submode - cc - ~runtime_files - ~target:standalone_runtime - ~flags - ~sourcemap:Js_of_ocaml.Sourcemap.Inline - |> Super_context.add_rule ~loc sctx ~dir - and+ () = - link_rule - ~submode - cc - ~runtime:standalone_runtime - ~target - ~directory_targets - ~obj_dir - top_sorted_modules - ~flags - ~linkall - ~link_time_code_gen - ~sourcemap - |> Super_context.add_rule sctx ~loc ~dir ~mode - in - () - | Whole_program -> - exe_rule - ~submode + let runtime_files = javascript_files @ wasm_files in + let directory_targets = + match mode with + | JS -> [] + | Wasm -> [ Path.Build.set_extension src ~ext:Js_of_ocaml.Ext.wasm_dir ] + in + match (cmode : Js_of_ocaml.Compilation_mode.t) with + | Separate_compilation -> + let+ () = + standalone_runtime_rule + ~mode cc - ~linkall ~runtime_files - ~src + ~target:standalone_runtime + ~flags + ~sourcemap:Js_of_ocaml.Sourcemap.Inline + |> Super_context.add_rule ~loc sctx ~dir + and+ () = + link_rule + ~mode + cc + ~runtime:standalone_runtime ~target ~directory_targets + ~obj_dir + top_sorted_modules ~flags + ~linkall + ~link_time_code_gen ~sourcemap - |> Super_context.add_rule sctx ~loc ~dir ~mode) + |> Super_context.add_rule sctx ~loc ~dir ~mode:rule_mode + in + () + | Whole_program -> + exe_rule + ~mode + cc + ~linkall + ~runtime_files + ~src + ~target + ~directory_targets + ~flags + ~sourcemap + |> Super_context.add_rule sctx ~loc ~dir ~mode:rule_mode ;; let runner = "node" -let js_of_ocaml_runtest_alias ~dir = - let+ js_of_ocaml = jsoo_env ~dir in +let js_of_ocaml_runtest_alias ~dir ~mode = + let+ js_of_ocaml = jsoo_env ~dir ~mode in match js_of_ocaml.runtest_alias with | Some a -> a | None -> Alias0.runtest diff --git a/src/dune_rules/jsoo/jsoo_rules.mli b/src/dune_rules/jsoo/jsoo_rules.mli index f0a3b2190dc5..ec9a03655258 100644 --- a/src/dune_rules/jsoo/jsoo_rules.mli +++ b/src/dune_rules/jsoo/jsoo_rules.mli @@ -19,7 +19,7 @@ val build_cm : Super_context.t -> dir:Path.Build.t -> in_context:Js_of_ocaml.In_context.t - -> submode:Js_of_ocaml.Submode.t + -> mode:Js_of_ocaml.Mode.t -> src:Path.t -> obj_dir:Path.Build.t Obj_dir.t -> config:Config.t option @@ -35,21 +35,44 @@ val build_exe -> promote:Rule.Promote.t option -> linkall:bool Action_builder.t -> link_time_code_gen:Link_time_code_gen_type.t Resolve.t + -> jsoo_mode:Js_of_ocaml.Mode.t -> unit Memo.t val setup_separate_compilation_rules : Super_context.t -> string list -> unit Memo.t val runner : string -val js_of_ocaml_runtest_alias : dir:Path.Build.t -> Alias.Name.t Memo.t -val jsoo_env : dir:Path.Build.t -> string list Action_builder.t Js_of_ocaml.Env.t Memo.t -val jsoo_submodes - : dir:Import.Path.Build.t - -> submodes:Js_of_ocaml.Submode.Set.t option - -> Js_of_ocaml.Submode.t list Memo.t +val js_of_ocaml_runtest_alias + : dir:Path.Build.t + -> mode:Js_of_ocaml.Mode.t + -> Alias.Name.t Memo.t -val iter_submodes : f:(Js_of_ocaml.Submode.t -> unit Memo.t) -> unit Memo.t +val jsoo_env + : dir:Path.Build.t + -> mode:Js_of_ocaml.Mode.t + -> string list Action_builder.t Js_of_ocaml.Env.t Memo.t + +val jsoo_enabled + : eval:(Blang.t -> bool Memo.t) + -> dir:Path.Build.t + -> in_context:Js_of_ocaml.In_context.t Js_of_ocaml.Mode.Pair.t + -> mode:Js_of_ocaml.Mode.t + -> bool Memo.t + +val jsoo_enabled_modes + : expander:Expander.t + -> dir:Path.Build.t + -> in_context:Js_of_ocaml.In_context.t Js_of_ocaml.Mode.Pair.t + -> Js_of_ocaml.Mode.Set.t Memo.t + +val jsoo_is_whole_program + : Super_context.t + -> dir:Path.Build.t + -> Js_of_ocaml.Mode.Set.t Memo.t + +val iter_jsoo_modes : f:(Js_of_ocaml.Mode.t -> unit Memo.t) -> unit Memo.t val js_of_ocaml_compilation_mode : Super_context.t -> dir:Path.Build.t + -> mode:Js_of_ocaml.Mode.t -> Js_of_ocaml.Compilation_mode.t Memo.t diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 1e0d90cbeca0..140e40359e76 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -474,14 +474,14 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~ (* Build *.cma.js / *.wasma *) Memo.when_ modes.ocaml.byte (fun () -> let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in - Jsoo_rules.iter_submodes ~f:(fun submode -> + Jsoo_rules.iter_jsoo_modes ~f:(fun mode -> let action_with_targets = List.map Jsoo_rules.Config.all ~f:(fun config -> Jsoo_rules.build_cm sctx ~dir - ~in_context:js_of_ocaml - ~submode + ~in_context:(Js_of_ocaml.Mode.Pair.select ~mode js_of_ocaml) + ~mode ~config:(Some config) ~src:(Path.build src) ~obj_dir) @@ -542,7 +542,7 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_ ~requires_link ~preprocessing:pp ~opaque:Inherit_from_settings - ~js_of_ocaml:(Some js_of_ocaml) + ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.map ~f:(fun x -> Some x) js_of_ocaml) ?stdlib:lib.stdlib ~package ?vimpl diff --git a/src/dune_rules/mdx.ml b/src/dune_rules/mdx.ml index 891a6df0bfab..03df5c205aa3 100644 --- a/src/dune_rules/mdx.ml +++ b/src/dune_rules/mdx.ml @@ -476,7 +476,7 @@ let mdx_prog_gen t ~sctx ~dir ~scope ~mdx_prog = ~requires_compile ~requires_link ~opaque:(Explicit false) - ~js_of_ocaml:None + ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.make None) ~melange_package_name:None ~package:None () diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index 146cd46aef84..6bf099324c1b 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -316,7 +316,7 @@ let setup_emit_cmj_rules ~requires_link ~requires_compile:direct_requires ~preprocessing:pp - ~js_of_ocaml:None + ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.make None) ~opaque:Inherit_from_settings ~melange_package_name:None ~package:mel.package diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index d6d4be159734..f9a1fa26e40a 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -311,18 +311,19 @@ let build_module ?(force_write_cmi = false) ?(precompiled_cmi = false) cctx m = match Obj_dir.Module.cm_file obj_dir m ~kind:(Ocaml Cmo) with | None -> Memo.return () | Some src -> - Compilation_context.js_of_ocaml cctx - |> Memo.Option.iter ~f:(fun in_context -> - (* Build *.cmo.js / *.wasmo *) - let sctx = Compilation_context.super_context cctx in - let dir = Compilation_context.dir cctx in - Jsoo_rules.iter_submodes ~f:(fun submode -> + Jsoo_rules.iter_jsoo_modes ~f:(fun mode -> + Compilation_context.js_of_ocaml cctx + |> Js_of_ocaml.Mode.Pair.select ~mode + |> Memo.Option.iter ~f:(fun in_context -> + (* Build *.cmo.js / *.wasmo *) + let sctx = Compilation_context.super_context cctx in + let dir = Compilation_context.dir cctx in let action_with_targets = Jsoo_rules.build_cm sctx ~dir ~in_context - ~submode + ~mode ~src:(Path.build src) ~obj_dir ~config:None diff --git a/src/dune_rules/ppx_driver.ml b/src/dune_rules/ppx_driver.ml index ab2e78b5b49e..cb42f95a9d1c 100644 --- a/src/dune_rules/ppx_driver.ml +++ b/src/dune_rules/ppx_driver.ml @@ -323,7 +323,7 @@ let build_ppx_driver sctx ~scope ~target ~pps ~pp_names = ~requires_compile:(Memo.return requires_compile) ~requires_link ~opaque - ~js_of_ocaml:None + ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.make None) ~melange_package_name:None ~package:None ~bin_annot:false diff --git a/src/dune_rules/stanzas/buildable.ml b/src/dune_rules/stanzas/buildable.ml index d4768cc49a4c..a874578fed7c 100644 --- a/src/dune_rules/stanzas/buildable.ml +++ b/src/dune_rules/stanzas/buildable.ml @@ -17,7 +17,7 @@ type t = ; preprocessor_deps : Dep_conf.t list ; lint : Preprocess.Without_instrumentation.t Preprocess.Per_module.t ; flags : Ocaml_flags.Spec.t - ; js_of_ocaml : Js_of_ocaml.In_buildable.t + ; js_of_ocaml : Js_of_ocaml.In_buildable.t Js_of_ocaml.Mode.Pair.t ; allow_overlapping_dependencies : bool ; ctypes : Ctypes_field.t option } @@ -99,7 +99,18 @@ let decode (for_ : for_) = in field "js_of_ocaml" - (Js_of_ocaml.In_buildable.decode ~executable) + (Js_of_ocaml.In_buildable.decode ~executable ~mode:JS) + ~default:Js_of_ocaml.In_buildable.default + and+ wasm_of_ocaml = + let executable = + match for_ with + | Executable -> true + | Library _ -> false + in + field + "wasm_of_ocaml" + (Dune_lang.Syntax.since Stanza.syntax (3, 17) + >>> Js_of_ocaml.In_buildable.decode ~executable ~mode:Wasm) ~default:Js_of_ocaml.In_buildable.default and+ allow_overlapping_dependencies = field_b "allow_overlapping_dependencies" and+ version = Dune_lang.Syntax.get_exn Stanza.syntax @@ -171,7 +182,7 @@ let decode (for_ : for_) = ; extra_objects ; libraries ; flags - ; js_of_ocaml + ; js_of_ocaml = { Js_of_ocaml.Mode.Pair.js = js_of_ocaml; wasm = wasm_of_ocaml } ; allow_overlapping_dependencies ; ctypes } diff --git a/src/dune_rules/stanzas/buildable.mli b/src/dune_rules/stanzas/buildable.mli index a44903189113..ec96635d0882 100644 --- a/src/dune_rules/stanzas/buildable.mli +++ b/src/dune_rules/stanzas/buildable.mli @@ -16,7 +16,7 @@ type t = ; preprocessor_deps : Dep_conf.t list ; lint : Lint.t ; flags : Ocaml_flags.Spec.t - ; js_of_ocaml : Js_of_ocaml.In_buildable.t + ; js_of_ocaml : Js_of_ocaml.In_buildable.t Js_of_ocaml.Mode.Pair.t ; allow_overlapping_dependencies : bool ; ctypes : Ctypes_field.t option } diff --git a/src/dune_rules/stanzas/executables.ml b/src/dune_rules/stanzas/executables.ml index b8f728cf8dbc..7426073735f7 100644 --- a/src/dune_rules/stanzas/executables.ml +++ b/src/dune_rules/stanzas/executables.ml @@ -206,6 +206,7 @@ module Link_mode = struct module T = struct type t = | Byte_complete + | Jsoo of Js_of_ocaml.Mode.t | Other of { mode : Mode_conf.t ; kind : Binary_kind.t @@ -220,6 +221,9 @@ module Link_mode = struct let open Ordering.O in let= () = Mode_conf.compare mode t.mode in Binary_kind.compare kind t.kind + | Other _, _ -> Lt + | _, Other _ -> Gt + | Jsoo m, Jsoo m' -> Js_of_ocaml.Mode.compare m m' ;; let to_dyn = Dyn.opaque @@ -233,8 +237,15 @@ module Link_mode = struct let shared_object = make Best Shared_object let byte = make Byte Exe let native = make Native Exe - let js = make Byte Js let plugin = make Best Plugin + let js = Jsoo JS + let wasm = Jsoo Wasm + + let is_jsoo m = + match m with + | Jsoo _ -> true + | Byte_complete | Other _ -> false + ;; let simple_representations = [ "exe", exe @@ -248,7 +259,12 @@ module Link_mode = struct ] ;; - let simple = Dune_lang.Decoder.enum simple_representations + let simple_representations_including_wasm = ("wasm", wasm) :: simple_representations + + let simple = + Dune_lang.Decoder.enum simple_representations + <|> sum [ "wasm", Syntax.since Stanza.syntax (3, 17) >>> return wasm ] + ;; let decode = enter @@ -256,11 +272,17 @@ module Link_mode = struct and+ kind = Binary_kind.decode in make mode kind) <|> simple + <|> enter + (keyword "byte" + >>> sum + [ "js", Syntax.since Stanza.syntax (1, 11) >>> return js + ; "wasm", Syntax.since Stanza.syntax (3, 17) >>> return wasm + ]) ;; let simple_encode link_mode = let is_ok (_, candidate) = compare candidate link_mode = Eq in - List.find ~f:is_ok simple_representations + List.find ~f:is_ok simple_representations_including_wasm |> Option.map ~f:(fun (s, _) -> Dune_lang.atom s) ;; @@ -269,7 +291,7 @@ module Link_mode = struct | Some s -> s | None -> (match link_mode with - | Byte_complete -> assert false + | Byte_complete | Jsoo _ -> assert false | Other { mode; kind } -> Dune_lang.Encoder.pair Mode_conf.encode Binary_kind.encode (mode, kind)) ;; @@ -282,6 +304,7 @@ module Link_mode = struct Variant ( "Other" , [ record [ "mode", Mode_conf.to_dyn mode; "kind", Binary_kind.to_dyn kind ] ] ) + | Jsoo mode -> Dyn.Variant ("Jsoo", [ Js_of_ocaml.Mode.to_dyn mode ]) ;; let extension t ~loc ~ext_obj ~ext_dll = @@ -306,10 +329,11 @@ module Link_mode = struct | Native, Object -> ".exe" ^ ext_obj | Byte, Shared_object -> ".bc" ^ ext_dll | Native, Shared_object -> ext_dll - | mode, Plugin -> Mode.plugin_ext mode - | Byte, Js -> Js_of_ocaml.Ext.exe ~submode:JS - | Native, Js -> - User_error.raise ~loc [ Pp.text "Javascript generation only supports bytecode!" ]) + | mode, Plugin -> Mode.plugin_ext mode) + | Jsoo kind -> + (match kind with + | JS -> Js_of_ocaml.Ext.exe ~mode:JS + | Wasm -> Js_of_ocaml.Ext.exe ~mode:Wasm) ;; module O = Comparable.Make (T) @@ -496,6 +520,8 @@ let common = | Byte_complete -> ".bc.exe" | Other { mode = Byte; _ } -> ".bc" | Other { mode = Native | Best; _ } -> ".exe" + | Jsoo JS -> Js_of_ocaml.Ext.exe ~mode:JS + | Jsoo Wasm -> Js_of_ocaml.Ext.exe ~mode:Wasm in Names.install_conf names ~ext ~enabled_if ~dir:project_root in diff --git a/src/dune_rules/stanzas/executables.mli b/src/dune_rules/stanzas/executables.mli index 245112db8867..8c5375cf37e4 100644 --- a/src/dune_rules/stanzas/executables.mli +++ b/src/dune_rules/stanzas/executables.mli @@ -3,6 +3,7 @@ open Import module Link_mode : sig type t = | Byte_complete + | Jsoo of Js_of_ocaml.Mode.t | Other of { mode : Mode_conf.t ; kind : Binary_kind.t @@ -16,6 +17,8 @@ module Link_mode : sig val byte : t val native : t val js : t + val wasm : t + val is_jsoo : t -> bool val compare : t -> t -> Ordering.t val to_dyn : t -> Dyn.t diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index 44c5b9f9200d..c0a4f42c6d2f 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -426,10 +426,13 @@ let to_lib_info Mode.Dict.of_func (fun ~mode -> archive_for_mode ~f_ext ~mode |> Option.to_list) in let jsoo_runtime = - List.map conf.buildable.js_of_ocaml.javascript_files ~f:(Path.Build.relative dir) + let in_buildable = conf.buildable.js_of_ocaml.js in + List.map in_buildable.javascript_files ~f:(Path.Build.relative dir) in let wasmoo_runtime = - List.map conf.buildable.js_of_ocaml.wasm_files ~f:(Path.Build.relative dir) + let in_buildable = conf.buildable.js_of_ocaml.wasm in + List.map in_buildable.javascript_files ~f:(Path.Build.relative dir) + @ List.map in_buildable.wasm_files ~f:(Path.Build.relative dir) in let status = match conf.visibility with diff --git a/src/dune_rules/test_rules.ml b/src/dune_rules/test_rules.ml index 66125a7a10f6..909ccb2a9d71 100644 --- a/src/dune_rules/test_rules.ml +++ b/src/dune_rules/test_rules.ml @@ -3,7 +3,7 @@ open Memo.O let alias mode ~dir = match mode with - | `js -> Jsoo_rules.js_of_ocaml_runtest_alias ~dir + | `js mode -> Jsoo_rules.js_of_ocaml_runtest_alias ~dir ~mode | `exe | `bc -> Memo.return Alias0.runtest ;; @@ -21,52 +21,63 @@ let test_kind dir_contents (loc, name, ext) = else `Regular ;; +let ext_of_mode runtest_mode = + match runtest_mode with + | `js mode -> Js_of_ocaml.Ext.exe ~mode + | `bc -> ".bc" + | `exe -> ".exe" +;; + let custom_runner runtest_mode = match runtest_mode with - | `js -> Some Jsoo_rules.runner + | `js _ -> Some Jsoo_rules.runner | `bc | `exe -> None ;; -let runtest_modes modes submodes project = +let runtest_modes modes jsoo_enabled_modes project = if Dune_project.dune_version project < (3, 0) - then Memo.return [ `exe, ".exe" ] + then [ `exe ] else Executables.Link_mode.Map.to_list modes - |> Memo.sequential_map ~f:(fun ((mode : Executables.Link_mode.t), _) -> + |> List.filter_map ~f:(fun ((mode : Executables.Link_mode.t), _) -> match mode with - | Byte_complete | Other { kind = Exe; mode = Native | Best } -> - Memo.return [ `exe, ".exe" ] - | Other { kind = Exe; mode = Byte } -> Memo.return [ `bc, ".bc" ] - | Other { kind = Js; _ } -> - Memo.return - (List.map submodes ~f:(fun submode -> `js, Js_of_ocaml.Ext.exe ~submode)) + | Byte_complete -> Some `exe + | Other { kind = Exe; mode = Native | Best } -> Some `exe + | Other { kind = Exe; mode = Byte } -> Some `bc | Other { kind = C | Object | Shared_object | Plugin; _ } -> (* We don't know how to run tests in these cases *) - Memo.return []) - >>| List.flatten - >>| List.sort_uniq ~compare:Poly.compare + None + | Jsoo mode -> + if Js_of_ocaml.Mode.Pair.select ~mode jsoo_enabled_modes + then Some (`js mode) + else None) + |> List.sort_uniq ~compare:Poly.compare ;; let rules (t : Tests.t) ~sctx ~dir ~scope ~expander ~dir_contents = let* () = let* runtest_modes = - let* submodes = - Jsoo_rules.jsoo_submodes ~dir ~submodes:t.exes.buildable.js_of_ocaml.submodes + let+ jsoo_enabled_modes = + Jsoo_rules.jsoo_enabled_modes + ~expander + ~dir + ~in_context:(Js_of_ocaml.In_context.make ~dir t.exes.buildable.js_of_ocaml) in - runtest_modes t.exes.modes submodes (Scope.project scope) + runtest_modes t.exes.modes jsoo_enabled_modes (Scope.project scope) in Expander.eval_blang expander t.enabled_if >>= function | false -> let loc = Nonempty_list.hd t.exes.names |> fst in - Memo.parallel_iter runtest_modes ~f:(fun (mode, _) -> + Memo.parallel_iter runtest_modes ~f:(fun mode -> let* alias_name = alias mode ~dir in let alias = Alias.make alias_name ~dir in Simple_rules.Alias_rules.add_empty sctx ~loc ~alias) | true -> Nonempty_list.to_list t.exes.names |> Memo.parallel_iter ~f:(fun (loc, s) -> - Memo.parallel_iter runtest_modes ~f:(fun (runtest_mode, ext) -> + Memo.parallel_iter runtest_modes ~f:(fun runtest_mode -> + let ext = ext_of_mode runtest_mode in let custom_runner = custom_runner runtest_mode in let test_pform = Pform.Var Test in let run_action = diff --git a/src/dune_rules/toplevel.ml b/src/dune_rules/toplevel.ml index e80bad4b3b0b..dd131b4e12c7 100644 --- a/src/dune_rules/toplevel.ml +++ b/src/dune_rules/toplevel.ml @@ -233,7 +233,7 @@ module Stanza = struct ~requires_compile ~requires_link ~flags - ~js_of_ocaml:None + ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.make None) ~melange_package_name:None ~package:None ~preprocessing diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml index 42369be6f5ac..85c53b2b17e0 100644 --- a/src/dune_rules/utop.ml +++ b/src/dune_rules/utop.ml @@ -186,7 +186,7 @@ let setup sctx ~dir = ~requires_link ~requires_compile:requires ~flags - ~js_of_ocaml:None + ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.make None) ~melange_package_name:None ~package:None ~preprocessing diff --git a/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/dune b/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/dune index af74ed3b5dff..3c4373c19b28 100644 --- a/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/dune +++ b/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/dune @@ -1,7 +1,8 @@ (library (name foo) (install_c_headers cfoo) - (js_of_ocaml (javascript_files foo.js) (wasm_files foo.js foo.wat)) + (js_of_ocaml (javascript_files foo.js)) + (wasm_of_ocaml (javascript_files foo.js) (wasm_files foo.wat)) (foreign_stubs (language c) (names c)) (foreign_stubs (language cxx) (names cpp)) (public_name foo)) diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/runtime.js b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/runtime.js index f2398f02647d..30ad61bc9480 100644 --- a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/runtime.js +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/runtime.js @@ -2,5 +2,5 @@ //Provides: jsPrint function jsPrint(x){ - joo_global_object.console.log(x); + globalThis.console.log(x); } diff --git a/test/blackbox-tests/test-cases/jsoo/simple.t/lib/runtime.js b/test/blackbox-tests/test-cases/jsoo/simple.t/lib/runtime.js index f2398f02647d..30ad61bc9480 100644 --- a/test/blackbox-tests/test-cases/jsoo/simple.t/lib/runtime.js +++ b/test/blackbox-tests/test-cases/jsoo/simple.t/lib/runtime.js @@ -2,5 +2,5 @@ //Provides: jsPrint function jsPrint(x){ - joo_global_object.console.log(x); + globalThis.console.log(x); } diff --git a/test/blackbox-tests/test-cases/meta-gen.t/dune b/test/blackbox-tests/test-cases/meta-gen.t/dune index 8fb1d5c797c8..6310c17a1d33 100644 --- a/test/blackbox-tests/test-cases/meta-gen.t/dune +++ b/test/blackbox-tests/test-cases/meta-gen.t/dune @@ -14,6 +14,8 @@ (library (name foobar_runtime_lib2) (js_of_ocaml + (javascript_files foobar_runtime.js foobar_runtime2.js)) + (wasm_of_ocaml (javascript_files foobar_runtime.js foobar_runtime2.js) (wasm_files foobar_runtime.wat foobar_runtime2.wat)) (public_name foobar.runtime-lib2) diff --git a/test/blackbox-tests/test-cases/meta-gen.t/run.t b/test/blackbox-tests/test-cases/meta-gen.t/run.t index 7716e35b6fd2..5d3c4cb8a2a2 100644 --- a/test/blackbox-tests/test-cases/meta-gen.t/run.t +++ b/test/blackbox-tests/test-cases/meta-gen.t/run.t @@ -61,7 +61,11 @@ plugin(byte) = "foobar_runtime_lib2.cma" plugin(native) = "foobar_runtime_lib2.cmxs" jsoo_runtime = "foobar_runtime.js foobar_runtime2.js" - wasmoo_runtime = "foobar_runtime.wat foobar_runtime2.wat" + wasmoo_runtime = + "foobar_runtime.js + foobar_runtime2.js + foobar_runtime.wat + foobar_runtime2.wat" ) package "sub" ( directory = "sub" diff --git a/test/blackbox-tests/test-cases/wasmoo/build-info.t/run.t b/test/blackbox-tests/test-cases/wasmoo/build-info.t/run.t index 04aa5e6195e8..429a5cca1be0 100644 --- a/test/blackbox-tests/test-cases/wasmoo/build-info.t/run.t +++ b/test/blackbox-tests/test-cases/wasmoo/build-info.t/run.t @@ -11,52 +11,19 @@ Jsoo and build-info Installing _install/lib/main/dune-package Installing _install/lib/main/opam Installing _install/bin/main - Installing _install/bin/main.bc.wasm.assets/Build_info.wasm - Installing _install/bin/main.bc.wasm.assets/Build_info.wasm.map - Installing _install/bin/main.bc.wasm.assets/Build_info__Build_info_data.wasm - Installing _install/bin/main.bc.wasm.assets/Build_info__Build_info_data.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm.map - Installing _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm - Installing _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm.map - Installing _install/bin/main.bc.wasm.assets/Std_exit.wasm - Installing _install/bin/main.bc.wasm.assets/Std_exit.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__List.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__List.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__String.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__String.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm.map + Installing _install/bin/main.bc.wasm.assets/build_info.wasm + Installing _install/bin/main.bc.wasm.assets/build_info.wasm.map + Installing _install/bin/main.bc.wasm.assets/build_info__Build_info_data.wasm + Installing _install/bin/main.bc.wasm.assets/build_info__Build_info_data.wasm.map + Installing _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm + Installing _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm.map Installing _install/bin/main.bc.wasm.assets/prelude.wasm Installing _install/bin/main.bc.wasm.assets/runtime.wasm Installing _install/bin/main.bc.wasm.assets/start.wasm - Installing _install/bin/main.bc.wasm.assets/start-291802e1.wat + Installing _install/bin/main.bc.wasm.assets/std_exit.wasm + Installing _install/bin/main.bc.wasm.assets/std_exit.wasm.map + Installing _install/bin/main.bc.wasm.assets/stdlib.wasm + Installing _install/bin/main.bc.wasm.assets/stdlib.wasm.map Installing _install/bin/main.bc.wasm.js $ node _install/bin/main.bc.wasm.js unknown @@ -81,97 +48,30 @@ Jsoo and build-info Installing _install/lib/main/opam Deleting _install/bin/main Installing _install/bin/main - Deleting _install/bin/main.bc.wasm.assets/Build_info.wasm - Installing _install/bin/main.bc.wasm.assets/Build_info.wasm - Deleting _install/bin/main.bc.wasm.assets/Build_info.wasm.map - Installing _install/bin/main.bc.wasm.assets/Build_info.wasm.map - Installing _install/bin/main.bc.wasm.assets/Build_info__Build_info_data.wasm - Deleting _install/bin/main.bc.wasm.assets/Build_info__Build_info_data.wasm.map - Installing _install/bin/main.bc.wasm.assets/Build_info__Build_info_data.wasm.map - Deleting _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm - Deleting _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm.map - Deleting _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm - Deleting _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm.map - Deleting _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm - Deleting _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm.map - Deleting _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm - Deleting _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm - Installing _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm - Deleting _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm.map - Installing _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Std_exit.wasm - Installing _install/bin/main.bc.wasm.assets/Std_exit.wasm - Deleting _install/bin/main.bc.wasm.assets/Std_exit.wasm.map - Installing _install/bin/main.bc.wasm.assets/Std_exit.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__List.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__List.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__List.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__List.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__String.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__String.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__String.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__String.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm.map + Deleting _install/bin/main.bc.wasm.assets/build_info.wasm + Installing _install/bin/main.bc.wasm.assets/build_info.wasm + Deleting _install/bin/main.bc.wasm.assets/build_info.wasm.map + Installing _install/bin/main.bc.wasm.assets/build_info.wasm.map + Installing _install/bin/main.bc.wasm.assets/build_info__Build_info_data.wasm + Installing _install/bin/main.bc.wasm.assets/build_info__Build_info_data.wasm.map + Deleting _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm + Installing _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm + Deleting _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm.map + Installing _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm.map Deleting _install/bin/main.bc.wasm.assets/prelude.wasm Installing _install/bin/main.bc.wasm.assets/prelude.wasm Deleting _install/bin/main.bc.wasm.assets/runtime.wasm Installing _install/bin/main.bc.wasm.assets/runtime.wasm Deleting _install/bin/main.bc.wasm.assets/start.wasm Installing _install/bin/main.bc.wasm.assets/start.wasm - Deleting _install/bin/main.bc.wasm.assets/start-291802e1.wat - Installing _install/bin/main.bc.wasm.assets/start-291802e1.wat + Deleting _install/bin/main.bc.wasm.assets/std_exit.wasm + Installing _install/bin/main.bc.wasm.assets/std_exit.wasm + Deleting _install/bin/main.bc.wasm.assets/std_exit.wasm.map + Installing _install/bin/main.bc.wasm.assets/std_exit.wasm.map + Deleting _install/bin/main.bc.wasm.assets/stdlib.wasm + Installing _install/bin/main.bc.wasm.assets/stdlib.wasm + Deleting _install/bin/main.bc.wasm.assets/stdlib.wasm.map + Installing _install/bin/main.bc.wasm.assets/stdlib.wasm.map Deleting _install/bin/main.bc.wasm.js Installing _install/bin/main.bc.wasm.js Installing _install/doc/main/README @@ -193,97 +93,30 @@ Jsoo and build-info Installing _install/lib/main/opam Deleting _install/bin/main Installing _install/bin/main - Deleting _install/bin/main.bc.wasm.assets/Build_info.wasm - Installing _install/bin/main.bc.wasm.assets/Build_info.wasm - Deleting _install/bin/main.bc.wasm.assets/Build_info.wasm.map - Installing _install/bin/main.bc.wasm.assets/Build_info.wasm.map - Installing _install/bin/main.bc.wasm.assets/Build_info__Build_info_data.wasm - Deleting _install/bin/main.bc.wasm.assets/Build_info__Build_info_data.wasm.map - Installing _install/bin/main.bc.wasm.assets/Build_info__Build_info_data.wasm.map - Deleting _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm - Deleting _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalAtomic.wasm.map - Deleting _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm - Deleting _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormat.wasm.map - Deleting _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm - Deleting _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalFormatBasics.wasm.map - Deleting _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm - Installing _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm - Deleting _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm.map - Installing _install/bin/main.bc.wasm.assets/CamlinternalLazy.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm - Installing _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm - Deleting _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm.map - Installing _install/bin/main.bc.wasm.assets/Dune__exe__Main.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Std_exit.wasm - Installing _install/bin/main.bc.wasm.assets/Std_exit.wasm - Deleting _install/bin/main.bc.wasm.assets/Std_exit.wasm.map - Installing _install/bin/main.bc.wasm.assets/Std_exit.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Buffer.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Bytes.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Char.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Int.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Lazy.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__List.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__List.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__List.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__List.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Obj.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Printf.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Seq.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__String.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__String.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__String.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__String.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Sys.wasm.map - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm - Installing _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm - Deleting _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm.map - Installing _install/bin/main.bc.wasm.assets/Stdlib__Uchar.wasm.map + Deleting _install/bin/main.bc.wasm.assets/build_info.wasm + Installing _install/bin/main.bc.wasm.assets/build_info.wasm + Deleting _install/bin/main.bc.wasm.assets/build_info.wasm.map + Installing _install/bin/main.bc.wasm.assets/build_info.wasm.map + Installing _install/bin/main.bc.wasm.assets/build_info__Build_info_data.wasm + Installing _install/bin/main.bc.wasm.assets/build_info__Build_info_data.wasm.map + Deleting _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm + Installing _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm + Deleting _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm.map + Installing _install/bin/main.bc.wasm.assets/dune__exe__Main.wasm.map Deleting _install/bin/main.bc.wasm.assets/prelude.wasm Installing _install/bin/main.bc.wasm.assets/prelude.wasm Deleting _install/bin/main.bc.wasm.assets/runtime.wasm Installing _install/bin/main.bc.wasm.assets/runtime.wasm Deleting _install/bin/main.bc.wasm.assets/start.wasm Installing _install/bin/main.bc.wasm.assets/start.wasm - Deleting _install/bin/main.bc.wasm.assets/start-291802e1.wat - Installing _install/bin/main.bc.wasm.assets/start-291802e1.wat + Deleting _install/bin/main.bc.wasm.assets/std_exit.wasm + Installing _install/bin/main.bc.wasm.assets/std_exit.wasm + Deleting _install/bin/main.bc.wasm.assets/std_exit.wasm.map + Installing _install/bin/main.bc.wasm.assets/std_exit.wasm.map + Deleting _install/bin/main.bc.wasm.assets/stdlib.wasm + Installing _install/bin/main.bc.wasm.assets/stdlib.wasm + Deleting _install/bin/main.bc.wasm.assets/stdlib.wasm.map + Installing _install/bin/main.bc.wasm.assets/stdlib.wasm.map Deleting _install/bin/main.bc.wasm.js Installing _install/bin/main.bc.wasm.js Deleting _install/doc/main/README diff --git a/test/blackbox-tests/test-cases/wasmoo/build-info.t/src/dune b/test/blackbox-tests/test-cases/wasmoo/build-info.t/src/dune index 9f1d7f4c7b48..b3391eec43c2 100644 --- a/test/blackbox-tests/test-cases/wasmoo/build-info.t/src/dune +++ b/test/blackbox-tests/test-cases/wasmoo/build-info.t/src/dune @@ -1,8 +1,7 @@ (executable (name main) (public_name main) - (modes js byte) - (js_of_ocaml (submodes wasm)) + (modes wasm byte) (modules main) (package main) (libraries dune-build-info)) diff --git a/test/blackbox-tests/test-cases/wasmoo/github3622.t b/test/blackbox-tests/test-cases/wasmoo/github3622.t index 5b83eb58c013..b4a79f8b5a5f 100644 --- a/test/blackbox-tests/test-cases/wasmoo/github3622.t +++ b/test/blackbox-tests/test-cases/wasmoo/github3622.t @@ -9,8 +9,7 @@ Setup fixtures: $ cat >dune < (executable > (name main) - > (modes js) - > (js_of_ocaml (submodes wasm))) + > (modes wasm)) > EOF Test without separate compilation: diff --git a/test/blackbox-tests/test-cases/wasmoo/inline-tests.t/wasm/dune b/test/blackbox-tests/test-cases/wasmoo/inline-tests.t/wasm/dune index 7fa817406284..de925d0bb794 100644 --- a/test/blackbox-tests/test-cases/wasmoo/inline-tests.t/wasm/dune +++ b/test/blackbox-tests/test-cases/wasmoo/inline-tests.t/wasm/dune @@ -1,6 +1,6 @@ (library (name inline_tests_wasm) - (js_of_ocaml (wasm_files wasm.wat) (submodes wasm)) + (wasm_of_ocaml (wasm_files wasm.wat)) (inline_tests - (modes js) + (modes wasm) (backend fake_backend))) diff --git a/test/blackbox-tests/test-cases/wasmoo/jsoo-config.t/bin/dune b/test/blackbox-tests/test-cases/wasmoo/jsoo-config.t/bin/dune index 6dc09bed0e5e..996bef7f4a0e 100644 --- a/test/blackbox-tests/test-cases/wasmoo/jsoo-config.t/bin/dune +++ b/test/blackbox-tests/test-cases/wasmoo/jsoo-config.t/bin/dune @@ -1,24 +1,20 @@ (executable (name bin1) (modules bin1) - (modes js) + (modes wasm) (libraries library1) - (js_of_ocaml - (flags (:standard --enable use-js-string))) ) (executable (name bin2) (modules bin2) - (modes js) + (modes wasm) (libraries library1) - (js_of_ocaml - (flags (:standard --disable use-js-string))) ) (executable (name bin3) (modules bin3) - (modes js) + (modes wasm) (libraries library1) ) diff --git a/test/blackbox-tests/test-cases/wasmoo/jsoo-config.t/dune b/test/blackbox-tests/test-cases/wasmoo/jsoo-config.t/dune index 7f70cce913fd..4c6f3c67cf64 100644 --- a/test/blackbox-tests/test-cases/wasmoo/jsoo-config.t/dune +++ b/test/blackbox-tests/test-cases/wasmoo/jsoo-config.t/dune @@ -1,7 +1,6 @@ (env (_ - (js_of_ocaml - (submodes wasm) + (wasm_of_ocaml (flags (:standard --quiet)) (compilation_mode separate) ))) diff --git a/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/bin/dune b/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/bin/dune index de172d2b9a31..11fce31221b7 100644 --- a/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/bin/dune +++ b/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/bin/dune @@ -1,8 +1,6 @@ (executables (names technologic) (libraries js_of_ocaml x) - (modes js) - (js_of_ocaml - (submodes wasm) - (flags (:standard)) - (wasm_files runtime.js))) + (modes wasm) + (wasm_of_ocaml + (javascript_files runtime.js))) diff --git a/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/lib/dune b/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/lib/dune index a68edc1c0f7d..b75532802b27 100644 --- a/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/lib/dune +++ b/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/lib/dune @@ -2,6 +2,6 @@ (name x) (libraries js_of_ocaml) (public_name x) - (js_of_ocaml - (flags (--pretty)) (wasm_files runtime.js runtime.wat)) + (wasm_of_ocaml + (flags (--pretty)) (javascript_files runtime.js) (wasm_files runtime.wat)) ) diff --git a/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/lib/runtime.js b/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/lib/runtime.js index f2398f02647d..30ad61bc9480 100644 --- a/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/lib/runtime.js +++ b/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/lib/runtime.js @@ -2,5 +2,5 @@ //Provides: jsPrint function jsPrint(x){ - joo_global_object.console.log(x); + globalThis.console.log(x); } diff --git a/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/run.t b/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/run.t index fec9ab2e6a99..79999cde7db0 100644 --- a/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/run.t +++ b/test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/run.t @@ -1,6 +1,6 @@ Compilation using WasmOO - $ dune build --display short bin/technologic.bc.js @install 2>&1 | \ + $ dune build --display short bin/technologic.bc.wasm.js @install 2>&1 | \ > sed s,^\ *$(ocamlc -config-var c_compiler),\ \ C_COMPILER,g wasm_of_ocaml bin/.technologic.eobjs/jsoo/technologic.bc.runtime.wasma ocamldep bin/.technologic.eobjs/dune__exe__Technologic.impl.d diff --git a/test/blackbox-tests/test-cases/wasmoo/public-libs.t/b/dune b/test/blackbox-tests/test-cases/wasmoo/public-libs.t/b/dune index 18b69c131784..2d2e43adf780 100644 --- a/test/blackbox-tests/test-cases/wasmoo/public-libs.t/b/dune +++ b/test/blackbox-tests/test-cases/wasmoo/public-libs.t/b/dune @@ -1,5 +1,4 @@ (executable (name main) (libraries a) - (modes js) - (js_of_ocaml (submodes wasm))) + (modes wasm)) diff --git a/test/blackbox-tests/test-cases/wasmoo/simple.t/bin/dune b/test/blackbox-tests/test-cases/wasmoo/simple.t/bin/dune index 1f0939d8c4ca..08ca6a4ce9f2 100644 --- a/test/blackbox-tests/test-cases/wasmoo/simple.t/bin/dune +++ b/test/blackbox-tests/test-cases/wasmoo/simple.t/bin/dune @@ -1,8 +1,6 @@ (executables (names technologic) (libraries js_of_ocaml x) - (modes js) - (js_of_ocaml - (submodes wasm) - (flags (:standard)) - (wasm_files runtime.js))) + (modes wasm) + (wasm_of_ocaml + (javascript_files runtime.js))) diff --git a/test/blackbox-tests/test-cases/wasmoo/simple.t/lib/dune b/test/blackbox-tests/test-cases/wasmoo/simple.t/lib/dune index d1633abbadbe..6bd6eaa51b65 100644 --- a/test/blackbox-tests/test-cases/wasmoo/simple.t/lib/dune +++ b/test/blackbox-tests/test-cases/wasmoo/simple.t/lib/dune @@ -2,6 +2,6 @@ (name x) (libraries js_of_ocaml) (public_name x) - (js_of_ocaml + (wasm_of_ocaml (flags (--pretty)) (wasm_files runtime.js runtime.wat)) (foreign_stubs (language c) (names stubs))) diff --git a/test/blackbox-tests/test-cases/wasmoo/simple.t/lib/runtime.js b/test/blackbox-tests/test-cases/wasmoo/simple.t/lib/runtime.js index f2398f02647d..30ad61bc9480 100644 --- a/test/blackbox-tests/test-cases/wasmoo/simple.t/lib/runtime.js +++ b/test/blackbox-tests/test-cases/wasmoo/simple.t/lib/runtime.js @@ -2,5 +2,5 @@ //Provides: jsPrint function jsPrint(x){ - joo_global_object.console.log(x); + globalThis.console.log(x); } diff --git a/test/blackbox-tests/test-cases/wasmoo/submodes.t/dune b/test/blackbox-tests/test-cases/wasmoo/submodes.t/dune index c8dcdb3f898f..def8e78b42f6 100644 --- a/test/blackbox-tests/test-cases/wasmoo/submodes.t/dune +++ b/test/blackbox-tests/test-cases/wasmoo/submodes.t/dune @@ -1,7 +1,7 @@ (executable (name main) - (modes js)) + (modes js wasm)) (env - (wasm (js_of_ocaml (submodes wasm))) - (both (js_of_ocaml (submodes js wasm)))) + (js (wasm_of_ocaml (enabled_if false))) + (wasm (js_of_ocaml (enabled_if false)))) diff --git a/test/blackbox-tests/test-cases/wasmoo/submodes.t/run.t b/test/blackbox-tests/test-cases/wasmoo/submodes.t/run.t index 2995e7e95e07..0bf84390a67e 100644 --- a/test/blackbox-tests/test-cases/wasmoo/submodes.t/run.t +++ b/test/blackbox-tests/test-cases/wasmoo/submodes.t/run.t @@ -1,6 +1,6 @@ Building with different combinations of submodes -The default is to only compile to JavaScript +Compiling to JavaScript $ dune build --profile js $ node _build/default/main.bc.js @@ -9,14 +9,14 @@ The default is to only compile to JavaScript Error: Don't know how to build main.bc.wasm.js [1] -Compiling to Wasm. One can still use the `.bc.js` binary but it runs -the Wasm code. +Compiling to Wasm. $ dune build --profile wasm - $ node _build/default/main.bc.js - wasm_of_ocaml $ node _build/default/main.bc.wasm.js wasm_of_ocaml + $ dune build --profile wasm main.bc.js + Error: Don't know how to build main.bc.js + [1] Compiling to both JS and Wasm. diff --git a/test/blackbox-tests/test-cases/wasmoo/tests.t/dune b/test/blackbox-tests/test-cases/wasmoo/tests.t/dune index c5e43ef8ad3d..fe703fcd7ddc 100644 --- a/test/blackbox-tests/test-cases/wasmoo/tests.t/dune +++ b/test/blackbox-tests/test-cases/wasmoo/tests.t/dune @@ -1,10 +1,9 @@ (tests (names a b) - (modes js)) + (modes wasm)) (env (_ - (js_of_ocaml + (wasm_of_ocaml (runtest_alias runtest-js) - (submodes wasm) (compilation_mode whole_program)))) diff --git a/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t b/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t index bd7c0a3cf094..094d6d20d76b 100644 --- a/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t +++ b/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t @@ -17,3 +17,6 @@ Workspaces also allow you to set the env for a context: (js_of_ocaml_flags ()) (js_of_ocaml_build_runtime_flags ()) (js_of_ocaml_link_flags ()) + (wasm_of_ocaml_flags ()) + (wasm_of_ocaml_build_runtime_flags ()) + (wasm_of_ocaml_link_flags ())