From fc80d8c6e9c3a5b2568c163f60709579c484ecea Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 1 Jun 2019 16:56:05 -0500 Subject: [PATCH] wip: theories --- src/th-cstor/Sidekick_th_cstor.ml | 9 ++++----- src/th-distinct/Sidekick_th_distinct.ml | 9 +++++---- src/th-ite/Sidekick_th_ite.ml | 22 ++++++++++------------ 3 files changed, 19 insertions(+), 21 deletions(-) diff --git a/src/th-cstor/Sidekick_th_cstor.ml b/src/th-cstor/Sidekick_th_cstor.ml index 549a720e..fca81024 100644 --- a/src/th-cstor/Sidekick_th_cstor.ml +++ b/src/th-cstor/Sidekick_th_cstor.ml @@ -38,9 +38,9 @@ module Make(A : ARG) : S with module A = A = struct let merge x _ = x end - type t = { - k: data SI.Key.t; - } + let k = SI.Key.create (module Data) + + type t = unit let on_merge (solver:SI.t) n1 tc1 n2 tc2 e_n1_n2 : unit = Log.debugf 5 @@ -69,10 +69,9 @@ module Make(A : ARG) : S with module A = A = struct | _ -> None let create_and_setup (solver:SI.t) : t = - let k = SI.Key.create solver (module Data) in SI.on_cc_merge solver ~k on_merge; SI.on_cc_new_term solver ~k on_new_term; - {k} + () let theory = A.S.mk_theory ~name ~create_and_setup () end diff --git a/src/th-distinct/Sidekick_th_distinct.ml b/src/th-distinct/Sidekick_th_distinct.ml index a2d413e4..f0a21afa 100644 --- a/src/th-distinct/Sidekick_th_distinct.ml +++ b/src/th-distinct/Sidekick_th_distinct.ml @@ -62,9 +62,11 @@ module Make(A : ARG) : S with module A = A = struct m1 m2 in () + let k = SI.Key.create (module Data) + module T_tbl = CCHashtbl.Make(T) + type t = { - k: Data.t SI.Key.t; expanded: unit T_tbl.t; (* negative "distinct" that have been case-split on *) } @@ -79,7 +81,7 @@ module Make(A : ARG) : S with module A = A = struct subs (fun sub -> let n = SI.cc_add_term solver sub in - SI.cc_add_data solver n ~k:self.k (IM.singleton lit sub)); + SI.cc_add_data solver n ~k (IM.singleton lit sub)); ) else if not @@ T_tbl.mem self.expanded lit_t then ( (* add clause [distinct t1…tn ∨ ∨_{i,j>i} t_i=j] *) T_tbl.add self.expanded lit_t (); @@ -104,8 +106,7 @@ module Make(A : ARG) : S with module A = A = struct | Some subs -> process_lit st solver lit t subs) let create_and_setup (solver:SI.t) : t = - let k = SI.Key.create solver (module Data) in - let self = { expanded=T_tbl.create 8; k; } in + let self = { expanded=T_tbl.create 8; } in SI.on_cc_merge solver ~k on_merge; SI.on_final_check solver (partial_check self); self diff --git a/src/th-ite/Sidekick_th_ite.ml b/src/th-ite/Sidekick_th_ite.ml index a35931fc..ceda3d64 100644 --- a/src/th-ite/Sidekick_th_ite.ml +++ b/src/th-ite/Sidekick_th_ite.ml @@ -42,16 +42,16 @@ module Make(A : ARG) let merge = A.T_set.union end - type t = { - k: Data.t Solver.Key.t; - } + let k = Solver.Key.create (module Data) - let on_merge (self:t) (solver:Solver.t) n1 n2 e_n1_n2 : unit = + type t = unit + + let on_merge (solver:Solver.t) n1 n2 e_n1_n2 : unit = Log.debugf 5 (fun k->k "(@[th-ite.on_merge@ :c1 %a@ :c2 %a@])" N.pp n1 N.pp n2); (* check if [n1] has some [ite] parents, and if [n2] is true/false *) let check_ n1 n2 = - match Solver.cc_data solver ~k:self.k n1, A.view_as_ite (N.term n2) with + match Solver.cc_data solver ~k n1, A.view_as_ite (N.term n2) with | Some set, T_bool n2_true -> assert (not @@ A.T_set.is_empty set); A.T_set.iter @@ -77,21 +77,19 @@ module Make(A : ARG) check_ n2 n1; () - let on_new_term (self:t) (solver:Solver.t) _n (t:T.t) = + let on_new_term (solver:Solver.t) _n (t:T.t) = match A.view_as_ite t with | T_ite (a,_,_) -> (* add [t] to parents of [a] *) let n_a = Solver.cc_find solver @@ Solver.cc_add_term solver a in - Solver.cc_add_data solver n_a ~k:self.k (A.T_set.singleton t); + Solver.cc_add_data solver n_a ~k (A.T_set.singleton t); None | _ -> None let create_and_setup (solver:Solver.t) : t = - let k = Solver.Key.create solver (module Data) in - let self = {k} in - Solver.on_cc_merge_all solver (on_merge self); - Solver.on_cc_new_term solver ~k (on_new_term self); - self + Solver.on_cc_merge_all solver on_merge; + Solver.on_cc_new_term solver ~k on_new_term; + () let theory = A.S.mk_theory ~name:"ite" ~create_and_setup () end