summaryrefslogtreecommitdiff
path: root/module/language/tree-il/optimize.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-09-19 20:59:53 -0400
committerAndy Wingo <wingo@pobox.com>2011-09-21 05:37:07 +0200
commitd111abd0f6d06308b172cc1fa964eb11ccf5d94a (patch)
treee9b9488d0c128136aaef7e541683117a4650b9dc /module/language/tree-il/optimize.scm
parent0c448ef47b752683855753ece53bef52733aee0b (diff)
downloadguile-d111abd0f6d06308b172cc1fa964eb11ccf5d94a.tar.gz
more optimize.scm factoring
* module/language/tree-il/optimize.scm (vlist-any): New helper. (peval): Use it here.
Diffstat (limited to 'module/language/tree-il/optimize.scm')
-rw-r--r--module/language/tree-il/optimize.scm15
1 files changed, 11 insertions, 4 deletions
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index 44579997a..b926081cc 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -139,6 +139,13 @@ lexical references."
(_ #f)))
body))
+(define (vlist-any proc vlist)
+ (let ((len (vlist-length vlist)))
+ (let lp ((i 0))
+ (and (< i len)
+ (or (proc (vlist-ref vlist i))
+ (lp (1+ i)))))))
+
(define* (peval exp #:optional (cenv (current-module)) (env vlist-null))
"Partially evaluate EXP in compilation environment CENV, with
top-level bindings from ENV and return the resulting expression. Since
@@ -282,10 +289,10 @@ it does not handle <fix> and <let-values>, it should be called before
($ <lambda-case> _ req opt rest kw inits gensyms body))
;; Look for NEW in the current environment, starting from the
;; outermost frame.
- (or (any (lambda (x)
- (and (equal? (cdr x) new)
- (make-lexical-ref src name (car x))))
- (vlist-fold cons '() env)) ; todo: optimize
+ (or (vlist-any (lambda (x)
+ (and (equal? (cdr x) new)
+ (make-lexical-ref src name (car x))))
+ env)
new))
(($ <lambda> src ()
(and lc ($ <lambda-case>)))