;;; Finite State Machine
;;; Peter Salvi, 2009

(defun cases->function (state-def)
  "Converts a state definition from `cases' style to `function' style."
  (if (= (length (first state-def)) 1)
      state-def
    (let ((input (gensym)))
      `((,input)
        (ecase ,input
          ,@(loop for (value next-state) in state-def collect
                  `(,value ',next-state)))))))

(defmacro defsm (name &rest states)
  "Creates a closure with a hash table containing function definitions."
  (let ((state-hash (gensym))
        (input (gensym)))
    `(let ((,state-hash (make-hash-table)))
       ,@(loop for (state . state-def) in states collect
               `(setf (gethash ',state ,state-hash)
                      (lambda ,@(cases->function state-def))))
       (defun ,name (,input)
         (fsm ,state-hash ,input)))))

(defun fsm (state-hash input)
  (loop for state = 'start then (funcall (gethash state state-hash) next)
        for next in input
        when (eq state 'stop) do (return 'early-accept)
        finally (if (eq state 'stop)
                    (return 'accept)
                  (return 'reject))))

;;; Usage example

;; (defsm test
;;   (start (0 foo) (1 bar))
;;   (foo (0 foo) (1 baz))
;;   (bar (input) (if (= input 0) 'bar 'foo))
;;   (baz (0 stop)))

;; (test '(1 0 1 1 0))          ; accept
;; (test '(0 1 0 0 1))          ; early-accept
;; (test '(1 0 1 0 0))          ; reject
;; (test '(1 0 1 1 1))          ; (condition)