[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-75-gceb7f9c

[Mark H Weaver]

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=ceb7f9cc126f50e0cc8956b80ac5d111580b23c8

The branch, stable-2.0 has been updated
       via  ceb7f9cc126f50e0cc8956b80ac5d111580b23c8 (commit)
      from  32e3c505c37ede7f096239574c3ac46206bf0cef (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 ceb7f9cc126f50e0cc8956b80ac5d111580b23c8
Author: Mark H Weaver <address@hidden>
Date:   Wed Jan 23 17:49:38 2013 -0500

    Do not defer expansion of internal define-syntax forms.
    
    * module/ice-9/psyntax.scm (expand-body): As required by R6RS, evaluate
      the right-hand-sides of internal 'define-syntax' forms and add their
      transformers to the compile-time environment immediately, so that the
      newly-defined keywords may be used in definition context within the
      same lexical contour.  Fixes #13509.

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

Summary of changes:
 module/ice-9/psyntax-pp.scm |   29 ++++++++++-------------------
 module/ice-9/psyntax.scm    |   36 +++++++++++++++---------------------
 2 files changed, 25 insertions(+), 40 deletions(-)

diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 139c02b..a0d338c 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -991,15 +991,17 @@
                                        (cons (cons er (wrap e w mod)) vals)
                                        (cons (cons 'lexical var) bindings)))))
                            ((memv key '(define-syntax-form 
define-syntax-parameter-form))
-                            (let ((id (wrap value w mod)) (label (gen-label)))
+                            (let ((id (wrap value w mod))
+                                  (label (gen-label))
+                                  (trans-r (macros-only-env er)))
                               (extend-ribcage! ribcage id label)
-                              (parse (cdr body)
-                                     (cons id ids)
-                                     (cons label labels)
-                                     var-ids
-                                     vars
-                                     vals
-                                     (cons (cons 'macro (cons er (wrap e w 
mod))) bindings))))
+                              (set-cdr!
+                                r
+                                (extend-env
+                                  (list label)
+                                  (list (cons 'macro (eval-local-transformer 
(expand e trans-r w mod) mod)))
+                                  (cdr r)))
+                              (parse (cdr body) (cons id ids) labels var-ids 
vars vals bindings)))
                            ((memv key '(begin-form))
                             (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ . 
each-any))))
                               (if tmp
@@ -1049,17 +1051,6 @@
                                 #f
                                 "invalid or duplicate identifier in definition"
                                 outer-form))
-                            (let loop ((bs bindings) (er-cache #f) (r-cache 
#f))
-                              (if (not (null? bs))
-                                (let ((b (car bs)))
-                                  (if (eq? (car b) 'macro)
-                                    (let* ((er (cadr b))
-                                           (r-cache (if (eq? er er-cache) 
r-cache (macros-only-env er))))
-                                      (set-cdr!
-                                        b
-                                        (eval-local-transformer (expand (cddr 
b) r-cache '(()) mod) mod))
-                                      (loop (cdr bs) er r-cache))
-                                    (loop (cdr bs) er-cache r-cache)))))
                             (set-cdr! r (extend-env labels bindings (cdr r)))
                             (build-letrec
                               #f
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 4abd3c9..565c911 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1470,13 +1470,22 @@
                                     (cons var vars) (cons (cons er (wrap e w 
mod)) vals)
                                     (cons (make-binding 'lexical var) 
bindings)))))
                         ((define-syntax-form define-syntax-parameter-form)
-                         (let ((id (wrap value w mod)) (label (gen-label)))
+                         (let ((id (wrap value w mod))
+                               (label (gen-label))
+                               (trans-r (macros-only-env er)))
                            (extend-ribcage! ribcage id label)
-                           (parse (cdr body)
-                                  (cons id ids) (cons label labels)
-                                  var-ids vars vals
-                                  (cons (make-binding 'macro (cons er (wrap e 
w mod)))
-                                        bindings))))
+                           ;; As required by R6RS, evaluate the 
right-hand-sides of internal
+                           ;; syntax definition forms and add their 
transformers to the
+                           ;; compile-time environment immediately, so that 
the newly-defined
+                           ;; keywords may be used in definition context 
within the same
+                           ;; lexical contour.
+                           (set-cdr! r (extend-env (list label)
+                                                   (list (make-binding 'macro
+                                                                       
(eval-local-transformer
+                                                                        
(expand e trans-r w mod)
+                                                                        mod)))
+                                                   (cdr r)))
+                           (parse (cdr body) (cons id ids) labels var-ids vars 
vals bindings)))
                         ((begin-form)
                          (syntax-case e ()
                            ((_ e1 ...)
@@ -1507,21 +1516,6 @@
                                    (syntax-violation
                                     #f "invalid or duplicate identifier in 
definition"
                                     outer-form))
-                               (let loop ((bs bindings) (er-cache #f) (r-cache 
#f))
-                                 (if (not (null? bs))
-                                     (let* ((b (car bs)))
-                                       (if (eq? (car b) 'macro)
-                                           (let* ((er (cadr b))
-                                                  (r-cache
-                                                   (if (eq? er er-cache)
-                                                       r-cache
-                                                       (macros-only-env er))))
-                                             (set-cdr! b
-                                                       (eval-local-transformer
-                                                        (expand (cddr b) 
r-cache empty-wrap mod)
-                                                        mod))
-                                             (loop (cdr bs) er r-cache))
-                                           (loop (cdr bs) er-cache r-cache)))))
                                (set-cdr! r (extend-env labels bindings (cdr 
r)))
                                (build-letrec no-source #t
                                              (reverse (map syntax->datum 
var-ids))


hooks/post-receive
-- 
GNU Guile