Skip to content

Commit

Permalink
Add pre-processing to coinstallability checks
Browse files Browse the repository at this point in the history
Addresses some remaining costly cases in ocaml#4311

The patch includes a small reorganisation of `OpamSolver`, but the general idea
is to fix the performance regression compared to 2.0:

- with the introduction of solver invariants, the pre-processing that trimmed
  packages conflicting with the base in `OpamState` was removed
- it was replaced by something much more general (and reliable) at the
  `OpamCudf` level
- but only for calls to the external solver, until now

NOTE: this enforces the invariant even for `opam install --coinstallable-with`,
which is consistent with 2.0 but had changed in 2.1. Without it we can't really
expect reasonable performance in general anyway.
  • Loading branch information
AltGr committed Jan 25, 2022
1 parent 9e28777 commit 01d23da
Show file tree
Hide file tree
Showing 6 changed files with 251 additions and 180 deletions.
1 change: 1 addition & 0 deletions master_changes.md
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,7 @@ users)
* Orphan packages are now handled at the solver level instead of a pre-processing phase, better ensuring consistency [#4969 @altgr]
* Make the 0install solver non-optional [#4909 @kit-ty-kate]
* Optimised reverse dependencies calculation [#5005 @AltGr]
* Enable cudf preprocessing for (co)insallability calculation, resulting in a x20 speedup [@AltGr]

## Client
* Check whether the repository might need updating more often [#4935 @kit-ty-kate]
Expand Down
153 changes: 88 additions & 65 deletions src/solver/opamCudf.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1194,6 +1194,73 @@ let dump_cudf_error ~version_map univ req =
| Some f -> f
| None -> assert false

let vpkg2set univ vp =
Set.of_list (Dose_common.CudfAdd.resolve_deps univ vp)

let compute_conflicts univ packages =
let open Set.Op in
let to_map set =
Set.fold (fun p ->
OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty)
set OpamStd.String.Map.empty
in
let direct_conflicts p =
let base_conflicts =
Set.filter (fun q -> q.Cudf.package <> p.Cudf.package)
(vpkg2set univ p.Cudf.conflicts)
in
(* Dependencies not matching constraints are also conflicts *)
List.fold_left (fun acc -> function
| (n, c) :: disj when List.for_all (fun (m, _) -> m = n) disj ->
let coset = function
| Some (op, v) ->
let filter = Some (OpamFormula.neg_relop op, v) in
Set.of_list (Cudf.lookup_packages ~filter univ n)
| None -> Set.empty
in
acc ++
List.fold_left (fun acc (_, c) -> acc %% coset c) (coset c) disj
| _ -> acc)
base_conflicts p.Cudf.depends
in
let cache = Hashtbl.create 513 in
let cache_direct = Hashtbl.create 513 in
(* Don't explore deeper than that for transitive conflicts *)
let max_dig_depth = OpamSolverConfig.(!r.dig_depth) in
let rec transitive_conflicts seen p =
try Hashtbl.find cache p with Not_found ->
let direct =
try Hashtbl.find cache_direct p with Not_found ->
let conflicts = direct_conflicts p in
Hashtbl.add cache_direct p conflicts;
conflicts
in
if Set.mem p seen || Set.cardinal seen >= max_dig_depth - 1 then direct
else
let seen = Set.add p seen in
let conflicts =
direct ++
List.fold_left (fun acc disj ->
acc ++
Set.map_reduce ~default:Set.empty
(transitive_conflicts seen)
Set.inter
(vpkg2set univ disj))
Set.empty
p.Cudf.depends
in
Hashtbl.add cache p conflicts;
conflicts
in
OpamStd.String.Map.fold (fun _ ps acc ->
acc ++
Set.map_reduce ~default:Set.empty
(transitive_conflicts Set.empty)
Set.inter
ps)
(to_map packages)
Set.empty

let preprocess_cudf_request (props, univ, creq) criteria =
let chrono = OpamConsole.timer () in
let univ0 = univ in
Expand All @@ -1220,21 +1287,15 @@ let preprocess_cudf_request (props, univ, creq) criteria =
in
let univ =
let open Set.Op in
let vpkg2set vp = Set.of_list (Dose_common.CudfAdd.resolve_deps univ vp) in
let to_install =
vpkg2set creq.Cudf.install
vpkg2set univ creq.Cudf.install
++ Set.of_list (Cudf.lookup_packages univ opam_invariant_package_name)
in
let to_install_formula =
List.map (fun x -> [x]) @@
(opam_invariant_package_name, None) ::
creq.Cudf.install @ creq.Cudf.upgrade
in
let to_map set =
Set.fold (fun p ->
OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty)
set OpamStd.String.Map.empty
in
let packages =
match do_trimming with
| None ->
Expand Down Expand Up @@ -1276,64 +1337,7 @@ let preprocess_cudf_request (props, univ, creq) criteria =
(dependency_set univ p.Cudf.depends))
interesting_set
in
let direct_conflicts p =
let base_conflicts =
Set.filter (fun q -> q.Cudf.package <> p.Cudf.package)
(vpkg2set p.Cudf.conflicts)
in
(* Dependencies not matching constraints are also conflicts *)
List.fold_left (fun acc -> function
| (n, c) :: disj when List.for_all (fun (m, _) -> m = n) disj ->
let coset = function
| Some (op, v) ->
let filter = Some (OpamFormula.neg_relop op, v) in
Set.of_list (Cudf.lookup_packages ~filter univ n)
| None -> Set.empty
in
acc ++
List.fold_left (fun acc (_, c) -> acc %% coset c) (coset c) disj
| _ -> acc)
base_conflicts p.Cudf.depends
in
let cache = Hashtbl.create 513 in
let cache_direct = Hashtbl.create 513 in
(* Don't explore deeper than that for transitive conflicts *)
let max_dig_depth = OpamSolverConfig.(!r.dig_depth) in
let rec transitive_conflicts seen p =
try Hashtbl.find cache p with Not_found ->
let direct =
try Hashtbl.find cache_direct p with Not_found ->
let conflicts = direct_conflicts p in
Hashtbl.add cache_direct p conflicts;
conflicts
in
if Set.mem p seen || Set.cardinal seen >= max_dig_depth - 1 then direct
else
let seen = Set.add p seen in
let conflicts =
direct ++
List.fold_left (fun acc disj ->
acc ++
Set.map_reduce ~default:Set.empty
(transitive_conflicts seen)
Set.inter
(vpkg2set disj))
Set.empty
p.Cudf.depends
in
Hashtbl.add cache p conflicts;
conflicts
in
let conflicts =
OpamStd.String.Map.fold (fun _ ps acc ->
acc ++
Set.map_reduce ~default:Set.empty
(transitive_conflicts Set.empty)
Set.inter
ps)
(to_map to_install)
Set.empty
in
let conflicts = compute_conflicts univ to_install in
log "Conflicts: %a (%a) pkgs to remove"
(slog OpamStd.Op.(string_of_int @* Set.cardinal)) conflicts
(slog OpamStd.Op.(string_of_int @* Set.cardinal)) (conflicts %% packages);
Expand All @@ -1347,6 +1351,25 @@ let preprocess_cudf_request (props, univ, creq) criteria =
(chrono ());
props, univ, creq

let trim_universe univ packages =
let chrono = OpamConsole.timer () in
let n = Cudf.universe_size univ in
let conflicts = compute_conflicts univ packages in
(* Set.iter (fun p -> Cudf.remove_package univ (p.Cudf.package, p.Cudf.version))
* conflicts; *)
let univ = Cudf.load_universe (Cudf.get_packages ~filter:(fun p -> not (Set.mem p conflicts)) univ) in
log "Pre-remove conflicts (%s): from %d - %d to %d packages in %.2fs"
(Set.to_string packages)
n (Set.cardinal conflicts) (Cudf.universe_size univ) (chrono ());
(* Dose_common.CudfAdd. (
* (\* let install =
* * List.map (fun p -> p.Cudf.package, Some (`Eq,p.Cudf.version)) packages
* * in *\)
* let _, univ, _ =
* preprocess_cudf_request ((), univ, Cudf.default_request (\* with install *\)) "-new"
* in *)
univ

exception Timeout of Dose_algo.Depsolver.solver_result option

let call_external_solver ~version_map univ req =
Expand Down
4 changes: 4 additions & 0 deletions src/solver/opamCudf.mli
Original file line number Diff line number Diff line change
Expand Up @@ -68,6 +68,10 @@ val reverse_dependencies: Cudf.universe -> Set.t -> Set.t
if the universe was loaded with [post] dependencies enabled) *)
val dependency_sort: Cudf.universe -> Set.t -> Cudf.package list

(** Pre-process a universe to remove incompatible/unneeded packages and ease the
task of the solvers *)
val trim_universe: Cudf.universe -> Set.t -> Cudf.universe

(** Check if a request is satisfiable and return the reasons why not unless
[explain] is set to [false] *)
val check_request:
Expand Down
Loading

0 comments on commit 01d23da

Please sign in to comment.