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

syntax/parse: add test for non-tilde pattern expander

Browse Source
This commit is contained in:
AlexKnauth 2015-10-13 15:26:13 -04:00 committed by Ryan Culpepper
parent 4d703fa2e2
commit 2acb10a5da
1 changed files with 44 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
pkgs/racket-test/tests/stxparse/test.rkt
View File

@ -562,23 +562,23 @@
;; from http://lists.racket-lang.org/users/archive/2014-June/063095.html ;; from http://lists.racket-lang.org/users/archive/2014-June/063095.html
(test-case "pattern-expanders" (test-case "pattern-expanders"
(let () (let ()
(define-splicing-syntax-class binding #:literals (=) (define-splicing-syntax-class binding #:literals (=)
[pattern (~seq name:id = expr:expr)]) [pattern (~seq name:id = expr:expr)])
(define-syntax ~separated (define-syntax ~separated
(pattern-expander (pattern-expander
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
[(separated sep pat) [(separated sep pat)
(with-syntax ([ooo '...]) (with-syntax ([ooo '...])
#'((~seq pat (~or (~peek-not _) #'((~seq pat (~or (~peek-not _)
(~seq sep (~peek _)))) (~seq sep (~peek _))))
ooo))])))) ooo))]))))
(define-splicing-syntax-class bindings (define-splicing-syntax-class bindings
[pattern (~separated (~datum /) b:binding) [pattern (~separated (~datum /) b:binding)
#:with (name ...) #'(b.name ...) #:with (name ...) #'(b.name ...)
#:with (expr ...) #'(b.expr ...)]) #:with (expr ...) #'(b.expr ...)])
(define (parse-my-let stx) (define (parse-my-let stx)
(syntax-parse stx (syntax-parse stx
@ -591,6 +591,33 @@
(+ x y z)))) (+ x y z))))
(syntax->datum #'(let ([x 1] [y 2] [z 3]) (syntax->datum #'(let ([x 1] [y 2] [z 3])
(+ x y z)))) (+ x y z))))
(define-syntax sep-comma ; test pattern expanders that don't begin with tilde
(pattern-expander
(lambda (stx)
(syntax-case stx ()
[(sep-comma pat)
(with-syntax ([ooo '...])
#'((~seq (~or (~and pat (~not ((~datum unquote) _))) ((~datum unquote) pat))
(~or (~peek-not _) (~peek ((~datum unquote) _))))
ooo))]))))
(define-splicing-syntax-class bindings2
[pattern (sep-comma [b:binding])
#:with (name ...) #'(b.name ...)
#:with (expr ...) #'(b.expr ...)])
(define (parse-my-let2 stx)
(syntax-parse stx
[(_ bs:bindings2 body)
#'(let ([bs.name bs.expr] ...)
body)]))
(check-equal? (syntax->datum
(parse-my-let2 #'(my-let ([x = 1], [y = 2], [z = 3])
(+ x y z))))
(syntax->datum #'(let ([x 1] [y 2] [z 3])
(+ x y z))))
)) ))
(test-case "this-syntax" (test-case "this-syntax"