From 420dad42c2a2c95ef67588d7cd72bf7f7275d62f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 31 Oct 2019 13:29:45 +0900 Subject: [PATCH 1/2] Make Hidden constructor take a record Otherwise, the string argument is unclear. Signed-off-by: Rudi Grinberg --- src/dune/lib.ml | 21 +++++++++++++++------ src/dune/lib.mli | 5 ++++- 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/src/dune/lib.ml b/src/dune/lib.ml index e37a77121e7..aaff8b8baa6 100644 --- a/src/dune/lib.ml +++ b/src/dune/lib.ml @@ -331,7 +331,10 @@ type db = and resolve_result = | Not_found | Found of Lib_info.external_ - | Hidden of Lib_info.external_ * string + | Hidden of + { info : Lib_info.external_ + ; reason : string + } | Redirect of db option * (Loc.t * Lib_name.t) type lib = t @@ -1134,7 +1137,7 @@ end = struct in Table.add_exn db.table name res; res - | Hidden (info, hidden) -> ( + | Hidden { info; reason = hidden } -> ( match match db.parent with | None -> St_not_found @@ -1539,7 +1542,10 @@ module DB = struct type t = resolve_result = | Not_found | Found of Lib_info.external_ - | Hidden of Lib_info.external_ * string + | Hidden of + { info : Lib_info.external_ + ; reason : string + } | Redirect of db option * (Loc.t * Lib_name.t) let to_dyn x = @@ -1547,8 +1553,8 @@ module DB = struct match x with | Not_found -> constr "Not_found" [] | Found lib -> constr "Found" [ Lib_info.to_dyn Path.to_dyn lib ] - | Hidden (lib, s) -> - constr "Hidden" [ Lib_info.to_dyn Path.to_dyn lib; string s ] + | Hidden { info = lib; reason } -> + constr "Hidden" [ Lib_info.to_dyn Path.to_dyn lib; string reason ] | Redirect (_, (_, name)) -> constr "Redirect" [ Lib_name.to_dyn name ] end @@ -1752,7 +1758,10 @@ module DB = struct else Not_found | Hidden pkg -> - Hidden (Dune_package.Lib.info pkg, "unsatisfied 'exist_if'") )) + Hidden + { info = Dune_package.Lib.info pkg + ; reason = "unsatisfied 'exist_if'" + } )) ~all:(fun () -> Findlib.all_packages findlib |> List.map ~f:Dune_package.Entry.name) diff --git a/src/dune/lib.mli b/src/dune/lib.mli index 30f5888cf67..b5a2e1720e1 100644 --- a/src/dune/lib.mli +++ b/src/dune/lib.mli @@ -149,7 +149,10 @@ module DB : sig type nonrec t = | Not_found | Found of Lib_info.external_ - | Hidden of Lib_info.external_ * string + | Hidden of + { info : Lib_info.external_ + ; reason : string + } | Redirect of t option * (Loc.t * Lib_name.t) val to_dyn : t Dyn.Encoder.t From bddaddf359b92f4655b09dc4f9d726ac19a29015 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 31 Oct 2019 14:32:55 +0900 Subject: [PATCH 2/2] Conditionally produce empty archive These cannot be produced with msvc Signed-off-by: Rudi Grinberg --- src/dune/context.ml | 21 +++------------------ src/dune/context.mli | 10 +--------- src/dune/lib_archives.ml | 18 +++++++++++++++--- src/dune/lib_archives.mli | 3 +++ src/dune/lib_config.ml | 24 ++++++++++++++++++++++++ src/dune/lib_config.mli | 13 +++++++++++++ src/dune/lib_rules.ml | 30 ++++++++++++++++++++++-------- src/dune/modules.ml | 10 ++++++++++ src/dune/modules.mli | 2 ++ 9 files changed, 93 insertions(+), 38 deletions(-) diff --git a/src/dune/context.ml b/src/dune/context.ml index 49d3821df46..7319e94790d 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -35,22 +35,6 @@ module Env_nodes = struct (Dune_env.Stanza.find env_nodes.workspace ~profile).env_vars end -module Ccomp_type = struct - type t = - | Msvc - | Other of string - - let to_dyn = - let open Dyn.Encoder in - function - | Msvc -> constr "Msvc" [] - | Other s -> constr "Other" [ string s ] - - let of_string = function - | "msvc" -> Msvc - | s -> Other s -end - type t = { name : Context_name.t ; kind : Kind.t @@ -79,7 +63,7 @@ type t = ; version_string : string ; version : Ocaml_version.t ; stdlib_dir : Path.t - ; ccomp_type : Ccomp_type.t + ; ccomp_type : Lib_config.Ccomp_type.t ; c_compiler : string ; ocamlc_cflags : string list ; ocamlopt_cflags : string list @@ -474,6 +458,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets let version = Ocaml_version.of_ocaml_config ocfg in let arch_sixtyfour = Ocaml_config.word_size ocfg = 64 in let ocamlopt = get_ocaml_tool "ocamlopt" in + let ccomp_type = Lib_config.Ccomp_type.of_config ocfg in let lib_config = { Lib_config.has_native = Option.is_some ocamlopt ; ext_obj = Ocaml_config.ext_obj ocfg @@ -486,11 +471,11 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ; natdynlink_supported = Dynlink_supported.By_the_os.of_bool natdynlink_supported ; stdlib_dir + ; ccomp_type } in if Option.is_some fdo_target_exe then check_fdo_support lib_config.has_native ocfg ~name; - let ccomp_type = Ccomp_type.of_string (Ocaml_config.ccomp_type ocfg) in let t = { name ; implicit diff --git a/src/dune/context.mli b/src/dune/context.mli index fca32523b71..10e6f447de9 100644 --- a/src/dune/context.mli +++ b/src/dune/context.mli @@ -42,14 +42,6 @@ module Env_nodes : sig } end -module Ccomp_type : sig - type t = - | Msvc - | Other of string - - val to_dyn : t -> Dyn.t -end - type t = { name : Context_name.t ; kind : Kind.t @@ -89,7 +81,7 @@ type t = ; version_string : string ; version : Ocaml_version.t ; stdlib_dir : Path.t - ; ccomp_type : Ccomp_type.t + ; ccomp_type : Lib_config.Ccomp_type.t ; c_compiler : string ; ocamlc_cflags : string list ; ocamlopt_cflags : string list diff --git a/src/dune/lib_archives.ml b/src/dune/lib_archives.ml index fc5d9bee697..693bf888c83 100644 --- a/src/dune/lib_archives.ml +++ b/src/dune/lib_archives.ml @@ -9,6 +9,13 @@ let lib_files t = t.lib_files let dll_files t = t.dll_files +let has_native_archive lib config contents = + Lib_config.linker_can_create_empty_archives config + || + let name = Dune_file.Library.best_name lib in + let modules = Dir_contents.modules_of_library contents ~name in + not (Modules.is_empty modules) + module Library = Dune_file.Library let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) = @@ -41,9 +48,14 @@ let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) = ; if_ (native && not virtual_library) (let files = - [ Library.archive ~dir lib ~ext:(Mode.compiled_lib_ext Native) - ; Library.archive ~dir lib ~ext:ext_lib - ] + if has_native_archive lib ctx.lib_config dir_contents then + [ Library.archive ~dir lib ~ext:ext_lib ] + else + [] + in + let files = + Library.archive ~dir lib ~ext:(Mode.compiled_lib_ext Native) + :: files in if Dynlink_supported.get lib.dynlink diff --git a/src/dune/lib_archives.mli b/src/dune/lib_archives.mli index c8508bf9150..eb7eeeabb45 100644 --- a/src/dune/lib_archives.mli +++ b/src/dune/lib_archives.mli @@ -2,6 +2,9 @@ open Stdune type t +val has_native_archive : + Dune_file.Library.t -> Lib_config.t -> Dir_contents.t -> bool + val make : ctx:Context.t -> dir:Path.Build.t diff --git a/src/dune/lib_config.ml b/src/dune/lib_config.ml index cf20827c762..f6ed2cc1468 100644 --- a/src/dune/lib_config.ml +++ b/src/dune/lib_config.ml @@ -1,5 +1,23 @@ open! Stdune +module Ccomp_type = struct + type t = + | Msvc + | Other of string + + let to_dyn = + let open Dyn.Encoder in + function + | Msvc -> constr "Msvc" [] + | Other s -> constr "Other" [ string s ] + + let of_string = function + | "msvc" -> Msvc + | s -> Other s + + let of_config ocfg = of_string (Ocaml_config.ccomp_type ocfg) +end + type t = { has_native : bool ; ext_lib : string @@ -11,6 +29,7 @@ type t = ; natdynlink_supported : Dynlink_supported.By_the_os.t ; ext_dll : string ; stdlib_dir : Path.t + ; ccomp_type : Ccomp_type.t } let var_map = @@ -28,3 +47,8 @@ let get_for_enabled_if t ~var = | None -> Code_error.raise "Lib_config.get_for_enabled_if: var not allowed" [ ("var", Dyn.Encoder.string var) ] + +let linker_can_create_empty_archives t = + match t.ccomp_type with + | Msvc -> false + | Other _ -> true diff --git a/src/dune/lib_config.mli b/src/dune/lib_config.mli index 7c2de4f84c7..8d3b94e0a64 100644 --- a/src/dune/lib_config.mli +++ b/src/dune/lib_config.mli @@ -1,5 +1,15 @@ open Stdune +module Ccomp_type : sig + type t = + | Msvc + | Other of string + + val to_dyn : t -> Dyn.t + + val of_config : Ocaml_config.t -> t +end + type t = { has_native : bool ; ext_lib : string @@ -11,8 +21,11 @@ type t = ; natdynlink_supported : Dynlink_supported.By_the_os.t ; ext_dll : string ; stdlib_dir : Path.t + ; ccomp_type : Ccomp_type.t } val allowed_in_enabled_if : string list val get_for_enabled_if : t -> var:string -> string + +val linker_can_create_empty_archives : t -> bool diff --git a/src/dune/lib_rules.ml b/src/dune/lib_rules.ml index 8bfb8874780..ae14bca3244 100644 --- a/src/dune/lib_rules.ml +++ b/src/dune/lib_rules.ml @@ -16,7 +16,8 @@ let msvc_hack_cclibs = Option.value ~default:lib (String.drop_prefix ~prefix:"-l" lib)) (* Build an OCaml library. *) -let build_lib (lib : Library.t) ~sctx ~expander ~flags ~dir ~mode ~cm_files = +let build_lib (lib : Library.t) ~sctx ~dir_contents ~expander ~flags ~dir ~mode + ~cm_files = let ctx = Super_context.context sctx in let { Lib_config.ext_lib; _ } = ctx.lib_config in Option.iter (Context.compiler ctx mode) ~f:(fun compiler -> @@ -74,7 +75,14 @@ let build_lib (lib : Library.t) ~sctx ~expander ~flags ~dir ~mode ~cm_files = ; Hidden_targets ( match mode with | Byte -> [] - | Native -> [ Library.archive lib ~dir ~ext:ext_lib ] ) + | Native -> + if + Lib_archives.has_native_archive lib ctx.lib_config + dir_contents + then + [ Library.archive lib ~dir ~ext:ext_lib ] + else + [] ) ] )) let gen_wrapped_compat_modules (lib : Library.t) cctx = @@ -211,7 +219,7 @@ let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents ocamlmklib ~archive_name ~loc:lib.buildable.loc ~sctx ~expander ~dir ~o_files ~c_library_flags:lib.c_library_flags ~build_targets_together -let build_shared lib ~sctx ~dir ~flags = +let build_shared lib ~dir_contents ~sctx ~dir ~flags = let ctx = Super_context.context sctx in Option.iter ctx.ocamlopt ~f:(fun ocamlopt -> let ext_lib = ctx.lib_config.ext_lib in @@ -226,7 +234,6 @@ let build_shared lib ~sctx ~dir ~flags = let build = Build.paths (Library.foreign_archives lib ~dir ~ext_lib |> List.map ~f:Path.build) - >>> Build.path (Path.build (Library.archive lib ~dir ~ext:ext_lib)) >>> Command.run ~dir:(Path.build ctx.build_dir) (Ok ocamlopt) [ Command.Args.dyn (Ocaml_flags.get flags Native) ; A "-shared" @@ -238,9 +245,16 @@ let build_shared lib ~sctx ~dir ~flags = ; Dep src ] in + let build = + if Lib_archives.has_native_archive lib ctx.lib_config dir_contents then + Build.path (Path.build (Library.archive lib ~dir ~ext:ext_lib)) + >>> build + else + build + in Super_context.add_rule sctx build ~dir) -let setup_build_archives (lib : Dune_file.Library.t) ~cctx +let setup_build_archives (lib : Dune_file.Library.t) ~dir_contents ~cctx ~(dep_graphs : Dep_graph.Ml_kind.t) ~expander = let dir = Compilation_context.dir cctx in let obj_dir = Compilation_context.obj_dir cctx in @@ -273,7 +287,7 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx Cm_files.make ~obj_dir ~ext_obj ~modules ~top_sorted_modules in Mode.Dict.Set.iter modes ~f:(fun mode -> - build_lib lib ~sctx ~expander ~flags ~dir ~mode ~cm_files)); + build_lib lib ~dir_contents ~sctx ~expander ~flags ~dir ~mode ~cm_files)); (* Build *.cma.js *) if modes.byte then Super_context.add_rules sctx ~dir @@ -287,7 +301,7 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx in Js_of_ocaml_rules.build_cm cctx ~js_of_ocaml ~src ~target); if Dynlink_supported.By_the_os.get natdynlink_supported && modes.native then - build_shared ~sctx lib ~dir ~flags + build_shared ~dir_contents ~sctx lib ~dir ~flags let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_info = @@ -351,7 +365,7 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents Module_compilation.build_all cctx ~dep_graphs; let expander = Super_context.expander sctx ~dir in if not (Library.is_virtual lib) then - setup_build_archives lib ~cctx ~dep_graphs ~expander; + setup_build_archives lib ~dir_contents ~cctx ~dep_graphs ~expander; let () = let vlib_stubs_o_files = Vimpl.vlib_stubs_o_files vimpl in if Library.has_foreign lib || List.is_non_empty vlib_stubs_o_files then diff --git a/src/dune/modules.ml b/src/dune/modules.ml index 6670648da18..bfc08e8a631 100644 --- a/src/dune/modules.ml +++ b/src/dune/modules.ml @@ -195,6 +195,8 @@ module Wrapped = struct ; wrapped : Mode.t } + let empty t = Module_name.Map.is_empty t.modules + let encode { modules; wrapped_compat; alias_module; main_module_name; wrapped } = let open Dune_lang.Encoder in @@ -752,3 +754,11 @@ let relocate_alias_module t ~src_dir = match t with | Wrapped t -> Wrapped (Wrapped.relocate_alias_module t ~src_dir) | s -> s + +let is_empty = function + | Stdlib _ + | Impl _ + | Singleton _ -> + false + | Unwrapped w -> Module_name.Map.is_empty w + | Wrapped w -> Wrapped.empty w diff --git a/src/dune/modules.mli b/src/dune/modules.mli index 225c106de01..a0d837aa1e4 100644 --- a/src/dune/modules.mli +++ b/src/dune/modules.mli @@ -95,3 +95,5 @@ val exit_module : t -> Module.t option (** [relcoate_alias_module t ~src_dir] sets the source directory of the alias module to [src_dir]. Only works if [t] is wrapped. *) val relocate_alias_module : t -> src_dir:Path.t -> t + +val is_empty : t -> bool