X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fptset.ml;h=9f9185c7e4d671848e4c0c31df615d2ee5480b85;hb=7e27afe6fa006ad355237ccc0695c6493ea57929;hp=fc1f59282795f8de21094a42304db4770be8d63c;hpb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;p=SXSI%2Fxpathcomp.git

diff --git a/src/ptset.ml b/src/ptset.ml
index fc1f592..9f9185c 100644
--- a/src/ptset.ml
+++ b/src/ptset.ml
@@ -57,6 +57,7 @@ sig
   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 =
@@ -89,6 +90,7 @@ struct
   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
@@ -153,7 +155,8 @@ struct
 
   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
@@ -168,14 +171,15 @@ struct
     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
 
@@ -188,9 +192,9 @@ struct
       | 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
@@ -232,14 +236,14 @@ struct
 	    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
@@ -311,22 +315,22 @@ struct
     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],
@@ -430,6 +434,7 @@ struct
 			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 =