mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

fix module-hygiene corner case by relying more on syntax objects

Browse source 
* module/ice-9/psyntax.scm (chi-macro): Instead of assuming that output
  of a macro should be scoped relative to the module that was current
  when the macro was defined, allow the module information associated
  with the syntax object itself to pass through unmolested. Fixes bug
  29860.
  (datum->syntax): Propagate the module of the identifier through to the
  new syntax object, so that datum->syntax preserves module hygiene in
  addition to lexical hygiene.
  (include, include-from-path): Refactor to plumb though the hygiene
  information from the filename instead of the `include', allowing
  hygiene from the original caller of include-from-path to propagate
  through.

* module/ice-9/psyntax-pp.scm: Regenerated.

* test-suite/tests/syncase.test ("macro-generating macro"): Add test for
  bug 29860.
This commit is contained in:
Andy Wingo 2010-06-06 13:00:59 +02:00
parent a96434cc33
commit 9846796b6a
3 changed files with 47 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2969,8 +2969,8 @@
(cons 'shift
#{s\ 1509}#))
(cons (quote shift) #{s\ 1509}#)))
(cons 'hygiene
(cdr #{p\ 1480}#))))))
(#{syntax-object-module\ 342}#
#{x\ 1496}#)))))
(if (vector? #{x\ 1496}#)
(let ((#{n\ 1517}#
(vector-length #{x\ 1496}#)))
@ -12640,7 +12640,7 @@
(#{make-syntax-object\ 334}#
#{datum\ 3858}#
(#{syntax-object-wrap\ 340}# #{id\ 3857}#)
#f)))
(#{syntax-object-module\ 342}# #{id\ 3857}#))))
(set! syntax->datum
(lambda (#{x\ 3861}#)
(#{strip\ 483}# #{x\ 3861}# (quote (())))))
@ -15409,7 +15409,7 @@
'each-any)))
(#{read-file\ 4381}#
#{fn\ 4401}#
#{k\ 4398}#))))
#{filename\ 4399}#))))
#{tmp\ 4395}#)
(syntax-violation
#f
@ -15457,15 +15457,17 @@
(hygiene guile))
#{fn\ 4421}#))
#{tmp\ 4419}#))
(let ((#{t\ 4424}#
(%search-load-path #{fn\ 4417}#)))
(if #{t\ 4424}#
#{t\ 4424}#
(syntax-violation
'include-from-path
"file not found in path"
#{x\ 4408}#
#{filename\ 4415}#))))))
(datum->syntax
#{filename\ 4415}#
(let ((#{t\ 4424}#
(%search-load-path #{fn\ 4417}#)))
(if #{t\ 4424}#
#{t\ 4424}#
(syntax-violation
'include-from-path
"file not found in path"
#{x\ 4408}#
#{filename\ 4415}#)))))))
#{tmp\ 4411}#)
(syntax-violation
#f

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

@ -1357,8 +1357,7 @@
(if rib
(cons rib (cons 'shift s))
(cons 'shift s)))
;; hither the hygiene
(cons 'hygiene (cdr p)))))))
(syntax-object-module x))))))
((vector? x)
(let* ((n (vector-length x))
@ -2413,7 +2412,8 @@
(set! datum->syntax
(lambda (id datum)
(make-syntax-object datum (syntax-object-wrap id) #f)))
(make-syntax-object datum (syntax-object-wrap id)
(syntax-object-module id))))
(set! syntax->datum
; accepts any object, since syntax objects may consist partially
@ -2754,7 +2754,7 @@
(syntax-case x ()
((k filename)
(let ((fn (syntax->datum #'filename)))
(with-syntax (((exp ...) (read-file fn #'k)))
(with-syntax (((exp ...) (read-file fn #'filename)))
#'(begin exp ...)))))))
(define-syntax include-from-path
@ -2762,10 +2762,12 @@
(syntax-case x ()
((k filename)
(let ((fn (syntax->datum #'filename)))
(with-syntax ((fn (or (%search-load-path fn)
(syntax-violation 'include-from-path
"file not found in path"
x #'filename))))
(with-syntax ((fn (datum->syntax
#'filename
(or (%search-load-path fn)
(syntax-violation 'include-from-path
"file not found in path"
x #'filename)))))
#'(include fn)))))))
(define-syntax unquote

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

@ -119,3 +119,25 @@
(@@ (new-module)
(new-module-macro #t)))
#:env (current-module))))
(define-module (test-suite test-syncase-2)
#:export (make-the-macro))
(define (hello)
'hello)
(define-syntax make-the-macro
(syntax-rules ()
((_ name)
(define-syntax name
(syntax-rules ()
((_) (hello)))))))
(define-module (test-suite test-syncase)) ;; back to main module
(use-modules (test-suite test-syncase-2))
(make-the-macro foo)
(with-test-prefix "macro-generating macro"
(pass-if "module hygiene"
(eq? (foo) 'hello)))