val make : data -> t
val node : t -> data
val stats : unit -> unit
+ val init : unit -> unit
end
module Make ( H : Hcons.SA ) : S with type elt = H.t =
type data = Data.t
type t = Node.t
let stats = Node.stats
+ let init = Node.init
let hash = Node.hash
let uid = Node.uid
let make = Node.make
let hbit = Array.init 256 naive_highest_bit
-
+ external clz : int -> int = "caml_clz" "noalloc"
+ external leading_bit : int -> int = "caml_leading_bit" "noalloc"
let highest_bit x =
try
let n = (x) lsr 24 in
let n = x lsr 32 in if n != 0 then highest_bit n lsl 32
else highest_bit x
- let branching_bit p0 p1 = highest_bit64 (p0 lxor p1)
+ let branching_bit p0 p1 = leading_bit (p0 lxor p1)
let join p0 t0 p1 t1 =
let m = branching_bit p0 p1 in
+ let msk = mask p0 m in
if zero_bit p0 m then
- branch (mask p0 m) m t0 t1
+ branch_ne msk m t0 t1
else
- branch (mask p0 m) m t1 t0
+ branch_ne msk m t1 t0
let match_prefix k p m = (mask k m) == p
| Branch (p,m,t0,t1) ->
if match_prefix kid p m then
if zero_bit kid m then
- branch p m (ins t0) t1
+ branch_ne p m (ins t0) t1
else
- branch p m t0 (ins t1)
+ branch_ne p m t0 (ins t1)
else
join kid (leaf k) p n
in
branch p m (merge s0 t0) (merge s1 t1)
else if m > n && match_prefix q p m then
if zero_bit q m then
- branch p m (merge s0 t) s1
+ branch_ne p m (merge s0 t) s1
else
- branch p m s0 (merge s1 t)
+ branch_ne p m s0 (merge s1 t)
else if m < n && match_prefix p q n then
if zero_bit p n then
- branch q n (merge s t0) t1
+ branch_ne q n (merge s t0) t1
else
- branch q n t0 (merge s t1)
+ branch_ne q n t0 (merge s t1)
else
(* The prefixes disagree. *)
join p s q t
then empty
else
match (Node.node s1,Node.node s2) with
- | Empty, _ -> empty
- | _, Empty -> s1
- | Leaf k1, _ -> if mem k1 s2 then empty else s1
- | _, Leaf k2 -> remove k2 s1
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- merge (diff l1 l2) (diff r1 r2)
- else if m1 > m2 && match_prefix p2 p1 m1 then
- if zero_bit p2 m1 then
- merge (diff l1 s2) r1
- else
- merge l1 (diff r1 s2)
- else if m1 < m2 && match_prefix p1 p2 m2 then
- if zero_bit p1 m2 then diff s1 l2 else diff s1 r2
- else
- s1
+ | Empty, _ -> empty
+ | _, Empty -> s1
+ | Leaf k1, _ -> if mem k1 s2 then empty else s1
+ | _, Leaf k2 -> remove k2 s1
+ | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
+ if m1 == m2 && p1 == p2 then
+ merge (diff l1 l2) (diff r1 r2)
+ else if m1 > m2 && match_prefix p2 p1 m1 then
+ if zero_bit p2 m1 then
+ merge (diff l1 s2) r1
+ else
+ merge l1 (diff r1 s2)
+ else if m1 < m2 && match_prefix p1 p2 m2 then
+ if zero_bit p1 m2 then diff s1 l2 else diff s1 r2
+ else
+ s1
(*s All the following operations ([cardinal], [iter], [fold], [for_all],
external make : t -> int = "%identity"
external node : t -> int = "%identity"
external stats : unit -> unit = "%identity"
+ external init : unit -> unit = "%identity"
end
)
let print ppf s =