From 73c224d2df83bbdd3f56cb1e2ce7bcfa8dfdd979 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 1 Apr 2024 16:14:44 -0700 Subject: [PATCH] feat: support libraries with the same name in multiple contexts (#10307) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * feat: support libraries with the same name in multiple contexts Signed-off-by: Javier Chávarri Signed-off-by: Antonio Nuno Monteiro Signed-off-by: Rudi Grinberg Co-authored-by: Javier Chávarri Co-authored-by: Rudi Grinberg --- bin/describe/describe_workspace.ml | 3 +- doc/changes/10307.md | 4 + src/dune_rules/dir_contents.ml | 4 +- src/dune_rules/dune_package.ml | 2 + src/dune_rules/dune_rules.ml | 1 + src/dune_rules/findlib.ml | 5 +- src/dune_rules/gen_rules.ml | 6 +- src/dune_rules/install_rules.ml | 23 +- src/dune_rules/lib.ml | 201 +++++++--- src/dune_rules/lib.mli | 14 +- src/dune_rules/lib_id.ml | 81 ++++ src/dune_rules/lib_id.mli | 26 ++ src/dune_rules/lib_info.ml | 6 + src/dune_rules/lib_info.mli | 2 + src/dune_rules/lib_rules.ml | 7 +- src/dune_rules/ml_sources.ml | 73 ++-- src/dune_rules/ml_sources.mli | 2 +- src/dune_rules/odoc.ml | 5 +- src/dune_rules/odoc_new.ml | 2 +- src/dune_rules/scope.ml | 372 ++++++++++++------ src/dune_rules/stanzas/library.ml | 11 + src/dune_rules/stanzas/library.mli | 1 + src/dune_rules/stanzas/library_redirect.ml | 20 +- src/dune_rules/stanzas/library_redirect.mli | 8 +- src/dune_rules/virtual_rules.ml | 3 +- .../deprecated-library-name/features.t | 2 +- .../eif-library-name-collision-same-folder.t | 24 +- .../enabled_if/eif-library-name-collision.t | 25 +- .../lib-collision-private-same-folder.t | 14 +- .../lib-collision/lib-collision-private.t | 17 +- .../lib-collision-public-same-folder.t | 16 +- .../lib-collision-public-same-public-name.t | 53 +++ .../lib-collision/lib-collision-public.t | 13 +- 33 files changed, 781 insertions(+), 265 deletions(-) create mode 100644 doc/changes/10307.md create mode 100644 src/dune_rules/lib_id.ml create mode 100644 src/dune_rules/lib_id.mli create mode 100644 test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-public-name.t diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index 91ff01fd15f..40fe6d49f85 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -451,7 +451,8 @@ module Crawl = struct let* modules_, obj_dir_ = Dir_contents.get sctx ~dir:(Path.as_in_build_dir_exn src_dir) >>= Dir_contents.ocaml - >>| Ml_sources.modules_and_obj_dir ~for_:(Library name) + >>| Ml_sources.modules_and_obj_dir + ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) in let* pp_map = let+ version = diff --git a/doc/changes/10307.md b/doc/changes/10307.md new file mode 100644 index 00000000000..05a87a71ab1 --- /dev/null +++ b/doc/changes/10307.md @@ -0,0 +1,4 @@ +- allow libraries with the same `(name ..)` in projects as long as they don't + conflict during resolution (via `enabled_if`). (#10307, @anmonteiro, + @jchavarri) + diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index f01b7ee6d23..2006b482d33 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -456,8 +456,8 @@ let modules_of_local_lib sctx lib = let dir = Lib_info.src_dir info in get sctx ~dir in - let name = Lib_info.name info in - ocaml t >>| Ml_sources.modules ~for_:(Library name) + ocaml t + >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) ;; let modules_of_lib sctx lib = diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 8b401f3ecae..50937ebd1e8 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -231,6 +231,7 @@ module Lib = struct 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 lib_id = Lib_id.External (loc, name) in let enabled = Memo.return Lib_info.Enabled_status.Normal in let status = match Lib_name.analyze name with @@ -255,6 +256,7 @@ module Lib = struct ~path_kind:External ~loc ~name + ~lib_id ~kind ~status ~src_dir diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml index 4426b90bfe5..4fc8b6dfab2 100644 --- a/src/dune_rules/dune_rules.ml +++ b/src/dune_rules/dune_rules.ml @@ -24,6 +24,7 @@ module Expander = Expander module Lib = Lib module Lib_flags = Lib_flags module Lib_info = Lib_info +module Lib_id = Lib_id module Modules = Modules module Module_compilation = Module_compilation module Exe_rules = Exe_rules diff --git a/src/dune_rules/findlib.ml b/src/dune_rules/findlib.ml index 88450ed7e9c..05b09cc3788 100644 --- a/src/dune_rules/findlib.ml +++ b/src/dune_rules/findlib.ml @@ -206,10 +206,13 @@ let to_dune_library (t : Findlib.Package.t) ~dir_contents ~ext_lib ~external_loc | Error e -> Error e)))) in let modules = Lib_info.Source.External None in + let name = t.name in + let lib_id = Lib_id.External (loc, name) in Lib_info.create ~loc ~path_kind:External - ~name:t.name + ~name + ~lib_id ~kind ~status ~src_dir diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 978336d0ed2..41dc463d4c2 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -111,7 +111,11 @@ end = struct let+ () = Toplevel.Stanza.setup ~sctx ~dir ~toplevel in empty_none | Library.T lib -> - let* enabled_if = Lib.DB.available (Scope.libs scope) (Library.best_name lib) in + let* enabled_if = + Lib.DB.available_by_lib_id + (Scope.libs scope) + (Local (Library.to_lib_id ~src_dir lib)) + in if_available_buildable ~loc:lib.buildable.loc (fun () -> Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander) diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index e334fcfa190..e94adea1f04 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -88,7 +88,10 @@ end = struct let lib_files ~dir_contents ~dir ~lib_config lib = let+ modules = let+ ml_sources = Dir_contents.ocaml dir_contents in - Some (Ml_sources.modules ml_sources ~for_:(Library (Lib_info.name lib))) + Some + (Ml_sources.modules + ml_sources + ~for_:(Library (Lib_info.lib_id lib |> Lib_id.to_local_exn))) and+ foreign_archives = match Lib_info.virtual_ lib with | None -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) @@ -181,7 +184,9 @@ end = struct let lib_name = Library.best_name lib in let* installable_modules = let+ modules = - Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library lib_name) + Dir_contents.ocaml dir_contents + >>| Ml_sources.modules + ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) and+ impl = Virtual_rules.impl sctx ~lib ~scope in Vimpl.impl_modules impl modules |> Modules.split_by_lib in @@ -338,7 +343,15 @@ end = struct if enabled_if then if lib.optional - then Lib.DB.available (Scope.libs scope) (Library.best_name lib) + then ( + let src_dir = + Expander.dir expander + |> Path.build + |> Path.drop_optional_build_context_src_exn + in + Lib.DB.available_by_lib_id + (Scope.libs scope) + (Local (Library.to_lib_id ~src_dir lib))) else Memo.return true else Memo.return false | Documentation.T _ -> Memo.return true @@ -652,7 +665,9 @@ end = struct |> Foreign.Sources.object_files ~dir ~ext_obj |> List.map ~f:Path.build and* modules = - Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library name) + Dir_contents.ocaml dir_contents + >>| Ml_sources.modules + ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) and* melange_runtime_deps = file_deps (Lib_info.melange_runtime_deps info) and* public_headers = file_deps (Lib_info.public_headers info) in let+ dune_lib = diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index ab1d7312d20..df5d011ca25 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -132,6 +132,18 @@ module Error = struct ] ;; + let duplicated ~loc_a ~loc_b ~name = + let open Pp.O in + User_error.make + ~loc:loc_b + [ Pp.textf "Library with name %S is already defined in " (Lib_name.to_string name) + ++ Loc.pp_file_colon_line loc_a + ++ Pp.text + ". Either change one of the names, or enable them conditionally using the \ + 'enabled_if' field." + ] + ;; + (* diml: it is not very clear what a "default implementation cycle" is *) let default_implementation_cycle cycle = make @@ -396,7 +408,8 @@ end type db = { parent : db option - ; resolve : Lib_name.t -> resolve_result Memo.t + ; resolve : Lib_name.t -> resolve_result list Memo.t + ; resolve_lib_id : Lib_id.t -> resolve_result Memo.t ; instantiate : (Lib_name.t -> Path.t Lib_info.t -> hidden:string option -> Status.t Memo.t) Lazy.t ; all : Lib_name.t list Memo.Lazy.t @@ -411,7 +424,7 @@ and resolve_result = | Invalid of User_message.t | Ignore | Redirect_in_the_same_db of (Loc.t * Lib_name.t) - | Redirect of db * (Loc.t * Lib_name.t) + | Redirect of db * Lib_id.t let lib_config (t : lib) = t.lib_config let name t = t.name @@ -816,8 +829,9 @@ module rec Resolve_names : sig -> private_deps:private_deps -> lib Resolve.t option Memo.t - val resolve_name : db -> Lib_name.t -> Status.t Memo.t + val resolve_lib_id : db -> Lib_id.t -> Status.t Memo.t val available_internal : db -> Lib_name.t -> bool Memo.t + val available_by_lib_id_internal : db -> Lib_id.t -> bool Memo.t val resolve_simple_deps : db @@ -1084,7 +1098,12 @@ end = struct module Input = struct type t = Lib_name.t * Path.t Lib_info.t * string option - let equal (x, _, _) (y, _, _) = Lib_name.equal x y + let equal (lib_name, info, _) (lib_name', info', _) = + let lib_id = Lib_info.lib_id info + and lib_id' = Lib_info.lib_id info' in + Lib_name.equal lib_name lib_name' && Lib_id.equal lib_id lib_id' + ;; + let hash (x, _, _) = Lib_name.hash x let to_dyn = Dyn.opaque end @@ -1116,7 +1135,83 @@ end = struct ;; let instantiate db name info ~hidden = (Lazy.force db.instantiate) name info ~hidden - let find_internal db (name : Lib_name.t) = resolve_name db name + + let resolve_hidden db ~info hidden = + let open Memo.O in + (match db.parent with + | None -> Memo.return Status.Not_found + | Some db -> + let lib_id = Lib_info.lib_id info in + resolve_lib_id db lib_id) + >>= function + | Status.Found _ as x -> Memo.return x + | _ -> + let name = Lib_info.name info in + instantiate db name info ~hidden:(Some hidden) + ;; + + let handle_resolve_result db ~super = function + | Ignore -> Memo.return Status.Ignore + | Redirect_in_the_same_db (_, name') -> find_internal db name' + | Redirect (db', lib_id') -> resolve_lib_id db' lib_id' + | Found info -> + let name = Lib_info.name info in + instantiate db name info ~hidden:None + | Invalid e -> Memo.return (Status.Invalid e) + | Not_found -> + (match db.parent with + | None -> Memo.return Status.Not_found + | Some db -> super db) + | Hidden { lib = info; reason = hidden; path = _ } -> resolve_hidden db ~info hidden + ;; + + let handle_resolve_result_with_multiple_results db ~super = function + | [] -> handle_resolve_result ~super db Not_found + | [ r ] -> handle_resolve_result ~super db r + | candidates -> + let open Memo.O in + Memo.parallel_map candidates ~f:(function + | Ignore -> Memo.return (Some Status.Ignore) + | Redirect_in_the_same_db (_, name') -> find_internal db name' >>| Option.some + | Redirect (db', lib_id') -> resolve_lib_id db' lib_id' >>| Option.some + | Found info -> + Lib_info.enabled info + >>= (function + | Disabled_because_of_enabled_if -> Memo.return None + | Normal | Optional -> + let name = Lib_info.name info in + instantiate db name info ~hidden:None >>| Option.some) + | Invalid e -> Memo.return (Some (Status.Invalid e)) + | Not_found -> handle_resolve_result ~super db Not_found >>| Option.some + | Hidden { lib = info; reason = hidden; path = _ } -> + resolve_hidden db ~info hidden >>| Option.some) + >>| List.filter_opt + >>| (function + | [] -> Status.Not_found + | [ status ] -> status + | libs -> + List.fold_left libs ~init:Status.Not_found ~f:(fun acc status -> + match acc, status with + | Status.Found a, Status.Found b -> + let a_id = Lib_info.lib_id a.info in + let b_id = Lib_info.lib_id b.info in + (match Lib_id.equal a_id b_id with + | true -> acc + | false -> + let name = + if Lib_name.equal a.name b.name then a.name else Lib_id.name a_id + and loc_a = Lib_info.loc a.info + and loc_b = Lib_info.loc b.info in + Status.Invalid (Error.duplicated ~loc_a ~loc_b ~name)) + | (Found _ as lib), _ | _, (Found _ as lib) -> lib + | _, _ -> acc)) + ;; + + let find_internal db (name : Lib_name.t) = + let open Memo.O in + let super db = find_internal db name in + db.resolve name >>= handle_resolve_result_with_multiple_results ~super db + ;; let resolve_dep db (loc, name) ~private_deps : t Resolve.t option Memo.t = let open Memo.O in @@ -1130,26 +1225,10 @@ end = struct | Hidden h -> Hidden.error h ~loc ~name >>| Option.some ;; - let resolve_name db name = + let resolve_lib_id db lib_id = let open Memo.O in - db.resolve name - >>= function - | Ignore -> Memo.return Status.Ignore - | Redirect_in_the_same_db (_, name') -> find_internal db name' - | Redirect (db', (_, name')) -> find_internal db' name' - | Found info -> instantiate db name info ~hidden:None - | Invalid e -> Memo.return (Status.Invalid e) - | Not_found -> - (match db.parent with - | None -> Memo.return Status.Not_found - | Some db -> find_internal db name) - | Hidden { lib = info; reason = hidden; path = _ } -> - (match db.parent with - | None -> Memo.return Status.Not_found - | Some db -> find_internal db name) - >>= (function - | Status.Found _ as x -> Memo.return x - | _ -> instantiate db name info ~hidden:(Some hidden)) + let super db = resolve_lib_id db lib_id in + db.resolve_lib_id lib_id >>= handle_resolve_result ~super db ;; let available_internal db (name : Lib_name.t) = @@ -1160,6 +1239,14 @@ end = struct | Not_found | Invalid _ | Hidden _ -> false ;; + let available_by_lib_id_internal db (lib_id : Lib_id.t) = + let open Memo.O in + resolve_lib_id db lib_id + >>| function + | Ignore | Found _ -> true + | Not_found | Invalid _ | Hidden _ -> false + ;; + let resolve_simple_deps db names ~private_deps : t list Resolve.Memo.t = Resolve.Memo.List.filter_map names ~f:(fun dep -> let open Memo.O in @@ -1779,7 +1866,7 @@ module DB = struct | Invalid of User_message.t | Ignore | Redirect_in_the_same_db of (Loc.t * Lib_name.t) - | Redirect of db * (Loc.t * Lib_name.t) + | Redirect of db * Lib_id.t let found f = Found f let not_found = Not_found @@ -1794,7 +1881,7 @@ module DB = struct | Found lib -> variant "Found" [ Lib_info.to_dyn Path.to_dyn lib ] | Hidden h -> variant "Hidden" [ Hidden.to_dyn (Lib_info.to_dyn Path.to_dyn) h ] | Ignore -> variant "Ignore" [] - | Redirect (_, (_, name)) -> variant "Redirect" [ Lib_name.to_dyn name ] + | Redirect (_, lib_id) -> variant "Redirect" [ Lib_id.to_dyn lib_id ] | Redirect_in_the_same_db (_, name) -> variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ] ;; @@ -1802,11 +1889,12 @@ module DB = struct type t = db - let create ~parent ~resolve ~all ~lib_config ~instrument_with () = + let create ~parent ~resolve ~resolve_lib_id ~all ~lib_config ~instrument_with () = let rec t = lazy { parent ; resolve + ; resolve_lib_id ; all = Memo.lazy_ all ; lib_config ; instrument_with @@ -1819,20 +1907,16 @@ module DB = struct let create_from_findlib = let bigarray = Lib_name.of_string "bigarray" in fun findlib ~has_bigarray_library ~lib_config -> - create - () - ~parent:None - ~lib_config - ~resolve:(fun name -> - let open Memo.O in - Findlib.find findlib name - >>| function - | Ok (Library pkg) -> Found (Dune_package.Lib.info pkg) - | Ok (Deprecated_library_name d) -> - Redirect_in_the_same_db (d.loc, d.new_public_name) - | Ok (Hidden_library pkg) -> Hidden (Hidden.unsatisfied_exist_if pkg) - | Error e -> - (match e with + let resolve name = + let open Memo.O in + Findlib.find findlib name + >>| function + | Ok (Library pkg) -> [ Found (Dune_package.Lib.info pkg) ] + | Ok (Deprecated_library_name d) -> + [ Redirect_in_the_same_db (d.loc, d.new_public_name) ] + | Ok (Hidden_library pkg) -> [ Hidden (Hidden.unsatisfied_exist_if pkg) ] + | Error e -> + [ (match e with | Invalid_dune_package why -> Invalid why | Not_found when (not has_bigarray_library) && Lib_name.equal name bigarray -> @@ -1841,7 +1925,17 @@ module DB = struct correct thing to do would be to redirect it to the stdlib, but the stdlib isn't first class. *) Ignore - | Not_found -> Not_found)) + | Not_found -> Not_found) + ] + in + create + () + ~parent:None + ~lib_config + ~resolve + ~resolve_lib_id:(fun lib_id -> + let open Memo.O in + resolve (Lib_id.name lib_id) >>| List.hd) ~all:(fun () -> let open Memo.O in Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.name) @@ -1866,6 +1960,14 @@ module DB = struct | Ignore | Not_found | Invalid _ | Hidden _ -> None ;; + let find_lib_id t lib_id = + let open Memo.O in + Resolve_names.resolve_lib_id t lib_id + >>| function + | Found t -> Some t + | Ignore | Not_found | Invalid _ | Hidden _ -> None + ;; + let find_even_when_hidden t name = let open Memo.O in Resolve_names.find_internal t name @@ -1874,6 +1976,14 @@ module DB = struct | Ignore | Invalid _ | Not_found -> None ;; + let find_lib_id_even_when_hidden t lib_id = + let open Memo.O in + Resolve_names.resolve_lib_id t lib_id + >>| function + | Found t | Hidden { lib = t; reason = _; path = _ } -> Some t + | Ignore | Invalid _ | Not_found -> None + ;; + let resolve_when_exists t (loc, name) = let open Memo.O in Resolve_names.find_internal t name @@ -1895,16 +2005,17 @@ module DB = struct ;; let available t name = Resolve_names.available_internal t name + let available_by_lib_id t lib_id = Resolve_names.available_by_lib_id_internal t lib_id - let get_compile_info t ~allow_overlaps name = + let get_compile_info t ~allow_overlaps lib_id = let open Memo.O in - find_even_when_hidden t name + find_lib_id_even_when_hidden t lib_id >>| function | Some lib -> lib, Compile.for_lib ~allow_overlaps t lib | None -> Code_error.raise "Lib.DB.get_compile_info got library that doesn't exist" - [ "name", Lib_name.to_dyn name ] + [ "lib_id", Lib_id.to_dyn lib_id ] ;; let resolve_user_written_deps diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 6dbda11c7a3..e312daf4fc5 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -100,7 +100,7 @@ module DB : sig val not_found : t val found : Lib_info.external_ -> t val to_dyn : t Dyn.builder - val redirect : db -> Loc.t * Lib_name.t -> t + val redirect : db -> Lib_id.t -> t val redirect_in_the_same_db : Loc.t * Lib_name.t -> t end @@ -113,7 +113,8 @@ module DB : sig [all] returns the list of names of libraries available in this database. *) val create : parent:t option - -> resolve:(Lib_name.t -> Resolve_result.t Memo.t) + -> resolve:(Lib_name.t -> Resolve_result.t list Memo.t) + -> resolve_lib_id:(Lib_id.t -> Resolve_result.t Memo.t) -> all:(unit -> Lib_name.t list Memo.t) -> lib_config:Lib_config.t -> instrument_with:Lib_name.t list @@ -122,15 +123,14 @@ module DB : sig val find : t -> Lib_name.t -> lib option Memo.t val find_even_when_hidden : t -> Lib_name.t -> lib option Memo.t + val find_lib_id : t -> Lib_id.t -> lib option Memo.t + val find_lib_id_even_when_hidden : t -> Lib_id.t -> lib option Memo.t val available : t -> Lib_name.t -> bool Memo.t + val available_by_lib_id : t -> Lib_id.t -> bool Memo.t (** Retrieve the compile information for the given library. Works for libraries that are optional and not available as well. *) - val get_compile_info - : t - -> allow_overlaps:bool - -> Lib_name.t - -> (lib * Compile.t) Memo.t + val get_compile_info : t -> allow_overlaps:bool -> Lib_id.t -> (lib * Compile.t) Memo.t val resolve : t -> Loc.t * Lib_name.t -> lib Resolve.Memo.t diff --git a/src/dune_rules/lib_id.ml b/src/dune_rules/lib_id.ml new file mode 100644 index 00000000000..dcebf420c37 --- /dev/null +++ b/src/dune_rules/lib_id.ml @@ -0,0 +1,81 @@ +open Import + +module Local = struct + module T = struct + type t = + { name : Lib_name.t + ; loc : Loc.t + ; src_dir : Path.Source.t + ; enabled_if : Blang.t + } + + let compare a b = + match Lib_name.compare a.name b.name with + | Eq -> + (match Path.Source.compare a.src_dir b.src_dir with + | Eq -> Loc.compare a.loc b.loc + | o -> o) + | x -> x + ;; + + let to_dyn { name; loc; enabled_if; src_dir } = + let open Dyn in + record + [ "name", Lib_name.to_dyn name + ; "loc", Loc.to_dyn_hum loc + ; "src_dir", Path.Source.to_dyn src_dir + ; "enabled_if", Blang.to_dyn enabled_if + ] + ;; + + let equal a b = Ordering.is_eq (compare a b) + end + + include T + include Comparable.Make (T) + + let make ~loc ~src_dir ~enabled_if name = { name; loc; enabled_if; src_dir } + let loc t = t.loc +end + +module T = struct + type t = + | External of (Loc.t * Lib_name.t) + | Local of Local.t + + let compare a b = + match a, b with + | External (_, a), External (_, b) -> Lib_name.compare a b + | Local a, Local b -> Local.compare a b + | Local { loc = loc1; _ }, External (loc2, _) + | External (loc1, _), Local { loc = loc2; _ } -> Loc.compare loc1 loc2 + ;; + + let to_dyn t = + let open Dyn in + match t with + | External (_, lib_name) -> variant "External" [ Lib_name.to_dyn lib_name ] + | Local t -> variant "Local" [ Local.to_dyn t ] + ;; + + let equal a b = Ordering.is_eq (compare a b) +end + +include T +include Comparable.Make (T) + +let to_local_exn = function + | Local t -> t + | External (loc, name) -> + Code_error.raise ~loc "Expected a Local library id" [ "name", Lib_name.to_dyn name ] +;; + +let name = function + | Local { name; _ } -> name + | External (_, name) -> name +;; + +let loc = function + | Local { loc; _ } -> loc + | External (loc, _) -> loc +;; diff --git a/src/dune_rules/lib_id.mli b/src/dune_rules/lib_id.mli new file mode 100644 index 00000000000..258ca5df5d0 --- /dev/null +++ b/src/dune_rules/lib_id.mli @@ -0,0 +1,26 @@ +open Import + +module Local : sig + type t + + module Map : Map.S with type key = t + module Set : Set.S with type elt = t + + val equal : t -> t -> bool + val make : loc:Loc.t -> src_dir:Path.Source.t -> enabled_if:Blang.t -> Lib_name.t -> t + val loc : t -> Loc.t + val to_dyn : t -> Dyn.t +end + +type t = + | External of (Loc.t * Lib_name.t) + | Local of Local.t + +module Map : Map.S with type key = t +module Set : Set.S with type elt = t + +val to_local_exn : t -> Local.t +val name : t -> Lib_name.t +val loc : t -> Loc.t +val equal : t -> t -> bool +val to_dyn : t -> Dyn.t diff --git a/src/dune_rules/lib_info.ml b/src/dune_rules/lib_info.ml index 82599470f45..a06610a72b3 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -300,6 +300,7 @@ end type 'path t = { loc : Loc.t ; name : Lib_name.t + ; lib_id : Lib_id.t ; kind : Lib_kind.t ; status : Status.t ; src_dir : 'path @@ -338,6 +339,7 @@ type 'path t = } let name t = t.name +let lib_id t = t.lib_id let version t = t.version let dune_version t = t.dune_version let loc t = t.loc @@ -391,6 +393,7 @@ let create ~loc ~path_kind ~name + ~lib_id ~kind ~status ~src_dir @@ -428,6 +431,7 @@ let create = { loc ; name + ; lib_id ; kind ; status ; src_dir @@ -520,6 +524,7 @@ let to_dyn { loc ; path_kind = _ ; name + ; lib_id ; kind ; status ; src_dir @@ -561,6 +566,7 @@ let to_dyn record [ "loc", Loc.to_dyn_hum loc ; "name", Lib_name.to_dyn name + ; "lib_id", Lib_id.to_dyn lib_id ; "kind", Lib_kind.to_dyn kind ; "status", Status.to_dyn status ; "src_dir", path src_dir diff --git a/src/dune_rules/lib_info.mli b/src/dune_rules/lib_info.mli index bb1a0fe4d41..f0e69642a01 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -89,6 +89,7 @@ end type 'path t val name : _ t -> Lib_name.t +val lib_id : _ t -> Lib_id.t val loc : _ t -> Loc.t (** The [*.cma] and [*.cmxa] files for OCaml libraries. Libraries built by Dune @@ -191,6 +192,7 @@ val create : loc:Loc.t -> path_kind:'a path -> name:Lib_name.t + -> lib_id:Lib_id.t -> kind:Lib_kind.t -> status:Status.t -> src_dir:'a diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index b140ec27538..75f9d4d8df6 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -645,16 +645,19 @@ let library_rules let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = let buildable = lib.buildable in let* local_lib, compile_info = + let src_dir = Path.Build.drop_build_context_exn dir in Lib.DB.get_compile_info (Scope.libs scope) - (Library.best_name lib) + (Local (Library.to_lib_id ~src_dir lib)) ~allow_overlaps:buildable.allow_overlapping_dependencies in let local_lib = Lib.Local.of_lib_exn local_lib in let f () = let* source_modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library (Library.best_name lib)) + >>| Ml_sources.modules + ~for_: + (Library (Lib_info.lib_id (Lib.Local.info local_lib) |> Lib_id.to_local_exn)) in let* cctx = cctx lib ~sctx ~source_modules ~dir ~scope ~expander ~compile_info in let* () = diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 2f517afa825..eedb18e6218 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -31,7 +31,7 @@ module Modules = struct type component = Modules.t * Path.Build.t Obj_dir.t type t = - { libraries : component Lib_name.Map.t + { libraries : component Lib_id.Local.Map.t ; executables : component String.Map.t ; melange_emits : component String.Map.t ; (* Map from modules to the origin they are part of *) @@ -39,7 +39,7 @@ module Modules = struct } let empty = - { libraries = Lib_name.Map.empty + { libraries = Lib_id.Local.Map.empty ; executables = String.Map.empty ; melange_emits = String.Map.empty ; rev_map = Module_name.Path.Map.empty @@ -50,6 +50,7 @@ module Modules = struct { stanza : 'stanza ; sources : (Loc.t * Module.Source.t) Module_trie.t ; modules : Modules_group.t + ; dir : Path.Build.t ; obj_dir : Path.Build.t Obj_dir.t } @@ -61,18 +62,41 @@ module Modules = struct let make { libraries = libs; executables = exes; melange_emits = emits } = let libraries = - match - Lib_name.Map.of_list_map libs ~f:(fun part -> - Library.best_name part.stanza, (part.modules, part.obj_dir)) - with - | Ok x -> x - | Error (name, _, part) -> - User_error.raise - ~loc:part.stanza.buildable.loc - [ Pp.textf - "Library %S appears for the second time in this directory" - (Lib_name.to_string name) - ] + let _, libraries = + List.fold_left + libs + ~init:(Lib_name.Set.empty, Lib_id.Local.Map.empty) + ~f:(fun (libname_set, acc) part -> + let stanza = part.stanza in + let name = + let src_dir = + Obj_dir.dir part.obj_dir + |> Path.build + |> Path.drop_optional_build_context_src_exn + in + Lib_id.name (Local (Library.to_lib_id ~src_dir stanza)) + in + match Lib_name.Set.mem libname_set name with + | true -> + User_error.raise + ~loc:stanza.buildable.loc + [ Pp.textf + "Library %S appears for the second time in this directory" + (Lib_name.to_string name) + ] + | false -> + let acc = + let lib_id = + let src_dir = + Path.drop_optional_build_context_src_exn (Path.build part.dir) + in + Library.to_lib_id ~src_dir part.stanza + in + Lib_id.Local.Map.add_exn acc lib_id (part.modules, part.obj_dir) + in + Lib_name.Set.add libname_set name, acc) + in + libraries in let executables = match @@ -221,14 +245,14 @@ let modules_of_files ~path ~dialects ~dir ~files = ;; type for_ = - | Library of Lib_name.t + | Library of Lib_id.Local.t | Exe of { first_exe : string } | Melange of { target : string } let dyn_of_for_ = let open Dyn in function - | Library n -> variant "Library" [ Lib_name.to_dyn n ] + | Library n -> variant "Library" [ Lib_id.Local.to_dyn n ] | Exe { first_exe } -> variant "Exe" [ record [ "first_exe", string first_exe ] ] | Melange { target } -> variant "Melange" [ record [ "target", string target ] ] ;; @@ -236,7 +260,7 @@ let dyn_of_for_ = let modules_and_obj_dir t ~for_ = match match for_ with - | Library name -> Lib_name.Map.find t.modules.libraries name + | Library lib_id -> Lib_id.Local.Map.find t.modules.libraries lib_id | Exe { first_exe } -> String.Map.find t.modules.executables first_exe | Melange { target } -> String.Map.find t.modules.melange_emits target with @@ -244,7 +268,8 @@ let modules_and_obj_dir t ~for_ = | None -> let map = match for_ with - | Library _ -> Lib_name.Map.keys t.modules.libraries |> Dyn.list Lib_name.to_dyn + | Library _ -> + Lib_id.Local.Map.keys t.modules.libraries |> Dyn.list Lib_id.Local.to_dyn | Exe _ -> String.Map.keys t.modules.executables |> Dyn.(list string) | Melange _ -> String.Map.keys t.modules.melange_emits |> Dyn.(list string) in @@ -264,7 +289,7 @@ let virtual_modules ~lookup_vlib vlib = | Local -> let src_dir = Lib_info.src_dir info |> Path.as_in_build_dir_exn in let+ t = lookup_vlib ~dir:src_dir in - modules t ~for_:(Library (Lib.name vlib)) + modules t ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) in let existing_virtual_modules = Modules_group.virtual_module_names modules in let allow_new_public_modules = @@ -314,8 +339,8 @@ let make_lib_modules let open Memo.O in let* resolved = let* libs = libs in - Library.best_name lib - |> Lib.DB.find_even_when_hidden libs + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Lib.DB.find_lib_id_even_when_hidden libs (Local (Library.to_lib_id ~src_dir lib)) (* can't happen because this library is defined using the current stanza *) >>| Option.value_exn @@ -422,7 +447,7 @@ let modules_of_stanzas = then Modules_group.make_wrapped ~obj_dir ~modules `Exe else Modules_group.exe_unwrapped modules ~obj_dir in - `Executables { Modules.stanza = exes; sources; modules; obj_dir } + `Executables { Modules.stanza = exes; sources; modules; obj_dir; dir } in fun stanzas ~expander ~project ~dir ~libs ~lookup_vlib ~modules ~include_subdirs -> Memo.parallel_map stanzas ~f:(fun stanza -> @@ -458,7 +483,7 @@ let modules_of_stanzas = >>= Resolve.read_memo in let obj_dir = Library.obj_dir lib ~dir in - `Library { Modules.stanza = lib; sources; modules; obj_dir } + `Library { Modules.stanza = lib; sources; modules; dir; obj_dir } | Executables.T exes -> make_executables ~dir ~expander ~modules ~project exes | Tests.T { exes; _ } -> make_executables ~dir ~expander ~modules ~project exes | Melange_stanzas.Emit.T mel -> @@ -480,7 +505,7 @@ let modules_of_stanzas = ~modules `Melange in - `Melange_emit { Modules.stanza = mel; sources; modules; obj_dir } + `Melange_emit { Modules.stanza = mel; sources; modules; dir; obj_dir } | _ -> Memo.return `Skip)) >>| filter_partition_map ;; diff --git a/src/dune_rules/ml_sources.mli b/src/dune_rules/ml_sources.mli index 0b42ab6fb87..9bdf9bcc963 100644 --- a/src/dune_rules/ml_sources.mli +++ b/src/dune_rules/ml_sources.mli @@ -21,7 +21,7 @@ type t val artifacts : t -> Artifacts_obj.t Memo.t type for_ = - | Library of Lib_name.t (** Library name *) + | Library of Lib_id.Local.t | Exe of { first_exe : string (** Name of first executable appearing in executables stanza *) } diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index c3b0d722ed3..ea114085bca 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -951,7 +951,10 @@ let setup_private_library_doc_alias sctx ~scope ~dir (l : Library.t) = | Private _ -> let ctx = Super_context.context sctx in let* lib = - Lib.DB.find_even_when_hidden (Scope.libs scope) (Library.best_name l) + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Lib.DB.find_lib_id_even_when_hidden + (Scope.libs scope) + (Local (Library.to_lib_id ~src_dir l)) >>| Option.value_exn in let lib = Lib (Lib.Local.of_lib_exn lib) in diff --git a/src/dune_rules/odoc_new.ml b/src/dune_rules/odoc_new.ml index fa38b200429..9418a283914 100644 --- a/src/dune_rules/odoc_new.ml +++ b/src/dune_rules/odoc_new.ml @@ -266,7 +266,7 @@ let libs_maps_def = let info = Dune_package.Lib.info l in let name = Lib_info.name info in let pkg = Lib_info.package info in - Lib.DB.find db name + Lib.DB.find_lib_id db (Lib_info.lib_id info) >>| (function | None -> maps | Some lib -> diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index a29d814606e..d488f37b7c6 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -26,19 +26,41 @@ module DB = struct module Found_or_redirect : sig type t = private | Found of Lib_info.external_ - | Redirect of (Loc.t * Lib_name.t) + | Redirect of + { loc : Loc.t + ; to_ : Lib_name.t + ; enabled : Toggle.t Memo.t + } + | Deprecated_library_name of (Loc.t * Lib_name.t) - val redirect : Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t + val redirect + : enabled:Toggle.t Memo.t + -> Lib_name.t + -> Loc.t * Lib_name.t + -> Lib_name.t * t + + val deprecated_library_name : Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t val found : Lib_info.external_ -> t end = struct type t = | Found of Lib_info.external_ - | Redirect of (Loc.t * Lib_name.t) + | Redirect of + { loc : Loc.t + ; to_ : Lib_name.t + ; enabled : Toggle.t Memo.t + } + | Deprecated_library_name of (Loc.t * Lib_name.t) + + let redirect ~enabled from (loc, to_) = + if Lib_name.equal from to_ + then Code_error.raise ~loc "Invalid redirect" [ "to_", Lib_name.to_dyn to_ ] + else from, Redirect { loc; to_; enabled } + ;; - let redirect from (loc, to_) = + let deprecated_library_name from (loc, to_) = if Lib_name.equal from to_ then Code_error.raise ~loc "Invalid redirect" [ "to_", Lib_name.to_dyn to_ ] - else from, Redirect (loc, to_) + else from, Deprecated_library_name (loc, to_) ;; let found x = Found x @@ -46,138 +68,239 @@ module DB = struct module Library_related_stanza = struct type t = - | Library of Path.Build.t * Library.t + | Library of Library.t | Library_redirect of Library_redirect.Local.t | Deprecated_library_name of Deprecated_library_name.t end + let resolve_found_or_redirect fr = + match (fr : Found_or_redirect.t) with + | Redirect { loc; to_; enabled; _ } -> + let+ enabled = + let+ toggle = enabled in + Toggle.enabled toggle + in + if enabled + then Lib.DB.Resolve_result.redirect_in_the_same_db (loc, to_) + else Lib.DB.Resolve_result.not_found + | Found lib -> Memo.return (Lib.DB.Resolve_result.found lib) + | Deprecated_library_name lib -> + Memo.return (Lib.DB.Resolve_result.redirect_in_the_same_db lib) + ;; + + let resolve_lib_id lib_id_map lib_id = + match Lib_id.Map.find lib_id_map lib_id with + | None -> Memo.return Lib.DB.Resolve_result.not_found + | Some found_or_redirect -> resolve_found_or_redirect found_or_redirect + ;; + let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = - let map = - List.map stanzas ~f:(fun stanza -> - match (stanza : Library_related_stanza.t) with - | Library_redirect s -> - let old_public_name = Lib_name.of_local s.old_name in - Found_or_redirect.redirect old_public_name s.new_public_name - | Deprecated_library_name s -> - let old_public_name = Deprecated_library_name.old_public_name s in - Found_or_redirect.redirect old_public_name s.new_public_name - | Library (dir, (conf : Library.t)) -> - let info = - let expander = Expander0.get ~dir in - Library.to_lib_info conf ~expander ~dir ~lib_config |> Lib_info.of_local + let by_name, by_id, _ = + List.fold_left + stanzas + ~init:(Lib_name.Map.empty, Lib_id.Map.empty, Lib_name.Map.empty) + ~f:(fun (by_name, by_id, libname_conflict_map) (dir, stanza) -> + let lib_id, name, r2 = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + match (stanza : Library_related_stanza.t) with + | Library_redirect s -> + let lib_name, redirect = + let old_public_name = Lib_name.of_local s.old_name.lib_name in + let enabled = + Memo.lazy_ (fun () -> + let* expander = Expander0.get ~dir in + Expander0.eval_blang expander s.old_name.enabled >>| Toggle.of_bool) + |> Memo.Lazy.force + in + Found_or_redirect.redirect ~enabled old_public_name s.new_public_name + and lib_id = Library_redirect.Local.to_lib_id ~src_dir s in + Some lib_id, lib_name, redirect + | Deprecated_library_name s -> + let lib_name, deprecated_lib = + let old_public_name = Deprecated_library_name.old_public_name s in + Found_or_redirect.deprecated_library_name + old_public_name + s.new_public_name + in + None, lib_name, deprecated_lib + | Library (conf : Library.t) -> + let info = + let expander = Expander0.get ~dir in + Library.to_lib_info conf ~expander ~dir ~lib_config |> Lib_info.of_local + and lib_id = Library.to_lib_id ~src_dir conf in + Some lib_id, Library.best_name conf, Found_or_redirect.found info in - Library.best_name conf, Found_or_redirect.found info) - |> Lib_name.Map.of_list_reducei ~f:(fun name (v1 : Found_or_redirect.t) v2 -> - let res = - match v1, v2 with - | Found info1, Found info2 -> Error (Lib_info.loc info1, Lib_info.loc info2) - | Found info, Redirect (loc, _) | Redirect (loc, _), Found info -> - Error (loc, Lib_info.loc info) - | Redirect (loc1, lib1), Redirect (loc2, lib2) -> - if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2) - in - match res with - | Ok x -> x - | Error (loc1, loc2) -> - let main_message = - Pp.textf "Library %s is defined twice:" (Lib_name.to_string name) + let libname_conflict_map = + Lib_name.Map.update libname_conflict_map name ~f:(function + | None -> Some r2 + | Some (r1 : Found_or_redirect.t) -> + let res = + match r1, r2 with + | Found _, Found _ + | Found _, Redirect _ + | Redirect _, Found _ + | Redirect _, Redirect _ -> Ok r1 + | Found info, Deprecated_library_name (loc, _) + | Deprecated_library_name (loc, _), Found info -> + Error (loc, Lib_info.loc info) + | ( Deprecated_library_name (loc2, lib2) + , Redirect { loc = loc1; to_ = lib1; _ } ) + | ( Redirect { loc = loc1; to_ = lib1; _ } + , Deprecated_library_name (loc2, lib2) ) + | ( Deprecated_library_name (loc1, lib1) + , Deprecated_library_name (loc2, lib2) ) -> + if Lib_name.equal lib1 lib2 then Ok r1 else Error (loc1, loc2) + in + (match res with + | Ok x -> Some x + | Error (loc1, loc2) -> + let main_message = + Pp.textf "Library %s is defined twice:" (Lib_name.to_string name) + in + let annots = + let main = User_message.make ~loc:loc2 [ main_message ] in + let related = + [ User_message.make ~loc:loc1 [ Pp.text "Already defined here" ] ] + in + User_message.Annots.singleton + Compound_user_error.annot + [ Compound_user_error.make ~main ~related ] + in + User_error.raise + ~annots + [ main_message + ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) + ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) + ])) in - let annots = - let main = User_message.make ~loc:loc2 [ main_message ] in - let related = - [ User_message.make ~loc:loc1 [ Pp.text "Already defined here" ] ] - in - User_message.Annots.singleton - Compound_user_error.annot - [ Compound_user_error.make ~main ~related ] + let by_name = + Lib_name.Map.update by_name name ~f:(function + | None -> Some [ r2 ] + | Some rest -> Some (r2 :: rest)) + and by_id = + match lib_id with + | None -> by_id + | Some lib_id -> Lib_id.Map.add_exn by_id (Local lib_id) r2 in - User_error.raise - ~annots - [ main_message - ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) - ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) - ]) + by_name, by_id, libname_conflict_map) in + let resolve name = + match Lib_name.Map.find by_name name with + | None | Some [] -> Memo.return [] + | Some [ fr ] -> resolve_found_or_redirect fr >>| List.singleton + | Some frs -> Memo.parallel_map frs ~f:resolve_found_or_redirect + and resolve_lib_id = resolve_lib_id by_id in Lib.DB.create () ~parent:(Some parent) - ~resolve:(fun name -> - Memo.return - @@ - match Lib_name.Map.find map name with - | None -> Lib.DB.Resolve_result.not_found - | Some (Redirect lib) -> Lib.DB.Resolve_result.redirect_in_the_same_db lib - | Some (Found lib) -> Lib.DB.Resolve_result.found lib) - ~all:(fun () -> Memo.return @@ Lib_name.Map.keys map) + ~resolve + ~resolve_lib_id + ~all:(fun () -> Lib_name.Map.keys by_name |> Memo.return) ~lib_config ~instrument_with ;; type redirect_to = - | Project of Dune_project.t + | Project of + { project : Dune_project.t + ; lib_id : Lib_id.Local.t + } | Name of (Loc.t * Lib_name.t) - let resolve t public_libs name : Lib.DB.Resolve_result.t = - match Lib_name.Map.find public_libs name with + let loc_of_redirect_to = function + | Project { lib_id; _ } -> Lib_id.Local.loc lib_id + | Name (loc, _) -> loc + ;; + + let resolve_redirect_to t rt = + match rt with + | Project { project; lib_id } -> + let scope = find_by_project (Fdecl.get t) project in + Lib.DB.Resolve_result.redirect scope.db (Local lib_id) + | Name name -> Lib.DB.Resolve_result.redirect_in_the_same_db name + ;; + + let resolve_lib_id t public_libs lib_id : Lib.DB.Resolve_result.t = + match Lib_id.Map.find public_libs lib_id with | None -> Lib.DB.Resolve_result.not_found - | Some (Project project) -> + | Some (Project { project; lib_id }) -> let scope = find_by_project (Fdecl.get t) project in - Lib.DB.Resolve_result.redirect scope.db (Loc.none, name) + Lib.DB.Resolve_result.redirect scope.db (Local lib_id) | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db name ;; (* Create a database from the public libraries defined in the stanzas *) let public_libs t ~installed_libs ~lib_config stanzas = - let public_libs = - match - List.filter_map stanzas ~f:(fun (stanza : Library_related_stanza.t) -> - match stanza with - | Library (_, { project; visibility = Public p; _ }) -> - Some (Public_lib.name p, Project project) - | Library _ | Library_redirect _ -> None - | Deprecated_library_name s -> - let old_name = Deprecated_library_name.old_public_name s in - Some (old_name, Name s.new_public_name)) - |> Lib_name.Map.of_list - with - | Ok x -> x - | Error (name, _, _) -> - (match - List.filter_map stanzas ~f:(fun stanza -> - let named p loc = Option.some_if (name = p) loc in - match stanza with - | Library (_, { buildable = { loc; _ }; visibility = Public p; _ }) - | Deprecated_library_name { Library_redirect.loc; old_name = p, _; _ } -> - named (Public_lib.name p) loc - | _ -> None) - with - | [] | [ _ ] -> assert false - | loc1 :: loc2 :: _ -> - let main_message = - Pp.textf "Public library %s is defined twice:" (Lib_name.to_string name) - in - let annots = - let main = User_message.make ~loc:loc2 [ main_message ] in - let related = - [ User_message.make ~loc:loc1 [ Pp.text "Already defined here" ] ] - in - User_message.Annots.singleton - Compound_user_error.annot - [ Compound_user_error.make ~main ~related ] - in - User_error.raise - ~annots - ~loc:loc2 - [ Pp.textf "Public library %s is defined twice:" (Lib_name.to_string name) - ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) - ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) - ]) + let by_name, by_id = + List.fold_left + stanzas + ~init:(Lib_name.Map.empty, Lib_id.Map.empty) + ~f: + (fun + (by_name, by_id) ((dir, stanza) : Path.Build.t * Library_related_stanza.t) -> + let candidate = + match stanza with + | Library ({ project; visibility = Public p; _ } as conf) -> + let lib_id = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Library.to_lib_id ~src_dir conf + in + Some (Public_lib.name p, Project { project; lib_id }, Some lib_id) + | Library _ | Library_redirect _ -> None + | Deprecated_library_name s -> + Some + (Deprecated_library_name.old_public_name s, Name s.new_public_name, None) + in + match candidate with + | None -> by_name, by_id + | Some (public_name, r2, lib_id2) -> + let by_name = + Lib_name.Map.update by_name public_name ~f:(function + | None -> Some r2 + | Some r1 -> + let loc1 = loc_of_redirect_to r1 + and loc2 = loc_of_redirect_to r2 in + let main_message = + Pp.textf + "Public library %s is defined twice:" + (Lib_name.to_string public_name) + in + let annots = + let main = User_message.make ~loc:loc2 [ main_message ] in + let related = + [ User_message.make ~loc:loc1 [ Pp.text "Already defined here" ] ] + in + User_message.Annots.singleton + Compound_user_error.annot + [ Compound_user_error.make ~main ~related ] + in + User_error.raise + ~annots + ~loc:loc2 + [ main_message + ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) + ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) + ]) + in + let by_id = + match lib_id2 with + | None -> by_id + | Some lib_id2 -> Lib_id.Map.add_exn by_id (Local lib_id2) r2 + in + by_name, by_id) + in + let resolve_lib_id lib_id = Memo.return (resolve_lib_id t by_id lib_id) in + let resolve name = + Memo.return + (match Lib_name.Map.find by_name name with + | None -> [] + | Some rt -> [ resolve_redirect_to t rt ]) in - let resolve lib = Memo.return (resolve t public_libs lib) in Lib.DB.create ~parent:(Some installed_libs) ~resolve - ~all:(fun () -> Lib_name.Map.keys public_libs |> Memo.return) + ~resolve_lib_id + ~all:(fun () -> Lib_name.Map.keys by_name |> Memo.return) ~lib_config () ;; @@ -195,14 +318,14 @@ module DB = struct coq_stanzas = let stanzas_by_project_dir = - List.map stanzas ~f:(fun (stanza : Library_related_stanza.t) -> + List.map stanzas ~f:(fun (dir, stanza) -> let project = - match stanza with - | Library (_, lib) -> lib.project + match (stanza : Library_related_stanza.t) with + | Library lib -> lib.project | Library_redirect x -> x.project | Deprecated_library_name x -> x.project in - Dune_project.root project, stanza) + Dune_project.root project, (dir, stanza)) |> Path.Source.Map.of_list_multi in let db_by_project_dir = @@ -260,17 +383,21 @@ module DB = struct let create_from_stanzas ~projects_by_root ~(context : Context_name.t) stanzas = let stanzas, coq_stanzas = + let build_dir = Context_name.build_dir context in Dune_file.fold_static_stanzas stanzas ~init:([], []) ~f:(fun dune_file stanza (acc, coq_acc) -> - let build_dir = Context_name.build_dir context in match Stanza.repr stanza with | Library.T lib -> let ctx_dir = Path.Build.append_source build_dir (Dune_file.dir dune_file) in - Library_related_stanza.Library (ctx_dir, lib) :: acc, coq_acc - | Deprecated_library_name.T d -> Deprecated_library_name d :: acc, coq_acc - | Library_redirect.Local.T d -> Library_redirect d :: acc, coq_acc + (ctx_dir, Library_related_stanza.Library lib) :: acc, coq_acc + | Deprecated_library_name.T d -> + let ctx_dir = Path.Build.append_source build_dir (Dune_file.dir dune_file) in + (ctx_dir, Deprecated_library_name d) :: acc, coq_acc + | Library_redirect.Local.T d -> + let ctx_dir = Path.Build.append_source build_dir (Dune_file.dir dune_file) in + (ctx_dir, Library_redirect d) :: acc, coq_acc | Coq_stanza.Theory.T coq_lib -> let ctx_dir = Path.Build.append_source build_dir (Dune_file.dir dune_file) in acc, (ctx_dir, coq_lib) :: coq_acc @@ -332,11 +459,10 @@ module DB = struct match Stanza.repr stanza with | Library.T ({ visibility = Private (Some pkg); _ } as lib) -> let+ lib = - let* scope = - find_by_dir (Path.Build.append_source build_dir (Dune_file.dir d)) - in + let src_dir = Dune_file.dir d in + let* scope = find_by_dir (Path.Build.append_source build_dir src_dir) in let db = libs scope in - Lib.DB.find db (Library.best_name lib) + Lib.DB.find_lib_id db (Local (Library.to_lib_id ~src_dir lib)) in (match lib with | None -> acc @@ -346,14 +472,12 @@ module DB = struct | Library.T { visibility = Public pub; _ } -> let+ lib = Lib.DB.find public_libs (Public_lib.name pub) in (match lib with - | None -> - (* Skip hidden or unavailable libraries. TODO we should assert - that the library name is always found somehow *) - acc + | None -> acc | Some lib -> let package = Public_lib.package pub in let name = Package.name package in - (name, Lib_entry.Library (Lib.Local.of_lib_exn lib)) :: acc) + let local_lib = Lib.Local.of_lib_exn lib in + (name, Lib_entry.Library local_lib) :: acc) | Deprecated_library_name.T ({ old_name = old_public_name, _; _ } as d) -> let package = Public_lib.package old_public_name in let name = Package.name package in diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index 2fb0a2750ba..71ad669e6a5 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -403,6 +403,12 @@ let main_module_name t : Lib_info.Main_module_name.t = This (Some (Module_name.of_local_lib_name t.name)) ;; +let to_lib_id ~src_dir t = + let loc, _ = t.name + and enabled_if = t.enabled_if in + Lib_id.Local.make ~loc ~src_dir ~enabled_if (Lib_name.of_local t.name) +;; + let to_lib_info conf ~expander @@ -476,6 +482,10 @@ let to_lib_info in let main_module_name = main_module_name conf in let name = best_name conf in + let lib_id = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Lib_id.Local (to_lib_id ~src_dir conf) + in let enabled = let+ enabled_if_result = let* expander = expander in @@ -537,6 +547,7 @@ let to_lib_info ~loc ~path_kind:Local ~name + ~lib_id ~kind ~status ~src_dir diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index 37865390ebe..1923ef0fa17 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -76,6 +76,7 @@ val is_virtual : t -> bool val is_impl : t -> bool val obj_dir : dir:Path.Build.t -> t -> Path.Build.t Obj_dir.t val main_module_name : t -> Lib_info.Main_module_name.t +val to_lib_id : src_dir:Path.Source.t -> t -> Lib_id.Local.t val to_lib_info : t diff --git a/src/dune_rules/stanzas/library_redirect.ml b/src/dune_rules/stanzas/library_redirect.ml index 61681e91359..eaea020df6f 100644 --- a/src/dune_rules/stanzas/library_redirect.ml +++ b/src/dune_rules/stanzas/library_redirect.ml @@ -8,7 +8,12 @@ type 'old_name t = } module Local = struct - type nonrec t = (Loc.t * Lib_name.Local.t) t + type info = + { lib_name : Loc.t * Lib_name.Local.t + ; enabled : Blang.t + } + + type nonrec t = info t include Stanza.Make (struct type nonrec t = t @@ -17,7 +22,12 @@ module Local = struct end) let for_lib (lib : Library.t) ~new_public_name ~loc : t = - { loc; new_public_name; old_name = lib.name; project = lib.project } + let old_name = + let lib_name = lib.name + and enabled = lib.enabled_if in + { lib_name; enabled } + in + { loc; new_public_name; old_name; project = lib.project } ;; let of_private_lib (lib : Library.t) : t option = @@ -43,4 +53,10 @@ module Local = struct let loc = fst public_name in Some (for_lib lib ~loc ~new_public_name:public_name)) ;; + + let to_lib_id ~src_dir t = + let loc = t.loc + and enabled_if = t.old_name.enabled in + Lib_id.Local.make ~loc ~src_dir ~enabled_if (Lib_name.of_local t.old_name.lib_name) + ;; end diff --git a/src/dune_rules/stanzas/library_redirect.mli b/src/dune_rules/stanzas/library_redirect.mli index 4bc1a9adf34..3f40b004246 100644 --- a/src/dune_rules/stanzas/library_redirect.mli +++ b/src/dune_rules/stanzas/library_redirect.mli @@ -20,10 +20,16 @@ type 'old_name t = } module Local : sig - type nonrec t = (Loc.t * Lib_name.Local.t) t + type info = + { lib_name : Loc.t * Lib_name.Local.t + ; enabled : Blang.t + } + + type nonrec t = info t include Stanza.S with type t := t val of_private_lib : Library.t -> t option val of_lib : Library.t -> t option + val to_lib_id : src_dir:Path.Source.t -> t -> Lib_id.Local.t end diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index f6f4011c0b6..f6fe6c618aa 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -115,7 +115,8 @@ let impl sctx ~(lib : Library.t) ~scope = Staged.unstage (Preprocessing.pped_modules_map preprocess ocaml.version) in Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library name) + >>| Ml_sources.modules + ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) >>= Modules.map_user_written ~f:(fun m -> Memo.return (pp_spec m)) in let+ foreign_objects = diff --git a/test/blackbox-tests/test-cases/deprecated-library-name/features.t b/test/blackbox-tests/test-cases/deprecated-library-name/features.t index f630742b248..5ce45c8c044 100644 --- a/test/blackbox-tests/test-cases/deprecated-library-name/features.t +++ b/test/blackbox-tests/test-cases/deprecated-library-name/features.t @@ -248,8 +248,8 @@ We check that there is an error when there is an actual ambiguity: $ (cd d && dune build --root . @all) Error: Library top2 is defined twice: - - dune:13 - dune:5 + - dune:13 [1] Another case of ambiguity: diff --git a/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t b/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t index 17f04d546ce..d0039fe4ee0 100644 --- a/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t +++ b/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t @@ -28,11 +28,7 @@ in the same dune file > let x = "foo" > EOF - $ dune build --display=short - Error: Library foo is defined twice: - - dune:4 - - dune:1 - [1] + $ dune build For public libraries @@ -48,7 +44,17 @@ For public libraries > EOF $ dune build - Error: Library foo is defined twice: - - dune:7 - - dune:3 - [1] + +Mixing public and private libraries + + $ cat > dune << EOF + > (library + > (name foo) + > (enabled_if (= %{context_name} "default"))) + > (library + > (name foo) + > (public_name baz.foo) + > (enabled_if (= %{context_name} "alt-context"))) + > EOF + + $ dune build diff --git a/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision.t b/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision.t index 258f7c86cbd..1aa17eff19d 100644 --- a/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision.t +++ b/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision.t @@ -37,10 +37,6 @@ For private libraries > EOF $ dune build - Error: Library foo is defined twice: - - a/dune:1 - - b/dune:1 - [1] For public libraries @@ -59,7 +55,20 @@ For public libraries > EOF $ dune build - Error: Library foo is defined twice: - - a/dune:3 - - b/dune:3 - [1] + +Mixing public and private libraries + + $ cat > a/dune << EOF + > (library + > (name foo) + > (enabled_if (= %{context_name} "default"))) + > EOF + + $ cat > b/dune << EOF + > (library + > (name foo) + > (public_name baz.foo) + > (enabled_if (= %{context_name} "alt-context"))) + > EOF + + $ dune build diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t index 3b9a80d7ae2..9c7391ac9d9 100644 --- a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t @@ -15,9 +15,10 @@ the same folder. Without any consumers of the libraries $ dune build - Error: Library foo is defined twice: - - dune:3 - - dune:1 + File "dune", line 3, characters 0-21: + 3 | (library + 4 | (name foo)) + Error: Library "foo" appears for the second time in this directory [1] With some consumer of the library @@ -37,7 +38,8 @@ With some consumer of the library > EOF $ dune build - Error: Library foo is defined twice: - - dune:3 - - dune:1 + File "dune", line 3, characters 0-21: + 3 | (library + 4 | (name foo)) + Error: Library "foo" appears for the second time in this directory [1] diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t index 4776da8c0c2..b91c09b44c9 100644 --- a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t @@ -17,14 +17,9 @@ different folders. > (name foo)) > EOF -Without any consumers of the libraries +Without any consumers of the libraries (both are built in separate folders) - $ dune build - Error: Library foo is defined twice: - - a/dune:1 - - b/dune:1 - -> required by alias default - [1] + $ dune build a/foo.cma b/foo.cma With some consumer of the library @@ -39,7 +34,9 @@ With some consumer of the library > EOF $ dune build - Error: Library foo is defined twice: - - a/dune:1 - - b/dune:1 + File "a/dune", line 1, characters 0-21: + 1 | (library + 2 | (name foo)) + Error: Library with name "foo" is already defined in b/dune:1. Either change + one of the names, or enable them conditionally using the 'enabled_if' field. [1] diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t index d29e077bd1b..b9357c65c88 100644 --- a/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t @@ -19,9 +19,11 @@ the same folder. Without any consumers of the libraries $ dune build - Error: Library foo is defined twice: - - dune:6 - - dune:3 + File "dune", line 4, characters 0-44: + 4 | (library + 5 | (name foo) + 6 | (public_name baz.foo)) + Error: Library "foo" appears for the second time in this directory [1] With some consumer @@ -43,7 +45,9 @@ With some consumer > EOF $ dune build - Error: Library foo is defined twice: - - dune:6 - - dune:3 + File "dune", line 4, characters 0-44: + 4 | (library + 5 | (name foo) + 6 | (public_name baz.foo)) + Error: Library "foo" appears for the second time in this directory [1] diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-public-name.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-public-name.t new file mode 100644 index 00000000000..bb8174284f1 --- /dev/null +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-public-name.t @@ -0,0 +1,53 @@ +Public libraries using the same library name, in the same context, defined in +different folders. + + $ mkdir -p a b + + $ cat > dune-project << EOF + > (lang dune 3.13) + > (package (name bar) (allow_empty)) + > EOF + + $ cat > a/dune << EOF + > (library + > (name foo) + > (public_name bar.foo)) + > EOF + + $ cat > b/dune << EOF + > (library + > (name bar) + > (public_name bar.foo)) + > EOF + +Without any consumers of the libraries + + $ dune build + File "b/dune", line 2, characters 7-10: + 2 | (name bar) + ^^^ + Error: Public library bar.foo is defined twice: + - a/dune:2 + - b/dune:2 + [1] + +With some consumer + + $ cat > dune << EOF + > (executable + > (name main) + > (libraries foo)) + > EOF + + $ cat > main.ml < let () = Foo.x + > EOF + + $ dune build + File "b/dune", line 2, characters 7-10: + 2 | (name bar) + ^^^ + Error: Public library bar.foo is defined twice: + - a/dune:2 + - b/dune:2 + [1] diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-public.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public.t index 51150a9512b..7dd4a25aecd 100644 --- a/test/blackbox-tests/test-cases/lib-collision/lib-collision-public.t +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public.t @@ -24,10 +24,6 @@ different folders. Without any consumers of the libraries $ dune build - Error: Library foo is defined twice: - - a/dune:3 - - b/dune:3 - [1] With some consumer @@ -42,7 +38,10 @@ With some consumer > EOF $ dune build - Error: Library foo is defined twice: - - a/dune:3 - - b/dune:3 + File "a/dune", line 1, characters 0-44: + 1 | (library + 2 | (name foo) + 3 | (public_name bar.foo)) + Error: Library with name "foo" is already defined in b/dune:1. Either change + one of the names, or enable them conditionally using the 'enabled_if' field. [1]