var.ml 1.7 KB
Newer Older
Pietro Abate's avatar
Pietro Abate committed
1

2
module V = struct
Pietro Abate's avatar
Pietro Abate committed
3
4
  type t = { id : Ident.U.t ; fr : int }
  let dump ppf t = Format.fprintf ppf "{%a(%d)}" Ident.U.print t.id t.fr
5
6
7
  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)
8
  let check _ = ()
9

10
11
12
  let id x = Ident.U.get_str x.id
  let cache = Hashtbl.create 17

13
  let is_fresh x = x.fr > 0
14
15
16
17
18
19
20
21
  let fresh v =
    try
      let w = Hashtbl.find cache (id v) in
      let w = { w with fr = w.fr + 1 } in
      Hashtbl.replace cache (id w) w;
      w
    with Not_found ->
      assert false
22

23
24
25
26
27
28
29
  let mk id = 
    try Hashtbl.find cache id
    with Not_found -> begin
      let v = { id = Ident.U.mk id; fr = 0 } in
      Hashtbl.add cache id v;
      v
    end
30

Pietro Abate's avatar
Pietro Abate committed
31
  let pp ppf x = Format.fprintf ppf "'%a" Ident.U.print x.id
32
  let pp ppf x = dump ppf x
33
34
35
36
end

include V
type var = t
37

Pietro Abate's avatar
Pietro Abate committed
38
module Set = struct
39
40
41
  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)
42
  let printf = pp Format.std_formatter
43
44
45
46
  let union = cup
  let inter = cap
  let cardinal = length
  let mem t v = mem v t
47
  let fold = fold
Pietro Abate's avatar
Pietro Abate committed
48
end
49

50
type 'a pairvar = [ `Atm of 'a | `Var of t ]
51

52
53
module Make (X : Custom.T) = struct
  type t = X.t pairvar
54
  let hash = function `Atm t -> X.hash t | `Var x -> V.hash x
55

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

58
59
  let compare t1 t2 =
    match t1,t2 with
60
    |`Var x, `Var y -> compare x y
61
62
63
64
65
    |`Atm x, `Atm y -> X.compare x y
    |`Var _, `Atm _ -> -1
    |`Atm _, `Var _ -> 1

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

67
68
  let dump ppf = function
    |`Atm x -> X.dump ppf x
69
    |`Var x -> V.dump ppf x
70
end