finiteCofinite.ml

   1 (******************************************************************************)
   2 (*  SXSI : XPath evaluator                                                    *)
   3 (*  Kim Nguyen (Kim.Nguyen@nicta.com.au)                                      *)
   4 (*  Copyright NICTA 2008                                                      *)
   5 (*  Distributed under the terms of the LGPL (see LICENCE)                     *)
   6 (******************************************************************************)
   7
   8 exception InfiniteSet
   9 module type S =
  10 sig
  11   type elt
  12   type t
  13   type set
  14   val empty : t
  15   val any : t
  16   val is_empty : t -> bool
  17   val is_any : t -> bool
  18   val is_finite : t -> bool
  19   val kind : t -> [ `Finite | `Cofinite ]
  20   val singleton : elt -> t
  21   val mem : elt -> t -> bool
  22   val add : elt -> t -> t
  23   val remove : elt -> t -> t
  24   val cup : t -> t -> t
  25   val cap : t -> t -> t
  26   val diff : t -> t -> t
  27   val neg : t -> t
  28   val compare : t -> t -> int
  29   val subset : t -> t -> bool
  30   val kind_split : t list -> t * t
  31   val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
  32   val for_all : (elt -> bool) -> t -> bool
  33   val exists : (elt -> bool) -> t -> bool
  34   val filter : (elt -> bool) -> t -> t
  35   val partition : (elt -> bool) -> t -> t * t
  36   val cardinal : t -> int
  37   val elements : t -> elt list
  38   val from_list : elt list -> t
  39   val choose : t -> elt
  40   val hash : t -> int
  41   val equal : t -> t -> bool
  42   val positive : t -> set
  43   val negative : t -> set
  44   val inj_positive : set -> t
  45   val inj_negative : set -> t
  46 end
  47
  48 module Make (E : Sigs.Set) : S with type elt = E.elt and type set = E.t =
  49 struct
  50
  51   type elt = E.elt
  52   type t = Finite of E.t | CoFinite of E.t
  53   type set = E.t
  54
  55   let empty = Finite E.empty
  56   let any = CoFinite E.empty
  57
  58   let is_empty =  function
  59       Finite s when E.is_empty s -> true
  60     | _ -> false
  61
  62   let is_any = function
  63       CoFinite s when E.is_empty s -> true
  64     | _ -> false
  65
  66   let is_finite = function
  67     | Finite _ -> true | _ -> false
  68
  69   let kind = function
  70       Finite _ -> `Finite
  71     | _ -> `Cofinite
  72
  73   let mem x = function Finite s -> E.mem x s
  74     | CoFinite s -> not (E.mem x s)
  75
  76   let singleton x = Finite (E.singleton x)
  77   let add e = function
  78     | Finite s -> Finite (E.add e s)
  79     | CoFinite s -> CoFinite (E.remove e s)
  80   let remove e = function
  81     | Finite s -> Finite (E.remove e s)
  82     | CoFinite s -> CoFinite (E.add e s)
  83
  84   let cup s t = match (s,t) with
  85     | Finite s, Finite t -> Finite (E.union s t)
  86     | CoFinite s, CoFinite t -> CoFinite ( E.inter s t)
  87     | Finite s, CoFinite t -> CoFinite (E.diff t s)
  88     | CoFinite s, Finite t-> CoFinite (E.diff s t)
  89
  90   let cap s t = match (s,t) with
  91     | Finite s, Finite t -> Finite (E.inter s t)
  92     | CoFinite s, CoFinite t -> CoFinite (E.union s t)
  93     | Finite s, CoFinite t -> Finite (E.diff s t)
  94     | CoFinite s, Finite t-> Finite (E.diff t s)
  95
  96   let diff s t = match (s,t) with
  97     | Finite s, Finite t -> Finite (E.diff s t)
  98     | Finite s, CoFinite t -> Finite(E.inter s t)
  99     | CoFinite s, Finite t -> CoFinite(E.union t s)
 100     | CoFinite s, CoFinite t -> Finite (E.diff t s)
 101
 102   let neg = function
 103     | Finite s -> CoFinite s
 104     | CoFinite s -> Finite s
 105
 106   let compare s t = match (s,t) with
 107     | Finite s , Finite t -> E.compare s t
 108     | CoFinite s , CoFinite t -> E.compare t s
 109     | Finite _, CoFinite _ -> -1
 110     | CoFinite _, Finite _ -> 1
 111
 112   let subset s t = match (s,t) with
 113     | Finite s , Finite t -> E.subset s t
 114     | CoFinite s , CoFinite t -> E.subset t s
 115     | Finite s, CoFinite t -> E.is_empty (E.inter s t)
 116     | CoFinite _, Finite _ -> false
 117
 118         (* given a  list l of type t list,
 119            returns two sets (f,c) where :
 120            - f is the union of all the finite sets of l
 121            - c is the union of all the cofinite sets of l
 122            - f and c are disjoint
 123            Invariant : cup f c = List.fold_left cup empty l
 124
 125            We treat the CoFinite part explicitely :
 126         *)
 127
 128   let kind_split l =
 129
 130     let rec next_finite_cofinite facc cacc = function
 131       | [] -> Finite facc, CoFinite (E.diff cacc facc)
 132       | Finite s ::r -> next_finite_cofinite (E.union s facc) cacc r
 133       | CoFinite _ ::r when E.is_empty cacc -> next_finite_cofinite facc cacc r
 134       | CoFinite s ::r -> next_finite_cofinite facc (E.inter cacc s) r
 135     in
 136     let rec first_cofinite facc = function
 137       | [] -> empty,empty
 138       | Finite s :: r-> first_cofinite (E.union s facc) r
 139       | CoFinite s :: r -> next_finite_cofinite facc s r
 140     in
 141       first_cofinite E.empty l
 142
 143   let fold f t a = match t with
 144     | Finite s -> E.fold f s a
 145     | CoFinite _ -> raise InfiniteSet
 146
 147   let for_all f = function
 148     | Finite s -> E.for_all f s
 149     | CoFinite _ -> raise InfiniteSet
 150
 151   let exists f = function
 152     | Finite s -> E.exists f s
 153     | CoFinite _ -> raise InfiniteSet
 154
 155   let filter f = function
 156     | Finite s -> Finite (E.filter f s)
 157     | CoFinite _ -> raise InfiniteSet
 158
 159   let partition f = function
 160     | Finite s -> let a,b = E.partition f s in Finite a,Finite b
 161     | CoFinite _ -> raise InfiniteSet
 162
 163   let cardinal = function
 164     | Finite s -> E.cardinal s
 165     | CoFinite _ -> raise InfiniteSet
 166
 167   let elements = function
 168     | Finite s -> E.elements s
 169     | CoFinite _ -> raise InfiniteSet
 170
 171   let from_list l =
 172     Finite(List.fold_left (fun x a -> E.add a x ) E.empty l)
 173
 174   let choose = function
 175       Finite s -> E.choose s
 176     | _ -> raise InfiniteSet
 177
 178   let equal a b =
 179     match a,b with
 180       | Finite x, Finite y | CoFinite x, CoFinite y -> E.equal x y
 181       | _ -> false
 182
 183   let hash =
 184     function Finite x -> (E.hash x)
 185       | CoFinite x -> ( ~-(E.hash x) land max_int)
 186
 187   let positive =
 188     function
 189       | Finite x -> x
 190       | _ -> E.empty
 191
 192   let negative =
 193     function
 194       | CoFinite x -> x
 195       | _ -> E.empty
 196
 197   let inj_positive t = Finite t
 198   let inj_negative t = CoFinite t
 199 end
 200