suzanne.soy/auto-syntax-e
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added auto-syntax-case

Browse Source
This commit is contained in:
Georges Dupéron 2016-10-20 01:43:49 +02:00
parent d15bf9bf08
commit 35cee6910e
4 changed files with 66 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.travis.yml
View File

@ -50,7 +50,7 @@ before_script:
# `raco pkg install --deps search-auto` to install any required
# packages without it getting stuck on a confirmation prompt.
script:
- raco test -x -p auto-syntax-e
- raco test -p auto-syntax-e
- raco setup --check-pkg-deps --pkgs auto-syntax-e;
- raco pkg install doc-coverage
- raco doc-coverage auto-syntax-e

43
main.rkt
View File

@ -13,6 +13,7 @@
(provide auto-with-syntax)
(provide auto-syntax)
(provide auto-syntax-case)
(define (leaves->datum e depth)
(if (> depth 0)
@ -91,38 +92,12 @@
(auto-syntax (id ...)
body ...))]))
(module+ test
(require rackunit
syntax/parse)
(check-equal? (match (auto-with-syntax ([x #'123])
(list (add1 x) #'x))
[(list a (? syntax? b))
(list a (syntax-e b))]
[_ 'error])
'(124 123))
(check-equal? (match (syntax-parse #'(1 2 3)
[(x:nat y:nat ...)
(auto-syntax (x y)
(list (map add1 (cons x y)) #'(x y ...)))])
[(list a (? syntax? b))
(list a (syntax->datum b))]
[_ 'error])
'((2 3 4) (1 2 3)))
(check-equal? (match (syntax-parse #'(1 2 3)
[({~seq x:nat {~optional y:nat}} ...)
(auto-syntax (x y)
(list (map cons x y)
(attribute x)
(attribute y)))])
[(list a
(list (? syntax? b₁) (? syntax? b₂))
(list (? syntax? c₁) (and #f c₂)))
(list a
(list (syntax->datum b₁) (syntax->datum b₂))
(list (syntax->datum c₁) c₂))]
[_ 'error])
'([(1 . 2) (3 . #f)]
[1 3]
[2 #f])))
(define-syntax auto-syntax-case
(syntax-parser
[(_ stx-expression literals [pat guard+body ...] ...)
#:with (id ...) (syntax->ids #'(pat ...))
#'(syntax-case stx-expression literals
[pat (auto-syntax (id ...)
guard+body ...)]
...)]))

12
scribblings/auto-syntax-e.scrbl
View File

@ -47,4 +47,14 @@ unchanged.
ignored and the existing binding, if any, is left untouched.
Note that it is not necessary to specify the ellipsis-depth of each
@racket[pvarᵢ].}
@racket[pvarᵢ].}
@defform[(auto-syntax-case stx-expression (literal ...)
[patᵢ maybe-guardᵢ bodyᵢ]
...)
#:grammar
[(maybe-guardᵢ (code:line)
(code:line guard-expression))]]{
Like @racket[syntax-case], but the syntax pattern variables bound by the
@racket[patᵢ ...] can be used outside of templates like in
@racket[auto-with-syntax].}

45
test/test-auto-syntax-e.rkt Normal file
View File

@ -0,0 +1,45 @@
#lang racket
(require auto-syntax-e
rackunit
syntax/parse)
(check-equal? (match (auto-with-syntax ([x #'123])
(list (add1 x) #'x))
[(list a (? syntax? b))
(list a (syntax-e b))]
[_ 'error])
'(124 123))
(check-equal? (match (syntax-parse #'(1 2 3)
[(x:nat y:nat ...)
(auto-syntax (x y)
(list (map add1 (cons x y)) #'(x y ...)))])
[(list a (? syntax? b))
(list a (syntax->datum b))]
[_ 'error])
'((2 3 4) (1 2 3)))
(check-equal? (match (syntax-parse #'(1 2 3)
[({~seq x:nat {~optional y:nat}} ...)
(auto-syntax (x y)
(list (map cons x y)
(attribute x)
(attribute y)))])
[(list a
(list (? syntax? b₁) (? syntax? b₂))
(list (? syntax? c₁) (and #f c₂)))
(list a
(list (syntax->datum b₁) (syntax->datum b₂))
(list (syntax->datum c₁) c₂))]
[_ 'error])
'([(1 . 2) (3 . #f)]
[1 3]
[2 #f]))
(check-equal? (match (auto-syntax-case #'123 ()
[x (list (add1 x) #'x)])
[(list a (? syntax? b))
(list a (syntax-e b))]
[_ 'error])
'(124 123))