refactor: use abstract-solver in smtlib driver; CDCL(T) implements asolver

this way we can add new SMT techniques without changing (much) the
driver.

src/main/main.ml

@@ -199,11 +199,12 @@ let main_smt ~config () : _ result =
             (Sidekick_smt_solver.Theory.name th_bool));
       [ th_bool; Driver.th_ty_unin; Driver.th_data; Driver.th_lra ]
     in
-    Solver.create_default ~tracer ~proof ~theories tst
+    Solver.Smt_solver.Solver.create_default ~tracer ~proof ~theories tst ()
   in
 
   let finally () =
-    if !p_stat then Format.printf "%a@." Solver.pp_stats solver
+    if !p_stat then
+      Format.printf "%a@." Solver.Smt_solver.Solver.pp_stats solver
   in
   CCFun.protect ~finally @@ fun () ->
   (* FIXME: emit an actual proof *)
@@ -215,7 +216,7 @@ let main_smt ~config () : _ result =
   in
   if !check then
     (* might have to check conflicts *)
-    Solver.add_theory solver Sidekick_smtlib.Check_cc.theory;
+    Solver.Smt_solver.Solver.add_theory solver Sidekick_smtlib.Check_cc.theory;
 
   let parse_res =
     let@ () = Profile.with_ "parse" ~args:[ "file", !file ] in
@@ -224,9 +225,10 @@ let main_smt ~config () : _ result =
 
   parse_res >>= fun input ->
   let driver =
+    let asolver = Solver.Smt_solver.Solver.as_asolver solver in
     Driver.create ~restarts:!restarts ~pp_cnf:!p_cnf ~time:!time_limit
       ~memory:!mem_limit ~pp_model:!p_model ?proof_file ~check:!check
-      ~progress:!p_progress solver
+      ~progress:!p_progress asolver
   in
 
   (* process statements *)

src/smt/dune

@@ -3,5 +3,6 @@
  (public_name sidekick.smt-solver)
  (synopsis "main SMT solver")
  (libraries containers iter sidekick.core sidekick.util sidekick.cc
-   sidekick.sat sidekick.simplify sidekick.model sidekick.trace)
+   sidekick.sat sidekick.abstract-solver sidekick.simplify
+   sidekick.model sidekick.trace)
  (flags :standard -w +32 -open Sidekick_util))

src/smt/solver.ml

@@ -6,32 +6,25 @@ open struct
   module Rule_ = Proof_core
 end
 
+module Check_res = Sidekick_abstract_solver.Check_res
+
 module Sat_solver = Sidekick_sat
 (** the parametrized SAT Solver *)
 
 (** {2 Result} *)
 
-module Unknown = struct
+module Unknown = Sidekick_abstract_solver.Unknown [@@ocaml.warning "-37"]
-  type t = U_timeout | U_max_depth | U_incomplete | U_asked_to_stop
 
-  let pp out = function
+type res = Check_res.t =
-    | U_timeout -> Fmt.string out {|"timeout"|}
+  | Sat of Model.t  (** Satisfiable *)
-    | U_max_depth -> Fmt.string out {|"max depth reached"|}
-    | U_incomplete -> Fmt.string out {|"incomplete fragment"|}
-    | U_asked_to_stop -> Fmt.string out {|"asked to stop by callback"|}
-end
-[@@ocaml.warning "-37"]
-
-type res =
-  | Sat of Model.t
   | Unsat of {
       unsat_core: unit -> lit Iter.t;
           (** Unsat core (subset of assumptions), or empty *)
       unsat_step_id: unit -> step_id option;
           (** Proof step for the empty clause *)
-    }
+    }  (** Unsatisfiable *)
   | Unknown of Unknown.t
