637a60d9b39b3aa946621518db98038e2259d4ce
[SXSI/xpathcomp.git] / 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 -> Uid.t
10     val equal : t -> t -> bool
11
12     val with_id : Uid.t -> t
13  end
14
15 module type S =
16   sig
17
18     type data
19     type t = private { id : Uid.t;
20                        key : int;
21                        node : data }
22     val make : data -> t
23     val node : t -> data
24     val hash : t -> int
25     val uid : t -> Uid.t
26     val equal : t -> t -> bool
27
28
29     val with_id : Uid.t -> t
30   end
31
32 module Make (H : Hashtbl.HashedType) : S with type data = H.t =
33 struct
34   let uid_make = Uid.make_maker()
35   type data = H.t
36   type t = { id : Uid.t;
37              key : int;
38              node : data }
39   let node t = t.node
40   let uid t = t.id
41   let hash t = t.key
42   let equal t1 t2 = t1 == t2
43   module WH = Weak.Make( struct 
44                            type _t = t 
45                            type t = _t 
46                            let hash = hash
47                            let equal a b = a == b || H.equal a.node b.node 
48                          end)
49   let pool = WH.create MED_H_SIZE
50   let make x = 
51     let cell = { id = uid_make(); key = H.hash x; node = x } in
52       WH.merge pool cell
53
54   exception Found of t
55   let with_id id = 
56     try
57       WH.iter (fun r -> if r.id == id then raise (Found r))  pool;      
58       raise Not_found
59     with
60       | Found r -> r
61       | e -> raise e
62   ;;
63
64 end