X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=ptset.ml;h=87e75062834dc09b2664499b39c8edd0c9977cc1;hb=d046f2b9d8e39b30350399eafe122c30ff61c8c1;hp=ea84ddf845e19416da121aa08176703d2a37e11c;hpb=25dd7fcc77c2188732d96d5ff98d759bb81737cb;p=SXSI%2Fxpathcomp.git diff --git a/ptset.ml b/ptset.ml index ea84ddf..87e7506 100644 --- a/ptset.ml +++ b/ptset.ml @@ -9,24 +9,28 @@ INCLUDE "utils.ml" module type S = sig include Set.S + type data 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 = struct @@ -34,7 +38,7 @@ struct 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) && @@ -42,15 +46,17 @@ struct | _ -> 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.HNode.id, Uid.to_int r.HNode.id) end ;; type t = HNode.t + type data = t node let hash = HNode.hash let uid = HNode.uid - + let make = HNode.make + let node _ = failwith "node" let empty = HNode.make Empty let is_empty s = (HNode.node s) == Empty @@ -75,10 +81,10 @@ struct | _ -> false let mem (k:elt) n = - let kid = H.uid k in + let kid = Uid.to_int (H.uid k) in let rec loop n = match HNode.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 @@ -138,10 +144,10 @@ END let match_prefix k p m = (mask k m) == p let add k t = - let kid = H.uid k in + let kid = Uid.to_int (H.uid k) in let rec ins n = match HNode.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 +160,10 @@ END ins t let remove k t = - let kid = H.uid k in + let kid = Uid.to_int(H.uid k) in let rec rmv n = match HNode.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 @@ -173,7 +179,7 @@ END let equal a b = HNode.equal a b - let compare a b = (HNode.uid a) - (HNode.uid b) + let compare a b = (Uid.to_int (HNode.uid a)) - (Uid.to_int (HNode.uid b)) let rec merge s t = if (equal s t) (* This is cheap thanks to hash-consing *) @@ -343,10 +349,6 @@ 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) || @@ -374,17 +376,28 @@ let rec uncons n = match HNode.node n with let from_list l = List.fold_left (fun acc e -> add e acc) empty l - +let with_id = HNode.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