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

fix-letrec tweaks

Browse source 
* module/language/tree-il/fix-letrec.scm (partition-vars): Previously,
  for letrec* we treated all unreferenced vars as complex, because of
  orderings of effects that could arise in their definitions.  But we
  can actually keep simple and lambda vars as unreferenced, as their
  initializers cannot cause side effects.
  (fix-letrec!): Remove letrec* -> letrec code, as it's unneeded.
This commit is contained in:
Andy Wingo 2011-03-09 22:37:53 +01:00
parent 531c9f1dc5
commit df12979562
1 changed files with 68 additions and 81 deletions
Download patch file Download diff file Expand all files Collapse all files

33
module/language/tree-il/fix-letrec.scm
View file

@ -96,9 +96,10 @@
(s '()) (l '()) (c '()))
(cond
((null? gensyms)
;; Unreferenced vars are still complex for letrec*.
;; We need to update our algorithm to "Fixing letrec
;; reloaded" to fix this.
;; Unreferenced complex vars are still
;; complex for letrec*. We need to update
;; our algorithm to "Fixing letrec reloaded"
;; to fix this.
(values (if in-order?
(lset-difference eq? unref c)
unref)
@ -109,7 +110,11 @@
(append c complex)))
((memq (car gensyms) unref)
;; See above note about unref and letrec*.
(if in-order?
(if (and in-order?
(not (lambda? (car vals)))
(not (simple-expression?
(car vals) orig-gensyms
effect+exception-free-primitive?)))
(lp (cdr gensyms) (cdr vals)
s l (cons (car gensyms) c))
(lp (cdr gensyms) (cdr vals)
@ -190,24 +195,6 @@
x))
((<letrec> src in-order? names gensyms vals body)
(if (and in-order?
(every (lambda (x)
(or (lambda? x)
(simple-expression?
x gensyms
effect+exception-free-primitive?)))
vals))
;; If it is a `letrec*', return an equivalent `letrec' when
;; it's possible. This is a hack until we implement the
;; algorithm described in "Fixing Letrec (Reloaded)"
;; (Ghuloum and Dybvig) to allow cases such as
;; (letrec* ((f (lambda () ...))(g (lambda () ...))) ...)
;; or
;; (letrec* ((x 2)(y 3)) y)
;; to be optimized. These can be common when using
;; internal defines.
(fix-letrec!
(make-letrec src #f names gensyms vals body))
(let ((binds (map list gensyms names vals)))
;; The bindings returned by this function need to appear in the same
;; order that they appear in the letrec.
@ -266,7 +253,7 @@
#f (cadr x) (car x)
(make-lexical-ref #f (cadr x) tmp)))
c tmps))))
body)))))))))))
body))))))))))
((<let> src names gensyms vals body)
(let ((binds (map list gensyms names vals)))