1. Introduction

This script implements an interpreter for stack-based finite state machines. A FSM is defined by a simple dialect where each state is a REBOL block. The interpreter is defined as an object.

2. The fsm! object

The fsm! object

fsm!: context [
 fsm!'s locals
 Helper functions
 The event function
 The init function
 The end function

3. The event function

Processes one event with the current state. The state machine must be initialized before starting to process events. The return value for this function is undefined (as you see, the current implementation will return true due to the until loop).

An event can be a value of types any-string! or set-word!, although in theory we can handle anything but parens and words. It's easy to extend the code so that it works with other types, if you need it.

The until loop is needed for the continue and override directives. See The interpreter's parse rules.

The event function

event: func [
 "Process one event"
 evt [any-string! set-word!]
 /local val ovr retact done?
] [
 ; we haven't been initialized? just exit
 if not block? state [exit]
 until [
  if tracing [print ["*** event" mold evt]]
  done?: yes
  Process the evt event
  if tracing [ask ""]

3.1 fsm!'s locals

We need to store the current state. The state word is used to refer to the current state block. It is initialized to the initial state by the init function.

For debugging, it is possible to set tracing to true; you'll get a step-by-step trace of the state machine.

fsm!'s locals

state: none

; debug mode, trace events and state changes
tracing: no

3.2 Process the evt event

Processing one event works this way: we use find to search for evt in the state block. (This is ok because we assume that events cannot be of type word! or paren!, and the rest of the dialect only uses words and parens.) If the current state does not handle this event (|evt| is not found), we search for default: which is the default handling for events for this state. If none of them is found, the event is just ignored; otherwise, the directives for the event are processed by the interpreter, using parse.

Process the evt event

local: any [find state evt find state [default:]]
if local [
 parse local [
  The interpreter's parse rules

3.3 Example of state blocks

Let's first make an example, so that it will be easier to understand The interpreter's parse rules. Each state is represented by a state block. This block defines how events are handled in that state. Event values are listed in the block, and each event (or group of events) is followed by directives. The list of directives for an event can be broken into two parts, both optional (but at least one of them must be specified - otherwise you shouldn't list the event in the block at all): an action (expressed as a paren, containing arbitrary REBOL code) and some state change directives.

In this example, state-one defines only an action for event1:. For event2: we only define a state change (going to state-two). For event6: we define both an action and a state change.

State change directives can be broken into two parts too: an optional continue or override directive, followed by a state change. A state change can be: the return directive, which goes back to the previous state (in the initial state, nothing happens); the rewind? directive, which we'll discuss later; or a word referring to a state block, which means switching to that state. In this last case, the word can be followed by a paren!, that is similar to the action paren for the event, but is executed after the new state uses return to return to this state.

In this example, for event3: or event4:, we define an action, and a state change with a return action. This means that if we receive event3: or event4: while in state-one, the action (print "Got event3 or event4") is executed, then the current state in changed to state-two. When state-two uses a return directive (for example it does so when receiving the event6: event), the current state is changed back to state-one and the action (print "Returned from state-two") is executed.

The continue and override directives are used to change what happens when switching to a new state. (They can be used with return and rewind? too.) Normally, a state change means that the next event will be processed by the new state; but if you use continue, then the current event is processed again by the new state (this is like "delegating" the processing of the event to another state). In this example, when event5: is encountered in state-one, the state is changed to state-two end event5: is processed again, which causes to print "Got event5 in state-two".

override is very similar, except that a new event is generated and then processed by the new state. override strange-event generates the event strange-event:, so in the default case for state-one a strange-event: is generated, the state is changed to state-two, and strange-event: is processed (which causes to print "Unhandled event in state-one, now in state-two").

Please see The interpreter's parse rules for more details.

Example of state blocks

state-one: [
 event1: (print "Got event1")
 event2: state-two
 event3: event4: (print "Got event3 or event4") state-two (print "Returned from state-two")
 event5: continue state-two
 event6: (print "Got event6") state-two
 default: override strange-event state-two
state-two: [
 event5: (print "Got event5 in state-two")
 strange-event: (print "Unhandled event in state-one, now in state-two")
 event6: return
 default: continue return

3.4 The interpreter's parse rules

These rules are parsing the state block already positioned at the event to be processed (result of the find function). Since multiple events can share the same directives, we have one or more event specfications followed by an optional action paren, followed by optional state change directives.

(As already noted, we only allow any-string! or set-word! for events, although only paren! and word! really need to be excluded. You can extend this rule if you need other types of events.)

Note that the return-state helper function is used to return to the previous state, and goto-state is used to go to a new state. Also note that you can specify an integer for return to return to the n-th previous state, i.e. 2 return calls the return-state function twice.

The interpreter's parse rules

some [any-string! | set-word!]
; do the event action if present
set val opt paren! (if all [:val tracing] [prin [mold :val ""]] do val) [
 ; make another state handle this event (must be followed by a state change directive)
 'continue (if tracing [prin "continue "] done?: no)
 ; override event and make a new state handle it (must be followed by a state change directive)
 'override set ovr word! (evt: to set-word! ovr if tracing [prin ["override" mold ovr ""]] done?: no)
] [
 ; return to previous state
 ; optional integer allows returning to n-th previous state
 set val opt integer! 'return (loop any [val 1] [return-state])
 Rule for the rewind? directive
 ; go to a new state. a return action can be defined too
 set val word! set retact opt paren! (
  if block? get/any val [
   if tracing [prin ["go to" val "then" mold :retact ""]]
   goto-state get val :retact
 ; continue or override not followed by a state change is ignored
 none (done?: yes)

3.4.1 Rule for the rewind? directive

We're going to discuss the rewind? directive separately, because it's a little more complicated.

The rewind? directive attempts to rewind the state stack up to one of the specified states (it must be followed by one or more words referring to state blocks); each state is attempted in the given order; the directive is ignored (i.e. no state change happens) if none of the given states is on the stack (this is the reason for the question mark in the name).

So, this is a conditional state change directive, because the state is only changed if one of the listed states are found in the stack. The rewind-state helper function is called with the listed target states in order; it will return true if the state was found and the stack was successfully rewound back to it (i.e. the required number of returns were performed - return actions are evaluated normally too). In this case, we don't need to attempt with other states. You can think of rewind? as of a sort of conditional throw.

Rule for the rewind? directive

'rewind? copy val some word! (
 if tracing [prin ["rewind?" mold/only val]]
 if not foreach word val [
  if block? get/any word [
   if rewind-state get word [break/return true]
 ] [
  ; if none of the states was found, ignore any continue or
  ; override directive too
  done?: yes

3.5 Helper functions

In the above code we used three helper functions (that are not meant to be called by users - they should only call init, event and end): goto-state, return-state and rewind-state.

goto-state changes the current state, pushing the old state and (if given) a return action into the stack.

return-state returns the state machine to the previous state; it gets the previous state and the return action from the stack, changes state to the previous state and does the return action. If the state stack is empty, it goes to the initial state.

rewind-state rewinds the stack up to a specified state, if it is on the stack; if the state is not on the stack, nothing is changed and the function returns false. Otherwise true is returned.

Helper functions

goto-state: func [new-state [block!] retact [paren! none!]] [
 insert/only insert/only state-stack: tail state-stack :state :retact
 state: new-state

return-state: has [retact [paren! none!]] [
 set [state retact] state-stack
 state: any [state initial]
 if tracing [prin ["return, retact:" mold :retact ""]]
 do retact
 state-stack: skip clear state-stack -2

rewind-state: func [up-to [block!] /local retact stack] [
 ; nothing in the stack (initial state), so nothing to rewind to
 if empty? state-stack [return false]
 ; start from the tail (because of the skip -2 at the start of the loop)
 stack: tail state-stack
 ; we will accumulate all the return code here and do it
 ; if we find the state on the stack
 retact: make block! 128
 until [
  stack: skip stack -2
  append retact stack/2
  ; did we find the state? (note: a copy won't be accepted)
  if same? up-to stack/1 [
   ; switch to this state
   state: up-to
   ; do all the return actions (they are all in the retact block)
   do retact
   ; reset state stack
   state-stack: skip clear stack -2
   return true
  head? stack
 ; return false if the state was not found

3.5.1 Additional fsm!'s locals

fsm!'s locals +≡

initial: none
state-stack: [ ]

4. The init function

Initializes the state machine. You need to call this function first.

The state stack is cleared and the current state is set to the given initial state. We also need to remember the initial state, so we set the word initial to it.

The init function

init: func [
 "Initialize the state machine"
 initial-state [block!]
] [
 clear state-stack: head state-stack
 initial: state: initial-state

5. The end function

Terminates processing. Gets the state machine back to the initial state and stops it. Note that you must call init again if you intend to reuse the state machine.

The end function

end: does [
 ; rewind the stack (does all pending return actions)
 foreach [retact state] head reverse head state-stack [do retact]

6. Example usage

To use the interpreter you just clone the fsm! object, call init to initialize the state machine, then call event for all your events, and when finished call end.

In this example we could set my-fsm/tracing: yes to trace the state machine step-by-step for debugging.

Example usage

my-fsm: make fsm! [ ]
; ...
my-fsm/init initial-state
; ...
my-fsm/event some-event
; ...
my-fsm/event some-other-event
; ...