support this-syntax in syntax-parse, syntax-parser, etc.
closes PR 14855
This commit is contained in:
parent
ca57adcf2d
commit
cb3f296678
|
@ -2,6 +2,7 @@
|
|||
(require rackunit
|
||||
syntax/parse
|
||||
syntax/parse/debug
|
||||
syntax/parse/define
|
||||
"setup.rkt"
|
||||
(for-syntax syntax/parse))
|
||||
|
||||
|
@ -576,3 +577,25 @@
|
|||
(syntax->datum #'(let ([x 1] [y 2] [z 3])
|
||||
(+ x y z))))
|
||||
))
|
||||
|
||||
(test-case "this-syntax"
|
||||
(let ()
|
||||
(define-syntax-class identity
|
||||
[pattern _
|
||||
#:with stx this-syntax])
|
||||
(define stx #'(1 2 3))
|
||||
(syntax-parse stx
|
||||
[x:identity
|
||||
(check-eq? this-syntax stx)
|
||||
(check-eq? #'x.stx stx)])
|
||||
((syntax-parser
|
||||
[x:identity
|
||||
(check-eq? this-syntax stx)
|
||||
(check-eq? #'x.stx stx)])
|
||||
stx)
|
||||
(define-simple-macro (x . _)
|
||||
#:with stx (syntax/loc this-syntax (void))
|
||||
stx)
|
||||
(check-eq? (x) (void))
|
||||
))
|
||||
|
||||
|
|
|
@ -161,7 +161,8 @@
|
|||
[(syntax-parse stx-expr . clauses)
|
||||
(quasisyntax/loc stx
|
||||
(let ([x (datum->syntax #f stx-expr)])
|
||||
(parse:clauses x clauses body-sequence #,((make-syntax-introducer) stx))))]))
|
||||
(with ([this-syntax x])
|
||||
(parse:clauses x clauses body-sequence #,((make-syntax-introducer) stx)))))]))
|
||||
|
||||
(define-syntax (syntax-parser stx)
|
||||
(syntax-case stx ()
|
||||
|
@ -169,7 +170,8 @@
|
|||
(quasisyntax/loc stx
|
||||
(lambda (x)
|
||||
(let ([x (datum->syntax #f x)])
|
||||
(parse:clauses x clauses body-sequence #,((make-syntax-introducer) stx)))))]))
|
||||
(with ([this-syntax x])
|
||||
(parse:clauses x clauses body-sequence #,((make-syntax-introducer) stx))))))]))
|
||||
|
||||
(define-syntax (syntax-parser/template stx)
|
||||
(syntax-case stx ()
|
||||
|
@ -177,7 +179,8 @@
|
|||
(quasisyntax/loc stx
|
||||
(lambda (x)
|
||||
(let ([x (datum->syntax #f x)])
|
||||
(parse:clauses x clauses one-template ctx))))]))
|
||||
(with ([this-syntax x])
|
||||
(parse:clauses x clauses one-template ctx)))))]))
|
||||
|
||||
(define-syntax (define/syntax-parse stx)
|
||||
(syntax-case stx ()
|
||||
|
|
Loading…
Reference in New Issue
Block a user