let init_solver_cache ?(buffer=false) pool =
let pool = strip_solver_pool pool in
let num_conflicts = ref 0 in
let num_disjunctions = ref 0 in
let num_dependencies = ref 0 in
let size = Array.length pool in
let add_depend constraints vpkgs pkg_id l =
let lit = S.lit_of_var pkg_id false in
if (List.length l) = 0 then
S.add_rule constraints [|lit|] [Diagnostic_int.Missing(pkg_id,vpkgs)]
else begin
let lits = List.map (fun id -> S.lit_of_var id true) l in
num_disjunctions := !num_disjunctions + (List.length lits);
S.add_rule constraints (Array.of_list (lit :: lits))
[Diagnostic_int.Dependency (pkg_id, vpkgs, l)];
if (List.length lits) > 1 then
S.associate_vars constraints (S.lit_of_var pkg_id true) l;
end
in
let conflicts = Hashtbl.create (size / 10) in
let add_conflict constraints vpkg (i,j) =
if i <> j then begin
let pair = (min i j,max i j) in
if not(Hashtbl.mem conflicts pair) then begin
incr num_conflicts;
Hashtbl.add conflicts pair ();
let p = S.lit_of_var i false in
let q = S.lit_of_var j false in
S.add_rule constraints [|p;q|] [Diagnostic_int.Conflict(i,j,vpkg)];
end
end
in
let exec_depends constraints pkg_id dll =
List.iter (fun (vpkgs,dl) ->
incr num_dependencies;
add_depend constraints vpkgs pkg_id dl
) dll
in
let exec_conflicts constraints pkg_id cl =
List.iter (fun (vpkg,l) ->
List.iter (fun id ->
add_conflict constraints vpkg (pkg_id, id)
) l
) cl
in
Util.Progress.set_total progressbar_init size ;
let constraints = S.initialize_problem ~buffer size in
Array.iteri (fun id (dll,cl) ->
Util.Progress.progress progressbar_init;
exec_depends constraints id dll;
exec_conflicts constraints id cl
) pool;
Hashtbl.clear conflicts;
debug "n. disjunctions %d" !num_disjunctions;
debug "n. dependencies %d" !num_dependencies;
debug "n. conflicts %d" !num_conflicts;
S.propagate constraints ;
constraints