refactor: use a variant for Lib_id to distinguish Local / External

Signed-off-by: Antonio Nuno Monteiro <[email protected]>

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 =

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 =

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

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

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

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

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
@@ -661,7 +667,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 =

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
+;;

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

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* () =

src/dune_rules/ml_sources.ml

@@ -25,15 +25,15 @@ 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 *)
       rev_map : Origin.t Module_name.Path.Map.t
     }
 
   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
@@ -59,7 +59,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 =
@@ -68,7 +68,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 ->
@@ -86,7 +86,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
@@ -238,30 +238,31 @@ 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 ] ]
 ;;
 
 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
   | Some s -> s
   | 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
@@ -281,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_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 =
@@ -332,7 +333,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

src/dune_rules/ml_sources.mli

@@ -20,7 +20,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 *)
       }

src/dune_rules/odoc.ml

@@ -953,7 +953,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