[Guile-commits] GNU Guile branch, vtable-vtable-deprecation, updated. v2.0.5-222-g185408e

[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=185408e051910a63d46ac1660d880dd50178e39b

The branch, vtable-vtable-deprecation has been updated
       via  185408e051910a63d46ac1660d880dd50178e39b (commit)
      from  4c49fe08e319c4434e16f124c0995edab1fdf313 (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 185408e051910a63d46ac1660d880dd50178e39b
Author: Mark H Weaver <address@hidden>
Date:   Thu Mar 8 01:24:25 2012 -0500

    Fix @ and @@ to not capture lexicals; new @@ @@ form for R6RS libraries
    
    * module/ice-9/psyntax.scm (@): Return top-wrap instead of the wrap
      applied to the '@' form, so that the symbol will be interpreted as a
      top-level identifier and never refer to any lexical variable.
    
      (@@): Change the syntax used to support R6RS 'library' forms to:
      (@@ @@ (mod ...) body).  Change the behavior of the documented
      (@@ (mod ...) id) form to be the same as that of @, except for the use
      of 'private' instead of 'public' in the psyntax mod: use syntax->datum
      on the identifier, and return top-wrap instead of the wrap applied to
      the '@@' form.
    
      This fixes <http://bugs.gnu.org/10756> reported by Ludovic Courtès.
    
    * module/ice-9/psyntax-pp.scm: Regenerate.
    
    * module/ice-9/r6rs-libraries.scm (library): Use '@@ @@' syntax instead
      of the older '@@' syntax.
    
    * test-suite/tests/syncase.test (changes to expansion environment): Use
      '@@ @@' syntax.
    
    * module/Makefile.am: Add explicit dependencies for boot-9.go on the
      files that it includes: quasisyntax.scm and r6rs-libraries.scm.

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

Summary of changes:
 module/Makefile.am              |    2 ++
 module/ice-9/psyntax-pp.scm     |   36 ++++++++++++++++++++++++++----------
 module/ice-9/psyntax.scm        |   19 ++++++++++++++++---
 module/ice-9/r6rs-libraries.scm |    2 +-
 test-suite/tests/syncase.test   |   16 ++++++++--------
 5 files changed, 53 insertions(+), 22 deletions(-)

diff --git a/module/Makefile.am b/module/Makefile.am
index 0133ddd..93fe9c8 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -32,6 +32,8 @@ nobase_ccache_DATA += ice-9/eval.go
 EXTRA_DIST += ice-9/eval.scm
 ETAGS_ARGS += ice-9/eval.scm
 
+ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm 
ice-9/r6rs-libraries.scm
+
 # We can compile these in any order, but it's fastest if we compile
 # psyntax and boot-9 first, then the compiler itself, then the rest of
 # the code.
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 7475983..68d1bf6 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1950,7 +1950,7 @@
                    (values
                      (syntax->datum id)
                      r
-                     w
+                     '((top))
                      #f
                      (syntax->datum
                        (cons '#(syntax-object public ((top)) (hygiene guile)) 
mod))))
@@ -1982,16 +1982,32 @@
                             (loop (+ i 1)))))))
                    (else x)))))
         (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ each-any any))))
-          (if (and tmp (apply (lambda (mod exp) (and-map id? mod)) tmp))
-            (apply (lambda (mod exp)
-                     (let ((mod (syntax->datum
-                                  (cons '#(syntax-object private ((top)) 
(hygiene guile)) mod))))
-                       (values (remodulate exp mod) r w (source-annotation 
exp) mod)))
+          (if (and tmp
+                   (apply (lambda (mod id) (and (and-map id? mod) (id? id))) 
tmp))
+            (apply (lambda (mod id)
+                     (values
+                       (syntax->datum id)
+                       r
+                       '((top))
+                       #f
+                       (syntax->datum
+                         (cons '#(syntax-object private ((top)) (hygiene 
guile)) mod))))
                    tmp)
