use more `syntax-parse`

beautiful-racket-lib/br/define.rkt

@@ -97,6 +97,7 @@
 ;; `syntax-parse` classes shared by `define-macro` and `define-macro-cases`
 (begin-for-syntax
   (require syntax/parse)
+  
   (define-syntax-class syntaxed-id
     #:literals (syntax quasisyntax)
     #:description "id in syntaxed form"
@@ -133,7 +134,6 @@
            "no matching case for calling pattern"
            (syntax->datum stx))]))
 
-
 (define-syntax (define-macro-cases stx)  
   (syntax-parse stx
     [(_ id:id)
@@ -143,12 +143,15 @@
     [(_ id:id (pat:expr . result-exprs:expr) ... else-clause:else-clause)
      (unless (all-...-follow-wildcards #'(pat ...))
        (raise-syntax-error 'define-macro-cases "found ellipses after non-wildcard variable" (syntax->datum stx)))
-     (with-syntax ([(LITERAL ...) (generate-literals #'(pat ...))])
+     (with-syntax ([(BOUND-LITS UNBOUND-LITS)
+                    (generate-bound-and-unbound-literals #'(pat ...) #:treat-as-bound #'id)])
        #'(define-macro id
            (λ (stx)
              (define result
                (syntax-parameterize ([caller-stx (make-rename-transformer #'stx)])
-                 (syntax-case stx (LITERAL ...)
+                 (syntax-parse (syntax-case stx () [any #'any])
+                     #:literals BOUND-LITS
+                     #:datum-literals UNBOUND-LITS
                    [pat . result-exprs] ...
                    else-clause)))
              (if (syntax? result)

beautiful-racket-lib/br/private/generate-literals.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
-(require "syntax-flatten.rkt")
-(provide all-...-follow-wildcards generate-literals)
+(require "syntax-flatten.rkt" racket/list)
+(provide all-...-follow-wildcards generate-literals generate-bound-and-unbound-literals)
 
 (define (literal-identifier? pat-datum)
   (and (symbol? pat-datum)
@@ -21,6 +21,15 @@
               #:when (literal-identifier? pat-datum))
              pat-arg))
 
+(define (generate-bound-and-unbound-literals pats #:treat-as-bound [bound-id #f])
+  (define-values (bound-literals unbound-literals)
+    (partition identifier-binding (for/list ([pat (in-list (generate-literals pats))]
+                                             #:unless (and bound-id (bound-identifier=? pat bound-id)))
+                                            pat)))
+  ;; return as list of two lists so it's easy to match them in syntax pattern
+  (list (if bound-id (cons bound-id bound-literals) bound-literals)
+        unbound-literals))
+
 (define (all-...-follow-wildcards pats)
   (define prev-datum (box #f))
   (and

beautiful-racket-lib/br/syntax.rkt

@@ -8,6 +8,7 @@
          racket/format
          syntax/stx
          syntax/strip-context
+         syntax/parse
          br/define
          br/private/syntax-flatten)
 (provide (all-defined-out)
@@ -35,13 +36,20 @@
                   #:when result)
                  result)))
 
+
+(define-macro (syntax-parse/easy STX LITS . EXPS)
+  (with-syntax ([(BOUND-LITS UNBOUND-LITS) (generate-bound-and-unbound-literals #'LITS)])
+    #'(syntax-parse (syntax-case STX () [any #'any])
+        #:literals BOUND-LITS
+        #:datum-literals UNBOUND-LITS
+        . EXPS)))
+
 (define-macro-cases pattern-case
   [(_ STX-ARG
       [PAT . BODY] ...
-      [else . ELSEBODY]) (with-syntax ([(LITERAL ...) (generate-literals #'(PAT ...))])
-                           #'(syntax-case STX-ARG (LITERAL ...)
+      [else . ELSEBODY]) #'(syntax-parse/easy STX-ARG (PAT ...)
                                               [PAT . BODY] ...
-                               [else . ELSEBODY]))]
+                                              [else . ELSEBODY])]
   [(_ STX-ARG PAT+BODY ...)
    #'(pattern-case STX-ARG
                    PAT+BODY ...
@@ -51,11 +59,10 @@
 (define-macro-cases with-pattern
   [(_ () . BODY) #'(begin . BODY)]
   [(_ ([PAT0 STX0] PAT+STX ...) . BODY)
-   (with-syntax ([(LITERAL ...) (generate-literals #'PAT0)])
-     #'(syntax-case STX0 (LITERAL ...)
+   #'(syntax-parse/easy STX0 PAT0
                         [PAT0 (with-pattern (PAT+STX ...) (let () . BODY))]
                         [else (raise-syntax-error 'with-pattern
-                                   (format "unable to match pattern ~a" 'PAT0) STX0)]))])
+                                                  (format "unable to match pattern ~a" 'PAT0) STX0)])])
 
 
 (define-macro (format-string FMT ID0 ID ...)