library id draft

bin/describe/describe_external_lib_deps.ml

@@ -68,13 +68,17 @@ type dep =
 
 let is_external db name =
   let open Memo.O in
-  let+ lib = Dune_rules.Lib.DB.find_even_when_hidden db name in
-  match lib with
-  | None -> true
-  | Some t ->
-    (match Dune_rules.Lib_info.status (Dune_rules.Lib.info t) with
-     | Installed_private | Public _ | Private _ -> false
-     | Installed -> true)
+  Dune_rules.Lib.DB.find_stanza_id db name
+  >>= function
+  | None -> Memo.return true
+  | Some library_id ->
+    let+ lib = Dune_rules.Lib.DB.find_even_when_hidden db library_id in
+    (match lib with
+     | None -> true
+     | Some t ->
+       (match Dune_rules.Lib_info.status (Dune_rules.Lib.info t) with
+        | Installed_private | Public _ | Private _ -> false
+        | Installed -> true))
 ;;
 
 let resolve_lib db name kind =

bin/describe/describe_workspace.ml

@@ -447,9 +447,10 @@ 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
             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 library_id)
           in
           let* pp_map =
             let+ version =

src/dune_rules/dir_contents.ml

@@ -259,9 +259,9 @@ end = struct
           in
           let stanzas = Dune_file.stanzas d in
           let project = Dune_file.project d in
+          let src_dir = Dune_file.dir d in
           let+ files, rules =
             Rules.collect (fun () ->
-              let src_dir = Dune_file.dir d in
               stanzas >>= load_text_files sctx st_dir ~src_dir ~dir)
           in
           let dirs = [ { Source_file_dir.dir; path_to_root = []; files } ] in
@@ -292,7 +292,7 @@ end = struct
               ; foreign_sources =
                   Memo.lazy_ (fun () ->
                     let dune_version = Dune_project.dune_version project in
-                    stanzas >>| Foreign_sources.make ~dune_version ~dirs)
+                    stanzas >>| Foreign_sources.make ~src_dir ~dune_version ~dirs)
               ; coq =
                   Memo.lazy_ (fun () ->
                     stanzas >>| Coq_sources.of_dir ~dir ~include_subdirs ~dirs)
@@ -321,16 +321,11 @@ end = struct
           let ctx = Super_context.context sctx in
           let stanzas = Dune_file.stanzas dune_file in
           let project = Dune_file.project dune_file in
+          let src_dir = Dune_file.dir dune_file in
           let+ (files, subdirs), rules =
             Rules.collect (fun () ->
               Memo.fork_and_join
-                (fun () ->
-                  stanzas
-                  >>= load_text_files
-                        sctx
-                        source_dir
-                        ~src_dir:(Dune_file.dir dune_file)
-                        ~dir)
+                (fun () -> stanzas >>= load_text_files sctx source_dir ~src_dir ~dir)
                 (fun () ->
                   Memo.parallel_map
                     components
@@ -370,7 +365,7 @@ end = struct
           let foreign_sources =
             Memo.lazy_ (fun () ->
               let dune_version = Dune_project.dune_version project in
-              stanzas >>| Foreign_sources.make ~dune_version ~dirs)
+              stanzas >>| Foreign_sources.make ~src_dir ~dune_version ~dirs)
           in
           let coq =
             Memo.lazy_ (fun () ->
@@ -456,8 +451,11 @@ let modules_of_local_lib sctx lib =
     let dir = Lib_info.src_dir info in
     get sctx ~dir
   in
-  let name = Lib_info.name info in
-  ocaml t >>| Ml_sources.modules ~for_:(Library name)
+  let library_id =
+    let lib = Lib.Local.to_lib lib in
+    Lib.library_id lib
+  in
+  ocaml t >>| Ml_sources.modules ~for_:(Library library_id)
 ;;
 
 let modules_of_lib sctx lib =

src/dune_rules/dune_package.ml

@@ -311,6 +311,14 @@ module Lib = struct
   let info dp = dp.info
   let external_location dp = dp.external_location
 
+  let library_id dp =
+    let info = info dp in
+    let loc = Lib_info.loc info
+    and name = Lib_info.name info
+    and src_dir = Lib_info.src_dir info in
+    Library.Id.external_ ~loc ~src_dir ~enabled_if:Blang.true_ name
+  ;;
+
   let to_dyn { info; main_module_name; external_location } =
     let open Dyn in
     record
@@ -358,12 +366,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
@@ -373,7 +381,17 @@ 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 library_id = function
+    | Library lib | Hidden_library lib ->
+      let info = Lib.info lib in
+      let loc = Lib_info.loc info
+      and name = Lib_info.name info
+      and src_dir = Lib_info.src_dir info in
+      Library.Id.external_ ~loc ~src_dir ~enabled_if:Blang.true_ name
+    | Deprecated_library_name _ -> assert false
   ;;
 
   let cstrs ~lang ~dir =
@@ -383,15 +401,15 @@ module Entry = struct
         Library lib )
     ; ( "deprecated_library_name"
       , let+ x = Deprecated_library_name.decode in
-        Deprecated_library_name x )
+        Deprecated_library_name (dir, x) )
     ]
   ;;
 
   let to_dyn x =
     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 ]
   ;;
