mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

peval: add a bunch of missing maybe-unconst calls

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-09-25 02:54:34 +02:00
parent b839233282
commit cf82943f9f
1 changed files with 10 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -539,7 +539,7 @@ it does not handle <fix> and <let-values>, it should be called before
(define (for-effect exp) (define (for-effect exp)
(loop exp env counter 'effect)) (loop exp env counter 'effect))
(define (for-tail exp) (define (for-tail exp)
(loop exp env counter ctx)) (maybe-unconst exp (loop exp env counter ctx)))
(if counter (if counter
(record-effort! counter)) (record-effort! counter))
@ -717,13 +717,15 @@ it does not handle <fix> and <let-values>, it should be called before
(_ #f)) (_ #f))
(make-let-values lv-src producer (for-tail consumer))))) (make-let-values lv-src producer (for-tail consumer)))))
(($ <dynwind> src winder body unwinder) (($ <dynwind> src winder body unwinder)
(make-dynwind src (for-value winder) (for-tail body) (make-dynwind src
(for-value unwinder))) (maybe-unconst winder (for-value winder))
(for-tail body)
(maybe-unconst unwinder (for-value unwinder))))
(($ <dynlet> src fluids vals body) (($ <dynlet> src fluids vals body)
(make-dynlet src (make-dynlet src
(map maybe-unconst fluids (map for-value fluids)) (map maybe-unconst fluids (map for-value fluids))
(map maybe-unconst vals (map for-value vals)) (map maybe-unconst vals (map for-value vals))
(maybe-unconst body (for-tail body)))) (for-tail body)))
(($ <dynref> src fluid) (($ <dynref> src fluid)
(make-dynref src (make-dynref src
(maybe-unconst fluid (for-value fluid)))) (maybe-unconst fluid (for-value fluid))))
@ -858,7 +860,7 @@ it does not handle <fix> and <let-values>, it should be called before
($ <lambda>) ($ <lambda>)
($ <toplevel-ref>) ($ <toplevel-ref>)
($ <lexical-ref>)) ($ <lexical-ref>))
(make-application src proc (make-application src (maybe-unconst orig-proc proc)
(map maybe-unconst orig-args (map maybe-unconst orig-args
(map for-value 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) ((last)
(if (null? effects) (if (null? effects)
(for-tail last) (for-tail last)
(make-sequence src (append (reverse effects) (make-sequence
(list src
(maybe-unconst last (reverse (cons (for-tail last) effects)))))
(for-tail last)))))))
((head . rest) ((head . rest)
(let ((head (for-effect head))) (let ((head (for-effect head)))
(cond (cond