diff --git a/src/dune_rules/cm_files.ml b/src/dune_rules/cm_files.ml index 83fe3476ee2..97dda45ef9d 100644 --- a/src/dune_rules/cm_files.ml +++ b/src/dune_rules/cm_files.ml @@ -40,6 +40,11 @@ let top_sorted_cms t ~mode = Obj_dir.Module.L.cm_files t.obj_dir ~kind:(Ocaml kind) modules) ;; +let top_sorted_modules t = + Action_builder.map t.top_sorted_modules ~f:(fun modules -> + filter_excluded_modules t modules) +;; + let top_sorted_objects_and_cms t ~mode = Action_builder.map t.top_sorted_modules ~f:(fun modules -> let modules = filter_excluded_modules t modules in diff --git a/src/dune_rules/cm_files.mli b/src/dune_rules/cm_files.mli index c685d2d0aa8..6db1df1261b 100644 --- a/src/dune_rules/cm_files.mli +++ b/src/dune_rules/cm_files.mli @@ -17,4 +17,5 @@ val make val unsorted_objects_and_cms : t -> mode:Mode.t -> Path.t list val top_sorted_cms : t -> mode:Mode.t -> Path.t list Action_builder.t +val top_sorted_modules : t -> Module.t list Action_builder.t val top_sorted_objects_and_cms : t -> mode:Mode.t -> Path.t list Action_builder.t diff --git a/src/dune_rules/jsoo/jsoo_rules.ml b/src/dune_rules/jsoo/jsoo_rules.ml index 7ad41a6dddb..3e46fb7b85f 100644 --- a/src/dune_rules/jsoo/jsoo_rules.ml +++ b/src/dune_rules/jsoo/jsoo_rules.ml @@ -48,7 +48,7 @@ module Config : sig val path : t -> string val of_string : string -> t val of_flags : string list -> t - val to_flags : t -> string list + val to_flags : current:string list -> t -> string list end = struct type t = { js_string : bool option @@ -121,12 +121,15 @@ end = struct loop default l ;; - let to_flags t = - List.concat_map (get t) ~f:(function - | "toplevel", true -> [ "--toplevel" ] + let to_flags ~current t = + current + :: List.map (get t) ~f:(function + | "toplevel", true -> + if List.mem current "--toplevel" ~equal:String.equal then [] else [ "--toplevel" ] | "toplevel", false -> [] | name, true -> [ "--enable"; name ] | name, false -> [ "--disable"; name ]) + |> List.concat ;; end @@ -239,7 +242,6 @@ let js_of_ocaml_rule ~spec ~target ~sourcemap - ~directory_targets = let open Action_builder.O in let jsoo = @@ -270,19 +272,21 @@ let js_of_ocaml_rule [ A "--source-map" ; Hidden_targets [ Path.Build.set_extension target ~ext:".map" ] ]) - ; Command.Args.dyn flags ; (match config with - | None -> S [] + | None -> + Dyn + (Action_builder.map flags ~f:(fun flags -> + Command.Args.S (List.map flags ~f:(fun x -> Command.Args.A x)))) | Some config -> Dyn - (Action_builder.map config ~f:(fun config -> + (Action_builder.map2 flags config ~f:(fun flags config -> Command.Args.S - (List.map (Config.to_flags config) ~f:(fun x -> Command.Args.A x))))) + (List.map (Config.to_flags ~current:flags config) ~f:(fun x -> + Command.Args.A x))))) ; A "-o" ; Target target ; spec ] - |> Action_builder.With_targets.add_directories ~directory_targets ;; let jsoo_runtime_files ~(mode : Js_of_ocaml.Mode.t) libs = @@ -319,12 +323,21 @@ let standalone_runtime_rule ~mode cc ~runtime_files ~target ~flags = ~dir ~flags ~target - ~directory_targets:[] ~spec ~config:(Some config) ;; -let exe_rule ~mode cc ~linkall ~runtime_files ~src ~target ~directory_targets ~flags = +let exe_rule + ~mode + cc + ~linkall + ~runtime_files + ~src + ~target + ~directory_targets + ~flags + ~sourcemap + = let dir = Compilation_context.dir cc in let sctx = Compilation_context.super_context cc in let libs = Compilation_context.requires_link cc in @@ -361,9 +374,10 @@ let exe_rule ~mode cc ~linkall ~runtime_files ~src ~target ~directory_targets ~f ~dir ~spec ~target - ~directory_targets ~flags ~config:None + ~sourcemap + |> Action_builder.With_targets.add_directories ~directory_targets ;; let with_js_ext ~mode s = @@ -406,6 +420,7 @@ let link_rule ~flags ~linkall ~link_time_code_gen + ~sourcemap = let sctx = Compilation_context.super_context cc in let dir = Compilation_context.dir cc in @@ -439,12 +454,13 @@ let link_rule 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 ] ]) + | Module (obj_dir, m) -> + [ in_obj_dir' ~obj_dir ~config:(Some config) [ mod_name m ] ]) 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 ])) + Path.build (in_obj_dir ~obj_dir ~config:(Some config) [ mod_name m ])) in let std_exit = Path.build @@ -472,9 +488,10 @@ let link_rule ~dir ~spec ~target - ~directory_targets ~flags ~config:None + ~sourcemap + |> Action_builder.With_targets.add_directories ~directory_targets ;; let build_cm' sctx ~dir ~in_context ~mode ~src ~target ~config ~sourcemap = @@ -488,7 +505,6 @@ let build_cm' sctx ~dir ~in_context ~mode ~src ~target ~config ~sourcemap = ~flags ~spec ~target - ~directory_targets:[] ~config ~sourcemap ;; @@ -507,6 +523,37 @@ let build_cm sctx ~dir ~in_context ~mode ~src ~obj_dir ~config = ~sourcemap:Js_of_ocaml.Sourcemap.Inline ;; +let build_cma_js sctx ~dir ~in_context ~obj_dir ~config ~linkall:_ ~mode cm_files basename + = + let name = with_js_ext ~mode basename in + let target = in_obj_dir ~obj_dir ~config [ name ] in + let flags = in_context.Js_of_ocaml.In_context.flags in + let modules = + let open Action_builder.O in + let+ l = Cm_files.top_sorted_modules cm_files in + let l = + List.map l ~f:(fun m -> + in_obj_dir + ~obj_dir + ~config + [ Module_name.Unique.to_string (Module.obj_name m) ^ Js_of_ocaml.Ext.cmo ~mode ] + |> Path.build) + in + l + in + js_of_ocaml_rule + sctx + ~dir + ~sub_command:Link + ~config:(Option.map config ~f:Action_builder.return) + ~flags + ~mode + ~spec: + (S [ A "-a"; Dyn (Action_builder.map modules ~f:(fun x -> Command.Args.Deps x)) ]) + ~target + ~sourcemap:Js_of_ocaml.Sourcemap.Inline +;; + let setup_separate_compilation_rules sctx components = match components with | _ :: _ :: _ :: _ | [] | [ _ ] -> Memo.return () diff --git a/src/dune_rules/jsoo/jsoo_rules.mli b/src/dune_rules/jsoo/jsoo_rules.mli index df7e768e62f..7dded77d6ff 100644 --- a/src/dune_rules/jsoo/jsoo_rules.mli +++ b/src/dune_rules/jsoo/jsoo_rules.mli @@ -38,6 +38,18 @@ val build_exe -> jsoo_mode:Js_of_ocaml.Mode.t -> unit Memo.t +val build_cma_js + : Super_context.t + -> dir:Path.Build.t + -> in_context:Js_of_ocaml.In_context.t + -> obj_dir:Path.Build.t Obj_dir.t + -> config:Config.t option + -> linkall:bool Action_builder.t + -> mode:Js_of_ocaml.Mode.t + -> Cm_files.t + -> string + -> Action.Full.t Action_builder.With_targets.t + val setup_separate_compilation_rules : Super_context.t -> string list -> unit Memo.t val runner : string diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 5919ad64359..61f6afc1a3f 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -118,6 +118,43 @@ let build_lib ])) ;; +(* Build an OCaml library. *) +let build_js_lib + (lib : Library.t) + ~sctx + ~expander + ~flags + ~dir + ~cm_files + ~in_context + ~obj_dir + ~mode + config + = + let linkall = + match lib.kind with + | Ppx_deriver _ | Ppx_rewriter _ -> Action_builder.return true + | Normal -> + let standard = Action_builder.return [] in + let open Action_builder.O in + let+ library_flags = + Expander.expand_and_eval_set expander lib.library_flags ~standard + and+ ocaml_flags = Ocaml_flags.get flags (Ocaml Byte) in + List.exists library_flags ~f:(String.equal "-linkall") + || List.exists ocaml_flags ~f:(String.equal "-linkall") + in + Jsoo_rules.build_cma_js + sctx + ~dir + ~config + ~in_context + ~obj_dir + ~linkall + ~mode + cm_files + (Library.archive_basename lib ~ext:(Mode.compiled_lib_ext Mode.Byte)) +;; + let gen_wrapped_compat_modules (lib : Library.t) cctx = let modules = Compilation_context.modules cctx in let wrapped_compat = Modules.With_vlib.wrapped_compat modules in @@ -472,22 +509,43 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~ build_lib lib ~native_archives ~dir ~sctx ~expander ~flags ~mode ~cm_files) and* () = (* Build *.cma.js / *.wasma *) - Memo.when_ modes.ocaml.byte (fun () -> - let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in - Memo.parallel_iter Js_of_ocaml.Mode.all ~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.Mode.Pair.select ~mode js_of_ocaml) - ~mode - ~config:(Some config) - ~src:(Path.build src) - ~obj_dir) - in - Memo.parallel_iter action_with_targets ~f:(fun rule -> - Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc rule))) + match `From_cmos with + | `From_cma -> + Memo.when_ modes.ocaml.byte (fun () -> + let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in + Memo.parallel_iter Js_of_ocaml.Mode.all ~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.Mode.Pair.select ~mode js_of_ocaml) + ~mode + ~config:(Some config) + ~src:(Path.build src) + ~obj_dir) + in + Memo.parallel_iter action_with_targets ~f:(fun rule -> + Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc rule))) + | `From_cmos -> + Memo.when_ modes.ocaml.byte (fun () -> + Memo.parallel_iter Js_of_ocaml.Mode.all ~f:(fun mode -> + let action_with_targets = + List.map Jsoo_rules.Config.all ~f:(fun config -> + build_js_lib + (lib : Library.t) + ~sctx + ~expander + ~flags + ~dir + ~cm_files + ~in_context:(Js_of_ocaml.Mode.Pair.select ~mode js_of_ocaml) + ~obj_dir + ~mode + (Some config)) + in + Memo.parallel_iter action_with_targets ~f:(fun rule -> + Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc rule))) in Memo.when_ (Dynlink_supported.By_the_os.get natdynlink_supported && modes.ocaml.native) diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index 3b469b24ae5..c8fe8e724c4 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -315,20 +315,22 @@ let build_module ?(force_write_cmi = false) ?(precompiled_cmi = false) cctx m = Compilation_context.js_of_ocaml cctx |> Js_of_ocaml.Mode.Pair.select ~mode |> Memo.Option.iter ~f:(fun in_context -> - (* Build *.cmo.js / *.wasmo *) + (* Build *.cmo.js *) 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 - ~mode - ~src:(Path.build src) - ~obj_dir - ~config:None + List.map Jsoo_rules.Config.all ~f:(fun config -> + Jsoo_rules.build_cm + sctx + ~dir + ~in_context + ~mode + ~src:(Path.build src) + ~obj_dir + ~config:(Some config)) in - Super_context.add_rule sctx ~dir action_with_targets))) + Memo.parallel_iter action_with_targets ~f:(fun rule -> + Super_context.add_rule sctx ~dir rule)))) in Memo.when_ melange (fun () -> let* () = build_cm ~cm_kind:(Melange Cmj) ~phase:None in diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index 1923ef0fa17..bdea9ff208f 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -71,6 +71,7 @@ val foreign_lib_files declared in. *) val archive : t -> dir:Path.Build.t -> ext:string -> Path.Build.t +val archive_basename : t -> ext:string -> string val best_name : t -> Lib_name.t val is_virtual : t -> bool val is_impl : t -> bool diff --git a/test/blackbox-tests/test-cases/jsoo/explicit-js-mode-specified.t/run.t b/test/blackbox-tests/test-cases/jsoo/explicit-js-mode-specified.t/run.t index ad0a3cdff80..b58e6ea89c7 100644 --- a/test/blackbox-tests/test-cases/jsoo/explicit-js-mode-specified.t/run.t +++ b/test/blackbox-tests/test-cases/jsoo/explicit-js-mode-specified.t/run.t @@ -27,9 +27,11 @@ specify js mode (#1940). js_of_ocaml .e.eobjs/jsoo/e.bc.runtime.js js_of_ocaml .js/default/stdlib/std_exit.cmo.js js_of_ocaml .js/default/stdlib/stdlib.cma.js - js_of_ocaml .b.eobjs/jsoo/b.cmo.js + js_of_ocaml .foo.objs/jsoo/default/foo.cmo.js + js_of_ocaml .b.eobjs/jsoo/default/b.cmo.js + js_of_ocaml .foo.objs/jsoo/default/foo__C.cmo.js js_of_ocaml b.bc.js - js_of_ocaml .e.eobjs/jsoo/e.cmo.js + js_of_ocaml .e.eobjs/jsoo/default/e.cmo.js js_of_ocaml .foo.objs/jsoo/default/foo.cma.js js_of_ocaml e.bc.js diff --git a/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t b/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t index 95d85a917c1..f6b532dc84a 100644 --- a/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t +++ b/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t @@ -1,6 +1,34 @@ tests js_of_ocaml conigs - $ dune build bin/bin1.bc.js bin/bin2.bc.js bin/bin3.bc.js + $ dune build bin/bin1.bc.js bin/bin2.bc.js bin/bin3.bc.js --display short + js_of_ocaml bin/.bin1.eobjs/jsoo/bin1.bc.runtime.js + js_of_ocaml bin/.bin2.eobjs/jsoo/bin2.bc.runtime.js + js_of_ocaml bin/.bin3.eobjs/jsoo/bin3.bc.runtime.js + js_of_ocaml .js/use-js-string/stdlib/std_exit.cmo.js + js_of_ocaml .js/use-js-string/stdlib/stdlib.cma.js + ocamlc lib/.library1.objs/byte/library1.{cmi,cmo,cmt} + js_of_ocaml .js/!use-js-string/stdlib/std_exit.cmo.js + js_of_ocaml .js/!use-js-string/stdlib/stdlib.cma.js + js_of_ocaml .js/default/stdlib/std_exit.cmo.js + js_of_ocaml .js/default/stdlib/stdlib.cma.js + ocamlc bin/.bin1.eobjs/byte/dune__exe__Bin1.{cmi,cmti} + js_of_ocaml lib/.library1.objs/jsoo/use-js-string/library1.cmo.js + ocamlc bin/.bin2.eobjs/byte/dune__exe__Bin2.{cmi,cmti} + js_of_ocaml lib/.library1.objs/jsoo/!use-js-string/library1.cmo.js + js_of_ocaml lib/.library1.objs/jsoo/default/library1.cmo.js + ocamlc bin/.bin3.eobjs/byte/dune__exe__Bin3.{cmi,cmti} + ocamlc bin/.bin1.eobjs/byte/dune__exe__Bin1.{cmo,cmt} + js_of_ocaml lib/.library1.objs/jsoo/use-js-string/library1.cma.js + ocamlc bin/.bin2.eobjs/byte/dune__exe__Bin2.{cmo,cmt} + js_of_ocaml lib/.library1.objs/jsoo/!use-js-string/library1.cma.js + js_of_ocaml lib/.library1.objs/jsoo/default/library1.cma.js + ocamlc bin/.bin3.eobjs/byte/dune__exe__Bin3.{cmo,cmt} + js_of_ocaml bin/.bin1.eobjs/jsoo/use-js-string/dune__exe__Bin1.cmo.js + js_of_ocaml bin/.bin2.eobjs/jsoo/!use-js-string/dune__exe__Bin2.cmo.js + js_of_ocaml bin/.bin3.eobjs/jsoo/default/dune__exe__Bin3.cmo.js + js_of_ocaml bin/bin1.bc.js + js_of_ocaml bin/bin2.bc.js + js_of_ocaml bin/bin3.bc.js $ node _build/default/bin/bin1.bc.js Hello bin1 Hi library1 diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t index 280a783d2ed..8648b25a171 100644 --- a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t @@ -14,17 +14,20 @@ Compilation using jsoo js_of_ocaml .js/default/js_of_ocaml/js_of_ocaml.cma.js js_of_ocaml .js/default/stdlib/std_exit.cmo.js js_of_ocaml .js/default/stdlib/stdlib.cma.js + js_of_ocaml lib/.x.objs/jsoo/default/x__.cmo.js ocamlopt lib/.x.objs/native/x__Y.{cmx,o} ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} + js_of_ocaml lib/.x.objs/jsoo/default/x__Y.cmo.js ocamlopt lib/.x.objs/native/x.{cmx,o} ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} ocamlc lib/x.cma + js_of_ocaml lib/.x.objs/jsoo/default/x.cmo.js ocamlopt lib/x.{a,cmxa} ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} - js_of_ocaml bin/.technologic.eobjs/jsoo/z.cmo.js + js_of_ocaml bin/.technologic.eobjs/jsoo/default/z.cmo.js js_of_ocaml lib/.x.objs/jsoo/default/x.cma.js ocamlopt lib/x.cmxs - js_of_ocaml bin/.technologic.eobjs/jsoo/technologic.cmo.js + js_of_ocaml bin/.technologic.eobjs/jsoo/default/technologic.cmo.js js_of_ocaml bin/technologic.bc.js $ node ./_build/default/bin/technologic.bc.js buy it 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 79999cde7db..bc7721a53f8 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 @@ -16,19 +16,22 @@ Compilation using WasmOO wasm_of_ocaml .js/default/stdlib/stdlib.wasma ocamlc bin/.technologic.eobjs/byte/dune__exe.{cmi,cmo,cmt} ocamldep bin/.technologic.eobjs/dune__exe__Technologic.intf.d + wasm_of_ocaml lib/.x.objs/jsoo/default/x__.wasmo ocamlopt lib/.x.objs/native/x__Y.{cmx,o} ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} - wasm_of_ocaml bin/.technologic.eobjs/jsoo/dune__exe.wasmo + wasm_of_ocaml lib/.x.objs/jsoo/default/x__Y.wasmo + wasm_of_ocaml bin/.technologic.eobjs/jsoo/default/dune__exe.wasmo ocamlopt lib/.x.objs/native/x.{cmx,o} ocamlc bin/.technologic.eobjs/byte/dune__exe__Technologic.{cmi,cmti} ocamlc lib/x.cma + wasm_of_ocaml lib/.x.objs/jsoo/default/x.wasmo ocamlc bin/.technologic.eobjs/byte/dune__exe__Z.{cmi,cmo,cmt} ocamlopt lib/x.{a,cmxa} wasm_of_ocaml lib/.x.objs/jsoo/default/x.wasma ocamlc bin/.technologic.eobjs/byte/dune__exe__Technologic.{cmo,cmt} - wasm_of_ocaml bin/.technologic.eobjs/jsoo/dune__exe__Z.wasmo + wasm_of_ocaml bin/.technologic.eobjs/jsoo/default/dune__exe__Z.wasmo ocamlopt lib/x.cmxs - wasm_of_ocaml bin/.technologic.eobjs/jsoo/dune__exe__Technologic.wasmo + wasm_of_ocaml bin/.technologic.eobjs/jsoo/default/dune__exe__Technologic.wasmo wasm_of_ocaml bin/technologic.bc.wasm.{js,assets} $ node ./_build/default/bin/technologic.bc.wasm.js buy it