-      (** Result of solving for the current set of clauses *)
+      (** Unknown, obtained after a timeout, memory limit, etc. *)
 
 (* main solver state *)
 type t = {
@@ -175,8 +168,8 @@ let assert_terms self c =
 let assert_term self t = assert_terms self [ t ]
 let add_ty (self : t) ty = SI.add_ty self.si ~ty
 
-let solve ?(on_exit = []) ?(check = true) ?(on_progress = fun _ -> ())
+let solve ?(on_exit = []) ?(on_progress = fun _ -> ())
-    ?(should_stop = fun _ _ -> false) ~assumptions (self : t) : res =
+    ?(should_stop = fun _ -> false) ~assumptions (self : t) : res =
   let@ () = Profile.with_ "smt-solver.solve" in
   let do_on_exit () = List.iter (fun f -> f ()) on_exit in
 
@@ -184,9 +177,8 @@ let solve ?(on_exit = []) ?(check = true) ?(on_progress = fun _ -> ())
     let resource_counter = ref 0 in
     fun () ->
       incr resource_counter;
-      on_progress self;
+      on_progress ();
-      if should_stop self !resource_counter then
+      if should_stop !resource_counter then raise_notrace Resource_exhausted
-        raise_notrace Resource_exhausted
   in
   Event.on ~f:on_progress (SI.on_progress self.si);
 
@@ -218,8 +210,6 @@ let solve ?(on_exit = []) ?(check = true) ?(on_progress = fun _ -> ())
         | Some m -> m
         | None -> assert false
       in
-      (* TODO: check model *)
-      let _ = check in
 
       do_on_exit ();
       Sat m
@@ -233,6 +223,20 @@ let solve ?(on_exit = []) ?(check = true) ?(on_progress = fun _ -> ())
   self.last_res <- Some res;
   res
 
+let as_asolver (self : t) : Sidekick_abstract_solver.Asolver.t =
+  object
+    method assert_term t : unit = assert_term self t
+    method assert_clause c p : unit = add_clause self c p
+    method assert_clause_l c p : unit = add_clause_l self c p
+    method lit_of_term ?sign t : Lit.t = mk_lit_t self ?sign t
+    method proof = self.proof
+    method last_res = last_res self
+    method add_ty ~ty = add_ty self ty
+
+    method solve ?on_exit ?on_progress ?should_stop ~assumptions () : res =
+      solve ?on_exit ?on_progress ?should_stop ~assumptions self
+  end
+
 let push_assumption self a =
   reset_last_res_ self;
   Sat_solver.push_assumption self.solver a

src/smt/solver.mli

@@ -7,6 +7,8 @@
     Theory implementors will mostly interact with {!SOLVER_INTERNAL}. *)
 
 open Sigs
