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

Improve how splicing-syntax-parameterize interacts with module* forms

Browse Source 
Commit 00d438cfbe made an attempt at this,
but this commit does it in a much more careful way, based on manually
emulating how the macroexpander expands module* forms in order to allow
splicing-syntax-parameterize to apply even within #%module-begin forms
introduced by the expander.
This commit is contained in:
Alexis King 2017-10-17 11:08:15 -07:00
parent dd585e7ff7
commit 1e38918aa9
2 changed files with 49 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-test-core/tests/racket/stxparam.rktl
View File

@ -34,6 +34,7 @@
(syntax-case stx ()
[(_ id) #`(define id (quote #,v))]))
(m x)
(splicing-syntax-parameterize ([sp 'sub])
(begin
(define other 'other)
@ -80,6 +81,12 @@
(module* sp-submod #f
(provide b)
(m b)))
; make sure it applies to #%module-begin for submodules
(splicing-letrec-syntax ([#%module-begin (syntax-rules ()
[(_) (#%plain-module-begin (begin (provide b) (m b)))])])
(splicing-syntax-parameterize ([sp 'begin-defined])
(module* sp-submod2 #f)))
(provide x y z w f g))
@ -90,6 +97,7 @@
(test 'nested values ((dynamic-require ''check-splicing-stxparam-1 'f)))
(test 'also-nested values ((dynamic-require ''check-splicing-stxparam-1 'g)))
(test 'sub-submod dynamic-require '(submod 'check-splicing-stxparam-1 sp-submod) 'b)
(test 'begin-defined dynamic-require '(submod 'check-splicing-stxparam-1 sp-submod2) 'b)
(module check-splicing-stxparam-et racket/base
(require (for-syntax racket/base)

46
racket/collects/racket/splicing.rkt
View File

@ -343,9 +343,13 @@
(syntax/loc/props body
(begin-for-syntax (wrap-param-et e (orig-id ...) (temp-id ...)) ...))]
[(module . _) body]
[(module* n #f form ...)
(syntax/loc/props body
(module* n #f (expand-ssp-body (sp-id ...) (temp-id ...) (orig-id ...) form) ...))]
[(module* name #f form ...)
(datum->syntax body
(list #'module* #'name #f
#`(expand-ssp-module-begin
(sp-id ...) (temp-id ...) (orig-id ...)
#,body name form ...))
body)]
[(module* . _) body]
[(#%require . _) body]
[(#%provide . _) body]
@ -354,6 +358,35 @@
(letrec-syntaxes ([(sp-id) (syntax-local-value (quote-syntax temp-id))] ...)
expr))]))))]))
(define-syntax (expand-ssp-module-begin stx)
(syntax-case stx ()
[(_ (sp-id ...) (temp-id ...) (orig-id ...) mod-form mod-name-id body-form ...)
(unless (eq? (syntax-local-context) 'module-begin)
(raise-syntax-error #f "only allowed in module-begin context" stx))
(let ([ctx (syntax-local-make-definition-context #f #f)])
(for ([sp-id (in-list (syntax->list #'(sp-id ...)))]
[temp-id (in-list (syntax->list #'(temp-id ...)))])
(syntax-local-bind-syntaxes (list sp-id)
#`(syntax-local-value (quote-syntax #,temp-id))
ctx))
(let* ([forms (syntax->list #'(body-form ...))]
; emulate how the macroexpander expands module bodies and introduces #%module-begin
[body (if (= (length forms) 1)
(let ([body (local-expand (car forms) 'module-begin #f ctx)])
(syntax-case body (#%plain-module-begin)
[(#%plain-module-begin . _) body]
[_ (datum->syntax #'mod-form (list '#%module-begin body) #'mod-form)]))
(datum->syntax #'mod-form (list* '#%module-begin forms) #'mod-form))]
[body (syntax-property body 'enclosing-module-name (syntax-e #'mod-name-id))]
[body (local-expand body 'module-begin #f ctx)])
(syntax-case body (#%plain-module-begin)
[(#%plain-module-begin form ...)
(syntax/loc/props body
(#%plain-module-begin
(expand-ssp-body (sp-id ...) (temp-id ...) (orig-id ...) form) ...))]
[_ (raise-syntax-error
#f "expansion of #%module-begin is not a #%plain-module-begin form" body)])))]))
(define-syntax (letrec-syntaxes/trans stx)
(syntax-case stx ()
[(_ bindings body)
@ -412,8 +445,11 @@
(define-values ids (wrap-param-et rhs (orig-id ...) (temp-id ...))))]
[(module . _) e]
[(module* n #f form ...)
(syntax/loc/props e
(module* n #f (wrap-param-et form (orig-id ...) (temp-id ...)) ...))]
(datum->syntax
e
(syntax-e #'(module* n #f (wrap-param-et form (orig-id ...) (temp-id ...)) ...))
e
e)]
[(module* . _) e]
[(#%require . _) e]
[(#%provide . _) e]