diff options
author | Andy Wingo <wingo@pobox.com> | 2011-09-19 20:59:53 -0400 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-09-21 05:37:07 +0200 |
commit | d111abd0f6d06308b172cc1fa964eb11ccf5d94a (patch) | |
tree | e9b9488d0c128136aaef7e541683117a4650b9dc /module/language/tree-il/optimize.scm | |
parent | 0c448ef47b752683855753ece53bef52733aee0b (diff) | |
download | guile-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.scm | 15 |
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>))) |