Fix for when the solver becomes unsat during if_sat

This commit is contained in:
Guillaume Bury 2015-12-11 09:08:10 +01:00
parent 1d1ba51329
commit df1f28ccb1
3 changed files with 12 additions and 7 deletions

View file

@ -3,6 +3,7 @@
LOG=build.log LOG=build.log
COMP=ocamlbuild -log $(LOG) -use-ocamlfind -classic-display COMP=ocamlbuild -log $(LOG) -use-ocamlfind -classic-display
FLAGS= FLAGS=
#-ocamlc ocamlopt -cflag -O3
DIRS=-Is solver,sat,smt,backend,util,util/smtlib DIRS=-Is solver,sat,smt,backend,util,util/smtlib
DOC=msat.docdir/index.html DOC=msat.docdir/index.html
TEST=sat_solve.native TEST=sat_solve.native

8
_tags
View file

@ -6,10 +6,10 @@
<backend/*.cmx>: for-pack(Msat) <backend/*.cmx>: for-pack(Msat)
# enable stronger inlining everywhere # enable stronger inlining everywhere
<util/{vec,hashcons,hstring,iheap}.cmx>: inline(100) #<util/{vec,hashcons,hstring,iheap}.cmx>: inline(100)
<solver/*.cmx>: inline(1000) #<solver/*.cmx>: inline(50)
<sat/**/*.cmx>: inline(100) #<sat/**/*.cmx>: inline(100)
<smt/**/*.cmx>: inline(100) #<smt/**/*.cmx>: inline(100)
# more warnings # more warnings
<**/*.ml>: warn_K, warn_Y, warn_X <**/*.ml>: warn_K, warn_Y, warn_X

View file

@ -567,12 +567,14 @@ module Make
let size = List.length atoms in let size = List.length atoms in
match atoms with match atoms with
| [] -> | [] ->
report_unsat init0; L.debug 1 "New clause (unsat) : %a" St.pp_clause init0;
report_unsat init0
| a::b::_ -> | a::b::_ ->
let clause = let clause =
if init then init0 if init then init0
else make_clause ?tag:init0.tag (fresh_name ()) atoms size true (History [init0]) level else make_clause ?tag:init0.tag (fresh_name ()) atoms size true (History [init0]) level
in in
L.debug 4 "New clause: %a" St.pp_clause clause;
attach_clause clause; attach_clause clause;
Vec.push vec clause; Vec.push vec clause;
if a.neg.is_true then begin if a.neg.is_true then begin
@ -588,7 +590,7 @@ module Make
L.debug 5 "New unit clause, propagating : %a" St.pp_atom a; L.debug 5 "New unit clause, propagating : %a" St.pp_atom a;
cancel_until 0; cancel_until 0;
enqueue_bool a 0 (Bcp (Some init0)) enqueue_bool a 0 (Bcp (Some init0))
with Trivial -> L.debug 5 "Trivial clause ignored" with Trivial -> L.debug 5 "Trivial clause ignored : %a" St.pp_clause init0
let progress_estimate () = let progress_estimate () =
let prg = ref 0. in let prg = ref 0. in
@ -902,7 +904,8 @@ module Make
| Sat -> | Sat ->
let nbc = env.nb_init_clauses in let nbc = env.nb_init_clauses in
Th.if_sat (full_slice ()); Th.if_sat (full_slice ());
if env.nb_init_clauses = nbc && if is_unsat () then raise Unsat
else if env.nb_init_clauses = nbc &&
env.elt_head = Vec.size env.elt_queue then env.elt_head = Vec.size env.elt_queue then
raise Sat raise Sat
end end
@ -1022,6 +1025,7 @@ module Make
reset_until l ul.ul_elt_lvl ul.ul_th_lvl ul.ul_th_env; reset_until l ul.ul_elt_lvl ul.ul_th_lvl ul.ul_th_env;
(* Log current assumptions for debugging purposes *) (* Log current assumptions for debugging purposes *)
L.debug 99 "Current trail:";
for i = 0 to Vec.size env.elt_queue - 1 do for i = 0 to Vec.size env.elt_queue - 1 do
L.debug 99 "%s%s%d -- %a" L.debug 99 "%s%s%d -- %a"
(if i = ul.ul_elt_lvl then "*" else " ") (if i = ul.ul_elt_lvl then "*" else " ")