refactor: use the proposed implementation for redirects

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

src/dune_rules/gen_rules.ml

@@ -111,14 +111,20 @@ end = struct
       let+ () = Toplevel.Stanza.setup ~sctx ~dir ~toplevel in
       empty_none
     | Library.T lib ->
-      let db = Scope.libs scope in
       (* This check surfaces conflicts between private names of public libraries,
          without it the user might get duplicated rules errors for cmxs
          when the libraries are defined in the same folder and have the same private name *)
-      let* res = Lib.DB.find_invalid db (Library.private_name lib) in
-      (match res with
-       | Some err -> User_error.raise [ User_message.pp err ]
-       | None ->
+      let* resolve_result =
+        let db = Scope.libs scope in
+        let loc, name =
+          let ((loc, _) as name) = lib.name in
+          loc, Lib_name.of_local name
+        in
+        Lib.DB.resolve db (loc, name)
+      in
+      (match Resolve.to_result resolve_result with
+       | Error err -> Resolve.raise_error_with_stack_trace err
+       | Ok _ ->
          let* lib_info =
            let* ocaml =
              let ctx = Super_context.context sctx in

src/dune_rules/lib.ml

@@ -1934,14 +1934,6 @@ module DB = struct
     | Ignore | Not_found | Invalid _ | Hidden _ -> None
   ;;
 
-  let find_invalid t name =
-    let open Memo.O in
-    Resolve_names.find_internal t name
-    >>| function
-    | Invalid err -> Some err
-    | Found _ | Ignore | Not_found | Hidden _ -> None
-  ;;
-
   let find_even_when_hidden t name =
     let open Memo.O in
     Resolve_names.find_internal t name

src/dune_rules/lib.mli

@@ -123,7 +123,6 @@ module DB : sig
     -> t
 
   val find : t -> Lib_name.t -> lib option Memo.t
-  val find_invalid : t -> Lib_name.t -> User_message.t 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
 

src/dune_rules/scope.ml

@@ -26,25 +26,30 @@ 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.t * Lib_name.t) * Toggle.t Memo.Lazy.t
       | Many of t list
       | 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 many : t list -> 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.t * Lib_name.t) * Toggle.t Memo.Lazy.t
       | Many of t list
       | Deprecated_library_name of (Loc.t * Lib_name.t)
 
-    let redirect from (loc, to_) =
+    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_)
+      else from, Redirect ((loc, to_), enabled)
     ;;
 
     let many x = Many x
@@ -61,17 +66,24 @@ module DB = struct
   module Library_related_stanza = struct
     type t =
       | Library of Path.Build.t * Library.t
-      | Library_redirect of Library_redirect.Local.t
+      | Library_redirect of Path.Build.t * 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 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
+        | 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
+          Found_or_redirect.redirect ~enabled 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.deprecated_library_name old_public_name s.new_public_name
@@ -90,8 +102,8 @@ module DB = struct
           | Redirect _, Redirect _ -> Ok (Found_or_redirect.many [ v1; v2 ])
           | Found info, Deprecated_library_name (loc, _)
           | Deprecated_library_name (loc, _), Found info -> Error (loc, Lib_info.loc info)
-          | Deprecated_library_name (loc2, lib2), Redirect (loc1, lib1)
-          | Redirect (loc1, lib1), Deprecated_library_name (loc2, lib2) ->
+          | Deprecated_library_name (loc2, lib2), Redirect ((loc1, lib1), _)
+          | Redirect ((loc1, lib1), _), Deprecated_library_name (loc2, lib2) ->
             if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2)
           | Deprecated_library_name (loc1, lib1), Deprecated_library_name (loc2, lib2) ->
             if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2)
@@ -123,27 +135,38 @@ module DB = struct
       ()
       ~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
+        | None -> Memo.return Lib.DB.Resolve_result.not_found
+        | Some (Redirect (lib, 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 lib
+          else Lib.DB.Resolve_result.not_found
+        | Some (Found lib) -> Memo.return (Lib.DB.Resolve_result.found lib)
         | Some (Many libs) ->
-          let results =
-            List.map
+          let+ results =
+            Memo.List.filter_map
               ~f:(function
-                | Found_or_redirect.Redirect lib ->
-                  Lib.DB.Resolve_result.redirect_in_the_same_db lib
-                | Found lib -> Lib.DB.Resolve_result.found lib
+                | Found_or_redirect.Redirect (lib, enabled) ->
+                  let+ enabled =
+                    let+ toggle = Memo.Lazy.force enabled in
+                    Toggle.enabled toggle
+                  in
+                  if enabled
+                  then Some (Lib.DB.Resolve_result.redirect_in_the_same_db lib)
+                  else None
+                | Found lib -> Memo.return (Some (Lib.DB.Resolve_result.found lib))
                 | Deprecated_library_name lib ->
-                  Lib.DB.Resolve_result.deprecated_library_name lib
+                  Memo.return (Some (Lib.DB.Resolve_result.deprecated_library_name lib))
                 | Many _ -> assert false)
               libs
           in
           Lib.DB.Resolve_result.multiple_results results
         | Some (Deprecated_library_name lib) ->
-          Lib.DB.Resolve_result.deprecated_library_name lib)
+          Memo.return (Lib.DB.Resolve_result.deprecated_library_name lib))
       ~all:(fun () -> Memo.return @@ Lib_name.Map.keys map)
       ~lib_config
       ~instrument_with
