From f6b3399ba15316b43e5cc94dda1975edbaea703c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 15 Nov 2018 17:39:39 -0800 Subject: [PATCH] punt --- sugar/unstable/case.rkt | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/sugar/unstable/case.rkt b/sugar/unstable/case.rkt index 404e006..553e070 100644 --- a/sugar/unstable/case.rkt +++ b/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)])])) \ No newline at end of file + [(_ [COND . BODY] ... ) #'(cond-report [COND . BODY] ... [else (void)])]))