* How come, Here are some worked examples taken pretty directly from the Lua paper on coroutines.
Just to express my appreciation -- 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
RoundRobinZB Just checked, that without that first "yield" in "proc-outp" there will be execution immediately after "tagging" ("coroutine A ..."). Why is that? Is it a bug in implementation? Or perhaps coroutine A proc-outp 1 2 3 4 counts as first call, not just "tagging" (in the sense of some kind of "declaration"); is it right?
Does there exist more detailed docs? Nothing about this in b1 documentation.
NEM I'm not sure where the man-page is hiding. The TIP [L1 ] describes the behaviour (ZB I meant the docs included in package - so not the suggestion, what can and/or will be done, but a confirmation - together with detailed explanation - what has been done; a little difference, isn't it?):
coroutine evaluates the Tcl command uplevel #0 [list cmd ?arg ...?] until it returns or a yield is encountered. If yield is found then a command named coroCmdName will be created with special behaviour as described below.
So yes, the call to coroutine does indeed immediately start it. You should consider it to be roughly equivalent to uplevel #0 with the special yield behaviour.
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 :"
PipelineZB It's not quite clear to me (the "proc-pair" procedure/coroutine): What exactly means [yield\]? Is it some kind of directive "take proc's argument (before returning a value and control)"?
yield is a special command used in a coroutine to pass a value back to the caller. When the caller invokes the coroutine a second (or more) times, the yield returns with the value passed to the coroutine. It is the mechanism through which coroutines pass values and flow of control JBR.
ZB So... my assumption was, that further execution (after reenter) is resumed right after the yield line - and it doesn't seem to be the case. So we're getting back "directly into lately left yield" (with ev. argument, whose value can be saved into variable "input" then, for example).
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 :"
CooperateDKF: We can conflate the definition and the task creation like this:
proc Task {name arguments body args} {
lappend ::Tasks $name
set ns [uplevel 1 namespace current]
coroutine $name apply [list $arguments $body $ns] {*}$args
}which allows us to do something like this (with the Cooperate from above):
Task A { args } {
yield
foreach item $args {
if { $item % 2 } {
yield [list Odd $item]
} else {
yield [list Even $item]
}
}
error "Task done"
} 1 2 3 4
Task Even { args } {
set input [yield]
while { 1 } {
set input [yield [list D [list $args $input]]]
}
} Even
Task Odd { args } {
set input [yield]
while { 1 } {
set input [yield [list D [list $args $input]]]
}
} Odd
Task D { prefix } {
set input [yield]
while { 1 } {
puts "$prefix $input"
set input [yield A]
}
} "Result :"
Cooperate