diff --git a/src/sat/Internal.ml b/src/sat/Internal.ml index ba6a56ff..ed68885f 100644 --- a/src/sat/Internal.ml +++ b/src/sat/Internal.ml @@ -959,7 +959,6 @@ module Make (Th : Theory_intf.S) = struct Vec.shrink st.elt_levels lvl; Vec.shrink st.backtrack_levels lvl; (* Recover the right theory state. *) - Th.reset_tasks (theory st); backtrack_down_to st b_lvl; ); assert (Vec.size st.elt_levels = Vec.size st.backtrack_levels); diff --git a/src/sat/Theory_intf.ml b/src/sat/Theory_intf.ml index 85d0c8c7..23780c69 100644 --- a/src/sat/Theory_intf.ml +++ b/src/sat/Theory_intf.ml @@ -127,9 +127,6 @@ module type S = sig val add_formula : t -> formula -> unit (** Internalize formula for later use *) - val reset_tasks : t -> unit - (** Clear caches/queues (when we backtrack) *) - val if_sat : t -> formula slice_actions -> (formula, proof) res (** Called at the end of the search in case a model has been found. If no new clause is pushed, then 'sat' is returned, else search is resumed. *) diff --git a/src/smt/Congruence_closure.ml b/src/smt/Congruence_closure.ml index f9141d39..fc7e6ab7 100644 --- a/src/smt/Congruence_closure.ml +++ b/src/smt/Congruence_closure.ml @@ -111,14 +111,10 @@ let[@inline] find st (n:node) : repr = if n == n.n_root then n else find_rec st n let[@inline] find_tn cc (t:term) : repr = get_ cc t |> find cc -let[@inline] find_tt cc (t:term) : term = find_tn cc t |> Equiv_class.term let[@inline] same_class cc (n1:node)(n2:node): bool = Equiv_class.equal (find cc n1) (find cc n2) -let[@inline] same_class_t cc (t1:term)(t2:term): bool = - Equiv_class.equal (find_tn cc t1) (find_tn cc t2) - (* compute signature *) let signature cc (t:term): node Term.view option = let find = find_tn cc in @@ -132,11 +128,13 @@ let signature cc (t:term): node Term.view option = (* find whether the given (parent) term corresponds to some signature in [signatures_] *) -let find_by_signature cc (t:term) : repr option = match signature cc t with +let find_by_signature cc (t:term) : repr option = + match signature cc t with | None -> None | Some s -> Sig_tbl.get cc.signatures_tbl s -let add_signature cc (t:term) (r:node): unit = match signature cc t with +let add_signature cc (t:term) (r:node): unit = + match signature cc t with | None -> () | Some s -> (* add, but only if not present already *) @@ -148,7 +146,7 @@ let add_signature cc (t:term) (r:node): unit = match signature cc t with assert (same_class cc r r'); end -let is_done (cc:t): bool = +let[@inline] is_done (cc:t): bool = Vec.is_empty cc.pending && Vec.is_empty cc.combine @@ -231,7 +229,7 @@ let ps_clear (cc:t) = Vec.clear cc.ps_queue; () -let rec decompose_explain cc (e:explanation): unit = +let decompose_explain cc (e:explanation): unit = Log.debugf 5 (fun k->k "(@[cc.decompose_expl@ %a@])" Explanation.pp e); begin match e with | E_reduction -> () @@ -285,23 +283,8 @@ let explain_unfold ?(init=Lit.Set.empty) cc (e:explanation) : Lit.Set.t = decompose_explain cc e; explain_loop cc -let explain_unfold_seq ?(init=Lit.Set.empty) cc (seq:explanation Sequence.t): Lit.Set.t = - ps_clear cc; - cc.ps_lits <- init; - Sequence.iter (decompose_explain cc) seq; - explain_loop cc - -let explain_unfold_bag ?(init=Lit.Set.empty) cc (b:explanation Bag.t) : Lit.Set.t = - match b with - | Bag.E -> init - | Bag.L (E_lit lit) -> Lit.Set.add lit init - | _ -> - ps_clear cc; - cc.ps_lits <- init; - Sequence.iter (decompose_explain cc) (Bag.to_seq b); - explain_loop cc - -(* add [tag] to [n] +(* add [tag] to [n], indicating that [n] is distinct from all the other + nodes tagged with [tag] precond: [n] is a representative *) let add_tag_n cc (n:node) (tag:int) (expl:explanation) : unit = assert (is_root_ n); @@ -384,7 +367,6 @@ and update_combine cc = (* remove [ra.parents] from signature, put them into [st.pending] *) begin Bag.to_seq r_from.n_parents - |> Sequence.iter (fun parent -> push_pending cc parent) end; (* perform [union ra rb] *) @@ -426,7 +408,7 @@ and notify_merge cc (ra:repr) ~into:(rb:repr) (e:explanation): unit = A.on_merge ra rb e (* add [t] to [cc] when not present already *) -and add_new_term cc (t:term) : node = +and add_new_term_ cc (t:term) : node = assert (not @@ mem cc t); Log.debugf 15 (fun k->k "(@[cc.add_term@ %a@])" Term.pp t); let n = Equiv_class.make t in @@ -466,7 +448,7 @@ and add_new_term cc (t:term) : node = (* add a term *) and[@inline] add_ cc t : node = try Term.Tbl.find cc.tbl t - with Not_found -> add_new_term cc t + with Not_found -> add_new_term_ cc t let add cc t : node = let n = add_ cc t in @@ -477,20 +459,6 @@ let add_seq cc seq = seq (fun t -> ignore @@ add_ cc t); update_pending cc -let union cc (a:node) (b:node) (e:Lit.t list): unit = - if not (same_class cc a b) then ( - let e = Explanation.E_lits e in - push_combine cc a b e; (* start by merging [a=b] *) - update_combine cc - ) - -(* to do after backtracking: reset task lists *) -let reset_tasks cc : unit = - Vec.iter (Equiv_class.set_field Equiv_class.field_is_pending false) cc.pending; - Vec.clear cc.pending; - Vec.clear cc.combine; - () - (* assert that this boolean literal holds *) let assert_lit cc lit : unit = let t = Lit.view lit in @@ -505,7 +473,7 @@ let assert_lit cc lit : unit = the corresponding value, so its superterms (like [ite]) can evaluate properly *) push_combine cc n rhs (E_lit lit); - update_pending cc + update_combine cc let assert_eq cc (t:term) (u:term) e : unit = let n1 = add_ cc t in @@ -538,27 +506,6 @@ let assert_distinct cc (l:term list) ~neq (lit:Lit.t) : unit = List.iter (fun (_,n) -> add_tag_n cc n tag @@ Explanation.lit lit) l end -(* handling "distinct" constraints *) -module Distinct_ = struct - module Int_set = Util.Int_set - - type Equiv_class.payload += - | P_dist of { - mutable tags: Int_set.t; - } - - let add_tag (tag:int) (n:Equiv_class.t) : unit = - if not @@ - CCList.exists - (function - | P_dist r -> r.tags <- Int_set.add tag r.tags; true - | _ -> false) - (Equiv_class.payload n) - then ( - Equiv_class.set_payload n (P_dist {tags=Int_set.singleton tag}) - ) -end - let create ?(size=2048) ~actions (tst:Term.state) : t = let nd = Equiv_class.dummy in let cc = { @@ -576,10 +523,6 @@ let create ?(size=2048) ~actions (tst:Term.state) : t = cc.true_ <- add cc (Term.true_ tst); cc.false_ <- add cc (Term.false_ tst); cc -(* check satisfiability, update congruence closure *) -let check (cc:t) : unit = - Log.debug 5 "(cc.check)"; - update_pending cc let final_check cc : unit = Log.debug 5 "(CC.final_check)"; diff --git a/src/smt/Congruence_closure.mli b/src/smt/Congruence_closure.mli index 71ab2834..235c1aad 100644 --- a/src/smt/Congruence_closure.mli +++ b/src/smt/Congruence_closure.mli @@ -41,15 +41,6 @@ val create : val find : t -> node -> repr (** Current representative *) -val same_class : t -> node -> node -> bool -(** Are these two classes the same in the current CC? *) - -val union : t -> node -> node -> Lit.t list -> unit -(** Merge the two equivalence classes. Will be undone on backtracking. *) - -val mem : t -> term -> bool -(** Is the term properly added to the congruence closure? *) - val add : t -> term -> node (** Add the term to the congruence closure, if not present already. Will be backtracked. *) @@ -71,25 +62,9 @@ val assert_distinct : t -> term list -> neq:term -> Lit.t -> unit with explanation [e] precond: [u = distinct l] *) -val reset_tasks : t -> unit -(** Reset the queue of pending tasks *) - -val check : t -> unit - val final_check : t -> unit -val explain_eq_n : ?init:Lit.Set.t -> t -> node -> node -> Lit.Set.t -(** explain why the two nodes are equal *) - -val explain_eq_t : ?init:Lit.Set.t -> t -> term -> term -> Lit.Set.t -(** explain why the two terms are equal *) - -val explain_unfold_bag : ?init:Lit.Set.t -> t -> explanation Bag.t -> Lit.Set.t - -val explain_unfold_seq : ?init:Lit.Set.t -> t -> explanation Sequence.t -> Lit.Set.t -(** Unfold those explanations into a complete set of - literals implying them *) - +val mk_model : t -> Model.t -> Model.t (** Enrich a model by mapping terms to their representative's value, if any. Otherwise map the representative to a fresh value *) -val mk_model : t -> Model.t -> Model.t + diff --git a/src/smt/Theory_combine.ml b/src/smt/Theory_combine.ml index 08304b9c..70001fd3 100644 --- a/src/smt/Theory_combine.ml +++ b/src/smt/Theory_combine.ml @@ -53,7 +53,6 @@ let assume_lit (self:t) (lit:Lit.t) : unit = | _ -> (* transmit to theories. *) C_clos.assert_lit (cc self) lit; - C_clos.check (cc self); theories self (fun (module Th) -> Th.on_assert Th.state lit); end @@ -71,10 +70,6 @@ let cdcl_return_res (self:t) : _ Sat_solver.res = Sat_solver.Unsat (IArray.to_list conflict_clause, Proof.default) end -let[@inline] check (self:t) : unit = - Log.debug 5 "(th_combine.check)"; - C_clos.check (cc self) - let with_conflict_catch self f = begin try @@ -91,11 +86,7 @@ let assume_real (self:t) (slice:Lit.t Sat_solver.slice_actions) = let (module SA) = slice in Log.debugf 5 (fun k->k "(th_combine.assume :len %d)" (Sequence.length @@ SA.slice_iter)); with_conflict_catch self - (fun () -> - SA.slice_iter (assume_lit self); - (* now check satisfiability *) - check self - ) + (fun () -> SA.slice_iter (assume_lit self)) let add_formula (self:t) (lit:Lit.t) = let t = Lit.view lit in @@ -224,6 +215,3 @@ let add_theory (self:t) (th:Theory.t) : unit = self.theories <- th_s :: self.theories let add_theory_l self = List.iter (add_theory self) - -let reset_tasks self = - Congruence_closure.reset_tasks (cc self)