Permalink
Browse files

Various improvement to the heuristic.

The current strategy (which seems to work fine) is:

1/ call the solver once to get a rought approximation of the final universe

2/ build a new universe where we:
   - install all the packages appearing in 1/; and
   - remove all the version below the one appearing in 1/

3/ use user-defined constraints to trim the universe (eg. for 'opam install core.109.15' we remove from the universe all the other versions of core)

4/ remove from 4/ all the versions of packages which are not a dependency appearing in the request (eg. it will remove every version of 'bin_prot' <> '109.15.00')

5/ brute-force explore the remaining universe to find a consistent state

This should fix #565 and #555
  • Loading branch information...
1 parent 8b09603 commit aba4647bbafded02a7ad8520834c564f637ed59a @samoht committed Mar 28, 2013
Showing with 322 additions and 235 deletions.
  1. +36 −11 src/solver/opamCudf.ml
  2. +16 −3 src/solver/opamCudf.mli
  3. +234 −221 src/solver/opamHeuristic.ml
  4. +36 −0 src/solver/opamHeuristic.mli
@@ -77,9 +77,10 @@ module Graph = struct
Algo.Defaultgraphs.PackageGraph.DotPrinter.output_graph fd g;
close_out fd
- (* Return the transitive closure of [pkgs] in [g], sorted in topological order *)
- let closure g pkgs =
- let g = PO.O.add_transitive_closure g in
+ let transitive_closure g =
+ PO.O.add_transitive_closure g
+
+ let close_and_linearize g pkgs =
let _, l =
Topo.fold
(fun pkg (closure, topo) ->
@@ -100,7 +101,7 @@ end
let filter_dependencies f_direction universe packages =
let graph = f_direction (Graph.of_universe universe) in
let packages = Set.of_list packages in
- Graph.closure graph packages
+ Graph.close_and_linearize graph packages
let dependencies = filter_dependencies (fun x -> x)
@@ -112,12 +113,15 @@ let string_of_atom (p, c) =
| Some (r,v) -> Printf.sprintf " (%s %d)" (OpamFormula.string_of_relop r) v in
Printf.sprintf "%s%s" p (const c)
+let string_of_vpkgs constr =
+ let constr = List.sort (fun (a,_) (b,_) -> String.compare a b) constr in
+ OpamFormula.string_of_conjunction string_of_atom constr
+
let string_of_request r =
- let to_string = OpamFormula.string_of_conjunction string_of_atom in
Printf.sprintf "install:%s remove:%s upgrade:%s"
- (to_string r.wish_install)
- (to_string r.wish_remove)
- (to_string r.wish_upgrade)
+ (string_of_vpkgs r.wish_install)
+ (string_of_vpkgs r.wish_remove)
+ (string_of_vpkgs r.wish_upgrade)
let string_of_universe u =
string_of_packages (List.sort compare (Cudf.get_packages u))
@@ -298,11 +302,32 @@ let default_preamble =
] in
Common.CudfAdd.add_properties Cudf.default_preamble l
-let uninstall name universe =
+let uninstall universe name =
let packages = Cudf.get_packages universe in
let packages = List.filter (fun p -> p.Cudf.package <> name) packages in
Cudf.load_universe packages
+let install universe package =
+ let versions = Cudf.lookup_packages universe package.Cudf.package in
+ let versions = List.map (fun p ->
+ if p.Cudf.version = package.Cudf.version then
+ { p with Cudf.installed = true }
+ else
+ { p with Cudf.installed = false }
+ ) versions in
+ let packages =
+ let filter p = p.Cudf.package <> package.Cudf.package in
+ Cudf.get_packages ~filter universe in
+ Cudf.load_universe (versions @ packages)
+
+let remove_all_uninstalled_versions_but name constr universe =
+ let filter p =
+ p.Cudf.installed
+ || p.Cudf.package <> name
+ || Cudf.version_matches p.Cudf.version constr in
+ let packages = Cudf.get_packages ~filter universe in
+ Cudf.load_universe packages
+
let to_cudf univ req = (
default_preamble,
univ,
@@ -332,7 +357,7 @@ let call_external_solver ~explain univ req =
let get_final_universe univ req =
let open Algo.Depsolver in
match call_external_solver ~explain:true univ req with
- | Sat (_,u) -> Success (uninstall "dose-dummy-request" u)
+ | Sat (_,u) -> Success (uninstall u "dose-dummy-request")
| Error str -> OpamGlobals.error_and_exit "solver error: %s" str
| Unsat r ->
let open Algo.Diagnostic in
@@ -462,7 +487,7 @@ let solution_of_actions ~simple_universe ~complete_universe root_actions =
some of its optional dependencies disapear, however we must
recompile it (see below). *)
let graph = create_graph (fun p -> Set.mem p remove_roots) simple_universe in
- let to_remove = List.rev (Graph.closure graph remove_roots) in
+ let to_remove = List.rev (Graph.close_and_linearize graph remove_roots) in
let root_causes =
let graph = Graph.PO.O.add_transitive_closure graph in
let cause pkg =
@@ -31,9 +31,12 @@ module Graph: sig
(** Build a graph from a CUDF universe *)
val of_universe: Cudf.universe -> t
+ (** Return the transitive closure of [g] *)
+ val transitive_closure: t -> t
+
(** Return the transitive closure of dependencies of [set],
- sorted in topological order *)
- val closure: t -> Set.t -> Cudf.package list
+ sorted in topological order. *)
+ val close_and_linearize: t -> Set.t -> Cudf.package list
end
(** Difference between universes *)
@@ -96,7 +99,14 @@ val resolve:
(Cudf.package action list, Algo.Diagnostic.reason list) result
(** Remove a package from an universe *)
-val uninstall: string -> Cudf.universe -> Cudf.universe
+val uninstall: Cudf.universe -> Cudf_types.pkgname -> Cudf.universe
+
+(** Install a package in the universe. Keep the invariant than only
+ one version of a package can be installed. *)
+val install: Cudf.universe -> Cudf.package -> Cudf.universe
+
+(** Remove all the versions of a given package, but the one given as argument. *)
+val remove_all_uninstalled_versions_but: string -> Cudf_types.constr -> Cudf.universe -> Cudf.universe
(** The "reinstall" string *)
val s_reinstall: string
@@ -106,6 +116,9 @@ val s_installed_root: string
(** {2 Pretty-printing} *)
+(** Convert a package constraint to something readable. *)
+val string_of_vpkgs: Cudf_types.vpkg list -> string
+
(** Convert a reason to something readable by the user *)
val string_of_reason: (Cudf.package -> package) -> Algo.Diagnostic.reason -> string option
Oops, something went wrong. Retry.

0 comments on commit aba4647

Please sign in to comment.