summaryrefslogtreecommitdiff
path: root/module/ice-9/psyntax-pp.scm
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2012-03-08 01:24:25 -0500
committerAndy Wingo <wingo@pobox.com>2012-07-06 20:12:50 +0200
commit8210c8538a6efb48d8adaf402546f30a8b249bcb (patch)
tree7aa6541ef70354e02584ceab749b84a5f406a090 /module/ice-9/psyntax-pp.scm
parent5f8d67ad09d21263d1ea2d537afcc5464d922dc5 (diff)
downloadguile-8210c8538a6efb48d8adaf402546f30a8b249bcb.tar.gz
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.
Diffstat (limited to 'module/ice-9/psyntax-pp.scm')
-rw-r--r--module/ice-9/psyntax-pp.scm36
1 files changed, 26 insertions, 10 deletions
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 7475983e5..68d1bf6eb 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