feat: clause pools in SMT

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. *)

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
+module Clause_pool_id = Sidekick_core.Clause_pool_id
-  type t = private int
-  val _unsafe_of_int : int -> t
-end = struct
-  type t = int
-  let _unsafe_of_int x = x
-end
 
 (** Actions available to the Plugin
 

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