wip: functorize theories wrt some "env"

src/smt/CC.ml

@@ -13,6 +13,6 @@ module Arg = struct
   end
 end
 
-include Sidekick_cc.Make(Arg)
+(* include Sidekick_cc.Make(Arg) *)
 
 module Mini_cc = Sidekick_cc.Mini_cc.Make(Arg)

src/smt/CC.mli

@@ -1,3 +1,4 @@
+(*
 
 include Sidekick_cc.S
   with type term = Term.t
@@ -8,6 +9,7 @@ include Sidekick_cc.S
    and type proof = Solver_types.proof
    and module Key = Sidekick_cc.Key
 
+*)
 module Mini_cc : Sidekick_cc.Mini_cc.S
   with type term = Term.t
    and type fun_ = Cst.t

src/smt/Theory.ml

@@ -1,8 +1,15 @@
 
-module Th_clause : sig
+(** {1 All the context for a theory} *)
+module type ENV = sig
+  include Sidekick_cc.TERM_LIT
+  module CC : Sidekick_cc.S
+                
+  (* TODO: useful?
+  module Th_clause : sig
     type t = Lit.t IArray.t
     val pp : t CCFormat.printer
-end = struct
+  end
+     = struct
     type t = Lit.t IArray.t
 
     let pp out c =
@@ -12,17 +19,15 @@ end = struct
         Format.fprintf out "[@[<hv>%a@]]"
           (Util.pp_iarray ~sep:" ∨ " Lit.pp) c
       )
-end
+  end
+  *)
 
-(** Unsatisfiable conjunction.
+  (** Unsatisfiable conjunction.
       Its negation will become a conflict clause *)
-type conflict = Lit.t list
+  type conflict = Lit.t list
 
-module CC_eq_class = CC.N
+  (** {3 Actions available to some of the theory's callbacks} *)
-module CC_expl = CC.Expl
+  module type ACTIONS = sig
-
-(** Actions available to a theory during its lifetime *)
-module type ACTIONS = sig
     val cc : CC.t
 
     val raise_conflict: conflict -> 'a
@@ -47,11 +52,33 @@ module type ACTIONS = sig
     val add_persistent_axiom: Lit.t list -> unit
     (** Add toplevel clause to the SAT solver. This clause will
         not be backtracked. *)
-end
+  end
 
-type actions = (module ACTIONS)
+  type actions = (module ACTIONS)
 
-module type S = sig
+  (** {3 Context given to a theory} *)
+  module Ctx : sig
+    type t
+
+    val cc : t -> CC.t
+
+    val on_partial_check : t -> (actions -> Lit.t Iter.t -> unit) -> unit
+    (** Called when a literal becomes true *)
+
+    val on_final_check: t -> (actions -> Lit.t Iter.t -> unit) -> unit
+    (** Final check, must be complete (i.e. must raise a conflict
+        if the set of literals is not satisfiable) *)
+
+    val on_mk_model : t -> (Lit.t Iter.t -> Model.t -> Model.t) -> unit
+    (** Update the given model *)
+
+    (**/**)
+    val on_check_invariants : t -> (unit -> unit) -> unit
+    (**/**)
+  end
+
+  (** {3 A theory's state} *)
+  module type THEORY = sig
     type t
 
     val name : string
@@ -60,38 +87,19 @@ module type S = sig
     val create : Term.state -> t
     (** Instantiate the theory's state *)
 
-  val on_new_term : t -> actions -> Term.t -> unit
+    val setup : t -> Ctx.t -> unit
-  (** Called when a new term is added *)
+    (** Setup the theory with the given context, including a
-
+        congruence closure *)
-  val on_merge: t -> actions -> CC_eq_class.t -> CC_eq_class.t -> CC_expl.t -> unit
-  (** Called when two classes are merged *)
-
-  val partial_check : t -> actions -> Lit.t Iter.t -> unit
-  (** Called when a literal becomes true *)
-
-  val final_check: t -> actions -> Lit.t Iter.t -> unit
-  (** Final check, must be complete (i.e. must raise a conflict
-      if the set of literals is not satisfiable) *)
-
-  val mk_model : t -> Lit.t Iter.t -> Model.t -> Model.t
-  (** Make a model for this theory's terms *)
 
     val push_level : t -> unit
 
     val pop_levels : t -> int -> unit
+  end
 
-  val cc_th : t -> CC.Theory.t list
+  type theory = (module THEORY)
 
-  (**/**)
+  (* TODO: remove?
-  val check_invariants : t -> unit
+  let make
-  (**/**)
-end
-
-type t = (module S)
-
-type 'a t1 = (module S with type t = 'a)
-
-let make
     (type st)
       ?(check_invariants=fun _ -> ())
       ?(on_new_term=fun _ _ _ -> ())
@@ -120,3 +128,5 @@ let make
       let cc_th = cc_th
     end in
     (module A : S)
+  *)
+end