Here are some worked examples taken pretty directly from the Lua paper on coroutines.
Just to express my apreciation -- having this stuff in Tcl is sweet -- Thanks JBR.
The main feature missing here is a graceful way to exit the multitasking control structure. For now I return and catch an error from the coroutine, I welcome any improvements along the return -code lines.
#!/home/john/bin/tclsh8.6a2 # namespace path ::tcl::unsupported
A list of the procs that will be cooperativly multitasked
set Tasks {}A proc to create the coroutines and place them on the Tasks list
proc Task { tag proc args } {
lappend ::Tasks $tag
coroutine $tag $proc {*}$args
}A proc to get them off when they exit.
proc Drop { task } {
set here [lsearch $::Tasks $task]
set ::Tasks [lreplace $::Tasks $here $here]
}
Here is our first control structure. Simply run the tasks in order as independent tasks. There is no communication between them. Tasks can add new tasks or exit. When all tasks exit RoundRobin exits.
proc RoundRobin {} {
while { [llength $::Tasks] } {
foreach task $::Tasks {
if { [catch { $task } reply] } {
Drop $task
}
}
}
}
proc proc-outp { args } {
yield
foreach item $args {
puts $item
yield
}
error "Task done"
}
Task A proc-outp 1 2 3 4
Task B proc-outp A B C D
RoundRobin
Now we chain the tasks together in order. The yield value of the previous task is passed to the next. This allows "pipeline" type control. The yeild values are transformed as they pass through the chain of procs.
proc Pipeline {} {
while { [llength $::Tasks] } {
set reply {}
foreach task $::Tasks {
if { [catch { set reply [$task $reply] } reply] } {
set ::Tasks {}
break
}
}
}
}
proc proc-enum { args } {
yield
foreach item $args {
yield $item
}
error "Task done"
}
proc proc-pair { args } {
set input [yield]
foreach item $args {
set input [yield [list $item $input]]
}
}
proc proc-puts { prefix } {
while { 1 } { puts "$prefix [yield]" }
}
Task A proc-enum 1 2 3 4
Task B proc-pair A B C D
Task C proc-puts "Result :"
Pipeline
Finally we have a set of cooperating procs. They all know about each other and pass control explicitly among themselves. This is done using the coroutine names as tags, as described in the Lua coroutine paper (cite??) and passing a list as the value of yield.
proc Cooperate {} {
set next [lindex $::Tasks 0]
set arg {}
while { 1 } {
if { [catch {
foreach { next arg } [$next $arg] {}
} reply] } {
set ::Tasks {}
break
}
}
}
proc proc-tag-pick { args } {
yield
foreach item $args {
if { $item % 2 } { yield [list Odd $item]
} else { yield [list Even $item] }
}
error "Task done"
}
proc proc-tag-cati { args } {
set input [yield]
while { 1 } {
set input [yield [list D [list $args $input]]]
}
}
proc proc-tag-puts { prefix } {
set input [yield]
while { 1 } {
puts "$prefix $input"
set input [yield A]
}
}
Task A proc-tag-pick 1 2 3 4
Task Even proc-tag-cati Even
Task Odd proc-tag-cati Odd
Task D proc-tag-puts "Result :"
Cooperate