proc goto label { upvar 1 next next set next $label return -code continue }The "machine" itself takes a paired list of alternating labels and state code (which could be implemented as dict, once that is available - 8.5?); if a state code does not end in a goto or break, the same state will be repeated as long as not left, with goto or break (implicit endless loop). Execution starts at the first of the states.
proc statemachine states { array set state $states set next [lindex $states 0] while 1 {eval $state($next)} }
RS 2006-08-26: Three years later, I like this version better, which keeps the goto command locally - it is not for general consumption after all, and hence disappears when the state machine returns:
proc statemachine states { array set S $states proc goto label { uplevel 1 set this $label return -code continue } set this [lindex $states 0] while 1 {eval $S($this)} rename goto {} } # Testing: a tiny state machine that greets you as often as you wish, and ends if you only hit <Return> on the "how often?" question: statemachine { 1 { puts "hello - how often?" gets stdin n if {$n eq ""} {goto 3} goto 2 } 2 { if {$n==0} {goto 1} puts Howdy! incr n -1 } 3 {puts "Thank you!"; break} }
GJL 2007-09-11: Run the test with Tclsh on Windows... "gets stdin n" doesn't do its job with Wish
A more elaborate page: Finite state machines