punt

sugar/unstable/case.rkt

@@ -2,25 +2,13 @@
 (require (for-syntax racket/base racket/syntax))
 (provide (all-defined-out))
 
-(define-syntax-rule (define-case-macro ID PRED)
-  (define-syntax (ID stx)
-    (syntax-case stx ()
-      [(_ TEST-VAL [(MATCH0 . MATCH-VALS) . RESULT] (... ...) [else . ELSE-RESULT])
-       #'(cond
-           [(PRED TEST-VAL '(MATCH0 . MATCH-VALS)) . RESULT] (... ...)
-           [else . ELSE-RESULT])]
-      [(_ TEST-VAL MATCH-CLAUSE (... ...))
-       #'(ID TEST-VAL
-             MATCH-CLAUSE (... ...)
-             [else (error 'ID (format "no match for ~a" TEST-VAL))])])))
-
 ;; like case but strictly uses `eq?` comparison (as opposed to `equal?`)
-(define-case-macro caseq memq)
-(define-case-macro casev memv)
+(define-syntax caseq (make-rename-transformer #'case))
+(define-syntax casev (make-rename-transformer #'case))
 
 
 (require sugar/debug)
 (define-syntax (cond-report stx)
   (syntax-case stx ()
     [(_ [COND . BODY] ... [else . ELSE-BODY]) #'(cond [(report COND) (report (let () (void) . BODY))] ... [else . ELSE-BODY])]
-    [(_ [COND . BODY] ... ) #'(cond-report [COND . BODY] ... [else (void)])])) 
+    [(_ [COND . BODY] ... ) #'(cond-report [COND . BODY] ... [else (void)])]))