var.ml 2.43 KB
Newer Older
1
module V = struct
2

3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

  type kind = Source | Internal

  type t = { name : Ident.U.t ;
	     id : int ;
	     kind : kind }

  let print_kind ppf k = Format.fprintf ppf "%s"
    (match k with Source -> "Source" | Internal -> "Internal")

  let compare_kind k1 k2 = if k1 == k2 then 0 else if k1 < k2 then -1 else 1

  let dump ppf t =
    Format.fprintf ppf "%a(%d_%a)" Ident.U.print t.name t.id print_kind t.kind

  let compare x y =
    let c = compare_kind x.kind y.kind in
    if c == 0 then
      let c = Pervasives.compare x.id y.id in
      if c == 0 then Ident.U.compare x.name y.name
      else c
    else c

26
  let equal x y =
27
    x == y || (x.kind == y.kind && x.id == y.id && Ident.U.equal x.name y.name)
28

29
  let hash x = Hashtbl.hash (x.id,x.name,x.kind)
30

31
  let check x = assert (x.id >= 0)
32

33 34 35
  let refresh v =
    (* according to Alain, a thread safe way to generate a unique ID *)
    { v with id = Oo.id (object end) }
36

37 38 39 40 41
  let mk ?(internal=false) id = { name = Ident.U.mk id;
				  id = 0;
				  kind = if internal then Internal else Source;
				}
  let is_internal x = x.kind == Internal
42

43
  let ident x = Ident.U.get_str x.name
44
  let print ppf x = Format.fprintf ppf "'%a_%i_%a" Ident.U.print x.name x.id print_kind x.kind
45 46
end

47

48

Pietro Abate's avatar
Pietro Abate committed
49
module Set = struct
50 51
  include SortedList.Make(V)
  let dump ppf s = Utils.pp_list ~sep:";" ~delim:("{","}") V.dump ppf (get s)
52
  let print ppf s = Utils.pp_list ~sep:";" ~delim:("{","}") V.print ppf (get s)
Pietro Abate's avatar
Pietro Abate committed
53
end
54

55
module Map = Set.Map
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75

include V
let gen set =
  let idx = ref 0 in
  let rec freshvar () =
    let rec pretty i acc =
      let ni,nm = i/26, i mod 26 in
      let acc = acc ^
        (String.make 1 (Char.chr (Char.code 'a' + nm)))
      in
      if ni == 0 then acc else pretty ni acc
    in
    let x = mk (pretty !idx "") in
    if Set.mem set x then
      (* if the name is taken by a variable in delta, restart *)
      (incr idx; freshvar ())
    else x
  in
  freshvar ()

76
type 'a var_or_atom = [ `Atm of 'a | `Var of t ]
77

78
module Make (X : Custom.T) = struct
79 80
  type t = X.t var_or_atom
  let hash = function `Atm t -> 17 + 17 * X.hash t | `Var x -> 997 + 17 * V.hash x
81

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

84 85
  let compare t1 t2 =
    match t1,t2 with
86
    |`Var x, `Var y -> compare x y
87 88 89 90
    |`Atm x, `Atm y -> X.compare x y
    |`Var _, `Atm _ -> -1
    |`Atm _, `Var _ -> 1

91
  let equal t1 t2 = (compare t1 t2) == 0
92

93 94
  let dump ppf = function
    |`Atm x -> X.dump ppf x
95
    |`Var x -> V.dump ppf x
96
end
97