Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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