diff options
author | Andy Wingo <wingo@pobox.com> | 2011-09-23 00:21:46 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-09-24 20:37:12 +0200 |
commit | fab137869e67d2f1d76764aa8b2855c88ae95379 (patch) | |
tree | 1d0361a9de8a73e30d4b483da74a8601cdd827e5 | |
parent | 062bf3aa443c33a2f07fe929aba03fcd44d959b1 (diff) | |
download | guile-fab137869e67d2f1d76764aa8b2855c88ae95379.tar.gz |
prune unused letrec bindings
* module/language/tree-il/optimize.scm (peval): Prune unused `letrec'
bindings.
-rw-r--r-- | module/language/tree-il/optimize.scm | 13 |
1 files changed, 12 insertions, 1 deletions
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm index 7ac68e926..1f2e17aa0 100644 --- a/module/language/tree-il/optimize.scm +++ b/module/language/tree-il/optimize.scm @@ -656,7 +656,18 @@ it does not handle <fix> and <let-values>, it should be called before (body (maybe-unconst body body*))) (if (const? body*) body - (make-letrec src in-order? names gensyms vals body)))) + (let*-values + (((stripped) (remove + (lambda (x) + (and (constant-expression? (car x)) + (not (hashq-ref + residual-lexical-references + (cadr x))))) + (zip vals gensyms names))) + ((vals gensyms names) (unzip3 stripped))) + (if (null? stripped) + body + (make-letrec src in-order? names gensyms vals body)))))) (($ <fix> src names gensyms vals body) (let* ((vals (map for-value vals)) (body* (loop body |