www

commit 35cee6910e977e9bd96b3cbddb23305ad66c959a
parent d15bf9bf089882c8b29d90fe571d7bfb2828fb02
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Thu, 20 Oct 2016 01:43:49 +0200

Added auto-syntax-case

Diffstat:
M
.travis.yml
 | 
2
+-
M
main.rkt
 | 
44
++++++++++----------------------------------
M
scribblings/auto-syntax-e.scrbl
 | 
14
++++++++++++--
A
test/test-auto-syntax-e.rkt
 | 
46
++++++++++++++++++++++++++++++++++++++++++++++

4 files changed, 69 insertions(+), 37 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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