X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=tagSet.ml;h=74784cfb8c38ae309fe37b9646cd96b72a84fe3c;hb=d550133ad7afdf65c5e284c2bcf67a5bdde6faa7;hp=48784a1ae5af9bea5cbd4765b6fac247ddbd7026;hpb=3623eefccfb5fc69e19ad975a3669f51a2a8b276;p=SXSI%2Fxpathcomp.git

diff --git a/tagSet.ml b/tagSet.ml
index 48784a1..74784cf 100644
--- a/tagSet.ml
+++ b/tagSet.ml
@@ -1,172 +1,17 @@
-(******************************************************************************)
-(*  SXSI : XPath evaluator                                                    *)
-(*  Kim Nguyen (Kim.Nguyen@nicta.com.au)                                      *)
-(*  Copyright NICTA 2008                                                      *)
-(*  Distributed under the terms of the LGPL (see LICENCE)                     *)
-(******************************************************************************)
-module type S = 
-sig
-  module S : Set.S 
-  type t = private Finite of S.t | CoFinite of S.t
-  exception InfiniteTagSet
-  val empty : t
-  val any : t
-  val is_empty : t -> bool
-  val is_any : t -> bool
-  val is_finite : t -> bool
-  val singleton : S.elt -> t
-  val mem : S.elt -> t -> bool
-  val add : S.elt -> t -> t
-  val remove : S.elt -> t -> t
-  val cup : t -> t -> t
-  val cap : t -> t -> t
-  val diff : t -> t -> t
-  val neg : t -> t
-  val compare : t -> t -> int
-  val subset : t -> t -> bool
-  val kind_split : t list -> t * t
-  val fold : (S.elt -> 'a -> 'a) -> t -> 'a -> 'a
-  val for_all : (S.elt -> bool) -> t -> bool
-  val exists : (S.elt -> bool) -> t -> bool
-  val filter : (S.elt -> bool) -> t -> S.t
-  val partition : (S.elt -> bool) -> t -> S.t * S.t
-  val cardinal : t -> int
-  val elements : t -> S.elt list
-  val from_list : S.elt list -> t
-  val choose : t -> S.elt
+(* module Ptset = 
+struct 
+  include Set.Make (struct type t = int let compare = (-) end)
+  let hash = Hashtbl.hash
 end
+  *)
+module M  : FiniteCofinite.S with type elt = Tag.t and type set = Ptset.Int.t =
+  FiniteCofinite.Make(Ptset.Int)
+include M
 
-module Make (Symbol : Set.OrderedType) =
-struct
-  module S = Set.Make(Symbol)
-  type t = Finite of S.t | CoFinite of S.t
 
-  exception InfiniteTagSet
+let tag t = singleton t
+let pcdata = singleton Tag.pcdata
+let attribute = singleton Tag.attribute
+let star = diff any (cup pcdata attribute)
+let node = neg attribute
 
