Merge pull request #5337 from rjbou/filter-dependencies

Move dependencies computation from `opam-solver` to `opam-state`

master_changes.md

@@ -108,6 +108,7 @@ users)
   * Improve performance of some opam list combination (e.g. --available --installable) [#4999 @kit-ty-kate]
   * Improve performance of opam list --conflicts-with when combined with other filters [#4999 @kit-ty-kate]
   * Fix coinstallability filter corner case [#5024 @AltGr]
+  * Improve performance for recursive `--required-by` and `depends-on` [#5337 @rjbou]
 
 ## Show
   * Add `depexts` to default printer [#4898 @rjbou]
@@ -511,8 +512,9 @@ users)
 ` [#5268 @kit-ty-kate]
   * `OpamUpdate`: change `repository` output to update function option, to not write cache and new repo config if nothing changed in `repositories` [#5146 @rjbou]
   * Add `OpamPinned.version_opt` [#5325 @kit-ty-kate]
-
   * Add optional argument `?env:(variable_contents option Lazy.t * string) OpamVariable.Map.t` to `OpamSysPoll` and `OpamSysInteract` functions. It is used to get syspolling variables from the environment first. [#4892 @rjbou]
+  * `OpamSwitchState`: move and reimplement `opam-solver` `dependencies` and `reverse_dependencies` [#5337 @rjbou]
+
 ## opam-solver
   * `OpamCudf`: Change type of `conflict_case.Conflict_cycle` (`string list list` to `Cudf.package action list list`) and `cycle_conflict`, `string_of_explanations`, `conflict_explanations_raw` types accordingly [#4039 @gasche]
   * `OpamCudf`: add `conflict_cycles` [#4039 @gasche]
@@ -528,6 +530,7 @@ users)
   * `OpamCudf`: add `trim_universe`, `opam_deprequest_package_name`, and `opam_deprequest_package` [#4975 @AltGr]
   * `OpamCudf.print_solution`: add optional `skip`, to avoid filtering solution beforehand [#4975 @AltGr]
   * `OpamCudf.filter_solution`: can do not remove recursively actions with optional `~recursive:true` [#4975 @AltGr]
+  * `OpamSolver`, `OpamCudf`: remove `dependencies` and `reverse_dependencies` [#5337 @rjbou]
 
 ## opam-format
   * Exposed `with_*` functions in `OpamFile.Dot_install` [#5169 @panglesd]
@@ -571,3 +574,4 @@ users)
   * `OpamStd.List`: add `find_map_opt` (for ocaml < 4.10) and `fold_left_map` (for ocaml < 4.11) [#5171 @cannorin]
   * `OpamCompat`: add `Int.equal` (for ocaml < 4.12)
   * `OpamFilename.clean_dir`: as the directory is recreated after removal, checks that the directory exists beforhand. It avoid creating a new empty directory uselessly [#4967 @rjbou]
+  * `OpamStd.Map`: add `filter_map` [#5337 @rjbou]

src/client/opamClient.ml

@@ -909,9 +909,9 @@ let assume_built_restrictions ?available_packages t atoms =
       t.pinned
   in
   let installed_dependencies =
-    OpamSolver.dependencies ~build:false ~post:false
+    OpamSwitchState.dependencies ~build:false ~post:false
       ~depopts:false ~installed:true ~unavailable:false
-      (OpamSwitchState.universe t
+      t (OpamSwitchState.universe t
          ~requested:pinned Query)
       pinned
   in
@@ -1253,7 +1253,7 @@ let remove_t ?ask ~autoremove ~force ?(formula=OpamFormula.Empty) atoms t =
           universe.u_base ++ t.installed_roots %% t.installed -- packages
         in
         let keep_cone =
-          keep |> OpamSolver.dependencies universe
+          keep |> OpamSwitchState.dependencies t universe
             ~build:true ~post:true ~depopts:true ~installed:true
         in
         let autoremove =
@@ -1262,11 +1262,11 @@ let remove_t ?ask ~autoremove ~force ?(formula=OpamFormula.Empty) atoms t =
         if atoms = [] then autoremove else
         (* restrict to the dependency cone of removed pkgs *)
         let remove_cone =
-          packages |> OpamSolver.reverse_dependencies universe
+          packages |> OpamSwitchState.reverse_dependencies t universe
             ~build:true ~post:true ~depopts:false ~installed:true
         in
         autoremove %%
-        (remove_cone |> OpamSolver.dependencies universe
+        (remove_cone |> OpamSwitchState.dependencies t universe
            ~build:true ~post:true ~depopts:false ~installed:true)
       else
         packages

src/client/opamCommands.ml

@@ -1474,8 +1474,8 @@ let config cli =
                 match OpamSwitchState.opam_opt state p with
                 | Some o -> OpamFile.OPAM.has_flag Pkgflag_Compiler o
                 | None -> false)
-            |> OpamSolver.dependencies ~depopts:true ~post:true ~build:true
-              ~installed:true
+            |> OpamSwitchState.dependencies ~depopts:true ~post:true ~build:true
+              ~installed:true state
               (OpamSwitchState.universe ~test:true ~doc:true ~dev_setup:true
                  ~requested:OpamPackage.Set.empty state Query)
             |> OpamPackage.Set.iter process;

src/client/opamListCommand.ml

@@ -225,12 +225,13 @@ let apply_selector ~base st = function
   | (Required_by ({recursive=true; _} as tog, atoms)
     | Depends_on ({recursive=true; _} as tog, atoms)) as direction ->
     let deps_fun = match direction with
-      | Required_by _ -> OpamSolver.dependencies
-      | Depends_on _ -> OpamSolver.reverse_dependencies
+      | Required_by _ -> OpamSwitchState.dependencies
+      | Depends_on _ -> OpamSwitchState.reverse_dependencies
       | _ -> assert false
     in
     deps_fun ~depopts:tog.depopts ~build:tog.build ~post:tog.post
       ~installed:false ~unavailable:true
+      st
       (get_universe st tog)
       (packages_of_atoms st atoms)
   | Required_by (tog, atoms) ->

src/client/opamLockCommand.ml

@@ -137,9 +137,9 @@ let lock_opam ?(only_direct=false) st opam =
   in
   (* Depends *)
   let all_depends =
-    OpamSolver.dependencies
+    OpamSwitchState.dependencies
       ~depopts:true ~build:true ~post:true ~installed:true
-      univ (OpamPackage.Set.singleton nv) |>
+      st univ (OpamPackage.Set.singleton nv) |>
     OpamPackage.Set.remove nv
   in
   let depends =
@@ -180,9 +180,9 @@ let lock_opam ?(only_direct=false) st opam =
       let depends_map = map_of_set `other installed in
       if only_direct then depends_map
       else
-        (OpamSolver.dependencies
+        (OpamSwitchState.dependencies
            ~depopts:false ~build:true ~post:true ~installed:true
-           univ installed
+           st univ installed
          -- all_depends)
         |> map_of_set (`other_dep typ)
         |> OpamPackage.Map.union (fun _v _o -> `other_dep typ) depends_map

src/core/opamStd.ml

@@ -47,6 +47,7 @@ module type MAP = sig
   val update: key -> ('a -> 'a) -> 'a -> 'a t -> 'a t
   val map_reduce:
     ?default:'b -> (key -> 'a -> 'b) -> ('b -> 'b -> 'b) -> 'a t -> 'b
+  val filter_map: (key -> 'a -> 'b option) -> 'a t -> 'b t
 end
 module type ABSTRACT = sig
   type t
@@ -318,6 +319,13 @@ module Map = struct
           add key (f key value) map
         ) map empty
 
+    let filter_map f map =
+      fold (fun key value map ->
+          match f key value with
+          | Some value -> add key value map
+          | None -> map
+        ) map empty
+
     let values map =
       List.rev (M.fold (fun _ v acc -> v :: acc) map [])
 

src/core/opamStd.mli

@@ -93,6 +93,7 @@ module type MAP = sig
   val map_reduce:
     ?default:'b -> (key -> 'a -> 'b) -> ('b -> 'b -> 'b) -> 'a t -> 'b
 
+  val filter_map: (key -> 'a -> 'b option) -> 'a t -> 'b t
 end
 
 (** A signature for handling abstract keys and collections thereof *)

src/solver/opamCudf.ml

@@ -598,29 +598,6 @@ let is_artefact cpkg =
   is_opam_deprequest cpkg ||
   cpkg.Cudf.package = dose_dummy_request
 
-let dependencies universe packages =
-  Set.fixpoint (fun p -> dependency_set universe p.Cudf.depends) packages
-(* similar to Dose_algo.Depsolver.dependency_closure but with finer results on
-   version sets *)
-
-let reverse_dependencies universe =
-  let tbl = Array.make (Cudf.universe_size universe) [] in
-  Cudf.iteri_packages (fun uid p ->
-      Set.iter
-        (fun q ->
-           let i = Cudf.uid_by_package universe q in
-           tbl.(i) <- uid :: tbl.(i))
-        (dependency_set universe p.Cudf.depends))
-    universe;
-  Set.fixpoint
-    (fun p ->
-       List.fold_left
-         (fun acc uid -> Set.add (Cudf.package_by_uid universe uid) acc)
-         Set.empty
-         tbl.(Cudf.uid_by_package universe p))
-(* similar to Dose_algo.Depsolver.reverse_dependency_closure but more reliable
-   and faster *)
-
 let dependency_sort universe packages =
   let graph = Graph.of_universe universe in
   Graph.linearize graph packages |> List.rev

src/solver/opamCudf.mli

@@ -58,12 +58,6 @@ module ActionGraph: OpamActionGraph.SIG with type package = Package.t
 (** Abstract type that may be returned in case of conflicts *)
 type conflict
 
-(** Return the transitive closure of dependencies of [set] *)
-val dependencies: Cudf.universe -> Set.t -> Set.t
-
-(** Return the transitive closure of reverse dependencies of [set] *)
-val reverse_dependencies: Cudf.universe -> Set.t -> Set.t
-
 (** Sorts the given packages topolgically (be careful if there are cycles, e.g.
    if the universe was loaded with [post] dependencies enabled) *)
 val dependency_sort: Cudf.universe -> Set.t -> Cudf.package list

src/solver/opamSolver.ml

@@ -585,35 +585,6 @@ let dependency_graph
     cudf_graph;
   g
 
-let filter_dependencies
-    f_direction ~depopts ~build ~post ~installed
-    ?(unavailable=false) universe packages =
-  if OpamPackage.Set.is_empty packages then OpamPackage.Set.empty else
-  let u_packages =
-    packages ++
-    if installed then universe.u_installed else
-    if unavailable then universe.u_packages else
-      universe.u_available in
-  log ~level:3 "filter_dependencies packages=%a"
-    (slog OpamPackage.Set.to_string) packages;
-  let cudf_universe, cudf_packages =
-    load_cudf_universe_with_packages
-      ~depopts ~build ~post universe u_packages packages
-  in
-  log ~level:3 "filter_dependencies: dependency";
-  let clos_packages = f_direction cudf_universe cudf_packages in
-  let result =
-    OpamCudf.Set.fold (fun cp -> OpamPackage.Set.add (OpamCudf.cudf2opam cp))
-      clos_packages OpamPackage.Set.empty
-  in
-  log "filter_dependencies result=%a"
-    (slog OpamPackage.Set.to_string) result;
-  result
-
-let dependencies = filter_dependencies OpamCudf.dependencies
-
-let reverse_dependencies = filter_dependencies OpamCudf.reverse_dependencies
-
 let dependency_sort ~depopts ~build ~post universe packages =
   let cudf_universe, cudf_packages =
     load_cudf_universe_with_packages

src/solver/opamSolver.mli

@@ -98,32 +98,6 @@ val installable: universe -> package_set
 (** Like [installable], but within a subset and potentially much faster *)
 val installable_subset: universe -> package_set -> package_set
 
-(** Return the transitive dependency closures
-    of a collection of packages.
-
-    [depopts]: include optional dependencies (depopts: foo)
-    [build]: include build dependencies (depends: foo {build})
-    [post]: include post dependencies (depends: foo {post})
-    [installed]: only consider already-installed packages
-    [unavaiable]: also consider unavailable packages
-*)
-val dependencies :
-  depopts:bool -> build:bool -> post:bool ->
-  installed:bool ->
-  ?unavailable:bool ->
-  universe ->
-  package_set ->
-  package_set
-
-(** Same as [dependencies] but for reverse dependencies. *)
-val reverse_dependencies :
-  depopts:bool -> build:bool -> post:bool ->
-  installed:bool ->
-  ?unavailable:bool ->
-  universe ->
-  package_set ->
-  package_set
-
 (** Sorts the given package set in topological order (as much as possible,
     beware of cycles in particular if [post] is [true]) *)
 val dependency_sort :

src/state/opamSwitchState.ml

@@ -1305,3 +1305,136 @@ let update_repositories gt update_fun switch =
   OpamFile.Switch_config.write
     (OpamPath.Switch.switch_config gt.root switch)
     conf
+
+
+(* dependencies computation *)
+
+let dependencies_filter_to_formula_t ~build ~post st nv =
+  let env v =
+    if List.mem v OpamPackageVar.predefined_depends_variables then
+      match OpamVariable.Full.to_string v with
+      | "build" -> Some (B build)
+      | "post" -> Some (B post)
+      | _ -> None
+    else
+      OpamPackageVar.resolve_switch ~package:nv st v
+  in
+  OpamFilter.filter_formula ~default:true env
+
+let dependencies_t base_deps_compute deps_compute
+    ~depopts ~installed ?(unavailable=false) universe packages =
+  if OpamPackage.Set.is_empty packages then OpamPackage.Set.empty else
+  let base =
+    packages ++
+    if installed then  universe.u_installed
+    else if unavailable then universe.u_packages
+    else universe.u_available
+  in
+  log ~level:3 "dependencies packages=%a"
+    (slog OpamPackage.Set.to_string) packages;
+  let timer = OpamConsole.timer () in
+  let base_depends =
+    let filter = base_deps_compute base in
+    let depends =
+      OpamPackage.Map.filter_map filter universe.u_depends
+    in
+    if depopts then
+      let depopts =
+        OpamPackage.Map.filter_map filter universe.u_depopts
+      in
+      OpamPackage.Map.union (fun d d' -> OpamFormula.And (d, d'))
+        depopts depends
+    else
+      depends
+  in
+  let result = deps_compute base base_depends packages in
+  log "dependencies (%.3f) result=%a" (timer ())
+    (slog OpamPackage.Set.to_string) result;
+  result
+
+let dependencies st ~build ~post =
+  dependencies_t
+    (fun base nv ff ->
+       if OpamPackage.Set.mem nv base then Some ff else None)
+    (fun base base_depends packages ->
+       let open OpamPackage.Set.Op in
+       let get_deps nvs =
+         OpamPackage.Set.fold (fun nv set ->
+             let depends_formula =
+               dependencies_filter_to_formula_t ~build ~post st nv
+                 (OpamPackage.Map.find nv base_depends)
+             in
+             if depends_formula = Empty then set else
+             let deps = OpamFormula.packages base depends_formula in
+             if OpamPackage.Set.is_empty deps then set else
+               deps ++ set)
+           nvs OpamPackage.Set.empty
+       in
+       let rec aux all deps =
+         let new_deps = get_deps deps in
+         if OpamPackage.Set.is_empty new_deps then all
+         else aux (all ++ new_deps) (new_deps -- all)
+       in
+       aux packages packages)
+
+let reverse_dependencies st ~build ~post =
+  dependencies_t
+    (fun base nv ff ->
+       if OpamPackage.Set.mem nv base then
+         Some (dependencies_filter_to_formula_t ~build ~post st nv ff)
+       else None)
+    (fun base base_depends packages ->
+       let base_int_pkg =
+         OpamPackage.Set.fold (fun nv map ->
+             OpamStd.IntMap.add (Hashtbl.hash nv) nv map)
+           base OpamStd.IntMap.empty
+       in
+       let rev_deps =
+         OpamPackage.Map.fold (fun nv depends_formula rev_deps ->
+             let depends =
+               OpamPackage.Set.fold (fun nv deps ->
+                   Hashtbl.hash nv :: deps)
+                 (OpamFormula.packages base depends_formula) []
+             in
+             List.fold_left (fun rev_deps rev_nv ->
+                 OpamStd.IntMap.update rev_nv
+                   (fun l -> Hashtbl.hash nv :: l)
+                   [] rev_deps)
+               rev_deps depends)
+           base_depends OpamStd.IntMap.empty
+       in
+       let open OpamStd.IntSet.Op in
+       let get_revdeps all done_ packages =
+         OpamStd.IntSet.fold (fun nv (all, done_, remaining) ->
+             if OpamStd.IntSet.mem nv done_ then
+               all, done_, remaining
+             else
+             match OpamStd.IntMap.find_opt nv rev_deps with
+             | Some deps ->
+               let deps = (OpamStd.IntSet.of_list deps) in
+               deps ++ all,
+               OpamStd.IntSet.add nv done_,
+               deps ++ remaining
+             | None -> all, done_, remaining)
+           packages (all, done_, OpamStd.IntSet.empty)
+       in
+       let rec aux all done_ remaining =
+         let all, done_, remaining =
+           get_revdeps all done_ remaining
+         in
+         if OpamStd.IntSet.is_empty remaining then all else
+           aux all done_ remaining
+       in
+       let int_revdeps =
+         let packages =
+           OpamPackage.Set.fold (fun nv set ->
+               OpamStd.IntSet.add (Hashtbl.hash nv) set)
+             packages OpamStd.IntSet.empty
+         in
+         aux OpamStd.IntSet.empty OpamStd.IntSet.empty packages
+       in
+       OpamStd.IntSet.fold (fun hash result ->
+           match OpamStd.IntMap.find_opt hash base_int_pkg with
+           | Some nv -> OpamPackage.Set.add nv result
+           | None -> OpamStd.Sys.exit_because `Internal_error)
+         int_revdeps packages)