Folks,
Inspired by "Swine before pearl", Dave Roberts
(http://www.findinglisp.com/blog/2004/06/basic-automaton-macro.html)
and my own needs I wrote up some code to create state machines. I stuck
to the format that Dave uses and added guards, i.e. conditions that
need to be evaluated before a transition is taken. The code uses CLOS
and transitions are triggered by event objects, although you can easily
trigger it by symbols if you use eql specializers.
I hope someone finds it useful and would appreciate comments or
suggestions for improvement! I'm sure what I'm doing can be done more
elegantly. Please see http://wagerlabs.com/tech for the gory details.
Thanks, Joel
--
http://wagerlabs.com/tech
Here is another way using state-event-action tables.
Thus one gets away from creating a function that ends
up as a big if-then-else statement.
A table (array) is created with integer indexes for
state and event. Next state and actions are stored
in the entries of the table. Then your guard
code can look like the following,
(defmacro define-state-table (name (states events actions) &rest table)
`(progn
,@(loop for integer-state from 0
for state in states
collect `(defparameter ,state ,integer-state))
,@(loop for integer-event from 0
for event in events
collect `(defparameter ,event ,integer-event))
(defparameter ,name
,(let ((state-table (make-array (list (length states) (length
events))
:initial-element nil)))
(loop for (state event next-state . process-actions) in table
do
(assert (and (member state states) (member event
events) (member next-state states)
(every (lambda (action) (member action
actions)) process-actions)))
(setf (aref state-table
(position state states)
(position event events))
(cons (position next-state states) process-actions)))
state-table))))
(define-state-table *guard-table* ((start state-1 state-2 state-3)
(event-1 event-2 event-3 event-4)
(true-guard false-guard))
(start event-1 state-1)
(start event-2 start)
(state-1 event-2 state-2)
(state-2 event-1 start)
(state-2 event-2 state-3)
(state-3 event-1 state-1 true-guard)
(state-3 event-2 state-2 true-guard true-guard)
(state-3 event-3 start false-guard)
(state-3 event-4 start true-guard false-guard))
(defvar *guard-state* start)
(defun process-guard-event (event &rest context &key &allow-other-keys)
(declare (ignorable context))
(let* ((state-event-action (aref *guard-table* *guard-state* event)))
(setf *guard-state* (or (first state-event-action) *guard-state*))
(dolist (action (rest state-event-action))
(case action
(true-guard (true-guard))
(false-guard (false-guard))))))