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:
Georges Dupéron 2016-11-10 15:21:26 +01:00
parent 64edde1f2d
commit de60a419e2
3 changed files with 29 additions and 3 deletions

View File

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

View File

@ -13,6 +13,7 @@
quasitemplate
quasitemplate/loc
define-template-metafunction
syntax-local-template-metafunction-introduce
??
?@)

View File

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