@@ -516,7 +534,7 @@ let encode ~dune_version { entries; name; version; dir; sections; sites; files }
       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

src/dune_rules/dune_package.mli

@@ -23,6 +23,7 @@ module Lib : sig
   val dir_of_name : Lib_name.t -> Path.Local.t
   val wrapped : t -> Wrapped.t option
   val info : t -> Path.t Lib_info.t
+  val library_id : t -> Library.Id.t
   val external_location : t -> External_location.t option
   val of_findlib : Path.t Lib_info.t -> External_location.t -> t
   val of_dune_lib : info:Path.t Lib_info.t -> main_module_name:Module_name.t option -> t
@@ -42,7 +43,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:
 
@@ -55,6 +56,7 @@ module Entry : sig
   val name : t -> Lib_name.t
   val version : t -> Package_version.t option
   val loc : t -> Loc.t
+  val library_id : t -> Library.Id.t
   val to_dyn : t Dyn.builder
 end
 

src/dune_rules/expander.ml

@@ -157,16 +157,29 @@ let expand_version { scope; _ } ~(source : Dune_lang.Template.Pform.t) s =
              allowed"
         ];
     let open Memo.O in
-    Lib.DB.find (Scope.libs scope) libname
-    >>| (function
-     | Some lib -> value_from_version (Lib_info.version (Lib.info lib))
+    (* TODO(anmonteiro): check *)
+    let db = Scope.libs scope in
+    Lib.DB.find_stanza_id db libname
+    >>= (function
      | None ->
        User_error.raise
          ~loc:source.loc
          [ Pp.textf
              "Package %S doesn't exist in the current project and isn't installed either."
              s
-         ])
+         ]
+     | Some library_id ->
+       Lib.DB.find db library_id
+       >>| (function
+        | Some lib -> value_from_version (Lib_info.version (Lib.info lib))
+        | None ->
+          User_error.raise
+            ~loc:source.loc
+            [ Pp.textf
+                "Package %S doesn't exist in the current project and isn't installed \
+                 either."
+                s
+            ]))
 ;;
 
 let expand_artifact ~source t artifact arg =
@@ -402,7 +415,9 @@ 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
+        let db = Scope.libs scope in
+        let* library_id = Resolve.Memo.lift_memo (Lib.DB.find_stanza_id db lib) in
+        Lib.DB.available db (Option.value_exn library_id)
         |> Resolve.Memo.lift_memo
         >>= function
         | false ->
@@ -653,7 +668,11 @@ 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 db = Scope.libs scope in
+           let+ available =
+             let* library_id = Lib.DB.find_stanza_id db lib in
+             Lib.DB.available db (Option.value_exn library_id)
+           in
            available |> string_of_bool |> string))
   | Bin_available ->
     Need_full_expander

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