-  let empty = Finite S.empty
-  let any = CoFinite S.empty
-
-  let is_empty =  function
-      Finite s when S.is_empty s -> true
-    | _ -> false
-  let is_any = function
-      CoFinite s when S.is_empty s -> true
-    | _ -> false
-  let is_finite = function
-    | Finite _ -> true | _ -> false
-
-  let mem x = function Finite s -> S.mem x s
-    | CoFinite s -> not (S.mem x s)
-
-  let singleton x = Finite (S.singleton x)
-  let add e = function 
-    | Finite s -> Finite (S.add e s)
-    | CoFinite s -> CoFinite (S.remove e s)
-  let remove e = function
-    | Finite s -> Finite (S.remove e s)
-    | CoFinite s -> CoFinite (S.add e s)
-	
-  let cup s t = match (s,t) with
-    | Finite s, Finite t -> Finite (S.union s t)
-    | CoFinite s, CoFinite t -> CoFinite ( S.inter s t)
-    | Finite s, CoFinite t -> CoFinite (S.diff t s)
-    | CoFinite s, Finite t-> CoFinite (S.diff s t)
-
-  let cap s t = match (s,t) with
-    | Finite s, Finite t -> Finite (S.inter s t)
-    | CoFinite s, CoFinite t -> CoFinite (S.union s t)
-    | Finite s, CoFinite t -> Finite (S.diff s t)
-    | CoFinite s, Finite t-> Finite (S.diff t s)
-	
-  let diff s t = match (s,t) with
-    | Finite s, Finite t -> Finite (S.diff s t)
-    | Finite s, CoFinite t -> Finite(S.inter s t)
-    | CoFinite s, Finite t -> CoFinite(S.union t s)
-    | CoFinite s, CoFinite t -> Finite (S.diff t s)
-
-  let neg = function 
-    | Finite s -> CoFinite s
-    | CoFinite s -> Finite s
-	
-  let compare s t = match (s,t) with
-    | Finite s , Finite t -> S.compare s t
-    | CoFinite s , CoFinite t -> S.compare s t
-    | Finite _, CoFinite _ -> -1
-    | CoFinite _, Finite _ -> 1
-	
-  let subset s t = match (s,t) with
-    | Finite s , Finite t -> S.subset s t
-    | CoFinite s , CoFinite t -> S.subset t s
-    | Finite s, CoFinite t -> S.is_empty (S.inter s t)
-    | CoFinite _, Finite _ -> false
-
-	(* given a  list l of type t list, 
-	   returns two sets (f,c) where :
-	   - f is the union of all the finite sets of l
-	   - c is the union of all the cofinite sets of l
-	   - f and c are disjoint
-	   Invariant : cup f c = List.fold_left cup empty l
-
-	   We treat the CoFinite part explicitely :
-	*)
-
-  let kind_split l =
-    
-    let rec next_finite_cofinite facc cacc = function 
-      | [] -> Finite facc, CoFinite (S.diff cacc facc)
-      | Finite s ::r -> next_finite_cofinite (S.union s facc) cacc r
-      | CoFinite _ ::r when S.is_empty cacc -> next_finite_cofinite facc cacc r
-      | CoFinite s ::r -> next_finite_cofinite facc (S.inter cacc s) r
-    in
-    let rec first_cofinite facc = function
-      | [] -> empty,empty
-      | Finite s :: r-> first_cofinite (S.union s facc) r
-      | CoFinite s :: r -> next_finite_cofinite facc s r  
-    in
-      first_cofinite S.empty l
-	
-  let fold f t a = match t with
-    | Finite s -> S.fold f s a
-    | CoFinite _ -> raise InfiniteTagSet
-
-  let for_all f = function
-    | Finite s -> S.for_all f s
-    | CoFinite _ -> raise InfiniteTagSet
-
-  let exists f = function
-    | Finite s -> S.exists f s
-    | CoFinite _ -> raise InfiniteTagSet
-
-  let filter f = function
-    | Finite s -> S.filter f s
-    | CoFinite _ -> raise InfiniteTagSet
-
-  let partition f = function
-    | Finite s -> S.partition f s
-    | CoFinite _ -> raise InfiniteTagSet
-
-  let cardinal = function
-    | Finite s -> S.cardinal s
-    | CoFinite _ -> raise InfiniteTagSet
-
-  let elements = function
-    | Finite s -> S.elements s
-    | CoFinite _ -> raise InfiniteTagSet
-	
-  let from_list l = 
-    Finite(List.fold_left (fun x a -> S.add a x ) S.empty l)
-
-  let choose = function
-      Finite s -> S.choose s
-    | _ -> raise InfiniteTagSet
-
-end
-
-module Xml =
-struct
-  include Make(Tag)
-  let star = diff any (from_list [ Tag.pcdata; Tag.attribute ])
-  let node = remove Tag.attribute any
-  let pcdata = singleton Tag.pcdata
-  let attribute = singleton Tag.attribute
-end