[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-91-gdf12979

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=df1297956211b7353155c9b54d7e9c22d05ce493

The branch, stable-2.0 has been updated
       via  df1297956211b7353155c9b54d7e9c22d05ce493 (commit)
      from  531c9f1dc51c4801c4d031ee80a31f15285a6b85 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit df1297956211b7353155c9b54d7e9c22d05ce493
Author: Andy Wingo <address@hidden>
Date:   Wed Mar 9 22:37:53 2011 +0100

    fix-letrec tweaks
    
    * 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.

-----------------------------------------------------------------------

Summary of changes:
 module/language/tree-il/fix-letrec.scm |  149 +++++++++++++++-----------------
 1 files changed, 68 insertions(+), 81 deletions(-)

diff --git a/module/language/tree-il/fix-letrec.scm 
b/module/language/tree-il/fix-letrec.scm
index ee8beb2..3d7db27 100644
--- a/module/language/tree-il/fix-letrec.scm
+++ b/module/language/tree-il/fix-letrec.scm
@@ -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,83 +195,65 @@
               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.
-                (define (lookup set)
-                  (let lp ((binds binds))
-                    (cond
-                     ((null? binds) '())
-                     ((memq (caar binds) set)
-                      (cons (car binds) (lp (cdr binds))))
-                     (else (lp (cdr binds))))))
-                (let ((u (lookup unref))
-                      (s (lookup simple))
-                      (l (lookup lambda*))
-                      (c (lookup complex)))
-                  ;; Bind "simple" bindings, and locations for complex
-                  ;; bindings.
-                  (make-let
-                   src
-                   (append (map cadr s) (map cadr c))
-                   (append (map car s) (map car c))
-                   (append (map caddr s) (map (lambda (x) (make-void #f)) c))
-                   ;; Bind lambdas using the fixpoint operator.
-                   (make-fix
-                    src (map cadr l) (map car l) (map caddr l)
-                    (make-sequence
-                     src
-                     (append
-                      ;; The right-hand-sides of the unreferenced
-                      ;; bindings, for effect.
-                      (map caddr u)
-                      (cond
-                       ((null? c)
-                        ;; No complex bindings, just emit the body.
-                        (list body))
-                       (in-order?
-                        ;; For letrec*, assign complex bindings in order, then 
the
-                        ;; body.
-                        (append
-                         (map (lambda (c)
-                                (make-lexical-set #f (cadr c) (car c)
-                                                  (caddr c)))
-                              c)
-                         (list body)))
-                       (else
-                        ;; Otherwise for plain letrec, evaluate the the 
"complex"
-                        ;; bindings, in a `let' to indicate that order doesn't
-                        ;; matter, and bind to their variables.
-                        (list
-                         (let ((tmps (map (lambda (x) (gensym)) c)))
-                           (make-let
-                            #f (map cadr c) tmps (map caddr c)
-                            (make-sequence
-                             #f
-                             (map (lambda (x tmp)
-                                    (make-lexical-set
-                                     #f (cadr x) (car x)
-                                     (make-lexical-ref #f (cadr x) tmp)))
-                                  c tmps))))
-                         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.
+            (define (lookup set)
+              (let lp ((binds binds))
+                (cond
+                 ((null? binds) '())
+                 ((memq (caar binds) set)
+                  (cons (car binds) (lp (cdr binds))))
+                 (else (lp (cdr binds))))))
+            (let ((u (lookup unref))
+                  (s (lookup simple))
+                  (l (lookup lambda*))
+                  (c (lookup complex)))
+              ;; Bind "simple" bindings, and locations for complex
+              ;; bindings.
+              (make-let
+               src
+               (append (map cadr s) (map cadr c))
+               (append (map car s) (map car c))
+               (append (map caddr s) (map (lambda (x) (make-void #f)) c))
+               ;; Bind lambdas using the fixpoint operator.
+               (make-fix
+                src (map cadr l) (map car l) (map caddr l)
+                (make-sequence
+                 src
+                 (append
+                  ;; The right-hand-sides of the unreferenced
+                  ;; bindings, for effect.
+                  (map caddr u)
+                  (cond
+                   ((null? c)
+                    ;; No complex bindings, just emit the body.
+                    (list body))
+                   (in-order?
+                    ;; For letrec*, assign complex bindings in order, then the
+                    ;; body.
+                    (append
+                     (map (lambda (c)
+                            (make-lexical-set #f (cadr c) (car c)
+                                              (caddr c)))
+                          c)
+                     (list body)))
+                   (else
+                    ;; Otherwise for plain letrec, evaluate the the "complex"
+                    ;; bindings, in a `let' to indicate that order doesn't
+                    ;; matter, and bind to their variables.
+                    (list
+                     (let ((tmps (map (lambda (x) (gensym)) c)))
+                       (make-let
+                        #f (map cadr c) tmps (map caddr c)
+                        (make-sequence
+                         #f
+                         (map (lambda (x tmp)
+                                (make-lexical-set
+                                 #f (cadr x) (car x)
+                                 (make-lexical-ref #f (cadr x) tmp)))
+                              c tmps))))
+                     body))))))))))
 
          ((<let> src names gensyms vals body)
           (let ((binds (map list gensyms names vals)))


hooks/post-receive
-- 
GNU Guile