#lang racket (define-syntax define-enum (syntax-rules () [(define-enum enum-name ([const-name const-value description] ...)) (define-syntax enum-name (let ([const-table (make-immutable-hasheq (list '(const-name . const-value) ...))]) (λ (stx) (let ([value (map (λ (name) (list #'quote (hash-ref const-table (syntax->datum name) (λ () (raise-syntax-error 'enum-name "unknown enumeration constant" name))))) (cdr (syntax-e stx)))]) (datum->syntax #'enum-name (if (and (not (null? value)) (null? (cdr value))) (car value) (cons #'list value)))))))])) (define-syntax enum-case (syntax-rules () [(enum-case enum-name enum-value [guard-spec . body] ...) (let ([v enum-value]) (let-syntax ([make-guard (syntax-rules (else) [(make-guard (const-name)) (eqv? v (enum-name const-name))] [(make-guard (const-name (... ...))) (memv v (list (enum-name const-name) (... ...)))] [(make-guard else) #t])]) (cond [(make-guard guard-spec) . body] ...)))])) (provide define-enum enum-case)