module type S =
sig
include Set.S
+ type data
val intersect : t -> t -> bool
val is_singleton : t -> bool
val mem_union : t -> t -> t
val uid : t -> int
val uncons : t -> elt*t
val from_list : elt list -> t
+ val make : data -> t
+ val node : t -> data
end
module Make ( H : Hcons.S ) : S with type elt = H.t =
struct
type elt = H.t
-
type 'a node =
| Empty
| Leaf of elt
| Branch of int * int * 'a * 'a
-
+
module rec HNode : Hcons.S with type data = Node.t = Hcons.Make (Node)
and Node : Hashtbl.HashedType with type t = HNode.t node =
struct
let equal x y =
match x,y with
| Empty,Empty -> true
- | Leaf k1, Leaf k2 -> H.equal k1 k2
+ | Leaf k1, Leaf k2 -> k1 == k2
| Branch(b1,i1,l1,r1),Branch(b2,i2,l2,r2) ->
b1 == b2 && i1 == i2 &&
(HNode.equal l1 l2) &&
| _ -> false
let hash = function
| Empty -> 0
- | Leaf i -> HASHINT2(HALF_MAX_INT,H.hash i)
- | Branch (b,i,l,r) -> HASHINT4(b,i,HNode.hash l, HNode.hash r)
+ | Leaf i -> HASHINT2(HALF_MAX_INT,H.uid i)
+ | Branch (b,i,l,r) -> HASHINT4(b,i,HNode.uid l, HNode.uid r)
end
;;
type t = HNode.t
+ type data = t node
let hash = HNode.hash
let uid = HNode.uid
-
+ let make = HNode.make
+ let node _ = failwith "node"
let empty = HNode.make Empty
let is_empty s = (HNode.node s) == Empty
let kid = H.uid k in
let rec loop n = match HNode.node n with
| Empty -> false
- | Leaf j -> H.equal k j
+ | Leaf j -> k == j
| Branch (p, _, l, r) -> if kid <= p then loop l else loop r
in loop n
let kid = H.uid k in
let rec ins n = match HNode.node n with
| Empty -> leaf k
- | Leaf j -> if H.equal j k then n else join kid (leaf k) (H.uid j) n
+ | Leaf j -> if j == k then n else join kid (leaf k) (H.uid j) n
| Branch (p,m,t0,t1) ->
if match_prefix kid p m then
if zero_bit kid m then
let kid = H.uid k in
let rec rmv n = match HNode.node n with
| Empty -> empty
- | Leaf j -> if H.equal k j then empty else n
+ | Leaf j -> if k == j then empty else n
| Branch (p,m,t0,t1) ->
if match_prefix kid p m then
if zero_bit kid m then
in
fold coll s (empty, false, empty)
-
-let make l = List.fold_left (fun acc e -> add e acc ) empty l
-(*i*)
-
(*s Additional functions w.r.t to [Set.S]. *)
let rec intersect s1 s2 = (equal s1 s2) ||
end
-(* Have to benchmark wheter this whole include stuff is worth it *)
-module Int : S with type elt = int = Make ( struct type t = int
- type data = t
- external hash : t -> int = "%identity"
- external uid : t -> int = "%identity"
- let equal : t -> t -> bool = (==)
- external make : t -> int = "%identity"
- external node : t -> int = "%identity"
-
- end
- )
+module Int : sig
+ include S with type elt = int
+ val print : Format.formatter -> t -> unit
+end
+ =
+struct
+ include Make ( struct type t = int
+ type data = t
+ external hash : t -> int = "%identity"
+ external uid : t -> int = "%identity"
+ let equal : t -> t -> bool = (==)
+ external make : t -> int = "%identity"
+ external node : t -> int = "%identity"
+
+ end
+ )
+ let print ppf s =
+ Format.pp_print_string ppf "{ ";
+ iter (fun i -> Format.fprintf ppf "%i " i) s;
+ Format.pp_print_string ppf "}";
+ Format.pp_print_flush ppf ()
+ end