From d111abd0f6d06308b172cc1fa964eb11ccf5d94a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 19 Sep 2011 20:59:53 -0400 Subject: [PATCH] more optimize.scm factoring * module/language/tree-il/optimize.scm (vlist-any): New helper. (peval): Use it here. --- module/language/tree-il/optimize.scm | 15 +++++++++++---- 1 file 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 and , it should be called before ($ _ 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)) (($ src () (and lc ($ )))