Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 686 lines (646 sloc) 29.723 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 List = Base.List
20 module Format = Base.Format
21 module String = Base.String
22
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
23 (* Inlining works roughly as described in
24 http://research.microsoft.com/en-us/um/people/simonpj/Papers/inlining/
25
26 Note that it works only on generated code, and not on javascript in general
27 It cannot deal with code that is too imperative. However the generated code is not
28 completely functional either because the compilation of tail calls introduces some
29 assignments.
30 Due to this imperativeness, inlining is more complicated that what is described
31 in the paper.
32 *)
33
fccc685 Initial open-source release
MLstate authored
34 type occur_kind =
35 | NeverUsed (* in that case, the value of the binding is necessarily read
36 * if the var never appears and the value of its bindings is not
37 * read, the variable is not in the map *)
38 | Once of JsIdentSet.t * bool (* the var appears once after the bindings in the set
39 * and the value of its binding is not used
40 * the boolean is true if you must execute the use
41 * after having executed the defition
42 * for example, it is false in [x = f(); if bool then x],
43 * since f() may be a side effect, you cannot inline x
44 *)
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
45 | Multiple (* multiple occurrences after possibly any binding *)
fccc685 Initial open-source release
MLstate authored
46 (* BEWARE:
978b7c4 @akoprow [fix] typo: occurence->occurrence, occured->occurred
akoprow authored
47 * (a=1)+a counts as two occurrences of a
fccc685 Initial open-source release
MLstate authored
48 * when (a=1, a) counts as one occurrence of a
49 * because (a=1)+a really means (a=1,a)+a
50 *)
51
52 let occurrence_analysis params code =
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
53 let acc = JsIdentMap.empty in (* maps identifiers to their occur kind *)
fccc685 Initial open-source release
MLstate authored
54 let env = JsIdentSet.empty in (* the set of parameters that have been assigned at the current point in the program *)
55 let safe_vars = JsIdentSet.empty in (* the set of variables that are always used when defined (if they are used)
56 * used to compute the value of the boolean in the Once case of occur_kind
57 * this env is reset when going inside a switch or an if
58 * It seems to show that we really lack some control flow analysis here *)
59 let rec aux_s tra_s tra_e _need_value (env,acc,safe_vars) stm =
60 match stm with
61 | J.Js_switch (_,e,esl,o) ->
62 let env, acc, safe_vars = aux_e tra_e tra_s true (env,acc,safe_vars) e in
63 let acc = List.fold_left
64 (fun acc (e,s) ->
65 let _env, acc, _ = aux_e tra_e tra_s true (env,acc,JsIdentSet.empty) e in
66 (* we can dump this env because we know that no binding occurs in the expression *)
67 let _, acc, _ = aux_s tra_s tra_e true (env,acc,JsIdentSet.empty) s in
68 acc
69 ) acc esl in
70 let _, acc, _ =
71 match o with
72 | None -> env, acc, safe_vars
73 | Some s -> aux_s tra_s tra_e true (env,acc,JsIdentSet.empty) s in
74 env, acc, safe_vars
75 | J.Js_if (_,e,s1,o) ->
76 (* the case None for o is not generated by the backend but can happen
77 * because Imp_Cleanup generates it on cases like if () then {...} else { /* fall through */ }
78 * in that case, we do the same same as if the code hadn't been cleaned up *)
79 let env, acc, safe_vars = aux_e tra_e tra_s true (env,acc,safe_vars) e in
80 (* dumping the env that comes out *)
81 let _, acc, _ = aux_s tra_s tra_e true (env,acc, JsIdentSet.empty) s1 in
82 let acc =
83 match o with
84 | None -> acc
85 | Some s2 ->
86 let _, acc, _ = aux_s tra_s tra_e true (env,acc, JsIdentSet.empty) s2 in
87 acc in
88 env, acc, safe_vars
89
90 | J.Js_var (_,i,Some e) ->
91 assert (not (JsIdentSet.mem i params));
92 aux_assign tra_e tra_s false (env,acc,safe_vars) i e
93
94 | J.Js_expr (_,e) ->
95 aux_e tra_e tra_s false (env,acc,safe_vars) e
96
97 | J.Js_function _
98 | J.Js_throw _
99 | J.Js_trycatch _
100 | J.Js_with _ ->
101 OManager.i_error "@[<v2>Imp_inlining:@ @[<v2>unexpected construct@ %a@] in@ %a@]@\n"
102 JsPrint.pp#code [stm] JsPrint.pp#code code
103
104 | J.Js_var (_,_,None)
105 | J.Js_return _
106 | J.Js_continue _
107 | J.Js_break _
108 | J.Js_comment _
109 | J.Js_label _
110 | J.Js_block _
111 | J.Js_while _
112 | J.Js_dowhile _
113 | J.Js_for _
114 | J.Js_forin _ ->
115 tra_s true (env,acc,safe_vars) stm
116 and aux_assign tra_e tra_s need_value (env,acc,safe_vars) i e =
117 let env, acc, safe_vars = aux_e tra_e tra_s true (env,acc,safe_vars) e in
118 (* beware: do not count i, this is a def, not a use *)
119 (* beware not to put parameters in the map, we cannot inline them *)
120 if JsIdentSet.mem i params then
121 JsIdentSet.add i env, acc, safe_vars
122 else
123 env, (if need_value then JsIdentMap.add i NeverUsed acc else acc), (JsIdentSet.add i safe_vars)
124 and aux_e tra_e tra_s need_value (env,acc,safe_vars) expr =
125 match expr with
126 | J.Je_cond (_,e1,e2,e3) ->
127 (* we don't care about [env] in if then else in expression, because no tail calls appears in them *)
128 let env, acc, safe_vars = aux_e tra_e tra_s true (env, acc, safe_vars) e1 in
129 let env, acc, _ = aux_e tra_e tra_s true (env, acc, JsIdentSet.empty) e2 in
130 let env, acc, _ = aux_e tra_e tra_s true (env, acc, JsIdentSet.empty) e3 in
131 env, acc, safe_vars
132 | J.Je_comma (_,el,e) ->
133 let env, acc, safe_vars = List.fold_left (fun env_acc e -> aux_e tra_e tra_s false env_acc e) (env,acc,safe_vars) el in
134 let env, acc, safe_vars = aux_e tra_e tra_s need_value (env, acc, safe_vars) e in
135 env, acc, safe_vars
136 | J.Je_binop (_,J.Jb_assign,J.Je_ident (_,i),e) ->
137 aux_assign tra_e tra_s need_value (env,acc,safe_vars) i e
138 | J.Je_unop (_,op,_) when J.is_assignment_unop op -> assert false (* FIXME *)
139 | J.Je_binop (_,op,_,_) when J.is_assignment_binop op -> assert false
140 | J.Je_ident (_,i) ->
141 if JsIdentSet.mem i params then
142 (* same remark as in aux_assign *)
143 env, acc, safe_vars
144 else
145 let acc =
146 try
147 (match JsIdentMap.find i acc with
148 (* could actually compute the set of identifiers after which there are
149 * inline points in the multiple case too *)
150 | NeverUsed -> JsIdentMap.add i Multiple acc
151 | Once _ -> JsIdentMap.add i Multiple acc
152 | Multiple -> acc)
153 with Not_found ->
154 JsIdentMap.add i (Once (env, JsIdentSet.mem i safe_vars)) acc in
155 env, acc, safe_vars
156 | _ -> tra_e true (env,acc,safe_vars) expr in
157 let fold_stm (env,acc,safe_vars) stm =
158 JsWalk.TStatement.traverse_fold_context_down aux_s aux_e true (env,acc,safe_vars) stm in
159 let _env, acc, _ =
160 List.fold_left fold_stm (env,acc,safe_vars) code in
161 (*Printf.printf ">>>\n%!";
162 JsIdentMap.iter
163 (fun i k ->
164 Printf.printf "%s: " (JsIdent.to_string i);
165 (match k with
166 | Once (s,b) -> Printf.printf "Once safe:%b" b; JsIdentSet.iter (fun s -> Printf.printf " %s" (JsIdent.to_string s)) s
167 | Multiple -> Printf.printf "Multiple"
168 | NeverUsed -> Printf.printf "NeverUsed");
169 Printf.printf "\n%!"
170 ) acc;*)
171 acc
172
173
174 let contains_vars params e =
175 JsWalk.Expr.exists
176 (function
177 | J.Je_ident (_,i) -> JsIdentSet.mem i params
178 | _ -> false)
179 e
180
09ecac9 @OpaOnWindowsNow [enhance] qmljsimp/imp_Code: add datastructure depthness limitation, …
OpaOnWindowsNow authored
181 let rec object_depth = function
182 | J.Je_object (_, fields) -> 1 + (List.fold_left (fun m (_,e) -> max (object_depth e) m ) 0 fields)
183 | _ -> 0
184
185 let local_inlining_maximal_object_depth = 5
186
fccc685 Initial open-source release
MLstate authored
187 let local_inlining_policy = function
188 | J.Je_ident _
189 | J.Je_num _
190 | J.Je_bool _
191 | J.Je_null _
192 | J.Je_undefined _ (* beware could be redefined *)
193 | J.Je_this _ (* beware, do not inline that inside a local function! *)
194 -> `always
195
09ecac9 @OpaOnWindowsNow [enhance] qmljsimp/imp_Code: add datastructure depthness limitation, …
OpaOnWindowsNow authored
196 (* we don't want to merge objects that have been carefully splitted in many pieces on purpose *)
197 | J.Je_object _ as obj when object_depth obj > local_inlining_maximal_object_depth ->
198 `never
199
fccc685 Initial open-source release
MLstate authored
200 (* beware not to inline side effects, even once
201 * you can reorder them by doing so *)
202 | _e ->
203 (* we must check later whether there are side effects or not
204 * because we can potentially inline an expression that does side effect
205 * into one that didn't *)
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
206 `once
fccc685 Initial open-source release
MLstate authored
207
208 type inline_kind =
209 | Safe of J.expr (* you can inline this binding *)
210 | Unsafe of J.expr (* you must check at the inline point if there was
211 * an assignment that would make inlining invalid *)
212
213 let simplify occur_env params code =
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
214 let env = JsIdentSet.empty in (* same as in occurrence_analysis *)
215 let acc = JsIdentMap.empty in (* maps identifiers to be inlined to their inline_kind *)
fccc685 Initial open-source release
MLstate authored
216 let weak_acc = JsIdentMap.empty in (* the set of identifiers to be inlined if no side effect happens
217 * between the def and the use *)
218 let set_to_clean_up = ref JsIdentSet.empty in (* the binding of these identifiers and its expression should be removed *)
219 let rec aux_s =
220 fun tra_s tra_e (env,acc,weak_acc) stm ->
221 match stm with
222 (* FIXME: factorize this fake control flow computation of whatever it is
223 * with the one in the occurrence analyser *)
224 | J.Js_if (label,e,s1,o) ->
225 let (env, acc,weak_acc), e = aux_e tra_e tra_s (env,acc,weak_acc) e in
226 let (_env, acc,_), s1 = aux_s tra_s tra_e (env, acc, weak_acc) s1 in
227 let acc, o =
228 match o with
229 | None -> acc, None
230 | Some s2 ->
231 let (_env, acc,_), s2 = aux_s tra_s tra_e (env, acc, weak_acc) s2 in
232 acc, Some s2 in
233 (env, acc,weak_acc), J.Js_if (label,e,s1,o)
234 | J.Js_switch (label,e,esl,o) ->
235 let (env,acc,weak_acc), e = aux_e tra_e tra_s (env,acc,weak_acc) e in
236 let acc, (esl:(J.expr * J.statement) list) =
237 List.fold_left_map
238 (fun acc (e,s) ->
239 let (_env, acc, _), e = aux_e tra_e tra_s (env,acc,weak_acc) e in
240 let (_env, acc, _), s = aux_s tra_s tra_e (env,acc,weak_acc) s in
241 acc, (e, s)
242 ) acc (esl:(J.expr * J.statement) list) in
243 let acc, o =
244 match o with
245 | None -> acc, None
246 | Some s ->
247 let (_env, acc, _), s = aux_s tra_s tra_e (env, acc, weak_acc) s in
248 acc, Some s in
249 (env, acc, weak_acc), J.Js_switch (label,e,esl,o)
250
251 | J.Js_var (label,i,o) -> (
252 assert (not (JsIdentSet.mem i params));
253 try
254 let kind = JsIdentMap.find i occur_env in
255 if kind = NeverUsed then
256 (env, acc, weak_acc), J.Js_block (label,[])
257 else (
258 match o with
259 | None -> (env, acc, weak_acc), stm (* we don't know yet if this variable is needed *)
260 | Some e ->
261 let (env,acc,weak_acc), decision = aux_binding tra_e tra_s (env,acc,weak_acc) kind i e in
262 match decision with
263 | `keep_binding e -> (env,acc,weak_acc), J.Js_var (label, i, Some e)
264 | `delete_binding -> (env,acc,weak_acc), J.Js_block (label,[])
265 )
266 with Not_found ->
267 (* local variable not in the map -> never used -> delete it *)
268 match o with
269 | None -> (env,acc,weak_acc), J.Js_block (label,[])
270 | Some e ->
271 let (env,acc,weak_acc), e = aux_e tra_e tra_s (env,acc,weak_acc) e in
272 (env,acc,weak_acc), J.Js_expr (label,e)
273 )
274
275 | J.Js_function _ -> assert false
276 | _ -> tra_s (env,acc,weak_acc) stm
277
278 and aux_binding =
279 fun tra_e tra_s (env,acc,weak_acc) kind i e ->
280 (* inline in the body *)
281 let (env, acc, weak_acc), e = aux_e tra_e tra_s (env,acc,weak_acc) e in
282 let policy = local_inlining_policy e in
283 match policy, kind with
284 | _, NeverUsed -> assert false
285 | `never, _
286 | `once, Multiple -> (env, acc, weak_acc), `keep_binding e
287 | (`once | `always), Once (set,safe) ->
288 let has_side_effects = Imp_Common.does_side_effects e in
289 if contains_vars set e || not safe && has_side_effects then
290 (* cannot inline, because we are in the situation of:
291 * [y = x, x = 2, _ = y] where we cannot inline y
292 * because x doesn't mean the same at the definition of y
293 * and at the use of y
294 * or [x = f(); if bool then x] because inlining may cause
295 * the side effect of x not to be executed *)
296 (env, acc, weak_acc), `keep_binding e
297 else
298 if has_side_effects then
299 (* we put the binding in the environment but we don't
300 * remove the binding because perhaps we won't able to
301 * inline after all
302 * if we do, then acc will be updated to make sure the
303 * binding is removed after all *)
304 let weak_acc = JsIdentMap.add i e weak_acc in
305 (env, acc, weak_acc), `keep_binding e
306 else
307 (* inline is safe, go for it and delete the binding *)
308 let acc = JsIdentMap.add i (Safe e) acc in
309 (env, acc, weak_acc), `delete_binding
310 | `always, Multiple ->
311 (* we put the binding in the environment but we don't
312 * remove the binding as we don't know if we will be able
313 * to remove all the uses *)
314 let acc = JsIdentMap.add i (Unsafe e) acc in
315 (env, acc, weak_acc), `keep_binding e
316
317 and aux_e =
318 fun tra_e tra_s (env,acc,weak_acc) expr ->
319 let (env, acc, weak_acc), expr =
320 match expr with
321 | J.Je_binop (label1,J.Jb_assign,J.Je_ident (label2,i),e) ->
322 if JsIdentSet.mem i params then
323 (* we know the identifier won't be rewritten anyway, so
324 * we can traverse without caution *)
325 tra_e (env,acc,weak_acc) expr
326 else (
327 try
328 (* beware not to rewrite the identifier *)
329 let kind = JsIdentMap.find i occur_env in
330 if kind = NeverUsed then
331 (* keep the expression but remove the assigment *)
332 aux_e tra_e tra_s (env,acc,weak_acc) e
333 else
334 let (env,acc,weak_acc), decision = aux_binding tra_e tra_s (env,acc,weak_acc) kind i e in
335 match decision with
336 | `keep_binding e -> (env,acc,weak_acc), J.Je_binop (label1,J.Jb_assign,J.Je_ident (label2,i),e)
337 | `delete_binding -> (env,acc,weak_acc), JsCons.Expr.string "deadcode1"
338 with Not_found ->
339 (* the identifier is not in the map means it is unused
340 * and the binding is unused *)
341 if Imp_Common.does_side_effects e then
342 aux_e tra_e tra_s (env, acc, weak_acc) e
343 else
344 (env, acc, weak_acc), JsCons.Expr.string "deadcode2"
345 )
346 | J.Je_ident (_,i) -> (
347 try
348 match JsIdentMap.find i acc with
349 | Safe e ->
350 (* don't go down in the expression, it was already
351 * rewritten before being put in the environment
352 * plus we know we never inline anything containing
353 * assigments to parameters so the env doesn't need to
354 * be updated by looking at the expression *)
355 (env,acc,weak_acc), e
356 | Unsafe e ->
357 if contains_vars env e then
358 (env,acc,weak_acc), expr (* cannot inline *)
359 else
360 (* don't go down either, same reason as above *)
361 (env,acc,weak_acc), e
362 with Not_found ->
363 try
364 (* same as in the case Safe in acc
365 * the only difference is that the weak_map
366 * is reset from times to times
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
367 * since we just inlined something that contains a side effect
fccc685 Initial open-source release
MLstate authored
368 * we must empty the weak acc *)
369 let e = JsIdentMap.find i weak_acc in
370 set_to_clean_up := JsIdentSet.add i !set_to_clean_up;
371 (env, acc, JsIdentMap.empty), e
372 with Not_found ->
373 (* parameter or global variable *)
374 (env,acc,weak_acc), expr
375 )
376 | J.Je_function _ -> assert false
377 | _ -> tra_e (env,acc,weak_acc) expr in
378 match expr with
379 (* put assignments also, delete, etc, same kind of stuff as in does_side_effects? ?? *)
380 | J.Je_call (_,_,_,false) -> (env, acc, JsIdentMap.empty), expr
381 | _ -> (env, acc, weak_acc), expr in
382 let foldmap_stm env_acc stm =
383 JsWalk.TStatement.traverse_foldmap aux_s aux_e env_acc stm in
384 let (_env,_acc,_), code = List.fold_left_map foldmap_stm (env,acc,weak_acc) code in
385
386 (* clean up *)
387 let set_to_clean_up = !set_to_clean_up in
388 let code =
389 List.map (fun stm ->
390 JsWalk.TStatement.map
391 (fun stm ->
392 match stm with
393 | J.Js_var (_,i,Some _) when JsIdentSet.mem i set_to_clean_up ->
394 JsCons.Statement.block []
395 | _ -> stm)
396 (fun expr ->
397 match expr with
398 | J.Je_binop (_,J.Jb_assign,J.Je_ident (_,i),_) when JsIdentSet.mem i set_to_clean_up ->
399 JsCons.Expr.string "deadcode3"
400 | _ -> expr)
401 stm
402 ) code in
403
404 (* simplified code *)
405 code
406
407 let local_inline_stm stm =
408 let rewrite_body params body =
409 let params_set = JsIdentSet.from_list params in
410 let code = ref body in
411 (* FIXME: don't need to iterate 4 times all the times
412 * we should stop as soon as the rewriting didn't do anything *)
413 for _i = 1 to 4 do
414 let occur_env = occurrence_analysis params_set !code in
415 code := simplify occur_env params_set !code;
416 done;
417 !code in
418 JsWalk.TStatement.traverse_map
419 (fun tra _tra_e stm ->
420 match stm with
421 | J.Js_function (label,name,env,[J.Js_return (label2,Some (J.Je_function (label3,None,params,body)))]) ->
422 let body = rewrite_body (env @ params) body in
423 J.Js_function (label,name,env,[J.Js_return (label2,Some (J.Je_function (label3,None,params,body)))])
424 | J.Js_function (label,name,params,body) ->
425 let body = rewrite_body params body in
426 J.Js_function (label,name,params,body)
427 | _ -> tra stm
428 )
429 (fun tra _tra_s expr ->
430 match expr with
431 | J.Je_function (label,name,params,body) ->
432 let body = rewrite_body params body in
433 J.Je_function (label,name,params,body)
434 | _ -> tra expr
435 )
436 stm
437
438 let local_inline code =
439 List.map local_inline_stm code
440
441 let global_inlining_policy_for_var e =
442 (* since we can't know whether a global variable is used several times
443 * we assume global vars are always used several times
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
444 * FIXME: actually, we could when the variable is not exported of the compilation unit
445 * but this information is lost (for now) very early in the compilation *)
fccc685 Initial open-source release
MLstate authored
446 match e with
447 | J.Je_ident _
448 | J.Je_num _
449 | J.Je_bool _
450 | J.Je_null _
451 | J.Je_undefined _
452 (* beware could be redefined, assuming it isn't *)
453 (* beware: do not inline 'this' *)
454 -> true
455 | _ -> false
456
457 let global_inlining_policy_for_function _name params body =
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
458 (* FIXME: same here, when a function is used once, it can be inlined no matter what *)
459 (* we inline but we do not want to make the code bigger, and it is difficult to know
460 * beforehand if the inlined code will be simplified or not
461 * so for now, we are conservative when choosing or not to inline *)
462 (* BEWARE: should make sure not to put recursive functions in here
fccc685 Initial open-source release
MLstate authored
463 * FIXME: should be able to inline functions as:
464 * function(x) {
465 * var a;
466 * return x
467 * }
468 * function (x) {
469 * x.f()
470 * return void;
471 * }
472 *)
473 let simple_expr ?(param_only=false) = function
474 (* param only is some kind of attemps to avoid a blowup? *)
475 | J.Je_ident (_,i) when not param_only || List.mem i params -> true
476 | J.Je_num _
477 | J.Je_bool _
478 | J.Je_null _
479 | J.Je_string (_, "", _) (* FIXME: which strings are we allowed to inline
480 here, and in the local inlining ?*)
481 | J.Je_undefined _ -> true
482 | _ -> false in
483 match body with
484 | [J.Js_return (_,Some e)] -> (
485 match e with
486 | J.Je_unop (_,_,e1) when simple_expr e1 -> Some e
487 (* FIXME: do not inline operators that do assignments (or side effects like delete?) *)
488 | J.Je_binop (_,_,e1,e2) when simple_expr e1 && simple_expr e2 -> Some e
489 | J.Je_dot (_,e1,_) when simple_expr e1 -> Some e
490 | J.Je_call (_, e1, l, _) when simple_expr e1 && List.for_all (simple_expr ~param_only:true) l ->
491 Some e
492 | _ -> if simple_expr e then Some e else None
493 )
494 | _ -> None
495
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
496 (* alpha converting [vars] in [body], while returning the new names of [vars]
497 * (and the new body of course)*)
fccc685 Initial open-source release
MLstate authored
498 let refresh vars body =
499 let freshs = List.map (fun _ -> Imp_Env.next_param "inline") vars in
500 let map =
501 List.fold_left2
502 (fun map var fresh -> JsIdentMap.add var fresh map)
503 JsIdentMap.empty vars freshs in
504 let body =
505 JsWalk.OnlyExpr.map
506 (fun e ->
507 match e with
508 | J.Je_ident (label,i) -> (
509 try J.Je_ident (label, JsIdentMap.find i map)
510 with Not_found -> e
511 )
512 | J.Je_function _ -> assert false
513 | _ -> e
514 ) body in
515 freshs, body
516
517 type env = {
518 functions : [`var of J.expr | `fun_ of (JsIdent.t list * J.expr) ] JsIdentMap.t;
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
519 (* maps from some global identifiers (the only that we saw fit for inlining)
520 * to their body *)
521
fccc685 Initial open-source release
MLstate authored
522 closures : JsIdent.t JsIdentMap.t;
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
523 (* used to map empty closures to the function they represent
524 * most probably useless now *)
fccc685 Initial open-source release
MLstate authored
525 }
526
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
527 (* utility to save [env] for separated compilation *)
fccc685 Initial open-source release
MLstate authored
528 module S =
529 struct
530 type t = env
531 let pass = "pass_JavascriptCompilation_imp_Inlining"
532 let pp_element f = function
533 | `var e ->
534 Format.fprintf f "`var %a" (JsPrint.pp#expr ~leading:true) e
535 | `fun_ (params,e) ->
536 Format.fprintf f "`fun %a -> %a"
537 (Format.pp_list "," (fun f i -> Format.pp_print_string f (JsIdent.to_string i))) params
538 (JsPrint.pp#expr ~leading:true) e
539 let pp_functions f m =
540 JsIdentMap.iter
541 (fun k v ->
542 Format.fprintf f "@[<2>%s:@ %a@]@\n" (JsIdent.to_string k) pp_element v
543 ) m
544 let pp_closures f m =
545 JsIdentMap.iter
546 (fun k v ->
547 Format.fprintf f "@[<2>%s: %s@]@\n" (JsIdent.to_string k) (JsIdent.to_string v)
548 ) m
549 let pp f env =
550 Format.fprintf f "@[{@\n @[<2>functions: %a@];@\n @[<2>closures: %a@]@\n}@]"
551 pp_functions env.functions pp_closures env.closures
552 end
553 module R =
554 struct
555 include ObjectFiles.Make(S)
556 let refresh_expr = JsWalk.Refresh.expr
557 let refresh_element = function
558 | `var e -> `var (refresh_expr e)
559 | `fun_ (params,e) -> `fun_ (params,refresh_expr e)
560 let load env =
561 fold ~deep:true (* FIXME: shouldn't be true, but the environment
562 * saved should have been rewritten by the inlining
563 * actually, if you depend on a plugin, then it won't
564 * be loaded if one of your deep dependency depends
565 * on it i think, so it also forces you go deep
566 *)
567 (fun {functions=functions1; closures=closures1} {functions=old_functions; closures=old_closures} ->
568 let functions1 =
569 JsIdentMap.fold
570 (fun k v env ->
571 let v = refresh_element v in
572 (* we can possibly have collisions in the map, if
573 * you depend on several independant packages that
574 * load the same plugins *)
575 JsIdentMap.add k v env
576 ) old_functions functions1 in
577 let closures1 = JsIdentMap.merge (fun a _ -> a) closures1 old_closures in
578 {functions=functions1; closures=closures1}
579 ) env
580 let save ~env ~loaded_env ~initial_env =
581 let functions_to_be_saved = JsIdentMap.diff2 env.functions loaded_env.functions initial_env.functions in
582 let closures_to_be_saved = JsIdentMap.diff2 env.closures loaded_env.closures initial_env.closures in
583 let env_to_be_saved = {functions = functions_to_be_saved; closures = closures_to_be_saved} in
584 save env_to_be_saved
585 end
586
587 let empty_env = { functions = JsIdentMap.empty; closures = JsIdentMap.empty }
588 let env_of_map closure_map =
589 let closure_map = IdentMap.fold (fun k v acc -> JsIdentMap.add (JsCons.Ident.ident k) (JsCons.Ident.ident v) acc) closure_map JsIdentMap.empty in
590 { functions = JsIdentMap.empty; closures = closure_map }
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
591
592 (* analysis of a toplevel statement, it fills the environment *)
fccc685 Initial open-source release
MLstate authored
593 let global_inline_analyse_stm (env:env) stm =
594 JsWalk.OnlyStatement.fold
595 (fun env -> function
596 | J.Js_var (_,name, Some (J.Je_function (_, None, params, body)))
597 | J.Js_function (_,name,params,body) -> (
598 match global_inlining_policy_for_function name params body with
599 | None -> env
600 | Some e -> {env with functions = JsIdentMap.add name (`fun_ (params,e)) env.functions}
601 )
602 | J.Js_var (_,v,Some e) ->
603 if global_inlining_policy_for_var e then
604 {env with functions = JsIdentMap.add v (`var e) env.functions}
605 else
606 env
607 | _ -> env
608 ) env stm
609
610 let global_inline_analyse_code env code =
611 List.fold_left global_inline_analyse_stm env code
612
f2ce0c4 [doc] qmljsimp: adding, removing, updating comments
Valentin Gatien-Baron authored
613 (* rewriting of a toplevel statement, given an inlining environment *)
fccc685 Initial open-source release
MLstate authored
614 let global_inline_rewrite_stm (env:env) (stm:JsAst.statement) : JsAst.statement =
615 let make_var_decl local_vars =
616 List.map (fun i -> JsCons.Statement.var i ?expr:None) local_vars in
617 let rewrite_expr_aux =
618 (fun self tra self_stm _tra_stm toplevel local_vars e ->
619 match e with
620 | J.Je_ident (_,i) -> (
621 try
622 match JsIdentMap.find i env.functions with
623 | `var e -> self toplevel local_vars e
624 | `fun_ _ -> tra toplevel local_vars e
625 with Not_found -> tra toplevel local_vars e
626 )
627 | J.Je_call (label,J.Je_ident (_,J.ExprIdent (Ident.FakeSource s)),J.Je_ident (label2,clos) :: args,pure)
628 when String.is_contained "clos_arg" s (* FIXME: export a function in qmlClosure that does this check instead
629 * (this is safe, but fragile) *)
630 && JsIdentMap.mem clos env.closures ->
631 let e = J.Je_call (label, J.Je_ident (label2, JsIdentMap.find clos env.closures), args, pure) in
632 self toplevel local_vars e
633 | J.Je_call (_,J.Je_ident (_,i), args,_) -> (
634 try
635 let rec aux i =
636 match JsIdentMap.find i env.functions with
637 | `var (J.Je_ident (_,j)) -> aux j
638 | `fun_ (params,body) when List.length params = List.length args ->
639 (* not inlining when there are arity problems, but it could be done
640 * easily (right List.map2 raises an exception) *)
641 let params, body = refresh params body in
642 let assignments = List.map2 (fun l p -> JsCons.Expr.assign_ident l p) params args in
643 let e = JsCons.Expr.comma assignments body in
644 let local_vars = params @ local_vars in
645 self toplevel local_vars e
646 | `var _
647 | `fun_ _ ->
648 tra toplevel local_vars e in
649 aux i
650 with Not_found ->
651 tra toplevel local_vars e
652 )
653 | J.Je_function (label,name,params,body) ->
654 let new_local_vars, body = List.fold_left_map (self_stm false) [] body in
655 let body = make_var_decl new_local_vars @ body in
656 local_vars, J.Je_function (label, name, params, body)
657 | _ -> tra toplevel local_vars e
658 ) in
659 let rewrite_stm_aux =
660 (fun self tra self_expr _tra_expr toplevel local_vars stm ->
661 match stm with
662 | J.Js_function (label,name,params,body) ->
663 let new_local_vars, body = List.fold_left_map (self false) [] body in
664 let body = make_var_decl new_local_vars @ body in
665 local_vars, J.Js_function (label, name, params, body)
666 | J.Js_var (label,i,Some e) when toplevel ->
667 let new_local_vars, e = self_expr false [] e in
668 let e = JsCons.Expr.maybe_scope new_local_vars e in
669 local_vars, J.Js_var (label, i, Some e)
670 | J.Js_return _
671 | J.Js_switch _
672 | J.Js_if _
673 | J.Js_throw _
674 | J.Js_trycatch _
675 | J.Js_for _
676 | J.Js_forin _
677 | J.Js_dowhile _
678 | J.Js_while _
679 | J.Js_with _ when toplevel -> assert false (* no expression at toplevel are treated *)
680 | _ -> tra toplevel local_vars stm) in
681 let local_vars = [] in
682 let local_vars, stm =
683 JsWalk.TStatement.self_traverse_foldmap_context_down rewrite_stm_aux rewrite_expr_aux true local_vars stm in
684 assert (local_vars = []);
685 stm
Something went wrong with that request. Please try again.