diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 2012-02-20 17:45:10 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 2012-02-20 17:45:10 +0000 |
| commit | 6d57d49f5e826e620bb62bb628dbb24e801356bc (patch) | |
| tree | e8a3dcbfde8592a60adc5a3d0d25cc7de11f0c4c | |
| parent | afbd4d496cea742ecda53b4b706c968979cdfc9c (diff) | |
Optimize away compile-time beta-redexes, as found sometimes in generated code, by Coq's extraction in particular
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12174 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | Changes | 1 | ||||
| -rw-r--r-- | bytecomp/simplif.ml | 24 |
2 files changed, 25 insertions, 0 deletions
@@ -18,6 +18,7 @@ Compilers: - Better reporting of compiler version mismatch in .cmi files * Warning 28 is now enabled by default. - New option -absname to use absolute paths in error messages +- Optimize away compile-time beta-redexes, e.g. (fun x y -> e) a b. Native-code compiler: - Optimized handling of partially-applied functions (PR#5287) diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml index 892fbe7ea..1883f7151 100644 --- a/bytecomp/simplif.ml +++ b/bytecomp/simplif.ml @@ -272,6 +272,18 @@ let simplify_exits lam = in simplif lam +(* Compile-time beta-reduction of functions immediately applied: + Lapply(Lfunction(Curried, params, body), args, loc) -> + let paramN = argN in ... let param1 = arg1 in body + Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock(args))], loc) -> + let paramN = argN in ... let param1 = arg1 in body + Assumes |args| = |params|. +*) + +let beta_reduce params body args = + List.fold_left2 (fun l param arg -> Llet(Strict, param, arg, l)) + body params args + (* Simplification of lets *) let simplify_lets lam = @@ -322,6 +334,12 @@ let simplify_lets lam = | Lconst cst -> () | Lvar v -> use_var bv v 1 + | Lapply(Lfunction(Curried, params, body), args, _) + when optimize && List.length params = List.length args -> + count bv (beta_reduce params body args) + | Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock _, args)], _) + when optimize && List.length params = List.length args -> + count bv (beta_reduce params body args) | Lapply(l1, ll, _) -> count bv l1; List.iter (count bv) ll | Lfunction(kind, params, l) -> @@ -397,6 +415,12 @@ let simplify_lets lam = l end | Lconst cst as l -> l + | Lapply(Lfunction(Curried, params, body), args, _) + when optimize && List.length params = List.length args -> + simplif (beta_reduce params body args) + | Lapply(Lfunction(Tupled, params, body), [Lprim(Pmakeblock _, args)], _) + when optimize && List.length params = List.length args -> + simplif (beta_reduce params body args) | Lapply(l1, ll, loc) -> Lapply(simplif l1, List.map simplif ll, loc) | Lfunction(kind, params, l) -> Lfunction(kind, params, simplif l) | Llet(str, v, Lvar w, l2) when optimize -> |