type t = { id : int;
key : int; (* hash *)
- node : node }
+ node : node;
+ }
and node =
| Empty
| Leaf of int
| Branch of int * int * t * t
+
+(* faster if outside of a module *)
+let hash_node x = match x with
+ | Empty -> 0
+ | Leaf i -> (i+1) land max_int
+ (* power of 2 +/- 1 are fast ! *)
+ | Branch (b,i,l,r) ->
+ ((b lsl 1)+ b + i+(i lsl 4) + (l.key lsl 5)-l.key
+ + (r.key lsl 7) - r.key) land max_int
+
module Node =
struct
type _t = t
type t = _t
- let hash x = x.key
- let hash_node = function
- | Empty -> 0
- | Leaf i -> i+1
- (* power of 2 +/- 1 are fast ! *)
- | Branch (b,i,l,r) ->
- (b lsl 1)+ b + i+(i lsl 4) + (l.key lsl 5)-l.key
- + (r.key lsl 7) - r.key
- let hash_node x = (hash_node x) land max_int
- let equal x y = match (x.node,y.node) with
+ external hash : t -> int = "%field1"
+ let equal x y =
+ if x.id == y.id || x.key == y.key || x.node == y.node then true
+ else
+ match (x.node,y.node) with
| Empty,Empty -> true
| Leaf k1, Leaf k2 when k1 == k2 -> true
| Branch(p1,m1,l1,r1), Branch(p2,m2,l2,r2) when m1==m2 && p1==p2 &&
let rec norm n =
let v = { id = gen_uid ();
- key = Node.hash_node n;
+ key = hash_node n;
node = n }
in
WH.merge pool v
let zero_bit k m = (k land m) == 0
-let singleton k = if k < 0 then failwith "singleton" else leaf k
+let singleton k = leaf k
let rec mem k n = match n.node with
| Empty -> false
let hash s = s.key
let from_list l = List.fold_left (fun acc i -> add i acc) empty l
+
+type int_vector
+
+external int_vector_alloc : int -> int_vector = "caml_int_vector_alloc"
+external int_vector_set : int_vector -> int -> int -> unit = "caml_int_vector_set"
+external int_vector_length : int_vector -> int = "caml_int_vector_length"
+external int_vector_empty : unit -> int_vector = "caml_int_vector_empty"
+
+let empty_vector = int_vector_empty ()
+
+let to_int_vector_ext s =
+ let l = cardinal s in
+ let v = int_vector_alloc l in
+ let i = ref 0 in
+ iter (fun e -> int_vector_set v !i e; incr i) s;
+ v
+
+let hash_vectors = Hashtbl.create 4097
+
+let to_int_vector s =
+ try
+ Hashtbl.find hash_vectors s.key
+ with
+ Not_found ->
+ let v = to_int_vector_ext s in
+ Hashtbl.add hash_vectors s.key v;
+ v
+
+