simon/sidekick
1
0
Fork 0
mirror of https://github.com/c-cube/sidekick.git synced 2025-12-06 11:15:43 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding documentation comments in Internal

Browse source
This commit is contained in:
Guillaume Bury 2016-07-01 12:07:49 +02:00
parent 34b1cda760
commit 66740e5de8
2 changed files with 144 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
_tags
View file

@ -2,7 +2,7 @@
true: color(always)
# optimization options
true: optimize(3), unbox_closures
true: optimize(3), unbox_closures, unbox_closures_factor(20)
# Include paths
<sat>: include

204
solver/internal.ml
View file

@ -23,11 +23,11 @@ module Make
(* a push/pop state *)
type user_level = {
(* User levels always refer to decision_level 0 *)
ul_elt_lvl : int; (* Number of atoms in trail at decision level 0 *)
ul_th_lvl : int; (* Number of atoms known by the theory at decicion level 0 *)
ul_elt_lvl : int; (* Number of atoms in trail at decision level 0 *)
ul_th_lvl : int; (* Number of atoms known by the theory at decicion level 0 *)
ul_th_env : Th.level; (* Theory state at level 0 *)
ul_clauses : int; (* number of clauses *)
ul_learnt : int; (* number of learnt clauses *)
ul_clauses : int; (* number of clauses *)
ul_learnt : int; (* number of learnt clauses *)
}
(* Singleton type containing the current state *)
@ -107,6 +107,7 @@ module Make
mutable nb_init_clauses : int;
}
(* Starting environment. *)
let env = {
unsat_conflict = None;
next_decision = None;
@ -157,18 +158,40 @@ module Make
nb_init_clauses = 0;
}
(* Misc functions *)
let to_float i = float_of_int i
let to_int f = int_of_float f
let nb_clauses () = Vec.size env.clauses_hyps
let nb_vars () = St.nb_elt ()
let decision_level () = Vec.size env.elt_levels
let f_weight i j =
get_elt_weight (St.get_elt j) < get_elt_weight (St.get_elt i)
(* Is the assumptions currently unsat ? *)
let is_unsat () =
match env.unsat_conflict with
| Some _ -> true
| None -> false
(* Level for push/pop operations *)
type level = int
(* Push/Pop *)
let current_level () = Vec.size env.user_levels
let push () =
if is_unsat () then current_level ()
let push () : level =
if is_unsat () then
(* When unsat, pushing does nothing, since adding more assumptions
can not make the proof disappear. *)
current_level ()
else begin
(* The assumptions are sat, or at least not yet detected unsat,
we need to save enough to be able to restore the current decision
level 0. *)
let res = current_level () in
(* To restore decision level 0, we need the stolver queue, and theory state. *)
let ul_elt_lvl, ul_th_lvl =
if Vec.is_empty env.elt_levels then
env.elt_head, env.th_head
@ -179,58 +202,61 @@ module Make
if Vec.is_empty env.th_levels then Th.current_level ()
else Vec.get env.th_levels 0
in
(* Keep in mind what are the current assumptions. *)
let ul_clauses = Vec.size env.clauses_hyps in
let ul_learnt = Vec.size env.clauses_learnt in
Vec.push env.user_levels {ul_elt_lvl; ul_th_lvl; ul_th_env; ul_clauses; ul_learnt;};
res
end
(* Level for push/pop operations *)
type level = int
(* To store info for level 0, it is easier to push at module
initialisation, when there are no assumptions. *)
let base_level =
let l = push () in
assert (l = 0);
l
(* Iteration over subterms *)
module Mi = Map.Make(struct type t = int let compare = Pervasives.compare end)
let iter_map = ref Mi.empty
(* Iteration over subterms.
When incrementing activity, we want to be able to iterate over
all subterms of a formula. However, the function provided by the theory
may be costly (if it walks a tree-like structure, and does some processing
to ignore some subterms for instance), so we want to 'cache' to list
of subterms of each formula. To do so we use a hashtable from variable id to
list of subterms. *)
let iter_map = Hashtbl.create 1003
let iter_sub f v =
try
List.iter f (Mi.find v.vid !iter_map)
List.iter f (Hashtbl.find iter_map v.vid)
with Not_found ->
let l = ref [] in
Th.iter_assignable (fun t -> l := add_term t :: !l) v.pa.lit;
iter_map := Mi.add v.vid !l !iter_map;
Hashtbl.add iter_map v.vid !l;
List.iter f !l
let atom lit =
(* When we have a new litteral,
we need to first create the list of its subterms. *)
let atom lit : atom =
let res = add_atom lit in
iter_sub ignore res.var;
res
(* Misc functions *)
let to_float i = float_of_int i
let to_int f = int_of_float f
(* Accessors for litterals *)
let f_weight i j =
get_elt_weight (St.get_elt j) < get_elt_weight (St.get_elt i)
(*
let f_filter i =
get_elt_level (St.get_elt i) < 0
*)
(* Var/clause activity *)
(* Variable and litteral activity.
Activity is used to decide on which variable to decide when propagation
is done. Uses a heap (implemented in Iheap), to keep track of variable activity.
To be more general, the heap only stores the variable/litteral id (i.e an int).
When we add a variable (which wraps a formula), we also need to add all
its subterms.
*)
let insert_var_order = function
| Either.Left l -> Iheap.insert f_weight env.order l.lid
| Either.Right v ->
Iheap.insert f_weight env.order v.vid;
iter_sub (fun t -> Iheap.insert f_weight env.order t.lid) v
(* Rather than iterate over all the heap when we want to decrease all the
variables/literals activity, we instead increase the value by which
we increase the activity of 'interesting' var/lits. *)
let var_decay_activity () =
env.var_incr <- env.var_incr *. env.var_decay
@ -273,33 +299,45 @@ module Make
env.clause_incr <- env.clause_incr *. 1e-20
end
(* Convenient access *)
let decision_level () = Vec.size env.elt_levels
(* Simplification of clauses.
When adding new clauses, it is desirable to 'simplify' them, i.e:
- remove variables that are false at level 0, since it is a fact
that they cannot be true, and therefore can not help to satisfy the clause
let nb_clauses () = Vec.size env.clauses_hyps
let nb_vars () = St.nb_elt ()
(* Simplify clauses *)
Aditionally, since we can do push/pop on the assumptions, we need to
keep track of what assumptions were used to simplify a given clause.
*)
exception Trivial
let simplify_zero atoms level0 =
(* Eliminates dead litterals from clauses when at decision level 0 *)
(* Eliminates dead litterals from clauses when at decision level 0 (see above) *)
assert (decision_level () = 0);
let aux (atoms, history, lvl) a =
if a.is_true then raise Trivial;
(* If a variable is true at level 0, then the clause is always satisfied *)
if a.neg.is_true then begin
(* If a variable is false, we need to see why it is false. *)
match a.var.reason with
| None | Some Decision -> assert false
(* The var must have a reason, and it cannot be a decision, since we are
at level 0. *)
| Some (Bcp cl) -> atoms, cl :: history, max lvl cl.c_level
(* The variable has been set to false because of another clause,
we then need to keep track of the assumption level used. *)
| Some (Semantic 0) -> atoms, history, lvl
(* Semantic propagations at level 0 are, well not easy to deal with,
this shouldn't really happen actually (because semantic propagations
at level 0 currently lack a proof). *)
| Some (Semantic _) ->
Log.debugf 0 "Unexpected semantic propagation at level 0: %a"
(fun k->k St.pp_atom a);
assert false
end else
a::atoms, history, lvl
(* General case, we do not know the truth value of a, just let it be. *)
in
let atoms, init, lvl = List.fold_left aux ([], [], level0) atoms in
(* TODO: Why do we sort the atoms here ? *)
List.fast_sort (fun a b -> a.var.vid - b.var.vid) atoms, init, lvl
let partition atoms init0 =
@ -309,12 +347,17 @@ module Make
| a :: r ->
if a.is_true then
if a.var.v_level = 0 then raise Trivial
(* Same as before, a var true at level 0 gives a trivially true clause *)
else (a::trues) @ unassigned @ falses @ r, history, lvl
(* A var true at level > 0 does not change anything, but is unlikely
to be watched, so we put prefer to put them at the end. *)
else if a.neg.is_true then
if a.var.v_level = 0 then begin
match a.var.reason with
| Some (Bcp cl) ->
partition_aux trues unassigned falses (cl :: history) (max lvl cl.c_level) r
(* Same as before, a var false at level 0 can be eliminated from the clause,
but we need to kepp in mind that we used another clause to simplify it. *)
| Some (Semantic 0) ->
partition_aux trues unassigned falses history lvl r
| _ -> assert false
@ -328,7 +371,8 @@ module Make
else
partition_aux [] [] [] [] init0 atoms
(* Compute a progess estimate *)
(* Compute a progess estimate.
TODO: remove it or use it ? *)
let progress_estimate () =
let prg = ref 0. in
let nbv = to_float (nb_vars()) in
@ -342,7 +386,13 @@ module Make
!prg /. nbv
(* Manipulating decision levels *)
(* Making a decision.
Before actually creatig a new decision level, we check that
all propagations have been done and propagated to the theory,
i.e that the theoriy state indeed takes into account the whole
stack of litterals
i.e we have indeed reached a propagation fixpoint before making
a new decision *)
let new_decision_level() =
assert (env.th_head = Vec.size env.elt_queue);
assert (env.elt_head = Vec.size env.elt_queue);
@ -350,10 +400,14 @@ module Make
Vec.push env.th_levels (Th.current_level ()); (* save the current tenv *)
()
(* Adding/removing clauses *)
(* Attach/Detach a clause.
Clauses that become satisfied are detached, i.e we remove
their watchers, while clauses that loose their satisfied status
have to be reattached, adding watchers. *)
let attach_clause c =
Vec.push (Vec.get c.atoms 0).neg.watched c;
Vec.push (Vec.get c.atoms 1).neg.watched c;
(* TODO: Learnt litterals are not really used anymre, :p *)
if c.learnt then
env.learnts_literals <- env.learnts_literals + Vec.size c.atoms
else
@ -362,36 +416,46 @@ module Make
let detach_clause c =
Log.debugf 10 "Removing clause @[%a@]" (fun k->k St.pp_clause c);
c.removed <- true;
(* Not necessary, cleanup is done during propagation
Vec.remove (Vec.get c.atoms 0).neg.watched c;
Vec.remove (Vec.get c.atoms 1).neg.watched c;
*)
if c.learnt then
env.learnts_literals <- env.learnts_literals - Vec.size c.atoms
else
env.clauses_literals <- env.clauses_literals - Vec.size c.atoms
let remove_clause c = detach_clause c
(* Is a clause satisfied ? *)
let satisfied c = Vec.exists (fun atom -> atom.is_true) c.atoms
let satisfied c =
Vec.exists (fun atom -> atom.is_true) c.atoms
(* cancel down to [lvl] excluded *)
(* Backtracking.
Used to backtrack, i.e cancel down to [lvl] excluded,
i.e we want to go back to the state the solver was in
when decision level [lvl] was created. *)
let cancel_until lvl =
(* Nothing to do if we try to backtrack to a non-existent level. *)
if decision_level () > lvl then begin
(* We set the head of the solver and theory queue to what it was. *)
env.elt_head <- Vec.get env.elt_levels lvl;
env.th_head <- env.elt_head;
(* Now we need to cleanup the vars that are not valid anymore
(i.e to the right of elt_head in the queue. *)
for c = env.elt_head to Vec.size env.elt_queue - 1 do
match (Vec.get env.elt_queue c) with
(* A literal is unassigned, we nedd to add it back to
the heap of potentially assignable literals. *)
| Either.Left l ->
l.assigned <- None;
l.l_level <- -1;
insert_var_order (elt_of_lit l)
(* A variable is not true/false anymore, one of two things can happen: *)
| Either.Right a ->
if a.var.v_level <= lvl then begin
(* It is a semantic propagation, which can be late, and has a level
lower than where we backtrack, so we just move it to the head
of the queue. *)
Vec.set env.elt_queue env.elt_head (of_atom a);
env.elt_head <- env.elt_head + 1
end else begin
(* it is a result of bolean propagation, or a semantic propagation
with a level higher than the level to which we backtrack,
in that case, we simply unset its value and reinsert it into the heap. *)
a.is_true <- false;
a.neg.is_true <- false;
a.var.v_level <- -1;
@ -399,7 +463,9 @@ module Make
insert_var_order (elt_of_var a.var)
end
done;
Th.backtrack (Vec.get env.th_levels lvl); (* recover the right tenv *)
(* Recover the right theory state. *)
Th.backtrack (Vec.get env.th_levels lvl);
(* Resize the vectors according to their new size. *)
Vec.shrink env.elt_queue ((Vec.size env.elt_queue) - env.elt_head);
Vec.shrink env.elt_levels ((Vec.size env.elt_levels) - lvl);
Vec.shrink env.th_levels ((Vec.size env.th_levels) - lvl);
@ -407,24 +473,40 @@ module Make
assert (Vec.size env.elt_levels = Vec.size env.th_levels);
()
(* Unsatisfiability is signaled through an exception, since it can happen
in multiple places (adding new clauses, or solving for instance). *)
let report_unsat ({atoms=atoms} as confl) =
Log.debugf 5 "@[Unsat conflict: %a@]" (fun k -> k St.pp_clause confl);
env.unsat_conflict <- Some confl;
raise Unsat
(* Simplification of boolean propagation reasons.
When doing boolean propagation *at level 0*, it can happen
that the clause cl, which propagates a formula, also contains
other formulas, but has been simplified. in which case, we
need to rebuild a clause with correct history, in order to
be able to build a correct proof at the end of proof search. *)
let simpl_reason = function
| (Bcp cl) as r ->
let l, history, c_lvl = partition (Vec.to_list cl.atoms) 0 in
begin match l with
| [ a ] ->
if history = [] then r
(* no simplification has been done, so [cl] is actually a clause with only
[a], so it is a valid reason for propagating [a]. *)
else
(* Clauses in [history] have been used to simplify [cl] into a clause [tmp_cl]
with only one formula (which is [a]). So we explicitly create that clause
and set it as the cause for the propagation of [a], that way we can
rebuild the whole resolution tree when we want to prove [a]. *)
let tmp_cl = make_clause (fresh_tname ()) l 1 true (History (cl :: history)) c_lvl in
Bcp tmp_cl
| _ -> assert false
end
| r -> r
(* Boolean propagation.
Wrapper function for adding a new propagated formula. *)
let enqueue_bool a lvl reason =
if a.neg.is_true then begin
Log.debugf 0 "Trying to enqueue a false litteral: %a" (fun k->k St.pp_atom a);
@ -610,7 +692,7 @@ module Make
clause_bump_activity lclause;
if is_uip then
enqueue_bool fuip blevel (Bcp lclause)
else begin
else begin
env.next_decision <- Some fuip.neg
end
end;
@ -790,10 +872,10 @@ module Make
let res = ref None in
while env.elt_head < Vec.size env.elt_queue do
begin match Vec.get env.elt_queue env.elt_head with
| Either.Left _ -> ()
| Either.Right a ->
incr num_props;
propagate_atom a res
| Either.Left _ -> ()
| Either.Right a ->
incr num_props;
propagate_atom a res
end;
env.elt_head <- env.elt_head + 1;
done;
@ -838,14 +920,14 @@ module Make
for i = 0 to lim1 - 1 do
let c = Vec.get env.learnts i in
if Vec.size c.atoms > 2 && not (locked c) then
remove_clause c
detach_clause c
else
begin Vec.set env.learnts !j c; incr j end
done;
for i = lim1 to lim2 - 1 do
let c = Vec.get env.learnts i in
if Vec.size c.atoms > 2 && not (locked c) && c.activity < extra_lim then
remove_clause c
detach_clause c
else
begin Vec.set env.learnts !j c; incr j end
done;
@ -857,7 +939,7 @@ module Make
let remove_satisfied vec =
for i = 0 to Vec.size vec - 1 do
let c = Vec.get vec i in
if satisfied c then remove_clause c
if satisfied c then detach_clause c
done
let simplify () =
@ -961,8 +1043,8 @@ module Make
add_clause c;
(* Clauses can be added after search has begun (and thus we are not at level 0,
so better not do anything at this point.
match propagate () with
| None -> () | Some confl -> report_unsat confl
match propagate () with
| None -> () | Some confl -> report_unsat confl
*)
in
List.iter aux cnf
@ -1106,7 +1188,7 @@ module Make
for i = ul.ul_clauses to Vec.size env.clauses_hyps - 1 do
let c = Vec.get env.clauses_hyps i in
assert (c.c_level > l);
remove_clause c
detach_clause c
done;
Vec.shrink env.clauses_hyps (Vec.size env.clauses_hyps - ul.ul_clauses);
@ -1116,7 +1198,7 @@ module Make
for i = ul.ul_learnt to Vec.size env.clauses_learnt - 1 do
let c = Vec.get env.clauses_learnt i in
if c.c_level > l then begin
remove_clause c;
detach_clause c;
match c.cpremise with
| History ({ cpremise = Lemma _ } as c' :: _ ) -> Stack.push c' s
| _ -> () (* Only simplified clauses can have a level > 0 *)