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=48e65b446822bffec9aa874bd39ca25ac4f29589 The branch, master has been updated via 48e65b446822bffec9aa874bd39ca25ac4f29589 (commit) via 408da790153b2c9620df5169e976e05d3647b995 (commit) from ce1dbe8c1bc3f1d37978d2ca1d5949b03514a5e3 (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 48e65b446822bffec9aa874bd39ca25ac4f29589 Author: Andy Wingo <[email protected]> Date: Wed Apr 2 15:58:06 2014 +0200 Refactor toplevel scope name generation in compile-cps * module/language/tree-il/compile-cps.scm (scope-counter, fresh-scope-id): (toplevel-box, capture-toplevel-scope, convert, cps-convert/thunk): Refactor to avoid abusing the var counter to generate scope identifiers. commit 408da790153b2c9620df5169e976e05d3647b995 Author: Andy Wingo <[email protected]> Date: Wed Apr 2 15:48:13 2014 +0200 compute-max-label-and-var takes letrec vars into account. * module/language/cps.scm (compute-max-label-and-var): Fix to take letrec vars into account. ----------------------------------------------------------------------- Summary of changes: module/language/cps.scm | 9 +++++- module/language/tree-il/compile-cps.scm | 45 +++++++++++++++++++----------- 2 files changed, 35 insertions(+), 19 deletions(-) diff --git a/module/language/cps.scm b/module/language/cps.scm index c1bb304..90f38a4 100644 --- a/module/language/cps.scm +++ b/module/language/cps.scm @@ -508,8 +508,13 @@ (lambda (label cont max-label max-var) (values (max label max-label) (match cont - (($ $kargs names vars) - (fold max max-var vars)) + (($ $kargs names vars body) + (let lp ((body body) (max-var (fold max max-var vars))) + (match body + (($ $letk conts body) (lp body max-var)) + (($ $letrec names vars funs body) + (lp body (fold max max-var vars))) + (_ max-var)))) (($ $kentry self) (max self max-var)) (_ max-var)))) diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index 0c0085d..5e7e66f 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -75,6 +75,12 @@ ;;; doesn't work for files auto-compiled for use with `load'. ;;; (define current-topbox-scope (make-parameter #f)) +(define scope-counter (make-parameter #f)) + +(define (fresh-scope-id) + (let ((scope-id (scope-counter))) + (scope-counter (1+ scope-id)) + scope-id)) (define (toplevel-box src name bound? val-proc) (let-fresh (kbox) (name-sym bound?-sym box) @@ -88,10 +94,10 @@ ($continue kbox src ($primcall 'resolve (name-sym bound?-sym))))) - (scope + (scope-id (let-fresh () (scope-sym) (build-cps-term - ($letconst (('scope scope-sym scope)) + ($letconst (('scope scope-sym scope-id)) ($continue kbox src ($primcall 'cached-toplevel-box (scope-sym name-sym bound?-sym))))))))))))) @@ -108,10 +114,10 @@ ($primcall 'cached-module-box (module-sym name-sym public?-sym bound?-sym)))))))) -(define (capture-toplevel-scope src scope k) +(define (capture-toplevel-scope src scope-id k) (let-fresh (kmodule) (module scope-sym) (build-cps-term - ($letconst (('scope scope-sym scope)) + ($letconst (('scope scope-sym scope-id)) ($letk ((kmodule ($kargs ('module) (module) ($continue k src ($primcall 'cache-current-module! @@ -294,12 +300,14 @@ ($fun fun-src meta '() (kentry ($kentry self (ktail ($ktail)) ,(convert-clauses body ktail))))))) - (let-fresh (kscope) (scope) - (build-cps-term - ($letk ((kscope ($kargs () () - ,(parameterize ((current-topbox-scope scope)) - (convert exp k subst))))) - ,(capture-toplevel-scope fun-src scope kscope))))))) + (let ((scope-id (fresh-scope-id))) + (let-fresh (kscope) () + (build-cps-term + ($letk ((kscope + ($kargs () () + ,(parameterize ((current-topbox-scope scope-id)) + (convert exp k subst))))) + ,(capture-toplevel-scope fun-src scope-id kscope)))))))) (($ <module-ref> src mod name public?) (module-box @@ -517,12 +525,14 @@ fun))) funs) ,(convert body k subst)))) - (let-fresh (kscope) (scope) - (build-cps-term - ($letk ((kscope ($kargs () () - ,(parameterize ((current-topbox-scope scope)) - (convert exp k subst))))) - ,(capture-toplevel-scope src scope kscope)))))) + (let ((scope-id (fresh-scope-id))) + (let-fresh (kscope) () + (build-cps-term + ($letk ((kscope + ($kargs () () + ,(parameterize ((current-topbox-scope scope-id)) + (convert exp k subst))))) + ,(capture-toplevel-scope src scope-id kscope))))))) (($ <let-values> src exp ($ <lambda-case> lsrc req #f rest #f () syms body #f)) @@ -589,7 +599,8 @@ integer." (define (cps-convert/thunk exp) (parameterize ((label-counter 0) - (var-counter 0)) + (var-counter 0) + (scope-counter 0)) (let ((src (tree-il-src exp))) (let-fresh (kinit ktail kclause kbody) (init) (build-cps-exp hooks/post-receive -- GNU Guile
