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 <[email protected]> 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
