From a712bd8ab2e4f9abeec0ab549ded8320a373c898 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Fri, 1 Mar 2024 10:39:07 +0000 Subject: [PATCH 01/38] feat: support libraries with the same name in multiple contexts MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri Signed-off-by: Antonio Nuno Monteiro --- bin/describe/describe_workspace.ml | 3 +- src/dune_rules/dir_contents.ml | 18 +- src/dune_rules/dune_package.ml | 23 +- src/dune_rules/dune_package.mli | 3 +- src/dune_rules/expander.ml | 4 +- src/dune_rules/findlib.ml | 17 +- src/dune_rules/gen_meta.ml | 2 +- src/dune_rules/gen_rules.ml | 5 +- src/dune_rules/install_rules.ml | 39 +- src/dune_rules/lib.ml | 286 +++++++++--- src/dune_rules/lib.mli | 27 +- src/dune_rules/lib_info.ml | 51 +++ src/dune_rules/lib_info.mli | 17 + src/dune_rules/lib_rules.ml | 9 +- src/dune_rules/ml_sources.ml | 69 ++- src/dune_rules/ml_sources.mli | 2 +- src/dune_rules/odoc.ml | 8 +- src/dune_rules/odoc_new.ml | 5 +- src/dune_rules/scope.ml | 420 ++++++++++++------ src/dune_rules/scope.mli | 2 +- .../stanzas/deprecated_library_name.ml | 8 + .../stanzas/deprecated_library_name.mli | 1 + src/dune_rules/stanzas/library.ml | 14 + src/dune_rules/stanzas/library.mli | 1 + src/dune_rules/stanzas/library_redirect.ml | 14 +- src/dune_rules/stanzas/library_redirect.mli | 7 +- src/dune_rules/virtual_rules.ml | 3 +- .../deprecated-library-name/features.t | 2 +- .../eif-library-name-collision-same-folder.t | 32 +- .../enabled_if/eif-library-name-collision.t | 25 +- .../lib-collision-private-same-folder.t | 14 +- .../lib-collision/lib-collision-private.t | 30 +- .../lib-collision-public-same-folder.t | 18 +- .../lib-collision-public-same-public-name.t | 47 ++ .../lib-collision/lib-collision-public.t | 14 +- 35 files changed, 935 insertions(+), 305 deletions(-) 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..b0ea0e8fcf9 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -449,9 +449,10 @@ module Crawl = struct | true -> (* XXX why do we have a second object directory? *) let* modules_, obj_dir_ = + let sentinel = Lib.sentinel lib in 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 sentinel) in let* pp_map = let+ version = diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index f01b7ee6d23..f0f76227eca 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -451,13 +451,19 @@ end include Load let modules_of_local_lib sctx lib = - let info = Lib.Local.info lib in - let* t = - let dir = Lib_info.src_dir info in - get sctx ~dir + let+ sources = + let* t = + let info = Lib.Local.info lib in + let dir = Lib_info.src_dir info in + get sctx ~dir + in + ocaml t + in + let sentinel = + let lib = Lib.Local.to_lib lib in + Lib.sentinel lib in - let name = Lib_info.name info in - ocaml t >>| Ml_sources.modules ~for_:(Library name) + Ml_sources.modules sources ~for_:(Library sentinel) ;; let modules_of_lib sctx lib = diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 8b401f3ecae..c680fa260f3 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -231,6 +231,9 @@ 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 sentinel = + Lib_info.Sentinel.external_ ~loc ~src_dir ~enabled_if:Blang.true_ name + in let enabled = Memo.return Lib_info.Enabled_status.Normal in let status = match Lib_name.analyze name with @@ -255,6 +258,7 @@ module Lib = struct ~path_kind:External ~loc ~name + ~sentinel ~kind ~status ~src_dir @@ -361,12 +365,12 @@ end module Entry = struct type t = | Library of Lib.t - | Deprecated_library_name of Deprecated_library_name.t + | Deprecated_library_name of Path.t * Deprecated_library_name.t | Hidden_library of Lib.t let name = function | Library lib | Hidden_library lib -> Lib_info.name (Lib.info lib) - | Deprecated_library_name d -> d.old_public_name + | Deprecated_library_name (_, d) -> d.old_public_name ;; let version = function @@ -376,7 +380,14 @@ module Entry = struct let loc = function | Library lib | Hidden_library lib -> Lib_info.loc (Lib.info lib) - | Deprecated_library_name d -> d.loc + | Deprecated_library_name (_, d) -> d.loc + ;; + + let sentinel = function + | Library lib | Hidden_library lib -> + let info = Lib.info lib in + Lib_info.sentinel info + | Deprecated_library_name _ -> assert false ;; let cstrs ~lang ~dir = @@ -386,7 +397,7 @@ module Entry = struct Library lib ) ; ( "deprecated_library_name" , let+ x = Deprecated_library_name.decode in - Deprecated_library_name x ) + Deprecated_library_name (dir, x) ) ] ;; @@ -394,7 +405,7 @@ module Entry = struct let open Dyn in match x with | Library lib -> variant "Library" [ Lib.to_dyn lib ] - | Deprecated_library_name lib -> + | Deprecated_library_name (_, lib) -> variant "Deprecated_library_name" [ Deprecated_library_name.to_dyn lib ] | Hidden_library lib -> variant "Hidden_library" [ Lib.to_dyn lib ] ;; @@ -536,7 +547,7 @@ let encode ~encoding ~dune_version { entries; name; version; dir; sections; site match e with | Entry.Library lib -> list (Dune_lang.atom "library" :: Lib.encode lib ~package_root:dir ~stublibs) - | Deprecated_library_name d -> + | Deprecated_library_name (_, d) -> list (Dune_lang.atom "deprecated_library_name" :: Deprecated_library_name.encode d) | Hidden_library lib -> Code_error.raise diff --git a/src/dune_rules/dune_package.mli b/src/dune_rules/dune_package.mli index 85bcd34556f..bedbe09a4e4 100644 --- a/src/dune_rules/dune_package.mli +++ b/src/dune_rules/dune_package.mli @@ -42,7 +42,7 @@ end module Entry : sig type t = | Library of Lib.t - | Deprecated_library_name of Deprecated_library_name.t + | Deprecated_library_name of Path.t * Deprecated_library_name.t | Hidden_library of Lib.t (** Only for external libraries that: @@ -53,6 +53,7 @@ module Entry : sig Dune itself never produces hidden libraries. *) val name : t -> Lib_name.t + val sentinel : t -> Lib_info.Sentinel.t val version : t -> Package_version.t option val loc : t -> Loc.t val to_dyn : t Dyn.builder diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index ce37d2cd3ef..e0ffbce3b79 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -402,7 +402,7 @@ let expand_lib_variable t source ~lib ~file ~lib_exec ~lib_private = then Resolve.Memo.map p ~f:(fun _ -> assert false) else let open Resolve.Memo.O in - Lib.DB.available (Scope.libs scope) lib + Lib.DB.available_by_name (Scope.libs scope) lib |> Resolve.Memo.lift_memo >>= function | false -> @@ -653,7 +653,7 @@ let expand_pform_macro (let lib = Lib_name.parse_string_exn (Dune_lang.Template.Pform.loc source, s) in let open Memo.O in let* scope = t.scope in - let+ available = Lib.DB.available (Scope.libs scope) lib in + let+ available = Lib.DB.available_by_name (Scope.libs scope) lib in available |> string_of_bool |> string)) | Bin_available -> Need_full_expander diff --git a/src/dune_rules/findlib.ml b/src/dune_rules/findlib.ml index 88450ed7e9c..0b2001c1a86 100644 --- a/src/dune_rules/findlib.ml +++ b/src/dune_rules/findlib.ml @@ -23,10 +23,11 @@ end let builtin_for_dune : Dune_package.t = let entry = Dune_package.Entry.Deprecated_library_name - { loc = Loc.of_pos __POS__ - ; old_public_name = Lib_name.of_string "dune.configurator" - ; new_public_name = Lib_name.of_string "dune-configurator" - } + ( Path.external_ Path.External.initial_cwd + , { loc = Loc.of_pos __POS__ + ; old_public_name = Lib_name.of_string "dune.configurator" + ; new_public_name = Lib_name.of_string "dune-configurator" + } ) in { name = Opam_package.Name.of_string "dune" ; entries = Lib_name.Map.singleton (Dune_package.Entry.name entry) entry @@ -206,10 +207,16 @@ 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 sentinel = + let enabled_if = Blang.true_ in + Lib_info.Sentinel.external_ ~loc ~src_dir ~enabled_if name + in Lib_info.create ~loc ~path_kind:External - ~name:t.name + ~name + ~sentinel ~kind ~status ~src_dir diff --git a/src/dune_rules/gen_meta.ml b/src/dune_rules/gen_meta.ml index ad6bf39056c..764604905a5 100644 --- a/src/dune_rules/gen_meta.ml +++ b/src/dune_rules/gen_meta.ml @@ -163,7 +163,7 @@ let gen ~(package : Package.t) ~add_directory_entry entries = let+ pkgs = Memo.parallel_map entries ~f:(fun (e : Scope.DB.Lib_entry.t) -> match e with - | Library lib -> + | Library (_, lib) -> let info = Lib.Local.info lib in let pub_name = let name = Lib_info.name info in diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 978336d0ed2..727e2f147a6 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -111,7 +111,10 @@ 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 = + let sentinel = Library.to_sentinel ~src_dir lib in + Lib.DB.available (Scope.libs scope) sentinel + 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..a3ea562ebe1 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -85,10 +85,10 @@ end = struct >>| List.singleton ;; - let lib_files ~dir_contents ~dir ~lib_config lib = + let lib_files ~dir_contents ~dir ~lib_config ~sentinel 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 sentinel)) and+ foreign_archives = match Lib_info.virtual_ lib with | None -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) @@ -179,9 +179,13 @@ end = struct ~lib_config in let lib_name = Library.best_name lib in + let sentinel = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Library.to_sentinel ~src_dir 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 sentinel) and+ impl = Virtual_rules.impl sctx ~lib ~scope in Vimpl.impl_modules impl modules |> Modules.split_by_lib in @@ -305,7 +309,7 @@ end = struct if Module.kind m = Virtual then [] else common m |> set_dir m) in modules_vlib @ modules_impl - and+ lib_files = lib_files ~dir ~dir_contents ~lib_config info + and+ lib_files = lib_files ~dir ~dir_contents ~lib_config ~sentinel info and+ execs = lib_ppxs ctx ~scope ~lib and+ dll_files = dll_files ~modes:ocaml ~dynlink:lib.dynlink ~ctx info @@ -330,7 +334,7 @@ end = struct ] ;; - let keep_if expander ~scope stanza = + let keep_if ~expander ~scope ~dir stanza = let+ keep = match Stanza.repr stanza with | Library.T lib -> @@ -338,7 +342,12 @@ end = struct if enabled_if then if lib.optional - then Lib.DB.available (Scope.libs scope) (Library.best_name lib) + then ( + let sentinel = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Library.to_sentinel ~src_dir lib + in + Lib.DB.available (Scope.libs scope) sentinel) else Memo.return true else Memo.return false | Documentation.T _ -> Memo.return true @@ -447,7 +456,7 @@ end = struct ;; let stanza_to_entries ~package_db ~sctx ~dir ~scope ~expander stanza = - (let+ stanza = keep_if expander stanza ~scope in + (let+ stanza = keep_if ~expander ~scope ~dir stanza in let open Option.O in let* stanza = stanza in let+ package = Stanzas.stanza_package stanza in @@ -619,8 +628,8 @@ end = struct (Some ( old_public_name , Dune_package.Entry.Deprecated_library_name - { loc; old_public_name; new_public_name } )) - | Library lib -> + (Path.build pkg_root, { loc; old_public_name; new_public_name }) )) + | Library (sentinel, lib) -> let info = Lib.Local.info lib in let dir = Lib_info.src_dir info in let* dir_contents = Dir_contents.get sctx ~dir in @@ -652,7 +661,8 @@ 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 sentinel) 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 = @@ -732,6 +742,9 @@ end = struct acc >>> let dune_pkg = + let dir = + Path.build (Install.Context.lib_dir ~context:ctx.name ~package:name) + in let entries = match Package.Name.Map.find deprecated_dune_packages name with | None -> Lib_name.Map.empty @@ -753,13 +766,13 @@ end = struct acc old_public_name (Dune_package.Entry.Deprecated_library_name - { loc; old_public_name; new_public_name })) + (dir, { loc; old_public_name; new_public_name }))) in let sections = sections ctx.name [] pkg in { Dune_package.version = Package.version pkg ; name ; entries - ; dir = Path.build (Install.Context.lib_dir ~context:ctx.name ~package:name) + ; dir ; sections ; sites = Package.sites pkg ; files = [] @@ -800,7 +813,7 @@ end = struct let* () = Action_builder.return () in match List.find_map entries ~f:(function - | Library lib -> + | Library (_, lib) -> let info = Lib.Local.info lib in Option.some_if (Option.is_some (Lib_info.virtual_ info)) lib | Deprecated_library_name _ -> None) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index ab1d7312d20..fdd15d83a32 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -132,6 +132,41 @@ module Error = struct ] ;; + let duplicated ~loc ~name_a ~name_b ~dir_a ~dir_b = + let different_folders, different_folders_text = + let different_folders = not (Path.equal dir_a dir_b) in + let different_folders_text = + if different_folders + then + Format.asprintf + " is defined in two folders (%s and %s)" + (Path.to_string_maybe_quoted dir_a) + (Path.to_string_maybe_quoted dir_b) + else "" + in + different_folders, different_folders_text + in + let different_name, different_name_text = + let different_name = not (Lib_name.equal name_a name_b) in + let different_name_text = + if different_name + then Format.asprintf " shares a name with library %S" (Lib_name.to_string name_a) + else "" + in + different_name, different_name_text + in + User_error.make + ~loc + [ Pp.textf + "Library with name %S%s%s%s. Either change one of the names, or enable them \ + conditionally using the 'enabled_if' field." + (Lib_name.to_string name_b) + different_folders_text + (if different_folders && different_name then " and" else "") + different_name_text + ] + ;; + (* diml: it is not very clear what a "default implementation cycle" is *) let default_implementation_cycle cycle = make @@ -317,6 +352,7 @@ module T = struct { info : Lib_info.external_ ; name : Lib_name.t ; unique_id : Id.t + ; sentinel : Lib_info.Sentinel.t ; re_exports : t list Resolve.t ; (* [requires] is contains all required libraries, including the ones mentioned in [re_exports]. *) @@ -396,10 +432,11 @@ end type db = { parent : db option - ; resolve : Lib_name.t -> resolve_result Memo.t + ; resolve_name : Lib_name.t -> resolve_result_with_multiple_results Memo.t + ; resolve_sentinel : Lib_info.Sentinel.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 + ; all : Lib_info.Sentinel.t list Memo.Lazy.t ; lib_config : Lib_config.t ; instrument_with : Lib_name.t list } @@ -411,10 +448,15 @@ 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_info.Sentinel.t + +and resolve_result_with_multiple_results = + | Resolve_result of resolve_result + | Multiple_results of resolve_result list let lib_config (t : lib) = t.lib_config let name t = t.name +let sentinel t = t.sentinel let info t = t.info let project t = t.project let implements t = Option.map ~f:Memo.return t.implements @@ -816,8 +858,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 available_internal : db -> Lib_name.t -> bool Memo.t + val resolve_sentinel : db -> Lib_info.Sentinel.t -> Status.t Memo.t + val available_internal : db -> Lib_info.Sentinel.t -> bool Memo.t + val available_by_name_internal : db -> Lib_name.t -> bool Memo.t val resolve_simple_deps : db @@ -1028,6 +1071,7 @@ end = struct let* package = Lib_info.package info in Package.Name.Map.find projects_by_package package in + let sentinel = Lib_info.sentinel info in let rec t = lazy (let open Resolve.O in @@ -1037,6 +1081,7 @@ end = struct { info ; name ; unique_id + ; sentinel ; requires ; ppx_runtime_deps ; pps @@ -1084,7 +1129,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 sentinel = Lib_info.sentinel info + and sentinel' = Lib_info.sentinel info' in + Lib_name.equal lib_name lib_name' && Lib_info.Sentinel.equal sentinel sentinel' + ;; + let hash (x, _, _) = Lib_name.hash x let to_dyn = Dyn.opaque end @@ -1116,7 +1166,92 @@ 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 sentinel = Lib_info.sentinel info in + resolve_sentinel db sentinel) + >>= 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', sentinel') -> resolve_sentinel db' sentinel' + | 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 + | Resolve_result r -> handle_resolve_result ~super db r + | Multiple_results candidates -> + let open Memo.O in + let+ libs = + Memo.List.filter_map candidates ~f:(function + | Ignore -> Memo.return (Some Status.Ignore) + | Redirect_in_the_same_db (_, name') -> find_internal db name' >>| Option.some + | Redirect (db', sentinel') -> resolve_sentinel db' sentinel' >>| 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 -> Memo.return None + | Hidden { lib = info; reason = hidden; path = _ } -> + resolve_hidden db ~info hidden >>| Option.some) + in + (match libs with + | [] -> assert false + | [ status ] -> status + | _ :: _ :: _ -> + List.fold_left libs ~init:Status.Not_found ~f:(fun acc status -> + match acc, status with + | Status.Found a, Status.Found b -> + (match Lib_info.Sentinel.equal a.sentinel b.sentinel with + | true -> acc + | false -> + let a = info a + and b = info b in + let loc = Lib_info.loc b + and dir_a = Lib_info.best_src_dir a + and dir_b = Lib_info.best_src_dir b + and name_a = + let sentinel = Lib_info.sentinel a in + Lib_info.Sentinel.name sentinel + and name_b = + let sentinel = Lib_info.sentinel b in + Lib_info.Sentinel.name sentinel + in + Status.Invalid (Error.duplicated ~loc ~name_a ~name_b ~dir_a ~dir_b)) + | Invalid _, _ -> acc + | (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _) + | (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib + | (Hidden _ | Ignore | Not_found), (Hidden _ | Ignore | Not_found | Invalid _) + -> 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 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,29 +1265,13 @@ end = struct | Hidden h -> Hidden.error h ~loc ~name >>| Option.some ;; - let resolve_name db name = + let resolve_sentinel db sentinel = 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_sentinel db sentinel in + db.resolve_sentinel sentinel >>= handle_resolve_result ~super db ;; - let available_internal db (name : Lib_name.t) = + let available_by_name_internal db (name : Lib_name.t) = let open Memo.O in find_internal db name >>| function @@ -1160,6 +1279,14 @@ end = struct | Not_found | Invalid _ | Hidden _ -> false ;; + let available_internal db (sentinel : Lib_info.Sentinel.t) = + let open Memo.O in + resolve_sentinel db sentinel + >>| 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 @@ -1279,7 +1406,7 @@ end = struct let+ select = Memo.List.find_map choices ~f:(fun { required; forbidden; file } -> Lib_name.Set.to_list forbidden - |> Memo.List.exists ~f:(available_internal db) + |> Memo.List.exists ~f:(available_by_name_internal db) >>= function | true -> Memo.return None | false -> @@ -1779,7 +1906,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_info.Sentinel.t let found f = Found f let not_found = Not_found @@ -1794,19 +1921,46 @@ 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 (_, sentinel) -> variant "Redirect" [ Lib_info.Sentinel.to_dyn sentinel ] | Redirect_in_the_same_db (_, name) -> variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ] ;; + + module With_multiple_results : sig + type resolve_result := t + + type t = resolve_result_with_multiple_results = + | Resolve_result of resolve_result + | Multiple_results of resolve_result list + + val to_dyn : t Dyn.builder + val resolve_result : resolve_result -> t + val multiple_results : resolve_result list -> t + end = struct + type t = resolve_result_with_multiple_results = + | Resolve_result of resolve_result + | Multiple_results of resolve_result list + + let resolve_result r = Resolve_result r + let multiple_results libs : t = Multiple_results libs + + let to_dyn t = + let open Dyn in + match t with + | Resolve_result r -> variant "Resolve_result" [ to_dyn r ] + | Multiple_results xs -> variant "Multiple_results" [ (Dyn.list to_dyn) xs ] + ;; + end end type t = db - let create ~parent ~resolve ~all ~lib_config ~instrument_with () = + let create ~parent ~resolve_name ~resolve_sentinel ~all ~lib_config ~instrument_with () = let rec t = lazy { parent - ; resolve + ; resolve_name + ; resolve_sentinel ; all = Memo.lazy_ all ; lib_config ; instrument_with @@ -1819,19 +1973,17 @@ 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 -> + let resolve_name name = + let open Memo.O in + Findlib.find findlib name + >>| function + | Ok (Library pkg) -> Resolve_result (Found (Dune_package.Lib.info pkg)) + | Ok (Deprecated_library_name (_, d)) -> + Resolve_result (Redirect_in_the_same_db (d.loc, d.new_public_name)) + | Ok (Hidden_library pkg) -> + Resolve_result (Hidden (Hidden.unsatisfied_exist_if pkg)) + | Error e -> + Resolve_result (match e with | Invalid_dune_package why -> Invalid why | Not_found when (not has_bigarray_library) && Lib_name.equal name bigarray @@ -1841,10 +1993,23 @@ 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_name + ~resolve_sentinel:(fun sentinel -> + let open Memo.O in + let name = Lib_info.Sentinel.name sentinel in + resolve_name name + >>| function + | Multiple_results _ -> assert false + | Resolve_result r -> r) ~all:(fun () -> let open Memo.O in - Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.name) + Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.sentinel) ;; let installed (context : Context.t) = @@ -1866,6 +2031,14 @@ module DB = struct | Ignore | Not_found | Invalid _ | Hidden _ -> None ;; + let find_sentinel t sentinel = + let open Memo.O in + Resolve_names.resolve_sentinel t sentinel + >>| 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 +2047,14 @@ module DB = struct | Ignore | Invalid _ | Not_found -> None ;; + let find_sentinel_even_when_hidden t sentinel = + let open Memo.O in + Resolve_names.resolve_sentinel t sentinel + >>| 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 @@ -1894,17 +2075,18 @@ module DB = struct | Some k -> Memo.return k ;; - let available t name = Resolve_names.available_internal t name + let available_by_name t name = Resolve_names.available_by_name_internal t name + let available t sentinel = Resolve_names.available_internal t sentinel - let get_compile_info t ~allow_overlaps name = + let get_compile_info t ~allow_overlaps sentinel = let open Memo.O in - find_even_when_hidden t name + find_sentinel_even_when_hidden t sentinel >>| 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 ] + [ "sentinel", Lib_info.Sentinel.to_dyn sentinel ] ;; let resolve_user_written_deps @@ -1998,7 +2180,7 @@ module DB = struct let open Memo.O in let* l = Memo.Lazy.force t.all - >>= Memo.parallel_map ~f:(find t) + >>= Memo.parallel_map ~f:(find_sentinel t) >>| List.filter_opt >>| Set.of_list in diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 6dbda11c7a3..322e10f79d9 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -11,6 +11,7 @@ val to_dyn : t -> Dyn.t or the [name] if not. *) val name : t -> Lib_name.t +val sentinel : t -> Lib_info.Sentinel.t val lib_config : t -> Lib_config.t val implements : t -> t Resolve.Memo.t option @@ -100,8 +101,20 @@ 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_info.Sentinel.t -> t val redirect_in_the_same_db : Loc.t * Lib_name.t -> t + + module With_multiple_results : sig + type resolve_result := t + + type t = private + | Resolve_result of resolve_result + | Multiple_results of resolve_result list + + val to_dyn : t Dyn.builder + val resolve_result : resolve_result -> t + val multiple_results : resolve_result list -> t + end end (** Create a new library database. [resolve] is used to resolve library names @@ -113,8 +126,9 @@ 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) - -> all:(unit -> Lib_name.t list Memo.t) + -> resolve_name:(Lib_name.t -> Resolve_result.With_multiple_results.t Memo.t) + -> resolve_sentinel:(Lib_info.Sentinel.t -> Resolve_result.t Memo.t) + -> all:(unit -> Lib_info.Sentinel.t list Memo.t) -> lib_config:Lib_config.t -> instrument_with:Lib_name.t list -> unit @@ -122,14 +136,17 @@ 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 available : t -> Lib_name.t -> bool Memo.t + val find_sentinel : t -> Lib_info.Sentinel.t -> lib option Memo.t + val find_sentinel_even_when_hidden : t -> Lib_info.Sentinel.t -> lib option Memo.t + val available : t -> Lib_info.Sentinel.t -> bool Memo.t + val available_by_name : t -> Lib_name.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_info.Sentinel.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_info.ml b/src/dune_rules/lib_info.ml index 82599470f45..f7309cb0f25 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -290,6 +290,51 @@ module File_deps = struct ;; end +module Sentinel = struct + module T = struct + type t = + { name : Lib_name.t + ; loc : Loc.t + ; src_dir : Path.t + ; enabled_if : Blang.t + } + + let compare a b = + match Lib_name.compare a.name b.name with + | Eq -> + (match Path.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.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 external_ ~loc ~src_dir ~enabled_if name = { name; loc; enabled_if; src_dir } + + let make ~loc ~src_dir ~enabled_if name = + let src_dir = Path.source src_dir in + { name; loc; enabled_if; src_dir } + ;; + + let name { name; _ } = name + let loc { loc; _ } = loc +end + (** {1 Lib_info_invariants} Many of the fields here are optional and are "entangled" in the sense that @@ -300,6 +345,7 @@ end type 'path t = { loc : Loc.t ; name : Lib_name.t + ; sentinel : Sentinel.t ; kind : Lib_kind.t ; status : Status.t ; src_dir : 'path @@ -338,6 +384,7 @@ type 'path t = } let name t = t.name +let sentinel t = t.sentinel let version t = t.version let dune_version t = t.dune_version let loc t = t.loc @@ -391,6 +438,7 @@ let create ~loc ~path_kind ~name + ~sentinel ~kind ~status ~src_dir @@ -428,6 +476,7 @@ let create = { loc ; name + ; sentinel ; kind ; status ; src_dir @@ -520,6 +569,7 @@ let to_dyn { loc ; path_kind = _ ; name + ; sentinel ; kind ; status ; src_dir @@ -561,6 +611,7 @@ let to_dyn record [ "loc", Loc.to_dyn_hum loc ; "name", Lib_name.to_dyn name + ; "sentinel", Sentinel.to_dyn sentinel ; "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..b59805598bd 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -86,9 +86,25 @@ module Main_module_name : sig type t = Module_name.t option Inherited.t end +(** What's the subset of fields that uniquely identifies this stanza? *) +module Sentinel : 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 external_ : loc:Loc.t -> src_dir:Path.t -> enabled_if:Blang.t -> Lib_name.t -> t + val name : t -> Lib_name.t + val loc : t -> Loc.t + val to_dyn : t -> Dyn.t +end + type 'path t val name : _ t -> Lib_name.t +val sentinel : _ t -> Sentinel.t val loc : _ t -> Loc.t (** The [*.cma] and [*.cmxa] files for OCaml libraries. Libraries built by Dune @@ -191,6 +207,7 @@ val create : loc:Loc.t -> path_kind:'a path -> name:Lib_name.t + -> sentinel:Sentinel.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..fb3a51938bf 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -644,17 +644,20 @@ let library_rules let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = let buildable = lib.buildable in + let sentinel = + let src_dir = Path.Build.drop_build_context_exn dir in + Library.to_sentinel ~src_dir lib + in let* local_lib, compile_info = Lib.DB.get_compile_info (Scope.libs scope) - (Library.best_name lib) + sentinel ~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)) + Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library sentinel) 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..c903b69c8aa 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_info.Sentinel.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_info.Sentinel.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,33 @@ 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_info.Sentinel.Map.empty) + ~f:(fun (lib_set, acc) part -> + let name = Library.best_name part.stanza in + match Lib_name.Set.mem lib_set name with + | true -> + 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) + ] + | false -> + let acc = + let sentinel = + let src_dir = + Path.drop_optional_build_context_src_exn (Path.build part.dir) + in + Library.to_sentinel ~src_dir part.stanza + in + Lib_info.Sentinel.Map.add_exn acc sentinel (part.modules, part.obj_dir) + in + Lib_name.Set.add lib_set name, acc) + in + libraries in let executables = match @@ -221,14 +237,14 @@ let modules_of_files ~path ~dialects ~dir ~files = ;; type for_ = - | Library of Lib_name.t + | Library of Lib_info.Sentinel.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_info.Sentinel.to_dyn n ] | Exe { first_exe } -> variant "Exe" [ record [ "first_exe", string first_exe ] ] | Melange { target } -> variant "Melange" [ record [ "target", string target ] ] ;; @@ -236,7 +252,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 sentinel -> Lib_info.Sentinel.Map.find t.modules.libraries sentinel | Exe { first_exe } -> String.Map.find t.modules.executables first_exe | Melange { target } -> String.Map.find t.modules.melange_emits target with @@ -244,7 +260,9 @@ 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_info.Sentinel.Map.keys t.modules.libraries + |> Dyn.list Lib_info.Sentinel.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 +282,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.sentinel vlib)) in let existing_virtual_modules = Modules_group.virtual_module_names modules in let allow_new_public_modules = @@ -314,8 +332,11 @@ 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 sentinel = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Library.to_sentinel ~src_dir lib + in + Lib.DB.find_sentinel_even_when_hidden libs sentinel (* can't happen because this library is defined using the current stanza *) >>| Option.value_exn @@ -422,7 +443,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 +479,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 +501,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..437f3ac18b4 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_info.Sentinel.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..cedc971d793 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -583,7 +583,7 @@ let libs_of_pkg ctx ~pkg = List.filter_map entries ~f:(fun (entry : Scope.DB.Lib_entry.t) -> match entry with | Deprecated_library_name _ -> None - | Library lib -> + | Library (_, lib) -> (match Lib.Local.to_lib lib |> Lib.info |> Lib_info.implements with | None -> Some lib | Some _ -> None)) @@ -951,7 +951,11 @@ 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 sentinel = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Library.to_sentinel ~src_dir l + in + Lib.DB.find_sentinel_even_when_hidden (Scope.libs scope) sentinel >>| 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..63961aedded 100644 --- a/src/dune_rules/odoc_new.ml +++ b/src/dune_rules/odoc_new.ml @@ -265,8 +265,8 @@ let libs_maps_def = | Some location -> 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 + let sentinel = Lib_info.sentinel info in + Lib.DB.find_sentinel db sentinel >>| (function | None -> maps | Some lib -> @@ -283,6 +283,7 @@ let libs_maps_def = maps.loc_of_lib in let loc_of_pkg = + let pkg = Lib_info.package info in match pkg with | None -> maps.loc_of_pkg | Some pkg_name -> diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index a29d814606e..b901074db0e 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -26,158 +26,320 @@ 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.Lazy.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.Lazy.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.Lazy.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 end + let resolve_name = + let module Resolve_result = Lib.DB.Resolve_result in + let module With_multiple_results = Resolve_result.With_multiple_results in + fun ~resolve_sentinel id_map name -> + match + Lib_name.Map.find id_map name |> Option.map ~f:Lib_info.Sentinel.Set.to_list + with + | None -> + Memo.return (With_multiple_results.resolve_result Resolve_result.not_found) + | Some [] -> assert false + | Some [ sentinel ] -> + resolve_sentinel sentinel >>| With_multiple_results.resolve_result + | Some xs -> + Memo.List.map ~f:resolve_sentinel xs >>| With_multiple_results.multiple_results + ;; + module Library_related_stanza = struct type t = | Library of Path.Build.t * Library.t - | Library_redirect of Library_redirect.Local.t - | Deprecated_library_name of Deprecated_library_name.t + | Library_redirect of Path.Build.t * Library_redirect.Local.t + | Deprecated_library_name of Path.Build.t * Deprecated_library_name.t end 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 - 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) - 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" ] ] + let sentinel_map, id_map = + let libs = + List.map stanzas ~f:(fun stanza -> + match (stanza : Library_related_stanza.t) with + | Library_redirect (dir, s) -> + let old_public_name = Lib_name.of_local s.old_name.lib_name in + let enabled = + Memo.lazy_ (fun () -> + let open Memo.O in + let* expander = Expander0.get ~dir in + let+ enabled = Expander0.eval_blang expander s.old_name.enabled in + Toggle.of_bool enabled) + in + let lib_name, redirect = + Found_or_redirect.redirect ~enabled old_public_name s.new_public_name + in + let sentinel = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Lib_info.Sentinel.make + ~loc:s.loc + ~src_dir + ~enabled_if:s.old_name.enabled + lib_name + in + lib_name, (sentinel, redirect) + | Deprecated_library_name (dir, s) -> + let old_public_name = Deprecated_library_name.old_public_name s in + let lib_name, deprecated_lib = + Found_or_redirect.deprecated_library_name old_public_name s.new_public_name 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) - ]) + let sentinel = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Deprecated_library_name.to_sentinel ~src_dir s + in + lib_name, (sentinel, deprecated_lib) + | 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 + in + let stanza_id = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Library.to_sentinel ~src_dir conf + in + Library.best_name conf, (stanza_id, Found_or_redirect.found info)) + in + let _, id_map, sentinel_map = + List.fold_left + libs + ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Sentinel.Map.empty) + ~f: + (fun + (libname_map, id_map, sentinel_map) + (name, ((sentinel, r2) : Lib_info.Sentinel.t * Found_or_redirect.t)) + -> + let libname_map' = + Lib_name.Map.update libname_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 id_map' = + let id_map : Lib_info.Sentinel.Set.t Lib_name.Map.t = id_map in + Lib_name.Map.update id_map name ~f:(fun sentinels -> + match + Option.map sentinels ~f:(fun sentinels -> + Lib_info.Sentinel.Set.add sentinels sentinel) + with + | None -> Some (Lib_info.Sentinel.Set.singleton sentinel) + | Some s -> Some s) + in + let sentinel_map' = Lib_info.Sentinel.Map.add_exn sentinel_map sentinel r2 in + libname_map', id_map', sentinel_map') + in + sentinel_map, id_map + in + let resolve_sentinel library_id = + match Lib_info.Sentinel.Map.find sentinel_map library_id with + | None -> Memo.return Lib.DB.Resolve_result.not_found + | Some (Redirect { loc; to_; enabled; _ }) -> + let+ enabled = + let+ toggle = Memo.Lazy.force 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 + | Some (Found lib) -> Memo.return (Lib.DB.Resolve_result.found lib) + | Some (Deprecated_library_name lib) -> + Memo.return (Lib.DB.Resolve_result.redirect_in_the_same_db lib) in + let resolve_name = resolve_name ~resolve_sentinel id_map 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_name + ~resolve_sentinel + ~all:(fun () -> Lib_info.Sentinel.Map.keys sentinel_map |> Memo.return) ~lib_config ~instrument_with ;; type redirect_to = - | Project of Dune_project.t + | Project of + { project : Dune_project.t + ; sentinel : Lib_info.Sentinel.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 resolve t public_libs sentinel : Lib.DB.Resolve_result.t = + match Lib_info.Sentinel.Map.find public_libs sentinel with | None -> Lib.DB.Resolve_result.not_found - | Some (Project project) -> + | Some (Project { project; sentinel }) -> 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 sentinel | 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 public_libs, public_ids = + let _, public_ids, public_libs = + List.fold_left + stanzas + ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Sentinel.Map.empty) + ~f: + (fun + (libname_map, id_map, sentinel_map) (stanza : Library_related_stanza.t) -> + let candidate = + match stanza with + | Library (dir, ({ project; visibility = Public p; _ } as conf)) -> + let sentinel = + let src_dir = + Path.drop_optional_build_context_src_exn (Path.build dir) + in + Library.to_sentinel ~src_dir conf + in + Some (Public_lib.name p, Project { project; sentinel }, sentinel) + | Library _ | Library_redirect _ -> None + | Deprecated_library_name (dir, s) -> + let sentinel = + let src_dir = + Path.drop_optional_build_context_src_exn (Path.build dir) + in + Deprecated_library_name.to_sentinel ~src_dir s + in + Some + ( Deprecated_library_name.old_public_name s + , Name s.new_public_name + , sentinel ) + in + match candidate with + | None -> libname_map, id_map, sentinel_map + | Some (public_name, r2, sentinel) -> + let libname_map' = + Lib_name.Map.update libname_map public_name ~f:(function + | None -> Some (sentinel, r2) + | Some (sent1, _r1) -> + (match (Lib_info.Sentinel.equal sent1) sentinel with + | false -> Some (sentinel, r2) + | true -> + let loc1 = Lib_info.Sentinel.loc sent1 + and loc2 = Lib_info.Sentinel.loc sentinel 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 id_map' = + let id_map : Lib_info.Sentinel.Set.t Lib_name.Map.t = id_map in + Lib_name.Map.update id_map public_name ~f:(fun sentinels -> + match + Option.map sentinels ~f:(fun sentinels -> + Lib_info.Sentinel.Set.add sentinels sentinel) + with + | None -> Some (Lib_info.Sentinel.Set.singleton sentinel) + | Some s -> Some s) + in + let sentinel_map' = + Lib_info.Sentinel.Map.add_exn sentinel_map sentinel r2 + in + libname_map', id_map', sentinel_map') + in + public_libs, public_ids in - let resolve lib = Memo.return (resolve t public_libs lib) in + let resolve_sentinel sentinel = Memo.return (resolve t public_libs sentinel) in + let resolve_name = resolve_name ~resolve_sentinel public_ids in Lib.DB.create ~parent:(Some installed_libs) - ~resolve - ~all:(fun () -> Lib_name.Map.keys public_libs |> Memo.return) + ~resolve_name + ~resolve_sentinel + ~all:(fun () -> Lib_info.Sentinel.Map.keys public_libs |> Memo.return) ~lib_config () ;; @@ -199,8 +361,8 @@ module DB = struct let project = match stanza with | Library (_, lib) -> lib.project - | Library_redirect x -> x.project - | Deprecated_library_name x -> x.project + | Library_redirect (_, x) -> x.project + | Deprecated_library_name (_, x) -> x.project in Dune_project.root project, stanza) |> Path.Source.Map.of_list_multi @@ -269,8 +431,12 @@ module DB = struct | 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 + | Deprecated_library_name.T d -> + let ctx_dir = Path.Build.append_source build_dir (Dune_file.dir dune_file) in + Deprecated_library_name (ctx_dir, d) :: acc, coq_acc + | Library_redirect.Local.T d -> + let ctx_dir = Path.Build.append_source build_dir (Dune_file.dir dune_file) in + Library_redirect (ctx_dir, 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 @@ -315,11 +481,11 @@ module DB = struct module Lib_entry = struct type t = - | Library of Lib.Local.t + | Library of Lib_info.Sentinel.t * Lib.Local.t | Deprecated_library_name of Deprecated_library_name.t let name = function - | Library lib -> Lib.Local.to_lib lib |> Lib.name + | Library (_, lib) -> Lib.Local.to_lib lib |> Lib.name | Deprecated_library_name { old_name = old_public_name, _; _ } -> Public_lib.name old_public_name ;; @@ -331,29 +497,27 @@ module DB = struct Dune_file.Memo_fold.fold_static_stanzas stanzas ~init:[] ~f:(fun d stanza acc -> match Stanza.repr stanza with | Library.T ({ visibility = Private (Some pkg); _ } as lib) -> + let src_dir = Dune_file.dir d in + let sentinel = Library.to_sentinel ~src_dir lib in let+ lib = - let* scope = - find_by_dir (Path.Build.append_source build_dir (Dune_file.dir d)) - in - let db = libs scope in - Lib.DB.find db (Library.best_name lib) + let* scope = find_by_dir (Path.Build.append_source build_dir src_dir) in + Lib.DB.find_sentinel (libs scope) sentinel in (match lib with | None -> acc | Some lib -> let name = Package.name pkg in - (name, Lib_entry.Library (Lib.Local.of_lib_exn lib)) :: acc) + (name, Lib_entry.Library (sentinel, Lib.Local.of_lib_exn lib)) :: acc) | 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 + let sentinel = Lib.sentinel lib in + (name, Lib_entry.Library (sentinel, 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/scope.mli b/src/dune_rules/scope.mli index 58f20daffb9..d602fd41a65 100644 --- a/src/dune_rules/scope.mli +++ b/src/dune_rules/scope.mli @@ -22,7 +22,7 @@ module DB : sig module Lib_entry : sig type t = - | Library of Lib.Local.t + | Library of Lib_info.Sentinel.t * Lib.Local.t | Deprecated_library_name of Deprecated_library_name.t end diff --git a/src/dune_rules/stanzas/deprecated_library_name.ml b/src/dune_rules/stanzas/deprecated_library_name.ml index 99ff37ccb73..5be6ce66d44 100644 --- a/src/dune_rules/stanzas/deprecated_library_name.ml +++ b/src/dune_rules/stanzas/deprecated_library_name.ml @@ -47,3 +47,11 @@ let decode = in { Library_redirect.loc; project; old_name; new_public_name }) ;; + +let to_sentinel ~src_dir (t : t) = + let loc, name = + let lib, _ = t.old_name in + Public_lib.loc lib, Public_lib.name lib + and enabled_if = Blang.true_ in + Lib_info.Sentinel.make ~loc ~src_dir ~enabled_if name +;; diff --git a/src/dune_rules/stanzas/deprecated_library_name.mli b/src/dune_rules/stanzas/deprecated_library_name.mli index b4a1e15490a..a6465d514c0 100644 --- a/src/dune_rules/stanzas/deprecated_library_name.mli +++ b/src/dune_rules/stanzas/deprecated_library_name.mli @@ -15,3 +15,4 @@ val decode : t Dune_lang.Decoder.t include Stanza.S with type t := t val old_public_name : t -> Lib_name.t +val to_sentinel : src_dir:Path.Source.t -> t -> Lib_info.Sentinel.t diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index 2fb0a2750ba..ab8fc26a920 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -403,6 +403,15 @@ let main_module_name t : Lib_info.Main_module_name.t = This (Some (Module_name.of_local_lib_name t.name)) ;; +let to_sentinel ~src_dir t = + let loc, name = + let ((loc, _) as name) = t.name in + loc, Lib_name.of_local name + in + let enabled_if = t.enabled_if in + Lib_info.Sentinel.make ~loc ~src_dir ~enabled_if name +;; + let to_lib_info conf ~expander @@ -476,6 +485,10 @@ let to_lib_info in let main_module_name = main_module_name conf in let name = best_name conf in + let sentinel = + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + to_sentinel ~src_dir conf + in let enabled = let+ enabled_if_result = let* expander = expander in @@ -537,6 +550,7 @@ let to_lib_info ~loc ~path_kind:Local ~name + ~sentinel ~kind ~status ~src_dir diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index 37865390ebe..989e8d267e8 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_sentinel : src_dir:Path.Source.t -> t -> Lib_info.Sentinel.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..3a2f8737e0e 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 = diff --git a/src/dune_rules/stanzas/library_redirect.mli b/src/dune_rules/stanzas/library_redirect.mli index 4bc1a9adf34..fcaae554077 100644 --- a/src/dune_rules/stanzas/library_redirect.mli +++ b/src/dune_rules/stanzas/library_redirect.mli @@ -20,7 +20,12 @@ 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 diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index f6f4011c0b6..c13bae3ff41 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -95,6 +95,7 @@ let impl sctx ~(lib : Library.t) ~scope = | External modules, External fa -> Memo.return (modules, fa) | Local, Local -> let name = Lib.name vlib in + let sentinel = Lib.sentinel vlib in let vlib = Lib.Local.of_lib_exn vlib in let* dir_contents = let info = Lib.Local.info vlib in @@ -115,7 +116,7 @@ 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 sentinel) >>= 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..0756766f316 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 @@ -29,10 +29,16 @@ in the same dune file > EOF $ dune build --display=short - Error: Library foo is defined twice: - - dune:4 - - dune:1 - [1] + ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} [alt-context] + ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} + ocamlopt .foo.objs/native/foo.{cmx,o} [alt-context] + ocamlc foo.cma [alt-context] + ocamlopt .foo.objs/native/foo.{cmx,o} + ocamlc foo.cma + ocamlopt foo.{a,cmxa} [alt-context] + ocamlopt foo.{a,cmxa} + ocamlopt foo.cmxs [alt-context] + ocamlopt foo.cmxs For public libraries @@ -48,7 +54,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..a5803680330 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,19 @@ different folders. > (name foo)) > EOF -Without any consumers of the libraries - - $ dune build - Error: Library foo is defined twice: - - a/dune:1 - - b/dune:1 - -> required by alias default - [1] +Without any consumers of the libraries (both are built in separate folders) + + $ dune build --display short + ocamlc a/.foo.objs/byte/foo.{cmi,cmo,cmt} + ocamlc b/.foo.objs/byte/foo.{cmi,cmo,cmt} + ocamlopt a/.foo.objs/native/foo.{cmx,o} + ocamlc a/foo.cma + ocamlopt b/.foo.objs/native/foo.{cmx,o} + ocamlc b/foo.cma + ocamlopt a/foo.{a,cmxa} + ocamlopt b/foo.{a,cmxa} + ocamlopt a/foo.cmxs + ocamlopt b/foo.cmxs With some consumer of the library @@ -39,7 +44,10 @@ With some consumer of the library > EOF $ dune build - Error: Library foo is defined twice: - - a/dune:1 - - b/dune:1 + File "b/dune", line 1, characters 0-21: + 1 | (library + 2 | (name foo)) + Error: Library with name "foo" is defined in two folders (_build/default/a + and _build/default/b). 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..3e8af8c0fb3 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,9 @@ the same folder. Without any consumers of the libraries $ dune build - Error: Library foo is defined twice: - - dune:6 - - dune:3 + Error: Multiple rules generated for _build/default/foo.cmxs: + - dune:4 + - dune:1 [1] With some consumer @@ -43,7 +43,13 @@ With some consumer > EOF $ dune build - Error: Library foo is defined twice: - - dune:6 - - dune:3 + File "dune", line 1, characters 0-0: + Error: Module "Main" is used in several stanzas: + - dune:1 + - dune:4 + - dune:7 + To fix this error, you must specify an explicit "modules" field in every + library, executable, and executables stanzas in this dune file. Note that + each module cannot appear in more than one "modules" field - it must belong + to a single library or executable. [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..04dbd10ab99 --- /dev/null +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-public-name.t @@ -0,0 +1,47 @@ +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 + +With some consumer + + $ cat > dune << EOF + > (executable + > (name main) + > (libraries foo)) + > EOF + + $ cat > main.ml < let () = Foo.x + > EOF + + $ dune build + File "a/dune", line 1, characters 0-44: + 1 | (library + 2 | (name foo) + 3 | (public_name bar.foo)) + Error: Library with name "foo" is defined in two folders (_build/default/b + and _build/default/a) and shares a name with library "bar". 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.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public.t index 51150a9512b..de24a5cfce2 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,11 @@ With some consumer > EOF $ dune build - Error: Library foo is defined twice: - - a/dune:3 - - b/dune:3 + File "b/dune", line 1, characters 0-44: + 1 | (library + 2 | (name foo) + 3 | (public_name baz.foo)) + Error: Library with name "foo" is defined in two folders (_build/default/a + and _build/default/b). Either change one of the names, or enable them + conditionally using the 'enabled_if' field. [1] From 04d2024e1d85ac22833c9c4c9a53bb7ab0a21dcd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Tue, 26 Mar 2024 11:17:11 +0000 Subject: [PATCH 02/38] rules: remove unnecessary changes in dune_pkg Entry.t MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- src/dune_rules/dune_package.ml | 12 ++++++------ src/dune_rules/dune_package.mli | 2 +- src/dune_rules/findlib.ml | 9 ++++----- src/dune_rules/install_rules.ml | 4 ++-- src/dune_rules/lib.ml | 2 +- 5 files changed, 14 insertions(+), 15 deletions(-) diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index c680fa260f3..6984ca5ac4f 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -365,12 +365,12 @@ end module Entry = struct type t = | Library of Lib.t - | Deprecated_library_name of Path.t * Deprecated_library_name.t + | Deprecated_library_name of Deprecated_library_name.t | Hidden_library of Lib.t let name = function | Library lib | Hidden_library lib -> Lib_info.name (Lib.info lib) - | Deprecated_library_name (_, d) -> d.old_public_name + | Deprecated_library_name d -> d.old_public_name ;; let version = function @@ -380,7 +380,7 @@ module Entry = struct let loc = function | Library lib | Hidden_library lib -> Lib_info.loc (Lib.info lib) - | Deprecated_library_name (_, d) -> d.loc + | Deprecated_library_name d -> d.loc ;; let sentinel = function @@ -397,7 +397,7 @@ module Entry = struct Library lib ) ; ( "deprecated_library_name" , let+ x = Deprecated_library_name.decode in - Deprecated_library_name (dir, x) ) + Deprecated_library_name x ) ] ;; @@ -405,7 +405,7 @@ module Entry = struct let open Dyn in match x with | Library lib -> variant "Library" [ Lib.to_dyn lib ] - | Deprecated_library_name (_, lib) -> + | Deprecated_library_name lib -> variant "Deprecated_library_name" [ Deprecated_library_name.to_dyn lib ] | Hidden_library lib -> variant "Hidden_library" [ Lib.to_dyn lib ] ;; @@ -547,7 +547,7 @@ let encode ~encoding ~dune_version { entries; name; version; dir; sections; site match e with | Entry.Library lib -> list (Dune_lang.atom "library" :: Lib.encode lib ~package_root:dir ~stublibs) - | Deprecated_library_name (_, d) -> + | Deprecated_library_name d -> list (Dune_lang.atom "deprecated_library_name" :: Deprecated_library_name.encode d) | Hidden_library lib -> Code_error.raise diff --git a/src/dune_rules/dune_package.mli b/src/dune_rules/dune_package.mli index bedbe09a4e4..72bee44cee5 100644 --- a/src/dune_rules/dune_package.mli +++ b/src/dune_rules/dune_package.mli @@ -42,7 +42,7 @@ end module Entry : sig type t = | Library of Lib.t - | Deprecated_library_name of Path.t * Deprecated_library_name.t + | Deprecated_library_name of Deprecated_library_name.t | Hidden_library of Lib.t (** Only for external libraries that: diff --git a/src/dune_rules/findlib.ml b/src/dune_rules/findlib.ml index 0b2001c1a86..db99e0509ea 100644 --- a/src/dune_rules/findlib.ml +++ b/src/dune_rules/findlib.ml @@ -23,11 +23,10 @@ end let builtin_for_dune : Dune_package.t = let entry = Dune_package.Entry.Deprecated_library_name - ( Path.external_ Path.External.initial_cwd - , { loc = Loc.of_pos __POS__ - ; old_public_name = Lib_name.of_string "dune.configurator" - ; new_public_name = Lib_name.of_string "dune-configurator" - } ) + { loc = Loc.of_pos __POS__ + ; old_public_name = Lib_name.of_string "dune.configurator" + ; new_public_name = Lib_name.of_string "dune-configurator" + } in { name = Opam_package.Name.of_string "dune" ; entries = Lib_name.Map.singleton (Dune_package.Entry.name entry) entry diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index a3ea562ebe1..afa7477d7b8 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -628,7 +628,7 @@ end = struct (Some ( old_public_name , Dune_package.Entry.Deprecated_library_name - (Path.build pkg_root, { loc; old_public_name; new_public_name }) )) + { loc; old_public_name; new_public_name } )) | Library (sentinel, lib) -> let info = Lib.Local.info lib in let dir = Lib_info.src_dir info in @@ -766,7 +766,7 @@ end = struct acc old_public_name (Dune_package.Entry.Deprecated_library_name - (dir, { loc; old_public_name; new_public_name }))) + { loc; old_public_name; new_public_name })) in let sections = sections ctx.name [] pkg in { Dune_package.version = Package.version pkg diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index fdd15d83a32..de9a107e79a 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1978,7 +1978,7 @@ module DB = struct Findlib.find findlib name >>| function | Ok (Library pkg) -> Resolve_result (Found (Dune_package.Lib.info pkg)) - | Ok (Deprecated_library_name (_, d)) -> + | Ok (Deprecated_library_name d) -> Resolve_result (Redirect_in_the_same_db (d.loc, d.new_public_name)) | Ok (Hidden_library pkg) -> Resolve_result (Hidden (Hidden.unsatisfied_exist_if pkg)) From 27bfc4a64779301b5444960d2936fab9db96ccf5 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 12:16:26 -0700 Subject: [PATCH 03/38] refactor: flip available / available_by_name Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/expander.ml | 4 ++-- src/dune_rules/gen_rules.ml | 2 +- src/dune_rules/install_rules.ml | 2 +- src/dune_rules/lib.ml | 17 ++++++++++------- src/dune_rules/lib.mli | 4 ++-- 5 files changed, 16 insertions(+), 13 deletions(-) diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index e0ffbce3b79..ce37d2cd3ef 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -402,7 +402,7 @@ let expand_lib_variable t source ~lib ~file ~lib_exec ~lib_private = then Resolve.Memo.map p ~f:(fun _ -> assert false) else let open Resolve.Memo.O in - Lib.DB.available_by_name (Scope.libs scope) lib + Lib.DB.available (Scope.libs scope) lib |> Resolve.Memo.lift_memo >>= function | false -> @@ -653,7 +653,7 @@ let expand_pform_macro (let lib = Lib_name.parse_string_exn (Dune_lang.Template.Pform.loc source, s) in let open Memo.O in let* scope = t.scope in - let+ available = Lib.DB.available_by_name (Scope.libs scope) lib in + let+ available = Lib.DB.available (Scope.libs scope) lib in available |> string_of_bool |> string)) | Bin_available -> Need_full_expander diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 727e2f147a6..9f15653fc13 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -113,7 +113,7 @@ end = struct | Library.T lib -> let* enabled_if = let sentinel = Library.to_sentinel ~src_dir lib in - Lib.DB.available (Scope.libs scope) sentinel + Lib.DB.available_by_sentinel (Scope.libs scope) sentinel in if_available_buildable ~loc:lib.buildable.loc diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index afa7477d7b8..42eb04afec1 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -347,7 +347,7 @@ end = struct let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in Library.to_sentinel ~src_dir lib in - Lib.DB.available (Scope.libs scope) sentinel) + Lib.DB.available_by_sentinel (Scope.libs scope) sentinel) else Memo.return true else Memo.return false | Documentation.T _ -> Memo.return true diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index de9a107e79a..b3e6b73ec38 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -859,8 +859,8 @@ module rec Resolve_names : sig -> lib Resolve.t option Memo.t val resolve_sentinel : db -> Lib_info.Sentinel.t -> Status.t Memo.t - val available_internal : db -> Lib_info.Sentinel.t -> bool Memo.t - val available_by_name_internal : db -> Lib_name.t -> bool Memo.t + val available_internal : db -> Lib_name.t -> bool Memo.t + val available_by_sentinel_internal : db -> Lib_info.Sentinel.t -> bool Memo.t val resolve_simple_deps : db @@ -1271,7 +1271,7 @@ end = struct db.resolve_sentinel sentinel >>= handle_resolve_result ~super db ;; - let available_by_name_internal db (name : Lib_name.t) = + let available_internal db (name : Lib_name.t) = let open Memo.O in find_internal db name >>| function @@ -1279,7 +1279,7 @@ end = struct | Not_found | Invalid _ | Hidden _ -> false ;; - let available_internal db (sentinel : Lib_info.Sentinel.t) = + let available_by_sentinel_internal db (sentinel : Lib_info.Sentinel.t) = let open Memo.O in resolve_sentinel db sentinel >>| function @@ -1406,7 +1406,7 @@ end = struct let+ select = Memo.List.find_map choices ~f:(fun { required; forbidden; file } -> Lib_name.Set.to_list forbidden - |> Memo.List.exists ~f:(available_by_name_internal db) + |> Memo.List.exists ~f:(available_internal db) >>= function | true -> Memo.return None | false -> @@ -2075,8 +2075,11 @@ module DB = struct | Some k -> Memo.return k ;; - let available_by_name t name = Resolve_names.available_by_name_internal t name - let available t sentinel = Resolve_names.available_internal t sentinel + let available t name = Resolve_names.available_internal t name + + let available_by_sentinel t sentinel = + Resolve_names.available_by_sentinel_internal t sentinel + ;; let get_compile_info t ~allow_overlaps sentinel = let open Memo.O in diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 322e10f79d9..4bc0103125b 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -138,8 +138,8 @@ module DB : sig val find_even_when_hidden : t -> Lib_name.t -> lib option Memo.t val find_sentinel : t -> Lib_info.Sentinel.t -> lib option Memo.t val find_sentinel_even_when_hidden : t -> Lib_info.Sentinel.t -> lib option Memo.t - val available : t -> Lib_info.Sentinel.t -> bool Memo.t - val available_by_name : t -> Lib_name.t -> bool Memo.t + val available : t -> Lib_name.t -> bool Memo.t + val available_by_sentinel : t -> Lib_info.Sentinel.t -> bool Memo.t (** Retrieve the compile information for the given library. Works for libraries that are optional and not available as well. *) From dbebe2e1a6ccf5361ea1c0bf6d76b4180fe2d65e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 12:23:15 -0700 Subject: [PATCH 04/38] refactor: avoid passing `Blang.true_` everytime to Sentinel.external_ Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/dune_package.ml | 4 +--- src/dune_rules/findlib.ml | 5 +---- src/dune_rules/lib_info.ml | 2 +- src/dune_rules/lib_info.mli | 2 +- 4 files changed, 4 insertions(+), 9 deletions(-) diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 6984ca5ac4f..98d21f3fcd6 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -231,9 +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 sentinel = - Lib_info.Sentinel.external_ ~loc ~src_dir ~enabled_if:Blang.true_ name - in + let sentinel = Lib_info.Sentinel.external_ ~loc ~src_dir name in let enabled = Memo.return Lib_info.Enabled_status.Normal in let status = match Lib_name.analyze name with diff --git a/src/dune_rules/findlib.ml b/src/dune_rules/findlib.ml index db99e0509ea..3e92c6df00f 100644 --- a/src/dune_rules/findlib.ml +++ b/src/dune_rules/findlib.ml @@ -207,10 +207,7 @@ let to_dune_library (t : Findlib.Package.t) ~dir_contents ~ext_lib ~external_loc in let modules = Lib_info.Source.External None in let name = t.name in - let sentinel = - let enabled_if = Blang.true_ in - Lib_info.Sentinel.external_ ~loc ~src_dir ~enabled_if name - in + let sentinel = Lib_info.Sentinel.external_ ~loc ~src_dir name in Lib_info.create ~loc ~path_kind:External diff --git a/src/dune_rules/lib_info.ml b/src/dune_rules/lib_info.ml index f7309cb0f25..4a929343066 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -324,7 +324,7 @@ module Sentinel = struct include T include Comparable.Make (T) - let external_ ~loc ~src_dir ~enabled_if name = { name; loc; enabled_if; src_dir } + let external_ ~loc ~src_dir name = { name; loc; enabled_if = Blang.true_; src_dir } let make ~loc ~src_dir ~enabled_if name = let src_dir = Path.source src_dir in diff --git a/src/dune_rules/lib_info.mli b/src/dune_rules/lib_info.mli index b59805598bd..a0ce619703f 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -95,7 +95,7 @@ module Sentinel : sig val equal : t -> t -> bool val make : loc:Loc.t -> src_dir:Path.Source.t -> enabled_if:Blang.t -> Lib_name.t -> t - val external_ : loc:Loc.t -> src_dir:Path.t -> enabled_if:Blang.t -> Lib_name.t -> t + val external_ : loc:Loc.t -> src_dir:Path.t -> Lib_name.t -> t val name : t -> Lib_name.t val loc : t -> Loc.t val to_dyn : t -> Dyn.t From 4b3c537a461a00fd6141060e68b4616441cf22c6 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 12:27:02 -0700 Subject: [PATCH 05/38] refactor: rename sentinel back to library_id Signed-off-by: Antonio Nuno Monteiro --- bin/describe/describe_workspace.ml | 4 +- src/dune_rules/dir_contents.ml | 6 +- src/dune_rules/dune_package.ml | 8 +- src/dune_rules/dune_package.mli | 2 +- src/dune_rules/findlib.ml | 4 +- src/dune_rules/gen_rules.ml | 4 +- src/dune_rules/install_rules.ml | 22 +-- src/dune_rules/lib.ml | 97 ++++++------ src/dune_rules/lib.mli | 16 +- src/dune_rules/lib_info.ml | 14 +- src/dune_rules/lib_info.mli | 6 +- src/dune_rules/lib_rules.ml | 8 +- src/dune_rules/ml_sources.ml | 30 ++-- src/dune_rules/ml_sources.mli | 2 +- src/dune_rules/odoc.ml | 6 +- src/dune_rules/odoc_new.ml | 4 +- src/dune_rules/scope.ml | 138 +++++++++--------- src/dune_rules/scope.mli | 2 +- .../stanzas/deprecated_library_name.ml | 4 +- .../stanzas/deprecated_library_name.mli | 2 +- src/dune_rules/stanzas/library.ml | 10 +- src/dune_rules/stanzas/library.mli | 2 +- src/dune_rules/virtual_rules.ml | 4 +- 23 files changed, 204 insertions(+), 191 deletions(-) diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index b0ea0e8fcf9..7234223d633 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -449,10 +449,10 @@ module Crawl = struct | true -> (* XXX why do we have a second object directory? *) let* modules_, obj_dir_ = - let sentinel = Lib.sentinel lib in + let library_id = Lib.library_id lib in Dir_contents.get sctx ~dir:(Path.as_in_build_dir_exn src_dir) >>= Dir_contents.ocaml - >>| Ml_sources.modules_and_obj_dir ~for_:(Library sentinel) + >>| Ml_sources.modules_and_obj_dir ~for_:(Library library_id) in let* pp_map = let+ version = diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index f0f76227eca..872b60f0f6c 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -459,11 +459,11 @@ let modules_of_local_lib sctx lib = in ocaml t in - let sentinel = + let library_id = let lib = Lib.Local.to_lib lib in - Lib.sentinel lib + Lib.library_id lib in - Ml_sources.modules sources ~for_:(Library sentinel) + Ml_sources.modules sources ~for_:(Library library_id) ;; let modules_of_lib sctx lib = diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 98d21f3fcd6..91c85694241 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -231,7 +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 sentinel = Lib_info.Sentinel.external_ ~loc ~src_dir name in + let library_id = Lib_info.Library_id.external_ ~loc ~src_dir name in let enabled = Memo.return Lib_info.Enabled_status.Normal in let status = match Lib_name.analyze name with @@ -256,7 +256,7 @@ module Lib = struct ~path_kind:External ~loc ~name - ~sentinel + ~library_id ~kind ~status ~src_dir @@ -381,10 +381,10 @@ module Entry = struct | Deprecated_library_name d -> d.loc ;; - let sentinel = function + let library_id = function | Library lib | Hidden_library lib -> let info = Lib.info lib in - Lib_info.sentinel info + Lib_info.library_id info | Deprecated_library_name _ -> assert false ;; diff --git a/src/dune_rules/dune_package.mli b/src/dune_rules/dune_package.mli index 72bee44cee5..209fc420fc9 100644 --- a/src/dune_rules/dune_package.mli +++ b/src/dune_rules/dune_package.mli @@ -53,7 +53,7 @@ module Entry : sig Dune itself never produces hidden libraries. *) val name : t -> Lib_name.t - val sentinel : t -> Lib_info.Sentinel.t + val library_id : t -> Lib_info.Library_id.t val version : t -> Package_version.t option val loc : t -> Loc.t val to_dyn : t Dyn.builder diff --git a/src/dune_rules/findlib.ml b/src/dune_rules/findlib.ml index 3e92c6df00f..629c26acb14 100644 --- a/src/dune_rules/findlib.ml +++ b/src/dune_rules/findlib.ml @@ -207,12 +207,12 @@ let to_dune_library (t : Findlib.Package.t) ~dir_contents ~ext_lib ~external_loc in let modules = Lib_info.Source.External None in let name = t.name in - let sentinel = Lib_info.Sentinel.external_ ~loc ~src_dir name in + let library_id = Lib_info.Library_id.external_ ~loc ~src_dir name in Lib_info.create ~loc ~path_kind:External ~name - ~sentinel + ~library_id ~kind ~status ~src_dir diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 9f15653fc13..2d1bb4fa584 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -112,8 +112,8 @@ end = struct empty_none | Library.T lib -> let* enabled_if = - let sentinel = Library.to_sentinel ~src_dir lib in - Lib.DB.available_by_sentinel (Scope.libs scope) sentinel + let library_id = Library.to_library_id ~src_dir lib in + Lib.DB.available_by_library_id (Scope.libs scope) library_id in if_available_buildable ~loc:lib.buildable.loc diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 42eb04afec1..e019228a48e 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -85,10 +85,10 @@ end = struct >>| List.singleton ;; - let lib_files ~dir_contents ~dir ~lib_config ~sentinel lib = + let lib_files ~dir_contents ~dir ~lib_config ~library_id lib = let+ modules = let+ ml_sources = Dir_contents.ocaml dir_contents in - Some (Ml_sources.modules ml_sources ~for_:(Library sentinel)) + Some (Ml_sources.modules ml_sources ~for_:(Library library_id)) and+ foreign_archives = match Lib_info.virtual_ lib with | None -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) @@ -179,13 +179,13 @@ end = struct ~lib_config in let lib_name = Library.best_name lib in - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_sentinel ~src_dir lib + Library.to_library_id ~src_dir lib in let* installable_modules = let+ modules = - Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library sentinel) + Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library library_id) and+ impl = Virtual_rules.impl sctx ~lib ~scope in Vimpl.impl_modules impl modules |> Modules.split_by_lib in @@ -309,7 +309,7 @@ end = struct if Module.kind m = Virtual then [] else common m |> set_dir m) in modules_vlib @ modules_impl - and+ lib_files = lib_files ~dir ~dir_contents ~lib_config ~sentinel info + and+ lib_files = lib_files ~dir ~dir_contents ~lib_config ~library_id info and+ execs = lib_ppxs ctx ~scope ~lib and+ dll_files = dll_files ~modes:ocaml ~dynlink:lib.dynlink ~ctx info @@ -343,11 +343,11 @@ end = struct then if lib.optional then ( - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_sentinel ~src_dir lib + Library.to_library_id ~src_dir lib in - Lib.DB.available_by_sentinel (Scope.libs scope) sentinel) + Lib.DB.available_by_library_id (Scope.libs scope) library_id) else Memo.return true else Memo.return false | Documentation.T _ -> Memo.return true @@ -629,7 +629,7 @@ end = struct ( old_public_name , Dune_package.Entry.Deprecated_library_name { loc; old_public_name; new_public_name } )) - | Library (sentinel, lib) -> + | Library (library_id, lib) -> let info = Lib.Local.info lib in let dir = Lib_info.src_dir info in let* dir_contents = Dir_contents.get sctx ~dir in @@ -662,7 +662,7 @@ end = struct |> List.map ~f:Path.build and* modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library sentinel) + >>| Ml_sources.modules ~for_:(Library library_id) 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 b3e6b73ec38..68cf4f5079f 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -352,7 +352,7 @@ module T = struct { info : Lib_info.external_ ; name : Lib_name.t ; unique_id : Id.t - ; sentinel : Lib_info.Sentinel.t + ; library_id : Lib_info.Library_id.t ; re_exports : t list Resolve.t ; (* [requires] is contains all required libraries, including the ones mentioned in [re_exports]. *) @@ -433,10 +433,10 @@ end type db = { parent : db option ; resolve_name : Lib_name.t -> resolve_result_with_multiple_results Memo.t - ; resolve_sentinel : Lib_info.Sentinel.t -> resolve_result Memo.t + ; resolve_library_id : Lib_info.Library_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_info.Sentinel.t list Memo.Lazy.t + ; all : Lib_info.Library_id.t list Memo.Lazy.t ; lib_config : Lib_config.t ; instrument_with : Lib_name.t list } @@ -448,7 +448,7 @@ and resolve_result = | Invalid of User_message.t | Ignore | Redirect_in_the_same_db of (Loc.t * Lib_name.t) - | Redirect of db * Lib_info.Sentinel.t + | Redirect of db * Lib_info.Library_id.t and resolve_result_with_multiple_results = | Resolve_result of resolve_result @@ -456,7 +456,7 @@ and resolve_result_with_multiple_results = let lib_config (t : lib) = t.lib_config let name t = t.name -let sentinel t = t.sentinel +let library_id t = t.library_id let info t = t.info let project t = t.project let implements t = Option.map ~f:Memo.return t.implements @@ -858,9 +858,9 @@ module rec Resolve_names : sig -> private_deps:private_deps -> lib Resolve.t option Memo.t - val resolve_sentinel : db -> Lib_info.Sentinel.t -> Status.t Memo.t + val resolve_library_id : db -> Lib_info.Library_id.t -> Status.t Memo.t val available_internal : db -> Lib_name.t -> bool Memo.t - val available_by_sentinel_internal : db -> Lib_info.Sentinel.t -> bool Memo.t + val available_by_library_id_internal : db -> Lib_info.Library_id.t -> bool Memo.t val resolve_simple_deps : db @@ -1071,7 +1071,7 @@ end = struct let* package = Lib_info.package info in Package.Name.Map.find projects_by_package package in - let sentinel = Lib_info.sentinel info in + let library_id = Lib_info.library_id info in let rec t = lazy (let open Resolve.O in @@ -1081,7 +1081,7 @@ end = struct { info ; name ; unique_id - ; sentinel + ; library_id ; requires ; ppx_runtime_deps ; pps @@ -1130,9 +1130,10 @@ end = struct type t = Lib_name.t * Path.t Lib_info.t * string option let equal (lib_name, info, _) (lib_name', info', _) = - let sentinel = Lib_info.sentinel info - and sentinel' = Lib_info.sentinel info' in - Lib_name.equal lib_name lib_name' && Lib_info.Sentinel.equal sentinel sentinel' + let library_id = Lib_info.library_id info + and library_id' = Lib_info.library_id info' in + Lib_name.equal lib_name lib_name' + && Lib_info.Library_id.equal library_id library_id' ;; let hash (x, _, _) = Lib_name.hash x @@ -1172,8 +1173,8 @@ end = struct (match db.parent with | None -> Memo.return Status.Not_found | Some db -> - let sentinel = Lib_info.sentinel info in - resolve_sentinel db sentinel) + let library_id = Lib_info.library_id info in + resolve_library_id db library_id) >>= function | Status.Found _ as x -> Memo.return x | _ -> @@ -1184,7 +1185,7 @@ end = struct let handle_resolve_result db ~super = function | Ignore -> Memo.return Status.Ignore | Redirect_in_the_same_db (_, name') -> find_internal db name' - | Redirect (db', sentinel') -> resolve_sentinel db' sentinel' + | Redirect (db', library_id') -> resolve_library_id db' library_id' | Found info -> let name = Lib_info.name info in instantiate db name info ~hidden:None @@ -1204,7 +1205,8 @@ end = struct Memo.List.filter_map candidates ~f:(function | Ignore -> Memo.return (Some Status.Ignore) | Redirect_in_the_same_db (_, name') -> find_internal db name' >>| Option.some - | Redirect (db', sentinel') -> resolve_sentinel db' sentinel' >>| Option.some + | Redirect (db', library_id') -> + resolve_library_id db' library_id' >>| Option.some | Found info -> Lib_info.enabled info >>= (function @@ -1224,7 +1226,7 @@ end = struct List.fold_left libs ~init:Status.Not_found ~f:(fun acc status -> match acc, status with | Status.Found a, Status.Found b -> - (match Lib_info.Sentinel.equal a.sentinel b.sentinel with + (match Lib_info.Library_id.equal a.library_id b.library_id with | true -> acc | false -> let a = info a @@ -1233,11 +1235,11 @@ end = struct and dir_a = Lib_info.best_src_dir a and dir_b = Lib_info.best_src_dir b and name_a = - let sentinel = Lib_info.sentinel a in - Lib_info.Sentinel.name sentinel + let library_id = Lib_info.library_id a in + Lib_info.Library_id.name library_id and name_b = - let sentinel = Lib_info.sentinel b in - Lib_info.Sentinel.name sentinel + let library_id = Lib_info.library_id b in + Lib_info.Library_id.name library_id in Status.Invalid (Error.duplicated ~loc ~name_a ~name_b ~dir_a ~dir_b)) | Invalid _, _ -> acc @@ -1265,10 +1267,10 @@ end = struct | Hidden h -> Hidden.error h ~loc ~name >>| Option.some ;; - let resolve_sentinel db sentinel = + let resolve_library_id db library_id = let open Memo.O in - let super db = resolve_sentinel db sentinel in - db.resolve_sentinel sentinel >>= handle_resolve_result ~super db + let super db = resolve_library_id db library_id in + db.resolve_library_id library_id >>= handle_resolve_result ~super db ;; let available_internal db (name : Lib_name.t) = @@ -1279,9 +1281,9 @@ end = struct | Not_found | Invalid _ | Hidden _ -> false ;; - let available_by_sentinel_internal db (sentinel : Lib_info.Sentinel.t) = + let available_by_library_id_internal db (library_id : Lib_info.Library_id.t) = let open Memo.O in - resolve_sentinel db sentinel + resolve_library_id db library_id >>| function | Ignore | Found _ -> true | Not_found | Invalid _ | Hidden _ -> false @@ -1906,7 +1908,7 @@ module DB = struct | Invalid of User_message.t | Ignore | Redirect_in_the_same_db of (Loc.t * Lib_name.t) - | Redirect of db * Lib_info.Sentinel.t + | Redirect of db * Lib_info.Library_id.t let found f = Found f let not_found = Not_found @@ -1921,7 +1923,8 @@ 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 (_, sentinel) -> variant "Redirect" [ Lib_info.Sentinel.to_dyn sentinel ] + | Redirect (_, library_id) -> + variant "Redirect" [ Lib_info.Library_id.to_dyn library_id ] | Redirect_in_the_same_db (_, name) -> variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ] ;; @@ -1955,12 +1958,20 @@ module DB = struct type t = db - let create ~parent ~resolve_name ~resolve_sentinel ~all ~lib_config ~instrument_with () = + let create + ~parent + ~resolve_name + ~resolve_library_id + ~all + ~lib_config + ~instrument_with + () + = let rec t = lazy { parent ; resolve_name - ; resolve_sentinel + ; resolve_library_id ; all = Memo.lazy_ all ; lib_config ; instrument_with @@ -2000,16 +2011,16 @@ module DB = struct ~parent:None ~lib_config ~resolve_name - ~resolve_sentinel:(fun sentinel -> + ~resolve_library_id:(fun library_id -> let open Memo.O in - let name = Lib_info.Sentinel.name sentinel in + let name = Lib_info.Library_id.name library_id in resolve_name name >>| function | Multiple_results _ -> assert false | Resolve_result r -> r) ~all:(fun () -> let open Memo.O in - Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.sentinel) + Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.library_id) ;; let installed (context : Context.t) = @@ -2031,9 +2042,9 @@ module DB = struct | Ignore | Not_found | Invalid _ | Hidden _ -> None ;; - let find_sentinel t sentinel = + let find_library_id t library_id = let open Memo.O in - Resolve_names.resolve_sentinel t sentinel + Resolve_names.resolve_library_id t library_id >>| function | Found t -> Some t | Ignore | Not_found | Invalid _ | Hidden _ -> None @@ -2047,9 +2058,9 @@ module DB = struct | Ignore | Invalid _ | Not_found -> None ;; - let find_sentinel_even_when_hidden t sentinel = + let find_library_id_even_when_hidden t library_id = let open Memo.O in - Resolve_names.resolve_sentinel t sentinel + Resolve_names.resolve_library_id t library_id >>| function | Found t | Hidden { lib = t; reason = _; path = _ } -> Some t | Ignore | Invalid _ | Not_found -> None @@ -2077,19 +2088,19 @@ module DB = struct let available t name = Resolve_names.available_internal t name - let available_by_sentinel t sentinel = - Resolve_names.available_by_sentinel_internal t sentinel + let available_by_library_id t library_id = + Resolve_names.available_by_library_id_internal t library_id ;; - let get_compile_info t ~allow_overlaps sentinel = + let get_compile_info t ~allow_overlaps library_id = let open Memo.O in - find_sentinel_even_when_hidden t sentinel + find_library_id_even_when_hidden t library_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" - [ "sentinel", Lib_info.Sentinel.to_dyn sentinel ] + [ "library_id", Lib_info.Library_id.to_dyn library_id ] ;; let resolve_user_written_deps @@ -2183,7 +2194,7 @@ module DB = struct let open Memo.O in let* l = Memo.Lazy.force t.all - >>= Memo.parallel_map ~f:(find_sentinel t) + >>= Memo.parallel_map ~f:(find_library_id t) >>| List.filter_opt >>| Set.of_list in diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 4bc0103125b..3d90b6c6636 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -11,7 +11,7 @@ val to_dyn : t -> Dyn.t or the [name] if not. *) val name : t -> Lib_name.t -val sentinel : t -> Lib_info.Sentinel.t +val library_id : t -> Lib_info.Library_id.t val lib_config : t -> Lib_config.t val implements : t -> t Resolve.Memo.t option @@ -101,7 +101,7 @@ module DB : sig val not_found : t val found : Lib_info.external_ -> t val to_dyn : t Dyn.builder - val redirect : db -> Lib_info.Sentinel.t -> t + val redirect : db -> Lib_info.Library_id.t -> t val redirect_in_the_same_db : Loc.t * Lib_name.t -> t module With_multiple_results : sig @@ -127,8 +127,8 @@ module DB : sig val create : parent:t option -> resolve_name:(Lib_name.t -> Resolve_result.With_multiple_results.t Memo.t) - -> resolve_sentinel:(Lib_info.Sentinel.t -> Resolve_result.t Memo.t) - -> all:(unit -> Lib_info.Sentinel.t list Memo.t) + -> resolve_library_id:(Lib_info.Library_id.t -> Resolve_result.t Memo.t) + -> all:(unit -> Lib_info.Library_id.t list Memo.t) -> lib_config:Lib_config.t -> instrument_with:Lib_name.t list -> unit @@ -136,17 +136,17 @@ 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_sentinel : t -> Lib_info.Sentinel.t -> lib option Memo.t - val find_sentinel_even_when_hidden : t -> Lib_info.Sentinel.t -> lib option Memo.t + val find_library_id : t -> Lib_info.Library_id.t -> lib option Memo.t + val find_library_id_even_when_hidden : t -> Lib_info.Library_id.t -> lib option Memo.t val available : t -> Lib_name.t -> bool Memo.t - val available_by_sentinel : t -> Lib_info.Sentinel.t -> bool Memo.t + val available_by_library_id : t -> Lib_info.Library_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_info.Sentinel.t + -> Lib_info.Library_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_info.ml b/src/dune_rules/lib_info.ml index 4a929343066..bfe3b2ab07f 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -290,7 +290,7 @@ module File_deps = struct ;; end -module Sentinel = struct +module Library_id = struct module T = struct type t = { name : Lib_name.t @@ -345,7 +345,7 @@ end type 'path t = { loc : Loc.t ; name : Lib_name.t - ; sentinel : Sentinel.t + ; library_id : Library_id.t ; kind : Lib_kind.t ; status : Status.t ; src_dir : 'path @@ -384,7 +384,7 @@ type 'path t = } let name t = t.name -let sentinel t = t.sentinel +let library_id t = t.library_id let version t = t.version let dune_version t = t.dune_version let loc t = t.loc @@ -438,7 +438,7 @@ let create ~loc ~path_kind ~name - ~sentinel + ~library_id ~kind ~status ~src_dir @@ -476,7 +476,7 @@ let create = { loc ; name - ; sentinel + ; library_id ; kind ; status ; src_dir @@ -569,7 +569,7 @@ let to_dyn { loc ; path_kind = _ ; name - ; sentinel + ; library_id ; kind ; status ; src_dir @@ -611,7 +611,7 @@ let to_dyn record [ "loc", Loc.to_dyn_hum loc ; "name", Lib_name.to_dyn name - ; "sentinel", Sentinel.to_dyn sentinel + ; "library_id", Library_id.to_dyn library_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 a0ce619703f..153d7527998 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -87,7 +87,7 @@ module Main_module_name : sig end (** What's the subset of fields that uniquely identifies this stanza? *) -module Sentinel : sig +module Library_id : sig type t module Map : Map.S with type key = t @@ -104,7 +104,7 @@ end type 'path t val name : _ t -> Lib_name.t -val sentinel : _ t -> Sentinel.t +val library_id : _ t -> Library_id.t val loc : _ t -> Loc.t (** The [*.cma] and [*.cmxa] files for OCaml libraries. Libraries built by Dune @@ -207,7 +207,7 @@ val create : loc:Loc.t -> path_kind:'a path -> name:Lib_name.t - -> sentinel:Sentinel.t + -> library_id:Library_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 fb3a51938bf..06ce8938663 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -644,20 +644,20 @@ let library_rules let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = let buildable = lib.buildable in - let sentinel = + let library_id = let src_dir = Path.Build.drop_build_context_exn dir in - Library.to_sentinel ~src_dir lib + Library.to_library_id ~src_dir lib in let* local_lib, compile_info = Lib.DB.get_compile_info (Scope.libs scope) - sentinel + library_id ~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 sentinel) + Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library library_id) 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 c903b69c8aa..5203c4e8f43 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_info.Sentinel.Map.t + { libraries : component Lib_info.Library_id.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_info.Sentinel.Map.empty + { libraries = Lib_info.Library_id.Map.empty ; executables = String.Map.empty ; melange_emits = String.Map.empty ; rev_map = Module_name.Path.Map.empty @@ -65,7 +65,7 @@ module Modules = struct let _, libraries = List.fold_left libs - ~init:(Lib_name.Set.empty, Lib_info.Sentinel.Map.empty) + ~init:(Lib_name.Set.empty, Lib_info.Library_id.Map.empty) ~f:(fun (lib_set, acc) part -> let name = Library.best_name part.stanza in match Lib_name.Set.mem lib_set name with @@ -78,13 +78,13 @@ module Modules = struct ] | false -> let acc = - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build part.dir) in - Library.to_sentinel ~src_dir part.stanza + Library.to_library_id ~src_dir part.stanza in - Lib_info.Sentinel.Map.add_exn acc sentinel (part.modules, part.obj_dir) + Lib_info.Library_id.Map.add_exn acc library_id (part.modules, part.obj_dir) in Lib_name.Set.add lib_set name, acc) in @@ -237,14 +237,14 @@ let modules_of_files ~path ~dialects ~dir ~files = ;; type for_ = - | Library of Lib_info.Sentinel.t + | Library of Lib_info.Library_id.t | Exe of { first_exe : string } | Melange of { target : string } let dyn_of_for_ = let open Dyn in function - | Library n -> variant "Library" [ Lib_info.Sentinel.to_dyn n ] + | Library n -> variant "Library" [ Lib_info.Library_id.to_dyn n ] | Exe { first_exe } -> variant "Exe" [ record [ "first_exe", string first_exe ] ] | Melange { target } -> variant "Melange" [ record [ "target", string target ] ] ;; @@ -252,7 +252,7 @@ let dyn_of_for_ = let modules_and_obj_dir t ~for_ = match match for_ with - | Library sentinel -> Lib_info.Sentinel.Map.find t.modules.libraries sentinel + | Library library_id -> Lib_info.Library_id.Map.find t.modules.libraries library_id | Exe { first_exe } -> String.Map.find t.modules.executables first_exe | Melange { target } -> String.Map.find t.modules.melange_emits target with @@ -261,8 +261,8 @@ let modules_and_obj_dir t ~for_ = let map = match for_ with | Library _ -> - Lib_info.Sentinel.Map.keys t.modules.libraries - |> Dyn.list Lib_info.Sentinel.to_dyn + Lib_info.Library_id.Map.keys t.modules.libraries + |> Dyn.list Lib_info.Library_id.to_dyn | Exe _ -> String.Map.keys t.modules.executables |> Dyn.(list string) | Melange _ -> String.Map.keys t.modules.melange_emits |> Dyn.(list string) in @@ -282,7 +282,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.sentinel vlib)) + modules t ~for_:(Library (Lib.library_id vlib)) in let existing_virtual_modules = Modules_group.virtual_module_names modules in let allow_new_public_modules = @@ -332,11 +332,11 @@ let make_lib_modules let open Memo.O in let* resolved = let* libs = libs in - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_sentinel ~src_dir lib + Library.to_library_id ~src_dir lib in - Lib.DB.find_sentinel_even_when_hidden libs sentinel + Lib.DB.find_library_id_even_when_hidden libs library_id (* can't happen because this library is defined using the current stanza *) >>| Option.value_exn diff --git a/src/dune_rules/ml_sources.mli b/src/dune_rules/ml_sources.mli index 437f3ac18b4..ec1491c1640 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_info.Sentinel.t + | Library of Lib_info.Library_id.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 cedc971d793..ba54e221e5b 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -951,11 +951,11 @@ let setup_private_library_doc_alias sctx ~scope ~dir (l : Library.t) = | Private _ -> let ctx = Super_context.context sctx in let* lib = - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_sentinel ~src_dir l + Library.to_library_id ~src_dir l in - Lib.DB.find_sentinel_even_when_hidden (Scope.libs scope) sentinel + Lib.DB.find_library_id_even_when_hidden (Scope.libs scope) library_id >>| 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 63961aedded..dc43761e84f 100644 --- a/src/dune_rules/odoc_new.ml +++ b/src/dune_rules/odoc_new.ml @@ -265,8 +265,8 @@ let libs_maps_def = | Some location -> let info = Dune_package.Lib.info l in let name = Lib_info.name info in - let sentinel = Lib_info.sentinel info in - Lib.DB.find_sentinel db sentinel + let library_id = Lib_info.library_id info in + Lib.DB.find_library_id db library_id >>| (function | None -> maps | Some lib -> diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index b901074db0e..0792e95697a 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -69,17 +69,17 @@ module DB = struct let resolve_name = let module Resolve_result = Lib.DB.Resolve_result in let module With_multiple_results = Resolve_result.With_multiple_results in - fun ~resolve_sentinel id_map name -> + fun ~resolve_library_id id_map name -> match - Lib_name.Map.find id_map name |> Option.map ~f:Lib_info.Sentinel.Set.to_list + Lib_name.Map.find id_map name |> Option.map ~f:Lib_info.Library_id.Set.to_list with | None -> Memo.return (With_multiple_results.resolve_result Resolve_result.not_found) | Some [] -> assert false - | Some [ sentinel ] -> - resolve_sentinel sentinel >>| With_multiple_results.resolve_result + | Some [ library_id ] -> + resolve_library_id library_id >>| With_multiple_results.resolve_result | Some xs -> - Memo.List.map ~f:resolve_sentinel xs >>| With_multiple_results.multiple_results + Memo.List.map ~f:resolve_library_id xs >>| With_multiple_results.multiple_results ;; module Library_related_stanza = struct @@ -90,7 +90,7 @@ module DB = struct end let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = - let sentinel_map, id_map = + let library_id_map, id_map = let libs = List.map stanzas ~f:(fun stanza -> match (stanza : Library_related_stanza.t) with @@ -106,25 +106,25 @@ module DB = struct let lib_name, redirect = Found_or_redirect.redirect ~enabled old_public_name s.new_public_name in - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Lib_info.Sentinel.make + Lib_info.Library_id.make ~loc:s.loc ~src_dir ~enabled_if:s.old_name.enabled lib_name in - lib_name, (sentinel, redirect) + lib_name, (library_id, redirect) | Deprecated_library_name (dir, s) -> let old_public_name = Deprecated_library_name.old_public_name s in let lib_name, deprecated_lib = Found_or_redirect.deprecated_library_name old_public_name s.new_public_name in - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Deprecated_library_name.to_sentinel ~src_dir s + Deprecated_library_name.to_library_id ~src_dir s in - lib_name, (sentinel, deprecated_lib) + lib_name, (library_id, deprecated_lib) | Library (dir, (conf : Library.t)) -> let info = let expander = Expander0.get ~dir in @@ -132,18 +132,18 @@ module DB = struct in let stanza_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_sentinel ~src_dir conf + Library.to_library_id ~src_dir conf in Library.best_name conf, (stanza_id, Found_or_redirect.found info)) in - let _, id_map, sentinel_map = + let _, id_map, library_id_map = List.fold_left libs - ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Sentinel.Map.empty) + ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Library_id.Map.empty) ~f: (fun - (libname_map, id_map, sentinel_map) - (name, ((sentinel, r2) : Lib_info.Sentinel.t * Found_or_redirect.t)) + (libname_map, id_map, library_id_map) + (name, ((library_id, r2) : Lib_info.Library_id.t * Found_or_redirect.t)) -> let libname_map' = Lib_name.Map.update libname_map name ~f:(function @@ -190,22 +190,24 @@ module DB = struct ])) in let id_map' = - let id_map : Lib_info.Sentinel.Set.t Lib_name.Map.t = id_map in - Lib_name.Map.update id_map name ~f:(fun sentinels -> + let id_map : Lib_info.Library_id.Set.t Lib_name.Map.t = id_map in + Lib_name.Map.update id_map name ~f:(fun library_ids -> match - Option.map sentinels ~f:(fun sentinels -> - Lib_info.Sentinel.Set.add sentinels sentinel) + Option.map library_ids ~f:(fun library_ids -> + Lib_info.Library_id.Set.add library_ids library_id) with - | None -> Some (Lib_info.Sentinel.Set.singleton sentinel) + | None -> Some (Lib_info.Library_id.Set.singleton library_id) | Some s -> Some s) in - let sentinel_map' = Lib_info.Sentinel.Map.add_exn sentinel_map sentinel r2 in - libname_map', id_map', sentinel_map') + let library_id_map' = + Lib_info.Library_id.Map.add_exn library_id_map library_id r2 + in + libname_map', id_map', library_id_map') in - sentinel_map, id_map + library_id_map, id_map in - let resolve_sentinel library_id = - match Lib_info.Sentinel.Map.find sentinel_map library_id with + let resolve_library_id library_id = + match Lib_info.Library_id.Map.find library_id_map library_id with | None -> Memo.return Lib.DB.Resolve_result.not_found | Some (Redirect { loc; to_; enabled; _ }) -> let+ enabled = @@ -219,13 +221,13 @@ module DB = struct | Some (Deprecated_library_name lib) -> Memo.return (Lib.DB.Resolve_result.redirect_in_the_same_db lib) in - let resolve_name = resolve_name ~resolve_sentinel id_map in + let resolve_name = resolve_name ~resolve_library_id id_map in Lib.DB.create () ~parent:(Some parent) ~resolve_name - ~resolve_sentinel - ~all:(fun () -> Lib_info.Sentinel.Map.keys sentinel_map |> Memo.return) + ~resolve_library_id + ~all:(fun () -> Lib_info.Library_id.Map.keys library_id_map |> Memo.return) ~lib_config ~instrument_with ;; @@ -233,16 +235,16 @@ module DB = struct type redirect_to = | Project of { project : Dune_project.t - ; sentinel : Lib_info.Sentinel.t + ; library_id : Lib_info.Library_id.t } | Name of (Loc.t * Lib_name.t) - let resolve t public_libs sentinel : Lib.DB.Resolve_result.t = - match Lib_info.Sentinel.Map.find public_libs sentinel with + let resolve t public_libs library_id : Lib.DB.Resolve_result.t = + match Lib_info.Library_id.Map.find public_libs library_id with | None -> Lib.DB.Resolve_result.not_found - | Some (Project { project; sentinel }) -> + | Some (Project { project; library_id }) -> let scope = find_by_project (Fdecl.get t) project in - Lib.DB.Resolve_result.redirect scope.db sentinel + Lib.DB.Resolve_result.redirect scope.db library_id | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db name ;; @@ -252,45 +254,45 @@ module DB = struct let _, public_ids, public_libs = List.fold_left stanzas - ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Sentinel.Map.empty) + ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Library_id.Map.empty) ~f: (fun - (libname_map, id_map, sentinel_map) (stanza : Library_related_stanza.t) -> + (libname_map, id_map, library_id_map) (stanza : Library_related_stanza.t) -> let candidate = match stanza with | Library (dir, ({ project; visibility = Public p; _ } as conf)) -> - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_sentinel ~src_dir conf + Library.to_library_id ~src_dir conf in - Some (Public_lib.name p, Project { project; sentinel }, sentinel) + Some (Public_lib.name p, Project { project; library_id }, library_id) | Library _ | Library_redirect _ -> None | Deprecated_library_name (dir, s) -> - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Deprecated_library_name.to_sentinel ~src_dir s + Deprecated_library_name.to_library_id ~src_dir s in Some ( Deprecated_library_name.old_public_name s , Name s.new_public_name - , sentinel ) + , library_id ) in match candidate with - | None -> libname_map, id_map, sentinel_map - | Some (public_name, r2, sentinel) -> + | None -> libname_map, id_map, library_id_map + | Some (public_name, r2, library_id) -> let libname_map' = Lib_name.Map.update libname_map public_name ~f:(function - | None -> Some (sentinel, r2) + | None -> Some (library_id, r2) | Some (sent1, _r1) -> - (match (Lib_info.Sentinel.equal sent1) sentinel with - | false -> Some (sentinel, r2) + (match (Lib_info.Library_id.equal sent1) library_id with + | false -> Some (library_id, r2) | true -> - let loc1 = Lib_info.Sentinel.loc sent1 - and loc2 = Lib_info.Sentinel.loc sentinel in + let loc1 = Lib_info.Library_id.loc sent1 + and loc2 = Lib_info.Library_id.loc library_id in let main_message = Pp.textf "Public library %s is defined twice:" @@ -317,29 +319,29 @@ module DB = struct ])) in let id_map' = - let id_map : Lib_info.Sentinel.Set.t Lib_name.Map.t = id_map in - Lib_name.Map.update id_map public_name ~f:(fun sentinels -> + let id_map : Lib_info.Library_id.Set.t Lib_name.Map.t = id_map in + Lib_name.Map.update id_map public_name ~f:(fun library_ids -> match - Option.map sentinels ~f:(fun sentinels -> - Lib_info.Sentinel.Set.add sentinels sentinel) + Option.map library_ids ~f:(fun library_ids -> + Lib_info.Library_id.Set.add library_ids library_id) with - | None -> Some (Lib_info.Sentinel.Set.singleton sentinel) + | None -> Some (Lib_info.Library_id.Set.singleton library_id) | Some s -> Some s) in - let sentinel_map' = - Lib_info.Sentinel.Map.add_exn sentinel_map sentinel r2 + let library_id_map' = + Lib_info.Library_id.Map.add_exn library_id_map library_id r2 in - libname_map', id_map', sentinel_map') + libname_map', id_map', library_id_map') in public_libs, public_ids in - let resolve_sentinel sentinel = Memo.return (resolve t public_libs sentinel) in - let resolve_name = resolve_name ~resolve_sentinel public_ids in + let resolve_library_id library_id = Memo.return (resolve t public_libs library_id) in + let resolve_name = resolve_name ~resolve_library_id public_ids in Lib.DB.create ~parent:(Some installed_libs) ~resolve_name - ~resolve_sentinel - ~all:(fun () -> Lib_info.Sentinel.Map.keys public_libs |> Memo.return) + ~resolve_library_id + ~all:(fun () -> Lib_info.Library_id.Map.keys public_libs |> Memo.return) ~lib_config () ;; @@ -481,7 +483,7 @@ module DB = struct module Lib_entry = struct type t = - | Library of Lib_info.Sentinel.t * Lib.Local.t + | Library of Lib_info.Library_id.t * Lib.Local.t | Deprecated_library_name of Deprecated_library_name.t let name = function @@ -498,16 +500,16 @@ module DB = struct match Stanza.repr stanza with | Library.T ({ visibility = Private (Some pkg); _ } as lib) -> let src_dir = Dune_file.dir d in - let sentinel = Library.to_sentinel ~src_dir lib in + let library_id = Library.to_library_id ~src_dir lib in let+ lib = let* scope = find_by_dir (Path.Build.append_source build_dir src_dir) in - Lib.DB.find_sentinel (libs scope) sentinel + Lib.DB.find_library_id (libs scope) library_id in (match lib with | None -> acc | Some lib -> let name = Package.name pkg in - (name, Lib_entry.Library (sentinel, Lib.Local.of_lib_exn lib)) :: acc) + (name, Lib_entry.Library (library_id, Lib.Local.of_lib_exn lib)) :: acc) | Library.T { visibility = Public pub; _ } -> let+ lib = Lib.DB.find public_libs (Public_lib.name pub) in (match lib with @@ -516,8 +518,8 @@ module DB = struct let package = Public_lib.package pub in let name = Package.name package in let local_lib = Lib.Local.of_lib_exn lib in - let sentinel = Lib.sentinel lib in - (name, Lib_entry.Library (sentinel, local_lib)) :: acc) + let library_id = Lib.library_id lib in + (name, Lib_entry.Library (library_id, 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/scope.mli b/src/dune_rules/scope.mli index d602fd41a65..de95f8ec015 100644 --- a/src/dune_rules/scope.mli +++ b/src/dune_rules/scope.mli @@ -22,7 +22,7 @@ module DB : sig module Lib_entry : sig type t = - | Library of Lib_info.Sentinel.t * Lib.Local.t + | Library of Lib_info.Library_id.t * Lib.Local.t | Deprecated_library_name of Deprecated_library_name.t end diff --git a/src/dune_rules/stanzas/deprecated_library_name.ml b/src/dune_rules/stanzas/deprecated_library_name.ml index 5be6ce66d44..e89eb81dd6f 100644 --- a/src/dune_rules/stanzas/deprecated_library_name.ml +++ b/src/dune_rules/stanzas/deprecated_library_name.ml @@ -48,10 +48,10 @@ let decode = { Library_redirect.loc; project; old_name; new_public_name }) ;; -let to_sentinel ~src_dir (t : t) = +let to_library_id ~src_dir (t : t) = let loc, name = let lib, _ = t.old_name in Public_lib.loc lib, Public_lib.name lib and enabled_if = Blang.true_ in - Lib_info.Sentinel.make ~loc ~src_dir ~enabled_if name + Lib_info.Library_id.make ~loc ~src_dir ~enabled_if name ;; diff --git a/src/dune_rules/stanzas/deprecated_library_name.mli b/src/dune_rules/stanzas/deprecated_library_name.mli index a6465d514c0..8cb94f3eca4 100644 --- a/src/dune_rules/stanzas/deprecated_library_name.mli +++ b/src/dune_rules/stanzas/deprecated_library_name.mli @@ -15,4 +15,4 @@ val decode : t Dune_lang.Decoder.t include Stanza.S with type t := t val old_public_name : t -> Lib_name.t -val to_sentinel : src_dir:Path.Source.t -> t -> Lib_info.Sentinel.t +val to_library_id : src_dir:Path.Source.t -> t -> Lib_info.Library_id.t diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index ab8fc26a920..757be5f24aa 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -403,13 +403,13 @@ let main_module_name t : Lib_info.Main_module_name.t = This (Some (Module_name.of_local_lib_name t.name)) ;; -let to_sentinel ~src_dir t = +let to_library_id ~src_dir t = let loc, name = let ((loc, _) as name) = t.name in loc, Lib_name.of_local name in let enabled_if = t.enabled_if in - Lib_info.Sentinel.make ~loc ~src_dir ~enabled_if name + Lib_info.Library_id.make ~loc ~src_dir ~enabled_if name ;; let to_lib_info @@ -485,9 +485,9 @@ let to_lib_info in let main_module_name = main_module_name conf in let name = best_name conf in - let sentinel = + let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - to_sentinel ~src_dir conf + to_library_id ~src_dir conf in let enabled = let+ enabled_if_result = @@ -550,7 +550,7 @@ let to_lib_info ~loc ~path_kind:Local ~name - ~sentinel + ~library_id ~kind ~status ~src_dir diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index 989e8d267e8..d52fe4ff9d0 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -76,7 +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_sentinel : src_dir:Path.Source.t -> t -> Lib_info.Sentinel.t +val to_library_id : src_dir:Path.Source.t -> t -> Lib_info.Library_id.t val to_lib_info : t diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index c13bae3ff41..9e5325720e5 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -95,7 +95,7 @@ let impl sctx ~(lib : Library.t) ~scope = | External modules, External fa -> Memo.return (modules, fa) | Local, Local -> let name = Lib.name vlib in - let sentinel = Lib.sentinel vlib in + let library_id = Lib.library_id vlib in let vlib = Lib.Local.of_lib_exn vlib in let* dir_contents = let info = Lib.Local.info vlib in @@ -116,7 +116,7 @@ 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 sentinel) + >>| Ml_sources.modules ~for_:(Library library_id) >>= Modules.map_user_written ~f:(fun m -> Memo.return (pp_spec m)) in let+ foreign_objects = From 590a32dd6b16748210c212f4e5421bd57ddb0aaa Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 12:43:13 -0700 Subject: [PATCH 06/38] refactor: remove `library_id` from Lib.t Signed-off-by: Antonio Nuno Monteiro --- bin/describe/describe_workspace.ml | 2 +- src/dune_rules/dir_contents.ml | 7 ++----- src/dune_rules/dune_package.ml | 4 +--- src/dune_rules/install_rules.ml | 10 ++++------ src/dune_rules/lib.ml | 8 +++----- src/dune_rules/lib.mli | 1 - src/dune_rules/ml_sources.ml | 4 ++-- src/dune_rules/scope.ml | 2 +- src/dune_rules/virtual_rules.ml | 2 +- 9 files changed, 15 insertions(+), 25 deletions(-) diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index 7234223d633..0f24ba36055 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -449,7 +449,7 @@ module Crawl = struct | true -> (* XXX why do we have a second object directory? *) let* modules_, obj_dir_ = - let library_id = Lib.library_id lib in + let library_id = Lib_info.library_id info in Dir_contents.get sctx ~dir:(Path.as_in_build_dir_exn src_dir) >>= Dir_contents.ocaml >>| Ml_sources.modules_and_obj_dir ~for_:(Library library_id) diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index 872b60f0f6c..595d54eb807 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -451,18 +451,15 @@ end include Load let modules_of_local_lib sctx lib = + let info = Lib.Local.info lib in let+ sources = let* t = - let info = Lib.Local.info lib in let dir = Lib_info.src_dir info in get sctx ~dir in ocaml t in - let library_id = - let lib = Lib.Local.to_lib lib in - Lib.library_id lib - in + let library_id = Lib_info.library_id info in Ml_sources.modules sources ~for_:(Library library_id) ;; diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 91c85694241..1d66e7beeb8 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -382,9 +382,7 @@ module Entry = struct ;; let library_id = function - | Library lib | Hidden_library lib -> - let info = Lib.info lib in - Lib_info.library_id info + | Library lib | Hidden_library lib -> Lib_info.library_id (Lib.info lib) | Deprecated_library_name _ -> assert false ;; diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index e019228a48e..909aec853a9 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -85,9 +85,10 @@ end = struct >>| List.singleton ;; - let lib_files ~dir_contents ~dir ~lib_config ~library_id lib = + let lib_files ~dir_contents ~dir ~lib_config lib = let+ modules = let+ ml_sources = Dir_contents.ocaml dir_contents in + let library_id = Lib_info.library_id lib in Some (Ml_sources.modules ml_sources ~for_:(Library library_id)) and+ foreign_archives = match Lib_info.virtual_ lib with @@ -179,12 +180,9 @@ end = struct ~lib_config in let lib_name = Library.best_name lib in - let library_id = - let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_library_id ~src_dir lib - in let* installable_modules = let+ modules = + let library_id = Lib_info.library_id info in Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library library_id) and+ impl = Virtual_rules.impl sctx ~lib ~scope in Vimpl.impl_modules impl modules |> Modules.split_by_lib @@ -309,7 +307,7 @@ end = struct if Module.kind m = Virtual then [] else common m |> set_dir m) in modules_vlib @ modules_impl - and+ lib_files = lib_files ~dir ~dir_contents ~lib_config ~library_id info + and+ lib_files = lib_files ~dir ~dir_contents ~lib_config info and+ execs = lib_ppxs ctx ~scope ~lib and+ dll_files = dll_files ~modes:ocaml ~dynlink:lib.dynlink ~ctx info diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 68cf4f5079f..b8db0d6cf84 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -352,7 +352,6 @@ module T = struct { info : Lib_info.external_ ; name : Lib_name.t ; unique_id : Id.t - ; library_id : Lib_info.Library_id.t ; re_exports : t list Resolve.t ; (* [requires] is contains all required libraries, including the ones mentioned in [re_exports]. *) @@ -456,7 +455,6 @@ and resolve_result_with_multiple_results = let lib_config (t : lib) = t.lib_config let name t = t.name -let library_id t = t.library_id let info t = t.info let project t = t.project let implements t = Option.map ~f:Memo.return t.implements @@ -1071,7 +1069,6 @@ end = struct let* package = Lib_info.package info in Package.Name.Map.find projects_by_package package in - let library_id = Lib_info.library_id info in let rec t = lazy (let open Resolve.O in @@ -1081,7 +1078,6 @@ end = struct { info ; name ; unique_id - ; library_id ; requires ; ppx_runtime_deps ; pps @@ -1226,7 +1222,9 @@ end = struct List.fold_left libs ~init:Status.Not_found ~f:(fun acc status -> match acc, status with | Status.Found a, Status.Found b -> - (match Lib_info.Library_id.equal a.library_id b.library_id with + let library_id_a = Lib_info.library_id a.info + and library_id_b = Lib_info.library_id b.info in + (match Lib_info.Library_id.equal library_id_a library_id_b with | true -> acc | false -> let a = info a diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 3d90b6c6636..1622df96ada 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -11,7 +11,6 @@ val to_dyn : t -> Dyn.t or the [name] if not. *) val name : t -> Lib_name.t -val library_id : t -> Lib_info.Library_id.t val lib_config : t -> Lib_config.t val implements : t -> t Resolve.Memo.t option diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 5203c4e8f43..a5ef3793865 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -275,14 +275,14 @@ let modules t ~for_ = modules_and_obj_dir t ~for_ |> fst let find_origin (t : t) path = Module_name.Path.Map.find t.modules.rev_map path let virtual_modules ~lookup_vlib vlib = - let info = Lib.info vlib in let+ modules = + let info = Lib.info vlib in match Option.value_exn (Lib_info.virtual_ info) with | External modules -> Memo.return modules | 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.library_id vlib)) + modules t ~for_:(Library (Lib_info.library_id info)) in let existing_virtual_modules = Modules_group.virtual_module_names modules in let allow_new_public_modules = diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 0792e95697a..d607652b259 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -518,7 +518,7 @@ module DB = struct let package = Public_lib.package pub in let name = Package.name package in let local_lib = Lib.Local.of_lib_exn lib in - let library_id = Lib.library_id lib in + let library_id = Lib_info.library_id (Lib.info lib) in (name, Lib_entry.Library (library_id, local_lib)) :: acc) | Deprecated_library_name.T ({ old_name = old_public_name, _; _ } as d) -> let package = Public_lib.package old_public_name in diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index 9e5325720e5..ff9269203fa 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -95,7 +95,6 @@ let impl sctx ~(lib : Library.t) ~scope = | External modules, External fa -> Memo.return (modules, fa) | Local, Local -> let name = Lib.name vlib in - let library_id = Lib.library_id vlib in let vlib = Lib.Local.of_lib_exn vlib in let* dir_contents = let info = Lib.Local.info vlib in @@ -115,6 +114,7 @@ let impl sctx ~(lib : Library.t) ~scope = let pp_spec = Staged.unstage (Preprocessing.pped_modules_map preprocess ocaml.version) in + let library_id = Lib_info.library_id info in Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library library_id) >>= Modules.map_user_written ~f:(fun m -> Memo.return (pp_spec m)) From bcdfa5ad6fad2c5ee3c21e2069a6fec014bc7d4f Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 13:05:28 -0700 Subject: [PATCH 07/38] refactor: tighten bindings, remove unnecessary lib id payload Signed-off-by: Antonio Nuno Monteiro --- bin/describe/describe_workspace.ml | 3 +-- src/dune_rules/dir_contents.ml | 11 ++++------- src/dune_rules/gen_meta.ml | 2 +- src/dune_rules/gen_rules.ml | 5 +++-- src/dune_rules/install_rules.ml | 23 +++++++++++++---------- src/dune_rules/odoc.ml | 2 +- src/dune_rules/scope.ml | 12 +++++------- src/dune_rules/scope.mli | 2 +- 8 files changed, 29 insertions(+), 31 deletions(-) diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index 0f24ba36055..9b9c0b78b2b 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -449,10 +449,9 @@ module Crawl = struct | true -> (* XXX why do we have a second object directory? *) let* modules_, obj_dir_ = - let library_id = Lib_info.library_id info in Dir_contents.get sctx ~dir:(Path.as_in_build_dir_exn src_dir) >>= Dir_contents.ocaml - >>| Ml_sources.modules_and_obj_dir ~for_:(Library library_id) + >>| Ml_sources.modules_and_obj_dir ~for_:(Library (Lib_info.library_id info)) in let* pp_map = let+ version = diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index 595d54eb807..cb906e349a4 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -452,15 +452,12 @@ include Load let modules_of_local_lib sctx lib = let info = Lib.Local.info lib in - let+ sources = - let* t = - let dir = Lib_info.src_dir info in - get sctx ~dir - in - ocaml t + let* t = + let dir = Lib_info.src_dir info in + get sctx ~dir in let library_id = Lib_info.library_id info in - Ml_sources.modules sources ~for_:(Library library_id) + ocaml t >>| Ml_sources.modules ~for_:(Library library_id) ;; let modules_of_lib sctx lib = diff --git a/src/dune_rules/gen_meta.ml b/src/dune_rules/gen_meta.ml index 764604905a5..ad6bf39056c 100644 --- a/src/dune_rules/gen_meta.ml +++ b/src/dune_rules/gen_meta.ml @@ -163,7 +163,7 @@ let gen ~(package : Package.t) ~add_directory_entry entries = let+ pkgs = Memo.parallel_map entries ~f:(fun (e : Scope.DB.Lib_entry.t) -> match e with - | Library (_, lib) -> + | Library lib -> let info = Lib.Local.info lib in let pub_name = let name = Lib_info.name info in diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 2d1bb4fa584..0301de3f1f6 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -112,8 +112,9 @@ end = struct empty_none | Library.T lib -> let* enabled_if = - let library_id = Library.to_library_id ~src_dir lib in - Lib.DB.available_by_library_id (Scope.libs scope) library_id + Lib.DB.available_by_library_id + (Scope.libs scope) + (Library.to_library_id ~src_dir lib) in if_available_buildable ~loc:lib.buildable.loc diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 909aec853a9..06a7f5d73a1 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -88,8 +88,7 @@ end = struct let lib_files ~dir_contents ~dir ~lib_config lib = let+ modules = let+ ml_sources = Dir_contents.ocaml dir_contents in - let library_id = Lib_info.library_id lib in - Some (Ml_sources.modules ml_sources ~for_:(Library library_id)) + Some (Ml_sources.modules ml_sources ~for_:(Library (Lib_info.library_id lib))) and+ foreign_archives = match Lib_info.virtual_ lib with | None -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) @@ -182,8 +181,8 @@ end = struct let lib_name = Library.best_name lib in let* installable_modules = let+ modules = - let library_id = Lib_info.library_id info in - Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library library_id) + Dir_contents.ocaml dir_contents + >>| Ml_sources.modules ~for_:(Library (Lib_info.library_id info)) and+ impl = Virtual_rules.impl sctx ~lib ~scope in Vimpl.impl_modules impl modules |> Modules.split_by_lib in @@ -332,7 +331,7 @@ end = struct ] ;; - let keep_if ~expander ~scope ~dir stanza = + let keep_if expander ~scope stanza = let+ keep = match Stanza.repr stanza with | Library.T lib -> @@ -342,7 +341,11 @@ end = struct if lib.optional then ( let library_id = - let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + let src_dir = + Expander.dir expander + |> Path.build + |> Path.drop_optional_build_context_src_exn + in Library.to_library_id ~src_dir lib in Lib.DB.available_by_library_id (Scope.libs scope) library_id) @@ -454,7 +457,7 @@ end = struct ;; let stanza_to_entries ~package_db ~sctx ~dir ~scope ~expander stanza = - (let+ stanza = keep_if ~expander ~scope ~dir stanza in + (let+ stanza = keep_if expander ~scope stanza in let open Option.O in let* stanza = stanza in let+ package = Stanzas.stanza_package stanza in @@ -627,7 +630,7 @@ end = struct ( old_public_name , Dune_package.Entry.Deprecated_library_name { loc; old_public_name; new_public_name } )) - | Library (library_id, lib) -> + | Library lib -> let info = Lib.Local.info lib in let dir = Lib_info.src_dir info in let* dir_contents = Dir_contents.get sctx ~dir in @@ -660,7 +663,7 @@ end = struct |> List.map ~f:Path.build and* modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library library_id) + >>| Ml_sources.modules ~for_:(Library (Lib_info.library_id info)) 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 = @@ -811,7 +814,7 @@ end = struct let* () = Action_builder.return () in match List.find_map entries ~f:(function - | Library (_, lib) -> + | Library lib -> let info = Lib.Local.info lib in Option.some_if (Option.is_some (Lib_info.virtual_ info)) lib | Deprecated_library_name _ -> None) diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index ba54e221e5b..27719dba847 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -583,7 +583,7 @@ let libs_of_pkg ctx ~pkg = List.filter_map entries ~f:(fun (entry : Scope.DB.Lib_entry.t) -> match entry with | Deprecated_library_name _ -> None - | Library (_, lib) -> + | Library lib -> (match Lib.Local.to_lib lib |> Lib.info |> Lib_info.implements with | None -> Some lib | Some _ -> None)) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index d607652b259..b26091451f0 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -483,11 +483,11 @@ module DB = struct module Lib_entry = struct type t = - | Library of Lib_info.Library_id.t * Lib.Local.t + | Library of Lib.Local.t | Deprecated_library_name of Deprecated_library_name.t let name = function - | Library (_, lib) -> Lib.Local.to_lib lib |> Lib.name + | Library lib -> Lib.Local.to_lib lib |> Lib.name | Deprecated_library_name { old_name = old_public_name, _; _ } -> Public_lib.name old_public_name ;; @@ -500,16 +500,15 @@ module DB = struct match Stanza.repr stanza with | Library.T ({ visibility = Private (Some pkg); _ } as lib) -> let src_dir = Dune_file.dir d in - let library_id = Library.to_library_id ~src_dir lib in let+ lib = let* scope = find_by_dir (Path.Build.append_source build_dir src_dir) in - Lib.DB.find_library_id (libs scope) library_id + Lib.DB.find_library_id (libs scope) (Library.to_library_id ~src_dir lib) in (match lib with | None -> acc | Some lib -> let name = Package.name pkg in - (name, Lib_entry.Library (library_id, Lib.Local.of_lib_exn lib)) :: acc) + (name, Lib_entry.Library (Lib.Local.of_lib_exn lib)) :: acc) | Library.T { visibility = Public pub; _ } -> let+ lib = Lib.DB.find public_libs (Public_lib.name pub) in (match lib with @@ -518,8 +517,7 @@ module DB = struct let package = Public_lib.package pub in let name = Package.name package in let local_lib = Lib.Local.of_lib_exn lib in - let library_id = Lib_info.library_id (Lib.info lib) in - (name, Lib_entry.Library (library_id, local_lib)) :: acc) + (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/scope.mli b/src/dune_rules/scope.mli index de95f8ec015..58f20daffb9 100644 --- a/src/dune_rules/scope.mli +++ b/src/dune_rules/scope.mli @@ -22,7 +22,7 @@ module DB : sig module Lib_entry : sig type t = - | Library of Lib_info.Library_id.t * Lib.Local.t + | Library of Lib.Local.t | Deprecated_library_name of Deprecated_library_name.t end From 0efd9d358f46f742750b1d09f3af9dd600e07b90 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 13:05:53 -0700 Subject: [PATCH 08/38] refactor: remove path from constructor Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/scope.ml | 46 ++++++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index b26091451f0..665d9b8e88f 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -84,17 +84,17 @@ module DB = struct module Library_related_stanza = struct type t = - | Library of Path.Build.t * Library.t - | Library_redirect of Path.Build.t * Library_redirect.Local.t - | Deprecated_library_name of Path.Build.t * Deprecated_library_name.t + | Library of Library.t + | Library_redirect of Library_redirect.Local.t + | Deprecated_library_name of Deprecated_library_name.t end let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = let library_id_map, id_map = let libs = - List.map stanzas ~f:(fun stanza -> + List.map stanzas ~f:(fun (dir, stanza) -> match (stanza : Library_related_stanza.t) with - | Library_redirect (dir, s) -> + | Library_redirect s -> let old_public_name = Lib_name.of_local s.old_name.lib_name in let enabled = Memo.lazy_ (fun () -> @@ -115,7 +115,7 @@ module DB = struct lib_name in lib_name, (library_id, redirect) - | Deprecated_library_name (dir, s) -> + | Deprecated_library_name s -> let old_public_name = Deprecated_library_name.old_public_name s in let lib_name, deprecated_lib = Found_or_redirect.deprecated_library_name old_public_name s.new_public_name @@ -125,7 +125,7 @@ module DB = struct Deprecated_library_name.to_library_id ~src_dir s in lib_name, (library_id, deprecated_lib) - | Library (dir, (conf : Library.t)) -> + | 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 @@ -257,10 +257,12 @@ module DB = struct ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Library_id.Map.empty) ~f: (fun - (libname_map, id_map, library_id_map) (stanza : Library_related_stanza.t) -> + (libname_map, id_map, library_id_map) + ((dir, stanza) : Path.Build.t * Library_related_stanza.t) + -> let candidate = match stanza with - | Library (dir, ({ project; visibility = Public p; _ } as conf)) -> + | Library ({ project; visibility = Public p; _ } as conf) -> let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) @@ -269,7 +271,7 @@ module DB = struct in Some (Public_lib.name p, Project { project; library_id }, library_id) | Library _ | Library_redirect _ -> None - | Deprecated_library_name (dir, s) -> + | Deprecated_library_name s -> let library_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) @@ -359,14 +361,16 @@ module DB = struct coq_stanzas = let stanzas_by_project_dir = - List.map stanzas ~f:(fun (stanza : Library_related_stanza.t) -> - let project = - match stanza with - | Library (_, lib) -> lib.project - | Library_redirect (_, x) -> x.project - | Deprecated_library_name (_, x) -> x.project - in - Dune_project.root project, stanza) + List.map + stanzas + ~f:(fun ((dir, stanza) : Path.Build.t * Library_related_stanza.t) -> + let project = + match stanza with + | Library lib -> lib.project + | Library_redirect x -> x.project + | Deprecated_library_name x -> x.project + in + Dune_project.root project, (dir, stanza)) |> Path.Source.Map.of_list_multi in let db_by_project_dir = @@ -432,13 +436,13 @@ module DB = struct 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 + (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 - Deprecated_library_name (ctx_dir, d) :: acc, coq_acc + (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 - Library_redirect (ctx_dir, d) :: acc, coq_acc + (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 From 4d70eb9a6703327ee09d134943c47dce3e935172 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 13:20:39 -0700 Subject: [PATCH 09/38] refactor: rename resolve_name back to resolve, tighten bindings Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/install_rules.ml | 7 ++----- src/dune_rules/lib.ml | 22 +++++++--------------- src/dune_rules/lib.mli | 2 +- src/dune_rules/lib_info.ml | 3 +-- src/dune_rules/lib_rules.ml | 12 +++++++----- src/dune_rules/ml_sources.ml | 2 +- src/dune_rules/odoc_new.ml | 5 ++--- src/dune_rules/scope.ml | 21 ++++++++++++--------- src/dune_rules/virtual_rules.ml | 3 +-- 9 files changed, 34 insertions(+), 43 deletions(-) diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 06a7f5d73a1..745b63d0f66 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -457,7 +457,7 @@ end = struct ;; let stanza_to_entries ~package_db ~sctx ~dir ~scope ~expander stanza = - (let+ stanza = keep_if expander ~scope stanza in + (let+ stanza = keep_if expander stanza ~scope in let open Option.O in let* stanza = stanza in let+ package = Stanzas.stanza_package stanza in @@ -743,9 +743,6 @@ end = struct acc >>> let dune_pkg = - let dir = - Path.build (Install.Context.lib_dir ~context:ctx.name ~package:name) - in let entries = match Package.Name.Map.find deprecated_dune_packages name with | None -> Lib_name.Map.empty @@ -773,7 +770,7 @@ end = struct { Dune_package.version = Package.version pkg ; name ; entries - ; dir + ; dir = Path.build (Install.Context.lib_dir ~context:ctx.name ~package:name) ; sections ; sites = Package.sites pkg ; files = [] diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index b8db0d6cf84..347b8dab930 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -431,7 +431,7 @@ end type db = { parent : db option - ; resolve_name : Lib_name.t -> resolve_result_with_multiple_results Memo.t + ; resolve : Lib_name.t -> resolve_result_with_multiple_results Memo.t ; resolve_library_id : Lib_info.Library_id.t -> resolve_result Memo.t ; instantiate : (Lib_name.t -> Path.t Lib_info.t -> hidden:string option -> Status.t Memo.t) Lazy.t @@ -1250,7 +1250,7 @@ end = struct let find_internal db (name : Lib_name.t) = let open Memo.O in let super db = find_internal db name in - db.resolve_name name >>= handle_resolve_result_with_multiple_results ~super db + 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 = @@ -1956,19 +1956,11 @@ module DB = struct type t = db - let create - ~parent - ~resolve_name - ~resolve_library_id - ~all - ~lib_config - ~instrument_with - () - = + let create ~parent ~resolve ~resolve_library_id ~all ~lib_config ~instrument_with () = let rec t = lazy { parent - ; resolve_name + ; resolve ; resolve_library_id ; all = Memo.lazy_ all ; lib_config @@ -1982,7 +1974,7 @@ module DB = struct let create_from_findlib = let bigarray = Lib_name.of_string "bigarray" in fun findlib ~has_bigarray_library ~lib_config -> - let resolve_name name = + let resolve name = let open Memo.O in Findlib.find findlib name >>| function @@ -2008,11 +2000,11 @@ module DB = struct () ~parent:None ~lib_config - ~resolve_name + ~resolve ~resolve_library_id:(fun library_id -> let open Memo.O in let name = Lib_info.Library_id.name library_id in - resolve_name name + resolve name >>| function | Multiple_results _ -> assert false | Resolve_result r -> r) diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 1622df96ada..ecca9b3c285 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -125,7 +125,7 @@ module DB : sig [all] returns the list of names of libraries available in this database. *) val create : parent:t option - -> resolve_name:(Lib_name.t -> Resolve_result.With_multiple_results.t Memo.t) + -> resolve:(Lib_name.t -> Resolve_result.With_multiple_results.t Memo.t) -> resolve_library_id:(Lib_info.Library_id.t -> Resolve_result.t Memo.t) -> all:(unit -> Lib_info.Library_id.t list Memo.t) -> lib_config:Lib_config.t diff --git a/src/dune_rules/lib_info.ml b/src/dune_rules/lib_info.ml index bfe3b2ab07f..3e9ca392758 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -327,8 +327,7 @@ module Library_id = struct let external_ ~loc ~src_dir name = { name; loc; enabled_if = Blang.true_; src_dir } let make ~loc ~src_dir ~enabled_if name = - let src_dir = Path.source src_dir in - { name; loc; enabled_if; src_dir } + { name; loc; enabled_if; src_dir = Path.source src_dir } ;; let name { name; _ } = name diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 06ce8938663..f8b23e0ccb2 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -644,11 +644,11 @@ let library_rules let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = let buildable = lib.buildable in - let library_id = - let src_dir = Path.Build.drop_build_context_exn dir in - Library.to_library_id ~src_dir lib - in let* local_lib, compile_info = + let library_id = + let src_dir = Path.Build.drop_build_context_exn dir in + Library.to_library_id ~src_dir lib + in Lib.DB.get_compile_info (Scope.libs scope) library_id @@ -657,7 +657,9 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = 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_id) + Dir_contents.ocaml dir_contents + >>| Ml_sources.modules + ~for_:(Library (Lib_info.library_id (Lib.Local.info local_lib))) 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 a5ef3793865..48a76a44bc1 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -275,8 +275,8 @@ let modules t ~for_ = modules_and_obj_dir t ~for_ |> fst let find_origin (t : t) path = Module_name.Path.Map.find t.modules.rev_map path let virtual_modules ~lookup_vlib vlib = + let info = Lib.info vlib in let+ modules = - let info = Lib.info vlib in match Option.value_exn (Lib_info.virtual_ info) with | External modules -> Memo.return modules | Local -> diff --git a/src/dune_rules/odoc_new.ml b/src/dune_rules/odoc_new.ml index dc43761e84f..e530dbfd5ce 100644 --- a/src/dune_rules/odoc_new.ml +++ b/src/dune_rules/odoc_new.ml @@ -265,8 +265,8 @@ let libs_maps_def = | Some location -> let info = Dune_package.Lib.info l in let name = Lib_info.name info in - let library_id = Lib_info.library_id info in - Lib.DB.find_library_id db library_id + let pkg = Lib_info.package info in + Lib.DB.find_library_id db (Lib_info.library_id info) >>| (function | None -> maps | Some lib -> @@ -283,7 +283,6 @@ let libs_maps_def = maps.loc_of_lib in let loc_of_pkg = - let pkg = Lib_info.package info in match pkg with | None -> maps.loc_of_pkg | Some pkg_name -> diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 665d9b8e88f..bb7613352a0 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -66,7 +66,7 @@ module DB = struct let found x = Found x end - let resolve_name = + let resolve = let module Resolve_result = Lib.DB.Resolve_result in let module With_multiple_results = Resolve_result.With_multiple_results in fun ~resolve_library_id id_map name -> @@ -221,11 +221,11 @@ module DB = struct | Some (Deprecated_library_name lib) -> Memo.return (Lib.DB.Resolve_result.redirect_in_the_same_db lib) in - let resolve_name = resolve_name ~resolve_library_id id_map in + let resolve = resolve ~resolve_library_id id_map in Lib.DB.create () ~parent:(Some parent) - ~resolve_name + ~resolve ~resolve_library_id ~all:(fun () -> Lib_info.Library_id.Map.keys library_id_map |> Memo.return) ~lib_config @@ -239,7 +239,7 @@ module DB = struct } | Name of (Loc.t * Lib_name.t) - let resolve t public_libs library_id : Lib.DB.Resolve_result.t = + let resolve_library_id t public_libs library_id : Lib.DB.Resolve_result.t = match Lib_info.Library_id.Map.find public_libs library_id with | None -> Lib.DB.Resolve_result.not_found | Some (Project { project; library_id }) -> @@ -337,11 +337,13 @@ module DB = struct in public_libs, public_ids in - let resolve_library_id library_id = Memo.return (resolve t public_libs library_id) in - let resolve_name = resolve_name ~resolve_library_id public_ids in + let resolve_library_id library_id = + Memo.return (resolve_library_id t public_libs library_id) + in + let resolve = resolve ~resolve_library_id public_ids in Lib.DB.create ~parent:(Some installed_libs) - ~resolve_name + ~resolve ~resolve_library_id ~all:(fun () -> Lib_info.Library_id.Map.keys public_libs |> Memo.return) ~lib_config @@ -503,10 +505,11 @@ module DB = struct Dune_file.Memo_fold.fold_static_stanzas stanzas ~init:[] ~f:(fun d stanza acc -> match Stanza.repr stanza with | Library.T ({ visibility = Private (Some pkg); _ } as lib) -> - let src_dir = Dune_file.dir d in let+ lib = + let src_dir = Dune_file.dir d in let* scope = find_by_dir (Path.Build.append_source build_dir src_dir) in - Lib.DB.find_library_id (libs scope) (Library.to_library_id ~src_dir lib) + let db = libs scope in + Lib.DB.find_library_id db (Library.to_library_id ~src_dir lib) in (match lib with | None -> acc diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index ff9269203fa..89cba153ac6 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -114,9 +114,8 @@ let impl sctx ~(lib : Library.t) ~scope = let pp_spec = Staged.unstage (Preprocessing.pped_modules_map preprocess ocaml.version) in - let library_id = Lib_info.library_id info in Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library library_id) + >>| Ml_sources.modules ~for_:(Library (Lib_info.library_id info)) >>= Modules.map_user_written ~f:(fun m -> Memo.return (pp_spec m)) in let+ foreign_objects = From 889ad47db2bfc2f643843ae51143df1593ceaba4 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 13:42:38 -0700 Subject: [PATCH 10/38] refactor: single pass over stanazas in scope Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/dir_contents.ml | 3 +- src/dune_rules/install_rules.ml | 15 ++- src/dune_rules/lib_rules.ml | 7 +- src/dune_rules/ml_sources.ml | 7 +- src/dune_rules/scope.ml | 128 ++++++++++---------- src/dune_rules/stanzas/library_redirect.ml | 7 ++ src/dune_rules/stanzas/library_redirect.mli | 1 + 7 files changed, 83 insertions(+), 85 deletions(-) diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index cb906e349a4..0b1365f79b9 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -456,8 +456,7 @@ let modules_of_local_lib sctx lib = let dir = Lib_info.src_dir info in get sctx ~dir in - let library_id = Lib_info.library_id info in - ocaml t >>| Ml_sources.modules ~for_:(Library library_id) + ocaml t >>| Ml_sources.modules ~for_:(Library (Lib_info.library_id info)) ;; let modules_of_lib sctx lib = diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 745b63d0f66..0ac32aa76c1 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -340,15 +340,14 @@ end = struct then if lib.optional then ( - let library_id = - let src_dir = - Expander.dir expander - |> Path.build - |> Path.drop_optional_build_context_src_exn - in - Library.to_library_id ~src_dir lib + let src_dir = + Expander.dir expander + |> Path.build + |> Path.drop_optional_build_context_src_exn in - Lib.DB.available_by_library_id (Scope.libs scope) library_id) + Lib.DB.available_by_library_id + (Scope.libs scope) + (Library.to_library_id ~src_dir lib)) else Memo.return true else Memo.return false | Documentation.T _ -> Memo.return true diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index f8b23e0ccb2..ead96ab4f6a 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -645,13 +645,10 @@ 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 library_id = - let src_dir = Path.Build.drop_build_context_exn dir in - Library.to_library_id ~src_dir lib - in + let src_dir = Path.Build.drop_build_context_exn dir in Lib.DB.get_compile_info (Scope.libs scope) - library_id + (Library.to_library_id ~src_dir lib) ~allow_overlaps:buildable.allow_overlapping_dependencies in let local_lib = Lib.Local.of_lib_exn local_lib in diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 48a76a44bc1..c80c55d6a33 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -332,11 +332,8 @@ let make_lib_modules let open Memo.O in let* resolved = let* libs = libs in - let library_id = - let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_library_id ~src_dir lib - in - Lib.DB.find_library_id_even_when_hidden libs library_id + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Lib.DB.find_library_id_even_when_hidden libs (Library.to_library_id ~src_dir lib) (* can't happen because this library is defined using the current stanza *) >>| Option.value_exn diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index bb7613352a0..7a63bf5f459 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -91,60 +91,59 @@ module DB = struct let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = let library_id_map, id_map = - let libs = - List.map stanzas ~f:(fun (dir, stanza) -> - match (stanza : Library_related_stanza.t) with - | Library_redirect s -> - let old_public_name = Lib_name.of_local s.old_name.lib_name in - let enabled = - Memo.lazy_ (fun () -> - let open Memo.O in - let* expander = Expander0.get ~dir in - let+ enabled = Expander0.eval_blang expander s.old_name.enabled in - Toggle.of_bool enabled) - in - let lib_name, redirect = - Found_or_redirect.redirect ~enabled old_public_name s.new_public_name - in - let library_id = - let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Lib_info.Library_id.make - ~loc:s.loc - ~src_dir - ~enabled_if:s.old_name.enabled - lib_name - in - lib_name, (library_id, redirect) - | Deprecated_library_name s -> - let old_public_name = Deprecated_library_name.old_public_name s in - let lib_name, deprecated_lib = - Found_or_redirect.deprecated_library_name old_public_name s.new_public_name - in - let library_id = - let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Deprecated_library_name.to_library_id ~src_dir s - in - lib_name, (library_id, 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 - in - let stanza_id = - let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_library_id ~src_dir conf - in - Library.best_name conf, (stanza_id, Found_or_redirect.found info)) - in let _, id_map, library_id_map = List.fold_left - libs + stanzas ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Library_id.Map.empty) - ~f: - (fun - (libname_map, id_map, library_id_map) - (name, ((library_id, r2) : Lib_info.Library_id.t * Found_or_redirect.t)) - -> + ~f:(fun (libname_map, id_map, library_id_map) (dir, stanza) -> + let name, library_id, r2 = + match (stanza : Library_related_stanza.t) with + | Library_redirect s -> + let old_public_name = Lib_name.of_local s.old_name.lib_name in + let enabled = + Memo.lazy_ (fun () -> + let open Memo.O in + let* expander = Expander0.get ~dir in + let+ enabled = Expander0.eval_blang expander s.old_name.enabled in + Toggle.of_bool enabled) + in + let lib_name, redirect = + Found_or_redirect.redirect ~enabled old_public_name s.new_public_name + in + let library_id = + let src_dir = + Path.drop_optional_build_context_src_exn (Path.build dir) + in + Library_redirect.Local.to_library_id ~src_dir s + in + lib_name, library_id, redirect + | Deprecated_library_name s -> + let old_public_name = Deprecated_library_name.old_public_name s in + let lib_name, deprecated_lib = + Found_or_redirect.deprecated_library_name + old_public_name + s.new_public_name + in + let library_id = + let src_dir = + Path.drop_optional_build_context_src_exn (Path.build dir) + in + Deprecated_library_name.to_library_id ~src_dir s + in + lib_name, library_id, 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 + in + let library_id = + let src_dir = + Path.drop_optional_build_context_src_exn (Path.build dir) + in + Library.to_library_id ~src_dir conf + in + Library.best_name conf, library_id, Found_or_redirect.found info + in let libname_map' = Lib_name.Map.update libname_map name ~f:(function | None -> Some r2 @@ -188,18 +187,19 @@ module DB = struct ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) ])) - in - let id_map' = + and id_map' = let id_map : Lib_info.Library_id.Set.t Lib_name.Map.t = id_map in Lib_name.Map.update id_map name ~f:(fun library_ids -> - match - Option.map library_ids ~f:(fun library_ids -> - Lib_info.Library_id.Set.add library_ids library_id) - with - | None -> Some (Lib_info.Library_id.Set.singleton library_id) - | Some s -> Some s) - in - let library_id_map' = + let library_ids = + match + Option.map library_ids ~f:(fun library_ids -> + Lib_info.Library_id.Set.add library_ids library_id) + with + | None -> Lib_info.Library_id.Set.singleton library_id + | Some s -> s + in + Some library_ids) + and library_id_map' = Lib_info.Library_id.Map.add_exn library_id_map library_id r2 in libname_map', id_map', library_id_map') @@ -319,8 +319,7 @@ module DB = struct ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) ])) - in - let id_map' = + and id_map' = let id_map : Lib_info.Library_id.Set.t Lib_name.Map.t = id_map in Lib_name.Map.update id_map public_name ~f:(fun library_ids -> match @@ -329,8 +328,7 @@ module DB = struct with | None -> Some (Lib_info.Library_id.Set.singleton library_id) | Some s -> Some s) - in - let library_id_map' = + and library_id_map' = Lib_info.Library_id.Map.add_exn library_id_map library_id r2 in libname_map', id_map', library_id_map') diff --git a/src/dune_rules/stanzas/library_redirect.ml b/src/dune_rules/stanzas/library_redirect.ml index 3a2f8737e0e..9e5b36afca8 100644 --- a/src/dune_rules/stanzas/library_redirect.ml +++ b/src/dune_rules/stanzas/library_redirect.ml @@ -53,4 +53,11 @@ module Local = struct let loc = fst public_name in Some (for_lib lib ~loc ~new_public_name:public_name)) ;; + + let to_library_id ~src_dir t = + let lib_name = Lib_name.of_local t.old_name.lib_name + and loc = t.loc + and enabled_if = t.old_name.enabled in + Lib_info.Library_id.make ~loc ~src_dir ~enabled_if lib_name + ;; end diff --git a/src/dune_rules/stanzas/library_redirect.mli b/src/dune_rules/stanzas/library_redirect.mli index fcaae554077..e1420506af7 100644 --- a/src/dune_rules/stanzas/library_redirect.mli +++ b/src/dune_rules/stanzas/library_redirect.mli @@ -31,4 +31,5 @@ module Local : sig val of_private_lib : Library.t -> t option val of_lib : Library.t -> t option + val to_library_id : src_dir:Path.Source.t -> t -> Lib_info.Library_id.t end From 67466c3269aa67ef1338dcaf3d7d67dea919d4c5 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 14:07:55 -0700 Subject: [PATCH 11/38] refactor: tighten bindings Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/scope.ml | 82 +++++++++++++++-------------------------- 1 file changed, 30 insertions(+), 52 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 7a63bf5f459..e2e75776609 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -97,51 +97,35 @@ module DB = struct ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Library_id.Map.empty) ~f:(fun (libname_map, id_map, library_id_map) (dir, stanza) -> let name, library_id, 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 old_public_name = Lib_name.of_local s.old_name.lib_name in - let enabled = - Memo.lazy_ (fun () -> - let open Memo.O in - let* expander = Expander0.get ~dir in - let+ enabled = Expander0.eval_blang expander s.old_name.enabled in - Toggle.of_bool enabled) - in let lib_name, redirect = - Found_or_redirect.redirect ~enabled old_public_name s.new_public_name - in - let library_id = - let src_dir = - Path.drop_optional_build_context_src_exn (Path.build dir) + let old_public_name = Lib_name.of_local s.old_name.lib_name in + let enabled = + Memo.lazy_ (fun () -> + let+ enabled = + let* expander = Expander0.get ~dir in + Expander0.eval_blang expander s.old_name.enabled + in + Toggle.of_bool enabled) in - Library_redirect.Local.to_library_id ~src_dir s - in + Found_or_redirect.redirect ~enabled old_public_name s.new_public_name + and library_id = Library_redirect.Local.to_library_id ~src_dir s in lib_name, library_id, redirect | Deprecated_library_name s -> - let old_public_name = Deprecated_library_name.old_public_name s in 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 - let library_id = - let src_dir = - Path.drop_optional_build_context_src_exn (Path.build dir) - in - Deprecated_library_name.to_library_id ~src_dir s - in + and library_id = Deprecated_library_name.to_library_id ~src_dir s in lib_name, library_id, 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 - in - let library_id = - let src_dir = - Path.drop_optional_build_context_src_exn (Path.build dir) - in - Library.to_library_id ~src_dir conf - in + and library_id = Library.to_library_id ~src_dir conf in Library.best_name conf, library_id, Found_or_redirect.found info in let libname_map' = @@ -190,15 +174,13 @@ module DB = struct and id_map' = let id_map : Lib_info.Library_id.Set.t Lib_name.Map.t = id_map in Lib_name.Map.update id_map name ~f:(fun library_ids -> - let library_ids = - match - Option.map library_ids ~f:(fun library_ids -> - Lib_info.Library_id.Set.add library_ids library_id) - with - | None -> Lib_info.Library_id.Set.singleton library_id - | Some s -> s - in - Some library_ids) + Some + (match + Option.map library_ids ~f:(fun library_ids -> + Lib_info.Library_id.Set.add library_ids library_id) + with + | None -> Lib_info.Library_id.Set.singleton library_id + | Some s -> s)) and library_id_map' = Lib_info.Library_id.Map.add_exn library_id_map library_id r2 in @@ -272,16 +254,11 @@ module DB = struct Some (Public_lib.name p, Project { project; library_id }, library_id) | Library _ | Library_redirect _ -> None | Deprecated_library_name s -> - let library_id = - let src_dir = - Path.drop_optional_build_context_src_exn (Path.build dir) - in - Deprecated_library_name.to_library_id ~src_dir s - in + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in Some ( Deprecated_library_name.old_public_name s , Name s.new_public_name - , library_id ) + , Deprecated_library_name.to_library_id ~src_dir s ) in match candidate with | None -> libname_map, id_map, library_id_map @@ -322,12 +299,13 @@ module DB = struct and id_map' = let id_map : Lib_info.Library_id.Set.t Lib_name.Map.t = id_map in Lib_name.Map.update id_map public_name ~f:(fun library_ids -> - match - Option.map library_ids ~f:(fun library_ids -> - Lib_info.Library_id.Set.add library_ids library_id) - with - | None -> Some (Lib_info.Library_id.Set.singleton library_id) - | Some s -> Some s) + Some + (match + Option.map library_ids ~f:(fun library_ids -> + Lib_info.Library_id.Set.add library_ids library_id) + with + | None -> Lib_info.Library_id.Set.singleton library_id + | Some s -> s)) and library_id_map' = Lib_info.Library_id.Map.add_exn library_id_map library_id r2 in From 558d1cbd8e0e694dee69eebf479b852545f9e541 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 16:21:32 -0700 Subject: [PATCH 12/38] refactor: use Nonempty_list.t for multiple_results Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/lib.ml | 23 +++++++------------- src/dune_rules/lib.mli | 4 ++-- src/dune_rules/odoc.ml | 9 ++++---- src/dune_rules/scope.ml | 35 +++++++++++++++++-------------- src/dune_rules/stanzas/library.ml | 3 +-- 5 files changed, 33 insertions(+), 41 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 347b8dab930..ee3b478d803 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -451,7 +451,7 @@ and resolve_result = and resolve_result_with_multiple_results = | Resolve_result of resolve_result - | Multiple_results of resolve_result list + | Multiple_results of resolve_result Nonempty_list.t let lib_config (t : lib) = t.lib_config let name t = t.name @@ -1198,7 +1198,7 @@ end = struct | Multiple_results candidates -> let open Memo.O in let+ libs = - Memo.List.filter_map candidates ~f:(function + Memo.List.filter_map (Nonempty_list.to_list candidates) ~f:(function | Ignore -> Memo.return (Some Status.Ignore) | Redirect_in_the_same_db (_, name') -> find_internal db name' >>| Option.some | Redirect (db', library_id') -> @@ -1216,7 +1216,7 @@ end = struct resolve_hidden db ~info hidden >>| Option.some) in (match libs with - | [] -> assert false + | [] -> Status.Not_found | [ status ] -> status | _ :: _ :: _ -> List.fold_left libs ~init:Status.Not_found ~f:(fun acc status -> @@ -1927,20 +1927,10 @@ module DB = struct variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ] ;; - module With_multiple_results : sig - type resolve_result := t - - type t = resolve_result_with_multiple_results = - | Resolve_result of resolve_result - | Multiple_results of resolve_result list - - val to_dyn : t Dyn.builder - val resolve_result : resolve_result -> t - val multiple_results : resolve_result list -> t - end = struct + module With_multiple_results = struct type t = resolve_result_with_multiple_results = | Resolve_result of resolve_result - | Multiple_results of resolve_result list + | Multiple_results of resolve_result Nonempty_list.t let resolve_result r = Resolve_result r let multiple_results libs : t = Multiple_results libs @@ -1949,7 +1939,8 @@ module DB = struct let open Dyn in match t with | Resolve_result r -> variant "Resolve_result" [ to_dyn r ] - | Multiple_results xs -> variant "Multiple_results" [ (Dyn.list to_dyn) xs ] + | Multiple_results xs -> + variant "Multiple_results" [ Dyn.list to_dyn (Nonempty_list.to_list xs) ] ;; end end diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index ecca9b3c285..2d5e7a6f0cd 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -108,11 +108,11 @@ module DB : sig type t = private | Resolve_result of resolve_result - | Multiple_results of resolve_result list + | Multiple_results of resolve_result Nonempty_list.t val to_dyn : t Dyn.builder val resolve_result : resolve_result -> t - val multiple_results : resolve_result list -> t + val multiple_results : resolve_result Nonempty_list.t -> t end end diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 27719dba847..a511161207a 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -951,11 +951,10 @@ let setup_private_library_doc_alias sctx ~scope ~dir (l : Library.t) = | Private _ -> let ctx = Super_context.context sctx in let* lib = - let library_id = - let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_library_id ~src_dir l - in - Lib.DB.find_library_id_even_when_hidden (Scope.libs scope) library_id + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Lib.DB.find_library_id_even_when_hidden + (Scope.libs scope) + (Library.to_library_id ~src_dir l) >>| Option.value_exn in let lib = Lib (Lib.Local.of_lib_exn lib) in diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index e2e75776609..d2f3c6c7b82 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -69,17 +69,22 @@ module DB = struct let resolve = let module Resolve_result = Lib.DB.Resolve_result in let module With_multiple_results = Resolve_result.With_multiple_results in + let not_found = With_multiple_results.resolve_result Resolve_result.not_found in fun ~resolve_library_id id_map name -> match - Lib_name.Map.find id_map name |> Option.map ~f:Lib_info.Library_id.Set.to_list + Lib_name.Map.find id_map name + |> Option.bind ~f:(fun library_ids -> + Lib_info.Library_id.Set.to_list library_ids |> Nonempty_list.of_list) with - | None -> - Memo.return (With_multiple_results.resolve_result Resolve_result.not_found) - | Some [] -> assert false + | None -> Memo.return not_found | Some [ library_id ] -> resolve_library_id library_id >>| With_multiple_results.resolve_result - | Some xs -> - Memo.List.map ~f:resolve_library_id xs >>| With_multiple_results.multiple_results + | Some library_ids -> + Memo.List.map ~f:resolve_library_id (Nonempty_list.to_list library_ids) + >>| fun library_ids -> + Nonempty_list.of_list library_ids + |> Option.value_exn + |> With_multiple_results.multiple_results ;; module Library_related_stanza = struct @@ -339,16 +344,14 @@ module DB = struct coq_stanzas = let stanzas_by_project_dir = - List.map - stanzas - ~f:(fun ((dir, stanza) : Path.Build.t * Library_related_stanza.t) -> - let project = - match stanza with - | Library lib -> lib.project - | Library_redirect x -> x.project - | Deprecated_library_name x -> x.project - in - Dune_project.root project, (dir, stanza)) + List.map stanzas ~f:(fun (dir, stanza) -> + let 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, (dir, stanza)) |> Path.Source.Map.of_list_multi in let db_by_project_dir = diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index 757be5f24aa..4484260ac8d 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -407,8 +407,7 @@ let to_library_id ~src_dir t = let loc, name = let ((loc, _) as name) = t.name in loc, Lib_name.of_local name - in - let enabled_if = t.enabled_if in + and enabled_if = t.enabled_if in Lib_info.Library_id.make ~loc ~src_dir ~enabled_if name ;; From df0bf4644b6b57b2283ed7d8e36f86d08f0adb76 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 26 Mar 2024 16:32:44 -0700 Subject: [PATCH 13/38] refactor: library_id construction functions Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/scope.ml | 2 +- src/dune_rules/stanzas/deprecated_library_name.ml | 7 +++---- src/dune_rules/stanzas/library.ml | 6 ++---- src/dune_rules/stanzas/library_redirect.ml | 9 ++++++--- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index d2f3c6c7b82..817ebcef9cf 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -409,11 +409,11 @@ 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 diff --git a/src/dune_rules/stanzas/deprecated_library_name.ml b/src/dune_rules/stanzas/deprecated_library_name.ml index e89eb81dd6f..de54ba5b3b0 100644 --- a/src/dune_rules/stanzas/deprecated_library_name.ml +++ b/src/dune_rules/stanzas/deprecated_library_name.ml @@ -49,9 +49,8 @@ let decode = ;; let to_library_id ~src_dir (t : t) = - let loc, name = - let lib, _ = t.old_name in - Public_lib.loc lib, Public_lib.name lib + let lib, _ = t.old_name in + let loc = Public_lib.loc lib and enabled_if = Blang.true_ in - Lib_info.Library_id.make ~loc ~src_dir ~enabled_if name + Lib_info.Library_id.make ~loc ~src_dir ~enabled_if (Public_lib.name lib) ;; diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index 4484260ac8d..a22e7e9134d 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -404,11 +404,9 @@ let main_module_name t : Lib_info.Main_module_name.t = ;; let to_library_id ~src_dir t = - let loc, name = - let ((loc, _) as name) = t.name in - loc, Lib_name.of_local name + let loc, _ = t.name and enabled_if = t.enabled_if in - Lib_info.Library_id.make ~loc ~src_dir ~enabled_if name + Lib_info.Library_id.make ~loc ~src_dir ~enabled_if (Lib_name.of_local t.name) ;; let to_lib_info diff --git a/src/dune_rules/stanzas/library_redirect.ml b/src/dune_rules/stanzas/library_redirect.ml index 9e5b36afca8..a93679f7fdc 100644 --- a/src/dune_rules/stanzas/library_redirect.ml +++ b/src/dune_rules/stanzas/library_redirect.ml @@ -55,9 +55,12 @@ module Local = struct ;; let to_library_id ~src_dir t = - let lib_name = Lib_name.of_local t.old_name.lib_name - and loc = t.loc + let loc = t.loc and enabled_if = t.old_name.enabled in - Lib_info.Library_id.make ~loc ~src_dir ~enabled_if lib_name + Lib_info.Library_id.make + ~loc + ~src_dir + ~enabled_if + (Lib_name.of_local t.old_name.lib_name) ;; end From 8828a9fce82c238aab08c438ba34ebe29f1758a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Tue, 26 Mar 2024 11:03:57 +0000 Subject: [PATCH 14/38] fix: lib collision public same folder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- src/dune_rules/ml_sources.ml | 5 ++++- src/dune_rules/stanzas/library.ml | 1 + src/dune_rules/stanzas/library.mli | 1 + .../lib-collision-public-same-folder.t | 22 +++++++++---------- 4 files changed, 16 insertions(+), 13 deletions(-) diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index c80c55d6a33..b62bc82cba8 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -67,7 +67,10 @@ module Modules = struct libs ~init:(Lib_name.Set.empty, Lib_info.Library_id.Map.empty) ~f:(fun (lib_set, acc) part -> - let name = Library.best_name part.stanza in + (* we need to check for private name to avoid "multiple rules" errors, + because even for public libraries, the artifacts folder still uses + the private name *) + let name = Library.private_name part.stanza in match Lib_name.Set.mem lib_set name with | true -> User_error.raise diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index a22e7e9134d..b38200a6bb6 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -369,6 +369,7 @@ let best_name t = | Public p -> snd p.name ;; +let private_name t = Lib_name.of_local t.name let is_virtual t = Option.is_some t.virtual_modules let is_impl t = Option.is_some t.implements diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index d52fe4ff9d0..b56ee0cd9d9 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -72,6 +72,7 @@ val foreign_lib_files val archive : t -> dir:Path.Build.t -> ext:string -> Path.Build.t val best_name : t -> Lib_name.t +val private_name : t -> Lib_name.t val is_virtual : t -> bool val is_impl : t -> bool val obj_dir : dir:Path.Build.t -> t -> Path.Build.t Obj_dir.t 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 3e8af8c0fb3..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: Multiple rules generated for _build/default/foo.cmxs: - - dune:4 - - dune:1 + 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,13 +45,9 @@ With some consumer > EOF $ dune build - File "dune", line 1, characters 0-0: - Error: Module "Main" is used in several stanzas: - - dune:1 - - dune:4 - - dune:7 - To fix this error, you must specify an explicit "modules" field in every - library, executable, and executables stanzas in this dune file. Note that - each module cannot appear in more than one "modules" field - it must belong - to a single library or executable. + 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] From 52c372386f8a9870f9f1dbf5dbe89a1841383ce7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Wed, 27 Mar 2024 11:19:51 +0000 Subject: [PATCH 15/38] ml_sources: use obj_dir instead of priv_name MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- src/dune_rules/ml_sources.ml | 21 ++++++++++--------- src/dune_rules/stanzas/library.ml | 1 - src/dune_rules/stanzas/library.mli | 1 - .../lib-collision-private-same-folder.t | 6 ++++-- .../lib-collision-public-same-folder.t | 6 ++++-- 5 files changed, 19 insertions(+), 16 deletions(-) diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index b62bc82cba8..8542515ae8c 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -65,19 +65,20 @@ module Modules = struct let _, libraries = List.fold_left libs - ~init:(Lib_name.Set.empty, Lib_info.Library_id.Map.empty) - ~f:(fun (lib_set, acc) part -> - (* we need to check for private name to avoid "multiple rules" errors, + ~init:(String.Set.empty, Lib_info.Library_id.Map.empty) + ~f:(fun (obj_dir_set, acc) part -> + (* need to check for obj_dir collisions to avoid "multiple rules" errors, because even for public libraries, the artifacts folder still uses - the private name *) - let name = Library.private_name part.stanza in - match Lib_name.Set.mem lib_set name with + the private library name *) + let name = Path.Build.to_string (Obj_dir.obj_dir part.obj_dir) in + match String.Set.mem obj_dir_set name with | true -> User_error.raise - ~loc:part.stanza.buildable.loc + ~loc:part.stanza.Library.buildable.loc [ Pp.textf - "Library %S appears for the second time in this directory" - (Lib_name.to_string name) + "Library %S has the same private name as another library in this \ + directory" + (Lib_name.to_string (Library.best_name part.stanza)) ] | false -> let acc = @@ -89,7 +90,7 @@ module Modules = struct in Lib_info.Library_id.Map.add_exn acc library_id (part.modules, part.obj_dir) in - Lib_name.Set.add lib_set name, acc) + String.Set.add obj_dir_set name, acc) in libraries in diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index b38200a6bb6..a22e7e9134d 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -369,7 +369,6 @@ let best_name t = | Public p -> snd p.name ;; -let private_name t = Lib_name.of_local t.name let is_virtual t = Option.is_some t.virtual_modules let is_impl t = Option.is_some t.implements diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index b56ee0cd9d9..d52fe4ff9d0 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -72,7 +72,6 @@ val foreign_lib_files val archive : t -> dir:Path.Build.t -> ext:string -> Path.Build.t val best_name : t -> Lib_name.t -val private_name : t -> Lib_name.t val is_virtual : t -> bool val is_impl : t -> bool val obj_dir : dir:Path.Build.t -> t -> Path.Build.t Obj_dir.t 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 9c7391ac9d9..c456e450cc0 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 @@ -18,7 +18,8 @@ Without any consumers of the libraries File "dune", line 3, characters 0-21: 3 | (library 4 | (name foo)) - Error: Library "foo" appears for the second time in this directory + Error: Library "foo" has the same private name as another library in this + directory [1] With some consumer of the library @@ -41,5 +42,6 @@ With some consumer of the library File "dune", line 3, characters 0-21: 3 | (library 4 | (name foo)) - Error: Library "foo" appears for the second time in this directory + Error: Library "foo" has the same private name as another library in this + directory [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 b9357c65c88..474d0d58eab 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 @@ -23,7 +23,8 @@ Without any consumers of the libraries 4 | (library 5 | (name foo) 6 | (public_name baz.foo)) - Error: Library "foo" appears for the second time in this directory + Error: Library "baz.foo" has the same private name as another library in this + directory [1] With some consumer @@ -49,5 +50,6 @@ With some consumer 4 | (library 5 | (name foo) 6 | (public_name baz.foo)) - Error: Library "foo" appears for the second time in this directory + Error: Library "baz.foo" has the same private name as another library in this + directory [1] From 93a592d1e41b7cee354f75693aa89a2a6e2c1ba5 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 28 Mar 2024 16:42:09 -0700 Subject: [PATCH 16/38] refactor: use the library name! Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/ml_sources.ml | 28 +++++++++++-------- .../lib-collision-private-same-folder.t | 6 ++-- .../lib-collision-public-same-folder.t | 6 ++-- 3 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 8542515ae8c..0290b1beab5 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -65,20 +65,24 @@ module Modules = struct let _, libraries = List.fold_left libs - ~init:(String.Set.empty, Lib_info.Library_id.Map.empty) - ~f:(fun (obj_dir_set, acc) part -> - (* need to check for obj_dir collisions to avoid "multiple rules" errors, - because even for public libraries, the artifacts folder still uses - the private library name *) - let name = Path.Build.to_string (Obj_dir.obj_dir part.obj_dir) in - match String.Set.mem obj_dir_set name with + ~init:(Lib_name.Set.empty, Lib_info.Library_id.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_info.Library_id.name (Library.to_library_id ~src_dir stanza) + in + match Lib_name.Set.mem libname_set name with | true -> User_error.raise - ~loc:part.stanza.Library.buildable.loc + ~loc:stanza.buildable.loc [ Pp.textf - "Library %S has the same private name as another library in this \ - directory" - (Lib_name.to_string (Library.best_name part.stanza)) + "Library %S appears for the second time in this directory" + (Lib_name.to_string name) ] | false -> let acc = @@ -90,7 +94,7 @@ module Modules = struct in Lib_info.Library_id.Map.add_exn acc library_id (part.modules, part.obj_dir) in - String.Set.add obj_dir_set name, acc) + Lib_name.Set.add libname_set name, acc) in libraries in 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 c456e450cc0..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 @@ -18,8 +18,7 @@ Without any consumers of the libraries File "dune", line 3, characters 0-21: 3 | (library 4 | (name foo)) - Error: Library "foo" has the same private name as another library in this - directory + Error: Library "foo" appears for the second time in this directory [1] With some consumer of the library @@ -42,6 +41,5 @@ With some consumer of the library File "dune", line 3, characters 0-21: 3 | (library 4 | (name foo)) - Error: Library "foo" has the same private name as another library in this - directory + 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-folder.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t index 474d0d58eab..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 @@ -23,8 +23,7 @@ Without any consumers of the libraries 4 | (library 5 | (name foo) 6 | (public_name baz.foo)) - Error: Library "baz.foo" has the same private name as another library in this - directory + Error: Library "foo" appears for the second time in this directory [1] With some consumer @@ -50,6 +49,5 @@ With some consumer 4 | (library 5 | (name foo) 6 | (public_name baz.foo)) - Error: Library "baz.foo" has the same private name as another library in this - directory + Error: Library "foo" appears for the second time in this directory [1] From 1437ede1f1e66661d8963a038d3a6059bbac7aa5 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 28 Mar 2024 17:42:02 -0700 Subject: [PATCH 17/38] refactor: more coherent error message Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/lib.ml | 60 ++++++------------- .../eif-library-name-collision-same-folder.t | 12 +--- .../lib-collision/lib-collision-private.t | 5 +- .../lib-collision-public-same-public-name.t | 6 +- .../lib-collision/lib-collision-public.t | 5 +- 5 files changed, 27 insertions(+), 61 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index ee3b478d803..a954c92e7c2 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -132,38 +132,15 @@ module Error = struct ] ;; - let duplicated ~loc ~name_a ~name_b ~dir_a ~dir_b = - let different_folders, different_folders_text = - let different_folders = not (Path.equal dir_a dir_b) in - let different_folders_text = - if different_folders - then - Format.asprintf - " is defined in two folders (%s and %s)" - (Path.to_string_maybe_quoted dir_a) - (Path.to_string_maybe_quoted dir_b) - else "" - in - different_folders, different_folders_text - in - let different_name, different_name_text = - let different_name = not (Lib_name.equal name_a name_b) in - let different_name_text = - if different_name - then Format.asprintf " shares a name with library %S" (Lib_name.to_string name_a) - else "" - in - different_name, different_name_text - in + let duplicated ~loc_a ~loc_b ~name = + let open Pp.O in User_error.make - ~loc - [ Pp.textf - "Library with name %S%s%s%s. Either change one of the names, or enable them \ - conditionally using the 'enabled_if' field." - (Lib_name.to_string name_b) - different_folders_text - (if different_folders && different_name then " and" else "") - different_name_text + ~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." ] ;; @@ -1227,19 +1204,20 @@ end = struct (match Lib_info.Library_id.equal library_id_a library_id_b with | true -> acc | false -> - let a = info a - and b = info b in - let loc = Lib_info.loc b - and dir_a = Lib_info.best_src_dir a - and dir_b = Lib_info.best_src_dir b + let best_name_a = a.name + and best_name_b = b.name + and info_a = info a + and info_b = info b in + let loc_a = Lib_info.loc info_a + and loc_b = Lib_info.loc info_b and name_a = - let library_id = Lib_info.library_id a in - Lib_info.Library_id.name library_id - and name_b = - let library_id = Lib_info.library_id b in + let library_id = Lib_info.library_id info_a in Lib_info.Library_id.name library_id in - Status.Invalid (Error.duplicated ~loc ~name_a ~name_b ~dir_a ~dir_b)) + let name = + if Lib_name.equal best_name_a best_name_b then best_name_a else name_a + in + Status.Invalid (Error.duplicated ~loc_a ~loc_b ~name)) | Invalid _, _ -> acc | (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _) | (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib 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 0756766f316..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,17 +28,7 @@ in the same dune file > let x = "foo" > EOF - $ dune build --display=short - ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} [alt-context] - ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} - ocamlopt .foo.objs/native/foo.{cmx,o} [alt-context] - ocamlc foo.cma [alt-context] - ocamlopt .foo.objs/native/foo.{cmx,o} - ocamlc foo.cma - ocamlopt foo.{a,cmxa} [alt-context] - ocamlopt foo.{a,cmxa} - ocamlopt foo.cmxs [alt-context] - ocamlopt foo.cmxs + $ dune build For public libraries 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 a5803680330..8323203d112 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 @@ -47,7 +47,6 @@ With some consumer of the library File "b/dune", line 1, characters 0-21: 1 | (library 2 | (name foo)) - Error: Library with name "foo" is defined in two folders (_build/default/a - and _build/default/b). Either change one of the names, or enable them - conditionally using the 'enabled_if' field. + Error: Library with name "foo" is already defined in a/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-public-name.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-public-name.t index 04dbd10ab99..d4f2cb864aa 100644 --- 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 @@ -41,7 +41,7 @@ With some consumer 1 | (library 2 | (name foo) 3 | (public_name bar.foo)) - Error: Library with name "foo" is defined in two folders (_build/default/b - and _build/default/a) and shares a name with library "bar". Either change one - of the names, or enable them conditionally using the 'enabled_if' field. + Error: Library with name "bar.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.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public.t index de24a5cfce2..61d5fcaf363 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 @@ -42,7 +42,6 @@ With some consumer 1 | (library 2 | (name foo) 3 | (public_name baz.foo)) - Error: Library with name "foo" is defined in two folders (_build/default/a - and _build/default/b). Either change one of the names, or enable them - conditionally using the 'enabled_if' field. + Error: Library with name "foo" is already defined in a/dune:1. Either change + one of the names, or enable them conditionally using the 'enabled_if' field. [1] From 8419ef6912f86b760da288a3e0382de281027dec Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 28 Mar 2024 20:55:42 -0700 Subject: [PATCH 18/38] fix: change `db.all` back to returning Lib_name.t list Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/dune_package.ml | 5 ----- src/dune_rules/dune_package.mli | 1 - src/dune_rules/lib.ml | 6 +++--- src/dune_rules/lib.mli | 2 +- src/dune_rules/scope.ml | 4 ++-- 5 files changed, 6 insertions(+), 12 deletions(-) diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 1d66e7beeb8..c731ea08024 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -381,11 +381,6 @@ module Entry = struct | Deprecated_library_name d -> d.loc ;; - let library_id = function - | Library lib | Hidden_library lib -> Lib_info.library_id (Lib.info lib) - | Deprecated_library_name _ -> assert false - ;; - let cstrs ~lang ~dir = let open Dune_lang.Decoder in [ ( "library" diff --git a/src/dune_rules/dune_package.mli b/src/dune_rules/dune_package.mli index 209fc420fc9..85bcd34556f 100644 --- a/src/dune_rules/dune_package.mli +++ b/src/dune_rules/dune_package.mli @@ -53,7 +53,6 @@ module Entry : sig Dune itself never produces hidden libraries. *) val name : t -> Lib_name.t - val library_id : t -> Lib_info.Library_id.t val version : t -> Package_version.t option val loc : t -> Loc.t val to_dyn : t Dyn.builder diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index a954c92e7c2..f14f6d0bc97 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -412,7 +412,7 @@ type db = ; resolve_library_id : Lib_info.Library_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_info.Library_id.t list Memo.Lazy.t + ; all : Lib_name.t list Memo.Lazy.t ; lib_config : Lib_config.t ; instrument_with : Lib_name.t list } @@ -1979,7 +1979,7 @@ module DB = struct | Resolve_result r -> r) ~all:(fun () -> let open Memo.O in - Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.library_id) + Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.name) ;; let installed (context : Context.t) = @@ -2153,7 +2153,7 @@ module DB = struct let open Memo.O in let* l = Memo.Lazy.force t.all - >>= Memo.parallel_map ~f:(find_library_id t) + >>= Memo.parallel_map ~f:(find t) >>| List.filter_opt >>| Set.of_list in diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 2d5e7a6f0cd..8676ee995ad 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -127,7 +127,7 @@ module DB : sig : parent:t option -> resolve:(Lib_name.t -> Resolve_result.With_multiple_results.t Memo.t) -> resolve_library_id:(Lib_info.Library_id.t -> Resolve_result.t Memo.t) - -> all:(unit -> Lib_info.Library_id.t list Memo.t) + -> all:(unit -> Lib_name.t list Memo.t) -> lib_config:Lib_config.t -> instrument_with:Lib_name.t list -> unit diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 817ebcef9cf..63647dd1437 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -214,7 +214,7 @@ module DB = struct ~parent:(Some parent) ~resolve ~resolve_library_id - ~all:(fun () -> Lib_info.Library_id.Map.keys library_id_map |> Memo.return) + ~all:(fun () -> Lib_name.Map.keys id_map |> Memo.return) ~lib_config ~instrument_with ;; @@ -326,7 +326,7 @@ module DB = struct ~parent:(Some installed_libs) ~resolve ~resolve_library_id - ~all:(fun () -> Lib_info.Library_id.Map.keys public_libs |> Memo.return) + ~all:(fun () -> Lib_name.Map.keys public_ids |> Memo.return) ~lib_config () ;; From 34b3d4247ae1eb3699f781e00580bb329e8342f3 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 29 Mar 2024 23:07:21 -0700 Subject: [PATCH 19/38] code review: rename library_id to lib_id, rm id from deprecated_library_name Signed-off-by: Antonio Nuno Monteiro --- bin/describe/describe_workspace.ml | 2 +- src/dune_rules/dir_contents.ml | 2 +- src/dune_rules/dune_package.ml | 4 +- src/dune_rules/findlib.ml | 4 +- src/dune_rules/gen_rules.ml | 4 +- src/dune_rules/install_rules.ml | 10 +- src/dune_rules/lib.ml | 76 +++++---- src/dune_rules/lib.mli | 16 +- src/dune_rules/lib_id.ml | 43 +++++ src/dune_rules/lib_id.mli | 13 ++ src/dune_rules/lib_info.ml | 56 +------ src/dune_rules/lib_info.mli | 19 +-- src/dune_rules/lib_rules.ml | 5 +- src/dune_rules/ml_sources.ml | 28 ++-- src/dune_rules/ml_sources.mli | 2 +- src/dune_rules/odoc.ml | 4 +- src/dune_rules/odoc_new.ml | 2 +- src/dune_rules/scope.ml | 148 +++++++++--------- .../stanzas/deprecated_library_name.ml | 7 - .../stanzas/deprecated_library_name.mli | 1 - src/dune_rules/stanzas/library.ml | 10 +- src/dune_rules/stanzas/library.mli | 2 +- src/dune_rules/stanzas/library_redirect.ml | 8 +- src/dune_rules/stanzas/library_redirect.mli | 2 +- src/dune_rules/virtual_rules.ml | 2 +- .../lib-collision/lib-collision-private.t | 12 +- 26 files changed, 218 insertions(+), 264 deletions(-) create mode 100644 src/dune_rules/lib_id.ml create mode 100644 src/dune_rules/lib_id.mli diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index 9b9c0b78b2b..c2e1c894c02 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -451,7 +451,7 @@ 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 (Lib_info.library_id info)) + >>| Ml_sources.modules_and_obj_dir ~for_:(Library (Lib_info.lib_id info)) in let* pp_map = let+ version = diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index 0b1365f79b9..ed9206d9ef5 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -456,7 +456,7 @@ let modules_of_local_lib sctx lib = let dir = Lib_info.src_dir info in get sctx ~dir in - ocaml t >>| Ml_sources.modules ~for_:(Library (Lib_info.library_id info)) + ocaml t >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info)) ;; let modules_of_lib sctx lib = diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index c731ea08024..3524d6e67d4 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -231,7 +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 library_id = Lib_info.Library_id.external_ ~loc ~src_dir name in + let lib_id = Lib_id.external_ ~loc ~src_dir name in let enabled = Memo.return Lib_info.Enabled_status.Normal in let status = match Lib_name.analyze name with @@ -256,7 +256,7 @@ module Lib = struct ~path_kind:External ~loc ~name - ~library_id + ~lib_id ~kind ~status ~src_dir diff --git a/src/dune_rules/findlib.ml b/src/dune_rules/findlib.ml index 629c26acb14..d865ee9e541 100644 --- a/src/dune_rules/findlib.ml +++ b/src/dune_rules/findlib.ml @@ -207,12 +207,12 @@ let to_dune_library (t : Findlib.Package.t) ~dir_contents ~ext_lib ~external_loc in let modules = Lib_info.Source.External None in let name = t.name in - let library_id = Lib_info.Library_id.external_ ~loc ~src_dir name in + let lib_id = Lib_id.external_ ~loc ~src_dir name in Lib_info.create ~loc ~path_kind:External ~name - ~library_id + ~lib_id ~kind ~status ~src_dir diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 0301de3f1f6..3198b7d2210 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -112,9 +112,7 @@ end = struct empty_none | Library.T lib -> let* enabled_if = - Lib.DB.available_by_library_id - (Scope.libs scope) - (Library.to_library_id ~src_dir lib) + Lib.DB.available_by_lib_id (Scope.libs scope) (Library.to_lib_id ~src_dir lib) in if_available_buildable ~loc:lib.buildable.loc diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 0ac32aa76c1..242b0ddf27b 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -88,7 +88,7 @@ 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.library_id lib))) + Some (Ml_sources.modules ml_sources ~for_:(Library (Lib_info.lib_id lib))) and+ foreign_archives = match Lib_info.virtual_ lib with | None -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) @@ -182,7 +182,7 @@ end = struct let* installable_modules = let+ modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library (Lib_info.library_id info)) + >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info)) and+ impl = Virtual_rules.impl sctx ~lib ~scope in Vimpl.impl_modules impl modules |> Modules.split_by_lib in @@ -345,9 +345,7 @@ end = struct |> Path.build |> Path.drop_optional_build_context_src_exn in - Lib.DB.available_by_library_id - (Scope.libs scope) - (Library.to_library_id ~src_dir lib)) + Lib.DB.available_by_lib_id (Scope.libs scope) (Library.to_lib_id ~src_dir lib)) else Memo.return true else Memo.return false | Documentation.T _ -> Memo.return true @@ -662,7 +660,7 @@ end = struct |> List.map ~f:Path.build and* modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library (Lib_info.library_id info)) + >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info)) 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 f14f6d0bc97..5b48baa9bd2 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -409,7 +409,7 @@ end type db = { parent : db option ; resolve : Lib_name.t -> resolve_result_with_multiple_results Memo.t - ; resolve_library_id : Lib_info.Library_id.t -> resolve_result 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 @@ -424,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 * Lib_info.Library_id.t + | Redirect of db * Lib_id.t and resolve_result_with_multiple_results = | Resolve_result of resolve_result @@ -833,9 +833,9 @@ module rec Resolve_names : sig -> private_deps:private_deps -> lib Resolve.t option Memo.t - val resolve_library_id : db -> Lib_info.Library_id.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_library_id_internal : db -> Lib_info.Library_id.t -> bool Memo.t + val available_by_lib_id_internal : db -> Lib_id.t -> bool Memo.t val resolve_simple_deps : db @@ -1103,10 +1103,9 @@ end = struct type t = Lib_name.t * Path.t Lib_info.t * string option let equal (lib_name, info, _) (lib_name', info', _) = - let library_id = Lib_info.library_id info - and library_id' = Lib_info.library_id info' in - Lib_name.equal lib_name lib_name' - && Lib_info.Library_id.equal library_id library_id' + 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 @@ -1146,8 +1145,8 @@ end = struct (match db.parent with | None -> Memo.return Status.Not_found | Some db -> - let library_id = Lib_info.library_id info in - resolve_library_id db library_id) + let lib_id = Lib_info.lib_id info in + resolve_lib_id db lib_id) >>= function | Status.Found _ as x -> Memo.return x | _ -> @@ -1158,7 +1157,7 @@ end = struct let handle_resolve_result db ~super = function | Ignore -> Memo.return Status.Ignore | Redirect_in_the_same_db (_, name') -> find_internal db name' - | Redirect (db', library_id') -> resolve_library_id db' library_id' + | 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 @@ -1178,8 +1177,7 @@ end = struct Memo.List.filter_map (Nonempty_list.to_list candidates) ~f:(function | Ignore -> Memo.return (Some Status.Ignore) | Redirect_in_the_same_db (_, name') -> find_internal db name' >>| Option.some - | Redirect (db', library_id') -> - resolve_library_id db' library_id' >>| Option.some + | Redirect (db', lib_id') -> resolve_lib_id db' lib_id' >>| Option.some | Found info -> Lib_info.enabled info >>= (function @@ -1199,9 +1197,9 @@ end = struct List.fold_left libs ~init:Status.Not_found ~f:(fun acc status -> match acc, status with | Status.Found a, Status.Found b -> - let library_id_a = Lib_info.library_id a.info - and library_id_b = Lib_info.library_id b.info in - (match Lib_info.Library_id.equal library_id_a library_id_b with + let lib_id_a = Lib_info.lib_id a.info + and lib_id_b = Lib_info.lib_id b.info in + (match Lib_id.equal lib_id_a lib_id_b with | true -> acc | false -> let best_name_a = a.name @@ -1211,8 +1209,8 @@ end = struct let loc_a = Lib_info.loc info_a and loc_b = Lib_info.loc info_b and name_a = - let library_id = Lib_info.library_id info_a in - Lib_info.Library_id.name library_id + let lib_id = Lib_info.lib_id info_a in + Lib_id.name lib_id in let name = if Lib_name.equal best_name_a best_name_b then best_name_a else name_a @@ -1243,10 +1241,10 @@ end = struct | Hidden h -> Hidden.error h ~loc ~name >>| Option.some ;; - let resolve_library_id db library_id = + let resolve_lib_id db lib_id = let open Memo.O in - let super db = resolve_library_id db library_id in - db.resolve_library_id library_id >>= handle_resolve_result ~super db + 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) = @@ -1257,9 +1255,9 @@ end = struct | Not_found | Invalid _ | Hidden _ -> false ;; - let available_by_library_id_internal db (library_id : Lib_info.Library_id.t) = + let available_by_lib_id_internal db (lib_id : Lib_id.t) = let open Memo.O in - resolve_library_id db library_id + resolve_lib_id db lib_id >>| function | Ignore | Found _ -> true | Not_found | Invalid _ | Hidden _ -> false @@ -1884,7 +1882,7 @@ module DB = struct | Invalid of User_message.t | Ignore | Redirect_in_the_same_db of (Loc.t * Lib_name.t) - | Redirect of db * Lib_info.Library_id.t + | Redirect of db * Lib_id.t let found f = Found f let not_found = Not_found @@ -1899,8 +1897,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 (_, library_id) -> - variant "Redirect" [ Lib_info.Library_id.to_dyn library_id ] + | 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 ] ;; @@ -1925,12 +1922,12 @@ module DB = struct type t = db - let create ~parent ~resolve ~resolve_library_id ~all ~lib_config ~instrument_with () = + let create ~parent ~resolve ~resolve_lib_id ~all ~lib_config ~instrument_with () = let rec t = lazy { parent ; resolve - ; resolve_library_id + ; resolve_lib_id ; all = Memo.lazy_ all ; lib_config ; instrument_with @@ -1970,9 +1967,9 @@ module DB = struct ~parent:None ~lib_config ~resolve - ~resolve_library_id:(fun library_id -> + ~resolve_lib_id:(fun lib_id -> let open Memo.O in - let name = Lib_info.Library_id.name library_id in + let name = Lib_id.name lib_id in resolve name >>| function | Multiple_results _ -> assert false @@ -2001,9 +1998,9 @@ module DB = struct | Ignore | Not_found | Invalid _ | Hidden _ -> None ;; - let find_library_id t library_id = + let find_lib_id t lib_id = let open Memo.O in - Resolve_names.resolve_library_id t library_id + Resolve_names.resolve_lib_id t lib_id >>| function | Found t -> Some t | Ignore | Not_found | Invalid _ | Hidden _ -> None @@ -2017,9 +2014,9 @@ module DB = struct | Ignore | Invalid _ | Not_found -> None ;; - let find_library_id_even_when_hidden t library_id = + let find_lib_id_even_when_hidden t lib_id = let open Memo.O in - Resolve_names.resolve_library_id t library_id + Resolve_names.resolve_lib_id t lib_id >>| function | Found t | Hidden { lib = t; reason = _; path = _ } -> Some t | Ignore | Invalid _ | Not_found -> None @@ -2046,20 +2043,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 available_by_library_id t library_id = - Resolve_names.available_by_library_id_internal t library_id - ;; - - let get_compile_info t ~allow_overlaps library_id = + let get_compile_info t ~allow_overlaps lib_id = let open Memo.O in - find_library_id_even_when_hidden t library_id + 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" - [ "library_id", Lib_info.Library_id.to_dyn library_id ] + [ "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 8676ee995ad..ba16042d57e 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 -> Lib_info.Library_id.t -> t + val redirect : db -> Lib_id.t -> t val redirect_in_the_same_db : Loc.t * Lib_name.t -> t module With_multiple_results : sig @@ -126,7 +126,7 @@ module DB : sig val create : parent:t option -> resolve:(Lib_name.t -> Resolve_result.With_multiple_results.t Memo.t) - -> resolve_library_id:(Lib_info.Library_id.t -> Resolve_result.t 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 @@ -135,18 +135,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_library_id : t -> Lib_info.Library_id.t -> lib option Memo.t - val find_library_id_even_when_hidden : t -> Lib_info.Library_id.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_library_id : t -> Lib_info.Library_id.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_info.Library_id.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..625c78da497 --- /dev/null +++ b/src/dune_rules/lib_id.ml @@ -0,0 +1,43 @@ +open Import + +module T = struct + type t = + { name : Lib_name.t + ; loc : Loc.t + ; src_dir : Path.t + ; enabled_if : Blang.t + } + + let compare a b = + match Lib_name.compare a.name b.name with + | Eq -> + (match Path.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.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 external_ ~loc ~src_dir name = { name; loc; enabled_if = Blang.true_; src_dir } + +let make ~loc ~src_dir ~enabled_if name = + { name; loc; enabled_if; src_dir = Path.source src_dir } +;; + +let name { name; _ } = name +let loc { loc; _ } = loc diff --git a/src/dune_rules/lib_id.mli b/src/dune_rules/lib_id.mli new file mode 100644 index 00000000000..30d4c8973ff --- /dev/null +++ b/src/dune_rules/lib_id.mli @@ -0,0 +1,13 @@ +open Import + +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 external_ : loc:Loc.t -> src_dir:Path.t -> Lib_name.t -> t +val name : t -> Lib_name.t +val loc : t -> Loc.t +val to_dyn : t -> Dyn.t diff --git a/src/dune_rules/lib_info.ml b/src/dune_rules/lib_info.ml index 3e9ca392758..a06610a72b3 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -290,50 +290,6 @@ module File_deps = struct ;; end -module Library_id = struct - module T = struct - type t = - { name : Lib_name.t - ; loc : Loc.t - ; src_dir : Path.t - ; enabled_if : Blang.t - } - - let compare a b = - match Lib_name.compare a.name b.name with - | Eq -> - (match Path.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.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 external_ ~loc ~src_dir name = { name; loc; enabled_if = Blang.true_; src_dir } - - let make ~loc ~src_dir ~enabled_if name = - { name; loc; enabled_if; src_dir = Path.source src_dir } - ;; - - let name { name; _ } = name - let loc { loc; _ } = loc -end - (** {1 Lib_info_invariants} Many of the fields here are optional and are "entangled" in the sense that @@ -344,7 +300,7 @@ end type 'path t = { loc : Loc.t ; name : Lib_name.t - ; library_id : Library_id.t + ; lib_id : Lib_id.t ; kind : Lib_kind.t ; status : Status.t ; src_dir : 'path @@ -383,7 +339,7 @@ type 'path t = } let name t = t.name -let library_id t = t.library_id +let lib_id t = t.lib_id let version t = t.version let dune_version t = t.dune_version let loc t = t.loc @@ -437,7 +393,7 @@ let create ~loc ~path_kind ~name - ~library_id + ~lib_id ~kind ~status ~src_dir @@ -475,7 +431,7 @@ let create = { loc ; name - ; library_id + ; lib_id ; kind ; status ; src_dir @@ -568,7 +524,7 @@ let to_dyn { loc ; path_kind = _ ; name - ; library_id + ; lib_id ; kind ; status ; src_dir @@ -610,7 +566,7 @@ let to_dyn record [ "loc", Loc.to_dyn_hum loc ; "name", Lib_name.to_dyn name - ; "library_id", Library_id.to_dyn library_id + ; "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 153d7527998..f0e69642a01 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -86,25 +86,10 @@ module Main_module_name : sig type t = Module_name.t option Inherited.t end -(** What's the subset of fields that uniquely identifies this stanza? *) -module Library_id : 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 external_ : loc:Loc.t -> src_dir:Path.t -> Lib_name.t -> t - val name : t -> Lib_name.t - val loc : t -> Loc.t - val to_dyn : t -> Dyn.t -end - type 'path t val name : _ t -> Lib_name.t -val library_id : _ t -> Library_id.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 @@ -207,7 +192,7 @@ val create : loc:Loc.t -> path_kind:'a path -> name:Lib_name.t - -> library_id:Library_id.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 ead96ab4f6a..da2695d4d20 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -648,15 +648,14 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = let src_dir = Path.Build.drop_build_context_exn dir in Lib.DB.get_compile_info (Scope.libs scope) - (Library.to_library_id ~src_dir lib) + (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 (Lib_info.library_id (Lib.Local.info local_lib))) + >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id (Lib.Local.info local_lib))) 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 0290b1beab5..7b66dd70c9f 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_info.Library_id.Map.t + { libraries : component Lib_id.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_info.Library_id.Map.empty + { libraries = Lib_id.Map.empty ; executables = String.Map.empty ; melange_emits = String.Map.empty ; rev_map = Module_name.Path.Map.empty @@ -65,7 +65,7 @@ module Modules = struct let _, libraries = List.fold_left libs - ~init:(Lib_name.Set.empty, Lib_info.Library_id.Map.empty) + ~init:(Lib_name.Set.empty, Lib_id.Map.empty) ~f:(fun (libname_set, acc) part -> let stanza = part.stanza in let name = @@ -74,7 +74,7 @@ module Modules = struct |> Path.build |> Path.drop_optional_build_context_src_exn in - Lib_info.Library_id.name (Library.to_library_id ~src_dir stanza) + Lib_id.name (Library.to_lib_id ~src_dir stanza) in match Lib_name.Set.mem libname_set name with | true -> @@ -86,13 +86,13 @@ module Modules = struct ] | false -> let acc = - let library_id = + let lib_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build part.dir) in - Library.to_library_id ~src_dir part.stanza + Library.to_lib_id ~src_dir part.stanza in - Lib_info.Library_id.Map.add_exn acc library_id (part.modules, part.obj_dir) + Lib_id.Map.add_exn acc lib_id (part.modules, part.obj_dir) in Lib_name.Set.add libname_set name, acc) in @@ -245,14 +245,14 @@ let modules_of_files ~path ~dialects ~dir ~files = ;; type for_ = - | Library of Lib_info.Library_id.t + | Library of Lib_id.t | Exe of { first_exe : string } | Melange of { target : string } let dyn_of_for_ = let open Dyn in function - | Library n -> variant "Library" [ Lib_info.Library_id.to_dyn n ] + | Library n -> variant "Library" [ Lib_id.to_dyn n ] | Exe { first_exe } -> variant "Exe" [ record [ "first_exe", string first_exe ] ] | Melange { target } -> variant "Melange" [ record [ "target", string target ] ] ;; @@ -260,7 +260,7 @@ let dyn_of_for_ = let modules_and_obj_dir t ~for_ = match match for_ with - | Library library_id -> Lib_info.Library_id.Map.find t.modules.libraries library_id + | Library lib_id -> Lib_id.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 @@ -268,9 +268,7 @@ let modules_and_obj_dir t ~for_ = | None -> let map = match for_ with - | Library _ -> - Lib_info.Library_id.Map.keys t.modules.libraries - |> Dyn.list Lib_info.Library_id.to_dyn + | Library _ -> Lib_id.Map.keys t.modules.libraries |> Dyn.list Lib_id.to_dyn | Exe _ -> String.Map.keys t.modules.executables |> Dyn.(list string) | Melange _ -> String.Map.keys t.modules.melange_emits |> Dyn.(list string) in @@ -290,7 +288,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_info.library_id info)) + modules t ~for_:(Library (Lib_info.lib_id info)) in let existing_virtual_modules = Modules_group.virtual_module_names modules in let allow_new_public_modules = @@ -341,7 +339,7 @@ let make_lib_modules let* resolved = let* libs = libs in let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Lib.DB.find_library_id_even_when_hidden libs (Library.to_library_id ~src_dir lib) + Lib.DB.find_lib_id_even_when_hidden libs (Library.to_lib_id ~src_dir lib) (* can't happen because this library is defined using the current stanza *) >>| Option.value_exn diff --git a/src/dune_rules/ml_sources.mli b/src/dune_rules/ml_sources.mli index ec1491c1640..e1ce4e41953 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_info.Library_id.t + | Library of Lib_id.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 a511161207a..b8a368fa3dc 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -952,9 +952,9 @@ let setup_private_library_doc_alias sctx ~scope ~dir (l : Library.t) = let ctx = Super_context.context sctx in let* lib = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Lib.DB.find_library_id_even_when_hidden + Lib.DB.find_lib_id_even_when_hidden (Scope.libs scope) - (Library.to_library_id ~src_dir l) + (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 e530dbfd5ce..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_library_id db (Lib_info.library_id info) + 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 63647dd1437..3df333a1570 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -70,19 +70,18 @@ module DB = struct let module Resolve_result = Lib.DB.Resolve_result in let module With_multiple_results = Resolve_result.With_multiple_results in let not_found = With_multiple_results.resolve_result Resolve_result.not_found in - fun ~resolve_library_id id_map name -> + fun ~resolve_lib_id id_map name -> match Lib_name.Map.find id_map name - |> Option.bind ~f:(fun library_ids -> - Lib_info.Library_id.Set.to_list library_ids |> Nonempty_list.of_list) + |> Option.bind ~f:(fun lib_ids -> + Lib_id.Set.to_list lib_ids |> Nonempty_list.of_list) with | None -> Memo.return not_found - | Some [ library_id ] -> - resolve_library_id library_id >>| With_multiple_results.resolve_result - | Some library_ids -> - Memo.List.map ~f:resolve_library_id (Nonempty_list.to_list library_ids) - >>| fun library_ids -> - Nonempty_list.of_list library_ids + | Some [ lib_id ] -> resolve_lib_id lib_id >>| With_multiple_results.resolve_result + | Some lib_ids -> + Memo.List.map ~f:resolve_lib_id (Nonempty_list.to_list lib_ids) + >>| fun lib_ids -> + Nonempty_list.of_list lib_ids |> Option.value_exn |> With_multiple_results.multiple_results ;; @@ -95,13 +94,13 @@ module DB = struct end let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = - let library_id_map, id_map = - let _, id_map, library_id_map = + let lib_id_map, id_map = + let _, id_map, lib_id_map = List.fold_left stanzas - ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Library_id.Map.empty) - ~f:(fun (libname_map, id_map, library_id_map) (dir, stanza) -> - let name, library_id, r2 = + ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_id.Map.empty) + ~f:(fun (libname_map, id_map, lib_id_map) (dir, stanza) -> + let name, lib_id, 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 -> @@ -116,22 +115,22 @@ module DB = struct Toggle.of_bool enabled) in Found_or_redirect.redirect ~enabled old_public_name s.new_public_name - and library_id = Library_redirect.Local.to_library_id ~src_dir s in - lib_name, library_id, redirect + and lib_id = Library_redirect.Local.to_lib_id ~src_dir s in + lib_name, Some lib_id, 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 - and library_id = Deprecated_library_name.to_library_id ~src_dir s in - lib_name, library_id, deprecated_lib + in + lib_name, None, 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 library_id = Library.to_library_id ~src_dir conf in - Library.best_name conf, library_id, Found_or_redirect.found info + and lib_id = Library.to_lib_id ~src_dir conf in + Library.best_name conf, Some lib_id, Found_or_redirect.found info in let libname_map' = Lib_name.Map.update libname_map name ~f:(function @@ -176,25 +175,29 @@ module DB = struct ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) ])) - and id_map' = - let id_map : Lib_info.Library_id.Set.t Lib_name.Map.t = id_map in - Lib_name.Map.update id_map name ~f:(fun library_ids -> - Some - (match - Option.map library_ids ~f:(fun library_ids -> - Lib_info.Library_id.Set.add library_ids library_id) - with - | None -> Lib_info.Library_id.Set.singleton library_id - | Some s -> s)) - and library_id_map' = - Lib_info.Library_id.Map.add_exn library_id_map library_id r2 in - libname_map', id_map', library_id_map') + let id_map', lib_id_map' = + match lib_id with + | None -> id_map, lib_id_map + | Some lib_id -> + let id_map' = + Lib_name.Map.update id_map name ~f:(fun lib_ids -> + Some + (match + Option.map lib_ids ~f:(fun lib_ids -> + Lib_id.Set.add lib_ids lib_id) + with + | None -> Lib_id.Set.singleton lib_id + | Some s -> s)) + and lib_id_map' = Lib_id.Map.add_exn lib_id_map lib_id r2 in + id_map', lib_id_map' + in + libname_map', id_map', lib_id_map') in - library_id_map, id_map + lib_id_map, id_map in - let resolve_library_id library_id = - match Lib_info.Library_id.Map.find library_id_map library_id with + let resolve_lib_id lib_id = + match Lib_id.Map.find lib_id_map lib_id with | None -> Memo.return Lib.DB.Resolve_result.not_found | Some (Redirect { loc; to_; enabled; _ }) -> let+ enabled = @@ -208,12 +211,12 @@ module DB = struct | Some (Deprecated_library_name lib) -> Memo.return (Lib.DB.Resolve_result.redirect_in_the_same_db lib) in - let resolve = resolve ~resolve_library_id id_map in + let resolve = resolve ~resolve_lib_id id_map in Lib.DB.create () ~parent:(Some parent) ~resolve - ~resolve_library_id + ~resolve_lib_id ~all:(fun () -> Lib_name.Map.keys id_map |> Memo.return) ~lib_config ~instrument_with @@ -222,16 +225,16 @@ module DB = struct type redirect_to = | Project of { project : Dune_project.t - ; library_id : Lib_info.Library_id.t + ; lib_id : Lib_id.t } | Name of (Loc.t * Lib_name.t) - let resolve_library_id t public_libs library_id : Lib.DB.Resolve_result.t = - match Lib_info.Library_id.Map.find public_libs library_id with + 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; library_id }) -> + | Some (Project { project; lib_id }) -> let scope = find_by_project (Fdecl.get t) project in - Lib.DB.Resolve_result.redirect scope.db library_id + Lib.DB.Resolve_result.redirect scope.db lib_id | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db name ;; @@ -241,42 +244,39 @@ module DB = struct let _, public_ids, public_libs = List.fold_left stanzas - ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_info.Library_id.Map.empty) + ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_id.Map.empty) ~f: (fun - (libname_map, id_map, library_id_map) + (libname_map, id_map, lib_id_map) ((dir, stanza) : Path.Build.t * Library_related_stanza.t) -> let candidate = match stanza with | Library ({ project; visibility = Public p; _ } as conf) -> - let library_id = + let lib_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Library.to_library_id ~src_dir conf + Library.to_lib_id ~src_dir conf in - Some (Public_lib.name p, Project { project; library_id }, library_id) + Some (Public_lib.name p, Project { project; lib_id }, Some lib_id) | Library _ | Library_redirect _ -> None | Deprecated_library_name s -> - let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in Some - ( Deprecated_library_name.old_public_name s - , Name s.new_public_name - , Deprecated_library_name.to_library_id ~src_dir s ) + (Deprecated_library_name.old_public_name s, Name s.new_public_name, None) in match candidate with - | None -> libname_map, id_map, library_id_map - | Some (public_name, r2, library_id) -> + | None | Some (_, _, None) -> libname_map, id_map, lib_id_map + | Some (public_name, r2, Some lib_id2) -> let libname_map' = Lib_name.Map.update libname_map public_name ~f:(function - | None -> Some (library_id, r2) - | Some (sent1, _r1) -> - (match (Lib_info.Library_id.equal sent1) library_id with - | false -> Some (library_id, r2) + | None -> Some (lib_id2, r2) + | Some (lib_id1, _r1) -> + (match (Lib_id.equal lib_id1) lib_id2 with + | false -> Some (lib_id2, r2) | true -> - let loc1 = Lib_info.Library_id.loc sent1 - and loc2 = Lib_info.Library_id.loc library_id in + let loc1 = Lib_id.loc lib_id1 + and loc2 = Lib_id.loc lib_id2 in let main_message = Pp.textf "Public library %s is defined twice:" @@ -301,31 +301,27 @@ module DB = struct ; Pp.textf "- %s" (Loc.to_file_colon_line loc1) ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) ])) - and id_map' = - let id_map : Lib_info.Library_id.Set.t Lib_name.Map.t = id_map in - Lib_name.Map.update id_map public_name ~f:(fun library_ids -> + in + let id_map' = + Lib_name.Map.update id_map public_name ~f:(fun lib_ids -> Some (match - Option.map library_ids ~f:(fun library_ids -> - Lib_info.Library_id.Set.add library_ids library_id) + Option.map lib_ids ~f:(fun lib_ids -> + Lib_id.Set.add lib_ids lib_id2) with - | None -> Lib_info.Library_id.Set.singleton library_id + | None -> Lib_id.Set.singleton lib_id2 | Some s -> s)) - and library_id_map' = - Lib_info.Library_id.Map.add_exn library_id_map library_id r2 - in - libname_map', id_map', library_id_map') + and lib_id_map' = Lib_id.Map.add_exn lib_id_map lib_id2 r2 in + libname_map', id_map', lib_id_map') in public_libs, public_ids in - let resolve_library_id library_id = - Memo.return (resolve_library_id t public_libs library_id) - in - let resolve = resolve ~resolve_library_id public_ids in + let resolve_lib_id lib_id = Memo.return (resolve_lib_id t public_libs lib_id) in + let resolve = resolve ~resolve_lib_id public_ids in Lib.DB.create ~parent:(Some installed_libs) ~resolve - ~resolve_library_id + ~resolve_lib_id ~all:(fun () -> Lib_name.Map.keys public_ids |> Memo.return) ~lib_config () @@ -488,7 +484,7 @@ module DB = struct 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_library_id db (Library.to_library_id ~src_dir lib) + Lib.DB.find_lib_id db (Library.to_lib_id ~src_dir lib) in (match lib with | None -> acc diff --git a/src/dune_rules/stanzas/deprecated_library_name.ml b/src/dune_rules/stanzas/deprecated_library_name.ml index de54ba5b3b0..99ff37ccb73 100644 --- a/src/dune_rules/stanzas/deprecated_library_name.ml +++ b/src/dune_rules/stanzas/deprecated_library_name.ml @@ -47,10 +47,3 @@ let decode = in { Library_redirect.loc; project; old_name; new_public_name }) ;; - -let to_library_id ~src_dir (t : t) = - let lib, _ = t.old_name in - let loc = Public_lib.loc lib - and enabled_if = Blang.true_ in - Lib_info.Library_id.make ~loc ~src_dir ~enabled_if (Public_lib.name lib) -;; diff --git a/src/dune_rules/stanzas/deprecated_library_name.mli b/src/dune_rules/stanzas/deprecated_library_name.mli index 8cb94f3eca4..b4a1e15490a 100644 --- a/src/dune_rules/stanzas/deprecated_library_name.mli +++ b/src/dune_rules/stanzas/deprecated_library_name.mli @@ -15,4 +15,3 @@ val decode : t Dune_lang.Decoder.t include Stanza.S with type t := t val old_public_name : t -> Lib_name.t -val to_library_id : src_dir:Path.Source.t -> t -> Lib_info.Library_id.t diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index a22e7e9134d..8cc5472ab88 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -403,10 +403,10 @@ let main_module_name t : Lib_info.Main_module_name.t = This (Some (Module_name.of_local_lib_name t.name)) ;; -let to_library_id ~src_dir t = +let to_lib_id ~src_dir t = let loc, _ = t.name and enabled_if = t.enabled_if in - Lib_info.Library_id.make ~loc ~src_dir ~enabled_if (Lib_name.of_local t.name) + Lib_id.make ~loc ~src_dir ~enabled_if (Lib_name.of_local t.name) ;; let to_lib_info @@ -482,9 +482,9 @@ let to_lib_info in let main_module_name = main_module_name conf in let name = best_name conf in - let library_id = + let lib_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - to_library_id ~src_dir conf + to_lib_id ~src_dir conf in let enabled = let+ enabled_if_result = @@ -547,7 +547,7 @@ let to_lib_info ~loc ~path_kind:Local ~name - ~library_id + ~lib_id ~kind ~status ~src_dir diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index d52fe4ff9d0..eab8bd785cc 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -76,7 +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_library_id : src_dir:Path.Source.t -> t -> Lib_info.Library_id.t +val to_lib_id : src_dir:Path.Source.t -> t -> Lib_id.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 a93679f7fdc..21402869587 100644 --- a/src/dune_rules/stanzas/library_redirect.ml +++ b/src/dune_rules/stanzas/library_redirect.ml @@ -54,13 +54,9 @@ module Local = struct Some (for_lib lib ~loc ~new_public_name:public_name)) ;; - let to_library_id ~src_dir t = + let to_lib_id ~src_dir t = let loc = t.loc and enabled_if = t.old_name.enabled in - Lib_info.Library_id.make - ~loc - ~src_dir - ~enabled_if - (Lib_name.of_local t.old_name.lib_name) + Lib_id.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 e1420506af7..41eafa01c61 100644 --- a/src/dune_rules/stanzas/library_redirect.mli +++ b/src/dune_rules/stanzas/library_redirect.mli @@ -31,5 +31,5 @@ module Local : sig val of_private_lib : Library.t -> t option val of_lib : Library.t -> t option - val to_library_id : src_dir:Path.Source.t -> t -> Lib_info.Library_id.t + val to_lib_id : src_dir:Path.Source.t -> t -> Lib_id.t end diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index 89cba153ac6..119ae045924 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -115,7 +115,7 @@ 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 (Lib_info.library_id info)) + >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info)) >>= Modules.map_user_written ~f:(fun m -> Memo.return (pp_spec m)) in let+ foreign_objects = 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 8323203d112..39735178493 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 @@ -19,17 +19,7 @@ different folders. Without any consumers of the libraries (both are built in separate folders) - $ dune build --display short - ocamlc a/.foo.objs/byte/foo.{cmi,cmo,cmt} - ocamlc b/.foo.objs/byte/foo.{cmi,cmo,cmt} - ocamlopt a/.foo.objs/native/foo.{cmx,o} - ocamlc a/foo.cma - ocamlopt b/.foo.objs/native/foo.{cmx,o} - ocamlc b/foo.cma - ocamlopt a/foo.{a,cmxa} - ocamlopt b/foo.{a,cmxa} - ocamlopt a/foo.cmxs - ocamlopt b/foo.cmxs + $ dune build a/foo.cma b/foo.cma With some consumer of the library From 007b41ec285d73f5132ffad4e9fa94e836ab21d3 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 29 Mar 2024 23:38:07 -0700 Subject: [PATCH 20/38] refactor: use a variant for Lib_id to distinguish Local / External Signed-off-by: Antonio Nuno Monteiro --- bin/describe/describe_workspace.ml | 3 +- src/dune_rules/dir_contents.ml | 3 +- src/dune_rules/dune_package.ml | 2 +- src/dune_rules/dune_rules.ml | 1 + src/dune_rules/findlib.ml | 2 +- src/dune_rules/gen_rules.ml | 4 +- src/dune_rules/install_rules.ml | 15 +++- src/dune_rules/lib_id.ml | 84 +++++++++++++++------ src/dune_rules/lib_id.mli | 21 +++++- src/dune_rules/lib_rules.ml | 6 +- src/dune_rules/ml_sources.ml | 23 +++--- src/dune_rules/ml_sources.mli | 2 +- src/dune_rules/odoc.ml | 2 +- src/dune_rules/scope.ml | 14 ++-- src/dune_rules/stanzas/library.ml | 4 +- src/dune_rules/stanzas/library.mli | 2 +- src/dune_rules/stanzas/library_redirect.ml | 2 +- src/dune_rules/stanzas/library_redirect.mli | 2 +- src/dune_rules/virtual_rules.ml | 3 +- 19 files changed, 132 insertions(+), 63 deletions(-) diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index c2e1c894c02..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 (Lib_info.lib_id info)) + >>| 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/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index ed9206d9ef5..2006b482d33 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -456,7 +456,8 @@ let modules_of_local_lib sctx lib = let dir = Lib_info.src_dir info in get sctx ~dir in - ocaml t >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info)) + 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 3524d6e67d4..50937ebd1e8 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -231,7 +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 ~src_dir name 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 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 d865ee9e541..05b09cc3788 100644 --- a/src/dune_rules/findlib.ml +++ b/src/dune_rules/findlib.ml @@ -207,7 +207,7 @@ let to_dune_library (t : Findlib.Package.t) ~dir_contents ~ext_lib ~external_loc in let modules = Lib_info.Source.External None in let name = t.name in - let lib_id = Lib_id.external_ ~loc ~src_dir name in + let lib_id = Lib_id.External (loc, name) in Lib_info.create ~loc ~path_kind:External diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 3198b7d2210..41dc463d4c2 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -112,7 +112,9 @@ end = struct empty_none | Library.T lib -> let* enabled_if = - Lib.DB.available_by_lib_id (Scope.libs scope) (Library.to_lib_id ~src_dir lib) + 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 diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 242b0ddf27b..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.lib_id 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) @@ -182,7 +185,8 @@ end = struct let* installable_modules = let+ modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info)) + >>| 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 @@ -345,7 +349,9 @@ end = struct |> Path.build |> Path.drop_optional_build_context_src_exn in - Lib.DB.available_by_lib_id (Scope.libs scope) (Library.to_lib_id ~src_dir lib)) + 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 @@ -660,7 +666,8 @@ end = struct |> List.map ~f:Path.build and* modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info)) + >>| 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_id.ml b/src/dune_rules/lib_id.ml index 625c78da497..dcebf420c37 100644 --- a/src/dune_rules/lib_id.ml +++ b/src/dune_rules/lib_id.ml @@ -1,30 +1,61 @@ 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 = - { name : Lib_name.t - ; loc : Loc.t - ; src_dir : Path.t - ; enabled_if : Blang.t - } + | External of (Loc.t * Lib_name.t) + | Local of Local.t let compare a b = - match Lib_name.compare a.name b.name with - | Eq -> - (match Path.compare a.src_dir b.src_dir with - | Eq -> Loc.compare a.loc b.loc - | o -> o) - | x -> x + 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 { name; loc; enabled_if; src_dir } = + let to_dyn t = let open Dyn in - record - [ "name", Lib_name.to_dyn name - ; "loc", Loc.to_dyn_hum loc - ; "src_dir", Path.to_dyn src_dir - ; "enabled_if", Blang.to_dyn enabled_if - ] + 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) @@ -33,11 +64,18 @@ end include T include Comparable.Make (T) -let external_ ~loc ~src_dir name = { name; loc; enabled_if = Blang.true_; src_dir } +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 make ~loc ~src_dir ~enabled_if name = - { name; loc; enabled_if; src_dir = Path.source src_dir } +let name = function + | Local { name; _ } -> name + | External (_, name) -> name ;; -let name { name; _ } = name -let loc { loc; _ } = loc +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 index 30d4c8973ff..258ca5df5d0 100644 --- a/src/dune_rules/lib_id.mli +++ b/src/dune_rules/lib_id.mli @@ -1,13 +1,26 @@ open Import -type t +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 equal : t -> t -> bool -val make : loc:Loc.t -> src_dir:Path.Source.t -> enabled_if:Blang.t -> Lib_name.t -> t -val external_ : loc:Loc.t -> src_dir:Path.t -> Lib_name.t -> 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_rules.ml b/src/dune_rules/lib_rules.ml index da2695d4d20..75f9d4d8df6 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -648,14 +648,16 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = let src_dir = Path.Build.drop_build_context_exn dir in Lib.DB.get_compile_info (Scope.libs scope) - (Library.to_lib_id ~src_dir 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 (Lib_info.lib_id (Lib.Local.info local_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 7b66dd70c9f..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_id.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_id.Map.empty + { libraries = Lib_id.Local.Map.empty ; executables = String.Map.empty ; melange_emits = String.Map.empty ; rev_map = Module_name.Path.Map.empty @@ -65,7 +65,7 @@ module Modules = struct let _, libraries = List.fold_left libs - ~init:(Lib_name.Set.empty, Lib_id.Map.empty) + ~init:(Lib_name.Set.empty, Lib_id.Local.Map.empty) ~f:(fun (libname_set, acc) part -> let stanza = part.stanza in let name = @@ -74,7 +74,7 @@ module Modules = struct |> Path.build |> Path.drop_optional_build_context_src_exn in - Lib_id.name (Library.to_lib_id ~src_dir stanza) + Lib_id.name (Local (Library.to_lib_id ~src_dir stanza)) in match Lib_name.Set.mem libname_set name with | true -> @@ -92,7 +92,7 @@ module Modules = struct in Library.to_lib_id ~src_dir part.stanza in - Lib_id.Map.add_exn acc lib_id (part.modules, part.obj_dir) + Lib_id.Local.Map.add_exn acc lib_id (part.modules, part.obj_dir) in Lib_name.Set.add libname_set name, acc) in @@ -245,14 +245,14 @@ let modules_of_files ~path ~dialects ~dir ~files = ;; type for_ = - | Library of Lib_id.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_id.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 ] ] ;; @@ -260,7 +260,7 @@ let dyn_of_for_ = let modules_and_obj_dir t ~for_ = match match for_ with - | Library lib_id -> Lib_id.Map.find t.modules.libraries lib_id + | 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 @@ -268,7 +268,8 @@ let modules_and_obj_dir t ~for_ = | None -> let map = match for_ with - | Library _ -> Lib_id.Map.keys t.modules.libraries |> Dyn.list Lib_id.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 @@ -288,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_info.lib_id info)) + 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 = @@ -339,7 +340,7 @@ let make_lib_modules let* resolved = let* libs = libs in let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - Lib.DB.find_lib_id_even_when_hidden libs (Library.to_lib_id ~src_dir lib) + 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 diff --git a/src/dune_rules/ml_sources.mli b/src/dune_rules/ml_sources.mli index e1ce4e41953..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_id.t + | 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 b8a368fa3dc..ea114085bca 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -954,7 +954,7 @@ let setup_private_library_doc_alias sctx ~scope ~dir (l : Library.t) = 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) - (Library.to_lib_id ~src_dir l) + (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/scope.ml b/src/dune_rules/scope.ml index 3df333a1570..83f6cf21d95 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -180,6 +180,7 @@ module DB = struct match lib_id with | None -> id_map, lib_id_map | Some lib_id -> + let lib_id = Lib_id.Local lib_id in let id_map' = Lib_name.Map.update id_map name ~f:(fun lib_ids -> Some @@ -225,7 +226,7 @@ module DB = struct type redirect_to = | Project of { project : Dune_project.t - ; lib_id : Lib_id.t + ; lib_id : Lib_id.Local.t } | Name of (Loc.t * Lib_name.t) @@ -234,7 +235,7 @@ module DB = struct | None -> Lib.DB.Resolve_result.not_found | Some (Project { project; lib_id }) -> let scope = find_by_project (Fdecl.get t) project in - Lib.DB.Resolve_result.redirect scope.db lib_id + Lib.DB.Resolve_result.redirect scope.db (Local lib_id) | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db name ;; @@ -272,11 +273,11 @@ module DB = struct Lib_name.Map.update libname_map public_name ~f:(function | None -> Some (lib_id2, r2) | Some (lib_id1, _r1) -> - (match (Lib_id.equal lib_id1) lib_id2 with + (match (Lib_id.Local.equal lib_id1) lib_id2 with | false -> Some (lib_id2, r2) | true -> - let loc1 = Lib_id.loc lib_id1 - and loc2 = Lib_id.loc lib_id2 in + let loc1 = Lib_id.Local.loc lib_id1 + and loc2 = Lib_id.Local.loc lib_id2 in let main_message = Pp.textf "Public library %s is defined twice:" @@ -302,6 +303,7 @@ module DB = struct ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) ])) in + let lib_id2 = Lib_id.Local lib_id2 in let id_map' = Lib_name.Map.update id_map public_name ~f:(fun lib_ids -> Some @@ -484,7 +486,7 @@ module DB = struct 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_lib_id db (Library.to_lib_id ~src_dir lib) + Lib.DB.find_lib_id db (Local (Library.to_lib_id ~src_dir lib)) in (match lib with | None -> acc diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index 8cc5472ab88..71ad669e6a5 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -406,7 +406,7 @@ let main_module_name t : Lib_info.Main_module_name.t = let to_lib_id ~src_dir t = let loc, _ = t.name and enabled_if = t.enabled_if in - Lib_id.make ~loc ~src_dir ~enabled_if (Lib_name.of_local t.name) + Lib_id.Local.make ~loc ~src_dir ~enabled_if (Lib_name.of_local t.name) ;; let to_lib_info @@ -484,7 +484,7 @@ let to_lib_info let name = best_name conf in let lib_id = let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in - to_lib_id ~src_dir conf + Lib_id.Local (to_lib_id ~src_dir conf) in let enabled = let+ enabled_if_result = diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index eab8bd785cc..1923ef0fa17 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -76,7 +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.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 21402869587..eaea020df6f 100644 --- a/src/dune_rules/stanzas/library_redirect.ml +++ b/src/dune_rules/stanzas/library_redirect.ml @@ -57,6 +57,6 @@ module Local = struct let to_lib_id ~src_dir t = let loc = t.loc and enabled_if = t.old_name.enabled in - Lib_id.make ~loc ~src_dir ~enabled_if (Lib_name.of_local t.old_name.lib_name) + 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 41eafa01c61..3f40b004246 100644 --- a/src/dune_rules/stanzas/library_redirect.mli +++ b/src/dune_rules/stanzas/library_redirect.mli @@ -31,5 +31,5 @@ module Local : sig 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.t + 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 119ae045924..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 (Lib_info.lib_id info)) + >>| 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 = From 1bb1cc586f922346b3c6eb44af33f57a7928b49b Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 30 Mar 2024 19:23:38 -0700 Subject: [PATCH 21/38] fix: account for deprecated libraries too Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/scope.ml | 392 ++++++++---------- .../lib-collision/lib-collision-private.t | 4 +- .../lib-collision-public-same-public-name.t | 20 +- .../lib-collision/lib-collision-public.t | 6 +- 4 files changed, 191 insertions(+), 231 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 83f6cf21d95..a242a499baf 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -14,6 +14,9 @@ let libs t = t.db let coq_libs t = t.coq_db module DB = struct + module Resolve_result = Lib.DB.Resolve_result + module With_multiple_results = Resolve_result.With_multiple_results + type scope = t type t = { by_dir : scope Path.Source.Map.t } @@ -66,26 +69,6 @@ module DB = struct let found x = Found x end - let resolve = - let module Resolve_result = Lib.DB.Resolve_result in - let module With_multiple_results = Resolve_result.With_multiple_results in - let not_found = With_multiple_results.resolve_result Resolve_result.not_found in - fun ~resolve_lib_id id_map name -> - match - Lib_name.Map.find id_map name - |> Option.bind ~f:(fun lib_ids -> - Lib_id.Set.to_list lib_ids |> Nonempty_list.of_list) - with - | None -> Memo.return not_found - | Some [ lib_id ] -> resolve_lib_id lib_id >>| With_multiple_results.resolve_result - | Some lib_ids -> - Memo.List.map ~f:resolve_lib_id (Nonempty_list.to_list lib_ids) - >>| fun lib_ids -> - Nonempty_list.of_list lib_ids - |> Option.value_exn - |> With_multiple_results.multiple_results - ;; - module Library_related_stanza = struct type t = | Library of Library.t @@ -93,132 +76,100 @@ module DB = struct | 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 = Memo.Lazy.force enabled in + Toggle.enabled toggle + in + if enabled + then Resolve_result.redirect_in_the_same_db (loc, to_) + else Resolve_result.not_found + | Found lib -> Memo.return (Resolve_result.found lib) + | Deprecated_library_name lib -> + Memo.return (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 Resolve_result.not_found + | Some found_or_redirect -> resolve_found_or_redirect found_or_redirect + ;; + + let not_found = With_multiple_results.resolve_result Resolve_result.not_found + let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = - let lib_id_map, id_map = - let _, id_map, lib_id_map = - List.fold_left - stanzas - ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_id.Map.empty) - ~f:(fun (libname_map, id_map, lib_id_map) (dir, stanza) -> - let name, lib_id, 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+ enabled = - let* expander = Expander0.get ~dir in - Expander0.eval_blang expander s.old_name.enabled - in - Toggle.of_bool enabled) - 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 - lib_name, Some lib_id, 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 + let lib_name_map, lib_id_map = + List.fold_left + stanzas + ~init:(Lib_name.Map.empty, Lib_id.Map.empty) + ~f:(fun (libname_map, lib_id_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+ enabled = + let* expander = Expander0.get ~dir in + Expander0.eval_blang expander s.old_name.enabled + in + Toggle.of_bool enabled) in - lib_name, None, 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 - Library.best_name conf, Some lib_id, Found_or_redirect.found info - in - let libname_map' = - Lib_name.Map.update libname_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 id_map', lib_id_map' = - match lib_id with - | None -> id_map, lib_id_map - | Some lib_id -> - let lib_id = Lib_id.Local lib_id in - let id_map' = - Lib_name.Map.update id_map name ~f:(fun lib_ids -> - Some - (match - Option.map lib_ids ~f:(fun lib_ids -> - Lib_id.Set.add lib_ids lib_id) - with - | None -> Lib_id.Set.singleton lib_id - | Some s -> s)) - and lib_id_map' = Lib_id.Map.add_exn lib_id_map lib_id r2 in - id_map', lib_id_map' - in - libname_map', id_map', lib_id_map') - in - lib_id_map, id_map - in - let resolve_lib_id lib_id = - match Lib_id.Map.find lib_id_map lib_id with - | None -> Memo.return Lib.DB.Resolve_result.not_found - | Some (Redirect { loc; to_; enabled; _ }) -> - let+ enabled = - let+ toggle = Memo.Lazy.force 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 - | Some (Found lib) -> Memo.return (Lib.DB.Resolve_result.found lib) - | Some (Deprecated_library_name lib) -> - Memo.return (Lib.DB.Resolve_result.redirect_in_the_same_db lib) + 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 + let libname_map' = + Lib_name.Map.update libname_map name ~f:(function + | None -> Some [ r2 ] + | Some (r1 :: rest : Found_or_redirect.t Nonempty_list.t) -> + Some (r2 :: r1 :: rest)) + in + let lib_id_map' = + match lib_id with + | None -> lib_id_map + | Some lib_id -> + let lib_id = Lib_id.Local lib_id in + Lib_id.Map.add_exn lib_id_map lib_id r2 + in + libname_map', lib_id_map') in - let resolve = resolve ~resolve_lib_id id_map in + let resolve name = + match Lib_name.Map.find lib_name_map name with + | None -> Memo.return not_found + | Some [ fr ] -> + resolve_found_or_redirect fr >>| With_multiple_results.resolve_result + | Some frs -> + Memo.List.map ~f:resolve_found_or_redirect (Nonempty_list.to_list frs) + >>| fun results -> + Nonempty_list.of_list results + |> Option.value_exn + |> With_multiple_results.multiple_results + and resolve_lib_id = resolve_lib_id lib_id_map in Lib.DB.create () ~parent:(Some parent) ~resolve ~resolve_lib_id - ~all:(fun () -> Lib_name.Map.keys id_map |> Memo.return) + ~all:(fun () -> Lib_name.Map.keys lib_name_map |> Memo.return) ~lib_config ~instrument_with ;; @@ -230,101 +181,104 @@ module DB = struct } | Name of (Loc.t * Lib_name.t) - let resolve_lib_id t public_libs lib_id : Lib.DB.Resolve_result.t = + 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 + Resolve_result.redirect scope.db (Local lib_id) + | Name name -> Resolve_result.redirect_in_the_same_db name + ;; + + let resolve_lib_id t public_libs lib_id : Resolve_result.t = match Lib_id.Map.find public_libs lib_id with - | None -> Lib.DB.Resolve_result.not_found + | None -> Resolve_result.not_found | Some (Project { project; lib_id }) -> let scope = find_by_project (Fdecl.get t) project in - Lib.DB.Resolve_result.redirect scope.db (Local lib_id) - | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db name + Resolve_result.redirect scope.db (Local lib_id) + | Some (Name name) -> 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, public_ids = - let _, public_ids, public_libs = - List.fold_left - stanzas - ~init:(Lib_name.Map.empty, Lib_name.Map.empty, Lib_id.Map.empty) - ~f: - (fun - (libname_map, id_map, lib_id_map) - ((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) + let public_libs_by_name, public_libs_by_id = + List.fold_left + stanzas + ~init:(Lib_name.Map.empty, Lib_id.Map.empty) + ~f: + (fun + (public_libs_by_name, public_libs_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 -> public_libs_by_name, public_libs_by_id + | Some (public_name, r2, lib_id2) -> + let public_libs_by_name' = + Lib_name.Map.update public_libs_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 - 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) + 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 - match candidate with - | None | Some (_, _, None) -> libname_map, id_map, lib_id_map - | Some (public_name, r2, Some lib_id2) -> - let libname_map' = - Lib_name.Map.update libname_map public_name ~f:(function - | None -> Some (lib_id2, r2) - | Some (lib_id1, _r1) -> - (match (Lib_id.Local.equal lib_id1) lib_id2 with - | false -> Some (lib_id2, r2) - | true -> - let loc1 = Lib_id.Local.loc lib_id1 - and loc2 = Lib_id.Local.loc lib_id2 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 lib_id2 = Lib_id.Local lib_id2 in - let id_map' = - Lib_name.Map.update id_map public_name ~f:(fun lib_ids -> - Some - (match - Option.map lib_ids ~f:(fun lib_ids -> - Lib_id.Set.add lib_ids lib_id2) - with - | None -> Lib_id.Set.singleton lib_id2 - | Some s -> s)) - and lib_id_map' = Lib_id.Map.add_exn lib_id_map lib_id2 r2 in - libname_map', id_map', lib_id_map') - in - public_libs, public_ids + let public_libs_by_id' = + match lib_id2 with + | None -> public_libs_by_id + | Some lib_id2 -> + let lib_id2 = Lib_id.Local lib_id2 in + Lib_id.Map.add_exn public_libs_by_id lib_id2 r2 + in + public_libs_by_name', public_libs_by_id') + in + let resolve_lib_id lib_id = Memo.return (resolve_lib_id t public_libs_by_id lib_id) in + let resolve name = + Memo.return + (match Lib_name.Map.find public_libs_by_name name with + | None -> not_found + | Some rt -> resolve_redirect_to t rt |> With_multiple_results.resolve_result) in - let resolve_lib_id lib_id = Memo.return (resolve_lib_id t public_libs lib_id) in - let resolve = resolve ~resolve_lib_id public_ids in Lib.DB.create ~parent:(Some installed_libs) ~resolve ~resolve_lib_id - ~all:(fun () -> Lib_name.Map.keys public_ids |> Memo.return) + ~all:(fun () -> Lib_name.Map.keys public_libs_by_name |> Memo.return) ~lib_config () ;; 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 39735178493..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 @@ -34,9 +34,9 @@ With some consumer of the library > EOF $ dune build - File "b/dune", line 1, characters 0-21: + File "a/dune", line 1, characters 0-21: 1 | (library 2 | (name foo)) - Error: Library with name "foo" is already defined in a/dune:1. Either change + 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-public-name.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-public-name.t index d4f2cb864aa..bb8174284f1 100644 --- 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 @@ -23,6 +23,13 @@ different folders. 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 @@ -37,11 +44,10 @@ With some consumer > EOF $ dune build - File "a/dune", line 1, characters 0-44: - 1 | (library - 2 | (name foo) - 3 | (public_name bar.foo)) - Error: Library with name "bar.foo" is already defined in b/dune:1. Either - change one of the names, or enable them conditionally using the 'enabled_if' - field. + 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 61d5fcaf363..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 @@ -38,10 +38,10 @@ With some consumer > EOF $ dune build - File "b/dune", line 1, characters 0-44: + File "a/dune", line 1, characters 0-44: 1 | (library 2 | (name foo) - 3 | (public_name baz.foo)) - Error: Library with name "foo" is already defined in a/dune:1. Either change + 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] From 727e4babe024ff5896698cb629b5816079374eec Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 16:29:44 +0100 Subject: [PATCH 22/38] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/scope.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index a242a499baf..c500b829ce9 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -158,11 +158,11 @@ module DB = struct | Some [ fr ] -> resolve_found_or_redirect fr >>| With_multiple_results.resolve_result | Some frs -> - Memo.List.map ~f:resolve_found_or_redirect (Nonempty_list.to_list frs) - >>| fun results -> - Nonempty_list.of_list results - |> Option.value_exn - |> With_multiple_results.multiple_results + Nonempty_list.to_list frs + |> Memo.parallel_map ~f:resolve_found_or_redirect + >>| Nonempty_list.of_list + >>| Option.value_exn + >>| With_multiple_results.multiple_results and resolve_lib_id = resolve_lib_id lib_id_map in Lib.DB.create () From 1076ade466fcd75bbd77f68f7949ba2155d5ccbc Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 16:32:25 +0100 Subject: [PATCH 23/38] promote Signed-off-by: Rudi Grinberg --- .../test-cases/deprecated-library-name/features.t | 4 ---- 1 file changed, 4 deletions(-) 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 5ce45c8c044..91114c6fc6f 100644 --- a/test/blackbox-tests/test-cases/deprecated-library-name/features.t +++ b/test/blackbox-tests/test-cases/deprecated-library-name/features.t @@ -247,10 +247,6 @@ We check that there is an error when there is an actual ambiguity: > EOF $ (cd d && dune build --root . @all) - Error: Library top2 is defined twice: - - dune:5 - - dune:13 - [1] Another case of ambiguity: From 47ba0dba4ca135b8265d3d7a37f793e66d70029b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 16:32:32 +0100 Subject: [PATCH 24/38] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/scope.ml | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index c500b829ce9..c3273f057e6 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -113,11 +113,8 @@ module DB = struct let old_public_name = Lib_name.of_local s.old_name.lib_name in let enabled = Memo.lazy_ (fun () -> - let+ enabled = - let* expander = Expander0.get ~dir in - Expander0.eval_blang expander s.old_name.enabled - in - Toggle.of_bool enabled) + let* expander = Expander0.get ~dir in + Expander0.eval_blang expander s.old_name.enabled >>| Toggle.of_bool) 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 @@ -146,9 +143,7 @@ module DB = struct let lib_id_map' = match lib_id with | None -> lib_id_map - | Some lib_id -> - let lib_id = Lib_id.Local lib_id in - Lib_id.Map.add_exn lib_id_map lib_id r2 + | Some lib_id -> Lib_id.Map.add_exn lib_id_map (Local lib_id) r2 in libname_map', lib_id_map') in From 5e466545bbff2c1fd39cf57f644f6068687672ac Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 16:35:40 +0100 Subject: [PATCH 25/38] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/scope.ml | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index c3273f057e6..9d021653fb6 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -100,11 +100,11 @@ module DB = struct let not_found = With_multiple_results.resolve_result Resolve_result.not_found let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = - let lib_name_map, lib_id_map = + let by_name, by_id = List.fold_left stanzas ~init:(Lib_name.Map.empty, Lib_id.Map.empty) - ~f:(fun (libname_map, lib_id_map) (dir, stanza) -> + ~f:(fun (by_name, by_id) (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 @@ -134,21 +134,20 @@ module DB = struct and lib_id = Library.to_lib_id ~src_dir conf in Some lib_id, Library.best_name conf, Found_or_redirect.found info in - let libname_map' = - Lib_name.Map.update libname_map name ~f:(function + let by_name = + Lib_name.Map.update by_name name ~f:(function | None -> Some [ r2 ] | Some (r1 :: rest : Found_or_redirect.t Nonempty_list.t) -> Some (r2 :: r1 :: rest)) - in - let lib_id_map' = + and by_id = match lib_id with - | None -> lib_id_map - | Some lib_id -> Lib_id.Map.add_exn lib_id_map (Local lib_id) r2 + | None -> by_id + | Some lib_id -> Lib_id.Map.add_exn by_id (Local lib_id) r2 in - libname_map', lib_id_map') + by_name, by_id) in let resolve name = - match Lib_name.Map.find lib_name_map name with + match Lib_name.Map.find by_name name with | None -> Memo.return not_found | Some [ fr ] -> resolve_found_or_redirect fr >>| With_multiple_results.resolve_result @@ -158,13 +157,13 @@ module DB = struct >>| Nonempty_list.of_list >>| Option.value_exn >>| With_multiple_results.multiple_results - and resolve_lib_id = resolve_lib_id lib_id_map in + and resolve_lib_id = resolve_lib_id by_id in Lib.DB.create () ~parent:(Some parent) ~resolve ~resolve_lib_id - ~all:(fun () -> Lib_name.Map.keys lib_name_map |> Memo.return) + ~all:(fun () -> Lib_name.Map.keys by_name |> Memo.return) ~lib_config ~instrument_with ;; From ac240e0475f7c55616be1817eaf50db7a2435097 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 16:43:26 +0100 Subject: [PATCH 26/38] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/scope.ml | 28 ++++++++++++---------------- 1 file changed, 12 insertions(+), 16 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 9d021653fb6..fd28a70cc0e 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -199,15 +199,13 @@ module DB = struct (* Create a database from the public libraries defined in the stanzas *) let public_libs t ~installed_libs ~lib_config stanzas = - let public_libs_by_name, public_libs_by_id = + let by_name, by_id = List.fold_left stanzas ~init:(Lib_name.Map.empty, Lib_id.Map.empty) ~f: (fun - (public_libs_by_name, public_libs_by_id) - ((dir, stanza) : Path.Build.t * Library_related_stanza.t) - -> + (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) -> @@ -222,10 +220,10 @@ module DB = struct (Deprecated_library_name.old_public_name s, Name s.new_public_name, None) in match candidate with - | None -> public_libs_by_name, public_libs_by_id + | None -> by_name, by_id | Some (public_name, r2, lib_id2) -> - let public_libs_by_name' = - Lib_name.Map.update public_libs_by_name public_name ~f:(function + 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 @@ -252,19 +250,17 @@ module DB = struct ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) ]) in - let public_libs_by_id' = + let by_id = match lib_id2 with - | None -> public_libs_by_id - | Some lib_id2 -> - let lib_id2 = Lib_id.Local lib_id2 in - Lib_id.Map.add_exn public_libs_by_id lib_id2 r2 + | None -> by_id + | Some lib_id2 -> Lib_id.Map.add_exn by_id (Local lib_id2) r2 in - public_libs_by_name', public_libs_by_id') + by_name, by_id) in - let resolve_lib_id lib_id = Memo.return (resolve_lib_id t public_libs_by_id lib_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 public_libs_by_name name with + (match Lib_name.Map.find by_name name with | None -> not_found | Some rt -> resolve_redirect_to t rt |> With_multiple_results.resolve_result) in @@ -272,7 +268,7 @@ module DB = struct ~parent:(Some installed_libs) ~resolve ~resolve_lib_id - ~all:(fun () -> Lib_name.Map.keys public_libs_by_name |> Memo.return) + ~all:(fun () -> Lib_name.Map.keys by_name |> Memo.return) ~lib_config () ;; From e4cbf767265d87ee185794b94f611261ef31bdf2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 16:49:09 +0100 Subject: [PATCH 27/38] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/scope.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index fd28a70cc0e..77a0d6fbc50 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -32,12 +32,12 @@ module DB = struct | Redirect of { loc : Loc.t ; to_ : Lib_name.t - ; enabled : Toggle.t Memo.Lazy.t + ; enabled : Toggle.t Memo.t } | Deprecated_library_name of (Loc.t * Lib_name.t) val redirect - : enabled:Toggle.t Memo.Lazy.t + : enabled:Toggle.t Memo.t -> Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t @@ -50,7 +50,7 @@ module DB = struct | Redirect of { loc : Loc.t ; to_ : Lib_name.t - ; enabled : Toggle.t Memo.Lazy.t + ; enabled : Toggle.t Memo.t } | Deprecated_library_name of (Loc.t * Lib_name.t) @@ -80,7 +80,7 @@ module DB = struct match (fr : Found_or_redirect.t) with | Redirect { loc; to_; enabled; _ } -> let+ enabled = - let+ toggle = Memo.Lazy.force enabled in + let+ toggle = enabled in Toggle.enabled toggle in if enabled @@ -115,6 +115,7 @@ module DB = struct 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 From f42679d1b24d9d11652f72665da2a30d90c3bc16 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 16:53:17 +0100 Subject: [PATCH 28/38] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/lib.ml | 37 ++++++++++++++++++------------------- 1 file changed, 18 insertions(+), 19 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 5b48baa9bd2..732be8f1c0c 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1173,27 +1173,26 @@ end = struct | Resolve_result r -> handle_resolve_result ~super db r | Multiple_results candidates -> let open Memo.O in - let+ libs = - Memo.List.filter_map (Nonempty_list.to_list 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 -> Memo.return None - | Hidden { lib = info; reason = hidden; path = _ } -> - resolve_hidden db ~info hidden >>| Option.some) - in - (match libs with + Nonempty_list.to_list candidates + |> Memo.List.filter_map ~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 -> Memo.return None + | Hidden { lib = info; reason = hidden; path = _ } -> + resolve_hidden db ~info hidden >>| Option.some) + >>| (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 -> From e6bba92a593a08e4ddf02d5926d7b45b07b6e145 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 16:55:53 +0100 Subject: [PATCH 29/38] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/lib.ml | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 732be8f1c0c..7ae024beed5 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1201,20 +1201,18 @@ end = struct (match Lib_id.equal lib_id_a lib_id_b with | true -> acc | false -> - let best_name_a = a.name - and best_name_b = b.name - and info_a = info a - and info_b = info b in - let loc_a = Lib_info.loc info_a - and loc_b = Lib_info.loc info_b - and name_a = - let lib_id = Lib_info.lib_id info_a in - Lib_id.name lib_id - in + let info_a = info a in let name = - if Lib_name.equal best_name_a best_name_b then best_name_a else name_a + if Lib_name.equal a.name b.name + then a.name + else ( + let lib_id = Lib_info.lib_id info_a in + Lib_id.name lib_id) in - Status.Invalid (Error.duplicated ~loc_a ~loc_b ~name)) + Status.Invalid + (let loc_a = Lib_info.loc info_a + and loc_b = Lib_info.loc (info b) in + Error.duplicated ~loc_a ~loc_b ~name)) | Invalid _, _ -> acc | (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _) | (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib From f04fe48e243883b790929fc37d94699de44559b3 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 31 Mar 2024 17:03:58 +0100 Subject: [PATCH 30/38] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/lib.ml | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 7ae024beed5..b4992d6d1fc 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1196,23 +1196,16 @@ end = struct List.fold_left libs ~init:Status.Not_found ~f:(fun acc status -> match acc, status with | Status.Found a, Status.Found b -> - let lib_id_a = Lib_info.lib_id a.info - and lib_id_b = Lib_info.lib_id b.info in - (match Lib_id.equal lib_id_a lib_id_b with + 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 info_a = info a in let name = - if Lib_name.equal a.name b.name - then a.name - else ( - let lib_id = Lib_info.lib_id info_a in - Lib_id.name lib_id) - in - Status.Invalid - (let loc_a = Lib_info.loc info_a - and loc_b = Lib_info.loc (info b) in - Error.duplicated ~loc_a ~loc_b ~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)) | Invalid _, _ -> acc | (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _) | (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib From cf7bbc8371b7ab8619a2d8ae5f4c8b39b6b22ac7 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 31 Mar 2024 14:40:27 -0700 Subject: [PATCH 31/38] fix: pattern matching in lib.ml Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/lib.ml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index b4992d6d1fc..09ea2d02024 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1206,11 +1206,8 @@ end = struct 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)) - | Invalid _, _ -> acc - | (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _) - | (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib - | (Hidden _ | Ignore | Not_found), (Hidden _ | Ignore | Not_found | Invalid _) - -> acc)) + | (Found _ as lib), _ | _, (Found _ as lib) -> lib + | _, _ -> acc)) ;; let find_internal db (name : Lib_name.t) = From 265ca4e6f722bfed7a0e8841bfbb7c898d5f3ec2 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 31 Mar 2024 14:48:17 -0700 Subject: [PATCH 32/38] fix: bring back conflict map for redirects Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/scope.ml | 51 +++++++++++++++++-- .../deprecated-library-name/features.t | 4 ++ 2 files changed, 51 insertions(+), 4 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 77a0d6fbc50..d277e21b2f2 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -100,11 +100,11 @@ module DB = struct let not_found = With_multiple_results.resolve_result Resolve_result.not_found let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = - let by_name, by_id = + 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) -> + ~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 @@ -135,6 +135,49 @@ module DB = struct and lib_id = Library.to_lib_id ~src_dir conf in Some lib_id, Library.best_name conf, Found_or_redirect.found info in + 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 by_name = Lib_name.Map.update by_name name ~f:(function | None -> Some [ r2 ] @@ -145,7 +188,7 @@ module DB = struct | None -> by_id | Some lib_id -> Lib_id.Map.add_exn by_id (Local lib_id) r2 in - by_name, by_id) + by_name, by_id, libname_conflict_map) in let resolve name = match Lib_name.Map.find by_name name with 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 91114c6fc6f..5ce45c8c044 100644 --- a/test/blackbox-tests/test-cases/deprecated-library-name/features.t +++ b/test/blackbox-tests/test-cases/deprecated-library-name/features.t @@ -247,6 +247,10 @@ We check that there is an error when there is an actual ambiguity: > EOF $ (cd d && dune build --root . @all) + Error: Library top2 is defined twice: + - dune:5 + - dune:13 + [1] Another case of ambiguity: From dbba9291265f04eead042bd1ef96ade151de3794 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 31 Mar 2024 15:07:28 -0700 Subject: [PATCH 33/38] refactor: remove Nonempty_list.t from resolve results Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/lib.ml | 10 ++++------ src/dune_rules/lib.mli | 4 ++-- src/dune_rules/scope.ml | 10 +++------- 3 files changed, 9 insertions(+), 15 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 09ea2d02024..c287f7509f6 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -428,7 +428,7 @@ and resolve_result = and resolve_result_with_multiple_results = | Resolve_result of resolve_result - | Multiple_results of resolve_result Nonempty_list.t + | Multiple_results of resolve_result list let lib_config (t : lib) = t.lib_config let name t = t.name @@ -1173,8 +1173,7 @@ end = struct | Resolve_result r -> handle_resolve_result ~super db r | Multiple_results candidates -> let open Memo.O in - Nonempty_list.to_list candidates - |> Memo.List.filter_map ~f:(function + Memo.List.filter_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 @@ -1892,7 +1891,7 @@ module DB = struct module With_multiple_results = struct type t = resolve_result_with_multiple_results = | Resolve_result of resolve_result - | Multiple_results of resolve_result Nonempty_list.t + | Multiple_results of resolve_result list let resolve_result r = Resolve_result r let multiple_results libs : t = Multiple_results libs @@ -1901,8 +1900,7 @@ module DB = struct let open Dyn in match t with | Resolve_result r -> variant "Resolve_result" [ to_dyn r ] - | Multiple_results xs -> - variant "Multiple_results" [ Dyn.list to_dyn (Nonempty_list.to_list xs) ] + | Multiple_results xs -> variant "Multiple_results" [ Dyn.list to_dyn xs ] ;; end end diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index ba16042d57e..379969892e6 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -108,11 +108,11 @@ module DB : sig type t = private | Resolve_result of resolve_result - | Multiple_results of resolve_result Nonempty_list.t + | Multiple_results of resolve_result list val to_dyn : t Dyn.builder val resolve_result : resolve_result -> t - val multiple_results : resolve_result Nonempty_list.t -> t + val multiple_results : resolve_result list -> t end end diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index d277e21b2f2..98f50caede0 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -181,8 +181,7 @@ module DB = struct let by_name = Lib_name.Map.update by_name name ~f:(function | None -> Some [ r2 ] - | Some (r1 :: rest : Found_or_redirect.t Nonempty_list.t) -> - Some (r2 :: r1 :: rest)) + | Some rest -> Some (r2 :: rest)) and by_id = match lib_id with | None -> by_id @@ -192,14 +191,11 @@ module DB = struct in let resolve name = match Lib_name.Map.find by_name name with - | None -> Memo.return not_found + | None | Some [] -> Memo.return not_found | Some [ fr ] -> resolve_found_or_redirect fr >>| With_multiple_results.resolve_result | Some frs -> - Nonempty_list.to_list frs - |> Memo.parallel_map ~f:resolve_found_or_redirect - >>| Nonempty_list.of_list - >>| Option.value_exn + Memo.parallel_map frs ~f:resolve_found_or_redirect >>| With_multiple_results.multiple_results and resolve_lib_id = resolve_lib_id by_id in Lib.DB.create From 3f3c50cc63d710de5902b8210dc02057d631534a Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 1 Apr 2024 14:18:08 -0700 Subject: [PATCH 34/38] refactor: remove `With_multiple_results` module Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/lib.ml | 43 +++++++++-------------------------------- src/dune_rules/lib.mli | 14 +------------- src/dune_rules/scope.ml | 36 ++++++++++++++-------------------- 3 files changed, 25 insertions(+), 68 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index c287f7509f6..1c75f152487 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -408,7 +408,7 @@ end type db = { parent : db option - ; resolve : Lib_name.t -> resolve_result_with_multiple_results 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 @@ -426,10 +426,6 @@ and resolve_result = | Redirect_in_the_same_db of (Loc.t * Lib_name.t) | Redirect of db * Lib_id.t -and resolve_result_with_multiple_results = - | Resolve_result of resolve_result - | Multiple_results of resolve_result list - let lib_config (t : lib) = t.lib_config let name t = t.name let info t = t.info @@ -1170,8 +1166,8 @@ end = struct ;; let handle_resolve_result_with_multiple_results db ~super = function - | Resolve_result r -> handle_resolve_result ~super db r - | Multiple_results candidates -> + | [ r ] -> handle_resolve_result ~super db r + | candidates -> let open Memo.O in Memo.List.filter_map candidates ~f:(function | Ignore -> Memo.return (Some Status.Ignore) @@ -1887,22 +1883,6 @@ module DB = struct | Redirect_in_the_same_db (_, name) -> variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ] ;; - - module With_multiple_results = struct - type t = resolve_result_with_multiple_results = - | Resolve_result of resolve_result - | Multiple_results of resolve_result list - - let resolve_result r = Resolve_result r - let multiple_results libs : t = Multiple_results libs - - let to_dyn t = - let open Dyn in - match t with - | Resolve_result r -> variant "Resolve_result" [ to_dyn r ] - | Multiple_results xs -> variant "Multiple_results" [ Dyn.list to_dyn xs ] - ;; - end end type t = db @@ -1929,14 +1909,12 @@ module DB = struct let open Memo.O in Findlib.find findlib name >>| function - | Ok (Library pkg) -> Resolve_result (Found (Dune_package.Lib.info pkg)) + | Ok (Library pkg) -> [ Found (Dune_package.Lib.info pkg) ] | Ok (Deprecated_library_name d) -> - Resolve_result (Redirect_in_the_same_db (d.loc, d.new_public_name)) - | Ok (Hidden_library pkg) -> - Resolve_result (Hidden (Hidden.unsatisfied_exist_if pkg)) + [ Redirect_in_the_same_db (d.loc, d.new_public_name) ] + | Ok (Hidden_library pkg) -> [ Hidden (Hidden.unsatisfied_exist_if pkg) ] | Error e -> - Resolve_result - (match e with + [ (match e with | Invalid_dune_package why -> Invalid why | Not_found when (not has_bigarray_library) && Lib_name.equal name bigarray -> @@ -1946,6 +1924,7 @@ module DB = struct but the stdlib isn't first class. *) Ignore | Not_found -> Not_found) + ] in create () @@ -1954,11 +1933,7 @@ module DB = struct ~resolve ~resolve_lib_id:(fun lib_id -> let open Memo.O in - let name = Lib_id.name lib_id in - resolve name - >>| function - | Multiple_results _ -> assert false - | Resolve_result r -> r) + 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) diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 379969892e6..e312daf4fc5 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -102,18 +102,6 @@ module DB : sig val to_dyn : t Dyn.builder val redirect : db -> Lib_id.t -> t val redirect_in_the_same_db : Loc.t * Lib_name.t -> t - - module With_multiple_results : sig - type resolve_result := t - - type t = private - | Resolve_result of resolve_result - | Multiple_results of resolve_result list - - val to_dyn : t Dyn.builder - val resolve_result : resolve_result -> t - val multiple_results : resolve_result list -> t - end end (** Create a new library database. [resolve] is used to resolve library names @@ -125,7 +113,7 @@ 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.With_multiple_results.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 diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 98f50caede0..e12788513a6 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -14,9 +14,6 @@ let libs t = t.db let coq_libs t = t.coq_db module DB = struct - module Resolve_result = Lib.DB.Resolve_result - module With_multiple_results = Resolve_result.With_multiple_results - type scope = t type t = { by_dir : scope Path.Source.Map.t } @@ -84,20 +81,20 @@ module DB = struct Toggle.enabled toggle in if enabled - then Resolve_result.redirect_in_the_same_db (loc, to_) - else Resolve_result.not_found - | Found lib -> Memo.return (Resolve_result.found lib) + 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 (Resolve_result.redirect_in_the_same_db 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 Resolve_result.not_found + | None -> Memo.return Lib.DB.Resolve_result.not_found | Some found_or_redirect -> resolve_found_or_redirect found_or_redirect ;; - let not_found = With_multiple_results.resolve_result Resolve_result.not_found + let not_found = [ Lib.DB.Resolve_result.not_found ] let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = let by_name, by_id, _ = @@ -192,11 +189,8 @@ module DB = struct let resolve name = match Lib_name.Map.find by_name name with | None | Some [] -> Memo.return not_found - | Some [ fr ] -> - resolve_found_or_redirect fr >>| With_multiple_results.resolve_result - | Some frs -> - Memo.parallel_map frs ~f:resolve_found_or_redirect - >>| With_multiple_results.multiple_results + | 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 () @@ -224,17 +218,17 @@ module DB = struct match rt with | Project { project; lib_id } -> let scope = find_by_project (Fdecl.get t) project in - Resolve_result.redirect scope.db (Local lib_id) - | Name name -> Resolve_result.redirect_in_the_same_db name + 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 : Resolve_result.t = + 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 -> Resolve_result.not_found + | None -> Lib.DB.Resolve_result.not_found | Some (Project { project; lib_id }) -> let scope = find_by_project (Fdecl.get t) project in - Resolve_result.redirect scope.db (Local lib_id) - | Some (Name name) -> Resolve_result.redirect_in_the_same_db 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 *) @@ -302,7 +296,7 @@ module DB = struct Memo.return (match Lib_name.Map.find by_name name with | None -> not_found - | Some rt -> resolve_redirect_to t rt |> With_multiple_results.resolve_result) + | Some rt -> [ resolve_redirect_to t rt ]) in Lib.DB.create ~parent:(Some installed_libs) From 318ebb89cbe2bf3db15b35b0636a7c517e23cd49 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 1 Apr 2024 14:28:13 -0700 Subject: [PATCH 35/38] refactor: use the empty list Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/scope.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index e12788513a6..d488f37b7c6 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -94,8 +94,6 @@ module DB = struct | Some found_or_redirect -> resolve_found_or_redirect found_or_redirect ;; - let not_found = [ Lib.DB.Resolve_result.not_found ] - let create_db_from_stanzas ~instrument_with ~parent ~lib_config stanzas = let by_name, by_id, _ = List.fold_left @@ -188,7 +186,7 @@ module DB = struct in let resolve name = match Lib_name.Map.find by_name name with - | None | Some [] -> Memo.return not_found + | 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 @@ -295,7 +293,7 @@ module DB = struct let resolve name = Memo.return (match Lib_name.Map.find by_name name with - | None -> not_found + | None -> [] | Some rt -> [ resolve_redirect_to t rt ]) in Lib.DB.create From d305b101dd2dd7c17d21271e14333fb98d1bbd75 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 1 Apr 2024 14:39:20 -0700 Subject: [PATCH 36/38] fix: Not_found case, recurse on the empty list Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/lib.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 1c75f152487..899817a732c 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1166,10 +1166,11 @@ end = struct ;; 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.List.filter_map candidates ~f:(function + 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 @@ -1181,9 +1182,10 @@ end = struct 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 -> Memo.return None + | 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_map ~f:Fun.id >>| (function | [] -> Status.Not_found | [ status ] -> status From bdfe63881f9e66d29c6a74aa887fd34066445021 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 1 Apr 2024 15:11:41 -0700 Subject: [PATCH 37/38] List.filter_opt Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/lib.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 899817a732c..df5d011ca25 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1185,7 +1185,7 @@ end = struct | 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_map ~f:Fun.id + >>| List.filter_opt >>| (function | [] -> Status.Not_found | [ status ] -> status From 7e992fcdceb8be9c833bbd96bdd28fb7a896c10c Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 1 Apr 2024 15:54:26 -0700 Subject: [PATCH 38/38] chore: add changelog entry Signed-off-by: Antonio Nuno Monteiro --- doc/changes/10307.md | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 doc/changes/10307.md 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) +