var.ml 2.01 KB
Newer Older
1

2
3
4
5
6
7
module V = struct
  type t = { fresh : bool; id : string; }
  let dump ppf t = Format.fprintf ppf "{id=%s;fresh=%b}" t.id t.fresh
  let compare x y = Pervasives.compare x.id y.id
  let equal x y = Pervasives.compare x.id y.id = 0
  let hash x = Hashtbl.hash x.id
8
9
10
  let check _ = ()

  let make_id ?(fresh=false) id = { id = id ; fresh = fresh }
11
end
12

13
type var = [ `Var of V.t ]
14
type t = var
15
let dump ppf (`Var x) = Format.fprintf ppf "%a" V.dump x
16
let pp ppf (`Var x) = Format.fprintf ppf "'%s" x.V.id
17
let compare (`Var x) (`Var y) = V.compare x y
18
let equal v1 v2 = (compare v1 v2) = 0
19
let hash (`Var x) = V.hash x
20
let check _ = ()
21

22
let mk ?fresh id = `Var (V.make_id ?fresh id)
23
24
25
26
27
28
29
30
let fresh : ?pre: string -> unit -> [> var ] =
  let counter = ref 0 in
  fun ?(pre="_fresh_") -> fun _ ->
    let id = (Printf.sprintf "%s%d" pre !counter) in
    let v = mk ~fresh:true id in
    incr counter;
    v
;;
31

32
33
let id (`Var x) = x.V.id
let is_fresh (`Var x) = x.V.fresh
34

Pietro Abate's avatar
Pietro Abate committed
35
module Set = struct
36
  include Set.Make(struct type t = var let compare = compare end) 
Pietro Abate's avatar
Pietro Abate committed
37
38
39
40
41
42
43
44
45
  let aux_print sep printer ppf s =
    let rec aux ppf = function
      |[] -> ()
      |[h] -> printer ppf h
      |h::l -> Format.fprintf ppf "%a %s %a" printer h sep aux l
    in
    aux ppf (elements s)

  let dump ppf s = aux_print ";" dump ppf s
46
  let pp ppf s = aux_print ";" pp ppf s
47
48
  let is_empty s = equal s empty
  let from_list l = List.fold_left (fun acc x -> add x acc) empty l
Pietro Abate's avatar
Pietro Abate committed
49
end
50

51
type 'a pairvar = [ `Atm of 'a | var ]
52
53
module type MAKE = functor (X : Custom.T) -> Custom.T with type t = X.t pairvar

54
55
module Make (X : Custom.T) = struct
  type t = X.t pairvar
56
  let hash = function `Atm t -> X.hash t | `Var x -> V.hash x
57
58
59
  let check = function `Atm t -> X.check t | `Var _ -> ()
  let compare t1 t2 =
    match t1,t2 with
60
    |`Var x, `Var y -> compare (`Var x) (`Var 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
Pietro Abate's avatar
Pietro Abate committed
69
    |`Var x -> dump ppf (`Var x)
70
end