Cherry-pick PR #1514: Added a syntax-local-template-metafunction-introduce function, so that template metafunctions can be unhygienic if necessary.
This commit is contained in:
parent
64edde1f2d
commit
de60a419e2
|
@ -2,7 +2,8 @@
|
|||
(require syntax/parse/private/minimatch
|
||||
racket/private/promise
|
||||
racket/private/stx) ;; syntax/stx
|
||||
(provide translate)
|
||||
(provide translate
|
||||
syntax-local-template-metafunction-introduce)
|
||||
|
||||
#|
|
||||
;; Doesn't seem to make much difference.
|
||||
|
@ -254,7 +255,8 @@ An VarRef is one of
|
|||
[mark (make-syntax-introducer)]
|
||||
[old-mark (current-template-metafunction-introducer)]
|
||||
[mf (get index env lenv)])
|
||||
(parameterize ((current-template-metafunction-introducer mark))
|
||||
(parameterize ((current-template-metafunction-introducer mark)
|
||||
(old-template-metafunction-introducer old-mark))
|
||||
(let ([r (call-with-continuation-barrier (lambda () (mf (mark (old-mark v)))))])
|
||||
(unless (syntax? r)
|
||||
(raise-syntax-error #f "result of template metafunction was not syntax" stx))
|
||||
|
@ -396,6 +398,17 @@ An VarRef is one of
|
|||
(syntax-local-introduce stx)
|
||||
stx))))
|
||||
|
||||
(define old-template-metafunction-introducer
|
||||
(make-parameter #f))
|
||||
|
||||
(define (syntax-local-template-metafunction-introduce stx)
|
||||
(let ([mark (current-template-metafunction-introducer)]
|
||||
[old-mark (old-template-metafunction-introducer)])
|
||||
(unless old-mark
|
||||
(error 'syntax-local-template-metafunction-introduce
|
||||
"must be called within the dynamic extent of a template metafunction"))
|
||||
(mark (old-mark stx))))
|
||||
|
||||
;; ----
|
||||
|
||||
(define (stx-cadr x) (stx-car (stx-cdr x)))
|
||||
|
|
|
@ -13,6 +13,7 @@
|
|||
quasitemplate
|
||||
quasitemplate/loc
|
||||
define-template-metafunction
|
||||
syntax-local-template-metafunction-introduce
|
||||
??
|
||||
?@)
|
||||
|
||||
|
|
|
@ -209,4 +209,16 @@ track which syntax or datum pattern variables are bound.
|
|||
(define-syntax (get-pvars stx)
|
||||
#`'#,(current-pvars))
|
||||
(get-pvars))
|
||||
'(y x))]])}
|
||||
'(y x))]])}
|
||||
|
||||
@section{Extensions to @racketmodname[syntax/parse/experimental/template]}
|
||||
|
||||
@defmodule[stxparse-info/parse/experimental/template]
|
||||
|
||||
@defform[(syntax-local-template-introduce stx)]{
|
||||
Like @racket[syntax-local-introduce], but for @tech{template metafunctions}.
|
||||
|
||||
This change is also available in the package
|
||||
@racketmodname{backport-template-pr1514}. It has been submitted as a Pull
|
||||
Request to Racket, but can be used in
|
||||
@racketmodname[stxparse-info/parse/experimental/template] right away.}
|
Loading…
Reference in New Issue
Block a user