diff --git a/smt/mcsat.ml b/smt/mcsat.ml index 68090667..2ed2022a 100644 --- a/smt/mcsat.ml +++ b/smt/mcsat.ml @@ -17,6 +17,9 @@ module Tsmt = struct type proof = unit + let proof_debug () = + "Proof", ["..."], Some "PURPLE" + type assumption = | Lit of formula | Assign of term * term diff --git a/solver/mcproof.ml b/solver/mcproof.ml index bc9cd0e4..8798cbb1 100644 --- a/solver/mcproof.ml +++ b/solver/mcproof.ml @@ -346,10 +346,14 @@ module Make(St : Mcsolver_types.S) = struct print_clause p.conclusion St.(p.conclusion.name) in print_dot_rule "BGCOLOR=\"LIGHTBLUE\"" aux () fmt p.conclusion - | Lemma _ -> + | Lemma proof -> + let name, args, color = St.proof_debug proof in + assert (args <> []); + let color = match color with None -> "YELLOW" | Some c -> c in let aux fmt () = - Format.fprintf fmt "%aLemma%s" - print_clause p.conclusion St.(p.conclusion.name) + Format.fprintf fmt "%a%s%a" + print_clause p.conclusion color (List.length args) name + (fun fmt -> List.iter (fun v -> Format.fprintf fmt "%a" St.print_semantic_var v)) args in print_dot_rule "BGCOLOR=\"LIGHTBLUE\"" aux () fmt p.conclusion | Resolution (proof1, proof2, a) -> diff --git a/solver/mcsolver_types.ml b/solver/mcsolver_types.ml index 4c6ba21e..3ea2f83f 100644 --- a/solver/mcsolver_types.ml +++ b/solver/mcsolver_types.ml @@ -212,6 +212,11 @@ module Make (E : Expr_intf.S)(Th : Plugin_intf.S with iter_map := Mi.add v.vid !l !iter_map; List.iter f !l + (* Proof debug info *) + let proof_debug p = + let name, l, color = Th.proof_debug p in + name, (List.map add_term l), color + (* Pretty printing for atoms and clauses *) let print_semantic_var fmt v = E.Term.print fmt v.tag.term diff --git a/solver/mcsolver_types_intf.ml b/solver/mcsolver_types_intf.ml index a0a313cc..10d504e5 100644 --- a/solver/mcsolver_types_intf.ml +++ b/solver/mcsolver_types_intf.ml @@ -96,6 +96,9 @@ module type S = sig val fresh_dname : unit -> string (** Fresh names for clauses *) + val proof_debug : proof -> string * (semantic var list) * (string option) + (** Debugging info for proofs (see Plugin_intf). *) + val print_atom : Format.formatter -> atom -> unit val print_semantic_var : Format.formatter -> semantic var -> unit val print_clause : Format.formatter -> clause -> unit diff --git a/solver/plugin_intf.ml b/solver/plugin_intf.ml index 3a4ba650..65e46908 100644 --- a/solver/plugin_intf.ml +++ b/solver/plugin_intf.ml @@ -78,5 +78,10 @@ module type S = sig val eval : formula -> eval_res (** Returns the evaluation of the formula in the current assignment *) + val proof_debug : proof -> string * (term list) * (string option) + (** Returns debugging information on a proof, as a triplet consisting of + a name/identification string associated with the proof, arguments of the proof, + and an optional color for the proof background *) + end