mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

more optimize.scm factoring

Browse source 
* module/language/tree-il/optimize.scm (vlist-any): New helper.
  (peval): Use it here.
This commit is contained in:
Andy Wingo 2011-09-19 20:59:53 -04:00
parent 0c448ef47b
commit d111abd0f6
1 changed files with 11 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

15
module/language/tree-il/optimize.scm
View file

@ -139,6 +139,13 @@ lexical references."
(_ #f))) (_ #f)))
body)) 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)) (define* (peval exp #:optional (cenv (current-module)) (env vlist-null))
"Partially evaluate EXP in compilation environment CENV, with "Partially evaluate EXP in compilation environment CENV, with
top-level bindings from ENV and return the resulting expression. Since 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)) ($ <lambda-case> _ req opt rest kw inits gensyms body))
;; Look for NEW in the current environment, starting from the ;; Look for NEW in the current environment, starting from the
;; outermost frame. ;; outermost frame.
(or (any (lambda (x) (or (vlist-any (lambda (x)
(and (equal? (cdr x) new) (and (equal? (cdr x) new)
(make-lexical-ref src name (car x)))) (make-lexical-ref src name (car x))))
(vlist-fold cons '() env)) ; todo: optimize env)
new)) new))
(($ <lambda> src () (($ <lambda> src ()
(and lc ($ <lambda-case>))) (and lc ($ <lambda-case>)))