@@ -269,7 +292,7 @@ module DB = struct
         let project =
           match stanza with
           | Library (_, lib) -> lib.project
-          | Library_redirect x -> x.project
+          | Library_redirect (_, x) -> x.project
           | Deprecated_library_name x -> x.project
         in
         Dune_project.root project, stanza)
@@ -355,7 +378,9 @@ module DB = struct
             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
+          | 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

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 =

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
 

test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t

@@ -15,12 +15,12 @@ the same folder.
 Without any consumers of the libraries
 
   $ dune build
-  Error:
   File "dune", line 1, characters 0-21:
+  1 | (library
+  2 |  (name foo))
   Error: A library with name "foo" is defined in two folders: _build/default
   and _build/default. Either change one of the names, or enable them
   conditionally using the 'enabled_if' field.
-
   [1]
 
 With some consumer of the library
@@ -40,12 +40,12 @@ With some consumer of the library
   > EOF
 
   $ dune build
-  Error:
   File "dune", line 1, characters 0-21:
+  1 | (library
+  2 |  (name foo))
   Error: A library with name "foo" is defined in two folders: _build/default
   and _build/default. Either change one of the names, or enable them
   conditionally using the 'enabled_if' field.
-
   File "dune", line 3, characters 0-21:
   3 | (library
   4 |  (name foo))

test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t

@@ -20,13 +20,12 @@ different folders.
 Without any consumers of the libraries
 
   $ dune build
-  Error:
   File "b/dune", line 1, characters 0-21:
+  1 | (library
+  2 |  (name foo))
   Error: A 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.
-
-  -> required by alias default
   [1]
 
 With some consumer of the library
@@ -42,13 +41,6 @@ With some consumer of the library
   > EOF
 
   $ dune build
-  Error:
-  File "b/dune", line 1, characters 0-21:
-  Error: A 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.
-
-  -> required by alias default
   File "b/dune", line 1, characters 0-21:
   1 | (library
   2 |  (name foo))

test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t

@@ -19,12 +19,13 @@ the same folder.
 Without any consumers of the libraries
 
   $ dune build
-  Error:
   File "dune", line 1, characters 0-44:
+  1 | (library
+  2 |  (name foo)
+  3 |  (public_name bar.foo))
   Error: A library with name "foo" is defined in two folders: _build/default
   and _build/default. Either change one of the names, or enable them
   conditionally using the 'enabled_if' field.
-
   [1]
 
 With some consumer
@@ -46,12 +47,6 @@ With some consumer
   > EOF
 
   $ dune build
-  Error:
-  File "dune", line 1, characters 0-44:
-  Error: A library with name "foo" is defined in two folders: _build/default
-  and _build/default. Either change one of the names, or enable them
-  conditionally using the 'enabled_if' field.
-
   File "dune", line 1, characters 0-0:
   Error: Module "Main" is used in several stanzas:
   - dune:1
@@ -61,4 +56,11 @@ With some consumer
   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 1, characters 0-44:
+  1 | (library
+  2 |  (name foo)
+  3 |  (public_name bar.foo))
+  Error: A library with name "foo" is defined in two folders: _build/default
+  and _build/default. Either change one of the names, or enable them
+  conditionally using the 'enabled_if' field.
   [1]

test/blackbox-tests/test-cases/lib-collision/lib-collision-public.t

@@ -24,16 +24,13 @@ different folders.
 Without any consumers of the libraries
 
   $ dune build
-  Error:
   File "b/dune", line 1, characters 0-44:
+  1 | (library
+  2 |  (name foo)
+  3 |  (public_name baz.foo))
   Error: A 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.
-
-  -> required by _build/install/default/lib/bar/foo/foo.a
-  -> required by _build/default/bar.install
-  -> required by alias all
-  -> required by alias default
   [1]
 
 With some consumer
@@ -49,16 +46,6 @@ With some consumer
   > EOF
 
   $ dune build
-  Error:
-  File "b/dune", line 1, characters 0-44:
-  Error: A 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.
-
-  -> required by _build/install/default/lib/bar/foo/foo.a
-  -> required by _build/default/bar.install
-  -> required by alias all
-  -> required by alias default
   File "b/dune", line 1, characters 0-44:
   1 | (library
   2 |  (name foo)