CGM Here are quick-and-dirty versions of coroutine-enabled after, gets and vwait, with a simple test program. This uses the new coroutine facilities in tcl8.6a2. When run:
Note that each coroutine maintains state in its local variables, but they all run effectively in parallel.
# Helpers lifted from wiki:
proc spawn cmd {
set k [gensym]
coroutine $k {*}$cmd
}
proc gensym {{prefix "::coroutine"}} {
variable gensymid
return $prefix[incr gensymid]
}
#########################################################################
# co_after delay
# - calling coroutine pauses for (at least) delay milliseconds and then
# continues, while allowing other events to be processed in the meantime.
proc co_after ms {
after $ms [info coroutine]
yield
}
proc counter {id ms} {
set count 0
while 1 {
puts "$id [incr count]"
co_after $ms
}
}
spawn {counter A 2000}
spawn {counter {B } 3000}
spawn {counter {C } 4000}
#########################################################################
# co_gets channelId
# - calling coroutine reads a line from specified channel. If no data is
# available the coroutine waits for data, while allowing other events to
# be processed.
proc co_gets chan {
# Note: We need a loop here because even if more data became available
# on the channel it may not be a complete line. As the regular gets
# blocks until a complete line is present so must we.
set line ""
while 1 {
fileevent $chan readable [info coroutine]
yield
fileevent $chan readable {}
if {[gets $chan line] >= 0 || [eof $chan]} break
}
return $line
}
proc count_input {} {
set count 0
while 1 {
set input [co_gets stdin]
puts "INPUT LINE [incr count]: $input"
if {[string is integer -strict $input]} {
set ::trigger1 $input
} else {
set ::trigger2 $input
}
}
}
spawn count_input
#########################################################################
# co_vwait variable
# - calling coroutine waits until the named variable is set and then
# continues. Unlike standard vwait, these calls do not nest, ie.
# multiple co::vwaits wait in parallel and can be activated in any order.
proc co_vwait_callback {coro args} {$coro}
proc co_vwait varname {
upvar $varname var
set callback "co_vwait_callback [info coroutine]"
trace add variable var write $callback
yield
trace remove variable var write $callback
}
proc waiter1 {} {
set total 0
while 1 {
co_vwait ::trigger1
puts "WAITER1 TOTAL: [incr total $::trigger1]"
}
}
proc waiter2 {} {
set buffer {}
while 1 {
co_vwait ::trigger2
puts "WAITER2 BUFFER: [append buffer $::trigger2]"
}
}
spawn waiter1
spawn waiter2
#########################################################################
vwait foreverNEM Very nice! I particularly like co_gets: it makes non-blocking I/O just about as convenient as the blocking version.
AK I wonder, should we create a tcl::unsupported::co namespace or other where we can collect these commands ? Could allow us get rid of the 'co_' prefix. For completeness we will need a 'co_read' as well. For polish go the extra mile and make them fully API compatible to the originals. Oh, what do we get from [infoCoroutine], or [info coroutine] if there is no coroutine running ? The empty string? If we can determine whether we are in a coro or not we can implement something which switches the internal behaviour automatically. I.e. regular [gets] outside of a coro, and the coro specific gets if a coro is running. Anyone up4 it ?
(MS sez: note that [info coroutine] returns an FQN, so {} is unambiguously "not in a coroutine": a coroutine named {} returns '::')
AK: Now I have to look at my own pop3 retriever code again, which is fully event-based, and quite difficult to follow. Especially the highlevel control code pulling one message after the other and handling any errors which occur. Inverting that loop into an event chain was murder when I did it a few years ago. As a coro it should be trivial.
AK: Another place we could simplify through a coro would be the spaghetti which is Tcllib's ftp package.
NEM 2008-09-08: I have a bare-bones coroutine ensemble at Coroutines for event-based programming. [info coroutine] (or at least the current version) does return the empty string when not in a coroutine. Putting some this stuff into tcllib would be a good idea (I'll happily volunteer to maintain it). In the short-term, I don't see that coro's could clean up tcllib event based code, as that would obviously limit the code to work only with 8.6+. Easier to structure everything in terms of callbacks and then just allow an easy way to wrap a coroutine around a call to make it look synchronous (as in the http example below).
AK: Definitely agree that this is not a short-term thing. Also agree that having this in Tcllib would be very nice.
NEM Here's another example - asynchronous HTTP requests using a synchronous interface:
proc get url {
http::geturl $url -command [info coroutine]
yield
}
proc main {} {
set t [get http://wiki.tcl.tk/4]
puts [http::data $t]
http::cleanup $t
}
coroutine m main
ZB When trying to run it with just "m" - it's answering: can't read "state(body)": no such variable
NEM The coroutine is already running, you don't need to invoke it: just start the event loop:
vwait forever