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

improve source location in internal-definition errors for syntax-case,

Browse Source 
syntax-case*, and datum-case
This commit is contained in:
Robby Findler 2016-04-26 16:08:16 -05:00
parent fb88abd992
commit 45acc19f44
3 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-test-core/tests/racket/macro.rktl
View File

@ -740,6 +740,9 @@
(datum-case (dynamic-require ''check-transformer-lift 'd) (begin define-values ok) (datum-case (dynamic-require ''check-transformer-lift 'd) (begin define-values ok)
[(begin (define-values (lifted) 5) ok) #t] [(begin (define-values (lifted) 5) ok) #t]
[x (datum x)])) [x (datum x)]))
(syntax-test #'(datum-case '(1 "x" -> y) (->) [(a b -> c) (define q 1)])
#rx"macro.rktl:.*no expression after a sequence of internal definitions")
;; ---------------------------------------- ;; ----------------------------------------
;; Check `#%variable-reference' expansion to make sure ;; Check `#%variable-reference' expansion to make sure

7
pkgs/racket-test-core/tests/racket/stx.rktl
View File

@ -142,6 +142,13 @@
(syntax-case #'#&(1 2 3) () (syntax-case #'#&(1 2 3) ()
[#&(x ...) #'(0 x ... 4)])) [#&(x ...) #'(0 x ... 4)]))
(syntax-test #'(syntax-case (syntax x) [x (define x 1)]))
(syntax-test #'(syntax-case (syntax x) () [x (define x 1)])
#rx"stx.rktl:.*no expression after a sequence of internal definitions")
(syntax-test #'(syntax-case* (syntax x) () eq? [x (define x 1)])
#rx"stx.rktl:.*no expression after a sequence of internal definitions")
;; ---------------------------------------- ;; ----------------------------------------
(test #t syntax-original? #'here) (test #t syntax-original? #'here)

20
racket/collects/racket/private/stxloc.rkt
View File

@ -6,26 +6,34 @@
(#%require "qq-and-or.rkt" "stxcase.rkt" "define-et-al.rkt" (#%require "qq-and-or.rkt" "stxcase.rkt" "define-et-al.rkt"
(for-syntax '#%kernel "stxcase.rkt" "sc.rkt")) (for-syntax '#%kernel "stxcase.rkt" "sc.rkt"))
(begin-for-syntax
(define-values (transform-to-syntax-case**)
(lambda (stx sc arg-is-stx? expr kws lit-comp s-exp? clauses)
((λ (ans) (datum->syntax #'here ans stx))
(list* 'syntax-case** sc arg-is-stx? expr kws lit-comp s-exp?
clauses)))))
;; Like regular syntax-case, but with free-identifier=? replacement ;; Like regular syntax-case, but with free-identifier=? replacement
(-define-syntax syntax-case* (-define-syntax syntax-case*
(lambda (stx) (lambda (stx)
(syntax-case** #f #t stx () free-identifier=? #f (syntax-case** #f #t stx () free-identifier=? #f
[(sc stxe kl id=? clause ...) [(sc stxe kl id=? . clause)
(syntax (syntax-case** sc #f stxe kl id=? #f clause ...))]))) (transform-to-syntax-case** stx #'sc #f #'stxe #'kl #'id=? #f #'clause)])))
;; Regular syntax-case ;; Regular syntax-case
(-define-syntax syntax-case (-define-syntax syntax-case
(lambda (stx) (lambda (stx)
(syntax-case** #f #t stx () free-identifier=? #f (syntax-case** #f #t stx () free-identifier=? #f
[(sc stxe kl clause ...) [(sc stxe kl . clause)
(syntax (syntax-case** sc #f stxe kl free-identifier=? #f clause ...))]))) (transform-to-syntax-case** stx #'sc #f #'stxe #'kl #'free-identifier=? #f
#'clause)])))
;; Like `syntax-case, but on plain datums ;; Like `syntax-case, but on plain datums
(-define-syntax datum-case (-define-syntax datum-case
(lambda (stx) (lambda (stx)
(syntax-case** #f #t stx () free-identifier=? #f (syntax-case** #f #t stx () free-identifier=? #f
[(sc stxe kl clause ...) [(sc stxe kl . clause)
(syntax (syntax-case** sc #f stxe kl eq? #t clause ...))]))) (transform-to-syntax-case** stx #'sc #f #'stxe #'kl #'eq? #t #'clause)])))
(-define (relocate loc stx) (-define (relocate loc stx)
(if (or (syntax-source loc) (if (or (syntax-source loc)