X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FfiniteCofinite.ml;fp=src%2FfiniteCofinite.ml;h=ecd0a56ca4c7296ee95ef05b2e84b71821ac1196;hb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;hp=0000000000000000000000000000000000000000;hpb=a223af3254fb51c279cfbccdc18c59484fdca74e;p=SXSI%2Fxpathcomp.git

diff --git a/src/finiteCofinite.ml b/src/finiteCofinite.ml
new file mode 100644
index 0000000..ecd0a56
--- /dev/null
+++ b/src/finiteCofinite.ml
@@ -0,0 +1,216 @@
+(******************************************************************************)
+(*  SXSI : XPath evaluator                                                    *)
+(*  Kim Nguyen (Kim.Nguyen@nicta.com.au)                                      *)
+(*  Copyright NICTA 2008                                                      *)
+(*  Distributed under the terms of the LGPL (see LICENCE)                     *)
+(******************************************************************************)
+INCLUDE "utils.ml"
+
+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 uid : t -> Uid.t
+  val positive : t -> set
+  val negative : t -> set
+  val inj_positive : set -> t
+  val inj_negative : set -> t
+end
+
+module Make (E : Ptset.S) : S with type elt = E.elt and type set = E.t =
+struct
+
+  type elt = E.elt
+  type node = Finite of E.t | CoFinite of E.t
+  type set = E.t
+  module Node = Hcons.Make(struct
+			     type t = node
+			     let equal a b =
+			       match a,b with
+				  (Finite(s1),Finite(s2))
+				 | (CoFinite(s1),CoFinite(s2)) -> E.equal s1 s2
+				 | _ -> false
+			     let hash = function
+			       Finite (s) -> (E.hash s) lsl 1
+			     | CoFinite(s) -> ((E.hash s) lsl 1 ) lor 1
+			   end)
+  type t = Node.t
+  let empty = Node.make (Finite E.empty)
+  let any = Node.make (CoFinite E.empty)
+  let finite x = Node.make (Finite x)
+  let cofinite x = Node.make (CoFinite x)
+
+  let is_empty =  function
+      { Node.node = Finite s } when E.is_empty s -> true
+    | _ -> false
+
+  let is_any = function
+      { Node.node = CoFinite s } when E.is_empty s -> true
+    | _ -> false
+
+  let is_finite t = match t.Node.node with
+    | Finite _ -> true | _ -> false
+
+  let kind t = match t.Node.node with
+      Finite _ -> `Finite
+    | _ -> `Cofinite
+
+  let mem x t = match t.Node.node with
+    | Finite s -> E.mem x s
+    | CoFinite s -> not (E.mem x s)
+
+  let singleton x = finite (E.singleton x)
+
+  let add e t = match t.Node.node with
+    | Finite s -> finite (E.add e s)
+    | CoFinite s -> cofinite (E.remove e s)
+
+  let remove e t = match t.Node.node with
+    | Finite s -> finite (E.remove e s)
+    | CoFinite s -> cofinite (E.add e s)
+
+  let cup s t = match (s.Node.node,t.Node.node) 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.Node.node,t.Node.node) 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.Node.node,t.Node.node) 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 t = match t.Node.node with
+    | Finite s -> cofinite s
+    | CoFinite s -> finite s
+
+  let compare s t = match (s.Node.node,t.Node.node) 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.Node.node,t.Node.node) 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)
+      | { Node.node = Finite s } ::r -> next_finite_cofinite (E.union s facc) cacc r
+      | { Node.node = CoFinite _ } ::r when E.is_empty cacc -> next_finite_cofinite facc cacc r
+      | { Node.node = CoFinite s } ::r -> next_finite_cofinite facc (E.inter cacc s) r
+    in
+    let rec first_cofinite facc = function
+      | [] -> empty,empty
+      | { Node.node = Finite s } :: r-> first_cofinite (E.union s facc) r
+      | { Node.node = CoFinite s } :: r -> next_finite_cofinite facc s r
+    in
+      first_cofinite E.empty l
+
+  let fold f t a = match t.Node.node with
+    | Finite s -> E.fold f s a
+    | CoFinite _ -> raise InfiniteSet
+
+  let for_all f t = match t.Node.node with
+    | Finite s -> E.for_all f s
+    | CoFinite _ -> raise InfiniteSet
+
+  let exists f t = match t.Node.node with
+    | Finite s -> E.exists f s
+    | CoFinite _ -> raise InfiniteSet
+
+  let filter f t = match t.Node.node with
+    | Finite s -> finite (E.filter f s)
+    | CoFinite _ -> raise InfiniteSet
+
+  let partition f t = match t.Node.node with
+    | Finite s -> let a,b = E.partition f s in finite a,finite b
+    | CoFinite _ -> raise InfiniteSet
+
+  let cardinal t = match t.Node.node with
+    | Finite s -> E.cardinal s
+    | CoFinite _ -> raise InfiniteSet
+
+  let elements t = match t.Node.node with
+    | 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 t = match t.Node.node with
+      Finite s -> E.choose s
+    | _ -> raise InfiniteSet
+
+  let equal = (==)
+
+  let hash t = t.Node.key
+
+  let uid t = t.Node.id
+
+
+  let positive t =
+    match t.Node.node with
+      | Finite x -> x
+      | _ -> E.empty
+
+  let negative t =
+    match t.Node.node with
+      | CoFinite x -> x
+      | _ -> E.empty
+
+  let inj_positive t = finite t
+  let inj_negative t = cofinite t
+end
+