-let empty = { id = gen_uid ();
- key = 0;
- node = Empty }
-
-let _ = WH.add pool empty
-
-let is_empty = function { id = 0 } -> true | _ -> false
+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
+ type t = HNode.t node
+ let equal x y =
+ match x,y with
+ | Empty,Empty -> true
+ | Leaf k1, Leaf k2 -> H.equal k1 k2
+ | Branch(b1,i1,l1,r1),Branch(b2,i2,l2,r2) ->
+ b1 == b2 && i1 == i2 &&
+ (HNode.equal l1 l2) &&
+ (HNode.equal r1 r2)
+ | _ -> false
+ let hash = function
+ | Empty -> 0
+ | 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