diff --git a/smt/mcsat.ml b/smt/mcsat.ml index 425c5ea3..de5dc594 100644 --- a/smt/mcsat.ml +++ b/smt/mcsat.ml @@ -108,6 +108,8 @@ module Tsmt = struct Valued (not (Fsmt.Term.equal a' b'), max lvl_a lvl_b) with Not_found -> Unknown end + let if_sat _ = () + end module Make(Dummy:sig end) = struct diff --git a/solver/mcsolver.ml b/solver/mcsolver.ml index c9c17a2f..760e1a48 100644 --- a/solver/mcsolver.ml +++ b/solver/mcsolver.ml @@ -644,6 +644,14 @@ module Make (L : Log_intf.S)(E : Expr_intf.S) propagate = slice_propagate; }) + let full_slice tag = Th.({ + start = 0; + length = Vec.size env.trail; + get = slice_get; + push = (fun cl proof -> tag := true; slice_push cl proof); + propagate = (fun _ -> assert false); + }) + let rec theory_propagate () = let slice = current_slice () in env.tatoms_qhead <- nb_assigns (); @@ -818,6 +826,13 @@ module Make (L : Log_intf.S)(E : Expr_intf.S) let check_vec vec = for i = 0 to Vec.size vec - 1 do check_clause (Vec.get vec i) done + let add_clauses cnf ~cnumber = + let aux cl = + add_clause ~cnumber cl (History []); + match propagate () with + | None -> () | Some confl -> report_unsat confl + in + List.iter aux cnf (* fixpoint of propagation and decisions until a model is found, or a conflict is reached *) @@ -829,7 +844,12 @@ module Make (L : Log_intf.S)(E : Expr_intf.S) while true do begin try search (to_int !n_of_conflicts) (to_int !n_of_learnts); - with Restart -> () + with + | Restart -> () + | Sat -> + let tag = ref false in + Th.if_sat (full_slice tag); + if not !tag then raise Sat end; n_of_conflicts := !n_of_conflicts *. env.restart_inc; n_of_learnts := !n_of_learnts *. env.learntsize_inc; @@ -837,14 +857,6 @@ module Make (L : Log_intf.S)(E : Expr_intf.S) with | Sat -> () - let add_clauses cnf ~cnumber = - let aux cl = - add_clause ~cnumber cl (History []); - match propagate () with - | None -> () | Some confl -> report_unsat confl - in - List.iter aux cnf - let init_solver cnf ~cnumber = let nbv = St.nb_vars () in let nbc = env.nb_init_clauses + List.length cnf in diff --git a/solver/plugin_intf.ml b/solver/plugin_intf.ml index acf662df..d14fcba9 100644 --- a/solver/plugin_intf.ml +++ b/solver/plugin_intf.ml @@ -78,6 +78,10 @@ module type S = sig val eval : formula -> eval_res (** Returns the evaluation of the formula in the current assignment *) + val if_sat : slice -> unit + (** Called at the end of the search in case a model has been found. If no new clause is + pushed, then 'sat' is returned, else search is resumed. *) + val proof_debug : proof -> string * (formula list) * (term list) * (string option) (** Returns debugging information on a proof, as a triplet consisting of a name/identification string associated with the proof, arguments of the proof,