add literal generator to `with-pattern`

beautiful-racket-demo/basic-demo/expander.rkt

@@ -9,7 +9,7 @@
 
 (define-macro (b-module-begin (b-program LINE ...))
   (with-pattern
-      ([((NAME NUM STMT ...) ...) #'(LINE ...)]
+      ([((b-line NUM STMT ...) ...) #'(LINE ...)]
        [(LINE-FUNC ...) (prefix-id "line-" #'(NUM ...))])
     #'(#%module-begin
        LINE ...

beautiful-racket-lib/br/cond.rkt

@@ -18,10 +18,9 @@
 (define-macro (forever . EXPRS)
   ;; todo: would be better with a syntax parameter
   (with-pattern
-   ([stop (datum->syntax #'EXPRS 'stop)])
+   ([STOP (datum->syntax #'EXPRS 'stop)])
-   #'(let/ec stop
+   #'(let/ec STOP
-       (while #t
+       (while #t . EXPRS))))
-              . EXPRS))))
 
 (module+ test
   (require rackunit)

beautiful-racket-lib/br/define.rkt

@@ -4,6 +4,7 @@
   (for-syntax racket/base
               syntax/parse
               br/private/syntax-flatten
+              br/private/generate-literals
               syntax/define))
 (provide (all-defined-out)
          (for-syntax with-shared-id))
@@ -21,25 +22,6 @@
         (provide id)
         (define id lambda-exp))))
 
-
-(begin-for-syntax
-  (define (upcased-and-capitalized? sym)
-    (define str (symbol->string sym))
-    (and (equal? (string-upcase str) str)
-         (let ([first-letter (substring str 0 1)])
-           (or (and (string->number first-letter) #t) ; leading digit OK
-               (not (equal? (string-downcase first-letter) first-letter))))))
-
-  (define (generate-literals pats)
-    ;; generate literals for any symbols that are not ... or _ 
-    (define pattern-arg-prefixer "_")
-    (for*/list ([pat-arg (in-list (syntax-flatten pats))]
-                [pat-datum (in-value (syntax->datum pat-arg))]
-                #:when (and (symbol? pat-datum)
-                            (not (member pat-datum '(... _))) ; exempted from literality
-                            (not (upcased-and-capitalized? pat-datum))))
-               pat-arg)))
-
 (begin-for-syntax
   ;; expose the caller context within br:define macros with syntax parameter
   (require (for-syntax racket/base) racket/stxparam)
@@ -173,12 +155,12 @@
     [(_ id:id leading-pat:expr ... else-pat:else-clause trailing-pat0:expr trailing-pat:expr ...)
      (raise-syntax-error 'define-macro-cases "`else` clause must be last" (syntax->datum #'id))]
     [(_ id:id (pat:expr . result-exprs:expr) ... else-clause:else-clause)
-     (with-syntax ([LITERALS (generate-literals #'(pat ...))])
+     (with-syntax ([(LITERAL ...) (generate-literals #'(pat ...))])
        #'(define-macro id
            (λ (stx)
              (define result
                (syntax-parameterize ([caller-stx (make-rename-transformer #'stx)])
-                 (syntax-case stx LITERALS
+                 (syntax-case stx (LITERAL ...)
                    [pat . result-exprs] ...
                    else-clause)))
              (if (syntax? result)

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

@@ -0,0 +1,20 @@
+#lang racket/base
+(require racket/list "syntax-flatten.rkt")
+(provide (all-defined-out))
+
+(define (upcased-and-capitalized? sym)
+    (define str (symbol->string sym))
+    (and (equal? (string-upcase str) str)
+         (let ([first-letter (substring str 0 1)])
+           (or (and (string->number first-letter) #t) ; leading digit OK
+               (not (equal? (string-downcase first-letter) first-letter))))))
+
+  (define (generate-literals pats)
+    ;; generate literals for any symbols that are not ... or _ 
+    (define pattern-arg-prefixer "_")
+    (for*/list ([pat-arg (in-list (syntax-flatten pats))]
+                [pat-datum (in-value (syntax->datum pat-arg))]
+                #:when (and (symbol? pat-datum)
+                            (not (member pat-datum '(... _))) ; exempted from literality
+                            (not (upcased-and-capitalized? pat-datum))))
+               pat-arg))

beautiful-racket-lib/br/syntax.rkt

@@ -1,5 +1,8 @@
 #lang racket/base
-(require (for-syntax racket/base racket/syntax)
+(require (for-syntax
+          racket/base
+          racket/syntax
+          br/private/generate-literals)
          racket/list
          racket/match
          racket/syntax
@@ -30,11 +33,12 @@
 
 (define-macro-cases with-pattern
   [(_ () . BODY) #'(begin . BODY)]
-  [(_ ([SID SID-STX] STX ...) . BODY)
+  [(_ ([PAT STX] PAT+STX ...) . BODY)
-   #'(with-syntax ([SID SID-STX])
+   (with-syntax ([(LITERAL ...) (generate-literals #'PAT)])
-       (with-pattern (STX ...) . BODY))]
+     #'(syntax-case STX (LITERAL ...)
-  [(_ ([SID] STX ...) . BODY) ; standalone id
+         [PAT (with-pattern (PAT+STX ...) (let () . BODY))]))]
-   #'(with-pattern ([SID SID] STX ...) . BODY)]) ; convert to previous case
+  [(_ ([ID] STX ...) . BODY) ; standalone id
+   #'(with-pattern ([ID ID] STX ...) . BODY)]) ; convert to previous case
 
 
 (define (check-syntax-list-argument caller-name arg)