Refactor duplicate library checking code

Signed-off-by: Nicolás Ojeda Bär <n.oje.bar@gmail.com>

src/dune/dune_file.ml

@@ -2212,7 +2212,7 @@ module Deprecated_library_name = struct
     { loc : Loc.t
     ; project : Dune_project.t
     ; old_public_name : bool * Public_lib.t
-    ; new_public_name : Lib_name.t
+    ; new_public_name : Loc.t * Lib_name.t
     }
 
   let decode =
@@ -2222,7 +2222,9 @@ module Deprecated_library_name = struct
        and+ old_public_name =
          field "old_public_name"
            (Public_lib.decode ~allow_deprecated_names:() ())
-       and+ new_public_name = field "new_public_name" Lib_name.decode in
+       and+ new_public_name =
+         field "new_public_name" (located Lib_name.decode)
+       in
        let old_public_name =
          let is_toplevel =
            not

src/dune/dune_file.mli

@@ -478,7 +478,7 @@ module Deprecated_library_name : sig
     { loc : Loc.t
     ; project : Dune_project.t
     ; old_public_name : bool * Public_lib.t
-    ; new_public_name : Lib_name.t
+    ; new_public_name : Loc.t * Lib_name.t
     }
 end
 

src/dune/gen_meta.ml

@@ -156,7 +156,10 @@ let gen ~package ~version entries =
           let pub_name = Pub_name.parse name in
           (pub_name, gen_lib pub_name (Lib.Local.to_lib lib) ~version)
         | Deprecated_library_name
-            { old_public_name = _, old_public_name; new_public_name; _ } ->
+            { old_public_name = _, old_public_name
+            ; new_public_name = _, new_public_name
+            ; _
+            } ->
           ( Pub_name.parse (Dune_file.Public_lib.name old_public_name)
           , version @ [ requires (Lib_name.Set.singleton new_public_name) ] ))
   in

src/dune/install_rules.ml

