From: Paul Tarvydas
Subject: Brainstorming - CL state machine macro
Date: 
Message-ID: <flebts$au6$1@aioe.org>
Exec summary - I need the equivalent of a goto based on a variable.  From
CL2e, it seems that I should use a case statement consisting of
non-computed go's.

I also need to figure out how to "capture" a state name and have it be
emitted by another macro deep in the bowels of user-supplied code.  (Is
this, then, a place where CL's non-hygenic macros are necessary?  Is there
some trick with nested / sibling macrolets that I can use?).


Long version - please make suggestions regarding alternatives that I may
have missed...

Over a few decades of embedded work, I have come to the realization that
state machines are the best way to handle "reactive" events.  I have
developed and become accustomed to a certain semantics for state machines. 
I now need a state machine in my CL gui.  Gui events - e.g. mouse move,
button clicks, character input - are "reactive" events.  The (large) set of
possible gestures is becoming hairy and would certainly be solved better
using a state machine.

I want to write a macro(s) that will allow me to work with state machines.


The state machine semantics I want are:

0) state machines contain multiple "states"

00) the state machine function is called exactly once for every "event" -
the machine function performs some computation based on the event
(including changing its own state), stores some state information
("history") and returns.  The next time the machine function is called, it
resumes execution in the body of the state where it had left off.

a) every state has "entry" code, "body" code and "exit" code (** note that
most simplistic state machine implementations leave out the concepts
of "entry" and "exit" code - the control flow of the machine is affected by
entry and exit code)

b) every time an event arrives (e.g. the machine is called), the current
state's body code is evaluated

c) if the evaluation does not result in a state change, then the machine
returns, without changing the state

d) if the state is changed, then (**** and this is important and different
from most other state machine models ****) 

(d1) the current state's "exit" code is immediately executed

(d2) the next state's "entry" code is immediately executed

(d3) the machine returns.

Here is sample macro syntax that would fit the above:

(machine (state-var)
  (state-name-1
        (entry-form-1)
        (body-form-1 ... (go-state state-name-2))
        (exit-form-1))
  (state-name-2)
        (entry-form-2)
        (body-form-2 ... (go-state state-name-3))
        (exit-form-2))
...
)

Where "state-var" is some variable (outside of the scope of the machine
macro).

Any state body can contain any number of "go-state" macro calls.

I can almost see how to build a macro to express these semantics.  Expanding
the above would result in the sample code below (ignoring issues of making
generated variables unique).  Note that "go-state" needs to expand into a
go to the state exit for the current state, which then results in a go to
the entry of the next state - every go-state becomes two go's in effect.

