var.ml 2.09 KB
Newer Older
1

2
module V = struct
3
  type t = { id : string; repr : string }
4
  let dump ppf t =
5
    let r = if t.repr = t.id then "" else Format.sprintf ";repr=%s" t.repr in
6
    Format.fprintf ppf "{id=%s;%s}" t.id r
7
8
9
  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
10
11
  let check _ = ()

12
  let make_id ?repr id =
13
    match repr with
14
15
    |None -> { id = id ; repr = id }
    |Some r -> { id = id ; repr = r }
16
end
17

18
type var = [ `Var of V.t ]
19
20
21
22
23
24
25
26
27
module VAR = struct
  type t = var
  let dump ppf (`Var x) = Format.fprintf ppf "%a" V.dump x
  let compare (`Var x) (`Var y) = V.compare x y
  let equal v1 v2 = (compare v1 v2) = 0
  let hash (`Var x) = V.hash x
  let check _ = ()
end
include VAR
28
29

let id (`Var x) = x.V.id
30
31
32
33
34
let is_internal (`Var x) =
  let s = x.V.repr in
  String.length s >= 1 && s.[0] == '#'
;;

35
let pp ppf (`Var x) = Format.fprintf ppf "'%s" x.V.repr
36

37
let mk ?repr id = `Var (V.make_id ?repr id)
38
39
40
41
let fresh : ?pre: string -> unit -> [> var ] =
  let counter = ref 0 in
  fun ?(pre="_fresh_") -> fun _ ->
    let id = (Printf.sprintf "%s%d" pre !counter) in
42
    let v = mk id in
43
44
45
    incr counter;
    v
;;
46

Pietro Abate's avatar
Pietro Abate committed
47
module Set = struct
48
49
50
  include SortedList.Make(VAR)
  let dump ppf s = Utils.pp_list ~sep:";" ~delim:("{","}") VAR.dump ppf (get s)
  let pp ppf s = Utils.pp_list ~sep:";" ~delim:("{","}") pp ppf (get s)
51
  let printf = pp Format.std_formatter
52
53
54
55
  let union = cup
  let inter = cap
  let cardinal = length
  let mem t v = mem v t
56
  let fold = fold
Pietro Abate's avatar
Pietro Abate committed
57
end
58

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

62
63
module Make (X : Custom.T) = struct
  type t = X.t pairvar
64
  let hash = function `Atm t -> X.hash t | `Var x -> V.hash x
65
66
67
  let check = function `Atm t -> X.check t | `Var _ -> ()
  let compare t1 t2 =
    match t1,t2 with
68
    |`Var x, `Var y -> compare (`Var x) (`Var y)
69
70
71
72
73
    |`Atm x, `Atm y -> X.compare x y
    |`Var _, `Atm _ -> -1
    |`Atm _, `Var _ -> 1

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

75
76
  let dump ppf = function
    |`Atm x -> X.dump ppf x
Pietro Abate's avatar
Pietro Abate committed
77
    |`Var x -> dump ppf (`Var x)
78
end