hcons.ml

   1 INCLUDE "utils.ml"
   2 module type SA =
   3   sig
   4     type data
   5     type t
   6     val make : data -> t
   7     val node : t -> data
   8     val hash : t -> int
   9     val uid : t -> int
  10     val equal : t -> t -> bool
  11   end
  12
  13 module type S =
  14   sig
  15     type data
  16     type t = private { id : int;
  17                        key : int;
  18                        node : data }
  19     val make : data -> t
  20     val node : t -> data
  21     val hash : t -> int
  22     val uid : t -> int
  23     val equal : t -> t -> bool
  24   end
  25
  26 module Make (H : Hashtbl.HashedType) : S with type data = H.t =
  27 struct
  28   type data = H.t
  29   type t = { id : int;
  30              key : int;
  31              node : data }
  32   let node t = t.node
  33   let hash t = t.key
  34   let uid t = t.id
  35   let gen_uid  =
  36     let id = ref ~-1 in
  37       fun () -> incr id;!id
  38   let equal = (==)
  39   module WH = Weak.Make( struct
  40                            type _t = t
  41                            type t = _t
  42                            let hash = hash
  43                            let equal a b = a==b || H.equal a.node b.node
  44                          end)
  45   let pool = WH.create MED_H_SIZE
  46   let make x =
  47     let cell = { id = gen_uid(); key = H.hash x; node = x } in
  48       WH.merge pool cell
  49 end