(block nil
  (let ((next-state nil))
    (tagbody

     (case state  ;; execution begins here by jumping to appropriate body
        (state-name-1 (go state-name-1-body))
        (state-name-2 (go state-name-2-body))
        (state-name-3 (go state-name-3-body))
        ...
        (otherwise (return state)))

  state-name-1-entry  ;; entry code sets state var, does entry work, returns
        (setq state 'state-name-1)
        (entry-form-1)
        (return state-var)

  state-name-1-body
        (body-form-1 ...
            (progn ()
              (setq next-state 'state-name-2)
              (go state-name-1-exit)))
        (return state-var) ;; default = no change in state

  state-name-1-exit  ;; exit code does some work, then jumps to next state
entry
        (exit-form-1)
        (go state-change)

... similarly for other states ...

     state-change   ;; state change = go to entry code of next state
       (case next-state
        (state-name-1 (go state-name-1-entry))
        (state-name-2 (go state-name-2-entry))
        (state-name-3 (go state-name-3-entry))
        ...
        (otherwise (return state)))))


Does this seem to be the most reasonable code to emit?  

I haven't yet sussed out "how" to emit the go-state macro.  Note that
go-state is supplied one label - the next state - but that it must, also,
implicitly memorize what state it is in (so that it may go to the
appropriate state exit).  In the above proposed expansion, go-state becomes
a setq and a go, next-state the label for the go is magically
inferred/memo'ized by the macro.

My comments: I could have used continuation functions, instead of the case
statements.  The "state" and "next-state" variables would then contain
functions like:

#'(lambda () (go state-2-body))

thanks for any comments

pt

From: Paul Khuong
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <18a1356c-9374-44db-a967-7d7dc1edcec9@1g2000hsl.googlegroups.com>
On Jan 1, 4:40 pm, Paul Tarvydas <········@visualframeworksinc.com>
wrote:
> Exec summary - I need the equivalent of a goto based on a variable.  From
> CL2e, it seems that I should use a case statement consisting of
> non-computed go's.
[...]
> Long version - please make suggestions regarding alternatives that I may
> have missed...
[...]
> I want to write a macro(s) that will allow me to work with state machines.
>
> The state machine semantics I want are:
[...]
> a) every state has "entry" code, "body" code and "exit" code (** note that
> most simplistic state machine implementations leave out the concepts
> of "entry" and "exit" code - the control flow of the machine is affected by
> entry and exit code)
[..]
> d) if the state is changed, then (**** and this is important and different
> from most other state machine models ****)
>
> (d1) the current state's "exit" code is immediately executed
>
> (d2) the next state's "entry" code is immediately executed
>
> (d3) the machine returns.

Use closures. First class functions are even more powerful than first-
class labels (computed gotos)! Store data in closed-over variables,
and represent states as mutually recursive functions (labels). You can
then simply return a closure corresponding to the next state
(continuation). e.g.

(let ((count 0))
  (labels ((state1 ()
             (incf count)
             #'state2)
           (state2 ()
             (format t "Counter: ~A~%" count)
             #'state1))
    #'state1))

Obviously, you can generate all that with a not-too-complex macro. By
introducing a 'transition' macro, you can easily implement your exit/
entry actions. You would then have something like:

(let (bindings...)
  (block block
    (labels ((first-state-entry () ...)
             (first-state-exit  () ...)
             (first-state-body  ()
               (macrolet ((transition (next-state)
                            [call exit function, then entry function
and
                             finally (return-from block #'next-state-
body)]))
                 ...))
             ...)
      (first-state-entry)
      #'first-state-body)))

Paul Khuong
From: Paul Tarvydas
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <flecsc$dqf$1@aioe.org>
I forgot to add:

a0) The first time - and only the first - that the machine function is
called, it should execute the entry code of the first (default) state plus
the body of that state.  Alternatively, the machine macro needs to emit an
initialization which forces the machine to enter the default state - and is
executed only once.  I want the macro / function to be embeddable within
the body of other code - i.e. it is not only used at the top level.

pt
From: Pascal Bourguignon
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <87odc54379.fsf@thalassa.informatimago.com>
Paul Tarvydas <········@visualframeworksinc.com> writes:

> Exec summary - I need the equivalent of a goto based on a variable.  From
> CL2e, it seems that I should use a case statement consisting of
> non-computed go's.
>
> I also need to figure out how to "capture" a state name and have it be
> emitted by another macro deep in the bowels of user-supplied code.  (Is
> this, then, a place where CL's non-hygenic macros are necessary?  Is there
> some trick with nested / sibling macrolets that I can use?).

You can use flet/labels or macrolet.

For example, you could generate something like:

(defun machine (...)
  (case state
    ((0)  (flet ((go-state (new-state)
                     (exit-from-state 0)
                     (enter-into-state new-state)
                     (return 'machine)))
              #|state 0 body |#
            ))
    ((1)  (flet ((go-state (new-state)
                     (exit-from-state 1)
                     (enter-into-state new-state)
                     (return 'machine)))
              #|state 1 body |#
            ))
    ...))


-- 
__Pascal_Bourguignon__               _  Software patents are endangering
()  ASCII ribbon against html email (o_ the computer industry all around
/\  1962:DO20I=1.100                //\ the world http://lpf.ai.mit.edu/
    2001:my($f)=`fortune`;          V_/   http://petition.eurolinux.org/
From: Mitch
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <9t8mn3h1f9mpumsc2e9t2pjef7ijh0b26r@4ax.com>
I don't understand it enough to conclude whether this might help you,
but Ragel (a state machine compiler (though targeting C, C++,
Objective-C, D, Java and Ruby)) looks interesting:
http://www.cs.queensu.ca/~thurston/ragel/

Mitch
From: Paul Tarvydas
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <flgd6c$m31$1@aioe.org>
Mitch wrote:

> I don't understand it enough to conclude whether this might help you,
> but Ragel (a state machine compiler (though targeting C, C++,
> Objective-C, D, Java and Ruby)) looks interesting:
> http://www.cs.queensu.ca/~thurston/ragel/
> 
> Mitch

Thanks for the pointer!

After a quick scan, it seems to me that Ragel has the same drawback as all
other FSM implementations - lack of entry/exit code formalism.

The formula I gave is for industrial-strength FSMs, proven to be practical
(shipping in commercial products since 1995).  (I did omit the bit about
hierarchical machines, which are also necessary).

I'm not sure why, but entry/exit state machines appear to be uncommon.  I
suspect that very few people use them for "real" programming...

pt
From: ddd
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <slrnfof1p2.3ao.ddd@localhost.localdomain>
On Wed, 02 Jan 2008 11:14:35 -0500, Paul Tarvydas
<········@visualframeworksinc.com> wrote:
> The formula I gave is for industrial-strength FSMs, proven to be practical
> (shipping in commercial products since 1995).  (I did omit the bit about
> hierarchical machines, which are also necessary).
>
> I'm not sure why, but entry/exit state machines appear to be uncommon.  I
> suspect that very few people use them for "real" programming...
>
> pt
>

Related, but in scheme is an article by Shiram Krishnamurthi "Automata
via Macros", was submitted to J. Functional Programming.  
From: Rainer Joswig
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <joswig-5144C1.00512502012008@news-europe.giganews.com>
In article <············@aioe.org>,
 Paul Tarvydas <········@visualframeworksinc.com> wrote:

> Exec summary - I need the equivalent of a goto based on a variable.  From
> CL2e, it seems that I should use a case statement consisting of
> non-computed go's.
> 
> I also need to figure out how to "capture" a state name and have it be
> emitted by another macro deep in the bowels of user-supplied code.  (Is
> this, then, a place where CL's non-hygenic macros are necessary?  Is there
> some trick with nested / sibling macrolets that I can use?).
> 
> 
> Long version - please make suggestions regarding alternatives that I may
> have missed...
> 
> Over a few decades of embedded work, I have come to the realization that
> state machines are the best way to handle "reactive" events.  I have
> developed and become accustomed to a certain semantics for state machines. 
> I now need a state machine in my CL gui.  Gui events - e.g. mouse move,
> button clicks, character input - are "reactive" events.  The (large) set of
> possible gestures is becoming hairy and would certainly be solved better
> using a state machine.
> 
> I want to write a macro(s) that will allow me to work with state machines.

The usual question: why do you want a MACRO? There is something
you want implement, a state machine - why are you sure that
you need one macro or more?

You could equally say (following is only a sketch, google will
find already written code, for sure).

You can represent the fsm, transitions and events as CLOS classes.
A generic function will, given an event and the fsm, find
the transition object, invoke the functions, change the fsm state
and call the next transition if necessary.

Advantage: you get first class representations of all
parts of the FSM.

 
> The state machine semantics I want are:
> 
> 0) state machines contain multiple "states"
> 
> 00) the state machine function is called exactly once for every "event" -
> the machine function performs some computation based on the event
> (including changing its own state), stores some state information
> ("history") and returns.  The next time the machine function is called, it
> resumes execution in the body of the state where it had left off.
> 
> a) every state has "entry" code, "body" code and "exit" code (** note that
> most simplistic state machine implementations leave out the concepts
> of "entry" and "exit" code - the control flow of the machine is affected by
> entry and exit code)
> 
> b) every time an event arrives (e.g. the machine is called), the current
> state's body code is evaluated
> 
> c) if the evaluation does not result in a state change, then the machine
> returns, without changing the state
> 
> d) if the state is changed, then (**** and this is important and different
> from most other state machine models ****) 
> 
> (d1) the current state's "exit" code is immediately executed
> 
> (d2) the next state's "entry" code is immediately executed
> 
> (d3) the machine returns.
> 
> Here is sample macro syntax that would fit the above:
> 
> (machine (state-var)
>   (state-name-1
>         (entry-form-1)
>         (body-form-1 ... (go-state state-name-2))
>         (exit-form-1))
>   (state-name-2)
>         (entry-form-2)
>         (body-form-2 ... (go-state state-name-3))
>         (exit-form-2))
> ...
> )
> 
> Where "state-var" is some variable (outside of the scope of the machine
> macro).
> 
> Any state body can contain any number of "go-state" macro calls.
> 
> I can almost see how to build a macro to express these semantics.  Expanding
> the above would result in the sample code below (ignoring issues of making
> generated variables unique).  Note that "go-state" needs to expand into a
> go to the state exit for the current state, which then results in a go to
> the entry of the next state - every go-state becomes two go's in effect.
> 
> (block nil
>   (let ((next-state nil))
>     (tagbody
> 
>      (case state  ;; execution begins here by jumping to appropriate body
>         (state-name-1 (go state-name-1-body))
>         (state-name-2 (go state-name-2-body))
>         (state-name-3 (go state-name-3-body))
>         ...
>         (otherwise (return state)))
> 
>   state-name-1-entry  ;; entry code sets state var, does entry work, returns
>         (setq state 'state-name-1)
>         (entry-form-1)
>         (return state-var)
> 
>   state-name-1-body
>         (body-form-1 ...
>             (progn ()
>               (setq next-state 'state-name-2)
>               (go state-name-1-exit)))
>         (return state-var) ;; default = no change in state
> 
>   state-name-1-exit  ;; exit code does some work, then jumps to next state
> entry
>         (exit-form-1)
>         (go state-change)
> 
> ... similarly for other states ...
> 
>      state-change   ;; state change = go to entry code of next state
>        (case next-state
>         (state-name-1 (go state-name-1-entry))
>         (state-name-2 (go state-name-2-entry))
>         (state-name-3 (go state-name-3-entry))
>         ...
>         (otherwise (return state)))))
> 
> 
> Does this seem to be the most reasonable code to emit?  
> 
> I haven't yet sussed out "how" to emit the go-state macro.  Note that
> go-state is supplied one label - the next state - but that it must, also,
> implicitly memorize what state it is in (so that it may go to the
> appropriate state exit).  In the above proposed expansion, go-state becomes
> a setq and a go, next-state the label for the go is magically
> inferred/memo'ized by the macro.
> 
> My comments: I could have used continuation functions, instead of the case
> statements.  The "state" and "next-state" variables would then contain
> functions like:
> 
> #'(lambda () (go state-2-body))
> 
> thanks for any comments
> 
> pt

-- 
http://lispm.dyndns.org/
From: Paul Tarvydas
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <flgdqd$nrm$1@aioe.org>
Rainer Joswig wrote:

> The usual question: why do you want a MACRO? There is something
> you want implement, a state machine - why are you sure that
> you need one macro or more?
> 

Well, because I want a sub-language that expresses state machines in a
natural way.  All parts (entry/body/exit) of a state machine should be
lexically grouped together and within the same scope.

> You could equally say (following is only a sketch, google will
> find already written code, for sure).

I did that and didn't find any that implement entry/body/exit.  If you see
one, please point me at it.

> You can represent the fsm, transitions and events as CLOS classes.

Yes, you can.  

but,

After lots of experience in OOP (see acknowledgements in "Eiffel: The
Language"), I have arrived at the conclusion that OOP is an epicycle
(i.e. "bad", i.e. exactly the wrong way to look at software architectures).

> Advantage: you get first class representations of all
> parts of the FSM.

In my book, that is a disadvantage :-).  

FSM's express control-flow.  Instances of objects obfuscate control-flow.

"The Root of All Evil = Call/Return"(tm).  

(Including method "sends", which are simply obfuscated call/returns).  

FSMs = goto-full programming.  (Yes, Dijkstra was dead wrong :-).

pt
From: Rainer Joswig
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <joswig-6BC3A3.01082503012008@news-europe.giganews.com>
In article <············@aioe.org>,
 Paul Tarvydas <········@visualframeworksinc.com> wrote:

> Rainer Joswig wrote:
> 
> > The usual question: why do you want a MACRO? There is something
> > you want implement, a state machine - why are you sure that
> > you need one macro or more?
> > 
> 
> Well, because I want a sub-language that expresses state machines in a
> natural way.  All parts (entry/body/exit) of a state machine should be
> lexically grouped together and within the same scope.
> 
> > You could equally say (following is only a sketch, google will
> > find already written code, for sure).
> 
> I did that and didn't find any that implement entry/body/exit.  If you see
> one, please point me at it.

Not what you want:
http://asmith.id.au/source/state-machine.lisp

Some inspiration:
http://groups.google.co.kr/group/comp.lang.lisp/browse_thread/thread/6852fbfca352d4cb/83a426727ef8e303?#83a426727ef8e303


> 
> > You can represent the fsm, transitions and events as CLOS classes.
> 
> Yes, you can.  
> 
> but,
> 
> After lots of experience in OOP (see acknowledgements in "Eiffel: The
> Language"), I have arrived at the conclusion that OOP is an epicycle
> (i.e. "bad", i.e. exactly the wrong way to look at software architectures).
> 
> > Advantage: you get first class representations of all
> > parts of the FSM.
> 
> In my book, that is a disadvantage :-).  
> 
> FSM's express control-flow.  Instances of objects obfuscate control-flow.
> 
> "The Root of All Evil = Call/Return"(tm).  
> 
> (Including method "sends", which are simply obfuscated call/returns).  
> 
> FSMs = goto-full programming.  (Yes, Dijkstra was dead wrong :-).
> 
> pt

-- 
http://lispm.dyndns.org/
From: John Thingstad
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <op.t39y9ts5ut4oq5@pandora.alfanett.no>
P� Tue, 01 Jan 2008 22:40:40 +0100, skrev Paul Tarvydas  
<········@visualframeworksinc.com>:

>
> (block nil
>   (let ((next-state nil))
>     (tagbody
>
>      (case state  ;; execution begins here by jumping to appropriate body
>         (state-name-1 (go state-name-1-body))
>         (state-name-2 (go state-name-2-body))
>         (state-name-3 (go state-name-3-body))
>         ...
>         (otherwise (return state)))
>
>   state-name-1-entry  ;; entry code sets state var, does entry work,  
> returns
>         (setq state 'state-name-1)
>         (entry-form-1)
>         (return state-var)
>
>   state-name-1-body
>         (body-form-1 ...
>             (progn ()
>               (setq next-state 'state-name-2)
>               (go state-name-1-exit)))
>         (return state-var) ;; default = no change in state
>
>   state-name-1-exit  ;; exit code does some work, then jumps to next  
> state
> entry
>         (exit-form-1)
>         (go state-change)
>
> ... similarly for other states ...
>
>      state-change   ;; state change = go to entry code of next state
>        (case next-state
>         (state-name-1 (go state-name-1-entry))
>         (state-name-2 (go state-name-2-entry))
>         (state-name-3 (go state-name-3-entry))
>         ...
>         (otherwise (return state)))))
>
>
> Does this seem to be the most reasonable code to emit?

tagbody and go seems the most naural to me too.
As a curiosity this is a hack I wrote to allow me to view plist's as enums  
in case

(defpackage :my-enum (:use :cl :iterate))

(in-package :my-enum)

(defun get-key (plist value)
   (iter (generating element in plist)
     (let ((current-key (next element))
           (current-value (next element)))
       (when (= current-value value)
         (return current-key)))))

(defun duplicate-value-check (enum)
   (let* ((values
           (iter
             (for element in enum)
             (when (numberp element)
               (collect element))))
          (sorted-values (sort values #'<))
          (position (mismatch sorted-values
                              (remove-duplicates sorted-values))))
     (when position
       (let ((value (nth position sorted-values)))
         (error "key ~A has a value ~D duplicated"
                (get-key enum value) value)))))

(defun enumerate (symbol-list)
   (iter (for symbol in symbol-list)
         (for value from 0)
         (nconcing (list symbol value))))

;; could type #.(getf *enum* key) each time, but it's a bit tedious
;; lets write $symbol instead
(let (old-readtable -enum-)

   (defun enable-shorthand (enum)
     (setf -enum- enum)
     (duplicate-value-check -enum-)
     (setf old-readtable (copy-readtable))
     (set-macro-character #\$ #'(lambda (stream char)
                                    (declare (ignore char))
                                    (getf -enum- (read stream)))))

   (defun disable-shorthand ()
     (setf *readtable* old-readtable)))

#--------------------------------------------------------------

With this you could write

(eval-when (:compile-toplevel :load-toplevel :execute)
   (defparameter *state* (enumerate '(:first :second :third))))

(enable-shorthand *state*)

(defun machine (...)
   (tagbody
     (case state
       ($:first  (go :first))
       ($:second (go :second))
       ...)
    :first
     ...))

(disable-shorhand)

and thus use names for states without needing many lines of ugly  
defconstant's and #.

--------------
John Thingstad
From: Paul Tarvydas
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <fm8lh4$gjs$1@aioe.org>
FYI, here is the macro I ended up with (should it go into a repository?
suggestions on which one?).

usage: 
(machine (state-var)
  (state-name (entry-code) (action-code) (exit-code))
  ...)

and (go-state state-name)

The macro is meant to be used inside the body of some form.  The named state
variable must already exist (e.g. declared in a persistent place - the
variable has to survive between invocations of the machine, e.g. an
instance variable of a clos object).

The first state in the machine is the "default" state.  On first visit, the
default state executes its entry code and its action code.  On subsequent
visits, the action code of the current state is visited.  If a go-state is
executed, the current state's exit code is executed immediately and then
the next state's entry code is executed, then the machine is executed
(return from the tagbody - execution falls through to any code following
the macro).

Example (silly) use:

(defun test ()
  (let (state)
    (dotimes (i 6)
      (format t "state=~A~%" state)
      (machine (state)
         (idle
          (format t "idle entry ~A~%" i)
          (progn
            (format t "idle body ~A~%" i)
            (when (= i 2) (go-state two)))
          (format t "idle exit ~A~%" i))

         (two
          (format t "two entry ~A~%" i)
          (progn
            (format t "two body ~A~%" i)
            (go-state three))
          (format t "two exit ~A~%" i))

         (three
          (format t "three entry ~A~%" i)
          (progn
            (format t "three body ~A~%" i)
            (go-state idle))
          (format t "thre exit ~A~%" i))))))



The macro (comments on style, etc. welcome):


(defmacro machine (state-var-list default-state &rest state-list)
  (unless (and (listp state-var-list)
               (listp default-state)
               (symbolp (car state-var-list))
               (= 4 (length default-state))
               (symbolp (car default-state))
               (every #'(lambda (x) (listp x)) (cdr default-state))
               (every #'(lambda (x) (and (= 4 (length x))
                                         (symbolp (car x))
                                         (every #'(lambda (y) (listp y))
(cdr x))))
                      state-list))
    (error "badly formed machine"))
  (let ((first-time (gensym "first-time-"))
        (next (gensym "next-"))
        (state-var (car state-var-list))
        (default-state-id (first default-state))
        (state-ids (mapcar #'car state-list)))
    (flet ((gen-name (sym str)
             (intern (concatenate 'string (symbol-name sym) (string-upcase
str)))))
      `(macrolet ((go-state (where)
                    `(progn
                       (setq ,',next ',,'where)
                       (go exits))))
         (prog ((,first-time (null ,state-var))
                ,next)
           (when ,first-time
             (go ,(gen-name default-state-id "-entry")))
           actions
           (case ,state-var
             (,default-state-id (go ,(gen-name default-state-id "-action")))
             ,@(mapcar
                #'(lambda (s)
                    `(,s (go ,(gen-name s "-action"))))
                state-ids)
             (otherwise (return ,state-var)))
           entries
           (case ,state-var
             (,default-state-id (go ,(gen-name default-state-id "-entry")))
             ,@(mapcar
                #'(lambda (s)
                    `(,s (go ,(gen-name s "-entry"))))
                state-ids)
             (otherwise (return ,state-var)))
           exits
           (case ,state-var
             (,default-state-id (go ,(gen-name default-state-id "-exit")))
             ,@(mapcar
                #'(lambda (s)
                    `(,s (go ,(gen-name s "-exit"))))
                state-ids)
             (otherwise (return ,state-var)))
           ,(gen-name default-state-id "-entry")
           (setq ,state-var ',default-state-id)
           ,(second default-state)
           (unless ,first-time
             (return ',state-var))
           ,(gen-name default-state-id "-action")
           ,(third default-state)
           (return ',state-var)
           ,(gen-name default-state-id "-exit")
           ,(fourth default-state)
           (setq ,state-var ,next)
           (go entries)
           ,@(apply 'append
                    (mapcar
                     #'(lambda (s)
                         (let ((name (first s))
                               (entry (second s))
                               (action (third s))
                               (exit (fourth s)))
                           `(,(gen-name name "-entry")
                             (setq ,state-var ',name)
                             ,entry
                             (return ',name)
                             ,(gen-name name "-action")
                             ,action
                             (return ',name)
                             ,(gen-name name "-exit")
                             ,exit
                             (setq ,state-var ,next)
                             (go entries))))
                     state-list)))))))
  
From: Rainer Joswig
Subject: Re: Brainstorming - CL state machine macro
Date: 
Message-ID: <joswig-87E088.23134411012008@news-europe.giganews.com>
In article <············@aioe.org>,
 Paul Tarvydas <········@visualframeworksinc.com> wrote:

> FYI, here is the macro I ended up with (should it go into a repository?
> suggestions on which one?).
> 
> usage: 
> (machine (state-var)
>   (state-name (entry-code) (action-code) (exit-code))
>   ...)
> 
> and (go-state state-name)
> 
> The macro is meant to be used inside the body of some form.  The named state
> variable must already exist (e.g. declared in a persistent place - the
> variable has to survive between invocations of the machine, e.g. an
> instance variable of a clos object).
> 
> The first state in the machine is the "default" state.  On first visit, the
> default state executes its entry code and its action code.  On subsequent
> visits, the action code of the current state is visited.  If a go-state is
> executed, the current state's exit code is executed immediately and then
> the next state's entry code is executed, then the machine is executed
> (return from the tagbody - execution falls through to any code following
> the macro).
> 
> Example (silly) use:
> 
> (defun test ()
>   (let (state)
>     (dotimes (i 6)
>       (format t "state=~A~%" state)
>       (machine (state)
>          (idle
>           (format t "idle entry ~A~%" i)
>           (progn
>             (format t "idle body ~A~%" i)
>             (when (= i 2) (go-state two)))
>           (format t "idle exit ~A~%" i))
> 
>          (two
>           (format t "two entry ~A~%" i)
>           (progn
>             (format t "two body ~A~%" i)
>             (go-state three))
>           (format t "two exit ~A~%" i))
> 
>          (three
>           (format t "three entry ~A~%" i)
>           (progn
>             (format t "three body ~A~%" i)
>             (go-state idle))
>           (format t "thre exit ~A~%" i))))))
> 
> 
> 
> The macro (comments on style, etc. welcome):

I would apply a healthy dose of functional abstraction.

Make the code generators functions you can test.
Otherwise this will end as one big mess of code that
is hard to understand and hard to debug.
External functions are most easy to debug.
If that works you may (or may not) convert them in FLET clauses.
But the name, the parameters and a documentation
string makes clear what code comes in and what code
gets generated. Stuff like FIRST, CAR and so on
are completely meaningless. It carries no clue
what is going on. Introduce speaking names.

> 
> 
> (defmacro machine (state-var-list default-state &rest state-list)
>   (unless (and (listp state-var-list)
>                (listp default-state)
>                (symbolp (car state-var-list))
>                (= 4 (length default-state))
>                (symbolp (car default-state))
>                (every #'(lambda (x) (listp x)) (cdr default-state))

(every #'lisp ...)

>                (every #'(lambda (x) (and (= 4 (length x))
>                                          (symbolp (car x))
>                                          (every #'(lambda (y) (listp y))
> (cdr x))))
>                       state-list))
>     (error "badly formed machine"))
>   (let ((first-time (gensym "first-time-"))
>         (next (gensym "next-"))
>         (state-var (car state-var-list))
>         (default-state-id (first default-state))
>         (state-ids (mapcar #'car state-list)))
>     (flet ((gen-name (sym str)
>              (intern (concatenate 'string (symbol-name sym) (string-upcase
> str)))))
>       `(macrolet ((go-state (where)
>                     `(progn
>                        (setq ,',next ',,'where)
>                        (go exits))))
>          (prog ((,first-time (null ,state-var))
>                 ,next)
>            (when ,first-time
>              (go ,(gen-name default-state-id "-entry")))
>            actions
>            (case ,state-var
>              (,default-state-id (go ,(gen-name default-state-id "-action")))
>              ,@(mapcar
>                 #'(lambda (s)
>                     `(,s (go ,(gen-name s "-action"))))
>                 state-ids)
>              (otherwise (return ,state-var)))
>            entries
>            (case ,state-var
>              (,default-state-id (go ,(gen-name default-state-id "-entry")))
>              ,@(mapcar
>                 #'(lambda (s)
>                     `(,s (go ,(gen-name s "-entry"))))
>                 state-ids)
>              (otherwise (return ,state-var)))
>            exits
>            (case ,state-var
>              (,default-state-id (go ,(gen-name default-state-id "-exit")))
>              ,@(mapcar
>                 #'(lambda (s)
>                     `(,s (go ,(gen-name s "-exit"))))
>                 state-ids)
>              (otherwise (return ,state-var)))
>            ,(gen-name default-state-id "-entry")
>            (setq ,state-var ',default-state-id)
>            ,(second default-state)
>            (unless ,first-time
>              (return ',state-var))
>            ,(gen-name default-state-id "-action")
>            ,(third default-state)
>            (return ',state-var)
>            ,(gen-name default-state-id "-exit")
>            ,(fourth default-state)
>            (setq ,state-var ,next)
>            (go entries)
>            ,@(apply 'append
>                     (mapcar
>                      #'(lambda (s)
>                          (let ((name (first s))
>                                (entry (second s))
>                                (action (third s))
>                                (exit (fourth s)))

(destructuring-bind (name entry action exit) s

>                            `(,(gen-name name "-entry")
>                              (setq ,state-var ',name)
>                              ,entry
>                              (return ',name)
>                              ,(gen-name name "-action")
>                              ,action
>                              (return ',name)
>                              ,(gen-name name "-exit")
>                              ,exit
>                              (setq ,state-var ,next)
>                              (go entries))))
>                      state-list)))))))
>