From e181d9e8e5675cafbe961c2d86eabc616d116db3 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 27 Sep 2020 13:38:22 -0700 Subject: [PATCH 1/4] Add (renaming ..) dependencies type (rename lib -> new_nam) to rename dependencies when they are shadowed Signed-off-by: Rudi Grinberg --- doc/concepts.rst | 23 ++ src/dune_rules/cinaps.ml | 4 +- src/dune_rules/compilation_context.ml | 29 +++ src/dune_rules/compilation_context.mli | 8 + src/dune_rules/dir_contents.ml | 1 + src/dune_rules/dune_file.ml | 70 ++++-- src/dune_rules/dune_file.mli | 10 +- src/dune_rules/exe_rules.ml | 2 + src/dune_rules/lib.ml | 49 +++- src/dune_rules/lib.mli | 5 + src/dune_rules/lib_dep.ml | 34 ++- src/dune_rules/lib_dep.mli | 9 +- src/dune_rules/lib_rules.ml | 3 +- src/dune_rules/ml_sources.ml | 25 +- src/dune_rules/module_compilation.ml | 83 +++++-- src/dune_rules/modules.ml | 31 ++- src/dune_rules/modules.mli | 6 +- test/blackbox-tests/test-cases/rename-deps.t | 231 +++++++++++++++++++ 18 files changed, 543 insertions(+), 80 deletions(-) create mode 100644 test/blackbox-tests/test-cases/rename-deps.t diff --git a/doc/concepts.rst b/doc/concepts.rst index 70745182a92..08dc7d8c246 100644 --- a/doc/concepts.rst +++ b/doc/concepts.rst @@ -373,6 +373,29 @@ not. When they are allowed, which is the default, all transitive dependencies are visible whether they are marked as re-exported or not. +Renamed dependencies +-------------------- + +A library dependency might be shadowed by an internal module with the same name +as the library. To workaround this limitation, we may introduce a new toplevel +name for ``foo`` using the ``rename`` construct: + +.. code:: scheme + + (rename -> ) + +Note that ```` will no longer be usable under its original name. + +For example: + +.. code:: scheme + + (library + (name bar) + (libraries (rename re -> re_unshadow))) + +This will make the ``re`` available under the ``Re_unshadow`` toplevel name. + .. _preprocessing-spec: Preprocessing specification diff --git a/src/dune_rules/cinaps.ml b/src/dune_rules/cinaps.ml index 74512662733..be208919695 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -30,9 +30,7 @@ let decode = field "files" Predicate_lang.Glob.decode ~default:Predicate_lang.any and+ preprocess, preprocessor_deps = Dune_file.preprocess_fields and+ libraries = - field "libraries" - (Dune_file.Lib_deps.decode ~allow_re_export:false) - ~default:[] + field "libraries" (Dune_file.Lib_deps.decode Executable) ~default:[] and+ flags = Ocaml_flags.Spec.decode in { loc; files; libraries; preprocess; preprocessor_deps; flags }) diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index 3c37653b350..23291cad87c 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -70,6 +70,7 @@ type t = ; vimpl : Vimpl.t option ; modes : Mode.Dict.Set.t ; bin_annot : bool + ; renames : (Lib.t * Module_name.t) list Or_exn.t } let super_context t = t.super_context @@ -114,10 +115,37 @@ let bin_annot t = t.bin_annot let context t = Super_context.context t.super_context +type rename = + { new_name : Module_name.t + ; old_name : Module_name.t + } + +let renames t = + let open Result.O in + let* renames = t.renames in + Result.List.map renames ~f:(fun (lib, new_name) -> + let* main_module_name = Lib.main_module_name lib in + let+ old_name = + match main_module_name with + | Some m -> Ok m + | None -> + Error + (User_error.E + (User_error.make + [ Pp.text "renaming unwrapped not supported yet" ])) + in + { new_name; old_name }) + let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags +<<<<<<< HEAD ~requires_compile ~requires_link ?(preprocessing = Pp_spec.dummy) ~opaque ?stdlib ~js_of_ocaml ~dynlink ~package ?vimpl ?modes ?(bin_annot = true) () = +======= + ~requires_compile ~requires_link ?(preprocessing = Preprocessing.dummy) + ~opaque ?stdlib ~js_of_ocaml ~dynlink ~package ?vimpl ?modes + ?(bin_annot = true) ?(renames = Ok []) () = +>>>>>>> 254959a66 (Rename dependencies) let project = Scope.project scope in let requires_compile = if Dune_project.implicit_transitive_deps project then @@ -158,6 +186,7 @@ let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags ; vimpl ; modes ; bin_annot + ; renames } let for_alias_module t = diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index 7bc3e2b80b2..8ca7eb1a2bf 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -40,6 +40,7 @@ val create : -> ?vimpl:Vimpl.t -> ?modes:Dune_file.Mode_conf.Set.Details.t Mode.Dict.t -> ?bin_annot:bool + -> ?renames:(Lib.t * Module_name.t) list Or_exn.t -> unit -> t @@ -99,3 +100,10 @@ val for_plugin_executable : val bin_annot : t -> bool val without_bin_annot : t -> t + +type rename = + { new_name : Module_name.t + ; old_name : Module_name.t + } + +val renames : t -> rename list Or_exn.t diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index e5ba636b924..a6110aee5a7 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -155,6 +155,7 @@ end = struct (* Manually add files generated by the (select ...) dependencies *) List.filter_map buildable.libraries ~f:(fun dep -> match (dep : Lib_dep.t) with + | Rename _ | Re_export _ | Direct _ -> None diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index 09d177cc47b..f6ac6ac0e3d 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -45,6 +45,10 @@ module Js_of_ocaml = struct { flags = Ordered_set_lang.Unexpanded.standard; javascript_files = [] } end +type for_ = + | Executable + | Library of Wrapped.t option + module Lib_deps = struct type t = Lib_dep.t list @@ -53,9 +57,21 @@ module Lib_deps = struct | Optional | Forbidden - let decode ~allow_re_export = + let rename_unwrapped_error loc = + User_error.raise ~loc + [ Pp.text "rename may not be used in unwrapped libraries" ] + + let decode for_ = let+ loc = loc - and+ t = repeat (Lib_dep.decode ~allow_re_export) in + and+ project = Dune_project.get_exn () + and+ t = + let allow_re_export = + match for_ with + | Library _ -> true + | Executable -> false + in + repeat (Lib_dep.decode ~allow_re_export) + in let add kind name acc = match Lib_name.Map.find acc name with | None -> Lib_name.Map.set acc name kind @@ -82,9 +98,28 @@ module Lib_deps = struct (Lib_name.to_string name) ] ) in + let check_rename = + match for_ with + | Library (Some (Simple false)) -> rename_unwrapped_error + | Library _ -> fun _loc -> () + | Executable -> + if Dune_project.wrapped_executables project then + fun _loc -> + () + else + fun loc -> + User_error.raise ~loc + [ Pp.text + "rename may not be used in executables without \ + wrapped_executables switched on in the dune-project file" + ] + in ignore ( List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x -> match x with + | Lib_dep.Rename ((loc, name), _) -> + check_rename loc; + add Required name acc | Lib_dep.Re_export (_, s) | Lib_dep.Direct (_, s) -> add Required s acc @@ -102,8 +137,9 @@ module Lib_deps = struct let info t ~kind = List.concat_map t ~f:(function - | Lib_dep.Re_export (_, s) - | Lib_dep.Direct (_, s) -> + | Lib_dep.Rename ((_, s), _) + | Re_export (_, s) + | Direct (_, s) -> [ (s, kind) ] | Select { choices; _ } -> List.concat_map choices ~f:(fun (c : Lib_dep.Select.Choice.t) -> @@ -163,16 +199,15 @@ module Buildable = struct ; allow_overlapping_dependencies : bool } - let decode ~in_library ~allow_re_export = + let decode (for_ : for_) = let use_foreign = Dune_lang.Syntax.deleted_in Stanza.syntax (2, 0) ~extra_info:"Use the (foreign_stubs ...) field instead." in let only_in_library decode = - if in_library then - decode - else - return None + match for_ with + | Executable -> return None + | Library _ -> decode in let add_stubs language ~loc ~names ~flags foreign_stubs = match names with @@ -219,8 +254,7 @@ module Buildable = struct >>> enter (maybe string) ))) and+ modules_without_implementation = Stanza_common.modules_field "modules_without_implementation" - and+ libraries = - field "libraries" (Lib_deps.decode ~allow_re_export) ~default:[] + and+ libraries = field "libraries" (Lib_deps.decode for_) ~default:[] and+ flags = Ocaml_flags.Spec.decode and+ js_of_ocaml = field "js_of_ocaml" Js_of_ocaml.decode ~default:Js_of_ocaml.default @@ -313,6 +347,11 @@ module Buildable = struct let has_foreign t = List.is_non_empty t.foreign_stubs || List.is_non_empty t.foreign_archives + + let first_rename_dep (t : t) = + List.find_map t.libraries ~f:(function + | Lib_dep.Rename ((loc, _), _) -> Some loc + | _ -> None) end module Public_lib = struct @@ -564,8 +603,9 @@ module Library = struct let decode = fields (let* stanza_loc = loc in + let* wrapped = Wrapped.field in let* dune_version = Dune_lang.Syntax.get_exn Stanza.syntax in - let+ buildable = Buildable.decode ~in_library:true ~allow_re_export:true + let+ buildable = Buildable.decode (Library (Option.map ~f:snd wrapped)) and+ name = field_o "name" Lib_name.Local.decode_loc and+ public = field_o "public_name" (Public_lib.decode ~allow_deprecated_names:false) @@ -585,7 +625,6 @@ module Library = struct field "modes" Mode_conf.Set.decode ~default:(Mode_conf.Set.default stanza_loc) and+ kind = field "kind" Lib_kind.decode ~default:Lib_kind.Normal - and+ wrapped = Wrapped.field and+ optional = field_b "optional" and+ no_dynlink = field_b "no_dynlink" and+ () = @@ -1347,7 +1386,7 @@ module Executables = struct let common = let* dune_version = Dune_lang.Syntax.get_exn Stanza.syntax in - let+ buildable = Buildable.decode ~in_library:false ~allow_re_export:false + let+ buildable = Buildable.decode Executable and+ (_ : bool) = field "link_executables" ~default:true (Dune_lang.Syntax.deleted_in Stanza.syntax (1, 0) >>> bool) @@ -1772,8 +1811,7 @@ module Tests = struct let gen_parse names = fields - (let+ buildable = - Buildable.decode ~in_library:false ~allow_re_export:false + (let+ buildable = Buildable.decode Executable and+ link_flags = Ordered_set_lang.Unexpanded.field "link_flags" and+ names = names and+ package = field_o "package" Stanza_common.Pkg.decode diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli index bd3ba3c1caa..a9e3bcdfea4 100644 --- a/src/dune_rules/dune_file.mli +++ b/src/dune_rules/dune_file.mli @@ -19,6 +19,10 @@ module Js_of_ocaml : sig val default : t end +type for_ = + | Executable + | Library of Wrapped.t option + module Lib_deps : sig type nonrec t = Lib_dep.t list @@ -26,7 +30,9 @@ module Lib_deps : sig val info : t -> kind:Lib_deps_info.Kind.t -> Lib_deps_info.t - val decode : allow_re_export:bool -> t Dune_lang.Decoder.t + val decode : for_ -> t Dune_lang.Decoder.t + + val rename_unwrapped_error : Loc.t -> 'a end (** [preprocess] and [preprocessor_deps] fields *) @@ -53,6 +59,8 @@ module Buildable : sig (** Check if the buildable has any foreign stubs or archives. *) val has_foreign : t -> bool + + val first_rename_dep : t -> Loc.t option end module Public_lib : sig diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index b95e4a5d70d..a40c868c2b6 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -138,9 +138,11 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info | Other { kind = Shared_object; _ } -> true | _ -> false) in + let renames = Lib.Compile.renames compile_info in Compilation_context.create () ~super_context:sctx ~expander ~scope ~obj_dir ~modules ~flags ~requires_link ~requires_compile ~preprocessing:pp ~js_of_ocaml ~opaque:Inherit_from_settings ~dynlink ~package:exes.package + ~renames in let requires_compile = Compilation_context.requires_compile cctx in let preprocess = diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 91dcae6ebfb..3145d639f97 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -239,7 +239,10 @@ module T = struct ; name : Lib_name.t ; unique_id : Id.t ; re_exports : t list Or_exn.t - ; requires : t list Or_exn.t + ; (* [requires] is contains all required libraries, including the ones + mentioned in [renames] and in [re_exports]. *) + requires : t list Or_exn.t + ; renames : (t * Module_name.t) list Or_exn.t ; ppx_runtime_deps : t list Or_exn.t ; pps : t list Or_exn.t ; resolved_selects : Resolved_select.t list @@ -983,6 +986,7 @@ module rec Resolve : sig ; pps : lib list Or_exn.t ; selects : Resolved_select.t list ; re_exports : lib list Or_exn.t + ; renames : (lib * Module_name.t) list Or_exn.t } val resolve_deps_and_add_runtime_deps : @@ -1086,7 +1090,7 @@ end = struct (Package.Name.to_string p') ] ))) in - let { requires; pps; selects = resolved_selects; re_exports } = + let { requires; pps; selects = resolved_selects; re_exports; renames } = let pps = Preprocess.Per_module.pps (Preprocess.Per_module.with_instrumentation (Lib_info.preprocess info) @@ -1142,6 +1146,7 @@ end = struct ; lib_config = db.lib_config ; re_exports ; project + ; renames } in t.sub_systems <- @@ -1242,6 +1247,7 @@ end = struct { resolved : t list Or_exn.t ; selects : Resolved_select.t list ; re_exports : t list Or_exn.t + ; renames : (lib * Module_name.t) list Or_exn.t } type resolved = @@ -1249,6 +1255,7 @@ end = struct ; pps : lib list Or_exn.t ; selects : Resolved_select.t list ; re_exports : lib list Or_exn.t + ; renames : (lib * Module_name.t) list Or_exn.t } let resolve_complex_deps db deps ~private_deps ~stack : resolved_deps = @@ -1277,9 +1284,9 @@ end = struct in (res, { Resolved_select.src_fn; dst_fn = result_fn }) in - let res, resolved_selects, re_exports = - List.fold_left deps ~init:(Ok [], [], Ok []) - ~f:(fun (acc_res, acc_selects, acc_re_exports) dep -> + let res, resolved_selects, re_exports, renames = + List.fold_left deps ~init:(Ok [], [], Ok [], Ok []) + ~f:(fun (acc_res, acc_selects, acc_re_exports, acc_renames) dep -> match (dep : Lib_dep.t) with | Re_export (loc, name) -> let lib = resolve_dep db (loc, name) ~private_deps ~stack in @@ -1293,14 +1300,27 @@ end = struct and+ acc_res = acc_res in lib :: acc_res in - (acc_res, acc_selects, acc_re_exports) + (acc_res, acc_selects, acc_re_exports, acc_renames) + | Rename ((loc, name), to_) -> + let lib = resolve_dep db (loc, name) ~private_deps ~stack in + let acc_res = + let+ lib = lib + and+ acc_res = acc_res in + lib :: acc_res + in + let acc_renames = + let+ lib = lib + and+ acc_renames = acc_renames in + (lib, to_) :: acc_renames + in + (acc_res, acc_selects, acc_re_exports, acc_renames) | Direct (loc, name) -> let acc_res = let+ lib = resolve_dep db (loc, name) ~private_deps ~stack and+ acc_res = acc_res in lib :: acc_res in - (acc_res, acc_selects, acc_re_exports) + (acc_res, acc_selects, acc_re_exports, acc_renames) | Select select -> let res, resolved_select = resolve_select select in let acc_res = @@ -1308,11 +1328,15 @@ end = struct and+ acc_res = acc_res in List.rev_append res acc_res in - (acc_res, resolved_select :: acc_selects, acc_re_exports)) + ( acc_res + , resolved_select :: acc_selects + , acc_re_exports + , acc_renames )) in let res = Result.map ~f:List.rev res in let re_exports = Result.map ~f:List.rev re_exports in - { resolved = res; selects = resolved_selects; re_exports } + let renames = Result.map ~f:List.rev renames in + { resolved = res; selects = resolved_selects; re_exports; renames } type pp_deps = { pps : t list Or_exn.t @@ -1381,6 +1405,7 @@ end = struct ; pps ; selects = resolved.selects ; re_exports = resolved.re_exports + ; renames = resolved.renames } let resolve_deps_and_add_runtime_deps db deps ~private_deps ~pps ~dune_version @@ -1603,8 +1628,11 @@ module Compile = struct ; resolved_selects : Resolved_select.t list ; lib_deps_info : Lib_deps_info.t ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t + ; renames : (lib * Module_name.t) list Or_exn.t } + let renames t = t.renames + let make_lib_deps_info ~user_written_deps ~pps ~kind = Lib_deps_info.merge (Dune_file.Lib_deps.info user_written_deps ~kind) @@ -1656,6 +1684,7 @@ module Compile = struct ; pps = t.pps ; lib_deps_info ; sub_systems = t.sub_systems + ; renames = t.renames } let direct_requires t = t.direct_requires @@ -1792,6 +1821,7 @@ module DB = struct ; pps ; selects = resolved_selects ; re_exports = _ + ; renames } = Resolve.resolve_deps_and_add_runtime_deps t deps ~pps ~private_deps:Allow_all ~stack:Dep_stack.empty @@ -1825,6 +1855,7 @@ module DB = struct ; resolved_selects ; lib_deps_info ; sub_systems = Sub_system_name.Map.empty + ; renames } (* Here we omit the [only_ppx_deps_allowed] check because by the time we reach diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 846e5bd51c5..42a45f96efb 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -115,6 +115,8 @@ type sub_system = .. module Compile : sig type t + type lib + (** Return the list of dependencies needed for linking this library/exe *) val requires_link : t -> L.t Or_exn.t Lazy.t @@ -138,7 +140,10 @@ module Compile : sig (** Sub-systems used in this compilation context *) val sub_systems : t -> sub_system list + + val renames : t -> (lib * Module_name.t) list Or_exn.t end +with type lib := t (** {1 Library name resolution} *) diff --git a/src/dune_rules/lib_dep.ml b/src/dune_rules/lib_dep.ml index 680819110ce..e45923ec325 100644 --- a/src/dune_rules/lib_dep.ml +++ b/src/dune_rules/lib_dep.ml @@ -1,6 +1,21 @@ open! Dune_engine open Stdune +module Rename = struct + type t = (Loc.t * Lib_name.t) * Module_name.t + + let decode : t Dune_lang.Decoder.t = + let open Dune_lang.Decoder in + let+ lib = Lib_name.decode_loc + and+ () = keyword "->" + and+ module_name = Module_name.decode in + (lib, module_name) + + let to_dyn ((_, name), m) = + let open Dyn.Encoder in + pair Lib_name.to_dyn Module_name.to_dyn (name, m) +end + module Select = struct module Choice = struct type t = @@ -99,6 +114,7 @@ type t = | Direct of (Loc.t * Lib_name.t) | Re_export of (Loc.t * Lib_name.t) | Select of Select.t + | Rename of Rename.t let to_dyn = let open Dyn.Encoder in @@ -106,21 +122,12 @@ let to_dyn = | Direct (_, name) -> Lib_name.to_dyn name | Re_export (_, name) -> constr "re_export" [ Lib_name.to_dyn name ] | Select s -> constr "select" [ Select.to_dyn s ] + | Rename s -> constr "rename" [ Rename.to_dyn s ] let direct x = Direct x let re_export x = Re_export x -let to_lib_names = function - | Direct (_, s) - | Re_export (_, s) -> - [ s ] - | Select s -> - List.fold_left s.choices ~init:Lib_name.Set.empty - ~f:(fun acc (x : Select.Choice.t) -> - Lib_name.Set.union acc (Lib_name.Set.union x.required x.forbidden)) - |> Lib_name.Set.to_list - let decode ~allow_re_export = let open Dune_lang.Decoder in let+ loc, t = @@ -133,6 +140,10 @@ let decode ~allow_re_export = ; ( "select" , let+ select = Select.decode in Select select ) + ; ( "rename" + , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 8) + and+ rename = Rename.decode in + Rename rename ) ] <|> let+ loc, name = located Lib_name.decode in Direct (loc, name) ) @@ -150,6 +161,9 @@ let encode = | Select select -> Code_error.raise "Lib_dep.encode: cannot encode select" [ ("select", Select.to_dyn select) ] + | Rename rename -> + Code_error.raise "Lib_dep.encode: cannot encode rename" + [ ("rename", Rename.to_dyn rename) ] module L = struct let field_encode t ~name = diff --git a/src/dune_rules/lib_dep.mli b/src/dune_rules/lib_dep.mli index fdab24bf550..1695bb54f83 100644 --- a/src/dune_rules/lib_dep.mli +++ b/src/dune_rules/lib_dep.mli @@ -19,10 +19,15 @@ module Select : sig val to_dyn : t -> Dyn.t end +module Rename : sig + type t = (Loc.t * Lib_name.t) * Module_name.t +end + type t = | Direct of (Loc.t * Lib_name.t) | Re_export of (Loc.t * Lib_name.t) | Select of Select.t + | Rename of Rename.t val to_dyn : t -> Dyn.t @@ -30,12 +35,8 @@ val direct : Loc.t * Lib_name.t -> t val re_export : Loc.t * Lib_name.t -> t -val to_lib_names : t -> Lib_name.t list - val decode : allow_re_export:bool -> t Dune_lang.Decoder.t -val encode : t Dune_lang.Encoder.t - module L : sig val field_encode : t list -> name:string -> Dune_lang.Encoder.field end diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index f41b5053809..30a4b9a1db7 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -372,10 +372,11 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope Dune_file.Mode_conf.Set.eval_detailed lib.modes ~has_native in let package = Dune_file.Library.package lib in + let renames = Lib.Compile.renames compile_info in Compilation_context.create () ~super_context:sctx ~expander ~scope ~obj_dir ~modules ~flags ~requires_compile ~requires_link ~preprocessing:pp ~opaque:Inherit_from_settings ~js_of_ocaml:(Some lib.buildable.js_of_ocaml) - ~dynlink ?stdlib:lib.stdlib ~package ?vimpl ~modes + ~dynlink ?stdlib:lib.stdlib ~package ?vimpl ~modes ~renames let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents ~compile_info = diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index eaa55cdc743..1f424753852 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -208,7 +208,7 @@ let virtual_modules lookup_vlib vlib = } let make_lib_modules (d : _ Dir_with_dune.t) ~lookup_vlib ~(lib : Library.t) - ~modules = + ~modules ~force_alias_module = let src_dir = d.ctx_dir in let kind, main_module_name, wrapped = match lib.implements with @@ -264,6 +264,15 @@ let make_lib_modules (d : _ Dir_with_dune.t) ~lookup_vlib ~(lib : Library.t) in (kind, main_module_name, wrapped) in + let () = + match wrapped with + | Simple false -> + Buildable.first_rename_dep lib.buildable + |> Option.iter ~f:Lib_deps.rename_unwrapped_error + | Simple true + | Yes_with_transition _ -> + () + in let modules = Modules_field_evaluator.eval ~modules ~buildable:lib.buildable ~kind ~private_modules: @@ -273,13 +282,18 @@ let make_lib_modules (d : _ Dir_with_dune.t) ~lookup_vlib ~(lib : Library.t) let implements = Option.is_some lib.implements in let _loc, lib_name = lib.name in Modules_group.lib ~stdlib ~implements ~lib_name ~src_dir ~modules - ~main_module_name ~wrapped + ~main_module_name ~wrapped ~force_alias_module let libs_and_exes (d : _ Dir_with_dune.t) ~lookup_vlib ~modules = List.filter_partition_map d.data ~f:(fun stanza -> match (stanza : Stanza.t) with | Library lib -> - let modules = make_lib_modules d ~lookup_vlib ~modules ~lib in + let force_alias_module = + Buildable.first_rename_dep lib.buildable |> Option.is_some + in + let modules = + make_lib_modules d ~lookup_vlib ~modules ~lib ~force_alias_module + in Left (lib, modules) | Executables exes | Tests { exes; _ } -> @@ -291,7 +305,10 @@ let libs_and_exes (d : _ Dir_with_dune.t) ~lookup_vlib ~modules = let modules = let project = Scope.project d.scope in if Dune_project.wrapped_executables project then - Modules_group.exe_wrapped ~src_dir:d.ctx_dir ~modules + let force_alias = + Buildable.first_rename_dep exes.buildable |> Option.is_some + in + Modules_group.exe_wrapped ~src_dir:d.ctx_dir ~modules ~force_alias else Modules_group.exe_unwrapped modules in diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index d10fa4a9d64..0fc3fac3051 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -283,31 +283,74 @@ let ocamlc_i ?(flags = []) ~deps cctx (m : Module.t) ~output = `-open` option of the compiler. This module is called the alias module and is implicitly generated by Dune.*) -let build_alias_module ~loc ~alias_module ~cctx = - let sctx = Compilation_context.super_context cctx in - let file = Option.value_exn (Module.file alias_module ~ml_kind:Impl) in - let modules = Compilation_context.modules cctx in - let alias_file () = - let main_module_name = - Modules.main_module_name modules |> Option.value_exn - in - Modules.for_alias modules |> Module_name.Map.values +let alias_source modules ~renames = + let alias new_name old_name = + sprintf "module %s = %s" + (Module_name.to_string new_name) + (Module_name.to_string old_name) + in + let main_module_name = Modules.main_module_name modules |> Option.value_exn in + let aliased_modules = Modules.for_alias modules in + let internal = + Module_name.Map.values aliased_modules |> List.map ~f:(fun (m : Module.t) -> - let name = Module_name.to_string (Module.name m) in + let name = Module.name m in let obj_name_as_module = - Module.obj_name m - |> Module_name.Unique.to_name ~loc - |> Module_name.to_string + Module.obj_name m |> Module_name.Unique.to_name ~loc:Loc.none in - sprintf "(** @canonical %s.%s *)\nmodule %s = %s\n" + sprintf "(** @canonical %s.%s *)\n%s\n" (Module_name.to_string main_module_name) - name name obj_name_as_module) - |> String.concat ~sep:"\n" + (Module_name.to_string name) + (alias name obj_name_as_module)) + in + let open Result.O in + let+ renames, shadows = + let+ renames = renames in + let aliases, shadows = + List.sort renames ~compare:(fun (x : Compilation_context.rename) y -> + Module_name.compare x.new_name y.new_name) + |> List.fold_left ~init:([], []) + ~f:(fun (aliases, shadows) { Compilation_context.new_name; old_name } + -> + if Module_name.Map.mem aliased_modules new_name then + (aliases, shadows) + else + let alias = alias new_name old_name in + let shadows = old_name :: shadows in + (alias :: aliases, shadows)) + in + let shadows = + List.sort_uniq shadows ~compare:Module_name.compare + |> List.filter_map ~f:(fun m -> + if Module_name.Map.mem aliased_modules m then + None + else + Some + (sprintf + (* TODO perhaps we should include which library is + shadowing? *) + "module %s = struct let this_module_is_shadowed = () end" + (Module_name.to_string m))) + in + (List.rev aliases, shadows) + in + [ renames; shadows; internal ] |> List.concat |> String.concat ~sep:"\n\n" + +let build_alias_module ~alias_module ~cctx = + let sctx = Compilation_context.super_context cctx in + let file = Option.value_exn (Module.file alias_module ~ml_kind:Impl) in + let modules = Compilation_context.modules cctx in + (* TODO should be lazy, but we can't compose that with Build.of_result *) + let alias_file = + let renames = Compilation_context.renames cctx in + alias_source modules ~renames in let dir = Compilation_context.dir cctx in - Super_context.add_rule ~loc sctx ~dir - ( Build.delayed alias_file - |> Build.write_file_dyn (Path.as_in_build_dir_exn file) ); + (* TODO obtain loc from buildable used to construct cctx *) + Super_context.add_rule ~loc:Loc.none sctx ~dir + (let target = Path.as_in_build_dir_exn file in + Build.With_targets.of_result_map alias_file ~targets:[ target ] + ~f:(Build.write_file target)); let cctx = Compilation_context.for_alias_module cctx in build_module cctx alias_module ~dep_graphs:(Dep_graph.Ml_kind.dummy alias_module) @@ -319,7 +362,7 @@ let build_all cctx ~dep_graphs = match Module.kind m with | Alias -> let cctx = Compilation_context.for_alias_module cctx in - build_alias_module ~loc:Loc.none ~alias_module:m ~cctx + build_alias_module ~alias_module:m ~cctx | Wrapped_compat -> let cctx = Lazy.force for_wrapped_compat in build_module cctx ~dep_graphs m diff --git a/src/dune_rules/modules.ml b/src/dune_rules/modules.ml index 3f4b523b57d..c812bc0d947 100644 --- a/src/dune_rules/modules.ml +++ b/src/dune_rules/modules.ml @@ -480,7 +480,7 @@ let rec main_module_name = function | Impl { vlib; impl = _ } -> main_module_name vlib let lib ~src_dir ~main_module_name ~wrapped ~stdlib ~lib_name ~implements - ~modules = + ~modules ~force_alias_module = let make_wrapped main_module_name = Wrapped (Wrapped.make ~src_dir ~lib_name ~implements ~modules ~main_module_name @@ -491,17 +491,24 @@ let lib ~src_dir ~main_module_name ~wrapped ~stdlib ~lib_name ~implements let main_module_name = Option.value_exn main_module_name in Stdlib (Stdlib.make ~stdlib ~modules ~main_module_name) | None -> ( - match (wrapped, main_module_name, as_singleton modules) with - | Simple false, _, Some m -> Singleton m - | Simple false, _, None -> Unwrapped modules - | (Yes_with_transition _ | Simple true), Some main_module_name, Some m -> - if Module.name m = main_module_name && not implements then + match + (wrapped, main_module_name, as_singleton modules, force_alias_module) + with + | Simple false, _, _, true -> + Code_error.raise "Modules.lib: unwrapped and force_alias" [] + | Simple false, _, Some m, false -> Singleton m + | Simple false, _, None, false -> Unwrapped modules + | (Yes_with_transition _ | Simple true), Some main_module_name, Some m, _ -> + if + Module.name m = main_module_name + && (not implements) && not force_alias_module + then Singleton m else make_wrapped main_module_name - | (Yes_with_transition _ | Simple true), Some main_module_name, None -> + | (Yes_with_transition _ | Simple true), Some main_module_name, None, _ -> make_wrapped main_module_name - | (Simple true | Yes_with_transition _), None, _ -> + | (Simple true | Yes_with_transition _), None, _, _ -> Code_error.raise "Modules.lib: cannot wrap without main module name" [] ) let impl impl ~vlib = @@ -561,10 +568,12 @@ let singleton_exe m = let exe_unwrapped m = Unwrapped m -let exe_wrapped ~src_dir ~modules = +let exe_wrapped ~src_dir ~modules ~force_alias = match as_singleton modules with - | None -> Wrapped (Wrapped.exe ~src_dir ~modules) - | Some m -> singleton_exe m + | Some m when not force_alias -> singleton_exe m + | Some _ + | None -> + Wrapped (Wrapped.exe ~src_dir ~modules) let rec impl_only = function | Stdlib w -> Stdlib.impl_only w diff --git a/src/dune_rules/modules.mli b/src/dune_rules/modules.mli index 547633683bf..df8a483b761 100644 --- a/src/dune_rules/modules.mli +++ b/src/dune_rules/modules.mli @@ -15,6 +15,9 @@ val lib : -> lib_name:Lib_name.Local.t -> implements:bool -> modules:Module.Name_map.t + -> force_alias_module:bool + (** Force the creation of an alias module. Required if we're renaming any + dependencies *) -> t val encode : t -> Dune_lang.t @@ -43,7 +46,8 @@ val iter_no_vlib : t -> f:(Module.t -> unit) -> unit val exe_unwrapped : Module.Name_map.t -> t -val exe_wrapped : src_dir:Path.Build.t -> modules:Module.Name_map.t -> t +val exe_wrapped : + src_dir:Path.Build.t -> modules:Module.Name_map.t -> force_alias:bool -> t (** For wrapped libraries, this is the user written entry module for the library. For single module libraries, it's the sole module in the library *) diff --git a/test/blackbox-tests/test-cases/rename-deps.t b/test/blackbox-tests/test-cases/rename-deps.t new file mode 100644 index 00000000000..cbf91c803df --- /dev/null +++ b/test/blackbox-tests/test-cases/rename-deps.t @@ -0,0 +1,231 @@ +A library can be shadowed by an internal module name: + + $ cat >dune-project < (lang dune 2.8) + > EOF + + $ mkdir lib0 lib1 lib2 + + $ cat >lib0/dune < (library + > (name lib0)) + > EOF + $ cat >lib0/lib0.ml < let greeting_from_lib0 = "Hello World" + > EOF + + $ cat >lib1/dune < (library + > (name lib1)) + > EOF + $ cat >lib1/lib1.ml < let greeting = "Hello World" + > EOF + + $ cat >lib2/dune < (library + > (libraries lib1) + > (name lib2)) + > EOF + +Now we shadow lib1: + $ touch lib2/lib1.ml + $ cat >lib2/lib2.ml < print_endline Lib1.greeting + > EOF + + $ dune build @all + File "lib2/lib2.ml", line 1, characters 14-27: + 1 | print_endline Lib1.greeting + ^^^^^^^^^^^^^ + Error: Unbound value Lib1.greeting + [1] + +"identity" renaming does not change the name precedence: + + $ cat >lib2/dune < (library + > (libraries (rename lib1 -> lib1)) + > (name lib2)) + > EOF + $ cat >lib2/lib2.ml < print_endline Lib1.greeting + > EOF + $ dune build @all + File "lib2/lib2.ml", line 1, characters 14-27: + 1 | print_endline Lib1.greeting + ^^^^^^^^^^^^^ + Error: Unbound value Lib1.greeting + [1] + +We can use the rename dependency type to use lib1 with a different name: + + $ cat >lib2/dune < (library + > (libraries (rename lib1 -> lib1_unshadow)) + > (name lib2)) + > EOF + $ cat >lib2/lib2.ml < print_endline Lib1_unshadow.greeting + > EOF + $ dune build @all + +The same for executables: + + $ mkdir exe + $ cat >exe/dune < (executable + > (name foo) + > (libraries (rename lib1 -> lib1_unshadow))) + > EOF + $ touch exe/lib1.ml + $ cat >exe/foo.ml < print_endline Lib1_unshadow.greeting + > EOF + $ dune exec ./exe/foo.exe + Hello World + +This works for single module executables: + + $ rm exe/lib1.ml + $ dune exec ./exe/foo.exe + Hello World + +And for single module libs: + $ rm lib2/lib1.ml + $ dune build @lib2/all + +This mode is disabled for unwrapped libraries + + $ mkdir unwrapped + $ cat >unwrapped/dune < (library + > (libraries (rename lib1 -> lib1_unshadow)) + > (wrapped false) + > (name unwrapped_lib)) + > EOF + $ dune build @unwrapped/all + File "unwrapped/dune", line 2, characters 20-24: + 2 | (libraries (rename lib1 -> lib1_unshadow)) + ^^^^ + Error: rename may not be used in unwrapped libraries + [1] + + $ rm -r unwrapped + +The renamed library can not be used by its original name: + + $ cat >lib2/lib2.ml < module Lib1_empty = struct include Lib1 end;; + > print_endline Lib1.greeting + > EOF + + $ dune build @lib2/all + File "lib2/lib2.ml", line 2, characters 14-27: + 2 | print_endline Lib1.greeting + ^^^^^^^^^^^^^ + Error: Unbound value Lib1.greeting + [1] + +# CR-someday aalekseyev: I would rather [Lib1_empty] definition +# above was rejected. +# +# In jenga we achieve this by defining the lib alias like this: +# +# module Lib = Module_that_does_not_exist +# +# which has its own downsides, but we thought it was a bit better than +# an empty module. I think we also considered making it a functor +# that can't be applied, something like: +# +# module type Abstract +# module Lib1(M : Abstract) = struct end +# +# but that can be pretty confusing too. + +Implementation detail: the generated renaming module. + + $ cat _build/default/lib2/lib2__.ml-gen + module Lib1_unshadow = Lib1 + + module Lib1 = struct let this_module_is_shadowed = () end + +Multiple renamings to the same name: + + $ cat >lib2/dune < (library + > (libraries + > (rename lib0 -> lib) + > (rename lib1 -> lib) + > ) + > (name lib2)) + > EOF + + $ dune build @lib2/all + File "lib2/lib2__.ml-gen", line 3, characters 0-17: + 3 | module Lib = Lib1 + ^^^^^^^^^^^^^^^^^ + Error: Multiple definition of the module name Lib. + Names must be unique in a given structure or signature. + [1] + +# CR aalekseyev: the error above should probably be caught earlier + +Complicated library renamings where the act of renaming shadows another library: + + $ cat >lib2/dune < (library + > (libraries + > (rename lib0 -> lib1) + > (rename lib1 -> lib0) + > ) + > (name lib2)) + > EOF + + $ cat >lib2/lib2.ml < let greeting_from_lib1 = Lib0.greeting + > let greeting_from_lib0 = Lib1.greeting_from_lib0 + > EOF + + $ cat >lib2/m.ml < let x = 8 + > EOF + + $ dune build @lib2/all + File "lib2/lib2__.ml-gen", line 5, characters 0-57: + 5 | module Lib0 = struct let this_module_is_shadowed = () end + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: Multiple definition of the module name Lib0. + Names must be unique in a given structure or signature. + [1] + +# CR aalekseyev: the above should probably work? +# Or at least if it fails it should fail with a better error. +# +# Probably the way to make it work is to generate something like this: +# +# module Root____ = struct +# module Lib0 = Lib0 +# module Lib1 = Lib1 +# end +# module Lib0 = Root____.Lib1 +# module Lib1 = Root____.Lib0 +# +# (at this point, one has to wonder if Root____ is, perhaps, all we needed, after all) + +Implementation detail, the generated renaming module: + + $ cat _build/default/lib2/lib2__.ml-gen + module Lib0 = Lib1 + + module Lib1 = Lib0 + + module Lib0 = struct let this_module_is_shadowed = () end + + module Lib1 = struct let this_module_is_shadowed = () end + + (** @canonical Lib2.M *) + module M = Lib2__M + +# CR aalekseyev: should we also add a @canonical doc comment to the library renamings? +# I don't know what uses it, but if it's needed on M it's probably needed on Lib1 too. From 8114d126d20981918f55a9fec3e48d623f44a0cd Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 30 Oct 2020 11:36:14 -0700 Subject: [PATCH 2/4] Replace renaming with (root_module ..) This feature is both simpler and more widely useful Signed-off-by: Rudi Grinberg --- CHANGES.md | 4 + doc/concepts.rst | 23 -- doc/dune-files.rst | 9 + src/dune_rules/compilation_context.ml | 55 ++--- src/dune_rules/compilation_context.mli | 14 +- src/dune_rules/dir_contents.ml | 9 +- src/dune_rules/dune_file.ml | 44 +--- src/dune_rules/dune_file.mli | 5 +- src/dune_rules/dune_package.ml | 18 +- src/dune_rules/exe_rules.ml | 2 - src/dune_rules/findlib/findlib.ml | 30 ++- src/dune_rules/lib.ml | 55 ++--- src/dune_rules/lib.mli | 7 +- src/dune_rules/lib_dep.ml | 24 -- src/dune_rules/lib_dep.mli | 5 - src/dune_rules/lib_info.ml | 13 +- src/dune_rules/lib_info.mli | 3 + src/dune_rules/lib_rules.ml | 3 +- src/dune_rules/ml_sources.ml | 24 +- src/dune_rules/module.ml | 10 + src/dune_rules/module.mli | 3 + src/dune_rules/module_compilation.ml | 113 +++++---- src/dune_rules/modules.ml | 25 +- src/dune_rules/modules.mli | 3 +- src/dune_rules/modules_field_evaluator.ml | 8 +- src/dune_rules/modules_field_evaluator.mli | 1 + src/stdune/result.ml | 7 + src/stdune/result.mli | 3 + test/blackbox-tests/test-cases/rename-deps.t | 231 ------------------- test/blackbox-tests/test-cases/root-module.t | 76 ++++++ 30 files changed, 317 insertions(+), 510 deletions(-) delete mode 100644 test/blackbox-tests/test-cases/rename-deps.t create mode 100644 test/blackbox-tests/test-cases/root-module.t diff --git a/CHANGES.md b/CHANGES.md index a2b687c1861..688a924aab9 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -78,6 +78,10 @@ Unreleased - Avoid pager when running `$ git diff` (#3912, @AltGr) +- Add `(root_module ..)` field to libraries & executables. This makes it + possible to use library dependencies shadowed by local modules (#3825, + @rgrinberg) + 2.7.1 (2/09/2020) ----------------- diff --git a/doc/concepts.rst b/doc/concepts.rst index 08dc7d8c246..70745182a92 100644 --- a/doc/concepts.rst +++ b/doc/concepts.rst @@ -373,29 +373,6 @@ not. When they are allowed, which is the default, all transitive dependencies are visible whether they are marked as re-exported or not. -Renamed dependencies --------------------- - -A library dependency might be shadowed by an internal module with the same name -as the library. To workaround this limitation, we may introduce a new toplevel -name for ``foo`` using the ``rename`` construct: - -.. code:: scheme - - (rename -> ) - -Note that ```` will no longer be usable under its original name. - -For example: - -.. code:: scheme - - (library - (name bar) - (libraries (rename re -> re_unshadow))) - -This will make the ``re`` available under the ``Re_unshadow`` toplevel name. - .. _preprocessing-spec: Preprocessing specification diff --git a/doc/dune-files.rst b/doc/dune-files.rst index bab0333c09c..8717dcdedb5 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -505,6 +505,11 @@ to use the :ref:`include_subdirs` stanza. configured through options using ``(inline_tests )``. See :ref:`inline_tests` for a reference of corresponding options. +- ``(root_module )`` this field instructs dune to generate a module that + will contain module aliases for every library specified in dependencies. This + is useful whenever a library is shadowed by a local module. The library may + then still be accessible via this root module + Note that when binding C libraries, dune doesn't provide special support for tools such as ``pkg-config``, however it integrates easily with :ref:`configurator` by @@ -644,6 +649,10 @@ Executables can also be linked as object or shared object files. See the current stanza. It is interpreted in the same way as the ``(modules ...)`` field of `library`_ +- ``(root_module )`` specifies a ``root_module`` that collects all + dependencies specified in ``libraries``. See the documentation for + ``root_module`` in the library stanza. + - ``(modes ())`` sets the `linking modes`_. The default is ``(exe)``. Before 2.0, it used to be ``(byte exe)``. diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index 23291cad87c..161d10eb5ab 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -3,6 +3,8 @@ open! Stdune open Import module SC = Super_context +let modules_of_lib = Fdecl.create Dyn.Encoder.opaque + module Includes = struct type t = Command.Args.dynamic Command.Args.t Cm_kind.Dict.t @@ -70,7 +72,6 @@ type t = ; vimpl : Vimpl.t option ; modes : Mode.Dict.Set.t ; bin_annot : bool - ; renames : (Lib.t * Module_name.t) list Or_exn.t } let super_context t = t.super_context @@ -115,37 +116,10 @@ let bin_annot t = t.bin_annot let context t = Super_context.context t.super_context -type rename = - { new_name : Module_name.t - ; old_name : Module_name.t - } - -let renames t = - let open Result.O in - let* renames = t.renames in - Result.List.map renames ~f:(fun (lib, new_name) -> - let* main_module_name = Lib.main_module_name lib in - let+ old_name = - match main_module_name with - | Some m -> Ok m - | None -> - Error - (User_error.E - (User_error.make - [ Pp.text "renaming unwrapped not supported yet" ])) - in - { new_name; old_name }) - let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags -<<<<<<< HEAD ~requires_compile ~requires_link ?(preprocessing = Pp_spec.dummy) ~opaque ?stdlib ~js_of_ocaml ~dynlink ~package ?vimpl ?modes ?(bin_annot = true) () = -======= - ~requires_compile ~requires_link ?(preprocessing = Preprocessing.dummy) - ~opaque ?stdlib ~js_of_ocaml ~dynlink ~package ?vimpl ?modes - ?(bin_annot = true) ?(renames = Ok []) () = ->>>>>>> 254959a66 (Rename dependencies) let project = Scope.project scope in let requires_compile = if Dune_project.implicit_transitive_deps project then @@ -186,15 +160,14 @@ let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags ; vimpl ; modes ; bin_annot - ; renames } let for_alias_module t = let flags = let project = Scope.project t.scope in let dune_version = Dune_project.dune_version project in - Ocaml_flags.default ~profile:(Super_context.context t.super_context).profile - ~dune_version + let profile = (Super_context.context t.super_context).profile in + Ocaml_flags.default ~dune_version ~profile in let sandbox = let ctx = Super_context.context t.super_context in @@ -215,6 +188,20 @@ let for_alias_module t = ; sandbox } +let for_root_module t = + let flags = + let project = Scope.project t.scope in + let dune_version = Dune_project.dune_version project in + let profile = (Super_context.context t.super_context).profile in + Ocaml_flags.default ~profile ~dune_version + in + { t with + flags = + Ocaml_flags.append_common flags + [ "-w"; "-49"; "-nopervasives"; "-nostdlib" ] + ; stdlib = None + } + let for_module_generated_at_link_time cctx ~requires ~module_ = let opaque = (* Cmi's of link time generated modules are compiled with -opaque, hence @@ -243,3 +230,9 @@ let for_plugin_executable t ~embed_in_plugin_libraries = { t with requires_link } let without_bin_annot t = { t with bin_annot = false } + +let root_module_entries t : Module_name.t list Or_exn.t = + let open Result.O in + let* requires = t.requires_compile in + let local_lib = Fdecl.get modules_of_lib t.super_context in + Result.List.concat_map requires ~f:(Lib.entry_module_names ~local_lib) diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index 8ca7eb1a2bf..6128d6ce03b 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -21,6 +21,10 @@ type opaque = | Inherit_from_settings (** Determined from the version of OCaml and the profile *) +val modules_of_lib : + (* to avoid a cycle with [Dir_contents] *) + (Super_context.t -> dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t + (** Create a compilation context. *) val create : super_context:Super_context.t @@ -40,7 +44,6 @@ val create : -> ?vimpl:Vimpl.t -> ?modes:Dune_file.Mode_conf.Set.Details.t Mode.Dict.t -> ?bin_annot:bool - -> ?renames:(Lib.t * Module_name.t) list Or_exn.t -> unit -> t @@ -91,6 +94,8 @@ val modes : t -> Mode.Dict.Set.t val for_wrapped_compat : t -> t +val for_root_module : t -> t + val for_module_generated_at_link_time : t -> requires:Lib.t list Or_exn.t -> module_:Module.t -> t @@ -101,9 +106,4 @@ val bin_annot : t -> bool val without_bin_annot : t -> t -type rename = - { new_name : Module_name.t - ; old_name : Module_name.t - } - -val renames : t -> rename list Or_exn.t +val root_module_entries : t -> Module_name.t list Or_exn.t diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index a6110aee5a7..ad44fc2748e 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -155,7 +155,6 @@ end = struct (* Manually add files generated by the (select ...) dependencies *) List.filter_map buildable.libraries ~f:(fun dep -> match (dep : Lib_dep.t) with - | Rename _ | Re_export _ | Direct _ -> None @@ -337,6 +336,14 @@ end = struct | See_above _ -> assert false | Here { t; rules = _; subdirs = _ } -> t ) + let () = + let f sctx ~dir ~name = + let t = get sctx ~dir in + let ml_sources = ocaml t in + Ml_sources.modules_of_library ml_sources ~name + in + Fdecl.set Compilation_context.modules_of_lib f + let gen_rules sctx ~dir = match Memo.exec memo0 (sctx, dir) with | See_above group_root -> Group_part group_root diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index f6ac6ac0e3d..b81fa873463 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -57,13 +57,8 @@ module Lib_deps = struct | Optional | Forbidden - let rename_unwrapped_error loc = - User_error.raise ~loc - [ Pp.text "rename may not be used in unwrapped libraries" ] - let decode for_ = let+ loc = loc - and+ project = Dune_project.get_exn () and+ t = let allow_re_export = match for_ with @@ -98,28 +93,9 @@ module Lib_deps = struct (Lib_name.to_string name) ] ) in - let check_rename = - match for_ with - | Library (Some (Simple false)) -> rename_unwrapped_error - | Library _ -> fun _loc -> () - | Executable -> - if Dune_project.wrapped_executables project then - fun _loc -> - () - else - fun loc -> - User_error.raise ~loc - [ Pp.text - "rename may not be used in executables without \ - wrapped_executables switched on in the dune-project file" - ] - in ignore ( List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x -> match x with - | Lib_dep.Rename ((loc, name), _) -> - check_rename loc; - add Required name acc | Lib_dep.Re_export (_, s) | Lib_dep.Direct (_, s) -> add Required s acc @@ -137,8 +113,7 @@ module Lib_deps = struct let info t ~kind = List.concat_map t ~f:(function - | Lib_dep.Rename ((_, s), _) - | Re_export (_, s) + | Lib_dep.Re_export (_, s) | Direct (_, s) -> [ (s, kind) ] | Select { choices; _ } -> @@ -197,6 +172,7 @@ module Buildable = struct ; flags : Ocaml_flags.Spec.t ; js_of_ocaml : Js_of_ocaml.t ; allow_overlapping_dependencies : bool + ; root_module : (Loc.t * Module_name.t) option } let decode (for_ : for_) = @@ -288,6 +264,9 @@ module Buildable = struct repeat (String_with_vars.decode >>| version_check) in (libname, flags))) )) + and+ root_module = + field_o "root_module" + (Dune_lang.Syntax.since Stanza.syntax (2, 8) >>> Module_name.decode_loc) in let preprocess = let init = @@ -343,15 +322,11 @@ module Buildable = struct ; flags ; js_of_ocaml ; allow_overlapping_dependencies + ; root_module } let has_foreign t = List.is_non_empty t.foreign_stubs || List.is_non_empty t.foreign_archives - - let first_rename_dep (t : t) = - List.find_map t.libraries ~f:(function - | Lib_dep.Rename ((loc, _), _) -> Some loc - | _ -> None) end module Public_lib = struct @@ -941,13 +916,14 @@ module Library = struct let wrapped = Some conf.wrapped in let special_builtin_support = conf.special_builtin_support in let instrumentation_backend = conf.instrumentation_backend in + let entry_modules = Lib_info.Source.Local in Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives ~foreign_dll_files ~jsoo_runtime ~jsoo_archive - ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~implements - ~default_implementation ~modes ~wrapped ~special_builtin_support - ~exit_module ~instrumentation_backend + ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~entry_modules + ~implements ~default_implementation ~modes ~wrapped + ~special_builtin_support ~exit_module ~instrumentation_backend end module Plugin = struct diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli index a9e3bcdfea4..13343a18623 100644 --- a/src/dune_rules/dune_file.mli +++ b/src/dune_rules/dune_file.mli @@ -31,8 +31,6 @@ module Lib_deps : sig val info : t -> kind:Lib_deps_info.Kind.t -> Lib_deps_info.t val decode : for_ -> t Dune_lang.Decoder.t - - val rename_unwrapped_error : Loc.t -> 'a end (** [preprocess] and [preprocessor_deps] fields *) @@ -55,12 +53,11 @@ module Buildable : sig ; flags : Ocaml_flags.Spec.t ; js_of_ocaml : Js_of_ocaml.t ; allow_overlapping_dependencies : bool + ; root_module : (Loc.t * Module_name.t) option } (** Check if the buildable has any foreign stubs or archives. *) val has_foreign : t -> bool - - val first_rename_dep : t -> Loc.t option end module Public_lib : sig diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 2175008045d..7b57df7eb8f 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -141,7 +141,7 @@ module Lib = struct and+ orig_src_dir = field_o "orig_src_dir" path and+ modules = let src_dir = Obj_dir.dir obj_dir in - field_o "modules" + field "modules" (Modules.decode ~implements:(Option.is_some implements) ~src_dir ~version:lang.version) @@ -153,6 +153,9 @@ module Lib = struct field_o "instrumentation.backend" (located Lib_name.decode) in let modes = Mode.Dict.Set.of_list modes in + let entry_modules = + Modules.entry_modules modules |> List.map ~f:Module.name + in let info : Path.t Lib_info.t = let src_dir = Obj_dir.dir obj_dir in let enabled = Lib_info.Enabled_status.Normal in @@ -170,25 +173,24 @@ module Lib = struct let dune_version = None in let virtual_ = if virtual_ then - let modules = Option.value_exn modules in Some (Lib_info.Source.External modules) else None in let wrapped = - Option.map modules ~f:Modules.wrapped - |> Option.map ~f:(fun w -> Lib_info.Inherited.This w) + Some (Lib_info.Inherited.This (Modules.wrapped modules)) in + let entry_modules = Lib_info.Source.External (Ok entry_modules) in Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives ~foreign_dll_files:[] ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled ~virtual_deps - ~dune_version ~virtual_ ~implements ~default_implementation ~modes - ~wrapped ~special_builtin_support ~exit_module:None - ~instrumentation_backend + ~dune_version ~virtual_ ~entry_modules ~implements + ~default_implementation ~modes ~wrapped ~special_builtin_support + ~exit_module:None ~instrumentation_backend in - { info; main_module_name; modules }) + { info; main_module_name; modules = Some modules }) let modules t = t.modules diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index a40c868c2b6..b95e4a5d70d 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -138,11 +138,9 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info | Other { kind = Shared_object; _ } -> true | _ -> false) in - let renames = Lib.Compile.renames compile_info in Compilation_context.create () ~super_context:sctx ~expander ~scope ~obj_dir ~modules ~flags ~requires_link ~requires_compile ~preprocessing:pp ~js_of_ocaml ~opaque:Inherit_from_settings ~dynlink ~package:exes.package - ~renames in let requires_compile = Compilation_context.requires_compile cctx in let preprocess = diff --git a/src/dune_rules/findlib/findlib.ml b/src/dune_rules/findlib/findlib.ml index c4ae3ca6a3d..07da7408294 100644 --- a/src/dune_rules/findlib/findlib.ml +++ b/src/dune_rules/findlib/findlib.ml @@ -330,13 +330,14 @@ end = struct let virtual_ = None in let default_implementation = None in let wrapped = None in + let dir_contents = Path.readdir_unsorted t.dir in let foreign_archives, native_archives = (* Here we scan [t.dir] and consider all files named [lib*.ext_lib] to be foreign archives, and all other files with the extension [ext_lib] to be native archives. The resulting lists of archives will be used to compute appropriate flags for linking dependent executables. *) - match Path.readdir_unsorted t.dir with + match dir_contents with | Error _ -> (* Raising an error is not an option here as we systematically delay all library loading errors until the libraries are actually used @@ -368,6 +369,31 @@ end = struct let sort = List.sort ~compare:Path.compare in (sort foreign_archives, sort native_archives) in + let entry_modules = + Lib_info.Source.External + ( match dir_contents with + | Error e -> + Error + (User_error.E + (User_message.make + [ Pp.textf "Unable to get entry modules of %s in %s. " + (Lib_name.to_string t.name) + (Path.to_string src_dir) + ; Pp.textf "error: %s" (Unix.error_message e) + ])) + | Ok files -> + let ext = Cm_kind.ext Cmi in + Result.List.filter_map files ~f:(fun fname -> + match Filename.check_suffix fname ext with + | false -> Ok None + | true -> ( + match + let name = Filename.chop_extension fname in + Module_name.of_string_user_error (Loc.in_dir src_dir, name) + with + | Ok s -> Ok (Some s) + | Error e -> Error (User_error.E e) )) ) + in Lib_info.create ~loc ~name:t.name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps @@ -375,7 +401,7 @@ end = struct ~jsoo_archive ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~implements ~default_implementation ~modes ~wrapped ~special_builtin_support ~exit_module:None - ~instrumentation_backend:None + ~instrumentation_backend:None ~entry_modules in Dune_package.Lib.make ~info ~modules:None ~main_module_name:None end diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 3145d639f97..5cb6bef3182 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -240,9 +240,8 @@ module T = struct ; unique_id : Id.t ; re_exports : t list Or_exn.t ; (* [requires] is contains all required libraries, including the ones - mentioned in [renames] and in [re_exports]. *) + mentioned in [re_exports]. *) requires : t list Or_exn.t - ; renames : (t * Module_name.t) list Or_exn.t ; ppx_runtime_deps : t list Or_exn.t ; pps : t list Or_exn.t ; resolved_selects : Resolved_select.t list @@ -367,6 +366,14 @@ let main_module_name t = | This x -> x | From _ -> assert false ) +let entry_module_names t ~local_lib = + match Lib_info.entry_modules t.info with + | External d -> d + | Local -> + let info = Lib_info.as_local_exn t.info in + let modules = local_lib ~dir:(Lib_info.src_dir info) ~name:t.name in + Ok (Modules.entry_modules modules |> List.map ~f:Module.name) + let wrapped t = let wrapped = Lib_info.wrapped t.info in match wrapped with @@ -986,7 +993,6 @@ module rec Resolve : sig ; pps : lib list Or_exn.t ; selects : Resolved_select.t list ; re_exports : lib list Or_exn.t - ; renames : (lib * Module_name.t) list Or_exn.t } val resolve_deps_and_add_runtime_deps : @@ -1090,7 +1096,7 @@ end = struct (Package.Name.to_string p') ] ))) in - let { requires; pps; selects = resolved_selects; re_exports; renames } = + let { requires; pps; selects = resolved_selects; re_exports } = let pps = Preprocess.Per_module.pps (Preprocess.Per_module.with_instrumentation (Lib_info.preprocess info) @@ -1146,7 +1152,6 @@ end = struct ; lib_config = db.lib_config ; re_exports ; project - ; renames } in t.sub_systems <- @@ -1247,7 +1252,6 @@ end = struct { resolved : t list Or_exn.t ; selects : Resolved_select.t list ; re_exports : t list Or_exn.t - ; renames : (lib * Module_name.t) list Or_exn.t } type resolved = @@ -1255,7 +1259,6 @@ end = struct ; pps : lib list Or_exn.t ; selects : Resolved_select.t list ; re_exports : lib list Or_exn.t - ; renames : (lib * Module_name.t) list Or_exn.t } let resolve_complex_deps db deps ~private_deps ~stack : resolved_deps = @@ -1284,9 +1287,9 @@ end = struct in (res, { Resolved_select.src_fn; dst_fn = result_fn }) in - let res, resolved_selects, re_exports, renames = - List.fold_left deps ~init:(Ok [], [], Ok [], Ok []) - ~f:(fun (acc_res, acc_selects, acc_re_exports, acc_renames) dep -> + let res, resolved_selects, re_exports = + List.fold_left deps ~init:(Ok [], [], Ok []) + ~f:(fun (acc_res, acc_selects, acc_re_exports) dep -> match (dep : Lib_dep.t) with | Re_export (loc, name) -> let lib = resolve_dep db (loc, name) ~private_deps ~stack in @@ -1300,27 +1303,14 @@ end = struct and+ acc_res = acc_res in lib :: acc_res in - (acc_res, acc_selects, acc_re_exports, acc_renames) - | Rename ((loc, name), to_) -> - let lib = resolve_dep db (loc, name) ~private_deps ~stack in - let acc_res = - let+ lib = lib - and+ acc_res = acc_res in - lib :: acc_res - in - let acc_renames = - let+ lib = lib - and+ acc_renames = acc_renames in - (lib, to_) :: acc_renames - in - (acc_res, acc_selects, acc_re_exports, acc_renames) + (acc_res, acc_selects, acc_re_exports) | Direct (loc, name) -> let acc_res = let+ lib = resolve_dep db (loc, name) ~private_deps ~stack and+ acc_res = acc_res in lib :: acc_res in - (acc_res, acc_selects, acc_re_exports, acc_renames) + (acc_res, acc_selects, acc_re_exports) | Select select -> let res, resolved_select = resolve_select select in let acc_res = @@ -1328,15 +1318,11 @@ end = struct and+ acc_res = acc_res in List.rev_append res acc_res in - ( acc_res - , resolved_select :: acc_selects - , acc_re_exports - , acc_renames )) + (acc_res, resolved_select :: acc_selects, acc_re_exports)) in let res = Result.map ~f:List.rev res in let re_exports = Result.map ~f:List.rev re_exports in - let renames = Result.map ~f:List.rev renames in - { resolved = res; selects = resolved_selects; re_exports; renames } + { resolved = res; selects = resolved_selects; re_exports } type pp_deps = { pps : t list Or_exn.t @@ -1405,7 +1391,6 @@ end = struct ; pps ; selects = resolved.selects ; re_exports = resolved.re_exports - ; renames = resolved.renames } let resolve_deps_and_add_runtime_deps db deps ~private_deps ~pps ~dune_version @@ -1628,11 +1613,8 @@ module Compile = struct ; resolved_selects : Resolved_select.t list ; lib_deps_info : Lib_deps_info.t ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t - ; renames : (lib * Module_name.t) list Or_exn.t } - let renames t = t.renames - let make_lib_deps_info ~user_written_deps ~pps ~kind = Lib_deps_info.merge (Dune_file.Lib_deps.info user_written_deps ~kind) @@ -1684,7 +1666,6 @@ module Compile = struct ; pps = t.pps ; lib_deps_info ; sub_systems = t.sub_systems - ; renames = t.renames } let direct_requires t = t.direct_requires @@ -1821,7 +1802,6 @@ module DB = struct ; pps ; selects = resolved_selects ; re_exports = _ - ; renames } = Resolve.resolve_deps_and_add_runtime_deps t deps ~pps ~private_deps:Allow_all ~stack:Dep_stack.empty @@ -1855,7 +1835,6 @@ module DB = struct ; resolved_selects ; lib_deps_info ; sub_systems = Sub_system_name.Map.empty - ; renames } (* Here we omit the [only_ppx_deps_allowed] check because by the time we reach diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 42a45f96efb..4e1a112f7ac 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -27,6 +27,11 @@ val info : t -> Path.t Lib_info.t val main_module_name : t -> Module_name.t option Or_exn.t +val entry_module_names : + t + -> local_lib:(dir:Path.Build.t -> name:Lib_name.t -> Modules.t) + -> Module_name.t list Or_exn.t + val wrapped : t -> Wrapped.t option Or_exn.t (** [is_impl lib] returns [true] if the library is an implementation of a @@ -140,8 +145,6 @@ module Compile : sig (** Sub-systems used in this compilation context *) val sub_systems : t -> sub_system list - - val renames : t -> (lib * Module_name.t) list Or_exn.t end with type lib := t diff --git a/src/dune_rules/lib_dep.ml b/src/dune_rules/lib_dep.ml index e45923ec325..36b393c38b0 100644 --- a/src/dune_rules/lib_dep.ml +++ b/src/dune_rules/lib_dep.ml @@ -1,21 +1,6 @@ open! Dune_engine open Stdune -module Rename = struct - type t = (Loc.t * Lib_name.t) * Module_name.t - - let decode : t Dune_lang.Decoder.t = - let open Dune_lang.Decoder in - let+ lib = Lib_name.decode_loc - and+ () = keyword "->" - and+ module_name = Module_name.decode in - (lib, module_name) - - let to_dyn ((_, name), m) = - let open Dyn.Encoder in - pair Lib_name.to_dyn Module_name.to_dyn (name, m) -end - module Select = struct module Choice = struct type t = @@ -114,7 +99,6 @@ type t = | Direct of (Loc.t * Lib_name.t) | Re_export of (Loc.t * Lib_name.t) | Select of Select.t - | Rename of Rename.t let to_dyn = let open Dyn.Encoder in @@ -122,7 +106,6 @@ let to_dyn = | Direct (_, name) -> Lib_name.to_dyn name | Re_export (_, name) -> constr "re_export" [ Lib_name.to_dyn name ] | Select s -> constr "select" [ Select.to_dyn s ] - | Rename s -> constr "rename" [ Rename.to_dyn s ] let direct x = Direct x @@ -140,10 +123,6 @@ let decode ~allow_re_export = ; ( "select" , let+ select = Select.decode in Select select ) - ; ( "rename" - , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 8) - and+ rename = Rename.decode in - Rename rename ) ] <|> let+ loc, name = located Lib_name.decode in Direct (loc, name) ) @@ -161,9 +140,6 @@ let encode = | Select select -> Code_error.raise "Lib_dep.encode: cannot encode select" [ ("select", Select.to_dyn select) ] - | Rename rename -> - Code_error.raise "Lib_dep.encode: cannot encode rename" - [ ("rename", Rename.to_dyn rename) ] module L = struct let field_encode t ~name = diff --git a/src/dune_rules/lib_dep.mli b/src/dune_rules/lib_dep.mli index 1695bb54f83..a233786fec0 100644 --- a/src/dune_rules/lib_dep.mli +++ b/src/dune_rules/lib_dep.mli @@ -19,15 +19,10 @@ module Select : sig val to_dyn : t -> Dyn.t end -module Rename : sig - type t = (Loc.t * Lib_name.t) * Module_name.t -end - type t = | Direct of (Loc.t * Lib_name.t) | Re_export of (Loc.t * Lib_name.t) | Select of Select.t - | Rename of Rename.t val to_dyn : t -> Dyn.t diff --git a/src/dune_rules/lib_info.ml b/src/dune_rules/lib_info.ml index a15a0f5965a..a244aaa6a3d 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -274,6 +274,7 @@ type 'path t = ; dune_version : Dune_lang.Syntax.Version.t option ; sub_systems : Sub_system_info.t Sub_system_name.Map.t ; virtual_ : Modules.t Source.t option + ; entry_modules : Module_name.t list Or_exn.t Source.t ; implements : (Loc.t * Lib_name.t) option ; default_implementation : (Loc.t * Lib_name.t) option ; wrapped : Wrapped.t Inherited.t option @@ -389,9 +390,9 @@ let create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives ~foreign_dll_files ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled - ~virtual_deps ~dune_version ~virtual_ ~implements ~default_implementation - ~modes ~wrapped ~special_builtin_support ~exit_module - ~instrumentation_backend = + ~virtual_deps ~dune_version ~virtual_ ~entry_modules ~implements + ~default_implementation ~modes ~wrapped ~special_builtin_support + ~exit_module ~instrumentation_backend = { loc ; name ; kind @@ -418,6 +419,7 @@ let create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ; dune_version ; sub_systems ; virtual_ + ; entry_modules ; implements ; default_implementation ; modes @@ -490,6 +492,7 @@ let to_dyn path ; special_builtin_support ; exit_module ; instrumentation_backend + ; entry_modules } = let open Dyn.Encoder in let snd f (_, x) = f x in @@ -518,6 +521,8 @@ let to_dyn path ; ("dune_version", option Dune_lang.Syntax.Version.to_dyn dune_version) ; ("sub_systems", Sub_system_name.Map.to_dyn Dyn.Encoder.opaque sub_systems) ; ("virtual_", option (Source.to_dyn Modules.to_dyn) virtual_) + ; ( "entry_modules" + , Source.to_dyn (Or_exn.to_dyn (list Module_name.to_dyn)) entry_modules ) ; ("implements", option (snd Lib_name.to_dyn) implements) ; ( "default_implementation" , option (snd Lib_name.to_dyn) default_implementation ) @@ -543,3 +548,5 @@ let has_native_archive lib_config modules = Lib_config.linker_can_create_empty_archives lib_config && Ocaml_version.ocamlopt_always_calls_library_linker lib_config.ocaml_version || not (Modules.is_empty modules) + +let entry_modules t = t.entry_modules diff --git a/src/dune_rules/lib_info.mli b/src/dune_rules/lib_info.mli index 0460dc859f8..defdadb28ed 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -131,6 +131,8 @@ val obj_dir : 'path t -> 'path Obj_dir.t val virtual_ : _ t -> Modules.t Source.t option +val entry_modules : _ t -> Module_name.t list Or_exn.t Source.t + val main_module_name : _ t -> Main_module_name.t val wrapped : _ t -> Wrapped.t Inherited.t option @@ -215,6 +217,7 @@ val create : -> virtual_deps:(Loc.t * Lib_name.t) list -> dune_version:Dune_lang.Syntax.Version.t option -> virtual_:Modules.t Source.t option + -> entry_modules:Module_name.t list Or_exn.t Source.t -> implements:(Loc.t * Lib_name.t) option -> default_implementation:(Loc.t * Lib_name.t) option -> modes:Mode.Dict.Set.t diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 30a4b9a1db7..f41b5053809 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -372,11 +372,10 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope Dune_file.Mode_conf.Set.eval_detailed lib.modes ~has_native in let package = Dune_file.Library.package lib in - let renames = Lib.Compile.renames compile_info in Compilation_context.create () ~super_context:sctx ~expander ~scope ~obj_dir ~modules ~flags ~requires_compile ~requires_link ~preprocessing:pp ~opaque:Inherit_from_settings ~js_of_ocaml:(Some lib.buildable.js_of_ocaml) - ~dynlink ?stdlib:lib.stdlib ~package ?vimpl ~modes ~renames + ~dynlink ?stdlib:lib.stdlib ~package ?vimpl ~modes let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents ~compile_info = diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 1f424753852..4ca0c5b4a71 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -264,19 +264,11 @@ let make_lib_modules (d : _ Dir_with_dune.t) ~lookup_vlib ~(lib : Library.t) in (kind, main_module_name, wrapped) in - let () = - match wrapped with - | Simple false -> - Buildable.first_rename_dep lib.buildable - |> Option.iter ~f:Lib_deps.rename_unwrapped_error - | Simple true - | Yes_with_transition _ -> - () - in let modules = Modules_field_evaluator.eval ~modules ~buildable:lib.buildable ~kind ~private_modules: (Option.value ~default:Ordered_set_lang.standard lib.private_modules) + ~src_dir in let stdlib = lib.stdlib in let implements = Option.is_some lib.implements in @@ -288,27 +280,23 @@ let libs_and_exes (d : _ Dir_with_dune.t) ~lookup_vlib ~modules = List.filter_partition_map d.data ~f:(fun stanza -> match (stanza : Stanza.t) with | Library lib -> - let force_alias_module = - Buildable.first_rename_dep lib.buildable |> Option.is_some - in let modules = - make_lib_modules d ~lookup_vlib ~modules ~lib ~force_alias_module + make_lib_modules d ~lookup_vlib ~modules ~lib + ~force_alias_module:false in Left (lib, modules) | Executables exes | Tests { exes; _ } -> + let src_dir = d.ctx_dir in let modules = Modules_field_evaluator.eval ~modules ~buildable:exes.buildable ~kind:Modules_field_evaluator.Exe_or_normal_lib - ~private_modules:Ordered_set_lang.standard + ~private_modules:Ordered_set_lang.standard ~src_dir in let modules = let project = Scope.project d.scope in if Dune_project.wrapped_executables project then - let force_alias = - Buildable.first_rename_dep exes.buildable |> Option.is_some - in - Modules_group.exe_wrapped ~src_dir:d.ctx_dir ~modules ~force_alias + Modules_group.exe_wrapped ~src_dir ~modules else Modules_group.exe_unwrapped modules in diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index 1815f0962bf..15c02ed3078 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -29,6 +29,7 @@ module Kind = struct | Alias | Impl_vmodule | Wrapped_compat + | Root let to_string = function | Intf_only -> "intf_only" @@ -37,6 +38,7 @@ module Kind = struct | Alias -> "alias" | Impl_vmodule -> "impl_vmodule" | Wrapped_compat -> "wrapped_compat" + | Root -> "root" let to_dyn t = Dyn.Encoder.string (to_string t) @@ -51,12 +53,14 @@ module Kind = struct ; ("alias", Alias) ; ("impl_vmodule", Impl_vmodule) ; ("wrapped_compat", Wrapped_compat) + ; ("root", Root) ] let has_impl = function | Alias | Impl_vmodule | Wrapped_compat + | Root | Impl -> true | Intf_only @@ -248,6 +252,7 @@ let encode match kind with | Kind.Impl when has_impl -> None | Intf_only when not has_impl -> None + | Root | Wrapped_compat | Impl_vmodule | Alias @@ -334,6 +339,11 @@ let generated_alias ~src_dir name = let t = generated ~src_dir name in { t with kind = Alias } +let generated_root ~src_dir name = + let src_dir = Path.build src_dir in + let t = generated ~src_dir name in + { t with kind = Root; visibility = Private } + let of_source ~visibility ~kind source = of_source ~visibility ~kind source module Name_map = struct diff --git a/src/dune_rules/module.mli b/src/dune_rules/module.mli index 81ab9e82d33..0ef04999235 100644 --- a/src/dune_rules/module.mli +++ b/src/dune_rules/module.mli @@ -23,6 +23,7 @@ module Kind : sig | Alias | Impl_vmodule | Wrapped_compat + | Root include Dune_lang.Conv.S with type t := t end @@ -132,3 +133,5 @@ val generated : src_dir:Path.t -> Module_name.t -> t (** Represent the generated alias module. *) val generated_alias : src_dir:Path.Build.t -> Module_name.t -> t + +val generated_root : src_dir:Path.Build.t -> Module_name.t -> t diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index 0fc3fac3051..273fc5a64f2 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -55,7 +55,15 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = let stdlib = CC.stdlib cctx in let mode = Mode.of_cm_kind cm_kind in let dynlink = CC.dynlink cctx in - let sandbox = CC.sandbox cctx in + let sandbox = + let default = CC.sandbox cctx in + match Module.kind m with + | Root -> + (* This is need to guarantee that no local modules shadow the modules + referenced by the root module *) + Sandbox_config.needs_sandboxing + | _ -> default + in (let open Option.O in let* compiler = Result.to_option (Context.compiler ctx mode) in let ml_kind = Cm_kind.source cm_kind in @@ -164,6 +172,11 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = src in let modules = Compilation_context.modules cctx in + let obj_dirs = + Obj_dir.all_obj_dirs obj_dir ~mode + |> List.concat_map ~f:(fun p -> + [ Command.Args.A "-I"; Path (Path.build p) ]) + in SC.add_rule sctx ~sandbox ~dir (let open Build.With_targets.O in Build.with_no_targets (Build.paths extra_deps) @@ -171,10 +184,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = >>> Command.run ~dir:(Path.build dir) (Ok compiler) [ Command.Args.dyn flags ; cmt_args - ; Command.Args.S - ( Obj_dir.all_obj_dirs obj_dir ~mode - |> List.concat_map ~f:(fun p -> - [ Command.Args.A "-I"; Path (Path.build p) ]) ) + ; Command.Args.S obj_dirs ; Cm_kind.Dict.get (CC.includes cctx) cm_kind ; As extra_args ; ( if dynlink || cm_kind <> Cmx then @@ -283,7 +293,7 @@ let ocamlc_i ?(flags = []) ~deps cctx (m : Module.t) ~output = `-open` option of the compiler. This module is called the alias module and is implicitly generated by Dune.*) -let alias_source modules ~renames = +let alias_source modules = let alias new_name old_name = sprintf "module %s = %s" (Module_name.to_string new_name) @@ -291,75 +301,60 @@ let alias_source modules ~renames = in let main_module_name = Modules.main_module_name modules |> Option.value_exn in let aliased_modules = Modules.for_alias modules in - let internal = - Module_name.Map.values aliased_modules - |> List.map ~f:(fun (m : Module.t) -> - let name = Module.name m in - let obj_name_as_module = - Module.obj_name m |> Module_name.Unique.to_name ~loc:Loc.none - in - sprintf "(** @canonical %s.%s *)\n%s\n" - (Module_name.to_string main_module_name) - (Module_name.to_string name) - (alias name obj_name_as_module)) - in - let open Result.O in - let+ renames, shadows = - let+ renames = renames in - let aliases, shadows = - List.sort renames ~compare:(fun (x : Compilation_context.rename) y -> - Module_name.compare x.new_name y.new_name) - |> List.fold_left ~init:([], []) - ~f:(fun (aliases, shadows) { Compilation_context.new_name; old_name } - -> - if Module_name.Map.mem aliased_modules new_name then - (aliases, shadows) - else - let alias = alias new_name old_name in - let shadows = old_name :: shadows in - (alias :: aliases, shadows)) - in - let shadows = - List.sort_uniq shadows ~compare:Module_name.compare - |> List.filter_map ~f:(fun m -> - if Module_name.Map.mem aliased_modules m then - None - else - Some - (sprintf - (* TODO perhaps we should include which library is - shadowing? *) - "module %s = struct let this_module_is_shadowed = () end" - (Module_name.to_string m))) - in - (List.rev aliases, shadows) - in - [ renames; shadows; internal ] |> List.concat |> String.concat ~sep:"\n\n" + Module_name.Map.values aliased_modules + |> List.map ~f:(fun (m : Module.t) -> + let name = Module.name m in + let obj_name_as_module = + Module.obj_name m |> Module_name.Unique.to_name ~loc:Loc.none + in + sprintf "(** @canonical %s.%s *)\n%s\n" + (Module_name.to_string main_module_name) + (Module_name.to_string name) + (alias name obj_name_as_module)) + |> String.concat ~sep:"\n\n" let build_alias_module ~alias_module ~cctx = let sctx = Compilation_context.super_context cctx in let file = Option.value_exn (Module.file alias_module ~ml_kind:Impl) in let modules = Compilation_context.modules cctx in - (* TODO should be lazy, but we can't compose that with Build.of_result *) - let alias_file = - let renames = Compilation_context.renames cctx in - alias_source modules ~renames - in + let alias_file () = alias_source modules in let dir = Compilation_context.dir cctx in - (* TODO obtain loc from buildable used to construct cctx *) Super_context.add_rule ~loc:Loc.none sctx ~dir - (let target = Path.as_in_build_dir_exn file in - Build.With_targets.of_result_map alias_file ~targets:[ target ] - ~f:(Build.write_file target)); + ( Build.delayed alias_file + |> Build.write_file_dyn (Path.as_in_build_dir_exn file) ); let cctx = Compilation_context.for_alias_module cctx in build_module cctx alias_module ~dep_graphs:(Dep_graph.Ml_kind.dummy alias_module) +let root_source entries = + let b = Buffer.create 128 in + List.iter entries ~f:(fun name -> + Printf.bprintf b "module %s = %s\n" + (Module_name.to_string name) + (Module_name.to_string name)); + Buffer.contents b + +let build_root_module root_module ~entries ~cctx = + let sctx = Compilation_context.super_context cctx in + let file = Option.value_exn (Module.file root_module ~ml_kind:Impl) in + let dir = Compilation_context.dir cctx in + let root_file = Result.map entries ~f:root_source in + Super_context.add_rule ~loc:Loc.none sctx ~dir + (let target = Path.as_in_build_dir_exn file in + Build.With_targets.of_result_map root_file ~targets:[ target ] + ~f:(Build.write_file target)); + build_module cctx root_module + ~dep_graphs:(Dep_graph.Ml_kind.dummy root_module) + let build_all cctx ~dep_graphs = let for_wrapped_compat = lazy (Compilation_context.for_wrapped_compat cctx) in let modules = Compilation_context.modules cctx in Modules.iter_no_vlib modules ~f:(fun m -> match Module.kind m with + | Root -> + let cctx = Compilation_context.for_root_module cctx in + let entries = Compilation_context.root_module_entries cctx in + build_root_module m ~entries ~cctx | Alias -> let cctx = Compilation_context.for_alias_module cctx in build_alias_module ~alias_module:m ~cctx diff --git a/src/dune_rules/modules.ml b/src/dune_rules/modules.ml index c812bc0d947..06f4fe5e545 100644 --- a/src/dune_rules/modules.ml +++ b/src/dune_rules/modules.ml @@ -568,12 +568,10 @@ let singleton_exe m = let exe_unwrapped m = Unwrapped m -let exe_wrapped ~src_dir ~modules ~force_alias = +let exe_wrapped ~src_dir ~modules = match as_singleton modules with - | Some m when not force_alias -> singleton_exe m - | Some _ - | None -> - Wrapped (Wrapped.exe ~src_dir ~modules) + | Some m -> singleton_exe m + | None -> Wrapped (Wrapped.exe ~src_dir ~modules) let rec impl_only = function | Stdlib w -> Stdlib.impl_only w @@ -742,13 +740,16 @@ let rec wrapped = function | Impl { vlib = _; impl } -> wrapped impl let rec alias_for t m = - match t with - | Singleton _ - | Unwrapped _ -> - None - | Wrapped w -> Wrapped.alias_for w m - | Stdlib w -> Stdlib.alias_for w m - | Impl { impl; vlib = _ } -> alias_for impl m + match Module.kind m with + | Root -> None + | _ -> ( + match t with + | Singleton _ + | Unwrapped _ -> + None + | Wrapped w -> Wrapped.alias_for w m + | Stdlib w -> Stdlib.alias_for w m + | Impl { impl; vlib = _ } -> alias_for impl m ) let is_stdlib_alias t m = match t with diff --git a/src/dune_rules/modules.mli b/src/dune_rules/modules.mli index df8a483b761..708969f7eba 100644 --- a/src/dune_rules/modules.mli +++ b/src/dune_rules/modules.mli @@ -46,8 +46,7 @@ val iter_no_vlib : t -> f:(Module.t -> unit) -> unit val exe_unwrapped : Module.Name_map.t -> t -val exe_wrapped : - src_dir:Path.Build.t -> modules:Module.Name_map.t -> force_alias:bool -> t +val exe_wrapped : src_dir:Path.Build.t -> modules:Module.Name_map.t -> t (** For wrapped libraries, this is the user written entry module for the library. For single module libraries, it's the sole module in the library *) diff --git a/src/dune_rules/modules_field_evaluator.ml b/src/dune_rules/modules_field_evaluator.ml index 97d408bc066..bcebcc6ddd4 100644 --- a/src/dune_rules/modules_field_evaluator.ml +++ b/src/dune_rules/modules_field_evaluator.ml @@ -253,7 +253,7 @@ let check_invalid_module_listing ~(buildable : Buildable.t) ~intf_only ~modules ) let eval ~modules:(all_modules : Module.Source.t Module_name.Map.t) - ~buildable:(conf : Buildable.t) ~private_modules ~kind = + ~buildable:(conf : Buildable.t) ~private_modules ~kind ~src_dir = (* Fake modules are modules that do not exist but it doesn't matter because they are only removed from a set (for jbuild file compatibility) *) let fake_modules = ref Module_name.Map.empty in @@ -316,4 +316,8 @@ let eval ~modules:(all_modules : Module.Source.t Module_name.Map.t) in Module.of_source m ~kind ~visibility) in - all_modules + match conf.root_module with + | None -> all_modules + | Some (_, name) -> + let module_ = Module.generated_root ~src_dir name in + Module_name.Map.set all_modules name module_ diff --git a/src/dune_rules/modules_field_evaluator.mli b/src/dune_rules/modules_field_evaluator.mli index 56b1732b33f..341056f8f54 100644 --- a/src/dune_rules/modules_field_evaluator.mli +++ b/src/dune_rules/modules_field_evaluator.mli @@ -25,4 +25,5 @@ val eval : -> buildable:Dune_file.Buildable.t -> private_modules:Ordered_set_lang.t -> kind:kind + -> src_dir:Path.Build.t -> Module.Name_map.t diff --git a/src/stdune/result.ml b/src/stdune/result.ml index 4c61bebe850..96184350882 100644 --- a/src/stdune/result.ml +++ b/src/stdune/result.ml @@ -106,6 +106,13 @@ module List = struct match t with | [] -> Ok init | x :: xs -> f init x >>= fun init -> fold_left xs ~f ~init + + let filter_map t ~f = + fold_left t ~init:[] ~f:(fun acc x -> + f x >>| function + | None -> acc + | Some y -> y :: acc) + >>| List.rev end let hash h1 h2 t = diff --git a/src/stdune/result.mli b/src/stdune/result.mli index 41fa8e60d84..2ec222a6608 100644 --- a/src/stdune/result.mli +++ b/src/stdune/result.mli @@ -69,6 +69,9 @@ module List : sig -> f:('acc -> 'a -> ('acc, 'c) result) -> init:'acc -> ('acc, 'c) result + + val filter_map : + 'a list -> f:('a -> ('b option, 'error) t) -> ('b list, 'error) t end module Option : sig diff --git a/test/blackbox-tests/test-cases/rename-deps.t b/test/blackbox-tests/test-cases/rename-deps.t deleted file mode 100644 index cbf91c803df..00000000000 --- a/test/blackbox-tests/test-cases/rename-deps.t +++ /dev/null @@ -1,231 +0,0 @@ -A library can be shadowed by an internal module name: - - $ cat >dune-project < (lang dune 2.8) - > EOF - - $ mkdir lib0 lib1 lib2 - - $ cat >lib0/dune < (library - > (name lib0)) - > EOF - $ cat >lib0/lib0.ml < let greeting_from_lib0 = "Hello World" - > EOF - - $ cat >lib1/dune < (library - > (name lib1)) - > EOF - $ cat >lib1/lib1.ml < let greeting = "Hello World" - > EOF - - $ cat >lib2/dune < (library - > (libraries lib1) - > (name lib2)) - > EOF - -Now we shadow lib1: - $ touch lib2/lib1.ml - $ cat >lib2/lib2.ml < print_endline Lib1.greeting - > EOF - - $ dune build @all - File "lib2/lib2.ml", line 1, characters 14-27: - 1 | print_endline Lib1.greeting - ^^^^^^^^^^^^^ - Error: Unbound value Lib1.greeting - [1] - -"identity" renaming does not change the name precedence: - - $ cat >lib2/dune < (library - > (libraries (rename lib1 -> lib1)) - > (name lib2)) - > EOF - $ cat >lib2/lib2.ml < print_endline Lib1.greeting - > EOF - $ dune build @all - File "lib2/lib2.ml", line 1, characters 14-27: - 1 | print_endline Lib1.greeting - ^^^^^^^^^^^^^ - Error: Unbound value Lib1.greeting - [1] - -We can use the rename dependency type to use lib1 with a different name: - - $ cat >lib2/dune < (library - > (libraries (rename lib1 -> lib1_unshadow)) - > (name lib2)) - > EOF - $ cat >lib2/lib2.ml < print_endline Lib1_unshadow.greeting - > EOF - $ dune build @all - -The same for executables: - - $ mkdir exe - $ cat >exe/dune < (executable - > (name foo) - > (libraries (rename lib1 -> lib1_unshadow))) - > EOF - $ touch exe/lib1.ml - $ cat >exe/foo.ml < print_endline Lib1_unshadow.greeting - > EOF - $ dune exec ./exe/foo.exe - Hello World - -This works for single module executables: - - $ rm exe/lib1.ml - $ dune exec ./exe/foo.exe - Hello World - -And for single module libs: - $ rm lib2/lib1.ml - $ dune build @lib2/all - -This mode is disabled for unwrapped libraries - - $ mkdir unwrapped - $ cat >unwrapped/dune < (library - > (libraries (rename lib1 -> lib1_unshadow)) - > (wrapped false) - > (name unwrapped_lib)) - > EOF - $ dune build @unwrapped/all - File "unwrapped/dune", line 2, characters 20-24: - 2 | (libraries (rename lib1 -> lib1_unshadow)) - ^^^^ - Error: rename may not be used in unwrapped libraries - [1] - - $ rm -r unwrapped - -The renamed library can not be used by its original name: - - $ cat >lib2/lib2.ml < module Lib1_empty = struct include Lib1 end;; - > print_endline Lib1.greeting - > EOF - - $ dune build @lib2/all - File "lib2/lib2.ml", line 2, characters 14-27: - 2 | print_endline Lib1.greeting - ^^^^^^^^^^^^^ - Error: Unbound value Lib1.greeting - [1] - -# CR-someday aalekseyev: I would rather [Lib1_empty] definition -# above was rejected. -# -# In jenga we achieve this by defining the lib alias like this: -# -# module Lib = Module_that_does_not_exist -# -# which has its own downsides, but we thought it was a bit better than -# an empty module. I think we also considered making it a functor -# that can't be applied, something like: -# -# module type Abstract -# module Lib1(M : Abstract) = struct end -# -# but that can be pretty confusing too. - -Implementation detail: the generated renaming module. - - $ cat _build/default/lib2/lib2__.ml-gen - module Lib1_unshadow = Lib1 - - module Lib1 = struct let this_module_is_shadowed = () end - -Multiple renamings to the same name: - - $ cat >lib2/dune < (library - > (libraries - > (rename lib0 -> lib) - > (rename lib1 -> lib) - > ) - > (name lib2)) - > EOF - - $ dune build @lib2/all - File "lib2/lib2__.ml-gen", line 3, characters 0-17: - 3 | module Lib = Lib1 - ^^^^^^^^^^^^^^^^^ - Error: Multiple definition of the module name Lib. - Names must be unique in a given structure or signature. - [1] - -# CR aalekseyev: the error above should probably be caught earlier - -Complicated library renamings where the act of renaming shadows another library: - - $ cat >lib2/dune < (library - > (libraries - > (rename lib0 -> lib1) - > (rename lib1 -> lib0) - > ) - > (name lib2)) - > EOF - - $ cat >lib2/lib2.ml < let greeting_from_lib1 = Lib0.greeting - > let greeting_from_lib0 = Lib1.greeting_from_lib0 - > EOF - - $ cat >lib2/m.ml < let x = 8 - > EOF - - $ dune build @lib2/all - File "lib2/lib2__.ml-gen", line 5, characters 0-57: - 5 | module Lib0 = struct let this_module_is_shadowed = () end - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: Multiple definition of the module name Lib0. - Names must be unique in a given structure or signature. - [1] - -# CR aalekseyev: the above should probably work? -# Or at least if it fails it should fail with a better error. -# -# Probably the way to make it work is to generate something like this: -# -# module Root____ = struct -# module Lib0 = Lib0 -# module Lib1 = Lib1 -# end -# module Lib0 = Root____.Lib1 -# module Lib1 = Root____.Lib0 -# -# (at this point, one has to wonder if Root____ is, perhaps, all we needed, after all) - -Implementation detail, the generated renaming module: - - $ cat _build/default/lib2/lib2__.ml-gen - module Lib0 = Lib1 - - module Lib1 = Lib0 - - module Lib0 = struct let this_module_is_shadowed = () end - - module Lib1 = struct let this_module_is_shadowed = () end - - (** @canonical Lib2.M *) - module M = Lib2__M - -# CR aalekseyev: should we also add a @canonical doc comment to the library renamings? -# I don't know what uses it, but if it's needed on M it's probably needed on Lib1 too. diff --git a/test/blackbox-tests/test-cases/root-module.t b/test/blackbox-tests/test-cases/root-module.t new file mode 100644 index 00000000000..3451eec3404 --- /dev/null +++ b/test/blackbox-tests/test-cases/root-module.t @@ -0,0 +1,76 @@ +A library can be shadowed by an internal module name: + + $ cat >dune-project < (lang dune 2.8) + > EOF + + $ mkdir lib0 lib1 lib2 + + $ cat >lib0/dune < (library + > (name lib0)) + > EOF + $ cat >lib0/lib0.ml < let greeting_from_lib0 = "Hello World" + > EOF + + $ cat >lib1/dune < (library + > (name lib1)) + > EOF + $ cat >lib1/lib1.ml < let greeting = "Hello World" + > EOF + + $ cat >lib2/dune < (library + > (libraries lib1) + > (name lib2)) + > EOF + +Now we shadow lib1: + $ cat >lib2/lib1.ml < let greeting = () + > EOF + $ cat >lib2/lib2.ml < print_endline Lib1.greeting + > EOF + + $ dune build @all + File "lib2/lib2.ml", line 1, characters 14-27: + 1 | print_endline Lib1.greeting + ^^^^^^^^^^^^^ + Error: This expression has type unit but an expression was expected of type + string + [1] + +We can use the rename dependency type to use lib1 with a different name: + + $ cat >lib2/dune < (library + > (libraries lib1) + > (root_module root) + > (name lib2)) + > EOF + $ cat >lib2/lib2.ml < print_endline Root.Lib1.greeting + > EOF + $ dune build @all + +The same for executables: + + $ mkdir exe + $ cat >exe/dune < (executable + > (name foo) + > (libraries lib1) + > (root_module root)) + > EOF + $ echo >exe/lib1.ml < let greeting = () + > EOF + $ cat >exe/foo.ml < print_endline Root.Lib1.greeting + > EOF + $ dune exec ./exe/foo.exe + Hello World From a00604854f1fea18ae27c091f96ca848f9b69f24 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 19 Nov 2020 17:12:31 -0800 Subject: [PATCH 3/4] Remove force_alias_module Signed-off-by: Rudi Grinberg --- src/dune_rules/ml_sources.ml | 9 +++------ src/dune_rules/modules.ml | 23 ++++++++--------------- src/dune_rules/modules.mli | 3 --- 3 files changed, 11 insertions(+), 24 deletions(-) diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 4ca0c5b4a71..caade6ca678 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -208,7 +208,7 @@ let virtual_modules lookup_vlib vlib = } let make_lib_modules (d : _ Dir_with_dune.t) ~lookup_vlib ~(lib : Library.t) - ~modules ~force_alias_module = + ~modules = let src_dir = d.ctx_dir in let kind, main_module_name, wrapped = match lib.implements with @@ -274,16 +274,13 @@ let make_lib_modules (d : _ Dir_with_dune.t) ~lookup_vlib ~(lib : Library.t) let implements = Option.is_some lib.implements in let _loc, lib_name = lib.name in Modules_group.lib ~stdlib ~implements ~lib_name ~src_dir ~modules - ~main_module_name ~wrapped ~force_alias_module + ~main_module_name ~wrapped let libs_and_exes (d : _ Dir_with_dune.t) ~lookup_vlib ~modules = List.filter_partition_map d.data ~f:(fun stanza -> match (stanza : Stanza.t) with | Library lib -> - let modules = - make_lib_modules d ~lookup_vlib ~modules ~lib - ~force_alias_module:false - in + let modules = make_lib_modules d ~lookup_vlib ~modules ~lib in Left (lib, modules) | Executables exes | Tests { exes; _ } -> diff --git a/src/dune_rules/modules.ml b/src/dune_rules/modules.ml index 06f4fe5e545..b22cd4186d3 100644 --- a/src/dune_rules/modules.ml +++ b/src/dune_rules/modules.ml @@ -480,7 +480,7 @@ let rec main_module_name = function | Impl { vlib; impl = _ } -> main_module_name vlib let lib ~src_dir ~main_module_name ~wrapped ~stdlib ~lib_name ~implements - ~modules ~force_alias_module = + ~modules = let make_wrapped main_module_name = Wrapped (Wrapped.make ~src_dir ~lib_name ~implements ~modules ~main_module_name @@ -491,24 +491,17 @@ let lib ~src_dir ~main_module_name ~wrapped ~stdlib ~lib_name ~implements let main_module_name = Option.value_exn main_module_name in Stdlib (Stdlib.make ~stdlib ~modules ~main_module_name) | None -> ( - match - (wrapped, main_module_name, as_singleton modules, force_alias_module) - with - | Simple false, _, _, true -> - Code_error.raise "Modules.lib: unwrapped and force_alias" [] - | Simple false, _, Some m, false -> Singleton m - | Simple false, _, None, false -> Unwrapped modules - | (Yes_with_transition _ | Simple true), Some main_module_name, Some m, _ -> - if - Module.name m = main_module_name - && (not implements) && not force_alias_module - then + match (wrapped, main_module_name, as_singleton modules) with + | Simple false, _, Some m -> Singleton m + | Simple false, _, None -> Unwrapped modules + | (Yes_with_transition _ | Simple true), Some main_module_name, Some m -> + if Module.name m = main_module_name && not implements then Singleton m else make_wrapped main_module_name - | (Yes_with_transition _ | Simple true), Some main_module_name, None, _ -> + | (Yes_with_transition _ | Simple true), Some main_module_name, None -> make_wrapped main_module_name - | (Simple true | Yes_with_transition _), None, _, _ -> + | (Simple true | Yes_with_transition _), None, _ -> Code_error.raise "Modules.lib: cannot wrap without main module name" [] ) let impl impl ~vlib = diff --git a/src/dune_rules/modules.mli b/src/dune_rules/modules.mli index 708969f7eba..547633683bf 100644 --- a/src/dune_rules/modules.mli +++ b/src/dune_rules/modules.mli @@ -15,9 +15,6 @@ val lib : -> lib_name:Lib_name.Local.t -> implements:bool -> modules:Module.Name_map.t - -> force_alias_module:bool - (** Force the creation of an alias module. Required if we're renaming any - dependencies *) -> t val encode : t -> Dune_lang.t From 2cb4b96467e6bdc726fffcca4836014894c5d118 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 20 Nov 2020 18:30:07 -0800 Subject: [PATCH 4/4] gross hacks for builtin & mangled modules * Hide modules with __ root_module * Populate module lists manually for some built in libraries Signed-off-by: Rudi Grinberg --- src/dune_rules/findlib/findlib.ml | 60 +++++++++++++------- src/dune_rules/findlib/meta.ml | 24 ++++++-- test/blackbox-tests/test-cases/root-module.t | 5 +- 3 files changed, 61 insertions(+), 28 deletions(-) diff --git a/src/dune_rules/findlib/findlib.ml b/src/dune_rules/findlib/findlib.ml index 07da7408294..a2d5c732d0e 100644 --- a/src/dune_rules/findlib/findlib.ml +++ b/src/dune_rules/findlib/findlib.ml @@ -247,6 +247,11 @@ end = struct (make_archives t "archive" (Ps.add preds Variant.plugin)) (make_archives t "plugin" preds) + let mangled_module_re = + lazy + (let open Re in + [ rep any; str "__"; rep any ] |> seq |> compile) + let exists t ~is_builtin = let exists_if = Vars.get_words t.vars "exists_if" Ps.empty in match exists_if with @@ -371,28 +376,39 @@ end = struct in let entry_modules = Lib_info.Source.External - ( match dir_contents with - | Error e -> - Error - (User_error.E - (User_message.make - [ Pp.textf "Unable to get entry modules of %s in %s. " - (Lib_name.to_string t.name) - (Path.to_string src_dir) - ; Pp.textf "error: %s" (Unix.error_message e) - ])) - | Ok files -> - let ext = Cm_kind.ext Cmi in - Result.List.filter_map files ~f:(fun fname -> - match Filename.check_suffix fname ext with - | false -> Ok None - | true -> ( - match - let name = Filename.chop_extension fname in - Module_name.of_string_user_error (Loc.in_dir src_dir, name) - with - | Ok s -> Ok (Some s) - | Error e -> Error (User_error.E e) )) ) + ( match Vars.get_words t.vars "main_modules" Ps.empty with + | _ :: _ as modules -> + Ok (List.map ~f:Module_name.of_string modules) + | [] -> ( + match dir_contents with + | Error e -> + Error + (User_error.E + (User_message.make + [ Pp.textf "Unable to get entry modules of %s in %s. " + (Lib_name.to_string t.name) + (Path.to_string src_dir) + ; Pp.textf "error: %s" (Unix.error_message e) + ])) + | Ok files -> + let ext = Cm_kind.ext Cmi in + Result.List.filter_map files ~f:(fun fname -> + match Filename.check_suffix fname ext with + | false -> Ok None + | true -> ( + if + (* We add this hack to skip manually mangled libraries *) + Re.execp (Lazy.force mangled_module_re) fname + then + Ok None + else + match + let name = Filename.chop_extension fname in + Module_name.of_string_user_error + (Loc.in_dir src_dir, name) + with + | Ok s -> Ok (Some s) + | Error e -> Error (User_error.E e) )) ) ) in Lib_info.create ~loc ~name:t.name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires diff --git a/src/dune_rules/findlib/meta.ml b/src/dune_rules/findlib/meta.ml index e7ffdfe6b37..677c21be2a0 100644 --- a/src/dune_rules/findlib/meta.ml +++ b/src/dune_rules/findlib/meta.ml @@ -141,19 +141,31 @@ let archives name = ; plugin "native" (name ^ Mode.plugin_ext Native) ] +(* fake entry we use to pass down the list of toplevel modules for root_module *) +let main_modules names = + List.map ~f:String.capitalize_ascii names + |> String.concat ~sep:" " |> rule "main_modules" [] Set + let builtins ~stdlib_dir ~version:ocaml_version = let version = version "[distributed with Ocaml]" in - let simple name ?dir ?archive_name deps = + let simple name ?(labels = false) ?dir ?archive_name deps = let archive_name = match archive_name with | None -> name | Some a -> a in + let main_modules = + if labels then + main_modules [ name; name ^ "Labels" ] + else + main_modules [ name ] + in let name = Lib_name.of_string name in let archives = archives archive_name in + let main_modules = main_modules in { name = Some name ; entries = - requires deps :: version + requires deps :: version :: main_modules :: ( match dir with | None -> archives @@ -161,7 +173,9 @@ let builtins ~stdlib_dir ~version:ocaml_version = } in let dummy name = - { name = Some (Lib_name.of_string name); entries = [ version ] } + { name = Some (Lib_name.of_string name) + ; entries = [ version; main_modules [ name ] ] + } in let compiler_libs = let sub name deps = @@ -181,7 +195,7 @@ let builtins ~stdlib_dir ~version:ocaml_version = in let stdlib = dummy "stdlib" in let str = simple "str" [] ~dir:"+" in - let unix = simple "unix" [] ~dir:"+" in + let unix = simple ~labels:true "unix" [] ~dir:"+" in let bigarray = if Ocaml_version.stdlib_includes_bigarray ocaml_version @@ -200,6 +214,7 @@ let builtins ~stdlib_dir ~version:ocaml_version = { name = Some (Lib_name.of_string "threads") ; entries = [ version + ; main_modules [ "thread" ] ; requires ~preds:[ Pos "mt"; Pos "mt_vm" ] [ "threads.vm" ] ; requires ~preds:[ Pos "mt"; Pos "mt_posix" ] [ "threads.posix" ] ; directory "+" @@ -219,6 +234,7 @@ let builtins ~stdlib_dir ~version:ocaml_version = { name = Some (Lib_name.of_string "num") ; entries = [ requires [ "num.core" ] + ; main_modules [ "num" ] ; version ; Package (simple "core" [] ~dir:"+" ~archive_name:"nums") ] diff --git a/test/blackbox-tests/test-cases/root-module.t b/test/blackbox-tests/test-cases/root-module.t index 3451eec3404..dca9e2cbc37 100644 --- a/test/blackbox-tests/test-cases/root-module.t +++ b/test/blackbox-tests/test-cases/root-module.t @@ -48,12 +48,13 @@ We can use the rename dependency type to use lib1 with a different name: $ cat >lib2/dune < (library - > (libraries lib1) + > (libraries lib1 unix) > (root_module root) > (name lib2)) > EOF $ cat >lib2/lib2.ml < print_endline Root.Lib1.greeting + > module U = UnixLabels + > let () = print_endline Root.Lib1.greeting > EOF $ dune build @all