(******************************************************************************) (* SXSI : XPath evaluator *) (* Kim Nguyen (Kim.Nguyen@nicta.com.au) *) (* Copyright NICTA 2008 *) (* Distributed under the terms of the LGPL (see LICENCE) *) (******************************************************************************) exception InfiniteSet module type S = sig type elt type t type set val empty : t val any : t val is_empty : t -> bool val is_any : t -> bool val is_finite : t -> bool val kind : t -> [ `Finite | `Cofinite ] val singleton : elt -> t val mem : elt -> t -> bool val add : elt -> t -> t val remove : 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 : (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 from_list : elt list -> t val choose : t -> elt val hash : t -> int val equal : t -> t -> bool val positive : t -> set val negative : t -> set end module Make (E : Sigs.Set) : S with type elt = E.elt and type set = E.t = struct type elt = E.elt type t = Finite of E.t | CoFinite of E.t type set = E.t let empty = Finite E.empty let any = CoFinite E.empty let is_empty = function Finite s when E.is_empty s -> true | _ -> false let is_any = function CoFinite s when E.is_empty s -> true | _ -> false let is_finite = function | Finite _ -> true | _ -> false let kind = function Finite _ -> `Finite | _ -> `Cofinite let mem x = function Finite s -> E.mem x s | CoFinite s -> not (E.mem x s) let singleton x = Finite (E.singleton x) let add e = function | Finite s -> Finite (E.add e s) | CoFinite s -> CoFinite (E.remove e s) let remove e = function | Finite s -> Finite (E.remove e s) | CoFinite s -> CoFinite (E.add e s) let cup s t = match (s,t) with | Finite s, Finite t -> Finite (E.union s t) | CoFinite s, CoFinite t -> CoFinite ( E.inter s t) | Finite s, CoFinite t -> CoFinite (E.diff t s) | CoFinite s, Finite t-> CoFinite (E.diff s t) let cap s t = match (s,t) with | Finite s, Finite t -> Finite (E.inter s t) | CoFinite s, CoFinite t -> CoFinite (E.union s t) | Finite s, CoFinite t -> Finite (E.diff s t) | CoFinite s, Finite t-> Finite (E.diff t s) let diff s t = match (s,t) with | Finite s, Finite t -> Finite (E.diff s t) | Finite s, CoFinite t -> Finite(E.inter s t) | CoFinite s, Finite t -> CoFinite(E.union t s) | CoFinite s, CoFinite t -> Finite (E.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 -> E.compare s t | CoFinite s , CoFinite t -> E.compare t s | Finite _, CoFinite _ -> -1 | CoFinite _, Finite _ -> 1 let subset s t = match (s,t) with | Finite s , Finite t -> E.subset s t | CoFinite s , CoFinite t -> E.subset t s | Finite s, CoFinite t -> E.is_empty (E.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 (E.diff cacc facc) | Finite s ::r -> next_finite_cofinite (E.union s facc) cacc r | CoFinite _ ::r when E.is_empty cacc -> next_finite_cofinite facc cacc r | CoFinite s ::r -> next_finite_cofinite facc (E.inter cacc s) r in let rec first_cofinite facc = function | [] -> empty,empty | Finite s :: r-> first_cofinite (E.union s facc) r | CoFinite s :: r -> next_finite_cofinite facc s r in first_cofinite E.empty l let fold f t a = match t with | Finite s -> E.fold f s a | CoFinite _ -> raise InfiniteSet let for_all f = function | Finite s -> E.for_all f s | CoFinite _ -> raise InfiniteSet let exists f = function | Finite s -> E.exists f s | CoFinite _ -> raise InfiniteSet let filter f = function | Finite s -> Finite (E.filter f s) | CoFinite _ -> raise InfiniteSet let partition f = function | Finite s -> let a,b = E.partition f s in Finite a,Finite b | CoFinite _ -> raise InfiniteSet let cardinal = function | Finite s -> E.cardinal s | CoFinite _ -> raise InfiniteSet let elements = function | Finite s -> E.elements s | CoFinite _ -> raise InfiniteSet let from_list l = Finite(List.fold_left (fun x a -> E.add a x ) E.empty l) let choose = function Finite s -> E.choose s | _ -> raise InfiniteSet let equal a b = match a,b with | Finite x, Finite y | CoFinite x, CoFinite y -> E.equal x y | _ -> false let hash = function Finite x -> (E.hash x) | CoFinite x -> ( ~-(E.hash x) land max_int) let positive = function | Finite x -> x | _ -> E.empty let negative = function | CoFinite x -> x | _ -> E.empty end