X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=ptset.ml;h=befb42e1df4a6420f3fe06918ab33dc6e9c32620;hb=df5fdb22632be887ecd9f5c46a014e7e970148a2;hp=ea84ddf845e19416da121aa08176703d2a37e11c;hpb=25dd7fcc77c2188732d96d5ff98d759bb81737cb;p=SXSI%2Fxpathcomp.git

diff --git a/ptset.ml b/ptset.ml
index ea84ddf..befb42e 100644
--- a/ptset.ml
+++ b/ptset.ml
@@ -8,56 +8,99 @@
 INCLUDE "utils.ml"
 module type S = 
 sig
-  include Set.S
+    type elt
+
+  type 'a node
+  module rec Node : sig
+    include  Hcons.S with type data = Data.t
+  end
+  and Data : sig 
+    include 
+      Hashtbl.HashedType with type t = Node.t node
+  end
+  type data = Data.t
+  type t = Node.t
+
+
+  val empty : t
+  val is_empty : t -> bool
+  val mem : elt -> t -> bool
+  val add : elt -> t -> t
+  val singleton : elt -> t
+  val remove : elt -> t -> t
+  val union : t -> t -> t
+  val inter : t -> t -> t
+  val diff : t -> t -> t
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val subset : t -> t -> bool
+  val iter : (elt -> unit) -> t -> unit
+  val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+  val for_all : (elt -> bool) -> t -> bool
+  val exists : (elt -> bool) -> t -> bool
+  val filter : (elt -> bool) -> t -> t
+  val partition : (elt -> bool) -> t -> t * t
+  val cardinal : t -> int
+  val elements : t -> elt list
+  val min_elt : t -> elt
+  val max_elt : t -> elt
+  val choose : t -> elt
+  val split : elt -> t -> t * bool * t   
+
   val intersect : t -> t -> bool
   val is_singleton : t -> bool
   val mem_union : t -> t -> t
   val hash : t -> int
-  val uid : t -> int
+  val uid : t -> Uid.t
   val uncons : t -> elt*t
   val from_list : elt list -> t 
+  val make : data -> t
+  val node : t -> data
+    
+  val with_id : Uid.t -> t
 end
 
-module Make ( H : Hcons.S ) : S with type elt = H.t =
+module Make ( H : Hcons.SA ) : S with type elt = H.t =
 struct
   type elt = H.t
-
   type 'a node =
     | Empty
     | Leaf of elt
     | Branch of int * int * 'a * 'a
-	
-  module rec HNode : Hcons.S with type data = Node.t = Hcons.Make (Node)
-  and Node : Hashtbl.HashedType  with type t = HNode.t node =
+
+  module rec Node : Hcons.S with type data = Data.t = Hcons.Make (Data)
+  and Data : Hashtbl.HashedType  with type t = Node.t node =
   struct 
-    type t =  HNode.t node
+    type t =  Node.t node
     let equal x y = 
       match x,y with
 	| Empty,Empty -> true
-	| Leaf k1, Leaf k2 -> H.equal k1 k2
+	| Leaf k1, Leaf k2 ->  k1 == k2
 	| Branch(b1,i1,l1,r1),Branch(b2,i2,l2,r2) ->
 	    b1 == b2 && i1 == i2 &&
-	      (HNode.equal l1 l2) &&
-	      (HNode.equal r1 r2) 
+	      (Node.equal l1 l2) &&
+	      (Node.equal r1 r2) 
 	| _ -> false
     let hash = function 
       | Empty -> 0
-      | Leaf i -> HASHINT2(HALF_MAX_INT,H.hash i)
-      | Branch (b,i,l,r) -> HASHINT4(b,i,HNode.hash l, HNode.hash r)
+      | Leaf i -> HASHINT2(HALF_MAX_INT,Uid.to_int (H.uid i))
+      | Branch (b,i,l,r) -> HASHINT4(b,i,Uid.to_int l.Node.id, Uid.to_int r.Node.id)
   end
- ;;
-			     
-  type t = HNode.t
-  let hash = HNode.hash 
-  let uid = HNode.uid
-    
-  let empty = HNode.make Empty
+ 
+  type data = Data.t
+  type t = Node.t
+
+  let hash = Node.hash 
+  let uid = Node.uid
+  let make = Node.make
+  let node _ = failwith "node"
+  let empty = Node.make Empty
     
-  let is_empty s = (HNode.node s) == Empty
+  let is_empty s = (Node.node s) == Empty
        
-  let branch p m l r = HNode.make (Branch(p,m,l,r))
+  let branch p m l r = Node.make (Branch(p,m,l,r))
 
