mirror of
https://github.com/c-cube/sidekick.git
synced 2025-12-09 20:55:39 -05:00
refactor(term): use hashconsing with a weak table
This commit is contained in:
parent
1ef0cf4183
commit
3b671aa7a4
5 changed files with 53 additions and 21 deletions
35
src/smt/Hashcons.ml
Normal file
35
src/smt/Hashcons.ml
Normal file
|
|
@ -0,0 +1,35 @@
|
||||||
|
|
||||||
|
module type ARG = sig
|
||||||
|
type t
|
||||||
|
val equal : t -> t -> bool
|
||||||
|
val hash : t -> int
|
||||||
|
val set_id : t -> int -> unit
|
||||||
|
end
|
||||||
|
|
||||||
|
module Make(A : ARG): sig
|
||||||
|
type t
|
||||||
|
val create : ?size:int -> unit -> t
|
||||||
|
val hashcons : t -> A.t -> A.t
|
||||||
|
val to_seq : t -> A.t Sequence.t
|
||||||
|
end = struct
|
||||||
|
module W = Weak.Make(A)
|
||||||
|
|
||||||
|
type t = {
|
||||||
|
tbl: W.t;
|
||||||
|
mutable n: int;
|
||||||
|
}
|
||||||
|
|
||||||
|
let create ?(size=1024) () : t = {tbl=W.create size; n=0}
|
||||||
|
|
||||||
|
(* hashcons terms *)
|
||||||
|
let hashcons st t =
|
||||||
|
let t' = W.merge st.tbl t in
|
||||||
|
if t == t' then (
|
||||||
|
st.n <- 1 + st.n;
|
||||||
|
A.set_id t' st.n;
|
||||||
|
);
|
||||||
|
t'
|
||||||
|
|
||||||
|
let to_seq st yield =
|
||||||
|
W.iter yield st.tbl
|
||||||
|
end
|
||||||
|
|
@ -21,30 +21,29 @@ let equal = term_equal_
|
||||||
let hash = term_hash_
|
let hash = term_hash_
|
||||||
let compare a b = CCInt.compare a.term_id b.term_id
|
let compare a b = CCInt.compare a.term_id b.term_id
|
||||||
|
|
||||||
(* TODO: when GC is implemented, add a field for recycling IDs
|
module H = Hashcons.Make(struct
|
||||||
that have been free'd, so we can keep the ID space dense. *)
|
type t = term
|
||||||
|
let equal t1 t2 = Term_cell.equal t1.term_view t2.term_view
|
||||||
|
let hash t = Term_cell.hash t.term_view
|
||||||
|
let set_id t id =
|
||||||
|
assert (t.term_id < 0);
|
||||||
|
t.term_id <- id
|
||||||
|
end)
|
||||||
|
|
||||||
type state = {
|
type state = {
|
||||||
tbl : term Term_cell.Tbl.t;
|
tbl : H.t;
|
||||||
mutable n: int;
|
mutable n: int;
|
||||||
true_ : t lazy_t;
|
true_ : t lazy_t;
|
||||||
false_ : t lazy_t;
|
false_ : t lazy_t;
|
||||||
}
|
}
|
||||||
|
|
||||||
let mk_real_ st c : t =
|
|
||||||
let term_ty = Term_cell.ty c in
|
|
||||||
let t = {
|
|
||||||
term_id= st.n;
|
|
||||||
term_ty;
|
|
||||||
term_view=c;
|
|
||||||
} in
|
|
||||||
st.n <- 1 + st.n;
|
|
||||||
Term_cell.Tbl.add st.tbl c t;
|
|
||||||
t
|
|
||||||
|
|
||||||
let[@inline] make st (c:t term_view) : t =
|
let[@inline] make st (c:t term_view) : t =
|
||||||
try Term_cell.Tbl.find st.tbl c
|
let t = {term_id= -1; term_ty=Ty.prop; term_view=c} in
|
||||||
with Not_found -> mk_real_ st c
|
let t' = H.hashcons st.tbl t in
|
||||||
|
if t == t' then (
|
||||||
|
t'.term_ty <- Term_cell.ty c;
|
||||||
|
);
|
||||||
|
t'
|
||||||
|
|
||||||
let[@inline] true_ st = Lazy.force st.true_
|
let[@inline] true_ st = Lazy.force st.true_
|
||||||
let[@inline] false_ st = Lazy.force st.false_
|
let[@inline] false_ st = Lazy.force st.false_
|
||||||
|
|
@ -53,7 +52,7 @@ let bool st b = if b then true_ st else false_ st
|
||||||
let create ?(size=1024) () : state =
|
let create ?(size=1024) () : state =
|
||||||
let rec st ={
|
let rec st ={
|
||||||
n=2;
|
n=2;
|
||||||
tbl=Term_cell.Tbl.create size;
|
tbl=H.create ~size ();
|
||||||
true_ = lazy (make st Term_cell.true_);
|
true_ = lazy (make st Term_cell.true_);
|
||||||
false_ = lazy (make st Term_cell.false_);
|
false_ = lazy (make st Term_cell.false_);
|
||||||
} in
|
} in
|
||||||
|
|
|
||||||
|
|
@ -34,7 +34,7 @@ val eq : state -> t -> t -> t
|
||||||
val if_: state -> t -> t -> t -> t
|
val if_: state -> t -> t -> t -> t
|
||||||
val and_eager : state -> t -> t -> t (* evaluate left argument first *)
|
val and_eager : state -> t -> t -> t (* evaluate left argument first *)
|
||||||
|
|
||||||
(* TODO: remove *)
|
(** Obtain unsigned version of [t], + the sign as a boolean *)
|
||||||
val abs : t -> t * bool
|
val abs : t -> t * bool
|
||||||
|
|
||||||
val to_seq : t -> t Sequence.t
|
val to_seq : t -> t Sequence.t
|
||||||
|
|
|
||||||
|
|
@ -46,7 +46,7 @@ end[@@inline]
|
||||||
include Make_eq(struct
|
include Make_eq(struct
|
||||||
type t = term
|
type t = term
|
||||||
let equal (t1:t) t2 = t1==t2
|
let equal (t1:t) t2 = t1==t2
|
||||||
let hash (t:term): int = t.term_id
|
let hash (t:term): int = CCHash.int t.term_id
|
||||||
let pp = pp_term
|
let pp = pp_term
|
||||||
end)
|
end)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -24,8 +24,6 @@ val ty : t -> Ty.t
|
||||||
|
|
||||||
val pp : t Fmt.printer
|
val pp : t Fmt.printer
|
||||||
|
|
||||||
module Tbl : CCHashtbl.S with type key = t
|
|
||||||
|
|
||||||
module type ARG = sig
|
module type ARG = sig
|
||||||
type t
|
type t
|
||||||
val hash : t -> int
|
val hash : t -> int
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue