diff --git a/src/core/Sidekick_core.ml b/src/core/Sidekick_core.ml index f6c31e90..c104f93c 100644 --- a/src/core/Sidekick_core.ml +++ b/src/core/Sidekick_core.ml @@ -155,6 +155,15 @@ module type CC_PROOF = sig of uninterpreted functions. *) end +(** Opaque identifier for clause pools in the SAT solver *) +module Clause_pool_id : sig + type t = private int + val _unsafe_of_int : int -> t +end = struct + type t = int + let _unsafe_of_int x = x +end + (** Signature for SAT-solver proof emission, using DRUP. We do not store the resolution steps, just the stream of clauses deduced. @@ -285,6 +294,7 @@ module type CC_ACTIONS = sig module Lit : LIT with module T = T type proof + type clause_pool_id = Clause_pool_id.t type dproof = proof -> unit module P : CC_PROOF with type lit = Lit.t and type t = proof @@ -299,6 +309,9 @@ module type CC_ACTIONS = sig exception). @param pr the proof of [c] being a tautology *) + val add_clause : ?pool:clause_pool_id -> t -> Lit.t list -> dproof -> unit + (** Learn a lemma *) + val propagate : t -> Lit.t -> reason:(unit -> Lit.t list * dproof) -> unit (** [propagate acts lit ~reason pr] declares that [reason() => lit] is a tautology. @@ -645,7 +658,7 @@ module type SOLVER_INTERNAL = sig type term = T.Term.t type term_store = T.Term.store type ty_store = T.Ty.store - type clause_pool + type clause_pool_id = Clause_pool_id.t type proof type dproof = proof -> unit (** Delayed proof. This is used to build a proof step on demand. *) @@ -803,6 +816,13 @@ module type SOLVER_INTERNAL = sig (** Add local clause to the SAT solver. This clause will be removed when the solver backtracks. *) + val add_clause_in_pool : + pool:clause_pool_id -> + t -> theory_actions -> + lit list -> dproof -> unit + (** Add local clause to the SAT solver. This clause will be + removed when the solver backtracks. *) + val add_clause_permanent : t -> theory_actions -> lit list -> dproof -> unit (** Add toplevel clause to the SAT solver. This clause will not be backtracked. *) diff --git a/src/sat/Solver_intf.ml b/src/sat/Solver_intf.ml index 74693eb6..851241c6 100644 --- a/src/sat/Solver_intf.ml +++ b/src/sat/Solver_intf.ml @@ -82,13 +82,7 @@ type ('lit, 'proof) reason = type lbool = L_true | L_false | L_undefined (** Valuation of an atom *) -module Clause_pool_id : sig - type t = private int - val _unsafe_of_int : int -> t -end = struct - type t = int - let _unsafe_of_int x = x -end +module Clause_pool_id = Sidekick_core.Clause_pool_id (** Actions available to the Plugin diff --git a/src/smt-solver/Sidekick_smt_solver.ml b/src/smt-solver/Sidekick_smt_solver.ml index 621a0229..db6c7854 100644 --- a/src/smt-solver/Sidekick_smt_solver.ml +++ b/src/smt-solver/Sidekick_smt_solver.ml @@ -63,10 +63,16 @@ module Make(A : ARG) module Lit = Lit type nonrec proof = proof type dproof = proof -> unit + type clause_pool_id = Sidekick_core.Clause_pool_id.t type t = sat_acts let[@inline] raise_conflict (a:t) lits (dp:dproof) = let (module A) = a in A.raise_conflict lits dp + let add_clause ?pool (a:t) lits (dp:dproof) : unit = + let (module A) = a in + match pool with + | None -> A.add_clause ~keep:false lits dp + | Some pool -> A.add_clause_in_pool ~pool lits dp let[@inline] propagate (a:t) lit ~reason = let (module A) = a in let reason = Sidekick_sat.Consequence reason in @@ -90,7 +96,7 @@ module Make(A : ARG) type ty = Ty.t type lit = Lit.t type term_store = Term.store - type clause_pool + type clause_pool_id = Sidekick_core.Clause_pool_id.t type ty_store = Ty.store type th_states = @@ -402,6 +408,10 @@ module Make(A : ARG) let c = preprocess_clause_ self acts c in add_sat_clause_ self acts ~keep:false c proof + let[@inline] add_clause_in_pool ~pool self acts c (proof:dproof) : unit = + let c = preprocess_clause_ self acts c in + add_sat_clause_pool_ self acts ~pool c proof + let[@inline] add_clause_permanent self acts c (proof:dproof) : unit = let c = preprocess_clause_ self acts c in add_sat_clause_ self acts ~keep:true c proof