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

Added a syntax-local-template-metafunction-introduce function, so that template metafunctions can be unhygienic if necessary.

Browse Source
This commit is contained in:
Georges Dupéron 2016-11-10 15:21:26 +01:00
parent 4b2a202640
commit 3995a4ab59
2 changed files with 18 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-doc/syntax/scribblings/parse/experimental.scrbl
View File

@ -345,4 +345,7 @@ the context above; instead, @racket[let-values] would report an
invalid binding list.
}
@defform[(syntax-local-template-introduce stx)]{
Like @racket[syntax-local-introduce], but for @tech{template metafunctions}.}
@(close-eval the-eval)

17
racket/collects/syntax/parse/experimental/template.rkt
View File

@ -8,7 +8,8 @@
[quasisyntax/loc quasitemplate/loc]
[~? ??]
[~@ ?@])
define-template-metafunction)
define-template-metafunction
syntax-local-template-metafunction-introduce)
;; ============================================================
;; Metafunctions
@ -26,11 +27,23 @@
(define current-template-metafunction-introducer
(make-parameter (lambda (stx) (if (syntax-transforming?) (syntax-local-introduce stx) stx))))
(define old-template-metafunction-introducer
(make-parameter #f))
(define ((make-hygienic-metafunction transformer) stx)
(define mark (make-syntax-introducer))
(define old-mark (current-template-metafunction-introducer))
(parameterize ((current-template-metafunction-introducer mark))
(parameterize ((current-template-metafunction-introducer mark)
(old-template-metafunction-introducer old-mark))
(define r (call-with-continuation-barrier (lambda () (transformer (mark (old-mark stx))))))
(unless (syntax? r)
(raise-syntax-error #f "result of template metafunction was not syntax" stx))
(old-mark (mark r))))
(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))))