diff --git a/src/core/internal.ml b/src/core/internal.ml index f8734758..0266f9c7 100644 --- a/src/core/internal.ml +++ b/src/core/internal.ml @@ -907,9 +907,19 @@ module Make be done *) Stack.push c env.clauses_to_add - let slice_propagate f l = - let a = atom f in - enqueue_semantic a l + let slice_propagate f = function + | Plugin_intf.Eval l -> + let a = atom f in + enqueue_semantic a l + | Plugin_intf.Consequence (causes, proof) -> + let l = List.rev_map atom causes in + if List.for_all (fun a -> a.is_true) l then + let p = atom f in + let c = make_clause (fresh_tname ()) + (p :: List.map (fun a -> a.neg) l) (Lemma proof) in + enqueue_bool p (decision_level ()) (Bcp c) + else + raise (Invalid_argument "Msat.Internal.slice_propagate") let current_slice (): (_,_,_) Plugin_intf.slice = { Plugin_intf.start = env.th_head; diff --git a/src/core/plugin_intf.ml b/src/core/plugin_intf.ml index 2c2d703b..8ff1cdbd 100644 --- a/src/core/plugin_intf.ml +++ b/src/core/plugin_intf.ml @@ -53,6 +53,14 @@ type ('term, 'formula) assumption = | Assign of 'term * 'term (** The first term is assigned to the second *) (** Asusmptions made by the core SAT solver. *) +type ('term, 'formula, 'proof) reason = + | Eval of 'term list + | Consequence of 'formula list * 'proof +(** The type of reasons for propagations of a formula [f]. + [Semantic lvl] means that [f] is true because of the assignments whose level is [<= lvl]. + [Consequence (l, p)] means that the formulas in [l] imply [f]. The proof should be a proof + of the clause "[l] implies [f]". *) + type ('term, 'formula, 'proof) slice = { start : int; (** Start of the slice *) length : int; (** Length of the slice *) @@ -60,7 +68,8 @@ type ('term, 'formula, 'proof) slice = { Should only be called on integers [i] s.t. [start <= i < start + length] *) push : 'formula list -> 'proof -> unit; (** Add a clause to the solver. *) - propagate : 'formula -> 'term list -> unit; (** Propagate a formula, i.e. the theory can + propagate : 'formula -> ('term, 'formula, 'proof) reason -> unit; + (** Propagate a formula, i.e. the theory can evaluate the formula to be true (see the definition of {!type:eval_res} *) } diff --git a/src/core/theory_intf.ml b/src/core/theory_intf.ml index 8df11c20..07fbc769 100644 --- a/src/core/theory_intf.ml +++ b/src/core/theory_intf.ml @@ -34,12 +34,17 @@ type ('formula, 'proof) res = ('formula, 'proof) Plugin_intf.res = current set of assumptions, i.e must have been encountered in a slice. *) type ('form, 'proof) slice = { - start : int; (** Start of the slice *) - length : int; (** Length of the slice *) - get : int -> 'form; (** Accesor for the formuals in the slice. - Should only be called on integers [i] s.t. - [start <= i < start + length] *) - push : 'form list -> 'proof -> unit; (** Allows to add to the solver a clause. *) + start : int; (** Start of the slice *) + length : int; (** Length of the slice *) + get : int -> 'form; (** Accesor for the formuals in the slice. + Should only be called on integers [i] s.t. + [start <= i < start + length] *) + push : 'form list -> 'proof -> unit; (** Allows to add to the solver a clause. *) + propagate : 'form -> 'form list -> 'proof -> unit; + (** [propagate lit causes proof] informs the solver to propagate [lit], with the reason + that the clause [causes => lit] is a theory tautology. It is faster than pushing + the associated clause but the clause will not be remembered by the sat solver, + i.e it will not be used by the solver to do boolean propagation. *) } (** The type for a slice. Slices are some kind of view of the current propagation queue. They allow to look at the propagated literals, diff --git a/src/solver/solver.ml b/src/solver/solver.ml index 8a25c126..8dfe2409 100644 --- a/src/solver/solver.ml +++ b/src/solver/solver.ml @@ -39,16 +39,22 @@ module Plugin(E : Formula_intf.S) let current_level = Th.current_level - let assume_get s i = - match s.Plugin_intf.get i with + let assume_get get = + function i -> + match get i with | Plugin_intf.Lit f -> f | _ -> assert false + let assume_propagate propagate = + fun f l proof -> + propagate f (Plugin_intf.Consequence (l, proof)) + let mk_slice s = { Theory_intf.start = s.Plugin_intf.start; length = s.Plugin_intf.length; - get = assume_get s; + get = assume_get s.Plugin_intf.get; push = s.Plugin_intf.push; + propagate = assume_propagate s.Plugin_intf.propagate; } let assume s = Th.assume (mk_slice s)