@@ -301,7 +301,7 @@ let gen_dune_package sctx pkg =
           |> List.map ~f:(function
                | Super_context.Lib_entry.Deprecated_library_name
                    { old_public_name = _, old_public_name
-                   ; new_public_name
+                   ; new_public_name = _, new_public_name
                    ; loc
                    ; _
                    } ->

src/dune/lib.ml

@@ -332,7 +332,7 @@ and resolve_result =
   | Not_found
   | Found of Lib_info.external_
   | Hidden of Lib_info.external_ * string
-  | Redirect of db option * Lib_name.t
+  | Redirect of db option * (Loc.t * Lib_name.t)
 
 type lib = t
 
@@ -1088,7 +1088,7 @@ end = struct
 
   let resolve_name db name ~stack =
     match db.resolve name with
-    | Redirect (db', name') -> (
+    | Redirect (db', (_, name')) -> (
       let db' = Option.value db' ~default:db in
       match find_internal db' name' ~stack with
       | St_initializing _ as x -> x
@@ -1510,7 +1510,7 @@ module DB = struct
       | Not_found
       | Found of Lib_info.external_
       | Hidden of Lib_info.external_ * string
-      | Redirect of db option * Lib_name.t
+      | Redirect of db option * (Loc.t * Lib_name.t)
 
     let to_dyn x =
       let open Dyn.Encoder in
@@ -1519,7 +1519,7 @@ module DB = struct
       | Found lib -> constr "Found" [ Lib_info.to_dyn Path.to_dyn lib ]
       | Hidden (lib, s) ->
         constr "Hidden" [ Lib_info.to_dyn Path.to_dyn lib; string s ]
-      | Redirect (_, name) -> constr "Redirect" [ Lib_name.to_dyn name ]
+      | Redirect (_, (_, name)) -> constr "Redirect" [ Lib_name.to_dyn name ]
   end
 
   type t = db
@@ -1558,7 +1558,7 @@ module DB = struct
                 | Hidden _ ->
                   assert false
                 | Found x -> x
-                | Redirect (_, name') -> (
+                | Redirect (_, (_, name')) -> (
                   match Lib_name.Map.find libmap name' with
                   | Some (Found x) -> x
                   | _ -> assert false ))
@@ -1610,29 +1610,10 @@ module DB = struct
               (ev.variant, ev.implementation)
           | _ -> acc)
     in
-    let top_level_public_libs =
-      List.fold_left stanzas ~init:Lib_name.Map.empty ~f:(fun acc stanza ->
-          match (stanza : Library_related_stanza.t) with
-          | Library (_, { public = Some p; name; _ }) ->
-            let public_name = Dune_file.Public_lib.name p in
-            Lib_name.Map.Multi.cons acc public_name (Lib_name.of_local name)
-          | _ -> acc)
-    in
     let map =
       List.concat_map stanzas ~f:(fun stanza ->
           match (stanza : Library_related_stanza.t) with
           | External_variant _ -> []
-          | Deprecated_library_name
-              { old_public_name = true, { sub_dir = None; name = _, name; _ }
-              ; new_public_name
-              ; _
-              }
-            when match
-                   Lib_name.Map.find top_level_public_libs new_public_name
-                 with
-                 | Some [ name' ] -> Lib_name.equal name name'
-                 | _ -> false ->
-            []
           | Deprecated_library_name
               { old_public_name = _, old_public_name; new_public_name; _ } ->
             [ ( Dune_file.Public_lib.name old_public_name
@@ -1679,42 +1660,38 @@ module DB = struct
                 [ (name, Found info) ]
               else
                 [ (name, Found info)
-                ; (Lib_name.of_local conf.name, Redirect (None, name))
+                ; (Lib_name.of_local conf.name, Redirect (None, p.name))
                 ] ))
-      |> Lib_name.Map.of_list
-      |> function
-      | Ok x -> x
-      | Error (name, _, _) -> (
-        match
-          List.filter_map stanzas ~f:(function
-            | Library (_, conf) ->
-              if
-                Lib_name.equal name (Lib_name.of_local conf.name)
-                ||
-                match conf.public with
-                | None -> false
-                | Some p -> Lib_name.equal name (Dune_file.Public_lib.name p)
-              then
-                Some conf.buildable.loc
-              else
-                None
-            | Deprecated_library_name
-                { old_public_name = _, old_public_name; loc; _ } ->
-              Option.some_if
-                (Lib_name.equal name
-                   (Dune_file.Public_lib.name old_public_name))
-                loc
-            | External_variant _ -> None)
-        with
-        | []
-        | [ _ ] ->
-          assert false
-        | loc1 :: loc2 :: _ ->
-          User_error.raise
-            [ Pp.textf "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)
-            ] )
+      |> Lib_name.Map.of_list_reducei ~f:(fun name v1 v2 ->
+             let res =
+               match (v1, v2) with
+               | Found info1, Found info2 ->
+                 Error (Lib_info.loc info1, Lib_info.loc info2)
+               | Found info, Redirect (None, (loc, _))
+               | Redirect (None, (loc, _)), Found info ->
+                 Error (loc, Lib_info.loc info)
+               | Redirect (None, (loc1, lib1)), Redirect (None, (loc2, lib2))
+                 ->
+                 if Lib_name.equal lib1 lib2 then
+                   Ok v1
+                 else
+                   Error (loc1, loc2)
+               | _ ->
+                 Code_error.raise
+                   "create_from_stanzas produced unexpected result"
+                   [ ("v1", Resolve_result.to_dyn v1)
+                   ; ("v2", Resolve_result.to_dyn v2)
+                   ]
+             in
+             match res with
+             | Ok x -> x
+             | Error (loc1, loc2) ->
+               User_error.raise
+                 [ Pp.textf "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)
+                 ])
     in
     (* We need to check that [external_variant] stanzas are correct, i.e.
        contain valid [virtual_library] fields now since this is the last time
@@ -1731,7 +1708,8 @@ module DB = struct
       ~resolve:(fun name ->
         match Findlib.find findlib name with
         | Ok (Library pkg) -> Found (Dune_package.Lib.info pkg)
-        | Ok (Deprecated_library_name d) -> Redirect (None, d.new_public_name)
+        | Ok (Deprecated_library_name d) ->
+          Redirect (None, (Loc.none, d.new_public_name))
         | Error e -> (
           match e with
           | Not_found ->

src/dune/lib.mli

@@ -146,7 +146,7 @@ module DB : sig
       | Not_found
       | Found of Lib_info.external_
       | Hidden of Lib_info.external_ * string
-      | Redirect of t option * Lib_name.t
+      | Redirect of t option * (Loc.t * Lib_name.t)
 
     val to_dyn : t Dyn.Encoder.t
   end

src/dune/scope.ml

@@ -41,14 +41,14 @@ module DB = struct
 
   type redirect_to =
     | Project of Dune_project.t
-    | Name of Lib_name.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
     | None -> Not_found
     | Some (Project project) ->
       let scope = find_by_project (Fdecl.get t) project in
-      Redirect (Some scope.db, name)
+      Redirect (Some scope.db, (Loc.none, name))
     | Some (Name name) -> Redirect (None, name)
 
   let public_libs t ~stdlib_dir ~installed_libs stanzas =