src/dune_rules/foreign_sources.ml

@@ -9,12 +9,12 @@ open Import
    Furthermore, this module is also responsible for details such as handling file
    extensions and validating filenames. *)
 type t =
-  { libraries : Foreign.Sources.t Lib_name.Map.t
+  { libraries : Foreign.Sources.t Library.Id.Map.t
   ; archives : Foreign.Sources.t Foreign.Archive.Name.Map.t
   ; executables : Foreign.Sources.t String.Map.t
   }
 
-let for_lib t ~name = Lib_name.Map.find_exn t.libraries name
+let for_lib t ~library_id = Library.Id.Map.find_exn t.libraries library_id
 
 let for_archive t ~archive_name =
   Foreign.Archive.Name.Map.find_exn t.archives archive_name
@@ -23,7 +23,7 @@ let for_archive t ~archive_name =
 let for_exes t ~first_exe = String.Map.find_exn t.executables first_exe
 
 let empty =
-  { libraries = Lib_name.Map.empty
+  { libraries = Library.Id.Map.empty
   ; archives = Foreign.Archive.Name.Map.empty
   ; executables = String.Map.empty
   }
@@ -165,7 +165,7 @@ let eval_foreign_stubs
         ~paths:Foreign.Source.[ path src1; path src2 ]))
 ;;
 
-let make stanzas ~(sources : Foreign.Sources.Unresolved.t) ~dune_version =
+let make stanzas ~src_dir ~(sources : Foreign.Sources.Unresolved.t) ~dune_version =
   let libs, foreign_libs, exes =
     let libs, foreign_libs, exes =
       List.fold_left
@@ -245,14 +245,17 @@ let make stanzas ~(sources : Foreign.Sources.Unresolved.t) ~dune_version =
     String.Map.of_list_map_exn exes ~f:(fun (exes, m) -> snd (List.hd exes.names), m)
   in
   let libraries =
-    match Lib_name.Map.of_list_map libs ~f:(fun (lib, m) -> Library.best_name lib, m) with
+    match
+      Library.Id.Map.of_list_map libs ~f:(fun (lib, m) ->
+        Library.Id.of_stanza ~src_dir lib, m)
+    with
     | Ok x -> x
-    | Error (name, _, (lib2, _)) ->
+    | Error (library_id, _, (lib2, _)) ->
       User_error.raise
         ~loc:lib2.buildable.loc
         [ Pp.textf
             "Library %S appears for the second time in this directory"
-            (Lib_name.to_string name)
+            (Lib_name.to_string (Library.Id.name library_id))
         ]
   in
   let archives =
@@ -286,7 +289,7 @@ let make stanzas ~(sources : Foreign.Sources.Unresolved.t) ~dune_version =
   { libraries; archives; executables }
 ;;
 
-let make stanzas ~dune_version ~dirs =
+let make stanzas ~src_dir ~dune_version ~dirs =
   let init = String.Map.empty in
   let sources =
     List.fold_left
@@ -296,5 +299,5 @@ let make stanzas ~dune_version ~dirs =
         let sources = Foreign.Sources.Unresolved.load ~dir ~dune_version ~files in
         String.Map.Multi.rev_union sources acc)
   in
-  make stanzas ~dune_version ~sources
+  make ~src_dir stanzas ~dune_version ~sources
 ;;

src/dune_rules/foreign_sources.mli

@@ -5,12 +5,13 @@ open Import
 type t
 
 val empty : t
-val for_lib : t -> name:Lib_name.t -> Foreign.Sources.t
+val for_lib : t -> library_id:Library.Id.t -> Foreign.Sources.t
 val for_archive : t -> archive_name:Foreign.Archive.Name.t -> Foreign.Sources.t
 val for_exes : t -> first_exe:string -> Foreign.Sources.t
 
 val make
   :  Stanza.t list
+  -> src_dir:Path.Source.t
   -> dune_version:Syntax.Version.t
   -> dirs:Source_file_dir.t list
   -> t

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