Changed internal representation of proofs

.merlin

@@ -2,9 +2,11 @@ S sat
 S smt
 S solver
 S util
+S backend
 
 B _build/
 B _build/sat
 B _build/smt
 B _build/solver
 B _build/util
+B _build/backend

Makefile

@@ -3,7 +3,7 @@
 LOG=build.log
 COMP=ocamlbuild -log $(LOG) -use-ocamlfind -classic-display
 FLAGS=
-DIRS=-Is solver,sat,smt,util,util/smtlib
+DIRS=-Is solver,sat,smt,backend,util,util/smtlib
 DOC=msat.docdir/index.html
 TEST=sat_solve.native
 

_tags

@@ -3,6 +3,7 @@
 <smt/*.cmx>: for-pack(Msat)
 <sat/*.cmx>: for-pack(Msat)
 <solver/*.cmx>: for-pack(Msat)
+<backend/*.cmx>: for-pack(Msat)
 
 # enable stronger inlining everywhere
 <util/{vec,hashcons,hstring,iheap}.cmx>: inline(100)

msat.mlpack

@@ -16,6 +16,9 @@ Solver
 Mcsolver
 Solver_types
 
+# Backends
+Dedukti
+
 # Auxiliary modules
 Res
 Tseitin

msat.odocl

@@ -22,3 +22,5 @@ solver/Tseitin
 solver/Tseitin_intf
 
 sat/Sat
+
+backend/Dedukti

solver/internal.ml

@@ -395,7 +395,6 @@ module Make (L : Log_intf.S)(St : Solver_types.S)
       (* visit the current predecessors *)
       for j = 0 to Vec.size !c.atoms - 1 do
         let q = Vec.get !c.atoms j in
-        (*printf "I visit %a@." D1.atom q;*)
         assert (q.is_true || q.neg.is_true && q.var.level >= 0); (* Pas sur *)
         if not q.var.seen && q.var.level > 0 then begin
           var_bump_activity q.var;

solver/res.ml

@@ -218,25 +218,25 @@ module Make(L : Log_intf.S)(St : Solver_types.S) = struct
     conclusion : clause;
     step : step;
   }
-  and proof = unit -> proof_node
+  and proof = clause * atom list
   and step =
     | Hypothesis
     | Lemma of lemma
     | Resolution of proof * proof * atom
 
-  let rec return_proof (c, cl) () =
+  let expand (c, cl) =
     L.debug 8 "Returning proof for : %a" St.pp_clause c;
     let st = match H.find proof cl with
       | Assumption -> Hypothesis
       | Lemma l -> Lemma l
       | Resolution (a, cl_c, cl_d) ->
-        Resolution (return_proof cl_c, return_proof cl_d, a)
+        Resolution (cl_c, cl_d, a)
     in
     { conclusion = c; step = st }
 
   let prove_unsat c =
     assert_can_prove_unsat c;
-    return_proof (St.empty_clause, [])
+    (St.empty_clause, [])
 
   (* Compute unsat-core *)
   let compare_cl c d =
@@ -253,7 +253,7 @@ module Make(L : Log_intf.S)(St : Solver_types.S) = struct
 
   let unsat_core proof =
     let rec aux acc proof =
-      let p = proof () in
+      let p = expand proof in
       match p.step with
       | Hypothesis | Lemma _ -> p.conclusion :: acc
       | Resolution (proof1, proof2, _) ->
@@ -261,7 +261,8 @@ module Make(L : Log_intf.S)(St : Solver_types.S) = struct
     in
     sort_uniq compare_cl (aux [] proof)
 
-  (* Print proof graph *)
+  (* Dot proof printing *)
+  module Dot = struct
     let _i = ref 0
     let new_id () = incr _i; "id_" ^ (string_of_int !_i)
 
@@ -348,8 +349,8 @@ module Make(L : Log_intf.S)(St : Solver_types.S) = struct
               print_clause p.conclusion
               "Resolution" St.(p.conclusion.name)
           in
-        let p1 = proof1 () in
+          let p1 = expand proof1 in
-        let p2 = proof2 () in
+          let p2 = expand proof2 in
           Format.fprintf fmt "%a%a%a%a"
             (print_dot_rule (color p.conclusion.St.name) aux ()) p.conclusion
             (print_res_node p.conclusion p1.conclusion p2.conclusion) a
@@ -357,9 +358,12 @@ module Make(L : Log_intf.S)(St : Solver_types.S) = struct
             print_dot_proof p2
       end
 
-  let print_dot fmt proof =
+    let print fmt proof =
       clear_ids ();
-    Format.fprintf fmt "digraph proof {@\n%a@\n}@." print_dot_proof (proof ())
+      Format.fprintf fmt "digraph proof {@\n%a@\n}@." print_dot_proof (expand proof)
+  end
+
+  let print_dot = Dot.print
 
 end
 

solver/res_intf.ml

@@ -15,18 +15,18 @@ module type S = sig
   type atom
   type clause
   type lemma
-  (** Abstract types for atoms, clauses and theoriy-specific lemmas *)
+  (** Abstract types for atoms, clauses and theory-specific lemmas *)
 
-  type proof_node = {
+  type proof
+  and proof_node = {
     conclusion : clause;
     step : step;
   }
-  and proof = unit -> proof_node
   and step =
     | Hypothesis
     | Lemma of lemma
     | Resolution of proof * proof * atom
-  (** Lazy type for proof trees. *)
+  (** Lazy type for proof trees. Proofs can be extended to proof nodes using functions defined later. *)
 
   (** {3 Resolution helpers} *)
   val to_list : clause -> atom list
@@ -67,10 +67,18 @@ module type S = sig
       the proof if it succeeds.
       @raise Insuficient_hyps if it does not succeed. *)
 
+  (** {3 Proof Manipulation} *)
+
+  val expand : proof -> proof_node
+  (** Return the proof step at the root of a given proof. *)
+
   val unsat_core : proof -> clause list
   (** Returns the unsat_core of the given proof, i.e the lists of conclusions of all leafs of the proof. *)
 
   val print_dot : Format.formatter -> proof -> unit
-  (** Print the given proof in dot format on the given formatter. *)
+  (** Print the given proof in dot format on the given formatter.
+      @deprecated *)
+
+  module Dot : Backend_intf.S with type t := proof
 
 end