projects
/
SXSI
/
xpathcomp.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
.
[SXSI/xpathcomp.git]
/
hcons.ml
diff --git
a/hcons.ml
b/hcons.ml
index
35bc942
..
7bc8823
100644
(file)
--- a/
hcons.ml
+++ b/
hcons.ml
@@
-6,44
+6,60
@@
module type SA =
val make : data -> t
val node : t -> data
val hash : t -> int
val make : data -> t
val node : t -> data
val hash : t -> int
- val uid : t ->
in
t
+ val uid : t ->
Uid.
t
val equal : t -> t -> bool
val equal : t -> t -> bool
- end
+
+ val with_id : Uid.t -> t
+ end
module type S =
sig
module type S =
sig
+
type data
type data
- type t = private { id :
in
t;
+ type t = private { id :
Uid.
t;
key : int;
node : data }
val make : data -> t
val node : t -> data
val hash : t -> int
key : int;
node : data }
val make : data -> t
val node : t -> data
val hash : t -> int
- val uid : t ->
in
t
+ val uid : t ->
Uid.
t
val equal : t -> t -> bool
val equal : t -> t -> bool
+
+
+ val with_id : Uid.t -> t
end
module Make (H : Hashtbl.HashedType) : S with type data = H.t =
struct
end
module Make (H : Hashtbl.HashedType) : S with type data = H.t =
struct
+ let uid_make = Uid.make_maker()
type data = H.t
type data = H.t
- type t = { id :
in
t;
+ type t = { id :
Uid.
t;
key : int;
node : data }
let node t = t.node
key : int;
node : data }
let node t = t.node
- let hash t = t.key
let uid t = t.id
let uid t = t.id
- let gen_uid =
- let id = ref ~-1 in
- fun () -> incr id;!id
- let equal = (==)
+ let hash t = t.key
+ let equal t1 t2 = t1 == t2
module WH = Weak.Make( struct
type _t = t
type t = _t
let hash = hash
module WH = Weak.Make( struct
type _t = t
type t = _t
let hash = hash
- let equal a b = a
==
b || H.equal a.node b.node
+ let equal a b = a
==
b || H.equal a.node b.node
end)
let pool = WH.create MED_H_SIZE
let make x =
end)
let pool = WH.create MED_H_SIZE
let make x =
- let cell = { id =
gen_uid
(); key = H.hash x; node = x } in
+ let cell = { id =
uid_make
(); key = H.hash x; node = x } in
WH.merge pool cell
WH.merge pool cell
+
+ exception Found of t
+
+ let with_id id =
+ try
+ WH.iter (fun r -> if r.id == id then raise (Found r)) pool;
+ raise Not_found
+ with
+ | Found r -> r
+ | e -> raise e
+ ;;
+
end
end