-  let leaf k = HNode.make (Leaf k)
+  let leaf k = Node.make (Leaf k)
 
   (* To enforce the invariant that a branch contains two non empty sub-trees *)
   let branch_ne p m t0 t1 = 
@@ -71,29 +114,29 @@ struct
   let singleton k = leaf k
     
   let is_singleton n = 
-    match HNode.node n with Leaf _ -> true
+    match Node.node n with Leaf _ -> true
       | _ -> false
 	  
   let mem (k:elt) n = 
-    let kid = H.uid k in
-    let rec loop n = match HNode.node n with
+    let kid = Uid.to_int (H.uid k) in
+    let rec loop n = match Node.node n with
       | Empty -> false
-      | Leaf j -> H.equal k j
+      | Leaf j ->  k == j
       | Branch (p, _, l, r) -> if kid <= p then loop l else loop r
     in loop n
 	 
-  let rec min_elt n = match HNode.node n with
+  let rec min_elt n = match Node.node n with
     | Empty -> raise Not_found
     | Leaf k -> k
     | Branch (_,_,s,_) -> min_elt s
 	
-  let rec max_elt n = match HNode.node n with
+  let rec max_elt n = match Node.node n with
     | Empty -> raise Not_found
     | Leaf k -> k
     | Branch (_,_,_,t) -> max_elt t
 	
   let elements s =
-    let rec elements_aux acc n = match HNode.node n with
+    let rec elements_aux acc n = match Node.node n with
       | Empty -> acc
       | Leaf k -> k :: acc
       | Branch (_,_,l,r) -> elements_aux (elements_aux acc r) l
@@ -138,10 +181,10 @@ END
   let match_prefix k p m = (mask k m) == p
     
   let add k t =
-    let kid = H.uid k in
-    let rec ins n = match HNode.node n with
+    let kid = Uid.to_int (H.uid k) in
+    let rec ins n = match Node.node n with
       | Empty -> leaf k
-      | Leaf j ->  if H.equal j k then n else join kid (leaf k) (H.uid j) n
+      | Leaf j ->  if j == k then n else join kid (leaf k) (Uid.to_int (H.uid j)) n
       | Branch (p,m,t0,t1)  ->
 	  if match_prefix kid p m then
 	    if zero_bit kid m then 
@@ -154,10 +197,10 @@ END
     ins t
       
   let remove k t =
-    let kid = H.uid k in
-    let rec rmv n = match HNode.node n with
+    let kid = Uid.to_int(H.uid k) in
+    let rec rmv n = match Node.node n with
       | Empty -> empty
-      | Leaf j  -> if H.equal k j then empty else n
+      | Leaf j  -> if  k == j then empty else n
       | Branch (p,m,t0,t1) -> 
 	  if match_prefix kid p m then
 	    if zero_bit kid m then
@@ -171,15 +214,15 @@ END
       
   (* should run in O(1) thanks to Hash consing *)
 
-  let equal a b = HNode.equal a b 
+  let equal a b = Node.equal a b 
 
-  let compare a b =  (HNode.uid a) - (HNode.uid b)
+  let compare a b =  (Uid.to_int (Node.uid a)) - (Uid.to_int (Node.uid b))
 
   let rec merge s t = 
     if (equal s t) (* This is cheap thanks to hash-consing *)
     then s
     else
-    match HNode.node s, HNode.node t with
+    match Node.node s, Node.node t with
       | Empty, _  -> t
       | _, Empty  -> s
       | Leaf k, _ -> add k t
@@ -205,7 +248,7 @@ END
 	       
 	       
   let rec subset s1 s2 = (equal s1 s2) ||
-    match (HNode.node s1,HNode.node s2) with
+    match (Node.node s1,Node.node s2) with
       | Empty, _ -> true
       | _, Empty -> false
       | Leaf k1, _ -> mem k1 s2
@@ -231,8 +274,8 @@ END
       let equal (x,y) (z,t) = (equal x z)&&(equal y t)
       let equal a b = equal a b || equal b a
       let hash (x,y) =   (* commutative hash *)
-	let x = HNode.hash x 
-	and y = HNode.hash y 
+	let x = Node.hash x 
+	and y = Node.hash y 
 	in
 	  if x < y then HASHINT2(x,y) else HASHINT2(y,x)
     end)
@@ -248,7 +291,7 @@ END
     if equal s1 s2 
     then s1
     else
-      match (HNode.node s1,HNode.node s2) with
+      match (Node.node s1,Node.node s2) with
 	| Empty, _ -> empty
 	| _, Empty -> empty
 	| Leaf k1, _ -> if mem k1 s2 then s1 else empty
@@ -267,7 +310,7 @@ END
     if equal s1 s2 
     then empty
     else
