diff --git a/src/cdsat/TVar.ml b/src/cdsat/TVar.ml index 2629f108..f56c8dc8 100644 --- a/src/cdsat/TVar.ml +++ b/src/cdsat/TVar.ml @@ -124,6 +124,15 @@ let pp (self : store) out (v : t) : unit = (Term.pp_limit ~max_depth:5 ~max_nodes:30) t +let pp_with_assignment (self : store) out (v : t) : unit = + let t = term self v in + match value self v with + | Some value -> + Fmt.fprintf out "(@[var[%d]@ :term %a@ :value %a@ :level %d@])" v + (Term.pp_limit ~max_depth:5 ~max_nodes:30) + t Value.pp value (level self v) + | None -> pp self out v + module Tbl = Util.Int_tbl module Set = Util.Int_set module Map = Util.Int_map diff --git a/src/cdsat/TVar.mli b/src/cdsat/TVar.mli index 9e46e27b..d0e66a97 100644 --- a/src/cdsat/TVar.mli +++ b/src/cdsat/TVar.mli @@ -59,6 +59,7 @@ val pop_new_var : store -> t option (** Pop a new variable if any, or return [None] *) val pp : store -> t Fmt.printer +val pp_with_assignment : store -> t Fmt.printer module Tbl : CCHashtbl.S with type key = t module Set : CCSet.S with type elt = t diff --git a/src/cdsat/core.ml b/src/cdsat/core.ml index ee85f22d..598777a2 100644 --- a/src/cdsat/core.ml +++ b/src/cdsat/core.ml @@ -24,26 +24,32 @@ type plugin_id = int type plugin_event = .. -type watch_request = - | Watch2 of TVar.t array * plugin_event - | Watch1 of TVar.t array * plugin_event - module Watches = Watch_schemes.Make (struct type t = plugin_id * plugin_event end) +(* TODO: regular GC, where we remove variables with a low activity/high LBD (?) + that are also not assigned in current trail. + + need to cooperate with plugins to mark sub-variables kept alive by alive + variables. +*) + type t = { tst: Term.store; vst: TVar.store; arg: (module ARG); stats: Stat.t; - trail: Trail.t; - plugins: plugin Vec.t; - term_to_var: Term_to_var.t; + trail: Trail.t; (** partial model (stack of assigned variables) *) + plugins: plugin Vec.t; (** plugins registered to this solver *) + term_to_var: Term_to_var.t; (** convert terms to vars *) vars_to_decide: Vars_to_decide.t; - pending_assignments: pending_assignment Vec.t; + (** set of variables (potentially) undecided *) + added_vars: unit TVar.Tbl.t; (** set of variables added to all plugins *) + pending_assignments: pending_assignment Vec.t; (** assignments to process *) watches: Watches.t; mutable last_res: Check_res.t option; + (** last result, useful to get unsat core/model *) proof_tracer: Proof.Tracer.t; n_conflicts: int Stat.counter; n_propagations: int Stat.counter; @@ -53,8 +59,7 @@ type t = { and plugin_action = t * plugin_id (* FIXME: - - add [on_add_var: TVar.t -> unit] - and [on_remove_var: TVar.t -> unit]. + - add [on_remove_var: TVar.t -> unit]. these are called when a variable becomes relevant/is removed or GC'd (in particular: setup watches + var constraints on add, kill watches and remove constraints on remove) @@ -73,7 +78,9 @@ and plugin = on_assign: 'st -> plugin_action -> TVar.t -> Value.t -> unit; on_event: 'st -> plugin_action -> unit:bool -> plugin_event -> unit; term_to_var_hooks: 'st -> Term_to_var.hook list; - on_add_var: 'st -> TVar.t -> watch_request list; + iter_theory_view: 'st -> TVar.theory_view -> TVar.t Iter.t; + (** return [true] if it iterated *) + on_add_var: 'st -> plugin_action -> TVar.t -> unit; } -> plugin @@ -88,6 +95,7 @@ let create ?(stats = Stat.create ()) ~arg tst vst ~proof_tracer () : t = pending_assignments = Vec.create (); term_to_var = Term_to_var.create vst; vars_to_decide = Vars_to_decide.create (); + added_vars = TVar.Tbl.create 32; watches = Watches.create vst; last_res = None; proof_tracer; @@ -113,13 +121,9 @@ module Plugin = struct type nonrec event = plugin_event = .. - type nonrec watch_request = watch_request = - | Watch2 of TVar.t array * event - | Watch1 of TVar.t array * event - - let make_builder ~name ~create ~push_level ~pop_levels + let make_builder ~name ~create ~push_level ~pop_levels ~iter_theory_view ?(decide = fun _ _ -> None) ?(on_assign = fun _ _ _ _ -> ()) - ?(on_event = fun _ _ ~unit:_ _ -> ()) ?(on_add_var = fun _ _ -> []) + ?(on_event = fun _ _ ~unit:_ _ -> ()) ?(on_add_var = fun _ _ _ -> ()) ?(term_to_var_hooks = fun _ -> []) () : builder = fun ~id vst -> let st = create vst in @@ -131,6 +135,7 @@ module Plugin = struct push_level; pop_levels; decide; + iter_theory_view; on_assign; on_event; term_to_var_hooks; @@ -159,6 +164,7 @@ let pop_levels (self : t) n : unit = term_to_var = _; watches = _; vars_to_decide = _; + added_vars = _; pending_assignments; last_res = _; proof_tracer = _; @@ -200,7 +206,7 @@ let add_ty (_self : t) ~ty:_ : unit = () (** Assign [v <- value] for [reason] at [level]. This assignment is delayed. *) -let assign (self : t) (v : TVar.t) ~(value : Value.t) ~level:v_level ~reason : +let assign_ (self : t) (v : TVar.t) ~(value : Value.t) ~level:v_level ~reason : unit = Log.debugf 50 (fun k -> k "(@[cdsat.core.assign@ `%a`@ @[<- %a@]@ :reason %a@])" @@ -208,6 +214,21 @@ let assign (self : t) (v : TVar.t) ~(value : Value.t) ~level:v_level ~reason : self.last_res <- None; Vec.push self.pending_assignments { var = v; value; level = v_level; reason } +let rec add_var_ (self : t) (v : TVar.t) : unit = + if not (TVar.Tbl.mem self.added_vars v) then ( + Log.debugf 50 (fun k -> k "(@[cdsat.add-var@ %a@])" (TVar.pp self.vst) v); + TVar.Tbl.add self.added_vars v (); + Vars_to_decide.add self.vars_to_decide v; + + (* add variable to plugins *) + iter_plugins self ~f:(fun (P p) -> p.on_add_var p.st (self, p.id) v); + + (* add sub-variables as well *) + let tview = TVar.theory_view self.vst v in + iter_plugins self ~f:(fun (P p) -> + p.iter_theory_view p.st tview (fun sub -> add_var_ self sub)) + ) + exception E_conflict of Conflict.t let raise_conflict (c : Conflict.t) : 'a = raise (E_conflict c) @@ -255,9 +276,6 @@ let propagate (self : t) : Conflict.t option = while Trail.head self.trail < Trail.size self.trail do let var = Trail.get self.trail (Trail.head self.trail) in - (* TODO: call plugins *) - Log.debugf 0 (fun k -> k "TODO: propagate %a" (TVar.pp self.vst) var); - let value = match TVar.value self.vst var with | Some v -> v @@ -314,13 +332,18 @@ let rec decide (self : t) : [ `Decided | `Full_model ] = Error.errorf "no plugin can decide %a" (TVar.pp self.vst) v with Decided value -> - Trail.push_level self.trail; let level = Trail.n_levels self.trail in + Trail.push_level self.trail; Log.debugf 5 (fun k -> k "(@[cdsat.new-level %d@])" level); - assign self v ~value ~level ~reason:(Reason.decide level); + assign_ self v ~value ~level ~reason:(Reason.decide level); `Decided ) +let assign (self : t) v ~value ~reason : unit = + let level = Reason.level reason in + add_var_ self v; + assign_ self v ~value ~level ~reason + (** Solve satisfiability of the current set of assertions *) let solve ~on_exit ~on_progress ~should_stop ~assumptions (self : t) : Check_res.t = @@ -357,6 +380,9 @@ let solve ~on_exit ~on_progress ~should_stop ~assumptions (self : t) : (match decide self with | `Decided -> () | `Full_model -> + Log.debugf 50 (fun k -> + k "(@[cdsat.sat.full-trail@ %a@])" (Trail.pp_full self.vst) + self.trail); let sat = make_sat_res self in res := Check_res.Sat sat; @@ -382,11 +408,12 @@ module Plugin_action = struct type t = plugin_action let[@inline] propagate ((self, _) : t) var value reason : unit = - assign self var ~value ~level:(Reason.level reason) ~reason + assign_ self var ~value ~level:(Reason.level reason) ~reason let term_to_var (self, _) t : TVar.t = term_to_var self t - let watch1 ((self, pl_id) : t) (vars : _ array) (ev : plugin_event) : unit = + let watch1 ((self, pl_id) : t) (vars : TVar.t list) (ev : plugin_event) : unit + = let _h : Watches.handle = Watches.watch1 self.watches vars (pl_id, ev) ~f:(fun ~unit (_, ev) -> let (P p) = get_plugin self pl_id in @@ -395,7 +422,8 @@ module Plugin_action = struct in () - let watch2 ((self, pl_id) : t) (vars : _ array) (ev : plugin_event) : unit = + let watch2 ((self, pl_id) : t) (vars : TVar.t list) (ev : plugin_event) : unit + = let _h : Watches.handle = Watches.watch2 self.watches vars (pl_id, ev) ~f:(fun ~unit (_, ev) -> let (P p) = get_plugin self pl_id in diff --git a/src/cdsat/core.mli b/src/cdsat/core.mli index badf5dbf..0e3d01b6 100644 --- a/src/cdsat/core.mli +++ b/src/cdsat/core.mli @@ -23,11 +23,11 @@ module Plugin_action : sig val term_to_var : t -> Term.t -> TVar.t (** Convert a term to a variable *) - val watch1 : t -> TVar.t array -> plugin_event -> unit + val watch1 : t -> TVar.t list -> plugin_event -> unit (** Create a watcher for the given set of variables, which will trigger the event *) - val watch2 : t -> TVar.t array -> plugin_event -> unit + val watch2 : t -> TVar.t list -> plugin_event -> unit (** Create a watcher for the given set of variables, which will trigger the event *) end @@ -41,19 +41,16 @@ module Plugin : sig type event = plugin_event = .. - type watch_request = - | Watch2 of TVar.t array * event - | Watch1 of TVar.t array * event - val make_builder : name:string -> create:(TVar.store -> 'st) -> push_level:('st -> unit) -> pop_levels:('st -> int -> unit) -> + iter_theory_view:('st -> TVar.theory_view -> TVar.t Iter.t) -> ?decide:('st -> TVar.t -> Value.t option) -> ?on_assign:('st -> Plugin_action.t -> TVar.t -> Value.t -> unit) -> ?on_event:('st -> Plugin_action.t -> unit:bool -> event -> unit) -> - ?on_add_var:('st -> TVar.t -> watch_request list) -> + ?on_add_var:('st -> Plugin_action.t -> TVar.t -> unit) -> ?term_to_var_hooks:('st -> Term_to_var.hook list) -> unit -> builder @@ -94,8 +91,7 @@ val add_term_to_var_hook : t -> Term_to_var.hook -> unit (** {2 Main solving API} *) -val assign : - t -> TVar.t -> value:Value.t -> level:int -> reason:Reason.t -> unit +val assign : t -> TVar.t -> value:Value.t -> reason:Reason.t -> unit val solve : on_exit:(unit -> unit) list -> diff --git a/src/cdsat/plugin_bool.ml b/src/cdsat/plugin_bool.ml index 6c38184d..e8f6844f 100644 --- a/src/cdsat/plugin_bool.ml +++ b/src/cdsat/plugin_bool.ml @@ -32,13 +32,26 @@ let decide (self : t) (v : TVar.t) : Value.t option = Some (Term.true_ self.tst) | _ -> None -let on_assign (self : t) (act : Core.Plugin_action.t) (v : TVar.t) - (value : Value.t) : unit = - Log.debugf 0 (fun k -> - k "(@[bool-plugin.on-assign %a@])" (TVar.pp self.vst) v); - () +type Core.Plugin.event += Eval of TVar.t | BCP of TVar.t -(* TODO: BCP via on_event *) +(* create watch *) +let on_add_var (self : t) acts (v : TVar.t) : unit = + match TVar.theory_view self.vst v with + | T_and lits | T_or lits -> + let vars_of_lits = Util.array_to_list_map TLit.var lits in + Core.Plugin_action.watch1 acts vars_of_lits (Eval v); + Core.Plugin_action.watch2 acts (v :: vars_of_lits) (BCP v) + | _ -> () + +let on_event (self : t) acts ~unit (ev : Core.Plugin.event) : unit = + match ev with + | Eval v -> + (* TODO: evaluate [v] *) + Log.debugf 1 (fun k -> k "(@[cdsat.bool.eval@ %a@])" (TVar.pp self.vst) v) + | BCP v -> + (* TODO: check if we can eval *) + Log.debugf 1 (fun k -> k "(@[cdsat.bool.bcp@ %a@])" (TVar.pp self.vst) v) + | _ -> () let term_to_var_hooks (self : t) : _ list = let (module A) = self.arg in @@ -67,10 +80,15 @@ let term_to_var_hooks (self : t) : _ list = in [ h ] +let iter_theory_view _ (v : TVar.theory_view) k = + match v with + | T_and lits | T_or lits -> Array.iter (fun { TLit.var; _ } -> k var) lits + | _ -> () + let builder ((module A : ARG) as arg) : Core.Plugin.builder = let create vst : t = let tst = TVar.Store.tst vst in { arg; vst; tst } in - Core.Plugin.make_builder ~name:"bool" ~create ~push_level ~pop_levels ~decide - ~on_assign ~term_to_var_hooks () + Core.Plugin.make_builder ~name:"bool" ~create ~push_level ~pop_levels + ~iter_theory_view ~decide ~on_add_var ~on_event ~term_to_var_hooks () diff --git a/src/cdsat/plugin_uninterpreted.ml b/src/cdsat/plugin_uninterpreted.ml index e169e06d..2f39f056 100644 --- a/src/cdsat/plugin_uninterpreted.ml +++ b/src/cdsat/plugin_uninterpreted.ml @@ -62,8 +62,14 @@ let term_to_var_hooks (self : t) : _ list = in [ h ] +let iter_theory_view _ (v : TVar.theory_view) k : unit = + match v with + | Unin_const _ -> () + | Unin_fun { f = _; args } -> Array.iter k args + | _ -> () + (* TODO: congruence rules *) let builder ((module A : ARG) as arg) : Core.Plugin.builder = Core.Plugin.make_builder ~name:"uf" ~create:(create arg) ~push_level - ~pop_levels ~decide ~on_assign ~term_to_var_hooks () + ~pop_levels ~iter_theory_view ~decide ~on_assign ~term_to_var_hooks () diff --git a/src/cdsat/solver.ml b/src/cdsat/solver.ml index 99728b09..8824beff 100644 --- a/src/cdsat/solver.ml +++ b/src/cdsat/solver.ml @@ -57,7 +57,6 @@ let assert_term_ (self : t) (t : Term.t) pr : unit = let pr = Proof.Tracer.add_step self.proof_tracer pr in Core.assign self.core v ~value:(Term.bool_val self.tst sign) - ~level:0 ~reason:(Reason.propagate_l self.vst [] pr) | Some value when Term.is_true value && sign -> () | Some value when Term.is_false value && not sign -> () diff --git a/src/cdsat/trail.ml b/src/cdsat/trail.ml index dbcf0750..1442c553 100644 --- a/src/cdsat/trail.ml +++ b/src/cdsat/trail.ml @@ -28,3 +28,8 @@ let pop_levels (self : t) (n : int) ~f : unit = (* also reset head *) if self.head > idx then self.head <- idx ) + +let pp_full vst out (self : t) : unit = + Fmt.fprintf out "(@[trail@ %a@])" + (Util.pp_iter (TVar.pp_with_assignment vst)) + (VVec.to_iter self.vars) diff --git a/src/cdsat/trail.mli b/src/cdsat/trail.mli index 877c3663..57e00128 100644 --- a/src/cdsat/trail.mli +++ b/src/cdsat/trail.mli @@ -10,3 +10,5 @@ val head : t -> int val set_head : t -> int -> unit include Sidekick_sigs.BACKTRACKABLE0_CB with type t := t and type elt := TVar.t + +val pp_full : TVar.store -> t Fmt.printer diff --git a/src/cdsat/watch_schemes.ml b/src/cdsat/watch_schemes.ml index 9823f956..e6e65994 100644 --- a/src/cdsat/watch_schemes.ml +++ b/src/cdsat/watch_schemes.ml @@ -79,7 +79,8 @@ struct let vec = Handle_v_map.get self.by_var v in Veci.push vec h - let watch1 (self : t) (arr : TVar.t array) (ev : Ev.t) ~(f : cb_) : handle = + let watch1 (self : t) (vars : TVar.t list) (ev : Ev.t) ~(f : cb_) : handle = + let arr = Array.of_list vars in let h = make_watch_ self (Watch1 { arr; ev }) in let i, all_set = find_watch_ self.vst arr ~idx0:0 in (* put watched var first *) @@ -88,7 +89,8 @@ struct if all_set then f ~unit:false ev; h - let watch2 (self : t) (arr : TVar.t array) (ev : Ev.t) ~(f : cb_) : handle = + let watch2 (self : t) (vars : TVar.t list) (ev : Ev.t) ~(f : cb_) : handle = + let arr = Array.of_list vars in let h = make_watch_ self (Watch2 { arr; ev }) in (* put watched vars first *) let i0, all_set0 = find_watch_ self.vst arr ~idx0:0 in diff --git a/src/cdsat/watch_schemes.mli b/src/cdsat/watch_schemes.mli index 4ec51f14..93a27653 100644 --- a/src/cdsat/watch_schemes.mli +++ b/src/cdsat/watch_schemes.mli @@ -10,13 +10,15 @@ end) : sig (** New set of watchers *) val watch2 : - t -> TVar.t array -> Ev.t -> f:(unit:bool -> Ev.t -> unit) -> handle + t -> TVar.t list -> Ev.t -> f:(unit:bool -> Ev.t -> unit) -> handle (** 2-watch scheme on these variables. *) val watch1 : - t -> TVar.t array -> Ev.t -> f:(unit:bool -> Ev.t -> unit) -> handle + t -> TVar.t list -> Ev.t -> f:(unit:bool -> Ev.t -> unit) -> handle (** 1-watch scheme on these variables. *) + (* TODO: remove var *) + val kill : t -> handle -> unit (** Disable watch *)