Arjen Markus They are very powerful programming devices, but most languages are unsuitable to actually define them: (finite) state machines. Everyday examples: parsers in Yacc/Lex, regular expressions, protocol handlers and so on.
Below is a small script, inspired by a paper on Forth, that shows that Tcl can retain the table-like appearance that one so dearly loves, when specifying a state machine. (Okay, it does little or no error checking, it defines only deterministic finite state machines, and the example is overly simple, but still, have a look).
# statemachine.tcl --
#
# Script to implement a finite state machine
#
# Version information:
# version 0.1: initial implementation, april 2002
namespace eval ::FiniteState {
variable statemachine
namespace export defineMachine evalMachine resetMachine
}
# defineMachine --
# Define a finite state machine and its transitions
#
# Arguments:
# machine Name of the machine (a variable)
# states List of states
#
# Result:
# None
#
# Side effects:
# The variable "machine" is filled with the definition
#
# Notes:
# The list of states can only contain the commands initialState
# and state. No others are allowed (no check though)
#
# For instance:
# defineMachine aMachine {
# initialState 1
# state 1 {
# "A" 2 {puts "To state 2"}
# "B" 3 {puts "To state 3"}
# }
# state 2 {
# "C" 1 {puts "To state 1"}
# "D" 3 {puts "To state 3"}
# }
# state 3 {
# "E" 3 {exit}
# }
# }
#
#
proc ::FiniteState::defineMachine { machine states } {
upvar $machine machinedef
set machinedef {}
set first_name {}
set maxarg [llength $states]
for { set idx 0 } { $idx < $maxarg } { incr idx } {
set arg [lindex $states $idx]
switch -- $arg {
"state" {
set statename [lindex $states [incr idx]]
set transitions [lindex $states [incr idx]]
lappend machinedef $statename $transitions
}
"initialState" {
set first_state [lindex $states [incr idx]]
}
default {
}
}
}
#
# First three items are reserved: the initial state and the current
# state. By storing them in the same list we can pass the
# information around in any way needed.
#
set machinedef [concat $first_state $first_state $machinedef]
}
# evalMachine --
# Evaluate the input and go to the next state
#
# Arguments:
# machine Name of the machine (a variable)
# input The input to which to react
#
# Result:
# None
#
# Side effects:
# The machine's state is changed and the action belonging to the
# transition is executed.
#
proc ::FiniteState::evalMachine { machine input } {
upvar $machine machinedef
set current_state [lindex $machinedef 1]
#
# Look up the state's transitions
#
set states [lrange $machinedef 2 end]
set idx [lsearch $states $current_state]
set transitions [lindex $states [incr idx]]
set found 0
foreach {pattern newstate action} $transitions {
if { $pattern == $input } {
uplevel $action
set found 1
break
}
}
if { $found } {
set machinedef [lreplace $machinedef 1 1 $newstate]
} else {
#error "Input ($input) not found for state $current_state"
# Or rather: ignore
}
}
# resetMachine --
# Reset the machine's state
#
# Arguments:
# machine Name of the machine (a variable)
#
# Result:
# None
#
# Side effects:
# The machine's state is changed to the initial state.
#
proc ::FiniteState::resetMachine { machine } {
upvar $machine machinedef
set initial_state [lindex $machinedef 0]
set machinedef [lreplace $machinedef 1 1 $current_state]
}
#
# Define a simple machine to test the code:
# A furnace that needs to keep the same temperature, so the heating
# may be on or off
#
namespace import ::FiniteState::*
defineMachine heater {
initialState off
state off {
"too_cold" on { set heating $heat_capacity}
}
state on {
"too_hot" off { set heating 0 }
}
}
set time 0.0
set dt 0.1
set temp_amb 20.0
set temp $temp_amb
set temp_ideal 200.0
set exch 0.3
set heating 0.0
set heat_capacity 500.0
while { $time < 10.0 } {
evalMachine heater \
[expr {$temp<=$temp_ideal? "too_cold" : "too_hot" }]
set time [expr {$time+$dt}]
set temp [expr {$temp+$dt*($exch*($temp_amb-$temp)+$heating)}]
puts "$time $temp $heating [lindex $heater 1]"
}