var.ml 1.4 KB
Newer Older
1
module V = struct
2
3
4
5
6
  type t = { id : string ; fr : int }
  let dump ppf t = Format.fprintf ppf "{%s(%d)}" t.id t.fr
  let compare x y = Pervasives.compare (x.id,x.fr) (y.id,y.fr)
  let equal x y = (compare x y) = 0
  let hash x = Hashtbl.hash (x.id,x.fr)
7
  let check _ = ()
8
  let id x = x.id
9

10
  let is_fresh x = x.fr > 0
11

12
  let mk id = { id = id ; fr = 0 }
13

14
  let pp ppf x =
Pietro Abate's avatar
Pietro Abate committed
15
    (*
16
    let pre = if x.fr == 0 then "" else (Printf.sprintf "_fresh_%d" x.fr) in
Pietro Abate's avatar
Pietro Abate committed
17
18
  *)
    Format.fprintf ppf "'%s" x.id
19

20
  let fresh v = { v with fr = v.fr + 1 }
21
22
23
24
end

include V
type var = t
25

Pietro Abate's avatar
Pietro Abate committed
26
module Set = struct
27
28
29
  include SortedList.Make(V)
  let dump ppf s = Utils.pp_list ~sep:";" ~delim:("{","}") V.dump ppf (get s)
  let pp ppf s = Utils.pp_list ~sep:";" ~delim:("{","}") V.pp ppf (get s)
30
  let printf = pp Format.std_formatter
31
32
33
34
  let union = cup
  let inter = cap
  let cardinal = length
  let mem t v = mem v t
35
  let fold = fold
Pietro Abate's avatar
Pietro Abate committed
36
end
37

38
type 'a pairvar = [ `Atm of 'a | `Var of t ]
39

40
41
module Make (X : Custom.T) = struct
  type t = X.t pairvar
42
  let hash = function `Atm t -> X.hash t | `Var x -> V.hash x
43

44
  let check = function `Atm t -> X.check t | `Var _ -> ()
45

46
47
  let compare t1 t2 =
    match t1,t2 with
48
    |`Var x, `Var y -> compare x y
49
50
51
52
53
    |`Atm x, `Atm y -> X.compare x y
    |`Var _, `Atm _ -> -1
    |`Atm _, `Var _ -> 1

  let equal t1 t2 = (compare t1 t2) = 0
54

55
56
  let dump ppf = function
    |`Atm x -> X.dump ppf x
57
    |`Var x -> V.dump ppf x
58
end