#lang racket/base (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) (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)])]))