diff --git a/.travis.yml b/.travis.yml index 40000a1..c0d81b8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -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 diff --git a/main.rkt b/main.rkt index 7884428..8b520ad 100644 --- a/main.rkt +++ b/main.rkt @@ -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 ...)] + ...)])) \ No newline at end of file diff --git a/scribblings/auto-syntax-e.scrbl b/scribblings/auto-syntax-e.scrbl index 9975647..f860493 100644 --- a/scribblings/auto-syntax-e.scrbl +++ b/scribblings/auto-syntax-e.scrbl @@ -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ᵢ].} \ No newline at end of file + @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].} \ No newline at end of file diff --git a/test/test-auto-syntax-e.rkt b/test/test-auto-syntax-e.rkt new file mode 100644 index 0000000..56eef56 --- /dev/null +++ b/test/test-auto-syntax-e.rkt @@ -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)) \ No newline at end of file