mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

Fix @ and @@ to not capture lexicals; new @@ @@ form for R6RS libraries

Browse source 
* 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.
This commit is contained in:
Mark H Weaver 2012-03-08 01:24:25 -05:00 • committed by Andy Wingo
parent 5f8d67ad09
commit 8210c8538a
5 changed files with 53 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/Makefile.am
View file

@ -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.

36
module/ice-9/psyntax-pp.scm
View file

@ -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

19
module/ice-9/psyntax.scm
View file

@ -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)

2
module/ice-9/r6rs-libraries.scm
View file

@ -197,7 +197,7 @@
(export e ...)
(re-export r ...)
(export! x ...)
(@@ (name name* ...) body)
(@@ @@ (name name* ...) body)
...))))))))
(define-syntax import

16
test-suite/tests/syncase.test
View file

@ -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)