-
Notifications
You must be signed in to change notification settings - Fork 125
/
imp_Renaming.ml
821 lines (779 loc) · 31.2 KB
/
imp_Renaming.ml
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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
module J = JsAst
module String = Base.String
module List = Base.List
exception NotImplemented
(*--------------------------------*)
(*---- control flow -------------*)
(*--------------------------------*)
type expr_or_stm =
| Expr of J.expr
| Stm of J.statement
type node = {
name : string; (* this name is for debug *)
id : int; (* this id is used to define comparison/hashing on nodes *)
label : Annot.t option; (* the label is used to identify the expr of statement
* that generated the current node
* it is only meant for cleaning useless assigments *)
def : JsIdentSet.t; (* FIXME: should be small sets *)
use : JsIdentSet.t; (* FIXME: should be small sets *)
mutable live_in : JsIdentSet.t; (* FIXME: should be small sets *)
mutable live_out : JsIdentSet.t; (* FIXME: should be small sets *)
content : expr_or_stm; (* unused, could be removed *)
alias : bool; (* when true, then the current node is an alias
* and so it is treated specially when building the
* interference graph *)
}
let next_id =
let id_ref = ref 0 in
fun () -> incr id_ref; !id_ref
let node_of_gen name ?(alias=false) ?(use=[]) ?def gen =
let alias = #<If:JS_RENAMING$contains "alias">false#<Else>alias#<End> in
let def, label =
match def with
| None -> [], None
| Some (d, None) -> d, None
| Some (d, Some loc) -> d, Some (Annot.annot loc) in
assert (not alias || List.length use = 1 && List.length def = 1);
{
name = name;
id = next_id ();
label = label;
def = JsIdentSet.from_list def;
use = JsIdentSet.from_list use;
live_in = JsIdentSet.empty;
live_out = JsIdentSet.empty;
content = gen;
alias = alias;
}
let node_of_stm name ?alias ?use ?def stm = node_of_gen name ?alias ?use ?def (Stm stm)
let node_of_expr name ?alias ?use ?def expr = node_of_gen name ?alias ?use ?def (Expr expr)
(* this environment is used for building the control flow graph *)
type env = {
labels : node StringMap.t;
current_break : node option; (* the statement where we go when we say break *)
current_continue: node option; (* the statement where we go when we say continue
* possibly not the same as the one before because
* a switch 'catches' break but not continue
*)
current_return: node option;
}
module Node =
struct
type t = node
let compare n1 n2 = compare n1.id n2.id
let hash n = Hashtbl.hash n.id
let equal n1 n2 = n1.id = n2.id
end
module G = Graph.Imperative.Digraph.Concrete(Node)
module SCC = Graph.Components.Make (G)
(* DEBUG *)
let vertex_name n =
n.name ^
"_DEF_"^
String.concat_map "_" JsIdent.stident (JsIdentSet.elements n.def) ^
"_USE_"^
String.concat_map "_" JsIdent.stident (JsIdentSet.elements n.use) ^
"_ID_" ^
string_of_int n.id
let vertex_name2 n =
vertex_name n ^
"_IN_" ^
String.concat_map "_" JsIdent.stident (JsIdentSet.elements n.live_in) ^
"_OUT_" ^
String.concat_map "_" JsIdent.stident (JsIdentSet.elements n.live_out)
module Viz = GraphUtils.DefaultGraphviz(G)(struct let vertex_name = vertex_name end)
module Viz2 = GraphUtils.DefaultGraphviz(G)(struct let vertex_name = vertex_name2 end)
(* END DEBUG *)
module GIdent = Graph.Imperative.Graph.Concrete(JsIdent)
module Coloring = Graph.Coloring.Make(GIdent)
(* DEBUG *)
module Viz3 = GraphUtils.DefaultGraphviz(GIdent)(struct let vertex_name = JsIdent.stident end)
(* END DEBUG *)
(*
* This function build a graph where there is a node for each assigment
* to an identifier and each use of an identifier (local or global)
* (plus some more nodes that are used only for building the graph
* especially for statements)
* There is an edge from a node [a] to a node [b] when [b] can be executed after [a]
* For instance when you have the program [x = y], you need to read [y] and then
* you write [x]
* The control flow graph would be [(y-use) -> (x-def)]
*)
let build_control_flow_graph ?name params body =
let g = G.create () in
let node_of_stm name ?alias ?use ?def stm =
let node = node_of_stm name ?alias ?use ?def stm in
G.add_vertex g node;
node in
let node_of_expr name ?alias ?use ?def expr =
let node = node_of_expr name ?alias ?use ?def expr in
G.add_vertex g node;
node in
let link n1 n2 =
G.add_edge g n1 n2 in
let env = {
labels = StringMap.empty;
current_break = None;
current_continue = None;
current_return = None;
} in
let local_vars = ref JsIdentSet.empty in
(* [aux] returns the entry node and output node of the control flow graph
* of the [orig_stm] *)
let rec aux_stm env orig_stm =
match orig_stm with
| J.Js_while (_, expr, stm) ->
let while1 = node_of_stm "while1" orig_stm in
let while2 = node_of_stm "while2" orig_stm in
let from_e = aux_expr while1 expr in
let to_s, from_s =
aux_stm
{env with
current_break = Some while2;
current_continue = Some while1;
} stm in
link from_e to_s;
link from_s while1;
link from_e while2;
while1, while2
| J.Js_for (_, e1, e2, e3, s) ->
let for1 = node_of_stm "for1" orig_stm in
let for2 = node_of_stm "for2" orig_stm in
let for3 = node_of_stm "for3" orig_stm in
let for4 = node_of_stm "for4" orig_stm in
let from_e1 = aux_expr_option for1 e1 in
let to_s,from_s =
aux_stm
{env with
current_break = Some for4;
current_continue = Some for3;
} s in
link from_s for3;
link from_e1 for2;
let from_e2 = aux_expr_option for2 e2 in
link from_e2 to_s;
let from_e3 = aux_expr_option for3 e3 in
link from_e3 for2;
link from_e2 for4;
for1, for4
| J.Js_forin _ ->
raise NotImplemented
| J.Js_var (_,_,None) ->
let dummy = node_of_stm "var_no_assign" orig_stm in
dummy, dummy
| J.Js_var (label,i,Some e) ->
aux_stm env (J.Js_expr (label, J.Je_binop (label, J.Jb_assign, J.Je_ident (label,i), e)))
| J.Js_with _ ->
assert false
| J.Js_block (_,sl) ->
aux_stms env sl
| J.Js_function _ ->
raise NotImplemented (* dealing with local function seems to be pretty hard without a global analysis *)
| J.Js_return (_, Some e) ->
let return = node_of_stm "return" orig_stm in
let to_ = aux_expr return e in
link to_ (Option.get env.current_return);
(* i think this is conservative but i am not so sure *)
(* FIXME: should probably return (return, `return)
* and that way, we don't the env anymore *)
return, to_
| J.Js_return (_, None) ->
let return = node_of_stm "return" orig_stm in
link return (Option.get env.current_return);
(* FIXME: same problem as above *)
return, return
| J.Js_continue (_, o) ->
(* FIXME: same problem as above *)
let continue = node_of_stm "continue" orig_stm in
link continue (
match o with
| None -> Option.get env.current_continue
| Some label -> StringMap.find label env.labels);
continue, continue
| J.Js_break (_, o) ->
let break = node_of_stm "break" orig_stm in
link break (
match o with
| None -> Option.get env.current_break
| Some label -> StringMap.find label env.labels
);
(* FIXME same problem as above *)
break, break
| J.Js_switch (_,e,esl,o) ->
let start = node_of_stm "switch1" orig_stm in
let end_ = node_of_stm "switch2" orig_stm in
let from_e = aux_expr start e in
let env = {env with current_break = Some end_} in
(match esl with
| [] -> assert false
| (e',s) :: esl ->
let from_e' = aux_expr from_e e' in
let start_s, end_s = aux_stm env s in
link from_e' start_s;
let last_end_s =
List.fold_left
(fun last_end_s (e',s) ->
let from_e' = aux_expr from_e e' in
let start_s, end_s = aux_stm env s in
link from_e' start_s;
link last_end_s start_s;
end_s
) end_s esl in
match o with
| None -> link from_e end_; link last_end_s end_
| Some s ->
let start_s, end_s = aux_stm env s in
link last_end_s start_s;
link from_e start_s;
link end_s end_);
start, end_
| J.Js_throw _ ->
(* exceptions are not dealt with
* presumably, you should say that a throw flows to the exit of
* the current function *)
raise NotImplemented
| J.Js_label (_, label, s) ->
let node = node_of_stm "label" orig_stm in
let env = {env with labels = StringMap.add label node env.labels} in
aux_stm env s
| J.Js_if (_,e,s,o) ->
let start = node_of_stm "if1" orig_stm in
let end_ = node_of_stm "if2" orig_stm in
let from_e = aux_expr start e in
let to_s, from_s = aux_stm env s in
link from_e to_s;
link from_s end_;
(match o with
| None ->
link from_e end_
| Some s ->
let to_s, from_s = aux_stm env s in
link from_e to_s;
link from_s end_
);
start, end_
| J.Js_expr (_, e) ->
let start = node_of_stm "expr" orig_stm in
start, aux_expr start e
| J.Js_trycatch _ ->
(* that one is possible is to do, but you have to assume that every function call
* can possibly raise exceptions *)
raise NotImplemented
| J.Js_dowhile _ ->
(* this one is just lazyness, because nobody uses it *)
raise NotImplemented
| J.Js_comment _ ->
let dummy = node_of_stm "comment" orig_stm in
dummy, dummy
and aux_stms env stms =
(match stms with
| [] ->
let dummy = node_of_stm "emptyblock" (JsCons.Statement.block []) in
dummy, dummy
| s :: stms ->
let to_s, from_s = aux_stm env s in
let from_stms =
List.fold_left
(fun from s ->
let to_, from2 = aux_stm env s in
link from to_;
from2
) from_s stms in
to_s, from_stms)
and aux_expr_option from = function
| None -> from
| Some e -> aux_expr from e
(* [aux_expr] returns the output node of the control flow graph
* of [expr] that starts at [from] *)
and aux_expr from orig_expr =
match orig_expr with
| J.Je_ident (_,i) when JsIdentSet.mem i !local_vars
->
let node = node_of_expr "ident_use" ~use:[i] orig_expr in
link from node;
node
| J.Je_ident _
| J.Je_this _
| J.Je_string _
| J.Je_num _
| J.Je_null _
| J.Je_undefined _
| J.Je_bool _
| J.Je_regexp _
->
from
| J.Je_function _ ->
(* presumably we should analyse the body of the function and
* local variables from our scope used inside the local function
* flow to the function entry point
* and when we see a call to the function then the flow of the control
* goes to the caller, the arugments, the entry point and then comes out of its exit
* (thus the variables captured by the closures are used
* when the closure is used)
* and what if the closure escape the scope?
* the closure just flows to the exit of the function which
* should possibly count as a use of the function *)
raise NotImplemented (* what should i do ?? *)
| J.Je_array (_,el) ->
List.fold_left aux_expr from el
| J.Je_comma (_, el, e) ->
aux_expr (List.fold_left aux_expr from el) e
| J.Je_object (_,sel) ->
List.fold_left (fun from (_s,e) -> aux_expr from e) from sel
| J.Je_call (_,e,el,_)
| J.Je_new (_,e,el) ->
List.fold_left aux_expr (aux_expr from e) el
| J.Je_unop (label,( J.Ju_add2_pre
| J.Ju_sub2_pre
| J.Ju_add2_post
| J.Ju_sub2_post
), J.Je_ident (_,i)) when JsIdentSet.mem i !local_vars ->
let node = node_of_expr "ident_incr" ~def:([i],Some label) ~use:[i] orig_expr in
link from node;
node
| J.Je_dot (_,e,_)
| J.Je_unop (_,_,e) ->
aux_expr from e
| J.Je_binop (label, J.Jb_assign, J.Je_ident (_,i), J.Je_ident (_,j)) when JsIdentSet.mem i !local_vars ->
(* special case for aliases
* if we don't do that, then we can not squash some aliases
* in expression such as
* (x = y, $an expression using x and y$) *)
let alias, use = if JsIdentSet.mem j !local_vars then true, [j] else false, [] in
let node = node_of_expr "ident_alias" ~alias ~def:([i],Some label) ~use orig_expr in
link from node;
node
| J.Je_binop (label,
( J.Jb_assign
| J.Jb_mul_assign
| J.Jb_div_assign
| J.Jb_mod_assign
| J.Jb_add_assign
| J.Jb_sub_assign
| J.Jb_lsl_assign
| J.Jb_lsr_assign
| J.Jb_asr_assign
| J.Jb_and_assign
| J.Jb_xor_assign
| J.Jb_or_assign as op ), J.Je_ident (_,i), e) as orig_expr when JsIdentSet.mem i !local_vars ->
(* [i += e] must first read [i], and then evaluate [e] (because [e] may change the value of [i]) *)
let node =
if op = J.Jb_assign then
from
else (
let node = node_of_expr "ident_def_use" ~use:[i] orig_expr in
link from node;
node
) in
let to_e = aux_expr node e in
let node = node_of_expr "ident_def" ~def:([i],Some label) orig_expr in
link to_e node;
node
| J.Je_binop (_,_,e1,e2) ->
(* when you have an assigmment to something that is not an ident
* (like [r.field]) then it doesn't count as defining [r]
* it is actually a use of [r] ! *)
aux_expr (aux_expr from e1) e2
| J.Je_cond (_,e1,e2,e3) ->
let to_1 = aux_expr from e1 in
let to_2 = aux_expr to_1 e2 in
let to_3 = aux_expr to_1 e3 in
let node = node_of_expr "ift" orig_expr in
link to_2 node;
link to_3 node;
node
| J.Je_runtime (_, e) -> (
match e with
| JsAstRuntime.SetDistant _ -> raise Exit
| JsAstRuntime.TaggedString _ -> from
)
| J.Je_hole _
->
raise Exit (* we cannot do anything in that case
* so we abort the analysis *) in
let build_graph_for_a_function code_elt ?name params body =
let arguments = JsCons.Ident.native "arguments" in
local_vars := JsIdentSet.from_list params;
local_vars :=
List.fold_left (
JsWalk.OnlyStatement.fold
(fun local_vars -> function
| J.Js_var (_,i,_)
| J.Js_function (_,i,_,_) ->
if JsIdent.equal i arguments then
raise Exit (* if you can use a parameter by saying arguments[i]
* then some uses of your parameters are hidden
* and squashing won't be correct *)
else
JsIdentSet.add i local_vars
| _ -> local_vars
)
) !local_vars body;
let node = node_of_stm "function_entry" code_elt in
let node1 = node_of_stm "function_param" code_elt in
let node2 = node_of_stm "function_return" code_elt in
let node_params =
List.map (fun param -> node_of_stm ~use:params ~def:([param],None) "param" code_elt) params in
List.iter
(fun n1 ->
link node n1;
link n1 node1;
List.iter (fun n2 -> link n1 n2) node_params
) node_params;
try
let to_, from = aux_stms {env with current_return = Some node2} body in
link node1 to_;
link from node2;
let _file =
match name with
| Some J.ExprIdent s ->
let s = Ident.stident s in
if String.length s > 100 then String.sub s 0 100 else s
| Some J.Native (_,s) ->
if String.length s > 100 then String.sub s 0 100 else s
| None ->
"anon" in
#<If:JS_RENAMING$is_contained _file>Viz.to_file_and_ps (_file^"_0_cfg") g#<End>;
Some (_file, to_, g)
with
| Exit ->
(* someone aborted the analysis for good reasons *)
None
| NotImplemented ->
(* the analysis failed on a construct
* that it cannot handle for now *)
None
in
let code_elt = JsCons.Statement.block [] in (* FIXME: a bit dirty, but useless for now anyway *)
build_graph_for_a_function code_elt ?name params body
(*
* This function updates the control flow graph
* so that we know at each point which variables are needed
* and which aren't
*)
let liveliness_analysis g =
(* i think i remember that SCC.scc_list is buggy *)
let groups = Array.to_list (SCC.scc_array g) in
List.iter
(fun nodes ->
while (* fixpoint *) (
List.fold_left
(fun continue node ->
let live_out =
G.fold_succ (fun vertex acc -> JsIdentSet.union vertex.live_in acc) g node JsIdentSet.empty in
let new_live_out = JsIdentSet.union live_out node.live_out in
node.live_out <- new_live_out;
let old_live_in = node.live_in in
let new_live_in = JsIdentSet.union node.use (JsIdentSet.diff new_live_out node.def) in
node.live_in <- new_live_in;
(* whenever one [live_in] set is not stable in an iteration
* then we must continue looping *)
continue || JsIdentSet.size old_live_in <> JsIdentSet.size new_live_in
)
false nodes
) do () done
) groups
(*
* This function uses the control flow graph decorated by the liveliness
* analysis to create the inteference graph, ie a graph when local identifiers
* are nodes and there are edges between identifiers that cannot be squashed
* This function also returns the set of useless bindings
* (ie assigments that are never read)
*)
let build_interference_graph control_flow_graph =
let g = GIdent.create () in
G.iter_vertex
(fun node ->
JsIdentSet.iter
(fun v ->
GIdent.add_vertex g v
) node.def
) control_flow_graph;
let dummy_bindings = ref AnnotSet.empty in
G.iter_vertex
(fun node ->
let set1 = node.def in
let set2 = JsIdentSet.diff node.live_out node.def in
let set2 = if node.alias then JsIdentSet.diff set2 node.use else set2 in
if JsIdentSet.inter set1 node.live_out = JsIdentSet.empty
&& node.label <> None
&& #<If:JS_RENAMING$contains "binding">false#<Else>true#<End>
then (
(* beware: here we are not building the interference in the graph
* this is correct only because we know that the binding will be removed later *)
dummy_bindings := AnnotSet.add (Option.get node.label) !dummy_bindings;
) else
JsIdentSet.iter
(fun v1 ->
if GIdent.mem_vertex g v1 then
JsIdentSet.iter
(fun v2 ->
if GIdent.mem_vertex g v2 then
GIdent.add_edge g v1 v2
) set2
) set1
) control_flow_graph;
g, !dummy_bindings
(*
* Coloring the interference graph
* Each color then becomes one variable name
* Since several variables can be given the same color,
* variables can be squashed
*
* Here we do not try very hard to find a good coloring
* (currently, ocamlgraph implements a simple greedy algorithm)
* because trying harder completely blew up compilation times
* and it turns out to be satisfactory as is
*)
let color_interference_graph g =
let size = max 1 (GIdent.nb_vertex g) in
(size, Coloring.coloring g size)
(*
* This function uses to the result of the coloring
* to rename the code
* It also removes removes useless bindings as identified when
* building the interference graph
* Some care is taken:
* - to rename identifiers in a predictable order
* (you can't use colors directly as identifiers, it is too fragile)
* - to remove variable declarations
* that arise because several variables were squashed together
*)
let squash_variables dummy_bindings renaming params body =
(* colors seems to be numbered from 1 *)
(* the seen table allow one to avoid renaming *)
let length = Coloring.H.length renaming + 1 in
let seen = Array.make length false in
let var_of_int_unseen =
(* FIXME: could use an array instead of a hashtbl because *)
let next = let r = ref (-1) in fun () -> incr r; !r in
let h = Hashtbl.create length in
fun color ->
try Hashtbl.find h color
with Not_found ->
let ident = JsCons.Ident.native (IdentGenerator.alphanum (next ())) in
Hashtbl.add h color ident;
ident in
let var_of_int color =
seen.(color) <- true;
var_of_int_unseen color in
let orig_params = params in
let params =
let aux param = var_of_int (Coloring.H.find renaming param) in
List.map aux params in
(* first renaming variables in expressions *)
let body =
List.map
(JsWalk.ExprInStatement.map
(fun e ->
match e with
| J.Je_binop (label,_,_,e) when AnnotSet.mem (Annot.annot label) dummy_bindings ->
e
| J.Je_ident (label,s) ->
(try J.Je_ident (label, var_of_int (Coloring.H.find renaming s))
with Not_found -> e)
| J.Je_function _ -> assert false
| _ -> e)
) body in
(* the variables renamed so far are the only used variables (and not just defined variables) *)
List.iter (fun p ->
let color = Coloring.H.find renaming p in
seen.(color) <- false (* no need to put a var on a variable that is a parameter *)
) orig_params;
(* rewriting the Js_var nodes:
- remove duplicate [var] arising from squashed variables
- renaming the variables
- removing some bindings that were detected as useless
*)
let body =
List.map
(JsWalk.OnlyStatement.map_up (* map up because we must not call ourself recursively THERE *)
(fun s ->
match s with
| J.Js_var (label, s, Some e) when AnnotSet.mem (Annot.annot label) dummy_bindings ->
let color = Coloring.H.find renaming s in
if seen.(color) then (
seen.(color) <- false;
(* THERE *)
JsCons.Statement.block [
J.Js_var (label, var_of_int_unseen color, None);
J.Js_expr (label,e);
]
) else
J.Js_expr (label,e)
| J.Js_var (label, s, e) ->
(try
let color = Coloring.H.find renaming s in
if seen.(color) then (
seen.(color) <- false;
J.Js_var (label, var_of_int_unseen color, e)
) else
(* keeping only one var (plus possibly the same declaration
* but from a function parameter:
* [function f(a) { var a; return a }]) *)
match e with
| None -> JsCons.Statement.block []
| Some e -> JsCons.Statement.assign_ident (var_of_int_unseen color) e
with Not_found ->
(* we are in that case if there is a var in the code
* but its value is never used (and so it doesn't end up in
* the graphs) (only if e is None) *)
match e with
| None -> JsCons.Statement.block [] (* local var *)
| Some _ -> assert false)
| J.Js_function _ ->
assert false
| _ -> s
)
) body in
params, body
(* opera says the result of [function(){var x; {a:x, b:(x=1)}.a}()] is 1 when it should be undefined
* to solve this problem, whenever the value of an identifier is used directly as the value of a field
* in an object literal, it is replaced by [ident || ident] if it is overwritten in other fields
* because [function(){var x; {a:(x||x), b:(x=1)}.a}()] gives undefined all right
* A few examples
* {a:x, b:x} -> nothing happens
* {a:x, b:(x=1)} -> {a:x||x, b:(x=1)}
* {a:x, b:x}, x=1 -> nothing happens
* {a:(1,x), b:(x=1)} -> {a:(1,x||x), b:(x=1)}
* {a:(x,1), b:(x=1)} -> nothing happens
* {a:(y=x), b:(x=1)} -> {a:(y=x||x), b:(x=1)}
*)
let hack_for_opera body =
let map_stm stm =
let _acc, stm =
JsWalk.ExprInStatement.self_traverse_foldmap_context_down
(fun self tra env acc e ->
(* env:
* It is Some _ when we are in the rhs in an object literal
* only when we are directly under the colon of [field:expr]
* (and we accept going though the last expression in a comma
* the expression of an assignment, and the rhs of && and ||)
* in this case, env contains the set of identifiers that are assigned to
* by the following fields of the object literals
* In all other cases, env is None
*
* acc:
* accumulates the set of identifiers written to in the current expression
* this value is reset when entering an object literal
*)
match e with
| J.Je_object (label, sel) ->
let new_acc, sel' =
List.fold_right_map_stable
(fun acc ((s,e) as p) ->
let acc, e' = self (Some acc) acc e in
acc, if e == e' then p else (s, e')
) JsIdentSet.empty sel in
let acc = JsIdentSet.union acc new_acc in
acc,
if sel' == sel then
e
else
J.Je_object (label, sel')
| J.Je_ident (label,x) -> (
match env with
| Some set when JsIdentSet.mem x set ->
let label2 = Annot.refresh label in
acc, JsCons.Expr.lor_ (J.Je_ident (label,x)) (J.Je_ident (label2,x))
| _ ->
acc, e
)
| J.Je_binop (label, J.Jb_assign, e1, e2) -> (
match e1 with
| J.Je_ident (label, i) ->
let acc = JsIdentSet.add i acc in
let acc, e2' = self env acc e2 in
acc,
if e2 == e2' then e else J.Je_binop (label, J.Jb_assign, e1, e2')
| _ ->
let acc, e1' = self None acc e1 in
let acc, e2' = self env acc e2 in
acc,
if e1 == e1' && e2 == e2' then e else J.Je_binop (label, J.Jb_assign, e1', e2')
)
| J.Je_comma (label, el, last_e) ->
let acc, el' =
List.fold_left_map_stable
(fun acc e ->
let acc, e' = self None acc e in
acc, e'
) acc el in
let acc, last_e' = self env acc last_e in
acc,
if el == el' && last_e == last_e' then e else J.Je_comma (label, el',last_e')
(* special case for lazy operators,
* since they may not force the interpret to deference the pointers... *)
| J.Je_binop (label, (J.Jb_land | J.Jb_lor as op), e1, e2) ->
let acc, e1' = self None acc e1 in
let acc, e2' = self env acc e2 in
acc,
if e1 == e1' && e2 == e2' then e else J.Je_binop (label, op, e1', e2')
| _ -> tra None acc e
) None JsIdentSet.empty stm in
stm in
List.map map_stm body
(* TODO: simplify the graph:
* when a node has def = [] and use = []
* then it was used for building the graph but it can be short circuited now *)
let rename_function ?name params body =
let _chrono = Chrono.make () in
_chrono.Chrono.start ();
match build_control_flow_graph ?name params body with
| None -> params, body, true
| Some (_file, _entry, g) ->
#<If:JS_RENAMING$contains "time"> Printf.printf "** %s\n%!" _file #<End>;
#<If:JS_RENAMING$contains "time"> Printf.printf "cfg: %fs\n%!" (_chrono.Chrono.read ()); _chrono.Chrono.restart () #<End>;
liveliness_analysis g;
#<If:JS_RENAMING$contains "time"> Printf.printf "liveliness: %fs\n%!" (_chrono.Chrono.read ()); _chrono.Chrono.restart () #<End>;
#<If:JS_RENAMING$is_contained _file>Viz2.to_file_and_ps (_file^"_1_liv") g#<End>;
let ig, dummy_bindings = build_interference_graph g in
#<If:JS_RENAMING$contains "time"> Printf.printf "interference: %fs\n%!" (_chrono.Chrono.read ()); _chrono.Chrono.restart () #<End>;
#<If:JS_RENAMING$is_contained _file>Viz3.to_file_and_ps (_file^"_2_interf") ig#<End>;
let _k, h = color_interference_graph ig in
#<If:JS_RENAMING$contains "time"> Printf.printf "coloring: %fs\n%!" (_chrono.Chrono.read ()); _chrono.Chrono.restart () #<End>;
#<If:JS_RENAMING$is_contained _file>Printf.printf "colored with %d colors\n%!" _k#<End>;
let params, body = squash_variables dummy_bindings h params body in
#<If:JS_RENAMING$contains "time"> Printf.printf "squashing: %fs\n%!" (_chrono.Chrono.read ()); _chrono.Chrono.restart () #<End>;
let body = hack_for_opera body in
#<If:JS_RENAMING$contains "time"> Printf.printf "hack for opera: %fs\n%!" (_chrono.Chrono.read ()); _chrono.Chrono.restart () #<End>;
params, body, false
let rename_code_elt code_elt =
let failed, code_elt =
JsWalk.TStatement.traverse_foldmap
(fun tra _ acc stm ->
match stm with
| J.Js_function (label,name,params,body) ->
let params, body, failed = rename_function ~name params body in
if failed then
(* if it failed, we can still try to rewrite inner functions *)
tra true stm
else
acc, J.Js_function (label,name,params,body)
| _ -> tra acc stm)
(fun tra _ acc e ->
match e with
| J.Je_function (label,name,params,body) ->
let params, body, failed = rename_function ?name params body in
if failed then
tra true e
else
acc, J.Je_function (label,name,params,body)
| _ -> tra acc e)
false code_elt in
if failed then Imp_SimpleRenaming.local_alpha_stm code_elt else code_elt
let rename code =
List.map rename_code_elt code