summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-09-23 00:21:46 +0200
committerAndy Wingo <wingo@pobox.com>2011-09-24 20:37:12 +0200
commitfab137869e67d2f1d76764aa8b2855c88ae95379 (patch)
tree1d0361a9de8a73e30d4b483da74a8601cdd827e5
parent062bf3aa443c33a2f07fe929aba03fcd44d959b1 (diff)
downloadguile-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.scm13
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