Skip to content

Commit 8a3f396

Browse files
hhugovouillon
hhugo
authored and
vouillon
committed
Compiler: rewrite of js_assign
1 parent 01dae16 commit 8a3f396

File tree

2 files changed

+110
-81
lines changed

2 files changed

+110
-81
lines changed

‎compiler/lib/js_assign.ml‎

Lines changed: 108 additions & 81 deletions
Original file line numberDiff line numberDiff line change
@@ -83,17 +83,21 @@ while compiling the OCaml toplevel:
8383
type alloc =
8484
{ mutable first_free : int
8585
; used : BitSet.t
86+
; existing_names : StringSet.t
8687
}
8788

88-
let make_alloc_table () = { first_free = 0; used = BitSet.create () }
89+
let make_alloc_table existing_names =
90+
{ first_free = 0; used = BitSet.create (); existing_names }
8991

9092
let next_available a i = BitSet.next_free a.used (max i a.first_free)
9193

9294
let allocate a i =
9395
BitSet.set a.used i;
9496
if a.first_free = i then a.first_free <- BitSet.next_free a.used a.first_free
9597

96-
let is_available l i = List.for_all l ~f:(fun a -> not (BitSet.mem a.used i))
98+
let is_available l name i =
99+
List.for_all l ~f:(fun a ->
100+
(not (BitSet.mem a.used i)) && not (StringSet.mem name a.existing_names))
97101

98102
let first_available l =
99103
let rec find_rec n l =
@@ -105,16 +109,16 @@ while compiling the OCaml toplevel:
105109
let mark_allocated l i = List.iter l ~f:(fun a -> allocate a i)
106110

107111
type t =
108-
{ constr : alloc list array
109-
; (* Constraints on variables *)
110-
mutable parameters : Var.t list array
111-
; (* Function parameters *)
112-
mutable constraints : S.t list
112+
{ constr : alloc list array (* Constraints on variables *)
113+
; mutable parameters : Var.t list array (* Function parameters *)
114+
; printer : Var_printer.t
113115
}
114116

115-
(* For debugging *)
116-
117-
let create nv = { constr = Array.make nv []; parameters = [| [] |]; constraints = [] }
117+
let create nv =
118+
{ constr = Array.make nv []
119+
; parameters = [| [] |]
120+
; printer = Var_printer.create Var_printer.Alphabet.javascript
121+
}
118122

119123
let allocate_variables t ~count =
120124
let weight v = try IdentMap.find (V (Var.of_idx v)) count with Not_found -> 0 in
@@ -125,7 +129,7 @@ while compiling the OCaml toplevel:
125129
idx.(i) <- i
126130
done;
127131
Array.stable_sort idx ~cmp:(fun i j -> compare (weight j) (weight i));
128-
let name = Array.make len "" in
132+
let names = Array.make len "" in
129133
let n0 = ref 0 in
130134
let n1 = ref 0 in
131135
let n2 = ref 0 in
@@ -138,22 +142,19 @@ while compiling the OCaml toplevel:
138142
n2 := !n2 + weight i);
139143
n3 := !n3 + weight i
140144
in
141-
let nm ~origin n =
142-
let n = Var.to_string ~origin:(Var.of_idx origin) (Var.of_idx n) in
143-
name.(origin) <- n
144-
in
145145
let total = ref 0 in
146146
let bad = ref 0 in
147147
for i = 0 to Array.length t.parameters - 1 do
148+
let name = Var_printer.to_string t.printer i in
148149
List.iter
149150
(List.rev t.parameters.(i))
150151
~f:(fun x ->
151152
incr total;
152153
let idx = Var.idx x in
153154
let l = constr.(idx) in
154-
if is_available l i
155+
if is_available l name i
155156
then (
156-
nm ~origin:idx i;
157+
names.(idx) <- name;
157158
mark_allocated l i;
158159
stats idx i)
159160
else incr bad)
@@ -165,29 +166,49 @@ while compiling the OCaml toplevel:
165166
(!total - !bad)
166167
!total;
167168
for i = 0 to len - 1 do
168-
let l = constr.(idx.(i)) in
169-
if (not (List.is_empty l)) && String.length name.(idx.(i)) = 0
170-
then (
171-
let n = first_available l in
172-
let idx = idx.(i) in
173-
nm ~origin:idx n;
174-
mark_allocated l n;
175-
stats idx n);
176-
if List.is_empty l then assert (weight idx.(i) = 0)
169+
let idx = idx.(i) in
170+
let l = constr.(idx) in
171+
(if (not (List.is_empty l)) && String.length names.(idx) = 0
172+
then
173+
let rec loop () =
174+
let n = first_available l in
175+
let name = Var_printer.to_string t.printer n in
176+
if List.for_all l ~f:(fun a -> not (StringSet.mem name a.existing_names))
177+
then (
178+
names.(idx) <- name;
179+
mark_allocated l n;
180+
stats idx n)
181+
else (
182+
mark_allocated l n;
183+
loop ())
184+
in
185+
loop ());
186+
if List.is_empty l then assert (weight idx = 0)
177187
done;
178188
if debug_shortvar ()
179189
then (
180190
Format.eprintf "short variable count: %d/%d@." !n1 !n0;
181191
Format.eprintf "short variable occurrences: %d/%d@." !n2 !n3);
182-
name
192+
names
183193

