Version 8 of coroutine-enabled event handling

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:

1. 3 coroutines are started using proc counter which increment and print local counters at different speeds, using co_after for their delays.
2. 1 coroutine is started using proc count_input which reads lines of input using co_gets, echoes them preceeded by line count, then if the input is integer it is assigned to variable ::trigger1 otherwise it's assigned to variable trigger2.
3. 2 coroutines are started (procs waiter1, waiter2) which use co_vwait to wait in parallel for updates to variables ::trigger1 and ::trigger2 then add/append these to a total and report them.

Note that each coroutine maintains state in its local variables, but they all run effectively in parallel.

 # Helpers lifted from wiki:
 namespace path ::tcl::unsupported

 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 [infoCoroutine]
     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 [infoCoroutine]
         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 [infoCoroutine]"
     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 forever

NEM Very nice! I particularly like co_gets: it makes non-blocking I/O just about as convenient as the blocking version.

NEM Here's another example - asynchronous HTTP requests using a synchronous interface:

namespace path ::tcl::unsupported
proc get url {
    http::geturl $url -command [infoCoroutine]
    yield
}
proc main {} {
    set t [get http://wiki.tcl.tk/4]
    puts [http::data $t]
    http::cleanup $t
}
coroutine m main