Newer
Older
(** Time-stamp: <modified the 22/01/2010 (at 18:15) by Erwan Jahier> *)
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
(* maps node_key to a string that won't clash *)
let node_key_tbl = Hashtbl.create 0
(* maps node name (string) to a counter *)
let node_name_tbl = Hashtbl.create 0
(* exported *)
let (node_key: Eff.node_key -> string -> string) =
fun nk name ->
let (long, sargs) = nk in
assert (name <> "");
if sargs = [] then
(* If there is no static argument, we don't have to invent a new name,
and therefore there is nothing to do to avoid clashes *)
name
else
try Hashtbl.find node_key_tbl nk
(* Note that we ignore the "name" in argument in this case *)
with
Not_found ->
(* let's build an ident that won't clash *)
(* all new name should not begins with a "_" ; hence we prefix by "n_" *)
let name = "n_" ^ name in
if not (Hashtbl.mem node_name_tbl name) then
(
(* that name won't clash, but let's tabulate it *)
Hashtbl.add node_name_tbl name 2;
Hashtbl.add node_key_tbl nk name;
name
)
else
(* That name have already been given, there is a possible clash! *)
let cpt = Hashtbl.find node_name_tbl name in
let fresh_name =
Hashtbl.replace node_name_tbl name (cpt+1);
Erwan Jahier
committed
name ^ "_" ^ (string_of_int cpt)
in
Hashtbl.add node_key_tbl nk fresh_name;
fresh_name
(********************************************************************************)
(* Dealing with fresh local (to the node) variable idents *)
let local_var_tbl = Hashtbl.create 0
(* exported *)
let (reset_local_var_prefix : string -> unit) =
fun str ->
Hashtbl.remove local_var_tbl str
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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
(********************************************************************************)
(* The idea is to prefix fresh var name by "_", except if at least
one user ident begins by "_". In that case, we try to prefix them
by "_0", and then "_1", and so on so forth. We take the first
possible one.
nb : this won't work if the user defined idents from "_1" to
"_1073741823" (on 32-bits machine), but I bet that this compiler
would die before anyway...
nb : We stored in ParserUtils.name_table the set of idents that begins by "_".
*)
let fresh_var_prefix = ref "_"
let char_is_int = function
|'0'|'1'|'2'|'3'|'4'|'5'|'6'|'7'|'8'|'9' -> true
| _ -> false
(* Returns None if str.[1] is not an int, and Some i otherwhise,
where i is the biggest possible int in str after the "_" (e.g.,
"_23toto" returns "Some 23" *)
let (get_int : string -> int option) =
fun str ->
let _ = assert (str<>"" && str.[0]='_') in
let s = String.length str in
if s>1 && char_is_int str.[1] then
let j = ref 2 in
while !j<s && char_is_int str.[!j] do incr j done;
Some (int_of_string (String.sub str 1 (!j-1)))
else
None
let _ = (* A few unit tests *)
assert (get_int "_" = None);
assert (get_int "_toto" = None);
assert (get_int "_1" = Some 1);
assert (get_int "_1234" = Some 1234);
assert (get_int "_1234toto" = Some 1234)
module IntSet =
Set.Make(struct
type t = int
let compare = compare
end)
(* exported *)
let (update_fresh_var_prefix : unit -> unit) =
fun _ ->
let used_ints = (* the set of ints apprearing after a "_" in program idents *)
Hashtbl.fold
(fun name _ acc ->
match get_int name with
None -> IntSet.add (-1) acc
| Some i -> IntSet.add i acc
)
ParserUtils.name_table
IntSet.empty
in
let used_ints = IntSet.elements used_ints in
let rec find_int l =
match l with
| [] -> -1
| [i] -> if i > 0 then 0 else i+1
| i::j::tail -> if j=i+1 then find_int (j::tail) else i+1
in
let index = find_int used_ints in
if index = (-1) then
()
(* no var begins by "_", so "_" is a good prefix.*)
else (
let new_prefix = ("_" ^ (string_of_int index)) in
fresh_var_prefix := new_prefix ;
if (Verbose.get_level()>1) then (
print_string ("I use " ^ new_prefix ^ " as prefix for fresh var names.\n");
flush stdout
)
)
(********************************************************************************)
(* exported *)
let (new_local_var : string -> string) =
fun prefix ->
try
let cpt = Hashtbl.find local_var_tbl prefix in
Hashtbl.replace local_var_tbl prefix (cpt+1);
!fresh_var_prefix ^ prefix ^"_"^ (string_of_int cpt)
with
Not_found ->
Hashtbl.add local_var_tbl prefix 2;
!fresh_var_prefix ^ prefix ^ "_1"
(********************************************************************************)
let (array_type : Eff.type_ -> string -> string) =
fun t name ->
"A_" ^ name