-            (syntax-violation
-              #f
-              "source expression failed to match any pattern"
-              tmp-1))))))
+            (let ((tmp ($sc-dispatch
+                         tmp-1
+                         '(_ #(free-id #(syntax-object @@ ((top)) (hygiene 
guile)))
+                             each-any
+                             any))))
+              (if (and tmp (apply (lambda (mod exp) (and-map id? mod)) tmp))
+                (apply (lambda (mod exp)
+                         (let ((mod (syntax->datum
+                                      (cons '#(syntax-object private ((top)) 
(hygiene guile)) mod))))
+                           (values (remodulate exp mod) r w (source-annotation 
exp) mod)))
+                       tmp)
+                (syntax-violation
+                  #f
+                  "source expression failed to match any pattern"
+                  tmp-1))))))))
   (global-extend
     'core
     'if
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 0e6f566..6c264a6 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2239,7 +2239,9 @@
                      (syntax-case e ()
                        ((_ (mod ...) id)
                         (and (and-map id? #'(mod ...)) (id? #'id))
-                        (values (syntax->datum #'id) r w #f
+                        ;; Strip the wrap from the identifier and return 
top-wrap
+                        ;; so that the identifier will not be captured by 
lexicals.
+                        (values (syntax->datum #'id) r top-wrap #f
                                 (syntax->datum
                                  #'(public mod ...)))))))
 
@@ -2262,9 +2264,20 @@
                                       ((fx= i n) v)
                                     (vector-set! v i (remodulate (vector-ref x 
i) mod)))))
                                (else x))))
-                     (syntax-case e ()
-                       ((_ (mod ...) exp)
+                     (syntax-case e (@@)
+                       ((_ (mod ...) id)
+                        (and (and-map id? #'(mod ...)) (id? #'id))
+                        ;; Strip the wrap from the identifier and return 
top-wrap
+                        ;; so that the identifier will not be captured by 
lexicals.
+                        (values (syntax->datum #'id) r top-wrap #f
+                                (syntax->datum
+                                 #'(private mod ...))))
+                       ((_ @@ (mod ...) exp)
                         (and-map id? #'(mod ...))
+                        ;; This is a special syntax used to support R6RS 
library forms.
+                        ;; Unlike the syntax above, the last item is not 
restricted to
+                        ;; be a single identifier, and the syntax objects are 
kept
+                        ;; intact, with only their module changed.
                         (let ((mod (syntax->datum #'(private mod ...))))
                           (values (remodulate #'exp mod)
                                   r w (source-annotation #'exp)
diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index bf1127e..f71b90b 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -197,7 +197,7 @@
                  (export e ...)
                  (re-export r ...)
                  (export! x ...)
-                 (@@ (name name* ...) body)
+                 (@@ @@ (name name* ...) body)
                  ...))))))))
     
 (define-syntax import
diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test
index 6183df8..0e81f65 100644
--- a/test-suite/tests/syncase.test
+++ b/test-suite/tests/syncase.test
@@ -115,16 +115,16 @@
          'foo)))
 
 (with-test-prefix "changes to expansion environment"
-  (pass-if "expander detects changes to current-module with @@"
+  (pass-if "expander detects changes to current-module with @@ @@"
     (compile '(begin
                 (define-module (new-module))
-                (@@ (new-module)
-                    (define-syntax new-module-macro
-                      (lambda (stx)
-                        (syntax-case stx () 
-                          ((_ arg) (syntax arg))))))
-                (@@ (new-module)
-                    (new-module-macro #t)))
+                (@@ @@ (new-module)
+                       (define-syntax new-module-macro
+                         (lambda (stx)
+                           (syntax-case stx () 
+                             ((_ arg) (syntax arg))))))
+                (@@ @@ (new-module)
+                       (new-module-macro #t)))
              #:env (current-module))))
 
 (define-module (test-suite test-syncase-2)


hooks/post-receive
-- 
GNU Guile