enum.rkt
#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)