+module Check_res = Sidekick_abstract_solver.Check_res
+module Unknown = Sidekick_abstract_solver.Unknown
 
 type t
 (** The solver's state. *)
@@ -25,19 +27,6 @@ val mk_theory :
   Theory.t
 (** Helper to create a theory. *)
 
-(* TODO *)
-module Unknown : sig
-  type t
-
-  val pp : t CCFormat.printer
-
-  (*
-    type unknown =
-      | U_timeout
-      | U_incomplete
-       *)
-end
-
 (** {3 Main API} *)
 
 val stats : t -> Stat.t
@@ -116,7 +105,7 @@ val assert_term : t -> term -> unit
 val add_ty : t -> ty -> unit
 
 (** Result of solving for the current set of clauses *)
-type res =
+type res = Check_res.t =
   | Sat of Model.t  (** Satisfiable *)
   | Unsat of {
       unsat_core: unit -> lit Iter.t;
@@ -131,24 +120,25 @@ type res =
 
 val solve :
   ?on_exit:(unit -> unit) list ->
-  ?check:bool ->
+  ?on_progress:(unit -> unit) ->
-  ?on_progress:(t -> unit) ->
+  ?should_stop:(int -> bool) ->
-  ?should_stop:(t -> int -> bool) ->
   assumptions:lit list ->
   t ->
   res
 (** [solve s] checks the satisfiability of the clauses added so far to [s].
-      @param check if true, the model is checked before returning.
       @param on_progress called regularly during solving.
       @param assumptions a set of atoms held to be true. The unsat core,
         if any, will be a subset of [assumptions].
-      @param should_stop a callback regularly called with the solver,
+      @param should_stop a callback regularly called from within the solver.
-        and with a number of "steps" done since last call. The exact notion
+        It is given a number of "steps" done since last call. The exact notion
         of step is not defined, but is guaranteed to increase regularly.
         The function should return [true] if it judges solving
         must stop (returning [Unknown]), [false] if solving can proceed.
       @param on_exit functions to be run before this returns *)
 
+val as_asolver : t -> Sidekick_abstract_solver.Asolver.t
+(** Comply to the abstract solver interface *)
+
 val last_res : t -> res option
 (** Last result, if any. Some operations will erase this (e.g. {!assert_term}). *)
 
@@ -184,7 +174,5 @@ val check_sat_propagations_only :
         the given core.
   *)
 
-(* TODO: allow on_progress to return a bool to know whether to stop? *)
-
 val pp_stats : t CCFormat.printer
 (** Print some statistics. What it prints exactly is unspecified. *)

src/smtlib/Driver.ml

@@ -1,5 +1,6 @@
 open Sidekick_core
 module Profile = Sidekick_util.Profile
+module Asolver = Solver.Asolver
 open! Sidekick_base
 open Common_
 
@@ -55,7 +56,7 @@ module Fmt = CCFormat
 
 type t = {
   progress: Progress_bar.t option;
-  solver: Solver.t;
+  solver: Asolver.t;
   time_start: float;
   time_limit: float;
   memory_limit: float;
@@ -68,7 +69,8 @@ type t = {
 
 (* call the solver to check-sat *)
 let create ?(restarts = true) ?(pp_cnf = false) ?proof_file ?(pp_model = false)
-    ?(check = false) ?time ?memory ?(progress = false) (solver : Solver.t) : t =
+    ?(check = false) ?time ?memory ?(progress = false) (solver : Asolver.t) : t
+    =
   let time_start = now () in
   let progress =
     if progress then
@@ -107,7 +109,7 @@ let decl_fun (_self : t) id args ret : unit =
 (* call the solver to check satisfiability *)
 let solve (self : t) ~assumptions () : Solver.res =
   let t1 = now () in
-  let should_stop _ _ =
+  let should_stop _n =
     if now () -. self.time_start > self.time_limit then (
       Log.debugf 0 (fun k -> k "timeout");
       true
@@ -125,12 +127,12 @@ let solve (self : t) ~assumptions () : Solver.res =
 
   let res =
     let@ () = Profile.with_ "process.solve" in
-    Solver.solve ~assumptions ?on_progress ~should_stop self.solver
+    Asolver.solve ~assumptions ?on_progress ~should_stop self.solver ()
   in
   let t2 = now () in
   flush stdout;
   (match res with
-  | Solver.Sat m ->
+  | Asolver.Check_res.Sat m ->
     if self.pp_model then
       (* TODO: use actual {!Model} in the solver? or build it afterwards *)
       Format.printf "(@[<hv1>model@ %a@])@." Sidekick_smt_solver.Model.pp m;
@@ -143,7 +145,7 @@ let solve (self : t) ~assumptions () : Solver.res =
     let t3 = now () in
     Fmt.printf "sat@.";
     Fmt.printf "; (%.3f/%.3f/%.3f)@." (t1 -. time_start) (t2 -. t1) (t3 -. t2)
-  | Solver.Unsat { unsat_step_id; unsat_core = _ } ->
+  | Asolver.Check_res.Unsat { unsat_step_id; unsat_core = _ } ->
     if self.check then
       ()
     (* FIXME: check trace?
@@ -158,19 +160,17 @@ let solve (self : t) ~assumptions () : Solver.res =
       (match unsat_step_id () with
       | None -> ()
       | Some step_id ->
+        (* TODO: read trace; emit proof
               let proof = Solver.proof self.solver in
               let proof_quip =
                 Profile.with_ "proof.to-quip" @@ fun () -> assert false
-          (* TODO
                    Proof_quip.of_proof proof ~unsat:step_id
-          *)
-        in
               Profile.with_ "proof.write-file" @@ fun () ->
               with_file_out file @@ fun oc ->
-        (* TODO
                  Proof_quip.output oc proof_quip;
+           flush oc
         *)
-        flush oc)
+        ())
     | _ -> ());
 
     let t3 = now () in
@@ -193,7 +193,7 @@ let process_stmt (self : t) (stmt : Statement.t) : unit or_error =
   Log.debugf 5 (fun k ->
       k "(@[smtlib.process-statement@ %a@])" Statement.pp stmt);
 
-  let add_step r = Proof_trace.add_step (Solver.proof self.solver) r in
+  let add_step r = Proof_trace.add_step (Asolver.proof self.solver) r in
 
   match stmt with
   | Statement.Stmt_set_logic logic ->
@@ -211,7 +211,7 @@ let process_stmt (self : t) (stmt : Statement.t) : unit or_error =
   | Statement.Stmt_check_sat l ->
     (* FIXME: how to map [l] to [assumptions] in proof? *)
     let assumptions =
-      List.map (fun (sign, t) -> Solver.mk_lit_t self.solver ~sign t) l
+      List.map (fun (sign, t) -> Asolver.lit_of_term self.solver ~sign t) l
     in
     ignore (solve self ~assumptions () : Solver.res);
     E.return ()
@@ -223,32 +223,32 @@ let process_stmt (self : t) (stmt : Statement.t) : unit or_error =
     E.return ()
   | Statement.Stmt_assert t ->
     if self.pp_cnf then Format.printf "(@[<hv1>assert@ %a@])@." Term.pp t;
-    let lit = Solver.mk_lit_t self.solver t in
+    let lit = Asolver.lit_of_term self.solver t in
-    Solver.add_clause self.solver [| lit |]
+    Asolver.assert_clause self.solver [| lit |]
       (add_step @@ fun () -> Proof_sat.sat_input_clause [ lit ]);
     E.return ()
   | Statement.Stmt_assert_clause c_ts ->
     if self.pp_cnf then
       Format.printf "(@[<hv1>assert-clause@ %a@])@." (Util.pp_list Term.pp) c_ts;
 
-    let c = CCList.map (fun t -> Solver.mk_lit_t self.solver t) c_ts in
+    let c = CCList.map (fun t -> Asolver.lit_of_term self.solver t) c_ts in
 
     (* proof of assert-input + preprocessing *)
     let pr =
       add_step @@ fun () ->
-      let lits = List.map (Solver.mk_lit_t self.solver) c_ts in
+      let lits = List.map (Asolver.lit_of_term self.solver) c_ts in
       Proof_sat.sat_input_clause lits
     in
 
-    Solver.add_clause self.solver (CCArray.of_list c) pr;
+    Asolver.assert_clause self.solver (CCArray.of_list c) pr;
     E.return ()
   | Statement.Stmt_get_model ->
-    (match Solver.last_res self.solver with
+    (match Asolver.last_res self.solver with
     | Some (Solver.Sat m) -> Fmt.printf "%a@." Sidekick_smt_solver.Model.pp m
     | _ -> Error.errorf "cannot access model");
     E.return ()
   | Statement.Stmt_get_value l ->
-    (match Solver.last_res self.solver with
+    (match Asolver.last_res self.solver with
     | Some (Solver.Sat m) ->
       let l =
         List.map
@@ -265,7 +265,9 @@ let process_stmt (self : t) (stmt : Statement.t) : unit or_error =
     | _ -> Error.errorf "cannot access model");
     E.return ()
   | Statement.Stmt_data ds ->
-    List.iter (fun d -> Solver.add_ty self.solver (Data_ty.data_as_ty d)) ds;
+    List.iter
+      (fun d -> Asolver.add_ty self.solver ~ty:(Data_ty.data_as_ty d))
+      ds;
     E.return ()
   | Statement.Stmt_define _ ->
     (* TODO *)

src/smtlib/Driver.mli

@@ -5,6 +5,7 @@
   calling "solve", etc.)
 *)
 
+module Asolver = Solver.Asolver
 open Sidekick_base
 
 val th_bool_dyn : Solver.theory
@@ -28,7 +29,7 @@ val create :
   ?time:float ->
   ?memory:float ->
   ?progress:bool ->
-  Solver.t ->
+  Asolver.t ->
   t
 
 val process_stmt : t -> Statement.t -> unit or_error

src/smtlib/check_cc.ml

@@ -44,7 +44,7 @@ let check_propagation si _cc p reason : unit =
         k "(@[check-cc-prop.ok@ @[%a => %a@]@])" pp_and reason Lit.pp p)
 
 let theory =
-  Solver.mk_theory ~name:"cc-check"
+  Solver.Smt_solver.Solver.mk_theory ~name:"cc-check"
     ~create_and_setup:(fun ~id:_ si ->
       let n_calls = Stat.mk_int (SI.stats si) "check-cc.call" in
       SI.on_cc_conflict si (fun { cc; th; c } ->

src/smtlib/check_cc.mli

@@ -1,2 +1,2 @@
-val theory : Solver.theory
+val theory : Solver.cdcl_theory
 (** theory that check validity of EUF conflicts, on the fly *)

src/smtlib/dune

@@ -4,5 +4,6 @@
  (synopsis "SMTLIB 2.6 driver for Sidekick")
  (private_modules Common_)
  (libraries containers zarith sidekick.core sidekick.util sidekick-base
+            sidekick.abstract-solver
    sidekick.mini-cc smtlib-utils sidekick.tef)
  (flags :standard -warn-error -a+8 -open Sidekick_util))

src/smtlib/solver.ml

@@ -1 +1,5 @@
-include Sidekick_base.Solver
+module Asolver = Sidekick_abstract_solver.Asolver
+module Smt_solver = Sidekick_smt_solver
+
+type t = Asolver.t
+type cdcl_theory = Smt_solver.theory