add `pattern-case` and `pattern-case-filter`

beautiful-racket-lib/br/get-info.rkt

@@ -7,7 +7,9 @@
     (send t compute-racket-amount-to-indent pos (λ(x)
                                                   (case x
                                                     [("with-pattern"
-                                                      "with-shared-id") 'lambda]
+                                                      "with-shared-id"
+                                                      "pattern-case"
+                                                      "pattern-case-filter") 'lambda]
                                                     [("define-macro"
                                                       "define-macro-cases"
                                                       "define-cases") 'define]

beautiful-racket-lib/br/syntax.rkt

@@ -25,18 +25,28 @@
 (module+ test
   (require rackunit))
 
+(define-macro (pattern-case-filter STX-ARG PAT+BODY ...)
+  #'(let* ([arg STX-ARG]
+           [stxs (or (and (syntax? arg) (syntax->list arg)) arg)])
+      (unless (and (list? stxs) (andmap syntax? stxs))
+        (raise-syntax-error 'pattern-case-filter
+                            (format "~v cannot be made into a list of syntax objects" (syntax->datum arg))))
+      (for*/list ([stx (in-list stxs)]
+                  [result (in-value (pattern-case stx PAT+BODY ... [else #f]))]
+                  #:when result)
+        result)))
 
-(define-macro-cases case-pattern
+(define-macro-cases pattern-case
   [(_ STX-ARG
       [PAT . BODY] ...
       [else . ELSEBODY]) (with-syntax ([(LITERAL ...) (generate-literals #'(PAT ...))])
                            #'(syntax-case STX-ARG (LITERAL ...)
                                [PAT . BODY] ...
                                [else . ELSEBODY]))]
-  [(_ STX-ARG
+  [(_ STX-ARG PAT+BODY ...)
-      PAT+BODY ...) #'(case-pattern STX-ARG
+   #'(pattern-case STX-ARG
                    PAT+BODY ...
-                                    [else (raise-syntax-error 'case-pattern
+                   [else (raise-syntax-error 'pattern-case
                                              (format "unable to match pattern for ~v" (syntax->datum STX-ARG)))])])
 
 (define-macro-cases with-pattern