support this-syntax in syntax-parse, syntax-parser, etc.

closes PR 14855
This commit is contained in:
AlexKnauth 2014-12-08 16:34:43 -05:00 committed by Ryan Culpepper
parent ca57adcf2d
commit cb3f296678
2 changed files with 29 additions and 3 deletions

View File

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

View File

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