### CODE TO MAKE (INDEPENDENT) AUTOMATA DEFINITION EASY ###
proc automaton {name definition} {
global definingAutomaton
set definingAutomaton $name
upvar #0 automaton_$name a state($name) s
array set a {}
set s {}
uplevel #0 $definition
}
proc node {key definition} {
global definingAutomaton
upvar #0 automaton_$definingAutomaton a
set a($key) $definition
}
proc start {key} {
global definingAutomaton
upvar #0 state($definingAutomaton) s
set s $key
}
proc transition {key} {
global currentAutomaton
upvar #0 state($currentAutomaton) s
set s $key
}
proc step {automaton} {
global currentAutomaton errorInfo errorCode
set currentAutomaton $automaton
upvar #0 state($automaton) s automaton_$automaton a
if {![info exist s]} {return}
set code [catch [list uplevel 1 $a($s)] msg]
unset currentAutomaton
return -code $code -errorcode $errorCode -errorinfo $errorInfo $msg
}
proc halt {} {
global currentAutomaton
upvar #0 state($currentAutomaton) s
unset s
}
### DEMO CODE ###
automaton foo {
start 4
node 2 {
puts "foo is 2"
halt
}
node 7 {
puts "foo is 7"
transition 2
}
node 4 {
puts "foo is 4"
transition 7
}
}
automaton bar {
node 42 {
puts "bar is 42"
# Random transition!
transition [lindex {7 twentyone 42} [expr {int(rand()*3)}]]
}
start 42
node 7 {
puts "bar is 7"
halt
}
node twentyone {
puts "bar is twentyone"
transition 7
}
}
while {[array size state]} {
step foo
step bar
}There's only one restriction with this code: do not step an automaton as part of the definition of any of the steps of an automaton. Bad things will happen!Donal Fellows further answered the follow-up question: What kind of "bad things"?Well, the problem stems from the fact that a global variable is used to communicate what is the current automaton, so that inherently makes the automata created through that process non-nestable. Making the system reentrant is more interesting and can be done in several ways.
- Method 1: Use a stack of "current" automata
- Method 2: Examine the call stack using info level
- Method 3: Rewrite the node definitions to refer to the right automaton
- Method 4: Rewrite the procs called to refer to the right automaton
# The rest of the code is the same as my previous message, so I won't
# repeat it. :^)
proc transition {key} {
global currentAutomata
upvar #0 state([lindex $currentAutomata end]) s
set s $key
}
proc step {automaton} {
global currentAutomata errorInfo errorCode
set savedAutomata $currentAutomata
lappend currentAutomata $automaton
upvar #0 state($automaton) s automaton_$automaton a
if {![info exist s]} {
set currentAutomata $savedAutomata
return
}
set code [catch [list uplevel 1 $a($s)] msg]
set currentAutomata $savedAutomata
return -code $code -errorcode $errorCode -errorinfo $errorInfo $msg
}
proc halt {} {
global currentAutomata
upvar #0 state([lindex $currentAutomata end]) s
unset s
}[Volker Hetzer added this idea that does without a global state table - every node is a proc that nominates it successor: However, here's a totally different idea for an automaton:
proc state0 {} \
{
global NextState ExitFlag
do something, perhaps manipulate the ExitFlag
set NextState state1
}
proc state1 {} \
{
global Nextstate ExitFlag
do something, perhaps manipulate the ExitFlag
set NextState state0
}
set ExitFlag 0
set NextState state0
while {!$ExitFlag} \
{
$NextState
}See, you don't need any state table at all in this case. Even if you want a state table, you could still put the state procedures directly into the table thus saving that big switch. I don't know at which point the cost of recompiling is lower than the cost of a big switch.comp.lang.tcl has hosted many, many other implementations of automata, and there are quite a few others loose "in the wild". They're common throughout the whole area of [Tcl agents]. Also, they often appear under the rubric of "finite-state machine" (FSM--see the Acronym collection).For related discussion, see also:
- Why Tcl has no GOTO command - GOTO in Tcl
- BASIC in Tcl - Playing Assembler for GOTO/JMP implementations
