refactor: create own data structure for lib entries (ocaml#11072)

will be needed to delay loading of the entries themselves

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

src/dune_rules/install_rules.ml

@@ -626,23 +626,23 @@ end = struct
       Path.Build.append_local pkg_root subdir
     in
     let* entries =
-      lib_entries
-      >>= Memo.parallel_map ~f:(fun (stanza : Scope.DB.Lib_entry.t) ->
-        match stanza with
-        | Deprecated_library_name { old_name = _, Deprecated _; _ } -> Memo.return None
-        | Deprecated_library_name
-            { old_name = old_public_name, Not_deprecated
+      let* { Scope.DB.Lib_entry.Set.deprecated_library_names; libraries } = lib_entries in
+      let deprecated =
+        List.filter_map deprecated_library_names ~f:(function
+          | { old_name = _, Deprecated _; _ } -> None
+          | { old_name = old_public_name, Not_deprecated
             ; new_public_name = _, new_public_name
             ; loc
             ; project = _
             } ->
-          let old_public_name = Public_lib.name old_public_name in
-          Memo.return
-            (Some
-               ( old_public_name
-               , Dune_package.Entry.Deprecated_library_name
-                   { loc; old_public_name; new_public_name } ))
-        | Library lib ->
+            let old_public_name = Public_lib.name old_public_name in
+            Some
+              ( old_public_name
+              , Dune_package.Entry.Deprecated_library_name
+                  { loc; old_public_name; new_public_name } ))
+      in
+      let+ libraries =
+        Memo.parallel_map libraries ~f:(fun 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
@@ -692,13 +692,12 @@ end = struct
               ~public_headers
             >>= Resolve.read_memo
           in
-          Some (name, Dune_package.Entry.Library dune_lib))
-    in
-    let entries =
-      List.fold_left entries ~init:Lib_name.Map.empty ~f:(fun acc x ->
-        match x with
-        | None -> acc
-        | Some (name, x) -> Lib_name.Map.add_exn acc name x)
+          name, Dune_package.Entry.Library dune_lib)
+      in
+      List.rev_append libraries deprecated
+      |> List.sort ~compare:(fun (x, _) (y, _) -> Lib_name.compare x y)
+      |> List.fold_left ~init:Lib_name.Map.empty ~f:(fun acc (name, x) ->
+        Lib_name.Map.add_exn acc name x)
     in
     let+ files =
       let+ map = Stanzas_to_entries.stanzas_to_entries sctx in
@@ -746,13 +745,14 @@ end = struct
     let* () =
       let deprecated_dune_packages =
         Memo.lazy_ ~name:"deprecated dune packages" (fun () ->
-          lib_entries
-          >>| List.filter_map ~f:(function
-            | Scope.DB.Lib_entry.Deprecated_library_name
-                ({ old_name = old_public_name, Deprecated _; _ } as t) ->
-              Some (Lib_name.package_name (Public_lib.name old_public_name), t)
+          let+ { deprecated_library_names; _ } = lib_entries in
+          List.filter_map deprecated_library_names ~f:(function
+            | { Library_redirect.old_name =
+                  old_public_name, Deprecated_library_name.Old_name.Deprecated _
+              ; _
+              } as t -> Some (Lib_name.package_name (Public_lib.name old_public_name), t)
             | _ -> None)
-          >>| Package.Name.Map.of_list_multi)
+          |> Package.Name.Map.of_list_multi)
         |> Memo.Lazy.force
       in
       Package.deprecated_package_names pkg
@@ -815,7 +815,7 @@ end = struct
     let pkg_name = Package.name pkg in
     let* deprecated_packages, entries =
       Scope.DB.lib_entries_of_package ctx.name pkg_name
-      >>| List.partition_map ~f:(function
+      >>| Scope.DB.Lib_entry.Set.partition_map ~f:(function
         | Scope.DB.Lib_entry.Deprecated_library_name
             { old_name = public, Deprecated { deprecated_package }; _ } as entry ->
           (match Public_lib.sub_dir public with

src/dune_rules/odoc.ml

@@ -599,15 +599,14 @@ let setup_toplevel_index_rules sctx =
 ;;
 
 let libs_of_pkg ctx ~pkg =
-  let+ entries = Scope.DB.lib_entries_of_package ctx pkg in
+  let+ { Scope.DB.Lib_entry.Set.libraries; _ } =
+    Scope.DB.lib_entries_of_package ctx pkg
+  in
   (* Filter out all implementations of virtual libraries *)
-  List.filter_map entries ~f:(fun (entry : Scope.DB.Lib_entry.t) ->
-    match entry with
-    | Deprecated_library_name _ -> None
-    | Library lib ->
-      (match Lib.Local.to_lib lib |> Lib.info |> Lib_info.implements with
-       | None -> Some lib
-       | Some _ -> None))
+  List.filter_map libraries ~f:(fun lib ->
+    match Lib.Local.to_lib lib |> Lib.info |> Lib_info.implements with
+    | None -> Some lib
+    | Some _ -> None)
 ;;
 
 let entry_modules_by_lib sctx lib =

src/dune_rules/scope.ml

@@ -447,6 +447,54 @@ module DB = struct
       | Deprecated_library_name { old_name = old_public_name, _; _ } ->
         Public_lib.loc old_public_name
     ;;
+
+    module Set = struct
+      type t =
+        { libraries : Lib.Local.t list
+        ; deprecated_library_names : Deprecated_library_name.t list
+        }
+
+      let empty = { libraries = []; deprecated_library_names = [] }
+
+      let of_list =
+        let by_name x = Lib.Local.info x |> Lib_info.name in
+        fun xs ->
+          let libraries, deprecated_library_names =
+            List.partition_map xs ~f:(function
+              | Library l -> Left l
+              | Deprecated_library_name l -> Right l)
+          in
+          { libraries =
+              List.sort libraries ~compare:(fun x y ->
+                Lib_name.compare (by_name x) (by_name y))
+          ; deprecated_library_names =
+              List.sort
+                deprecated_library_names
+                ~compare:(fun { old_name = old_public_name, _; _ } y ->
+                  Lib_name.compare
+                    (Public_lib.name old_public_name)
+                    (Public_lib.name (fst y.old_name)))
+          }
+      ;;
+
+      let fold { libraries; deprecated_library_names } ~init ~f =
+        let init =
+          List.fold_left ~init libraries ~f:(fun acc lib -> f (Library lib) acc)
+        in
+        List.fold_left deprecated_library_names ~init ~f:(fun acc dep ->
+          f (Deprecated_library_name dep) acc)
+      ;;
+
+      let partition_map t ~f =
+        let l, r =
+          fold t ~init:([], []) ~f:(fun x (l, r) ->
+            match f x with
+            | Left x -> x :: l, r
+            | Right x -> l, x :: r)
+        in
+        List.(rev l, rev r)
+      ;;
+    end
   end
 
   let lib_entries_of_package =
@@ -489,11 +537,7 @@ module DB = struct
             Memo.return ((name, Lib_entry.Deprecated_library_name d) :: acc)
           | _ -> Memo.return acc)
       in
-      Package.Name.Map.of_list_multi libs
-      |> Package.Name.Map.map
-           ~f:
-             (List.sort ~compare:(fun a b ->
-                Lib_name.compare (Lib_entry.name a) (Lib_entry.name b)))
+      Package.Name.Map.of_list_multi libs |> Package.Name.Map.map ~f:Lib_entry.Set.of_list
     in
     let per_context =
       Per_context.create_by_name ~name:"scope-db" (fun ctx ->
@@ -508,11 +552,11 @@ module DB = struct
     in
     fun (ctx : Context_name.t) pkg_name ->
       let+ map = per_context ctx in
-      match Package.Name.Map.Multi.find map pkg_name with
-      | ([] | [ _ ]) as xs -> xs
-      | libs ->
+      match Package.Name.Map.find map pkg_name with
+      | None -> Lib_entry.Set.empty
+      | Some libs ->
         let _by_name =
-          List.fold_left libs ~init:Lib_name.Map.empty ~f:(fun by_name entry2 ->
+          Lib_entry.Set.fold libs ~init:Lib_name.Map.empty ~f:(fun entry2 by_name ->
             let public_name = Lib_entry.name entry2 in
             Lib_name.Map.update by_name public_name ~f:(function
               | None -> Some entry2

src/dune_rules/scope.mli

@@ -24,8 +24,19 @@ module DB : sig
     type t =
       | Library of Lib.Local.t
       | Deprecated_library_name of Deprecated_library_name.t
+
+    module Set : sig
+      type entry := t
+
+      type t =
+        { libraries : Lib.Local.t list
+        ; deprecated_library_names : Deprecated_library_name.t list
+        }
+
+      val partition_map : t -> f:(entry -> ('a, 'b) Either.t) -> 'a list * 'b list
+    end
   end
 
-  val lib_entries_of_package : Context_name.t -> Package.Name.t -> Lib_entry.t list Memo.t
+  val lib_entries_of_package : Context_name.t -> Package.Name.t -> Lib_entry.Set.t Memo.t
   val with_all : Context.t -> f:((Dune_project.t -> t) -> 'a) -> 'a Memo.t
 end