You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
sugar/sugar/unstable/case.rkt

26 lines
993 B
Racket

#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)])]))