184194
let add_constraints global u ~offset (params : ident list) =
185195
let constr = global.constr in
186-
let c = make_alloc_table () in
187-
S.iter
188-
(fun v ->
189-
let i = Var.idx v in
190-
constr.(i) <- c :: constr.(i))
196+
let existing_names =
197+
Javascript.IdentSet.fold
198+
(fun x acc ->
199+
match x with
200+
| V _ -> acc
201+
| S { name = Utf8 name; _ } -> StringSet.add name acc)
202+
u
203+
StringSet.empty
204+
in
205+
let c = make_alloc_table existing_names in
206+
Javascript.IdentSet.iter
207+
(function
208+
| S _ -> ()
209+
| V v ->
210+
let i = Var.idx v in
211+
constr.(i) <- c :: constr.(i))
191212
u;
192213
let params = Array.of_list params in
193214
let len = Array.length params in
@@ -206,8 +227,7 @@ while compiling the OCaml toplevel:
206227
match params.(i) with
207228
| V x -> global.parameters.(i + offset) <- x :: global.parameters.(i + offset)
208229
| _ -> ()
209-
done;
210-
global.constraints <- u :: global.constraints
230+
done
211231

212232
let record_block state scope (block : Js_traverse.block) =
213233
let all =
@@ -223,15 +243,6 @@ while compiling the OCaml toplevel:
223243
let ids = bound_idents_of_binding p in
224244
List.fold_left ids ~init:all ~f:(fun all i -> Javascript.IdentSet.add i all)
225245
in
226-
let all =
227-
Javascript.IdentSet.fold
228-
(fun x acc ->
229-
match x with
230-
| V i -> S.add i acc
231-
| S _ -> acc)
232-
all
233-
S.empty
234-
in
235246
match block with
236247
| Normal -> add_constraints state all ~offset:0 []
237248
| Catch (v, _) -> add_constraints state all ~offset:5 (bound_idents_of_binding v)
@@ -249,7 +260,7 @@ module Preserve : Strategy = struct
249260

250261
type t =
251262
{ size : int
252-
; mutable scopes : (S.t * Js_traverse.t) list
263+
; mutable scopes : (S.t * Javascript.IdentSet.t) list
253264
}
254265

255266
let create size = { size; scopes = [] }
@@ -265,6 +276,11 @@ module Preserve : Strategy = struct
265276
Javascript.IdentSet.elements
266277
(IdentSet.union scope.Js_traverse.def_var scope.Js_traverse.def_local)
267278
in
279+
let all =
280+
Javascript.IdentSet.union
281+
(Javascript.IdentSet.union scope.Js_traverse.def_var scope.Js_traverse.def_local)
282+
scope.Js_traverse.use
283+
in
268284
let defs =
269285
List.fold_left
270286
~init:S.empty
@@ -274,49 +290,64 @@ module Preserve : Strategy = struct
274290
| S _ -> acc)
275291
defs
276292
in
277-
278-
t.scopes <- (defs, scope) :: t.scopes
293+
t.scopes <- (defs, all) :: t.scopes
279294

