Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[bug fix] jsimp: tail call optimization was broken for local functions

  • Loading branch information...
commit b49c2c1d759b0add867f8a18ec10399acabb1c88 1 parent e00f7b0
Valentin Gatien-Baron authored
Showing with 28 additions and 6 deletions.
  1. +18 −5 qmljsimp/imp_Code.ml
  2. +10 −1 qmljsimp/imp_Compiler.ml
View
23 qmljsimp/imp_Code.ml
@@ -427,17 +427,30 @@ let analyse_tail_recursion bindings =
| Q.Match (_, _, pel) -> List.iter (fun (_,e) -> aux myself e) pel
| Q.Apply (_, Q.Directive (_, `partial_apply _, [Q.Apply (_, Q.Ident (_, f), _)], _), _)
| Q.Apply (_, Q.Ident (_, f), _) when IdentTable.mem env f ->
+ #<If:JS_IMP$contains "tailcall">
+ Format.printf " %s\n%!" (Ident.to_string f)
+ #<End>;
let set1 = IdentTable.find env f in
let set2 = IdentTable.find env myself in
let full_set = IdentSet.add myself (IdentSet.add f (IdentSet.union set1 set2)) in
IdentSet.iter (fun i -> IdentTable.replace env i full_set) full_set
- | _ -> () in
+ | e ->
+ #<If:JS_IMP$contains "fulltailcall">
+ Format.printf "@\nstopped on %a" QmlPrint.pp#expr e
+ #<End>;
+ () in
List.iter
(fun (i,expr) ->
- match expr with
- | Q.Lambda (_, _, Q.Lambda (_, _, e))
- | Q.Lambda (_, _, e) -> aux i e
- | _ -> assert false
+ #<If:JS_IMP$contains "tailcall">
+ Format.printf ">> analysing tail calls of %s: " (Ident.to_string i)
+ #<End>;
+ (match expr with
+ | Q.Lambda (_, _, Q.Lambda (_, _, e))
+ | Q.Lambda (_, _, e) -> aux i e
+ | _ -> assert false);
+ #<If:JS_IMP$contains "tailcall">
+ Format.printf "@."
+ #<End>
) bindings;
let binding_of_ident i =
List.find (fun (j,_e) -> Ident.equal i j) bindings in
View
11 qmljsimp/imp_Compiler.ml
@@ -83,7 +83,16 @@ let compile ?(val_=fun _ -> assert false) ?bsl ?(closure_map=IdentMap.empty) ~re
if env = 0 then sub else
let env_args, args = List.split_at env args in
(* same here *)
- QmlAst.Apply (label, QmlAst.Apply (label2, fun_, env_args), args)
+ (* BEWARE duplicating the annotation [label] is bad, but the
+ * backend doesn't care about that and then they are lost *)
+ QmlAst.Apply (
+ label,
+ QmlAst.Directive
+ (label,
+ `partial_apply None,
+ [QmlAst.Apply (label2, fun_, env_args)],
+ []),
+ args)
| QmlAst.Directive (_,(`lifted_lambda _ | `full_apply _),_,_) -> assert false
| e -> e)
) code in
Please sign in to comment.
Something went wrong with that request. Please try again.