atoms.ml 1.69 KB
Newer Older
1 2 3
type 'a t = Finite of 'a list | Cofinite of 'a list

let empty = Finite []
4
let any   = Cofinite []
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

let atom x = Finite [x]

let cup s t =
  match (s,t) with
    | (Finite s, Finite t) -> Finite (SortedList.cup s t)
    | (Finite s, Cofinite t) -> Cofinite (SortedList.diff t s)
    | (Cofinite s, Finite t) -> Cofinite (SortedList.diff s t)
    | (Cofinite s, Cofinite t) -> Cofinite (SortedList.cap s t)

let cap s t =
  match (s,t) with
    | (Finite s, Finite t) -> Finite (SortedList.cap s t)
    | (Finite s, Cofinite t) -> Finite (SortedList.diff s t)
    | (Cofinite s, Finite t) -> Finite (SortedList.diff t s)
    | (Cofinite s, Cofinite t) -> Cofinite (SortedList.cup s t)

let diff s t =
  match (s,t) with
    | (Finite s, Cofinite t) -> Finite (SortedList.cap s t)
    | (Finite s, Finite t) -> Finite (SortedList.diff s t)
    | (Cofinite s, Cofinite t) -> Finite (SortedList.diff t s)
    | (Cofinite s, Finite t) -> Cofinite (SortedList.cup s t)
	
let contains x = function
  | Finite s -> SortedList.mem s x
  | Cofinite s -> not (SortedList.mem s x)

let is_empty = function
  | Finite [] -> true
  | _ -> false
36 37 38 39

let is_atom = function
  | Finite [a] -> Some a
  | _ -> None
40
      
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
let sample except = function
  | Finite (x :: _) -> x
  | Cofinite l -> except l
  | Finite [] -> raise Not_found


let print any f = function
  | Finite l -> List.map (fun x ppf -> f ppf x) l
  | Cofinite [] ->
      [ fun ppf -> Format.fprintf ppf "%s" any ]
  | Cofinite [h] ->
      [ fun ppf -> Format.fprintf ppf "@[%s - %a@]" any f h ]
  | Cofinite (h::t) -> 
      [ fun ppf -> 
	  Format.fprintf ppf "@[%s - (" any;
	  f ppf h;
	  List.iter (fun x -> Format.fprintf ppf " |@ %a" f x) t;
	  Format.fprintf ppf ")@]" ]
59

60