Solver module is now functorised. 'make' now compiles.

Makefile

@@ -18,6 +18,9 @@ $(LIB):
 doc:
 	$(COMP) $(FLAGS) $(DIRS) $(DOC)
 
+log:
+	cat _build/$(LOG) || true
+
 clean:
 	$(COMP) -clean
 

_tags

@@ -1,2 +1,3 @@
 <smt/*.cmx>: for-pack(Msat)
+<sat/*.cmx>: for-pack(Msat)
 

msat.mlpack

@@ -1,18 +1,5 @@
-Arith
-Cc
-Combine
-Exception
 Explanation
-Fm
+Formula_intf
-Intervals
-Literal
-Polynome
-Smt
 Solver
 Solver_types
-Sum
+Theory_intf
-Symbols
-Term
-Ty
-Uf
-Use

msat.odocl

@@ -1,15 +1,18 @@
+sat/Formula_intf
+sat/Explanation
+sat/Solver
+sat/Solver_types
+sat/Theory_intf
+
 smt/Arith
 smt/Cc
 smt/Combine
 smt/Exception
-smt/Explanation
 smt/Fm
 smt/Intervals
 smt/Literal
 smt/Polynome
 smt/Smt
-smt/Solver
-smt/Solver_types
 smt/Sum
 smt/Symbols
 smt/Term

sat/.merlin

@@ -2,3 +2,4 @@ S ./
 S ../common/
 
 B ../_build/
+B ../_build/common/

sat/explanation.ml

@@ -14,6 +14,8 @@
 
 open Format
 
+module type S = Explanation_intf.S
+
 module Make(Stypes : Solver_types.S) = struct
 
     type atom = Stypes.atom

sat/formula_intf.ml

@@ -17,12 +17,14 @@ module type S = sig
 
   type t
 
-  val vrai : t
+  val true_ : t
-  val faux : t
+  val false_ : t
   val dummy : t
 
   val neg : t -> t
+
   val norm : t -> t * bool
+  (** Returns a 'normalized' form of the formula, possibly negated *)
 
   val hash : t -> int
   val equal : t -> t -> bool
@@ -34,7 +36,6 @@ module type S = sig
   val print : Format.formatter -> t -> unit
 
   module Map : Map.S with type key = t
-  module Set : Set.S with type elt = t
 
 end
 

sat/solver.mli

@@ -11,9 +11,10 @@
 (*                                                                        *)
 (**************************************************************************)
 
-module Make (F : Formula_intf.S)(Th : Theory_intf.S with type formula = F.t) : sig
+module Make (F : Formula_intf.S)
-
+            (St : Solver_types.S with type formula = F.t)
-    module St : Solver_types.S with type formula = F.t
+            (Ex : Explanation.S with type atom = St.atom)
+            (Th : Theory_intf.S with type formula = F.t and type explanation = Ex.t) : sig
 
     exception Sat
     exception Unsat of St.clause list
@@ -29,3 +30,4 @@ module Make (F : Formula_intf.S)(Th : Theory_intf.S with type formula = F.t) : s
     val restore : state -> unit
 
 end
+

sat/solver_types.ml

@@ -21,8 +21,12 @@ let is_le n = Hstring.compare n ale = 0
 let is_lt n = Hstring.compare n alt = 0
 let is_gt n = Hstring.compare n agt = 0
 
+module type S = Solver_types_intf.S
+
 module Make (F : Formula_intf.S) = struct
 
+type formula = F.t
+
 type var =
     {  vid : int;
        pa : atom;
@@ -35,7 +39,7 @@ type var =
 
 and atom =
     { var : var;
-      lit : F.t;
+      lit : formula;
       neg : atom;
       mutable watched : clause Vec.t;
       mutable is_true : bool;
@@ -80,6 +84,7 @@ and dummy_clause =
     cpremise = [] }
 
 module MA = F.Map
+type varmap = var MA.t
 
 let ale = Hstring.make "<="
 let alt = Hstring.make "<"
@@ -174,8 +179,6 @@ let clear () =
   cpt_mk_var := 0;
   ma := MA.empty
 
-module Debug = struct
-
   let sign a = if a==a.var.pa then "" else "-"
 
   let level a =
@@ -196,25 +199,23 @@ module Debug = struct
     else if a.neg.is_true then sprintf ":0%s" (level a)
     else ":X"
 
-  let premise fmt v =
+  let pp_premise fmt v =
     List.iter (fun {name=name} -> fprintf fmt "%s," name) v
 
-  let atom fmt a =
+  let pp_atom fmt a =
     fprintf fmt "%s%d%s [lit:%a] vpremise={{%a}}"
       (sign a) (a.var.vid+1) (value a) F.print a.lit
-      premise a.var.vpremise
+      pp_premise a.var.vpremise
 
-  let atoms_list fmt l = List.iter (fprintf fmt "%a ; " atom) l
+  let pp_atoms_list fmt l = List.iter (fprintf fmt "%a ; " pp_atom) l
-  let atoms_array fmt arr = Array.iter (fprintf fmt "%a ; " atom) arr
+  let pp_atoms_array fmt arr = Array.iter (fprintf fmt "%a ; " pp_atom) arr
 
-  let atoms_vec fmt vec =
+  let pp_atoms_vec fmt vec =
     for i = 0 to Vec.size vec - 1 do
-      fprintf fmt "%a ; " atom (Vec.get vec i)
+      fprintf fmt "%a ; " pp_atom (Vec.get vec i)
     done
 
-  let clause fmt {name=name; atoms=arr; cpremise=cp} =
+  let pp_clause fmt {name=name; atoms=arr; cpremise=cp} =
-    fprintf fmt "%s:{ %a} cpremise={{%a}}" name atoms_vec arr premise cp
+    fprintf fmt "%s:{ %a} cpremise={{%a}}" name pp_atoms_vec arr pp_premise cp
-
-end
 
 end

sat/solver_types_intf.ml

@@ -48,8 +48,8 @@ module type S = sig
     and premise = clause list
 
     val cpt_mk_var : int ref
-    module Map : Map.S with type key = formula
+    type varmap
-    val ma : var Map.t ref
+    val ma : varmap ref
 
     val dummy_var : var
     val dummy_atom : atom

sat/theory_intf.ml

@@ -15,13 +15,11 @@
 module type S = sig
     type t
     type formula
+    type explanation
 
-    module St : Solver_types.S with type formula = formula
+    exception Inconsistent of explanation
-    module Ex : Explanation.S with type atom = St.atom
-
-    exception Inconsistent of Ex.t
 
     val empty : unit -> t
-    val assume : cs:bool -> formula -> Ex.t -> t -> t
+    val assume : cs:bool -> formula -> explanation -> t -> t
 end
 

smt/cc.ml

@@ -189,13 +189,13 @@ module Make (X : Sig.X) = struct
 	    | _ -> []
 
   let contra_congruence  =
-    let vrai,_ = X.make T.vrai in
+    let true_,_ = X.make T.true_ in
-    let faux, _ = X.make T.faux in
+    let false_, _ = X.make T.false_ in
     fun env r ex ->
-      if X.equal (fst (Uf.find_r env.uf r)) vrai then
+      if X.equal (fst (Uf.find_r env.uf r)) true_ then
-	  new_facts_by_contra_congruence env r T.faux ex
+	  new_facts_by_contra_congruence env r T.false_ ex
-      else if X.equal (fst (Uf.find_r env.uf r)) faux then
+      else if X.equal (fst (Uf.find_r env.uf r)) false_ then
-	  new_facts_by_contra_congruence env r T.vrai ex
+	  new_facts_by_contra_congruence env r T.true_ ex
       else []
 
   let clean_use =
@@ -518,7 +518,7 @@ module Make (X : Sig.X) = struct
     let t = { gamma = env; gamma_finite = env; choices = [] } in
     let t, _, _ =
       assume ~cs:false
-        (A.LT.make (A.Distinct (false, [T.vrai; T.faux]))) Ex.empty t
+        (A.LT.make (A.Distinct (false, [T.true_; T.false_]))) Ex.empty t
     in t
 
 end

smt/literal.ml

@@ -168,8 +168,8 @@ module type S_Term = sig
 
   val mk_pred : Term.t -> t
 
-  val vrai : t
+  val true_ : t
-  val faux : t
+  val false_ : t
 
 (*  val terms_of : t -> Term.Set.t
   val vars_of : t -> Symbols.Set.t
@@ -182,16 +182,16 @@ module LT : S_Term = struct
   module L = Make(Term)
   include L
 
-  let mk_pred t = make (Eq (t, Term.vrai) )
+  let mk_pred t = make (Eq (t, Term.true_) )
 
-  let vrai = mk_pred Term.vrai
+  let true_ = mk_pred Term.true_
-  let faux = mk_pred Term.faux
+  let false_ = mk_pred Term.false_
 
   let neg a = match view a with
-    | Eq(t1, t2) when Term.equal t2 Term.faux ->
+    | Eq(t1, t2) when Term.equal t2 Term.false_ ->
-      make (Eq (t1, Term.vrai))
+      make (Eq (t1, Term.true_))
-    | Eq(t1, t2) when Term.equal t2 Term.vrai ->
+    | Eq(t1, t2) when Term.equal t2 Term.true_ ->
-      make (Eq (t1, Term.faux))
+      make (Eq (t1, Term.false_))
     | _ -> L.neg a
 
 (* let terms_of a =

smt/literal.mli

@@ -53,8 +53,8 @@ module type S_Term = sig
   include S with type elt = Term.t
 
   val mk_pred : Term.t -> t
-  val vrai : t
+  val true_ : t
-  val faux : t
+  val false_ : t
 
 end
 

smt/smt.ml

@@ -274,8 +274,8 @@ end
       lift_ite sb l ty
     with Not_found -> raise (Error (UnknownSymb s))
 
-  let t_true = T AETerm.vrai
+  let t_true = T AETerm.true_
-  let t_false = T AETerm.faux
+  let t_false = T AETerm.false_
 
   let rec is_int = function
     | T t -> AETerm.is_int t
@@ -365,8 +365,8 @@ end
     | [f] -> print fmt f
     | f::l -> fprintf fmt "%a %s %a" print f sep (print_list sep) l
 
-  let f_true = Lit Literal.LT.vrai
+  let f_true = Lit Literal.LT.true_
-  let f_false = Lit Literal.LT.faux
+  let f_false = Lit Literal.LT.false_
 
   let make comb l = Comb (comb, l)
 
@@ -565,7 +565,7 @@ end
         [] Ty.Tbool
       in
       incr cpt;
-      Literal.LT.make (Literal.Eq (t, AETerm.vrai))
+      Literal.LT.make (Literal.Eq (t, AETerm.true_))
 
   module Tseitin (Dummy : sig end)= struct
     let acc_or = ref []

smt/term.ml

@@ -62,8 +62,8 @@ let compare t1 t2 =
 
 let make s l ty = T.hashcons {f=s;xs=l;ty=ty;tag=0 (* dumb_value *) }
 
-let vrai = make (Sy.True) [] Ty.Tbool
+let true_ = make (Sy.True) [] Ty.Tbool
-let faux = make (Sy.False) [] Ty.Tbool
+let false_ = make (Sy.False) [] Ty.Tbool
 
 let int i = make (Sy.int i) [] Ty.Tint
 let real r = make (Sy.real r) [] Ty.Treal

smt/term.mli

@@ -17,8 +17,8 @@ type view = private {f: Symbols.t ; xs: t list; ty: Ty.t; tag : int}
 val view : t -> view
 val make : Symbols.t -> t list -> Ty.t -> t
 
-val vrai : t
+val true_ : t
-val faux : t
+val false_ : t
 val int : string -> t
 val real : string -> t