Automata via Macros - http://cs.brown.edu/~sk/Publications/Papers/Published/sk-automata-macros/

automata.rkt

#lang racket

(module+ test
  (require rackunit))

(define state-machine
  '((init (c more))
    (more (a more)
          (d more)
          (r end))
    (end)))

(define (run machine init-state stream)
  (define (walker state stream)
    (cond
      [(empty? stream) #t]
      [else
       (let* ([in (first stream)]
              [transitions (rest (assv state machine))]
              [new-state (assv in transitions)])
         (if new-state
             (walker (first (rest new-state)) (rest stream))
             #f))]))
  (walker init-state stream))

(module+ test
  (check-true (run state-machine 'init '(c a d a d d r)))
  (check-false (run state-machine 'init '(c a d a d d r r))))

(define machine
  (letrec ([init
            (lambda (stream)
              (cond
                [(empty? stream) #t]
                [else
                 (case (first stream)
                   [(c) (more (rest stream))]
                   [else #f])]))]
           [more
            (lambda (stream)
              (cond
                [(empty? stream) #t]
                [else
                 (case (first stream)
                   [(a) (more (rest stream))]
                   [(d) (more (rest stream))]
                   [(r) (end (rest stream))]
                   [else #f])]))]
           [end
            (lambda (stream)
              (cond
                [(empty? stream) #t]
                [else
                 (case (first stream)
                   [else #f])]))])
    init))

(module+ test
  (check-true (machine '(c a d a d d r)))
  (check-false (machine '(c a d a d d r r))))

(define-syntax automaton
  (syntax-rules (:)
    [(_ init-state
        (state : response ...)
        ...)
     (let-syntax
         ([process-state
           (syntax-rules (accept →)
             [(_ accept)
              (lambda (stream)
                (cond
                  [(empty? stream) #t]
                  [else #f]))]
             [(_ (label → target) (... ...))
              (lambda (stream)
                (cond
                  [(empty? stream) #f]
                  [else
                   (case (first stream)
                     [(label) (target (rest stream))]
                     (... ...)
                     [else #f])]))])])
       (letrec ([state
                 (process-state response ...)]
                ...)
         init-state))]))

(define m (automaton init
           [init : (c → more)]
           [more : (a → more)
                   (d → more)
                   (r → end)]
           [end : accept]))

(module+ test
  (check-true (m '(c a d a d d r)))
  (check-false (m '(c a d a d d r r)))
  (check-true (m '(c a d r)))
  (check-false (m '(c a d a)))
  (check-true (m '(c a d a r)))
  (check-false (m '(c a d a r r))))