-(******************************************************************************)
-(* 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.t =
+ FiniteCofinite.Make(Ptset)
+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
projects / SXSI / xpathcomp.git / blobdiff