diff --git a/src/sat/Sidekick_sat.ml b/src/sat/Sidekick_sat.ml index fc956231..bc5f3344 100644 --- a/src/sat/Sidekick_sat.ml +++ b/src/sat/Sidekick_sat.ml @@ -28,6 +28,7 @@ let pp_lbool out = function | L_undefined -> Format.fprintf out "undefined" exception No_proof = Solver_intf.No_proof +exception Resource_exhausted = Solver_intf.Resource_exhausted module Solver = Solver module Make_cdcl_t = Solver.Make_cdcl_t diff --git a/src/sat/Solver.ml b/src/sat/Solver.ml index c69ea789..5e359dc8 100644 --- a/src/sat/Solver.ml +++ b/src/sat/Solver.ml @@ -2184,7 +2184,7 @@ module Make(Plugin : PLUGIN) (* do some amount of search, until the number of conflicts or clause learnt reaches the given parameters *) - let search (st:t) ~(max_conflicts:int) : unit = + let search (st:t) ~on_progress ~(max_conflicts:int) : unit = Log.debugf 3 (fun k->k "(@[sat.search@ :max-conflicts %d@ :max-learnt %d@])" max_conflicts !(st.max_clauses_learnt)); @@ -2224,6 +2224,7 @@ module Make(Plugin : PLUGIN) in if do_gc then ( reduce_clause_db st; + on_progress(); ); let decided = pick_branch_lit ~full:true st in @@ -2258,7 +2259,7 @@ module Make(Plugin : PLUGIN) on_progress(); begin try self.max_clauses_learnt := int_of_float !max_learnt ; - search self ~max_conflicts:(int_of_float !max_conflicts) + search self ~on_progress ~max_conflicts:(int_of_float !max_conflicts) with | Restart -> max_conflicts := !max_conflicts *. restart_inc; @@ -2267,6 +2268,7 @@ module Make(Plugin : PLUGIN) assert (self.elt_head = AVec.size self.trail && has_no_delayed_actions self && self.next_decisions=[]); + on_progress(); begin match Plugin.final_check self.th (full_slice self) with | () -> if self.elt_head = AVec.size self.trail && @@ -2287,6 +2289,7 @@ module Make(Plugin : PLUGIN) (match self.on_conflict with Some f -> f self c | None -> ()); Delayed_actions.add_clause_learnt self.delayed_actions c; perform_delayed_actions self; + on_progress(); end; end done diff --git a/src/sat/Solver_intf.ml b/src/sat/Solver_intf.ml index d08bd441..2bd175ca 100644 --- a/src/sat/Solver_intf.ml +++ b/src/sat/Solver_intf.ml @@ -230,6 +230,9 @@ module type PLUGIN_SAT = sig and type proof_step = proof_step end +exception Resource_exhausted +(** Can be raised in a progress handler *) + (** The external interface implemented by safe solvers, such as the one created by the {!Solver.Make} and {!Mcsolver.Make} functors. *) module type S = sig @@ -377,7 +380,7 @@ module type S = sig val add_clause_a_in_pool : t -> pool:clause_pool_id -> lit array -> proof_step -> unit (** Like {!add_clause_a} but using a specific clause pool *) -(** {2 Solving} *) + (** {2 Solving} *) val solve : ?on_progress:(unit -> unit) -> @@ -387,7 +390,11 @@ module type S = sig @param assumptions additional atomic assumptions to be temporarily added. The assumptions are just used for this call to [solve], they are not saved in the solver's state. - @param on_progress regularly called during solving + @param on_progress regularly called during solving. + Can raise {!Resource_exhausted} + to stop solving. + + @raise Resource_exhausted if the on_progress handler raised it to stop *) (** {2 Evaluating and adding literals} *) diff --git a/src/smt-solver/Sidekick_smt_solver.ml b/src/smt-solver/Sidekick_smt_solver.ml index 6432307a..fbd24c24 100644 --- a/src/smt-solver/Sidekick_smt_solver.ml +++ b/src/smt-solver/Sidekick_smt_solver.ml @@ -907,7 +907,7 @@ module Make(A : ARG) ))); Model.Map model - exception Should_stop + exception Resource_exhausted = Sidekick_sat.Resource_exhausted let solve ?(on_exit=[]) ?(check=true) @@ -924,7 +924,7 @@ module Make(A : ARG) fun() -> incr resource_counter; on_progress self; - if should_stop self !resource_counter then raise_notrace Should_stop + if should_stop self !resource_counter then raise_notrace Resource_exhausted in self.si.on_progress <- on_progress; @@ -961,7 +961,7 @@ module Make(A : ARG) let unsat_proof_step () = Some (UNSAT.unsat_proof()) in do_on_exit (); Unsat {unsat_core; unsat_proof_step} - | exception Should_stop -> Unknown Unknown.U_asked_to_stop + | exception Resource_exhausted -> Unknown Unknown.U_asked_to_stop in self.last_res <- Some res; res