280295
let allocate_variables t ~count:_ =
281296
let names = Array.make t.size "" in
282-
List.iter t.scopes ~f:(fun (defs, state) ->
283-
let assigned =
297+
List.iter t.scopes ~f:(fun (defs, all) ->
298+
let reserved =
284299
IdentSet.fold
285300
(fun var acc ->
286301
match var with
287302
| S { name = Utf8 s; _ } -> StringSet.add s acc
288303
| V v ->
289304
let name = names.(Var.idx v) in
290305
if not (String.is_empty name) then StringSet.add name acc else acc)
291-
(IdentSet.union
292-
state.Js_traverse.use
293-
(IdentSet.union state.Js_traverse.def_var state.Js_traverse.def_local))
294-
Reserved.keyword
306+
all
307+
StringSet.empty
295308
in
296-
let _assigned =
309+
let unamed = ref 0 in
310+
let _reserved =
297311
S.fold
298-
(fun var assigned ->
312+
(fun var reserved ->
299313
assert (String.is_empty names.(Var.idx var));
300314
let name =
301315
match Var.get_name var with
302316
| Some expected_name ->
303317
assert (not (String.is_empty expected_name));
304-
if not (StringSet.mem expected_name assigned)
318+
assert (not (StringSet.mem expected_name Reserved.keyword));
319+
if not (StringSet.mem expected_name reserved)
305320
then expected_name
306321
else
322+
let expected_name =
323+
if Char.equal expected_name.[String.length expected_name - 1] '$'
324+
then expected_name
325+
else expected_name ^ "$"
326+
in
307327
let i = ref 0 in
308328
while
309-
StringSet.mem (Printf.sprintf "%s$%d" expected_name !i) assigned
329+
StringSet.mem (Printf.sprintf "%s%d" expected_name !i) reserved
310330
do
311331
incr i
312332
done;
313-
Printf.sprintf "%s$%d" expected_name !i
314-
| None -> Var.to_string var
333+
Printf.sprintf "%s%d" expected_name !i
334+
| None ->
335+
while
336+
let name =
337+
Var_printer.Alphabet.to_string
338+
Var_printer.Alphabet.javascript
339+
!unamed
340+
in
341+
StringSet.mem name reserved || StringSet.mem name Reserved.keyword
342+
do
343+
incr unamed
344+
done;
345+
Var_printer.Alphabet.to_string Var_printer.Alphabet.javascript !unamed
315346
in
316347
names.(Var.idx var) <- name;
317-
StringSet.add name assigned)
348+
StringSet.add name reserved)
318349
defs
319-
assigned
350+
reserved
320351
in
321352
());
322353
names
@@ -352,7 +383,9 @@ class traverse_labels h =
352383

353384
class name ident label =
354385
object (m)
355-
inherit Js_traverse.subst ident as super
386+
inherit Js_traverse.map as super
387+
388+
method ident x = ident x
356389

357390
method statement =
358391
function
@@ -374,24 +407,22 @@ let program' (module Strategy : Strategy) p =
374407
o#program p
375408
in
376409
mapper#record_block Normal;
377-
let free =
378-
IdentSet.filter
379-
(function
380-
| V _ -> true
381-
| S _ -> false)
410+
let freevar =
411+
IdentSet.fold
412+
(fun ident acc ->
413+
match ident with
414+
| V v -> Var.Set.add v acc
415+
| S _ -> acc)
382416
mapper#get_free
417+
Var.Set.empty
383418
in
384-
let has_free_var = IdentSet.cardinal free <> 0 in
419+
let has_free_var = not (Var.Set.is_empty freevar) in
385420
let unallocated_names = ref Var.Set.empty in
386421
let names = Strategy.allocate_variables state ~count:mapper#get_count in
387422
(* ignore the choosen name for escaping/free [V _] variables *)
388-
IdentSet.iter
389-
(function
390-
| S _ -> ()
391-
| V x -> names.(Var.idx x) <- "")
392-
free;
423+
Var.Set.iter (fun x -> names.(Var.idx x) <- "") freevar;
393424
let ident = function
394-
| V v -> (
425+
| V v as x -> (
395426
if Config.Flag.stable_var ()
396427
then
397428
ident ~var:v (Utf8_string.of_string_exn (Printf.sprintf "v%d" (Code.Var.idx v)))
@@ -400,9 +431,9 @@ let program' (module Strategy : Strategy) p =
400431
match name with
401432
| "" ->
402433
unallocated_names := Var.Set.add v !unallocated_names;
403-
V v
434+
x
404435
| _ -> ident ~var:v (Utf8_string.of_string_exn name))
405-
| x -> x
436+
| S _ as x -> x
406437
in
407438
let label_printer = Var_printer.create Var_printer.Alphabet.javascript in
408439
let max_label_depth = Hashtbl.fold (fun _ d acc -> max d acc) labels 0 in
@@ -423,7 +454,7 @@ let program' (module Strategy : Strategy) p =
423454
then
424455
Format.eprintf
425456
"Some variables escaped (#%d). Use [--debug js_assign] for more info.@."
426-
(IdentSet.cardinal free)
457+
(Var.Set.cardinal freevar)
427458
else
428459
let (_ : Source_map.info) =
429460
Js_output.program
@@ -432,11 +463,7 @@ let program' (module Strategy : Strategy) p =
432463
p
433464
in
434465
Format.eprintf "Some variables escaped:";
435-
IdentSet.iter
436-
(function
437-
| S _ -> ()
438-
| V v -> Format.eprintf " <%s>" (Var.to_string v))
439-
free;
466+
Var.Set.iter (fun v -> Format.eprintf " <%a>" Var.print v) freevar;
440467
Format.eprintf "@."
441468
in
442469
assert false);

‎compiler/lib/var_printer.mli‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,8 @@ module Alphabet : sig
2323
type t
2424

2525
val javascript : t
26+
27+
val to_string : t -> int -> string
2628
end
2729

2830
type t

0 commit comments

Comments
 (0)