suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix problem with package, define*, and macro-introduced identifiers

Browse Source 
svn: r14671

original commit: 2b8b10dd400a833a0b8632411f91b01c48e61796
This commit is contained in:
Matthew Flatt 2009-04-30 23:57:45 +00:00
parent 2b7e5a9642
commit 872f83b18d
1 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/scheme/package.ss
View File

@ -219,14 +219,12 @@
ids))]
[add-package-context (lambda (def-ctxes)
(lambda (stx)
(for/fold ([stx stx])
([def-ctx (in-list (reverse def-ctxes))])
(let ([q (local-expand #`(quote #,stx)
ctx
(list #'quote)
def-ctx)])
(syntax-case q ()
[(_ stx) #'stx])))))])
(let ([q (local-expand #`(quote #,stx)
ctx
(list #'quote)
def-ctxes)])
(syntax-case q ()
[(_ stx) #'stx]))))])
(let loop ([exprs init-exprs]
[rev-forms null]
[def-ctxes (list def-ctx)])
@ -293,11 +291,10 @@
(lambda ()
(list (quote-syntax hidden) ...)))))))))))]
[else
(let ([expr ((add-package-context (cdr def-ctxes))
(local-expand ((add-package-context (cdr def-ctxes)) (car exprs))
ctx
kernel-forms
(car def-ctxes)))])
(let ([expr (local-expand (car exprs)
ctx
kernel-forms
def-ctxes)])
(syntax-case expr (begin)
[(begin . rest)
(loop (append (flatten-begin expr) (cdr exprs))