diff options
author | Andy Wingo <wingo@pobox.com> | 2011-09-25 02:54:34 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-09-25 02:54:34 +0200 |
commit | cf82943f9f075248d803b31e19ddb8e933ad35ba (patch) | |
tree | 23dbff5aadc9f3d2ebf8eed1236550c2c32a505d | |
parent | b839233282686301a5ba762b2dda890b3659ce4d (diff) | |
download | guile-cf82943f9f075248d803b31e19ddb8e933ad35ba.tar.gz |
peval: add a bunch of missing maybe-unconst calls
* module/language/tree-il/optimize.scm (peval): Add missing
maybe-unconst calls. Things are getting ugly. They will get better
in the next commit though.
-rw-r--r-- | module/language/tree-il/optimize.scm | 19 |
1 files changed, 10 insertions, 9 deletions
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm index a95b3ad90..a8447b159 100644 --- a/module/language/tree-il/optimize.scm +++ b/module/language/tree-il/optimize.scm @@ -539,7 +539,7 @@ it does not handle <fix> and <let-values>, it should be called before (define (for-effect exp) (loop exp env counter 'effect)) (define (for-tail exp) - (loop exp env counter ctx)) + (maybe-unconst exp (loop exp env counter ctx))) (if counter (record-effort! counter)) @@ -717,13 +717,15 @@ it does not handle <fix> and <let-values>, it should be called before (_ #f)) (make-let-values lv-src producer (for-tail consumer))))) (($ <dynwind> src winder body unwinder) - (make-dynwind src (for-value winder) (for-tail body) - (for-value unwinder))) + (make-dynwind src + (maybe-unconst winder (for-value winder)) + (for-tail body) + (maybe-unconst unwinder (for-value unwinder)))) (($ <dynlet> src fluids vals body) (make-dynlet src (map maybe-unconst fluids (map for-value fluids)) (map maybe-unconst vals (map for-value vals)) - (maybe-unconst body (for-tail body)))) + (for-tail body))) (($ <dynref> src fluid) (make-dynref src (maybe-unconst fluid (for-value fluid)))) @@ -858,7 +860,7 @@ it does not handle <fix> and <let-values>, it should be called before ($ <lambda>) ($ <toplevel-ref>) ($ <lexical-ref>)) - (make-application src proc + (make-application src (maybe-unconst orig-proc proc) (map maybe-unconst orig-args (map for-value orig-args)))) @@ -887,10 +889,9 @@ it does not handle <fix> and <let-values>, it should be called before ((last) (if (null? effects) (for-tail last) - (make-sequence src (append (reverse effects) - (list - (maybe-unconst last - (for-tail last))))))) + (make-sequence + src + (reverse (cons (for-tail last) effects))))) ((head . rest) (let ((head (for-effect head))) (cond |