-      match (HNode.node s1,HNode.node s2) with
+      match (Node.node s1,Node.node s2) with
 	| Empty, _ -> empty
 	| _, Empty -> s1
 	| Leaf k1, _ -> if mem k1 s2 then empty else s1
@@ -290,46 +333,46 @@ END
     [exists], [filter], [partition], [choose], [elements]) are
     implemented as for any other kind of binary trees. *)
 
-let rec cardinal n = match HNode.node n with
+let rec cardinal n = match Node.node n with
   | Empty -> 0
   | Leaf _ -> 1
   | Branch (_,_,t0,t1) -> cardinal t0 + cardinal t1
 
-let rec iter f n = match HNode.node n with
+let rec iter f n = match Node.node n with
   | Empty -> ()
   | Leaf k -> f k
   | Branch (_,_,t0,t1) -> iter f t0; iter f t1
       
-let rec fold f s accu = match HNode.node s with
+let rec fold f s accu = match Node.node s with
   | Empty -> accu
   | Leaf k -> f k accu
   | Branch (_,_,t0,t1) -> fold f t0 (fold f t1 accu)
 
 
-let rec for_all p n = match HNode.node n with
+let rec for_all p n = match Node.node n with
   | Empty -> true
   | Leaf k -> p k
   | Branch (_,_,t0,t1) -> for_all p t0 && for_all p t1
 
-let rec exists p n = match HNode.node n with
+let rec exists p n = match Node.node n with
   | Empty -> false
   | Leaf k -> p k
   | Branch (_,_,t0,t1) -> exists p t0 || exists p t1
 
-let rec filter pr n = match HNode.node n with
+let rec filter pr n = match Node.node n with
   | Empty -> empty
   | Leaf k -> if pr k then n else empty
   | Branch (p,m,t0,t1) -> branch_ne p m (filter pr t0) (filter pr t1)
 
 let partition p s =
-  let rec part (t,f as acc) n = match HNode.node n with
+  let rec part (t,f as acc) n = match Node.node n with
     | Empty -> acc
     | Leaf k -> if p k then (add k t, f) else (t, add k f)
     | Branch (_,_,t0,t1) -> part (part acc t0) t1
   in
   part (empty, empty) s
 
-let rec choose n = match HNode.node n with
+let rec choose n = match Node.node n with
   | Empty -> raise Not_found
   | Leaf k -> k
   | Branch (_, _,t0,_) -> choose t0   (* we know that [t0] is non-empty *)
@@ -343,14 +386,10 @@ let split x s =
   in
   fold coll s (empty, false, empty)
 
-
-let make l = List.fold_left (fun acc e -> add e acc ) empty l
-(*i*)
-
 (*s Additional functions w.r.t to [Set.S]. *)
 
 let rec intersect s1 s2 = (equal s1 s2) ||
-  match (HNode.node s1,HNode.node s2) with
+  match (Node.node s1,Node.node s2) with
   | Empty, _ -> false
   | _, Empty -> false
   | Leaf k1, _ -> mem k1 s2
@@ -367,24 +406,35 @@ let rec intersect s1 s2 = (equal s1 s2) ||
 
 
 
-let rec uncons n = match HNode.node n with
+let rec uncons n = match Node.node n with
   | Empty -> raise Not_found
   | Leaf k -> (k,empty)
   | Branch (p,m,s,t) -> let h,ns = uncons s in h,branch_ne p m ns t
    
 let from_list l = List.fold_left (fun acc e -> add e acc) empty l
 
-
+let with_id = Node.with_id
 end
 
-(* Have to benchmark wheter this whole include stuff is worth it *)
-module Int : S with type elt = int = Make ( struct type t = int 
-						 type data = t
-						 external hash : t -> int = "%identity"
-						 external uid : t -> int = "%identity"
-						 let equal : t -> t -> bool = (==)
-						 external make : t -> int = "%identity"
-						 external node : t -> int = "%identity"
-						   
-					  end
-					  ) 
+module Int : sig
+  include S with type elt = int
+  val print : Format.formatter -> t -> unit
+end
+  = 
+struct
+  include Make ( struct type t = int 
+			type data = t
+			external hash : t -> int = "%identity"
+			external uid : t -> Uid.t = "%identity"
+			external equal : t -> t -> bool = "%eq"
+			external make : t -> int = "%identity"
+			external node : t -> int = "%identity"
+			external with_id : Uid.t -> t = "%identity"
+		 end
+	       ) 
+  let print ppf s = 
+    Format.pp_print_string ppf "{ ";
+    iter (fun i -> Format.fprintf ppf "%i " i) s;
+    Format.pp_print_string ppf "}";
+    Format.pp_print_flush ppf ()
+ end