atoms.ml 2.68 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
module HashedString = 
struct 
  type t = string 
  let hash = Hashtbl.hash
  let equal = (=)
end

module AtomPool  = Pool.Make(HashedString)
type v = AtomPool.t
let value = AtomPool.value
let mk = AtomPool.mk

13
14
15
16
17
18
19
20
module SList = SortedList.Make(
  struct 
    type 'a t = v 
    let compare = AtomPool.compare 
    let hash = AtomPool.hash 
    let equal = AtomPool.equal 
  end)
type t = Finite of unit SList.t | Cofinite of unit SList.t
21
22

let empty = Finite []
23
let any   = Cofinite []
24
25
26
27
28

let atom x = Finite [x]

let cup s t =
  match (s,t) with
29
30
31
32
    | (Finite s, Finite t) -> Finite (SList.cup s t)
    | (Finite s, Cofinite t) -> Cofinite (SList.diff t s)
    | (Cofinite s, Finite t) -> Cofinite (SList.diff s t)
    | (Cofinite s, Cofinite t) -> Cofinite (SList.cap s t)
33
34
35

let cap s t =
  match (s,t) with
36
37
38
39
    | (Finite s, Finite t) -> Finite (SList.cap s t)
    | (Finite s, Cofinite t) -> Finite (SList.diff s t)
    | (Cofinite s, Finite t) -> Finite (SList.diff t s)
    | (Cofinite s, Cofinite t) -> Cofinite (SList.cup s t)
40
41
42

let diff s t =
  match (s,t) with
43
44
45
46
    | (Finite s, Cofinite t) -> Finite (SList.cap s t)
    | (Finite s, Finite t) -> Finite (SList.diff s t)
    | (Cofinite s, Cofinite t) -> Finite (SList.diff t s)
    | (Cofinite s, Finite t) -> Cofinite (SList.cup s t)
47
48
	
let contains x = function
49
50
  | Finite s -> SList.mem s x
  | Cofinite s -> not (SList.mem s x)
51
52
53
54

let is_empty = function
  | Finite [] -> true
  | _ -> false
55
56
57
58

let is_atom = function
  | Finite [a] -> Some a
  | _ -> None
59
      
60
let sample = function
61
  | Finite (x :: _) -> x
62
  | Cofinite l -> AtomPool.dummy_min
63
64
  | Finite [] -> raise Not_found

65
66
67
68
69
let print_v ppf a = 
  if a = AtomPool.dummy_min then
    Format.fprintf ppf "(almost any atom)"
  else
    Format.fprintf ppf "`%s" (value a)
70

71
72
let print = function
  | Finite l -> List.map (fun x ppf -> print_v ppf x) l
73
  | Cofinite [] ->
74
      [ fun ppf -> Format.fprintf ppf "Atom" ]
75
  | Cofinite [h] ->
76
      [ fun ppf -> Format.fprintf ppf "@[Atom - %a@]" print_v h ]
77
78
  | Cofinite (h::t) -> 
      [ fun ppf -> 
79
80
81
	  Format.fprintf ppf "@[Atom - (";
	  print_v ppf h;
	  List.iter (fun x -> Format.fprintf ppf " |@ %a" print_v x) t;
82
	  Format.fprintf ppf ")@]" ]
83

84
85

(* TODO: clean what follow to re-use SList operations *)
86
87
88
89
90
91
92
let rec hash_seq accu = function
  | t::rem -> hash_seq (accu * 17 + t) rem
  | [] -> accu

let hash accu = function
  | Finite l -> hash_seq (accu + 1) l
  | Cofinite l -> hash_seq (accu + 3) l
93

94
95
96
97
98
99
100
101
102
103
104
let rec equal_rec l1 l2 =
  (l1 == l2) ||
  match (l1,l2) with
    | (x1::l1,x2::l2) -> (x1 == x2) && (equal_rec l1 l2)
    | _ -> false

let equal t1 t2 = match (t1,t2) with
  | (Finite l1, Finite l2) -> equal_rec l1 l2
  | (Cofinite l1, Cofinite l2) -> equal_rec l1 l2
  | _ -> false
  
105