From 167a40b66c042ee7d4a292db1c8deed11ad814e9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sun, 21 Jul 2019 22:51:21 +0200 Subject: [PATCH 01/34] Add JS compilation mode, plumbing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_file.ml | 32 ++++++++-- src/dune_file.mli | 1 + src/exe.ml | 152 ++++++++++++++++++++++++++-------------------- src/exe.mli | 24 ++++---- src/mode.ml | 10 +++ src/mode.mli | 8 +++ src/toplevel.ml | 5 +- 7 files changed, 149 insertions(+), 83 deletions(-) diff --git a/src/dune_file.ml b/src/dune_file.ml index 25806c44312..8db243a6536 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -800,6 +800,7 @@ module Mode_conf = struct | Byte | Native | Best + | Js let compare (a : t) b = compare a b let to_dyn _ = Dyn.opaque end @@ -810,12 +811,14 @@ module Mode_conf = struct [ "byte" , Byte ; "native", Native ; "best" , Best + ; "js" , Js ] let to_string = function | Byte -> "byte" | Native -> "native" | Best -> "best" + | Js -> "js" let to_dyn t = let open Dyn.Encoder in @@ -1526,6 +1529,7 @@ module Executables = struct let byte = byte_exe let native = native_exe + let js = make Js Exe let installable_modes = [exe; native; byte] @@ -1536,19 +1540,34 @@ module Executables = struct ; "shared_object" , shared_object ; "byte" , byte ; "native" , native + ; "js" , js ] let simple = Dune_lang.Decoder.enum simple_representations let decode = + let then_ = + let non_js_mode = + let f (loc, mode) = + match mode with + | Mode_conf.Js -> + User_error.raise ~loc + [ Pp.text "It is not allowed to specify a binary kind when \ + using js mode." + ] + | mode -> mode + in + map ~f (located Mode_conf.decode) + in + enter + (let+ mode = non_js_mode + and+ kind = Binary_kind.decode + and+ loc = loc in + {mode; kind; loc}) + in if_list - ~then_: - (enter - (let+ mode = Mode_conf.decode - and+ kind = Binary_kind.decode - and+ loc = loc in - { mode; kind; loc})) + ~then_ ~else_:simple let simple_encode link_mode = @@ -1666,6 +1685,7 @@ module Executables = struct match mode.mode with | Native | Best -> ".exe" | Byte -> ".bc" + | Js -> ".bc.js" in Names.install_conf names ~ext in diff --git a/src/dune_file.mli b/src/dune_file.mli index dcc7822c43c..4d16e729d92 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -167,6 +167,7 @@ module Mode_conf : sig | Byte | Native | Best (** [Native] if available and [Byte] if not *) + | Js val decode : t Dune_lang.Decoder.t val compare : t -> t -> Ordering.t diff --git a/src/exe.ml b/src/exe.ml index 3cdb2fd3cf6..e291e8f5d43 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -14,26 +14,29 @@ module Program = struct end module Linkage = struct - type t = - { mode : Mode.t + type 'mode t = + { mode : 'mode ; ext : string ; flags : string list } + let map t ~f = + { t with mode = f t.mode } + let byte = - { mode = Byte + { mode = Mode.Js.Mode Byte ; ext = ".bc" ; flags = [] } let native = - { mode = Native + { mode = Mode.Js.Mode Native ; ext = ".exe" ; flags = [] } let custom = - { mode = Byte + { mode = Mode.Js.Mode Byte ; ext = ".exe" ; flags = ["-custom"] } @@ -55,30 +58,36 @@ module Linkage = struct let so_flags_unix = ["-output-complete-obj"; "-runtime-variant"; "_pic"] let of_user_config (ctx : Context.t) (m : Dune_file.Executables.Link_mode.t) = - let wanted_mode : Mode.t = + let wanted_mode : Mode.Js.t = match m.mode with - | Byte -> Byte - | Native -> Native - | Best -> Native + | Js -> Js + | Byte -> Mode Byte + | Native -> Mode Native + | Best -> Mode Native in - let real_mode : Mode.t = + let real_mode : Mode.Js.t = match m.mode with - | Byte -> Byte - | Native -> Native - | Best -> if Option.is_some ctx.ocamlopt then Native else Byte + | Js -> Js + | Byte -> Mode Byte + | Native -> Mode Native + | Best -> if Option.is_some ctx.ocamlopt then Mode Native else Mode Byte in let ext = - match wanted_mode, m.kind with - | Byte , C -> ".bc.c" - | Native , C -> User_error.raise ~loc:m.loc - [ Pp.text "C file generation only \ - supports bytecode!" ] - | Byte , Exe -> ".bc" - | Native , Exe -> ".exe" - | Byte , Object -> ".bc" ^ ctx.lib_config.ext_obj - | Native , Object -> ".exe" ^ ctx.lib_config.ext_obj - | Byte , Shared_object -> ".bc" ^ ctx.lib_config.ext_dll - | Native , Shared_object -> ctx.lib_config.ext_dll + match wanted_mode with + | Js -> ".bc.js" + | Mode mode -> begin + match mode, m.kind with + | Byte , C -> ".bc.c" + | Native , C -> User_error.raise ~loc:m.loc + [ Pp.text "C file generation only \ + supports bytecode!" ] + | Byte , Exe -> ".bc" + | Native , Exe -> ".exe" + | Byte , Object -> ".bc" ^ ctx.lib_config.ext_obj + | Native , Object -> ".exe" ^ ctx.lib_config.ext_obj + | Byte , Shared_object -> ".bc" ^ ctx.lib_config.ext_dll + | Native , Shared_object -> ctx.lib_config.ext_dll + end in let flags = match m.kind with @@ -86,7 +95,7 @@ module Linkage = struct | Exe -> begin match wanted_mode, real_mode with - | Native, Byte -> ["-custom"] + | Mode Native, Mode Byte -> ["-custom"] | _ -> [] end | Object -> o_flags @@ -98,14 +107,17 @@ module Linkage = struct so_flags_unix in match real_mode with - | Native -> + | Mode Native -> (* The compiler doesn't pass these flags in native mode. This looks like a bug in the compiler. *) List.concat_map ctx.native_c_libraries ~f:(fun flag -> ["-cclib"; flag]) @ so_flags - | Byte -> + | Mode Byte -> so_flags + | Js -> + Code_error.raise "js mode/shared object binary kind combination is illegal" + [] in { ext ; mode = real_mode @@ -113,14 +125,14 @@ module Linkage = struct } end -let exe_path_from_name cctx ~name ~(linkage : Linkage.t) = +let exe_path_from_name cctx ~name ~(linkage : Mode.t Linkage.t) = Path.Build.relative (CC.dir cctx) (name ^ linkage.ext) let link_exe ~loc ~name - ~(linkage:Linkage.t) - ~top_sorted_modules + ~(linkage:Mode.t Linkage.t) + ~cm_files ~link_time_code_gen ~promote ?(link_flags=Build.arr (fun _ -> [])) @@ -129,22 +141,11 @@ let link_exe let sctx = CC.super_context cctx in let ctx = SC.context sctx in let dir = CC.dir cctx in - let obj_dir = CC.obj_dir cctx in let requires = CC.requires_link cctx in - let expander = CC.expander cctx in let mode = linkage.mode in let exe = exe_path_from_name cctx ~name ~linkage in let compiler = Option.value_exn (Context.compiler ctx mode) in - let js_of_ocaml = - CC.js_of_ocaml cctx - |> Option.value ~default:Dune_file.Js_of_ocaml.default - in - let cm_files = - let modules = CC.modules cctx in - Cm_files.make ~obj_dir ~modules ~top_sorted_modules - ~ext_obj:ctx.lib_config.ext_obj - in - let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode in + let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode:linkage.mode in SC.add_rule sctx ~loc ~dir ~mode:(match promote with | None -> Standard @@ -182,14 +183,23 @@ let link_exe ]) ; Dyn (Build.S.map top_sorted_cms ~f:(fun x -> Command.Args.Deps x)) ])); - if linkage.ext = ".bc" then - let flags = - (Expander.expand_and_eval_set expander - js_of_ocaml.flags - ~standard:(Build.return (Js_of_ocaml_rules.standard sctx))) in - Js_of_ocaml_rules.build_exe cctx ~js_of_ocaml ~src:exe - ~cm:top_sorted_cms ~flags:(Command.Args.dyn flags) - ~promote + exe + +let link_js ~src ~cm_files ~promote cctx = + let sctx = CC.super_context cctx in + let expander = CC.expander cctx in + let js_of_ocaml = + CC.js_of_ocaml cctx + |> Option.value ~default:Dune_file.Js_of_ocaml.default + in + let flags = + (Expander.expand_and_eval_set expander + js_of_ocaml.flags + ~standard:(Build.return (Js_of_ocaml_rules.standard sctx))) in + let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode:Mode.Byte in + Js_of_ocaml_rules.build_exe cctx ~js_of_ocaml ~src + ~cm:top_sorted_cms ~flags:(Command.Args.dyn flags) + ~promote let build_and_link_many ~programs @@ -198,27 +208,39 @@ let build_and_link_many ?link_flags cctx = - let modules = Compilation_context.modules cctx in + let modules = CC.modules cctx in let dep_graphs = Dep_rules.rules cctx ~modules in Module_compilation.build_all cctx ~dep_graphs; - let link_time_code_gen = Link_time_code_gen.handle_special_libs cctx in - let modules = Compilation_context.modules cctx in List.iter programs ~f:(fun { Program.name; main_module_name ; loc } -> - let top_sorted_modules = - let main = Option.value_exn (Modules.find modules main_module_name) in - Dep_graph.top_closed_implementations dep_graphs.impl - [main] + let cm_files = + let sctx = CC.super_context cctx in + let ctx = SC.context sctx in + let obj_dir = CC.obj_dir cctx in + let top_sorted_modules = + let main = Option.value_exn (Modules.find modules main_module_name) in + Dep_graph.top_closed_implementations dep_graphs.impl + [main] + in + Cm_files.make ~obj_dir ~modules ~top_sorted_modules + ~ext_obj:ctx.lib_config.ext_obj in List.iter linkages ~f:(fun linkage -> - link_exe cctx - ~loc - ~name - ~linkage - ~top_sorted_modules - ~link_time_code_gen - ~promote - ?link_flags)) + let has_js = linkage.Linkage.mode = Mode.Js.Js in + let linkage = Linkage.map ~f:Mode.Js.to_mode linkage in + let exe = + link_exe cctx + ~loc + ~name + ~linkage + ~cm_files + ~link_time_code_gen + ~promote + ?link_flags + in + if has_js then + link_js ~src:exe ~cm_files ~promote cctx + )) let build_and_link ~program = build_and_link_many ~programs:[program] diff --git a/src/exe.mli b/src/exe.mli index f8c6f5b41e0..a41f6d509f1 100644 --- a/src/exe.mli +++ b/src/exe.mli @@ -10,28 +10,30 @@ module Program : sig end module Linkage : sig - type t + type 'mode t + + val map : 'm1 t -> f:('m1 -> 'm2) -> 'm2 t (** Byte compilation, exetension [.bc] *) - val byte : t + val byte : Mode.Js.t t (** Native compilation, extension [.exe] *) - val native : t + val native : Mode.Js.t t (** Byte compilation, link with [-custom], extension [.exe] *) - val custom : t + val custom : Mode.Js.t t (** [native] if supported, [custom] if not *) - val native_or_custom : Context.t -> t + val native_or_custom : Context.t -> Mode.Js.t t val make - : mode:Mode.t + : mode:'mode -> ext:string -> ?flags:string list -> unit - -> t + -> 'mode t - val of_user_config : Context.t -> Dune_file.Executables.Link_mode.t -> t + val of_user_config : Context.t -> Dune_file.Executables.Link_mode.t -> Mode.Js.t t end (** {1 High-level functions} *) @@ -40,7 +42,7 @@ end val build_and_link : program:Program.t - -> linkages:Linkage.t list + -> linkages:Mode.Js.t Linkage.t list -> promote:Dune_file.Promote.t option -> ?link_flags:(unit, string list) Build.t -> Compilation_context.t @@ -48,7 +50,7 @@ val build_and_link val build_and_link_many : programs:Program.t list - -> linkages:Linkage.t list + -> linkages:Mode.Js.t Linkage.t list -> promote:Dune_file.Promote.t option -> ?link_flags:(unit, string list) Build.t -> Compilation_context.t @@ -57,5 +59,5 @@ val build_and_link_many val exe_path : Compilation_context.t -> program:Program.t - -> linkage:Linkage.t + -> linkage:Mode.t Linkage.t -> Path.Build.t diff --git a/src/mode.ml b/src/mode.ml index cdc86a74ca4..ac5f3efc493 100644 --- a/src/mode.ml +++ b/src/mode.ml @@ -135,3 +135,13 @@ module Dict = struct ) end end + +module Js = struct + type mode_ = t + type t = + | Js + | Mode of mode_ + let to_mode = function + | Js -> Byte + | Mode m -> m +end diff --git a/src/mode.mli b/src/mode.mli index c341949a7d2..ce9280ce1e7 100644 --- a/src/mode.mli +++ b/src/mode.mli @@ -64,3 +64,11 @@ module Dict : sig val iter : t -> f:(mode -> unit) -> unit end end with type mode := t + +module Js : sig + type mode_ = t + type t = + | Js + | Mode of mode_ + val to_mode : t -> mode_ +end with type mode_ := t diff --git a/src/toplevel.ml b/src/toplevel.ml index 1750aab8c97..96cd1be2ada 100644 --- a/src/toplevel.ml +++ b/src/toplevel.ml @@ -97,7 +97,10 @@ let setup_rules t = ~linkages:[linkage] ~link_flags:(Build.return ["-linkall"; "-warn-error"; "-31"]) ~promote:None; - let src = Exe.exe_path t.cctx ~program ~linkage in + let src = + Exe.exe_path t.cctx ~program + ~linkage:(Exe.Linkage.map ~f:Mode.Js.to_mode linkage) + in let dir = Source.stanza_dir t.source in let dst = Path.Build.relative dir (Path.Build.basename src) in Super_context.add_rule sctx ~dir ~loc:t.source.loc From 7e1d7f5ac75b8437f32fe688d6d3415112b53445 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 00:46:29 +0200 Subject: [PATCH 02/34] Simplify MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/cinaps.ml | 5 ++- src/dune_file.mli | 1 + src/exe.ml | 96 ++++++++++++++++++++++----------------------- src/exe.mli | 29 ++++++++------ src/exe_rules.ml | 11 +++++- src/inline_tests.ml | 2 + src/toplevel.ml | 7 +--- 7 files changed, 83 insertions(+), 68 deletions(-) diff --git a/src/cinaps.ml b/src/cinaps.ml index 0ce41334d45..7268eec991e 100644 --- a/src/cinaps.ml +++ b/src/cinaps.ml @@ -130,9 +130,12 @@ let gen_rules sctx t ~dir ~scope ~dir_kind = ~dynlink:false ~package:None in + let linkages = + [Exe.Linkage.Js.NonJs (Exe.Linkage.native_or_custom (Super_context.context sctx))] + in Exe.build_and_link cctx ~program:{ name; main_module_name; loc } - ~linkages:[Exe.Linkage.native_or_custom (Super_context.context sctx)] + ~linkages ~promote:None; Super_context.add_alias_action sctx ~dir ~loc:(Some loc) ~stamp:"cinaps" diff --git a/src/dune_file.mli b/src/dune_file.mli index 4d16e729d92..debc74d9b71 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -333,6 +333,7 @@ module Executables : sig val shared_object : t val byte : t val native : t + val byte_exe : t val compare : t -> t -> Ordering.t diff --git a/src/exe.ml b/src/exe.ml index e291e8f5d43..152fd10a1e9 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -14,29 +14,33 @@ module Program = struct end module Linkage = struct - type 'mode t = - { mode : 'mode + type t = + { mode : Mode.t ; ext : string ; flags : string list } - let map t ~f = - { t with mode = f t.mode } + module Js = struct + type linkage = t + type t = + | Js + | NonJs of linkage + end let byte = - { mode = Mode.Js.Mode Byte + { mode = Byte ; ext = ".bc" ; flags = [] } let native = - { mode = Mode.Js.Mode Native + { mode = Native ; ext = ".exe" ; flags = [] } let custom = - { mode = Mode.Js.Mode Byte + { mode = Byte ; ext = ".exe" ; flags = ["-custom"] } @@ -58,36 +62,32 @@ module Linkage = struct let so_flags_unix = ["-output-complete-obj"; "-runtime-variant"; "_pic"] let of_user_config (ctx : Context.t) (m : Dune_file.Executables.Link_mode.t) = - let wanted_mode : Mode.Js.t = + let wanted_mode : Mode.t = match m.mode with - | Js -> Js - | Byte -> Mode Byte - | Native -> Mode Native - | Best -> Mode Native + | Js -> assert false + | Byte -> Byte + | Native -> Native + | Best -> Native in - let real_mode : Mode.Js.t = + let real_mode : Mode.t = match m.mode with - | Js -> Js - | Byte -> Mode Byte - | Native -> Mode Native - | Best -> if Option.is_some ctx.ocamlopt then Mode Native else Mode Byte + | Js -> assert false + | Byte -> Byte + | Native -> Native + | Best -> if Option.is_some ctx.ocamlopt then Native else Byte in let ext = - match wanted_mode with - | Js -> ".bc.js" - | Mode mode -> begin - match mode, m.kind with - | Byte , C -> ".bc.c" - | Native , C -> User_error.raise ~loc:m.loc - [ Pp.text "C file generation only \ - supports bytecode!" ] - | Byte , Exe -> ".bc" - | Native , Exe -> ".exe" - | Byte , Object -> ".bc" ^ ctx.lib_config.ext_obj - | Native , Object -> ".exe" ^ ctx.lib_config.ext_obj - | Byte , Shared_object -> ".bc" ^ ctx.lib_config.ext_dll - | Native , Shared_object -> ctx.lib_config.ext_dll - end + match wanted_mode, m.kind with + | Byte , C -> ".bc.c" + | Native , C -> User_error.raise ~loc:m.loc + [ Pp.text "C file generation only \ + supports bytecode!" ] + | Byte , Exe -> ".bc" + | Native , Exe -> ".exe" + | Byte , Object -> ".bc" ^ ctx.lib_config.ext_obj + | Native , Object -> ".exe" ^ ctx.lib_config.ext_obj + | Byte , Shared_object -> ".bc" ^ ctx.lib_config.ext_dll + | Native , Shared_object -> ctx.lib_config.ext_dll in let flags = match m.kind with @@ -95,7 +95,7 @@ module Linkage = struct | Exe -> begin match wanted_mode, real_mode with - | Mode Native, Mode Byte -> ["-custom"] + | Native, Byte -> ["-custom"] | _ -> [] end | Object -> o_flags @@ -107,31 +107,33 @@ module Linkage = struct so_flags_unix in match real_mode with - | Mode Native -> + | Native -> (* The compiler doesn't pass these flags in native mode. This looks like a bug in the compiler. *) List.concat_map ctx.native_c_libraries ~f:(fun flag -> ["-cclib"; flag]) @ so_flags - | Mode Byte -> + | Byte -> so_flags - | Js -> - Code_error.raise "js mode/shared object binary kind combination is illegal" - [] in { ext ; mode = real_mode ; flags } + + let of_user_config (ctx : Context.t) (m : Dune_file.Executables.Link_mode.t) = + match m.mode with + | Js -> Js.Js + | _ -> NonJs (of_user_config ctx m) end -let exe_path_from_name cctx ~name ~(linkage : Mode.t Linkage.t) = +let exe_path_from_name cctx ~name ~(linkage : Linkage.t) = Path.Build.relative (CC.dir cctx) (name ^ linkage.ext) let link_exe ~loc ~name - ~(linkage:Mode.t Linkage.t) + ~(linkage:Linkage.t) ~cm_files ~link_time_code_gen ~promote @@ -182,8 +184,7 @@ let link_exe ; Lib.Lib_and_module.L.link_flags to_link ~mode ]) ; Dyn (Build.S.map top_sorted_cms ~f:(fun x -> Command.Args.Deps x)) - ])); - exe + ])) let link_js ~src ~cm_files ~promote cctx = let sctx = CC.super_context cctx in @@ -226,9 +227,11 @@ let build_and_link_many ~ext_obj:ctx.lib_config.ext_obj in List.iter linkages ~f:(fun linkage -> - let has_js = linkage.Linkage.mode = Mode.Js.Js in - let linkage = Linkage.map ~f:Mode.Js.to_mode linkage in - let exe = + match linkage with + | Linkage.Js.Js -> + let exe = exe_path_from_name cctx ~name ~linkage:Linkage.byte in + link_js ~src:exe ~cm_files ~promote cctx + | NonJs linkage -> link_exe cctx ~loc ~name @@ -237,9 +240,6 @@ let build_and_link_many ~link_time_code_gen ~promote ?link_flags - in - if has_js then - link_js ~src:exe ~cm_files ~promote cctx )) let build_and_link ~program = diff --git a/src/exe.mli b/src/exe.mli index a41f6d509f1..3eace7bfd8c 100644 --- a/src/exe.mli +++ b/src/exe.mli @@ -10,30 +10,35 @@ module Program : sig end module Linkage : sig - type 'mode t + type t - val map : 'm1 t -> f:('m1 -> 'm2) -> 'm2 t + module Js : sig + type linkage + type t = + | Js + | NonJs of linkage + end with type linkage := t (** Byte compilation, exetension [.bc] *) - val byte : Mode.Js.t t + val byte : t (** Native compilation, extension [.exe] *) - val native : Mode.Js.t t + val native : t (** Byte compilation, link with [-custom], extension [.exe] *) - val custom : Mode.Js.t t + val custom : t (** [native] if supported, [custom] if not *) - val native_or_custom : Context.t -> Mode.Js.t t + val native_or_custom : Context.t -> t val make - : mode:'mode + : mode:Mode.t -> ext:string -> ?flags:string list -> unit - -> 'mode t + -> t - val of_user_config : Context.t -> Dune_file.Executables.Link_mode.t -> Mode.Js.t t + val of_user_config : Context.t -> Dune_file.Executables.Link_mode.t -> Js.t end (** {1 High-level functions} *) @@ -42,7 +47,7 @@ end val build_and_link : program:Program.t - -> linkages:Mode.Js.t Linkage.t list + -> linkages:Linkage.Js.t list -> promote:Dune_file.Promote.t option -> ?link_flags:(unit, string list) Build.t -> Compilation_context.t @@ -50,7 +55,7 @@ val build_and_link val build_and_link_many : programs:Program.t list - -> linkages:Mode.Js.t Linkage.t list + -> linkages:Linkage.Js.t list -> promote:Dune_file.Promote.t option -> ?link_flags:(unit, string list) Build.t -> Compilation_context.t @@ -59,5 +64,5 @@ val build_and_link_many val exe_path : Compilation_context.t -> program:Program.t - -> linkage:Mode.t Linkage.t + -> linkage:Linkage.t -> Path.Build.t diff --git a/src/exe_rules.ml b/src/exe_rules.ml index 982f17d8f72..518b3c222f5 100644 --- a/src/exe_rules.ml +++ b/src/exe_rules.ml @@ -58,7 +58,14 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander let ctx = SC.context sctx in let l = let has_native = Option.is_some ctx.ocamlopt in - List.filter_map (L.Set.to_list exes.modes) ~f:(fun (mode : L.t) -> + let modes = + let f = function {L.mode = Js; _} -> true | _ -> false in + if L.Set.exists exes.modes ~f then + L.Set.add exes.modes L.byte_exe + else + exes.modes + in + List.filter_map (L.Set.to_list modes) ~f:(fun (mode : L.t) -> match has_native, mode.mode with | false, Native -> None @@ -70,7 +77,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander if L.Set.mem exes.modes L.byte && not (L.Set.mem exes.modes L.native) && not (L.Set.mem exes.modes L.exe) then - Exe.Linkage.custom :: l + Exe.Linkage.Js.NonJs Exe.Linkage.custom :: l else l in diff --git a/src/inline_tests.ml b/src/inline_tests.ml index d65ba3470cc..476c4d963f9 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -310,6 +310,8 @@ include Sub_system.Register_end_point( | Javascript -> None ) in + let linkages = + List.map ~f:(fun linkage -> Exe.Linkage.Js.NonJs linkage) linkages in Exe.build_and_link cctx ~program:{ name; main_module_name = Module.name main_module ; loc } ~linkages diff --git a/src/toplevel.ml b/src/toplevel.ml index 96cd1be2ada..f472d2fb374 100644 --- a/src/toplevel.ml +++ b/src/toplevel.ml @@ -94,13 +94,10 @@ let setup_rules t = let sctx = Compilation_context.super_context t.cctx in Exe.build_and_link t.cctx ~program - ~linkages:[linkage] + ~linkages:[Exe.Linkage.Js.NonJs linkage] ~link_flags:(Build.return ["-linkall"; "-warn-error"; "-31"]) ~promote:None; - let src = - Exe.exe_path t.cctx ~program - ~linkage:(Exe.Linkage.map ~f:Mode.Js.to_mode linkage) - in + let src = Exe.exe_path t.cctx ~program ~linkage in let dir = Source.stanza_dir t.source in let dst = Path.Build.relative dir (Path.Build.basename src) in Super_context.add_rule sctx ~dir ~loc:t.source.loc From 76a74f85f9f15b7fefee5b68efe7721276dc178f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 00:58:01 +0200 Subject: [PATCH 03/34] Add explicit_js_mode to dune-project MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_project.ml | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/dune_project.ml b/src/dune_project.ml index 077549d7a1a..97aa597a50f 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -209,6 +209,7 @@ type t = ; generate_opam_files : bool ; file_key : File_key.t ; dialects : Dialect.DB.t + ; explicit_js_mode : bool } let equal = (==) @@ -240,7 +241,7 @@ let to_dyn ; extension_args = _; stanza_parser = _ ; packages ; implicit_transitive_deps ; wrapped_executables ; dune_version ; allow_approx_merlin ; generate_opam_files - ; file_key ; dialects } = + ; file_key ; dialects ; explicit_js_mode } = let open Dyn.Encoder in record [ "name", Name.to_dyn name @@ -265,6 +266,7 @@ let to_dyn ; "generate_opam_files", bool generate_opam_files ; "file_key", string file_key ; "dialects", Dialect.DB.to_dyn dialects + ; "explicit_js_mode", bool explicit_js_mode ] let find_extension_args t key = @@ -569,6 +571,7 @@ let anonymous = lazy ( ; generate_opam_files = false ; file_key ; dialects = Dialect.DB.builtin + ; explicit_js_mode = false }) let default_name ~dir ~packages = @@ -636,6 +639,8 @@ let parse ~dir ~lang ~opam_packages ~file = ~check:(Syntax.since Stanza.syntax (1, 10)) and+ dialects = multi_field "dialect" (Syntax.since Stanza.syntax (1, 11) >>> located Dialect.decode) + and+ explicit_js_mode = + field_b "explicit_js_mode" ~check:(Syntax.since Stanza.syntax (1, 11)) in let homepage = match homepage, source with @@ -750,6 +755,7 @@ let parse ~dir ~lang ~opam_packages ~file = ; allow_approx_merlin ; generate_opam_files ; dialects + ; explicit_js_mode }) let load_dune_project ~dir opam_packages = @@ -798,6 +804,7 @@ let make_jbuilder_project ~dir opam_packages = ; generate_opam_files = false ; wrapped_executables = false ; dialects + ; explicit_js_mode = false } let load ~dir ~files = From 38bb136065eeb2c345dbf61f6c749e2282ba9315 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 01:05:17 +0200 Subject: [PATCH 04/34] Add test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/dune.inc | 10 ++++++++++ .../test-cases/explicit_js_mode/a.ml | 0 .../test-cases/explicit_js_mode/b.ml | 0 .../test-cases/explicit_js_mode/dune | 8 ++++++++ .../test-cases/explicit_js_mode/dune-project | 2 ++ .../test-cases/explicit_js_mode/run.t | 14 ++++++++++++++ 6 files changed, 34 insertions(+) create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/a.ml create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/b.ml create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/dune create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/dune-project create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/run.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index d1f221421e0..bf7dfb7207e 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -467,6 +467,14 @@ test-cases/exec-missing (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name explicit_js_mode) + (deps (package dune) (source_tree test-cases/explicit_js_mode)) + (action + (chdir + test-cases/explicit_js_mode + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name external-lib-deps) (deps (package dune) (source_tree test-cases/external-lib-deps)) @@ -1698,6 +1706,7 @@ (alias exe-name-mangle) (alias exec-cmd) (alias exec-missing) + (alias explicit_js_mode) (alias external-lib-deps) (alias extra-lang-line) (alias fallback-dune) @@ -1896,6 +1905,7 @@ (alias exe-name-mangle) (alias exec-cmd) (alias exec-missing) + (alias explicit_js_mode) (alias external-lib-deps) (alias extra-lang-line) (alias fallback-dune) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/a.ml b/test/blackbox-tests/test-cases/explicit_js_mode/a.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/b.ml b/test/blackbox-tests/test-cases/explicit_js_mode/b.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/dune b/test/blackbox-tests/test-cases/explicit_js_mode/dune new file mode 100644 index 00000000000..9b8d538ad93 --- /dev/null +++ b/test/blackbox-tests/test-cases/explicit_js_mode/dune @@ -0,0 +1,8 @@ +(executable + (name a) + (modules a)) + +(executable + (name b) + (modes js) + (modules b)) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/dune-project b/test/blackbox-tests/test-cases/explicit_js_mode/dune-project new file mode 100644 index 00000000000..46c66d56fe1 --- /dev/null +++ b/test/blackbox-tests/test-cases/explicit_js_mode/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(explicit_js_mode) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/run.t b/test/blackbox-tests/test-cases/explicit_js_mode/run.t new file mode 100644 index 00000000000..e7c4d9c43d7 --- /dev/null +++ b/test/blackbox-tests/test-cases/explicit_js_mode/run.t @@ -0,0 +1,14 @@ +Check that .bc.js rule is generated only if js mode is used. + + $ dune build --display short a.bc.js + Error: Don't know how to build a.bc.js + Hint: did you mean b.bc.js? + [1] + + $ dune build --display short b.bc.js + js_of_ocaml b.bc.runtime.js + ocamldep .b.eobjs/b.ml.d + ocamlc .b.eobjs/byte/b.{cmi,cmo,cmt} + js_of_ocaml .b.eobjs/byte/b.cmo.js + js_of_ocaml .js/stdlib/stdlib.cma.js + jsoo_link b.bc.js From fdc273c4a115f1f6c42cc3229882704721c07c88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 01:08:53 +0200 Subject: [PATCH 05/34] Enable explicit_js_mode in dune itself MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- dune-project | 1 + 1 file changed, 1 insertion(+) diff --git a/dune-project b/dune-project index fb0b076e232..12417bafbff 100644 --- a/dune-project +++ b/dune-project @@ -4,6 +4,7 @@ (implicit_transitive_deps false) (generate_opam_files true) (wrapped_executables true) +(explicit_js_mode) (license MIT) (maintainers "Jane Street Group, LLC ") From 362fa5ae08a8aa118c42673dda6f18f0358463b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 01:35:53 +0200 Subject: [PATCH 06/34] Enable js mode for libraries, handle backwards compat MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_file.mli | 1 + src/dune_project.ml | 1 + src/dune_project.mli | 1 + src/exe.ml | 6 +++--- src/exe_rules.ml | 3 +++ src/lib_rules.ml | 6 +++++- 6 files changed, 14 insertions(+), 4 deletions(-) diff --git a/src/dune_file.mli b/src/dune_file.mli index debc74d9b71..8af6891bcaf 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -334,6 +334,7 @@ module Executables : sig val byte : t val native : t val byte_exe : t + val js : t val compare : t -> t -> Ordering.t diff --git a/src/dune_project.ml b/src/dune_project.ml index 97aa597a50f..7dbdf0a930b 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -233,6 +233,7 @@ let implicit_transitive_deps t = t.implicit_transitive_deps let allow_approx_merlin t = t.allow_approx_merlin let generate_opam_files t = t.generate_opam_files let dialects t = t.dialects +let explicit_js_mode t = t.explicit_js_mode let to_dyn { name ; root ; version ; source; license; authors diff --git a/src/dune_project.mli b/src/dune_project.mli index 0d154c0afc9..48324b19c26 100644 --- a/src/dune_project.mli +++ b/src/dune_project.mli @@ -83,6 +83,7 @@ val stanza_parser : t -> Stanza.t list Dune_lang.Decoder.t val allow_approx_merlin : t -> bool val generate_opam_files : t -> bool val dialects : t -> Dialect.DB.t +val explicit_js_mode : t -> bool val equal : t -> t -> bool val hash : t -> int diff --git a/src/exe.ml b/src/exe.ml index 152fd10a1e9..5c2f530faba 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -186,13 +186,14 @@ let link_exe ; Dyn (Build.S.map top_sorted_cms ~f:(fun x -> Command.Args.Deps x)) ])) -let link_js ~src ~cm_files ~promote cctx = +let link_js ~name ~cm_files ~promote cctx = let sctx = CC.super_context cctx in let expander = CC.expander cctx in let js_of_ocaml = CC.js_of_ocaml cctx |> Option.value ~default:Dune_file.Js_of_ocaml.default in + let src = exe_path_from_name cctx ~name ~linkage:Linkage.byte in let flags = (Expander.expand_and_eval_set expander js_of_ocaml.flags @@ -229,8 +230,7 @@ let build_and_link_many List.iter linkages ~f:(fun linkage -> match linkage with | Linkage.Js.Js -> - let exe = exe_path_from_name cctx ~name ~linkage:Linkage.byte in - link_js ~src:exe ~cm_files ~promote cctx + link_js ~name ~cm_files ~promote cctx | NonJs linkage -> link_exe cctx ~loc diff --git a/src/exe_rules.ml b/src/exe_rules.ml index 518b3c222f5..4015b31291d 100644 --- a/src/exe_rules.ml +++ b/src/exe_rules.ml @@ -58,10 +58,13 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander let ctx = SC.context sctx in let l = let has_native = Option.is_some ctx.ocamlopt in + let explicit_js_mode = Dune_project.explicit_js_mode (Scope.project scope) in let modes = let f = function {L.mode = Js; _} -> true | _ -> false in if L.Set.exists exes.modes ~f then L.Set.add exes.modes L.byte_exe + else if not explicit_js_mode && L.Set.mem exes.modes L.byte_exe then + L.Set.add exes.modes L.js else exes.modes in diff --git a/src/lib_rules.ml b/src/lib_rules.ml index 2a36a0778fb..e1a0901fc83 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -279,6 +279,10 @@ module Gen (P : sig val sctx : Super_context.t end) = struct let obj_dir = Compilation_context.obj_dir cctx in let flags = Compilation_context.flags cctx in let modules = Compilation_context.modules cctx in + let explicit_js_mode = + Dune_project.explicit_js_mode + (Scope.project (Compilation_context.scope cctx)) + in let js_of_ocaml = lib.buildable.js_of_ocaml in let { Lib_config. ext_obj; has_native; natdynlink_supported; _ } = ctx.lib_config in @@ -304,7 +308,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct Mode.Dict.Set.iter modes ~f:(fun mode -> build_lib lib ~expander ~flags ~dir ~mode ~cm_files)); (* Build *.cma.js *) - if modes.byte then + if (explicit_js_mode && Mode_conf.Set.mem lib.modes Js) || modes.byte then SC.add_rules sctx ~dir ( let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in From 2e9d5afba3136c321fd716e72ade36f30f8b205b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 01:51:31 +0200 Subject: [PATCH 07/34] Fix MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_file.ml | 2 +- src/lib_rules.ml | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/dune_file.ml b/src/dune_file.ml index 8db243a6536..4273461b833 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -837,7 +837,7 @@ module Mode_conf = struct let eval t ~has_native = let has_best = mem t Best in - let byte = mem t Byte || (has_best && (not has_native)) in + let byte = mem t Byte || mem t Js || (has_best && (not has_native)) in let native = has_native && (mem t Native || has_best) in { Mode.Dict.byte; native } end diff --git a/src/lib_rules.ml b/src/lib_rules.ml index e1a0901fc83..73255e3d4c0 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -308,7 +308,9 @@ module Gen (P : sig val sctx : Super_context.t end) = struct Mode.Dict.Set.iter modes ~f:(fun mode -> build_lib lib ~expander ~flags ~dir ~mode ~cm_files)); (* Build *.cma.js *) - if (explicit_js_mode && Mode_conf.Set.mem lib.modes Js) || modes.byte then + if (explicit_js_mode && Mode_conf.Set.mem lib.modes Js) || + (not explicit_js_mode && modes.byte) + then SC.add_rules sctx ~dir ( let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in From 8d583a3b00be80fa456ef3a1342cea0583a4ff4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 01:51:39 +0200 Subject: [PATCH 08/34] Add test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../blackbox-tests/test-cases/explicit_js_mode/c.ml | 0 .../blackbox-tests/test-cases/explicit_js_mode/d.ml | 0 .../blackbox-tests/test-cases/explicit_js_mode/dune | 9 +++++++++ .../test-cases/explicit_js_mode/run.t | 13 +++++++++++++ 4 files changed, 22 insertions(+) create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/c.ml create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/d.ml diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/c.ml b/test/blackbox-tests/test-cases/explicit_js_mode/c.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/d.ml b/test/blackbox-tests/test-cases/explicit_js_mode/d.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/dune b/test/blackbox-tests/test-cases/explicit_js_mode/dune index 9b8d538ad93..7aa34a09e25 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/dune +++ b/test/blackbox-tests/test-cases/explicit_js_mode/dune @@ -6,3 +6,12 @@ (name b) (modes js) (modules b)) + +(library + (name foo) + (modules c)) + +(library + (name bar) + (modules d) + (modes js)) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/run.t b/test/blackbox-tests/test-cases/explicit_js_mode/run.t index e7c4d9c43d7..b4f71d49dfa 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/run.t +++ b/test/blackbox-tests/test-cases/explicit_js_mode/run.t @@ -12,3 +12,16 @@ Check that .bc.js rule is generated only if js mode is used. js_of_ocaml .b.eobjs/byte/b.cmo.js js_of_ocaml .js/stdlib/stdlib.cma.js jsoo_link b.bc.js + +Same for libraries. + + $ dune build --display short _build/default/.foo.objs/foo.cma.js + Error: Don't know how to build _build/default/.foo.objs/foo.cma.js + [1] + + $ dune build --display short _build/default/.bar.objs/bar.cma.js + ocamlc .bar.objs/byte/bar.{cmi,cmo,cmt} + ocamldep .bar.objs/d.ml.d + ocamlc .bar.objs/byte/bar__D.{cmi,cmo,cmt} + ocamlc bar.cma + js_of_ocaml .bar.objs/bar.cma.js From 52895ab587a086ec43bad348dbc983d35e452dd5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 02:00:27 +0200 Subject: [PATCH 09/34] Add js targets to alias all when js explicit mode enabled MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/gen_rules.ml | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index d6221d2deaa..6c10fb28ba5 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -225,9 +225,15 @@ module Gen(P : sig val sctx : Super_context.t end) = struct List.iter js_targets ~f:(fun js_target -> assert (Path.Build.equal (Path.Build.parent_exn js_target) ctx_dir)); - Predicate.create ~id ~f:(fun basename -> - not (List.exists js_targets ~f:(fun js_target -> - String.equal (Path.Build.basename js_target) basename))) + let f = + if Dune_project.explicit_js_mode (Scope.project scope) then + fun _ -> true + else + fun basename -> + not (List.exists js_targets ~f:(fun js_target -> + String.equal (Path.Build.basename js_target) basename)) + in + Predicate.create ~id ~f in File_selector.create ~dir:(Path.build ctx_dir) pred |> Build.paths_matching ~loc:Loc.none From c243e77907e3397824669894c9ee4f95cdc01d54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 02:06:30 +0200 Subject: [PATCH 10/34] Add test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../test-cases/explicit_js_mode/run.t | 29 +++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/run.t b/test/blackbox-tests/test-cases/explicit_js_mode/run.t index b4f71d49dfa..0821225fae8 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/run.t +++ b/test/blackbox-tests/test-cases/explicit_js_mode/run.t @@ -25,3 +25,32 @@ Same for libraries. ocamlc .bar.objs/byte/bar__D.{cmi,cmo,cmt} ocamlc bar.cma js_of_ocaml .bar.objs/bar.cma.js + +Check that js targets are attached to @all + + $ dune clean + $ dune build --display short @all + ocamldep $ext_lib.eobjs/a.ml.d + ocamlc $ext_lib.eobjs/byte/a.{cmi,cmo,cmt} + ocamlc a.bc + ocamldep .b.eobjs/b.ml.d + ocamlc .b.eobjs/byte/b.{cmi,cmo,cmt} + ocamlc b.bc + js_of_ocaml b.bc.runtime.js + js_of_ocaml .b.eobjs/byte/b.cmo.js + ocamlc .bar.objs/byte/bar.{cmi,cmo,cmt} + ocamldep .bar.objs/d.ml.d + ocamlc .bar.objs/byte/bar__D.{cmi,cmo,cmt} + ocamlc bar.cma + ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} + ocamlopt .foo.objs/native/foo.{cmx,o} + ocamldep .foo.objs/c.ml.d + ocamlc .foo.objs/byte/foo__C.{cmi,cmo,cmt} + ocamlc foo.cma + ocamlopt $ext_lib.eobjs/native/a.{cmx,o} + ocamlopt a.exe + js_of_ocaml .js/stdlib/stdlib.cma.js + jsoo_link b.bc.js + ocamlopt .foo.objs/native/foo__C.{cmx,o} + ocamlopt foo.{a,cmxa} + ocamlopt foo.cmxs From bac8829c853ec343ca4831150a3271d61909e4fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 07:12:37 +0200 Subject: [PATCH 11/34] Do not generate .cmo.js rules when not specified MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/cinaps.ml | 1 + src/compilation_context.ml | 2 +- src/compilation_context.mli | 2 +- src/exe_rules.ml | 9 ++++++++- src/inline_tests.ml | 2 +- src/lib_rules.ml | 9 ++++++++- src/link_time_code_gen.ml | 1 + src/toplevel.ml | 1 + src/utop.ml | 1 + test/blackbox-tests/test-cases/explicit_js_mode/run.t | 6 ++++++ 10 files changed, 29 insertions(+), 5 deletions(-) diff --git a/src/cinaps.ml b/src/cinaps.ml index 7268eec991e..b65f611a702 100644 --- a/src/cinaps.ml +++ b/src/cinaps.ml @@ -127,6 +127,7 @@ let gen_rules sctx t ~dir ~scope ~dir_kind = ~requires_compile:(Lib.Compile.direct_requires compile_info) ~requires_link:(Lib.Compile.requires_link compile_info) ~flags:(Ocaml_flags.of_list ["-w"; "-24"]) + ~js_of_ocaml:None ~dynlink:false ~package:None in diff --git a/src/compilation_context.ml b/src/compilation_context.ml index 5de14abcb38..0b94c4994e2 100644 --- a/src/compilation_context.ml +++ b/src/compilation_context.ml @@ -91,7 +91,7 @@ let create ~super_context ~scope ~expander ~obj_dir ?(dir_kind=Dune_lang.File_syntax.Dune) ~modules ~flags ~requires_compile ~requires_link ?(preprocessing=Preprocessing.dummy) ?(no_keep_locs=false) - ~opaque ?stdlib ?js_of_ocaml ~dynlink ?sandbox ~package ?vimpl () = + ~opaque ?stdlib ~js_of_ocaml ~dynlink ?sandbox ~package ?vimpl () = let requires_compile = if Dune_project.implicit_transitive_deps (Scope.project scope) then Lazy.force requires_link diff --git a/src/compilation_context.mli b/src/compilation_context.mli index 5a06cc841ef..0552416d42e 100644 --- a/src/compilation_context.mli +++ b/src/compilation_context.mli @@ -27,7 +27,7 @@ val create -> ?no_keep_locs : bool -> opaque : bool -> ?stdlib : Dune_file.Library.Stdlib.t - -> ?js_of_ocaml : Dune_file.Js_of_ocaml.t + -> js_of_ocaml : Dune_file.Js_of_ocaml.t option -> dynlink : bool -> ?sandbox : bool -> package : Package.t option diff --git a/src/exe_rules.ml b/src/exe_rules.ml index 4015b31291d..01c280c13a4 100644 --- a/src/exe_rules.ml +++ b/src/exe_rules.ml @@ -96,6 +96,13 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander let cctx = 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 = exes.buildable.js_of_ocaml in + if Dune_project.explicit_js_mode (Scope.project scope) then + Option.some_if (List.mem ~set:linkages Exe.Linkage.Js.Js) js_of_ocaml + else + Some js_of_ocaml + in let dynlink = Dune_file.Executables.Link_mode.Set.exists exes.modes ~f:(fun mode -> match mode.kind with @@ -113,7 +120,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander ~requires_link ~requires_compile ~preprocessing:pp - ~js_of_ocaml:exes.buildable.js_of_ocaml + ~js_of_ocaml ~opaque:(SC.opaque sctx) ~dynlink ~package:exes.package diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 476c4d963f9..518acf2ddbb 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -292,7 +292,7 @@ include Sub_system.Register_end_point( ~requires_compile:runner_libs ~requires_link:(lazy runner_libs) ~flags:(Ocaml_flags.of_list ["-w"; "-24"; "-g"]) - ~js_of_ocaml:lib.buildable.js_of_ocaml + ~js_of_ocaml:None ~dynlink:false ~package:(Option.map lib.public ~f:(fun p -> p.package)); in diff --git a/src/lib_rules.ml b/src/lib_rules.ml index 73255e3d4c0..aad71f4e534 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -361,6 +361,13 @@ module Gen (P : sig val sctx : Super_context.t end) = struct let cctx = 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 = lib.buildable.js_of_ocaml in + if Dune_project.explicit_js_mode (Scope.project scope) then + Option.some_if (Mode_conf.Set.mem lib.modes Js) js_of_ocaml + else + Some js_of_ocaml + in let dynlink = Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries in Compilation_context.create () @@ -376,7 +383,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct ~preprocessing:pp ~no_keep_locs:lib.no_keep_locs ~opaque - ~js_of_ocaml:lib.buildable.js_of_ocaml + ~js_of_ocaml ~dynlink ?stdlib:lib.stdlib ~package:(Option.map lib.public ~f:(fun p -> p.package)) diff --git a/src/link_time_code_gen.ml b/src/link_time_code_gen.ml index 898ec26a2e0..8333d92a0f0 100644 --- a/src/link_time_code_gen.ml +++ b/src/link_time_code_gen.ml @@ -55,6 +55,7 @@ let generate_and_compile_module cctx ~precompiled_cmi ~name:basename ~requires_link:(lazy requires) ~flags:Ocaml_flags.empty ~opaque + ~js_of_ocaml:None ~dynlink:(Compilation_context.dynlink cctx) ~package:(Compilation_context.package cctx) () diff --git a/src/toplevel.ml b/src/toplevel.ml index f472d2fb374..aa6c8093f44 100644 --- a/src/toplevel.ml +++ b/src/toplevel.ml @@ -144,6 +144,7 @@ module Stanza = struct ~requires_compile ~requires_link ~flags + ~js_of_ocaml:None ~dynlink:false ~package:None in diff --git a/src/utop.ml b/src/utop.ml index 81fd1b171e9..a4215a77003 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -91,6 +91,7 @@ let setup sctx ~dir = ~requires_link:(lazy requires) ~requires_compile:requires ~flags + ~js_of_ocaml:None ~dynlink:false ~package:None in diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/run.t b/test/blackbox-tests/test-cases/explicit_js_mode/run.t index 0821225fae8..2f14fb86bee 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/run.t +++ b/test/blackbox-tests/test-cases/explicit_js_mode/run.t @@ -13,6 +13,12 @@ Check that .bc.js rule is generated only if js mode is used. js_of_ocaml .js/stdlib/stdlib.cma.js jsoo_link b.bc.js +We also check that .cmo.js rules are not generated if not specified. + + $ dune build --display short _build/default/.a.eobjs/byte/a.cmo.js + Error: Don't know how to build _build/default/.a.eobjs/byte/a.cmo.js + [1] + Same for libraries. $ dune build --display short _build/default/.foo.objs/foo.cma.js From e3bae30a10ee9447fd60232ff2bbec8dea246ff1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 07:40:20 +0200 Subject: [PATCH 12/34] Remove dead code MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/mode.ml | 10 ---------- src/mode.mli | 8 -------- 2 files changed, 18 deletions(-) diff --git a/src/mode.ml b/src/mode.ml index ac5f3efc493..cdc86a74ca4 100644 --- a/src/mode.ml +++ b/src/mode.ml @@ -135,13 +135,3 @@ module Dict = struct ) end end - -module Js = struct - type mode_ = t - type t = - | Js - | Mode of mode_ - let to_mode = function - | Js -> Byte - | Mode m -> m -end diff --git a/src/mode.mli b/src/mode.mli index ce9280ce1e7..c341949a7d2 100644 --- a/src/mode.mli +++ b/src/mode.mli @@ -64,11 +64,3 @@ module Dict : sig val iter : t -> f:(mode -> unit) -> unit end end with type mode := t - -module Js : sig - type mode_ = t - type t = - | Js - | Mode of mode_ - val to_mode : t -> mode_ -end with type mode_ := t From b309328f2ab06daf5d5ef88d4915b0e5eb7735cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 07:49:23 +0200 Subject: [PATCH 13/34] Add test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/test-cases/explicit_js_mode/dune | 4 ++++ test/blackbox-tests/test-cases/explicit_js_mode/run.t | 8 +++++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/dune b/test/blackbox-tests/test-cases/explicit_js_mode/dune index 7aa34a09e25..a76373a0bd0 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/dune +++ b/test/blackbox-tests/test-cases/explicit_js_mode/dune @@ -15,3 +15,7 @@ (name bar) (modules d) (modes js)) + +(test + (name e) + (modules e)) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/run.t b/test/blackbox-tests/test-cases/explicit_js_mode/run.t index 2f14fb86bee..f00a72a0a8d 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/run.t +++ b/test/blackbox-tests/test-cases/explicit_js_mode/run.t @@ -32,7 +32,8 @@ Same for libraries. ocamlc bar.cma js_of_ocaml .bar.objs/bar.cma.js -Check that js targets are attached to @all +Check that js targets are attached to @all, but not for tests that do not +specify js mode (#1940). $ dune clean $ dune build --display short @all @@ -48,6 +49,9 @@ Check that js targets are attached to @all ocamldep .bar.objs/d.ml.d ocamlc .bar.objs/byte/bar__D.{cmi,cmo,cmt} ocamlc bar.cma + ocamldep .e.eobjs/e.ml.d + ocamlc .e.eobjs/byte/e.{cmi,cmo,cmt} + ocamlc e.bc ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} ocamlopt .foo.objs/native/foo.{cmx,o} ocamldep .foo.objs/c.ml.d @@ -57,6 +61,8 @@ Check that js targets are attached to @all ocamlopt a.exe js_of_ocaml .js/stdlib/stdlib.cma.js jsoo_link b.bc.js + ocamlopt .e.eobjs/native/e.{cmx,o} + ocamlopt e.exe ocamlopt .foo.objs/native/foo__C.{cmx,o} ocamlopt foo.{a,cmxa} ocamlopt foo.cmxs From 8de68379375925d9cad1f90669f68a505dcab055 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 09:28:13 +0200 Subject: [PATCH 14/34] Enable explicit_js_mode by default on 2.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_project.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/dune_project.ml b/src/dune_project.ml index 7dbdf0a930b..ac0b1934c1e 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -533,6 +533,9 @@ let implicit_transitive_deps_default ~(lang : Lang.Instance.t) = let wrapped_executables_default ~(lang : Lang.Instance.t) = lang.version >= (2, 0) +let explicit_js_mode_default ~(lang : Lang.Instance.t) = + lang.version >= (2, 0) + let anonymous = lazy ( let lang = get_dune_lang () in let name = Name.anonymous_root in @@ -548,6 +551,7 @@ let anonymous = lazy ( in let implicit_transitive_deps = implicit_transitive_deps_default ~lang in let wrapped_executables = wrapped_executables_default ~lang in + let explicit_js_mode = explicit_js_mode_default ~lang in let root = Path.Source.root in let file_key = File_key.make ~root ~name in { name @@ -572,7 +576,7 @@ let anonymous = lazy ( ; generate_opam_files = false ; file_key ; dialects = Dialect.DB.builtin - ; explicit_js_mode = false + ; explicit_js_mode }) let default_name ~dir ~packages = From 02a16bf49e57f1cb881d889d8d84bf32552fd930 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 09:29:37 +0200 Subject: [PATCH 15/34] Rename NonJs => Non_js MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/cinaps.ml | 2 +- src/exe.ml | 6 +++--- src/exe.mli | 2 +- src/exe_rules.ml | 2 +- src/inline_tests.ml | 2 +- src/toplevel.ml | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/cinaps.ml b/src/cinaps.ml index b65f611a702..beddc6257f4 100644 --- a/src/cinaps.ml +++ b/src/cinaps.ml @@ -132,7 +132,7 @@ let gen_rules sctx t ~dir ~scope ~dir_kind = ~package:None in let linkages = - [Exe.Linkage.Js.NonJs (Exe.Linkage.native_or_custom (Super_context.context sctx))] + [Exe.Linkage.Js.Non_js (Exe.Linkage.native_or_custom (Super_context.context sctx))] in Exe.build_and_link cctx ~program:{ name; main_module_name; loc } diff --git a/src/exe.ml b/src/exe.ml index 5c2f530faba..86d20ff1f3a 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -24,7 +24,7 @@ module Linkage = struct type linkage = t type t = | Js - | NonJs of linkage + | Non_js of linkage end let byte = @@ -124,7 +124,7 @@ module Linkage = struct let of_user_config (ctx : Context.t) (m : Dune_file.Executables.Link_mode.t) = match m.mode with | Js -> Js.Js - | _ -> NonJs (of_user_config ctx m) + | _ -> Non_js (of_user_config ctx m) end let exe_path_from_name cctx ~name ~(linkage : Linkage.t) = @@ -231,7 +231,7 @@ let build_and_link_many match linkage with | Linkage.Js.Js -> link_js ~name ~cm_files ~promote cctx - | NonJs linkage -> + | Non_js linkage -> link_exe cctx ~loc ~name diff --git a/src/exe.mli b/src/exe.mli index 3eace7bfd8c..43ead2095bc 100644 --- a/src/exe.mli +++ b/src/exe.mli @@ -16,7 +16,7 @@ module Linkage : sig type linkage type t = | Js - | NonJs of linkage + | Non_js of linkage end with type linkage := t (** Byte compilation, exetension [.bc] *) diff --git a/src/exe_rules.ml b/src/exe_rules.ml index 01c280c13a4..7b7bd501004 100644 --- a/src/exe_rules.ml +++ b/src/exe_rules.ml @@ -80,7 +80,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander if L.Set.mem exes.modes L.byte && not (L.Set.mem exes.modes L.native) && not (L.Set.mem exes.modes L.exe) then - Exe.Linkage.Js.NonJs Exe.Linkage.custom :: l + Exe.Linkage.Js.Non_js Exe.Linkage.custom :: l else l in diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 518acf2ddbb..58ec6ab9f78 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -311,7 +311,7 @@ include Sub_system.Register_end_point( ) in let linkages = - List.map ~f:(fun linkage -> Exe.Linkage.Js.NonJs linkage) linkages in + List.map ~f:(fun linkage -> Exe.Linkage.Js.Non_js linkage) linkages in Exe.build_and_link cctx ~program:{ name; main_module_name = Module.name main_module ; loc } ~linkages diff --git a/src/toplevel.ml b/src/toplevel.ml index aa6c8093f44..08e2533f925 100644 --- a/src/toplevel.ml +++ b/src/toplevel.ml @@ -94,7 +94,7 @@ let setup_rules t = let sctx = Compilation_context.super_context t.cctx in Exe.build_and_link t.cctx ~program - ~linkages:[Exe.Linkage.Js.NonJs linkage] + ~linkages:[Exe.Linkage.Js.Non_js linkage] ~link_flags:(Build.return ["-linkall"; "-warn-error"; "-31"]) ~promote:None; let src = Exe.exe_path t.cctx ~program ~linkage in From 1506265a651e4a805928e7d26694714a6de850bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 09:30:18 +0200 Subject: [PATCH 16/34] Add comment to remove hack after 2.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/gen_rules.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 6c10fb28ba5..4c97168d53c 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -216,6 +216,7 @@ module Gen(P : sig val sctx : Super_context.t end) = struct |> SC.add_rules ~dir:ctx_dir sctx | _ -> ()); let dyn_deps = + (* DUNE2: no need to filter out js targets anymore *) let pred = let id = lazy ( let open Dyn.Encoder in From 95db9aff60d41d7209c2852f0473d0e0c5055271 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 10:22:12 +0200 Subject: [PATCH 17/34] Update CHANGES.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index dd28336b1bf..5bf05e08ec4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -15,6 +15,9 @@ is done to prevent the accidental collision with library dependencies of the executable. (#2364, fixes #2292, @rgrinberg) +- New compilation mode `js` for libraries and modules in order to explicitly + enable Javascript targets. (#1941, @nojb) + 1.11.0 (unreleased) ------------------- From 60d04841d5931508f9238e396679142d697c8585 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 11:16:34 +0200 Subject: [PATCH 18/34] Fix tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/test-cases/explicit_js_mode/e.ml | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/e.ml diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/e.ml b/test/blackbox-tests/test-cases/explicit_js_mode/e.ml new file mode 100644 index 00000000000..e69de29bb2d From eac0a95cee9a5e0f77027448a3931d210ad9000c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 11:21:55 +0200 Subject: [PATCH 19/34] Cleanup MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/exe_rules.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/exe_rules.ml b/src/exe_rules.ml index 7b7bd501004..573fa375989 100644 --- a/src/exe_rules.ml +++ b/src/exe_rules.ml @@ -53,12 +53,13 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander ]) in + let explicit_js_mode = Dune_project.explicit_js_mode (Scope.project scope) in + let linkages = let module L = Dune_file.Executables.Link_mode in let ctx = SC.context sctx in let l = let has_native = Option.is_some ctx.ocamlopt in - let explicit_js_mode = Dune_project.explicit_js_mode (Scope.project scope) in let modes = let f = function {L.mode = Js; _} -> true | _ -> false in if L.Set.exists exes.modes ~f then @@ -98,7 +99,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander let requires_link = Lib.Compile.requires_link compile_info in let js_of_ocaml = let js_of_ocaml = exes.buildable.js_of_ocaml in - if Dune_project.explicit_js_mode (Scope.project scope) then + if explicit_js_mode then Option.some_if (List.mem ~set:linkages Exe.Linkage.Js.Js) js_of_ocaml else Some js_of_ocaml From 687e26a210eb96e0e3e7c954eff5f03962b4d1d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 11:31:22 +0200 Subject: [PATCH 20/34] Update gen_tests.ml MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/gen_tests.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/test/blackbox-tests/gen_tests.ml b/test/blackbox-tests/gen_tests.ml index 1d4943991db..28e70492162 100644 --- a/test/blackbox-tests/gen_tests.ml +++ b/test/blackbox-tests/gen_tests.ml @@ -165,6 +165,7 @@ let exclusions = ; make "env" ~skip_ocaml:"<4.06.0" ; make "env-cflags" ~skip_ocaml:"<4.06.0" ; make "wrapped-transition" ~skip_ocaml:"<4.06.0" + ; make "explicit_js_mode" ~js:true ] let all_tests = lazy ( From 31af91e24e3af49720c80e7dc0bff058e17955b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 13:02:15 +0200 Subject: [PATCH 21/34] Add test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../test-cases/explicit_js_mode/run.t | 19 ++++++++++++++++++- .../test-cases/explicit_js_mode/sub/dune | 5 +++++ .../test-cases/explicit_js_mode/sub/efoo.ml | 0 3 files changed, 23 insertions(+), 1 deletion(-) create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/sub/dune create mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/sub/efoo.ml diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/run.t b/test/blackbox-tests/test-cases/explicit_js_mode/run.t index f00a72a0a8d..cbda6365f53 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/run.t +++ b/test/blackbox-tests/test-cases/explicit_js_mode/run.t @@ -36,7 +36,7 @@ Check that js targets are attached to @all, but not for tests that do not specify js mode (#1940). $ dune clean - $ dune build --display short @all + $ dune build --display short @@all ocamldep $ext_lib.eobjs/a.ml.d ocamlc $ext_lib.eobjs/byte/a.{cmi,cmo,cmt} ocamlc a.bc @@ -66,3 +66,20 @@ specify js mode (#1940). ocamlopt .foo.objs/native/foo__C.{cmx,o} ocamlopt foo.{a,cmxa} ocamlopt foo.cmxs + +In the following test, the executable efoo has js mode enabled but it depends +on the library foo that does not have it enabled. One can compile the bytecode +executable: + + $ dune build --display short sub/efoo.bc + ocamldep sub/.efoo.eobjs/efoo.ml.d + ocamlc sub/.efoo.eobjs/byte/efoo.{cmi,cmo,cmt} + ocamlc sub/efoo.bc + +But not the JS: + + $ dune build --display short sub/efoo.bc.js + js_of_ocaml sub/efoo.bc.runtime.js + Error: No rule found for .foo.objs/foo.cma.js + js_of_ocaml sub/.efoo.eobjs/byte/efoo.cmo.js + [1] diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/sub/dune b/test/blackbox-tests/test-cases/explicit_js_mode/sub/dune new file mode 100644 index 00000000000..b7abbac1dfb --- /dev/null +++ b/test/blackbox-tests/test-cases/explicit_js_mode/sub/dune @@ -0,0 +1,5 @@ +(executable + (name efoo) + (modes js) + (libraries foo) + (modules efoo)) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/sub/efoo.ml b/test/blackbox-tests/test-cases/explicit_js_mode/sub/efoo.ml new file mode 100644 index 00000000000..e69de29bb2d From db69b933cf0e2400152611c04e5c4a62fa629188 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 13:08:49 +0200 Subject: [PATCH 22/34] Update dune.inc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/dune.inc | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index bf7dfb7207e..a7447f45ce2 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -1706,7 +1706,6 @@ (alias exe-name-mangle) (alias exec-cmd) (alias exec-missing) - (alias explicit_js_mode) (alias external-lib-deps) (alias extra-lang-line) (alias fallback-dune) @@ -2029,6 +2028,6 @@ (name runtest-disabled) (deps (alias cinaps) (alias envs-and-contexts))) -(alias (name runtest-js) (deps (alias js_of_ocaml))) +(alias (name runtest-js) (deps (alias explicit_js_mode) (alias js_of_ocaml))) (alias (name runtest-coq) (deps (alias coq))) \ No newline at end of file From 279640dba546768dee48aa9cca41e694ce18c83d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 13:28:06 +0200 Subject: [PATCH 23/34] Update gen_tests.ml MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/gen_tests.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/blackbox-tests/gen_tests.ml b/test/blackbox-tests/gen_tests.ml index 28e70492162..ced5bd8e9de 100644 --- a/test/blackbox-tests/gen_tests.ml +++ b/test/blackbox-tests/gen_tests.ml @@ -165,7 +165,7 @@ let exclusions = ; make "env" ~skip_ocaml:"<4.06.0" ; make "env-cflags" ~skip_ocaml:"<4.06.0" ; make "wrapped-transition" ~skip_ocaml:"<4.06.0" - ; make "explicit_js_mode" ~js:true + ; make "explicit_js_mode" ~external_deps:true ~js:true ] let all_tests = lazy ( From a465feb2e2ddbbd044fd8c7234bd34fa9a984198 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 13:50:46 +0200 Subject: [PATCH 24/34] Revert changes to JS compilation of libs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/lib_rules.ml | 17 ++--------------- 1 file changed, 2 insertions(+), 15 deletions(-) diff --git a/src/lib_rules.ml b/src/lib_rules.ml index aad71f4e534..23ff418730e 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -279,10 +279,6 @@ module Gen (P : sig val sctx : Super_context.t end) = struct let obj_dir = Compilation_context.obj_dir cctx in let flags = Compilation_context.flags cctx in let modules = Compilation_context.modules cctx in - let explicit_js_mode = - Dune_project.explicit_js_mode - (Scope.project (Compilation_context.scope cctx)) - in let js_of_ocaml = lib.buildable.js_of_ocaml in let { Lib_config. ext_obj; has_native; natdynlink_supported; _ } = ctx.lib_config in @@ -308,9 +304,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct Mode.Dict.Set.iter modes ~f:(fun mode -> build_lib lib ~expander ~flags ~dir ~mode ~cm_files)); (* Build *.cma.js *) - if (explicit_js_mode && Mode_conf.Set.mem lib.modes Js) || - (not explicit_js_mode && modes.byte) - then + if modes.byte then SC.add_rules sctx ~dir ( let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in @@ -361,13 +355,6 @@ module Gen (P : sig val sctx : Super_context.t end) = struct let cctx = 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 = lib.buildable.js_of_ocaml in - if Dune_project.explicit_js_mode (Scope.project scope) then - Option.some_if (Mode_conf.Set.mem lib.modes Js) js_of_ocaml - else - Some js_of_ocaml - in let dynlink = Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries in Compilation_context.create () @@ -383,7 +370,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct ~preprocessing:pp ~no_keep_locs:lib.no_keep_locs ~opaque - ~js_of_ocaml + ~js_of_ocaml:(Some lib.buildable.js_of_ocaml) ~dynlink ?stdlib:lib.stdlib ~package:(Option.map lib.public ~f:(fun p -> p.package)) From acd2bb75b624805094d80958ff425eb5b8763663 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 13:56:47 +0200 Subject: [PATCH 25/34] Update tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../test-cases/explicit_js_mode/dune | 13 +++++---- .../test-cases/explicit_js_mode/e.ml | 0 .../test-cases/explicit_js_mode/run.t | 29 ++++--------------- .../test-cases/explicit_js_mode/sub/dune | 5 ---- .../test-cases/explicit_js_mode/sub/efoo.ml | 0 5 files changed, 12 insertions(+), 35 deletions(-) mode change 100644 => 100755 test/blackbox-tests/test-cases/explicit_js_mode/e.ml delete mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/sub/dune delete mode 100644 test/blackbox-tests/test-cases/explicit_js_mode/sub/efoo.ml diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/dune b/test/blackbox-tests/test-cases/explicit_js_mode/dune index a76373a0bd0..ceefe483d31 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/dune +++ b/test/blackbox-tests/test-cases/explicit_js_mode/dune @@ -11,11 +11,12 @@ (name foo) (modules c)) -(library - (name bar) - (modules d) - (modes js)) - (test + (name d) + (modules d)) + +(executable (name e) - (modules e)) + (modules e) + (modes js) + (libraries foo)) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/e.ml b/test/blackbox-tests/test-cases/explicit_js_mode/e.ml old mode 100644 new mode 100755 diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/run.t b/test/blackbox-tests/test-cases/explicit_js_mode/run.t index cbda6365f53..20b6d114695 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/run.t +++ b/test/blackbox-tests/test-cases/explicit_js_mode/run.t @@ -19,24 +19,18 @@ We also check that .cmo.js rules are not generated if not specified. Error: Don't know how to build _build/default/.a.eobjs/byte/a.cmo.js [1] -Same for libraries. +JS compilation of libraries is always available to avoid having to annotate +every dependency of an executable. $ dune build --display short _build/default/.foo.objs/foo.cma.js Error: Don't know how to build _build/default/.foo.objs/foo.cma.js [1] - $ dune build --display short _build/default/.bar.objs/bar.cma.js - ocamlc .bar.objs/byte/bar.{cmi,cmo,cmt} - ocamldep .bar.objs/d.ml.d - ocamlc .bar.objs/byte/bar__D.{cmi,cmo,cmt} - ocamlc bar.cma - js_of_ocaml .bar.objs/bar.cma.js - Check that js targets are attached to @all, but not for tests that do not specify js mode (#1940). $ dune clean - $ dune build --display short @@all + $ dune build --display short @@all | grep js_of_ocaml ocamldep $ext_lib.eobjs/a.ml.d ocamlc $ext_lib.eobjs/byte/a.{cmi,cmo,cmt} ocamlc a.bc @@ -67,19 +61,6 @@ specify js mode (#1940). ocamlopt foo.{a,cmxa} ocamlopt foo.cmxs -In the following test, the executable efoo has js mode enabled but it depends -on the library foo that does not have it enabled. One can compile the bytecode -executable: - - $ dune build --display short sub/efoo.bc - ocamldep sub/.efoo.eobjs/efoo.ml.d - ocamlc sub/.efoo.eobjs/byte/efoo.{cmi,cmo,cmt} - ocamlc sub/efoo.bc +Check that building a JS-enabled executable that depends on a library works. -But not the JS: - - $ dune build --display short sub/efoo.bc.js - js_of_ocaml sub/efoo.bc.runtime.js - Error: No rule found for .foo.objs/foo.cma.js - js_of_ocaml sub/.efoo.eobjs/byte/efoo.cmo.js - [1] + $ dune build --display short e.bc.js diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/sub/dune b/test/blackbox-tests/test-cases/explicit_js_mode/sub/dune deleted file mode 100644 index b7abbac1dfb..00000000000 --- a/test/blackbox-tests/test-cases/explicit_js_mode/sub/dune +++ /dev/null @@ -1,5 +0,0 @@ -(executable - (name efoo) - (modes js) - (libraries foo) - (modules efoo)) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/sub/efoo.ml b/test/blackbox-tests/test-cases/explicit_js_mode/sub/efoo.ml deleted file mode 100644 index e69de29bb2d..00000000000 From 003d28f5c1d14658b8d0508b3e00f4d52cc1c481 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 14:01:18 +0200 Subject: [PATCH 26/34] Promote test results MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../test-cases/explicit_js_mode/run.t | 50 ++++++++----------- 1 file changed, 21 insertions(+), 29 deletions(-) diff --git a/test/blackbox-tests/test-cases/explicit_js_mode/run.t b/test/blackbox-tests/test-cases/explicit_js_mode/run.t index 20b6d114695..a52f4befdf9 100644 --- a/test/blackbox-tests/test-cases/explicit_js_mode/run.t +++ b/test/blackbox-tests/test-cases/explicit_js_mode/run.t @@ -2,7 +2,7 @@ Check that .bc.js rule is generated only if js mode is used. $ dune build --display short a.bc.js Error: Don't know how to build a.bc.js - Hint: did you mean b.bc.js? + Hint: did you mean b.bc.js or e.bc.js? [1] $ dune build --display short b.bc.js @@ -23,44 +23,36 @@ JS compilation of libraries is always available to avoid having to annotate every dependency of an executable. $ dune build --display short _build/default/.foo.objs/foo.cma.js - Error: Don't know how to build _build/default/.foo.objs/foo.cma.js - [1] + ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} + ocamldep .foo.objs/c.ml.d + ocamlc .foo.objs/byte/foo__C.{cmi,cmo,cmt} + ocamlc foo.cma + js_of_ocaml .foo.objs/foo.cma.js Check that js targets are attached to @all, but not for tests that do not specify js mode (#1940). $ dune clean - $ dune build --display short @@all | grep js_of_ocaml - ocamldep $ext_lib.eobjs/a.ml.d - ocamlc $ext_lib.eobjs/byte/a.{cmi,cmo,cmt} - ocamlc a.bc - ocamldep .b.eobjs/b.ml.d - ocamlc .b.eobjs/byte/b.{cmi,cmo,cmt} - ocamlc b.bc + $ dune build --display short @@all 2>&1 | grep js_of_ocaml js_of_ocaml b.bc.runtime.js js_of_ocaml .b.eobjs/byte/b.cmo.js - ocamlc .bar.objs/byte/bar.{cmi,cmo,cmt} - ocamldep .bar.objs/d.ml.d - ocamlc .bar.objs/byte/bar__D.{cmi,cmo,cmt} - ocamlc bar.cma + js_of_ocaml e.bc.runtime.js + js_of_ocaml .e.eobjs/byte/e.cmo.js + js_of_ocaml .js/stdlib/stdlib.cma.js + js_of_ocaml .foo.objs/foo.cma.js + +Check that building a JS-enabled executable that depends on a library works. + + $ dune clean + $ dune build --display short e.bc.js + js_of_ocaml e.bc.runtime.js ocamldep .e.eobjs/e.ml.d - ocamlc .e.eobjs/byte/e.{cmi,cmo,cmt} - ocamlc e.bc ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} - ocamlopt .foo.objs/native/foo.{cmx,o} ocamldep .foo.objs/c.ml.d ocamlc .foo.objs/byte/foo__C.{cmi,cmo,cmt} ocamlc foo.cma - ocamlopt $ext_lib.eobjs/native/a.{cmx,o} - ocamlopt a.exe + js_of_ocaml .foo.objs/foo.cma.js js_of_ocaml .js/stdlib/stdlib.cma.js - jsoo_link b.bc.js - ocamlopt .e.eobjs/native/e.{cmx,o} - ocamlopt e.exe - ocamlopt .foo.objs/native/foo__C.{cmx,o} - ocamlopt foo.{a,cmxa} - ocamlopt foo.cmxs - -Check that building a JS-enabled executable that depends on a library works. - - $ dune build --display short e.bc.js + ocamlc .e.eobjs/byte/e.{cmi,cmo,cmt} + js_of_ocaml .e.eobjs/byte/e.cmo.js + jsoo_link e.bc.js From 470c183ba6df9508137b4aad74f1cb3de6ad3006 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 14:40:24 +0200 Subject: [PATCH 27/34] Move Js variant from Mode_conf.t to Binary_kind.t MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/binary_kind.ml | 5 ++++- src/binary_kind.mli | 1 + src/cinaps.ml | 5 +---- src/dune_file.ml | 33 +++++++-------------------------- src/dune_file.mli | 1 - src/exe.ml | 30 +++++++++++++----------------- src/exe.mli | 16 ++++++---------- src/exe_rules.ml | 6 +++--- src/inline_tests.ml | 2 -- src/toplevel.ml | 2 +- 10 files changed, 36 insertions(+), 65 deletions(-) diff --git a/src/binary_kind.ml b/src/binary_kind.ml index e2c47cc7be8..468d527a436 100644 --- a/src/binary_kind.ml +++ b/src/binary_kind.ml @@ -5,6 +5,7 @@ type t = | Exe | Object | Shared_object + | Js let decode = let open Dune_lang.Decoder in @@ -13,6 +14,7 @@ let decode = ; "exe" , return Exe ; "object" , return Object ; "shared_object" , return Shared_object + ; "js" , Syntax.since Stanza.syntax (1, 11) >>> return Js ] let to_string = function @@ -20,6 +22,7 @@ let to_string = function | Exe -> "exe" | Object -> "object" | Shared_object -> "shared_object" + | Js -> "js" let to_dyn t = let open Dyn.Encoder in @@ -28,4 +31,4 @@ let to_dyn t = let encode t = Dune_lang.unsafe_atom_of_string (to_string t) -let all = [C; Exe; Object; Shared_object] +let all = [C; Exe; Object; Shared_object; Js] diff --git a/src/binary_kind.mli b/src/binary_kind.mli index 6f0778ced55..dbff82f62c7 100644 --- a/src/binary_kind.mli +++ b/src/binary_kind.mli @@ -7,6 +7,7 @@ type t = | Exe | Object | Shared_object + | Js include Dune_lang.Conv with type t := t diff --git a/src/cinaps.ml b/src/cinaps.ml index beddc6257f4..1a37ab72d03 100644 --- a/src/cinaps.ml +++ b/src/cinaps.ml @@ -131,12 +131,9 @@ let gen_rules sctx t ~dir ~scope ~dir_kind = ~dynlink:false ~package:None in - let linkages = - [Exe.Linkage.Js.Non_js (Exe.Linkage.native_or_custom (Super_context.context sctx))] - in Exe.build_and_link cctx ~program:{ name; main_module_name; loc } - ~linkages + ~linkages:[Exe.Linkage.native_or_custom (Super_context.context sctx)] ~promote:None; Super_context.add_alias_action sctx ~dir ~loc:(Some loc) ~stamp:"cinaps" diff --git a/src/dune_file.ml b/src/dune_file.ml index 4273461b833..abe68984b7b 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -800,7 +800,6 @@ module Mode_conf = struct | Byte | Native | Best - | Js let compare (a : t) b = compare a b let to_dyn _ = Dyn.opaque end @@ -811,14 +810,12 @@ module Mode_conf = struct [ "byte" , Byte ; "native", Native ; "best" , Best - ; "js" , Js ] let to_string = function | Byte -> "byte" | Native -> "native" | Best -> "best" - | Js -> "js" let to_dyn t = let open Dyn.Encoder in @@ -837,7 +834,7 @@ module Mode_conf = struct let eval t ~has_native = let has_best = mem t Best in - let byte = mem t Byte || mem t Js || (has_best && (not has_native)) in + let byte = mem t Byte || (has_best && (not has_native)) in let native = has_native && (mem t Native || has_best) in { Mode.Dict.byte; native } end @@ -1529,7 +1526,7 @@ module Executables = struct let byte = byte_exe let native = native_exe - let js = make Js Exe + let js = make Byte Js let installable_modes = [exe; native; byte] @@ -1547,27 +1544,12 @@ module Executables = struct Dune_lang.Decoder.enum simple_representations let decode = - let then_ = - let non_js_mode = - let f (loc, mode) = - match mode with - | Mode_conf.Js -> - User_error.raise ~loc - [ Pp.text "It is not allowed to specify a binary kind when \ - using js mode." - ] - | mode -> mode - in - map ~f (located Mode_conf.decode) - in - enter - (let+ mode = non_js_mode - and+ kind = Binary_kind.decode - and+ loc = loc in - {mode; kind; loc}) - in if_list - ~then_ + ~then_:(enter + (let+ mode = Mode_conf.decode + and+ kind = Binary_kind.decode + and+ loc = loc in + {mode; kind; loc})) ~else_:simple let simple_encode link_mode = @@ -1685,7 +1667,6 @@ module Executables = struct match mode.mode with | Native | Best -> ".exe" | Byte -> ".bc" - | Js -> ".bc.js" in Names.install_conf names ~ext in diff --git a/src/dune_file.mli b/src/dune_file.mli index 8af6891bcaf..064e5452c9e 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -167,7 +167,6 @@ module Mode_conf : sig | Byte | Native | Best (** [Native] if available and [Byte] if not *) - | Js val decode : t Dune_lang.Decoder.t val compare : t -> t -> Ordering.t diff --git a/src/exe.ml b/src/exe.ml index 86d20ff1f3a..1ec3532bdb1 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -20,13 +20,6 @@ module Linkage = struct ; flags : string list } - module Js = struct - type linkage = t - type t = - | Js - | Non_js of linkage - end - let byte = { mode = Byte ; ext = ".bc" @@ -50,6 +43,12 @@ module Linkage = struct | None -> custom | Some _ -> native + let js = + { mode = Byte + ; ext = ".bc.js" + ; flags = [] + } + let make ~mode ~ext ?(flags=[]) () = { mode ; ext @@ -64,14 +63,12 @@ module Linkage = struct let of_user_config (ctx : Context.t) (m : Dune_file.Executables.Link_mode.t) = let wanted_mode : Mode.t = match m.mode with - | Js -> assert false | Byte -> Byte | Native -> Native | Best -> Native in let real_mode : Mode.t = match m.mode with - | Js -> assert false | Byte -> Byte | Native -> Native | Best -> if Option.is_some ctx.ocamlopt then Native else Byte @@ -88,10 +85,15 @@ module Linkage = struct | Native , Object -> ".exe" ^ ctx.lib_config.ext_obj | Byte , Shared_object -> ".bc" ^ ctx.lib_config.ext_dll | Native , Shared_object -> ctx.lib_config.ext_dll + | Byte , Js -> ".bc.js" + | Native , Js -> User_error.raise ~loc:m.loc + [ Pp.text "Javascript generation only \ + supports bytecode!" ] in let flags = match m.kind with | C -> c_flags + | Js -> [] | Exe -> begin match wanted_mode, real_mode with @@ -120,11 +122,6 @@ module Linkage = struct ; mode = real_mode ; flags } - - let of_user_config (ctx : Context.t) (m : Dune_file.Executables.Link_mode.t) = - match m.mode with - | Js -> Js.Js - | _ -> Non_js (of_user_config ctx m) end let exe_path_from_name cctx ~name ~(linkage : Linkage.t) = @@ -228,10 +225,9 @@ let build_and_link_many ~ext_obj:ctx.lib_config.ext_obj in List.iter linkages ~f:(fun linkage -> - match linkage with - | Linkage.Js.Js -> + if linkage = Linkage.js then link_js ~name ~cm_files ~promote cctx - | Non_js linkage -> + else link_exe cctx ~loc ~name diff --git a/src/exe.mli b/src/exe.mli index 43ead2095bc..0bbf6ed3270 100644 --- a/src/exe.mli +++ b/src/exe.mli @@ -12,13 +12,6 @@ end module Linkage : sig type t - module Js : sig - type linkage - type t = - | Js - | Non_js of linkage - end with type linkage := t - (** Byte compilation, exetension [.bc] *) val byte : t @@ -31,6 +24,9 @@ module Linkage : sig (** [native] if supported, [custom] if not *) val native_or_custom : Context.t -> t + (** Javascript compilation, extension [.bc.js] *) + val js : t + val make : mode:Mode.t -> ext:string @@ -38,7 +34,7 @@ module Linkage : sig -> unit -> t - val of_user_config : Context.t -> Dune_file.Executables.Link_mode.t -> Js.t + val of_user_config : Context.t -> Dune_file.Executables.Link_mode.t -> t end (** {1 High-level functions} *) @@ -47,7 +43,7 @@ end val build_and_link : program:Program.t - -> linkages:Linkage.Js.t list + -> linkages:Linkage.t list -> promote:Dune_file.Promote.t option -> ?link_flags:(unit, string list) Build.t -> Compilation_context.t @@ -55,7 +51,7 @@ val build_and_link val build_and_link_many : programs:Program.t list - -> linkages:Linkage.Js.t list + -> linkages:Linkage.t list -> promote:Dune_file.Promote.t option -> ?link_flags:(unit, string list) Build.t -> Compilation_context.t diff --git a/src/exe_rules.ml b/src/exe_rules.ml index 573fa375989..834afab21e9 100644 --- a/src/exe_rules.ml +++ b/src/exe_rules.ml @@ -61,7 +61,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander let l = let has_native = Option.is_some ctx.ocamlopt in let modes = - let f = function {L.mode = Js; _} -> true | _ -> false in + let f = function {L.kind = Js; _} -> true | _ -> false in if L.Set.exists exes.modes ~f then L.Set.add exes.modes L.byte_exe else if not explicit_js_mode && L.Set.mem exes.modes L.byte_exe then @@ -81,7 +81,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander if L.Set.mem exes.modes L.byte && not (L.Set.mem exes.modes L.native) && not (L.Set.mem exes.modes L.exe) then - Exe.Linkage.Js.Non_js Exe.Linkage.custom :: l + Exe.Linkage.custom :: l else l in @@ -100,7 +100,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander let js_of_ocaml = let js_of_ocaml = exes.buildable.js_of_ocaml in if explicit_js_mode then - Option.some_if (List.mem ~set:linkages Exe.Linkage.Js.Js) js_of_ocaml + Option.some_if (List.mem ~set:linkages Exe.Linkage.js) js_of_ocaml else Some js_of_ocaml in diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 58ec6ab9f78..e7b0994e5cc 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -310,8 +310,6 @@ include Sub_system.Register_end_point( | Javascript -> None ) in - let linkages = - List.map ~f:(fun linkage -> Exe.Linkage.Js.Non_js linkage) linkages in Exe.build_and_link cctx ~program:{ name; main_module_name = Module.name main_module ; loc } ~linkages diff --git a/src/toplevel.ml b/src/toplevel.ml index 08e2533f925..fdf06f07d3b 100644 --- a/src/toplevel.ml +++ b/src/toplevel.ml @@ -94,7 +94,7 @@ let setup_rules t = let sctx = Compilation_context.super_context t.cctx in Exe.build_and_link t.cctx ~program - ~linkages:[Exe.Linkage.Js.Non_js linkage] + ~linkages:[linkage] ~link_flags:(Build.return ["-linkall"; "-warn-error"; "-31"]) ~promote:None; let src = Exe.exe_path t.cctx ~program ~linkage in From afbb54e2df66dcde8e806f00636d388f4271d98e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 15:10:33 +0200 Subject: [PATCH 28/34] Reduce diff MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_file.ml | 11 ++++++----- src/exe.ml | 7 ++++--- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/dune_file.ml b/src/dune_file.ml index abe68984b7b..f4a659654f8 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -1545,11 +1545,12 @@ module Executables = struct let decode = if_list - ~then_:(enter - (let+ mode = Mode_conf.decode - and+ kind = Binary_kind.decode - and+ loc = loc in - {mode; kind; loc})) + ~then_: + (enter + (let+ mode = Mode_conf.decode + and+ kind = Binary_kind.decode + and+ loc = loc in + {mode; kind; loc})) ~else_:simple let simple_encode link_mode = diff --git a/src/exe.ml b/src/exe.ml index 1ec3532bdb1..cca94cd7954 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -63,13 +63,13 @@ module Linkage = struct let of_user_config (ctx : Context.t) (m : Dune_file.Executables.Link_mode.t) = let wanted_mode : Mode.t = match m.mode with - | Byte -> Byte + | Byte -> Byte | Native -> Native | Best -> Native in let real_mode : Mode.t = match m.mode with - | Byte -> Byte + | Byte -> Byte | Native -> Native | Best -> if Option.is_some ctx.ocamlopt then Native else Byte in @@ -207,9 +207,10 @@ let build_and_link_many ?link_flags cctx = - let modules = CC.modules cctx in + let modules = Compilation_context.modules cctx in let dep_graphs = Dep_rules.rules cctx ~modules in Module_compilation.build_all cctx ~dep_graphs; + let link_time_code_gen = Link_time_code_gen.handle_special_libs cctx in List.iter programs ~f:(fun { Program.name; main_module_name ; loc } -> let cm_files = From 3e33392662e1d04dc78652c97f916d0bb7f224c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 15:19:28 +0200 Subject: [PATCH 29/34] Add doc to the manual MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/advanced-topics.rst | 18 ++++++++++++++++++ doc/dune-files.rst | 4 ++++ 2 files changed, 22 insertions(+) diff --git a/doc/advanced-topics.rst b/doc/advanced-topics.rst index d1e14e24459..5b792ce623c 100644 --- a/doc/advanced-topics.rst +++ b/doc/advanced-topics.rst @@ -268,6 +268,24 @@ Starting from dune 2.0, dune mangles compilation units of executables by default. However, this can still be turned off using ``(wrapped_executables false)`` +Explicit JS mode +================ + +By default, Javascript targets are defined for every bytecode executable that +dune knows about. This is not very precise and does not interact well with the +``@all`` alias (eg, the ``@all`` alias will try to build JS targets +corresponding to every `test` stanza). In order to better control the +compilation of JS targets, this behaviour can be turned off by using +``(explicit_js_mode)`` in the ``dune-project`` file. + +When explicit JS mode is enabled, an explicit `js` mode needs to be added to the +``(modes ...)`` field of executables in order to trigger JS +compilation. Explicit JS targets declared like this will be attached to the +``@all`` alias. + +Starting from dune 2.0 this new behaviour will be the default and JS compilation +of binaries will need to be explicitly declared. + .. _dialects-main: Dialects diff --git a/doc/dune-files.rst b/doc/dune-files.rst index b416eb5b11d..4d51b538632 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -341,6 +341,8 @@ compilation is not available. - ``shared_object`` for producing object files that can be dynamically loaded into an application. This mode can be used to write a plugin in OCaml for a non-OCaml application. +- ``js`` for producing Javascript from bytecode executables, see + `Explicit JS mode`_. For instance the following ``executables`` stanza will produce byte code executables and native shared objects: @@ -359,6 +361,7 @@ Additionally, you can use the following short-hands: - ``shared_object`` for ``(best shared_object)`` - ``byte`` for ``(byte exe)`` - ``native`` for ``(native exe)`` +- ``js`` for ``(byte js)`` For instance the following ``modes`` fields are all equivalent: @@ -381,6 +384,7 @@ native/best object .exe%{ext_obj} byte shared_object .bc%{ext_dll} native/best shared_object %{ext_dll} byte c .bc.c +byte js .bc.js ================ ============= ================= Where ``%{ext_obj}`` and ``%{ext_dll}`` are the extensions for object From 818c2ef2d729c40809203e37792e6b726dc5091e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 15:22:06 +0200 Subject: [PATCH 30/34] Update CHANGES.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- CHANGES.md | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5bf05e08ec4..9bedcc344ce 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -15,8 +15,7 @@ is done to prevent the accidental collision with library dependencies of the executable. (#2364, fixes #2292, @rgrinberg) -- New compilation mode `js` for libraries and modules in order to explicitly - enable Javascript targets. (#1941, @nojb) +- Enable `(explicit_js_mode)` by default. (#1941, @nojb) 1.11.0 (unreleased) ------------------- @@ -111,6 +110,10 @@ framework with a variable (#2313, @mlasson, original idea by @diml, review by @rgrinberg). +- New binary kind `js` for executables in order to explicitly enable Javascript + targets, and a switch `(explicit_js_mode)` to require this mode in order to + declare JS targets corresponding to executables. (#1941, @nojb) + 1.10.0 (04/06/2019) ------------------- From 8d73424bc2f7d3c1e76e64fd2918023022991341 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 15:46:17 +0200 Subject: [PATCH 31/34] Fix doc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/advanced-topics.rst | 4 +++- doc/dune-files.rst | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/advanced-topics.rst b/doc/advanced-topics.rst index 5b792ce623c..bed9886e2b0 100644 --- a/doc/advanced-topics.rst +++ b/doc/advanced-topics.rst @@ -268,13 +268,15 @@ Starting from dune 2.0, dune mangles compilation units of executables by default. However, this can still be turned off using ``(wrapped_executables false)`` +.. _explicit-js-mode: + Explicit JS mode ================ By default, Javascript targets are defined for every bytecode executable that dune knows about. This is not very precise and does not interact well with the ``@all`` alias (eg, the ``@all`` alias will try to build JS targets -corresponding to every `test` stanza). In order to better control the +corresponding to every ``test`` stanza). In order to better control the compilation of JS targets, this behaviour can be turned off by using ``(explicit_js_mode)`` in the ``dune-project`` file. diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 4d51b538632..cee27469a2f 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -342,7 +342,7 @@ compilation is not available. loaded into an application. This mode can be used to write a plugin in OCaml for a non-OCaml application. - ``js`` for producing Javascript from bytecode executables, see - `Explicit JS mode`_. + :ref:`explicit-js-mode`. For instance the following ``executables`` stanza will produce byte code executables and native shared objects: From 3796f5fafe3cba8e7b67726bf20879ebda9aa657 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 16:16:41 +0200 Subject: [PATCH 32/34] Update dune.inc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/dune.inc | 1 - 1 file changed, 1 deletion(-) diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index a7447f45ce2..f8af5fd88a9 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -1904,7 +1904,6 @@ (alias exe-name-mangle) (alias exec-cmd) (alias exec-missing) - (alias explicit_js_mode) (alias external-lib-deps) (alias extra-lang-line) (alias fallback-dune) From a64e028a1609e242e441b994aaf9703e93719bfb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 16:30:58 +0200 Subject: [PATCH 33/34] Fix MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/inline_tests.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/inline_tests.ml b/src/inline_tests.ml index e7b0994e5cc..9fae2044951 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -292,7 +292,7 @@ include Sub_system.Register_end_point( ~requires_compile:runner_libs ~requires_link:(lazy runner_libs) ~flags:(Ocaml_flags.of_list ["-w"; "-24"; "-g"]) - ~js_of_ocaml:None + ~js_of_ocaml:(Some lib.buildable.js_of_ocaml) ~dynlink:false ~package:(Option.map lib.public ~f:(fun p -> p.package)); in From 998e1cac2fc23d21a2d3a2073b3fa09fe7c2a067 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 22 Jul 2019 17:05:32 +0200 Subject: [PATCH 34/34] Fix inline_tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/inline_tests.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 9fae2044951..6bcc993ecab 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -302,12 +302,12 @@ include Sub_system.Register_end_point( then Mode_conf.Set.add info.modes Byte else info.modes in - List.filter_map (Mode_conf.Set.to_list modes) ~f:(fun (mode : Mode_conf.t) -> + List.map (Mode_conf.Set.to_list modes) ~f:(fun (mode : Mode_conf.t) -> match mode with - | Native -> Some Exe.Linkage.native - | Best -> Some (Exe.Linkage.native_or_custom (Super_context.context sctx)) - | Byte -> Some Exe.Linkage.byte - | Javascript -> None + | Native -> Exe.Linkage.native + | Best -> Exe.Linkage.native_or_custom (Super_context.context sctx) + | Byte -> Exe.Linkage.byte + | Javascript -> Exe.Linkage.js ) in Exe.build_and_link cctx