diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 2010-05-25 12:34:20 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 2010-05-25 12:34:20 +0000 |
| commit | 4c7e1b7f38ea619da6620e5d8f04ca5483a7b12f (patch) | |
| tree | 7ba2911a589cd752266119df85138082c72625b5 /bytecomp/simplif.ml | |
| parent | f1c18b2dff4fbca0d6053cc544f8fb6f1abb0af9 (diff) | |
| download | ocaml-annot-from-lambda.tar.gz | |
Added tail call heuristic for native compilationannot-from-lambda
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/annot-from-lambda@10466 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'bytecomp/simplif.ml')
| -rw-r--r-- | bytecomp/simplif.ml | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml index e758eed489..264a0800bc 100644 --- a/bytecomp/simplif.ml +++ b/bytecomp/simplif.ml @@ -409,20 +409,24 @@ let simplify_lets lam = in simplif lam +(* Tail call info in annotation files *) + +let is_tail_native_heuristic : (int -> bool) ref = + ref (fun n -> true) + let rec emit_tail_infos is_tail lambda = - let is_tail_native_heuristic _ = - true in - let call_kind x = - if is_tail && ((not !Clflags.native_code) || (is_tail_native_heuristic x)) then - Annot.Tail - else - Annot.Stack in + let call_kind args = + if is_tail + && ((not !Clflags.native_code) + || (!is_tail_native_heuristic (List.length args))) + then Annot.Tail + else Annot.Stack in match lambda with | Lvar _ -> () | Lconst _ -> () | Lapply (func, l, loc) -> list_emit_tail_infos false l; - Stypes.record (Stypes.An_call (loc, call_kind ())) + Stypes.record (Stypes.An_call (loc, call_kind l)) | Lfunction (_, _, lam) -> emit_tail_infos true lam | Llet (_, _, lam, body) -> @@ -471,7 +475,7 @@ let rec emit_tail_infos is_tail lambda = emit_tail_infos false meth; emit_tail_infos false obj; list_emit_tail_infos false args; - Stypes.record (Stypes.An_call (loc, call_kind ())) + Stypes.record (Stypes.An_call (loc, call_kind (obj :: args))) | Levent (lam, _) -> emit_tail_infos is_tail lam | Lifused (_, lam) -> @@ -481,7 +485,11 @@ and list_emit_tail_infos_fun f is_tail = and list_emit_tail_infos is_tail = List.iter (emit_tail_infos is_tail) +(* The entry point: + simplification + emission of tailcall annotations, if needed. *) + let simplify_lambda lam = let res = simplify_lets (simplify_exits lam) in - emit_tail_infos true res; + if !Clflags.annotations then emit_tail_infos true res; res + |