diff options
author | Mark H Weaver <mhw@netris.org> | 2012-03-08 01:24:25 -0500 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-07-06 20:12:50 +0200 |
commit | 8210c8538a6efb48d8adaf402546f30a8b249bcb (patch) | |
tree | 7aa6541ef70354e02584ceab749b84a5f406a090 /module/ice-9/psyntax-pp.scm | |
parent | 5f8d67ad09d21263d1ea2d537afcc5464d922dc5 (diff) | |
download | guile-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.scm | 36 |
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 |