From 726bca25425b5dd5ecfabfb42f911f0e2b14724b Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Tue, 24 Jan 2017 00:03:18 -0500
Subject: [PATCH] add `caseq` and `casev`

---
 beautiful-racket-lib/br/case.rkt | 24 ++++++++++++++++++++++++
 beautiful-racket-lib/br/main.rkt |  4 ++--
 2 files changed, 26 insertions(+), 2 deletions(-)
 create mode 100644 beautiful-racket-lib/br/case.rkt

diff --git a/beautiful-racket-lib/br/case.rkt b/beautiful-racket-lib/br/case.rkt
new file mode 100644
index 0000000..0636eeb
--- /dev/null
+++ b/beautiful-racket-lib/br/case.rkt
@@ -0,0 +1,24 @@
+#lang racket/base
+(require (for-syntax racket/base) br/define)
+(provide (all-defined-out))
+
+(define-macro (define-case-macro ID PRED)
+  #'(define-syntax (ID stx)
+      (syntax-case stx ()
+        [(_ test-val
+            [(match-vals) . result] (... ...)
+            [else . else-result])
+         #'(cond
+             [(PRED test-val '(match-vals)) . result] (... ...)
+             [else . else-result])]
+        [(_ test-val
+            match-clause (... ...))
+         #'(ID test-val
+               match-clause (... ...)
+               [else (error 'ID "no match")])])))
+
+;; like case but strictly uses `eq?` comparison (as opposed to `equal?`)
+(define-case-macro caseq memq)
+
+;; `eqv?` is OK for chars (same as `char=?`)
+(define-case-macro casev memv)
\ No newline at end of file
diff --git a/beautiful-racket-lib/br/main.rkt b/beautiful-racket-lib/br/main.rkt
index 4ded778..bfccd9b 100644
--- a/beautiful-racket-lib/br/main.rkt
+++ b/beautiful-racket-lib/br/main.rkt
@@ -1,10 +1,10 @@
 #lang racket/base
 (require racket/provide racket/list racket/string racket/format racket/match racket/port  racket/function
-         br/define br/syntax br/datum br/debug br/cond br/list racket/class racket/vector br/reader-utils
+         br/define br/syntax br/datum br/debug br/cond br/case br/list racket/class racket/vector br/reader-utils
          (for-syntax racket/base racket/syntax br/syntax br/debug br/define br/datum))
 (provide (all-from-out racket/base)
          (all-from-out racket/list racket/string racket/format racket/match racket/port racket/function
-                       br/syntax br/datum br/debug br/cond br/list racket/class racket/vector br/define br/reader-utils)
+                       br/syntax br/datum br/debug br/cond br/case br/list racket/class racket/vector br/define br/reader-utils)
          (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug br/datum))
          (for-syntax caller-stx with-shared-id)) ; from br/define