blob: 64099a73b6a7718aae8cb10c7e3a40ca1185d396 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Pierre Chambart, OCamlPro *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2016 OCamlPro SAS *)
(* Copyright 2014--2016 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
open! Int_replace_polymorphic_compare
type t = {
compilation_unit : Compilation_unit.t;
name : string;
name_stamp : int;
(** [name_stamp]s are unique within any given compilation unit. *)
}
include Identifiable.Make (struct
type nonrec t = t
let compare t1 t2 =
if t1 == t2 then 0
else
let c = t1.name_stamp - t2.name_stamp in
if c <> 0 then c
else Compilation_unit.compare t1.compilation_unit t2.compilation_unit
let equal t1 t2 =
if t1 == t2 then true
else
t1.name_stamp = t2.name_stamp
&& Compilation_unit.equal t1.compilation_unit t2.compilation_unit
let output chan t =
output_string chan t.name;
output_string chan "_";
output_string chan (Int.to_string t.name_stamp)
let hash t = t.name_stamp lxor (Compilation_unit.hash t.compilation_unit)
let print ppf t =
if Compilation_unit.equal t.compilation_unit
(Compilation_unit.get_current_exn ())
then begin
Format.fprintf ppf "%s/%d"
t.name t.name_stamp
end else begin
Format.fprintf ppf "%a.%s/%d"
Compilation_unit.print t.compilation_unit
t.name t.name_stamp
end
end)
let previous_name_stamp = ref (-1)
let create_with_name_string ?current_compilation_unit name =
let compilation_unit =
match current_compilation_unit with
| Some compilation_unit -> compilation_unit
| None -> Compilation_unit.get_current_exn ()
in
let name_stamp =
incr previous_name_stamp;
!previous_name_stamp
in
{ compilation_unit;
name;
name_stamp;
}
let create ?current_compilation_unit name =
let name = (name : Internal_variable_names.t :> string) in
create_with_name_string ?current_compilation_unit name
let create_with_same_name_as_ident ident =
create_with_name_string (Ident.name ident)
let rename ?current_compilation_unit t =
create_with_name_string ?current_compilation_unit t.name
let in_compilation_unit t cu =
Compilation_unit.equal cu t.compilation_unit
let get_compilation_unit t = t.compilation_unit
let name t = t.name
let unique_name t =
t.name ^ "_" ^ (Int.to_string t.name_stamp)
let print_list ppf ts =
List.iter (fun t -> Format.fprintf ppf "@ %a" print t) ts
let debug_when_stamp_matches t ~stamp ~f =
if t.name_stamp = stamp then f ()
let print_opt ppf = function
| None -> Format.fprintf ppf "<no var>"
| Some t -> print ppf t
type pair = t * t
module Pair = Identifiable.Make (Identifiable.Pair (T) (T))
let compare_lists l1 l2 =
Misc.Stdlib.List.compare compare l1 l2
let output_full chan t =
Compilation_unit.output chan t.compilation_unit;
output_string chan ".";
output chan t
|
