[Guile-commits] GNU Guile branch, master, updated. v2.1.0-919-g2ad91e6

[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=2ad91e6b34f8aa204f4cd64d9578cc218a35041d

The branch, master has been updated
       via  2ad91e6b34f8aa204f4cd64d9578cc218a35041d (commit)
      from  560bfa924152db0ab4d117e37f7886a88830bb81 (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 2ad91e6b34f8aa204f4cd64d9578cc218a35041d
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 14 13:53:35 2014 +0200

    Optimize make-global-cont-folder
    
    * module/language/cps.scm (make-global-cont-folder): Inline the
      fold-values, as peval doesn't do so.  Allows closure conversion to
      avoid any closure creation.

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

Summary of changes:
 module/language/cps.scm |   18 ++++++++++--------
 1 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/module/language/cps.scm b/module/language/cps.scm
index 86cdec5..2867a4a 100644
--- a/module/language/cps.scm
+++ b/module/language/cps.scm
@@ -476,12 +476,6 @@
 
 (define-syntax-rule (make-global-cont-folder seed ...)
   (lambda (proc cont seed ...)
-    (define (fold-values proc in seed ...)
-      (if (null? in)
-          (values seed ...)
-          (let-values (((seed ...) (proc (car in) seed ...)))
-            (fold-values proc (cdr in) seed ...))))
-
     (define (cont-folder cont seed ...)
       (match cont
         (($ $cont k cont)
@@ -513,7 +507,11 @@
       (match term
         (($ $letk conts body)
          (let-values (((seed ...) (term-folder body seed ...)))
-           (fold-values cont-folder conts seed ...)))
+           (let lp ((conts conts) (seed seed) ...)
+             (if (null? conts)
+                 (values seed ...)
+                 (let-values (((seed ...) (cont-folder (car conts) seed ...)))
+                   (lp (cdr conts) seed ...))))))
 
         (($ $continue k src exp)
          (match exp
@@ -522,7 +520,11 @@
 
         (($ $letrec names syms funs body)
          (let-values (((seed ...) (term-folder body seed ...)))
-           (fold-values fun-folder funs seed ...)))))
+           (let lp ((funs funs) (seed seed) ...)
+             (if (null? funs)
+                 (values seed ...)
+                 (let-values (((seed ...) (fun-folder (car funs) seed ...)))
+                   (lp (cdr funs) seed ...))))))))
 
     (cont-folder cont seed ...)))
 


hooks/post-receive
-- 
GNU Guile