better literal detection

beautiful-racket-lib/br/define.rkt

@@ -135,6 +135,14 @@
            "no matching case for calling pattern"
            (syntax->datum stx))]))
 
+(define-for-syntax (literalize-pat pat)
+  (cond
+    [(syntax->list pat) => (λ (subpats) (datum->syntax pat (map literalize-pat subpats)))]
+    [else (syntax-case pat ()
+            [pat (and (identifier? #'pat) (literal-identifier-datum? (syntax->datum #'pat)))
+                 #'(~literal pat)]
+            [pat #'pat])]))
+
 (define-syntax (define-macro-cases stx)
   (define (error-source stx) (or (syntax-property stx 'caller) 'define-macro-cases))
   (syntax-parse stx
@@ -145,16 +153,13 @@
     [(_ id:id (pat:expr . result-exprs:expr) ... else-clause:else-clause)
      (unless (ellipses-follow-wildcards-or-subpatterns? #'(pat ...))
        (raise-syntax-error (error-source #'id) "ellipsis in pattern can only appear after wildcard or subpattern" (syntax->datum stx)))
-     (with-syntax ([(BOUND-LITS UNBOUND-LITS)
+     (with-syntax ([(PAT ...) (map literalize-pat (syntax->list #'(pat ...)))])
-                    (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-parse (syntax-case stx () [any #'any])
-                   #:literals BOUND-LITS
+                   [PAT . result-exprs] ...
-                   #:datum-literals UNBOUND-LITS
-                   [pat . result-exprs] ...
                    else-clause)))
              (if (syntax? result)
                  result

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

@@ -1,8 +1,8 @@
 #lang racket/base
 (require "syntax-flatten.rkt" racket/list racket/match)
-(provide ellipses-follow-wildcards-or-subpatterns? generate-literals generate-bound-and-unbound-literals)
+(provide ellipses-follow-wildcards-or-subpatterns? generate-literals generate-bound-and-unbound-literals literal-identifier-datum?)
 
-(define (literal-identifier? pat-datum)
+(define (literal-identifier-datum? pat-datum)
   (and (symbol? pat-datum)
        (not (memq pat-datum '(... _))) ; isn't a reserved identifier
        (let ([pat-str (symbol->string pat-datum)])
@@ -11,14 +11,14 @@
 
 (define (wildcard? pat-datum)
   (and (symbol? pat-datum)
-       (not (literal-identifier? pat-datum))
+       (not (literal-identifier-datum? pat-datum))
        (not (memq pat-datum '(... _)))))
 
 ;; generate literals for any symbols that are not ... or _ and not IN_CAPS
 (define (generate-literals pats)
   (for*/list ([pat-arg (in-list (syntax-flatten pats))]
               [pat-datum (in-value (syntax->datum pat-arg))]
-              #:when (literal-identifier? pat-datum))
+              #:when (literal-identifier-datum? pat-datum))
     pat-arg))