[NEM] 2004-06-24: As a related item, here is a little toy proc for making a [foreach] loop run asynchronously. Needs work to be really useful, and could benefit from some form of [lambda], but somebody might find it useful as a version of the pattern used above: ====== proc async-foreach {var list body} { proc async-body [list $var args] [string map [list %BODY $body] { %BODY if {[llength $args] > 0} { after idle [linsert $args 0 async-body] } }] after idle [linsert $list 0 async-body] } ====== And a usage example: ====== async-foreach item {1 2 3 4 5} { puts "Item = $item" } vwait forever ;# -> # item = 1 # item = 2 # item = 3 # item = 4 # item = 5 ====== The above implementation has the following limitations: * Only one loop can be active at any one time (hence the need for lambda or a unique-name scheme) * Only one variable and one list to iterate over Extensions are possible, but that needs some work [Lars H]: It is perfectly possible to make do without lambdas and unique-name schemes. ====== proc async-foreach {vars list body {final ""}} { if {[llength $vars] && [llength $list]} then { foreach $vars $list {break} set list [lrange $list [llength $vars] end] if 1 then $body after idle [list async-foreach $vars $list $body $final] } else $final } ====== (The `if 1 then $body` rather than `eval $body` here is to have `$body` byte-compiled.) This form adds a second body, `$final`, which is evaluated after the last iteration. It also supports multiple loop variables. Example: ======none % async-foreach {item item2} {1 2 3 4 5} { puts "Items = ($item,$item2)" } {puts "That's all, folks!"} Items = (1,2) after#28 % Items = (3,4) Items = (5,) That's all, folks! ====== Note the slight asynchronicity that the return value from the command (after#28, `[after]`) and the following prompt are printed by the command loop between the first and second iteration of the asynch-foreach. One problem with the above procedure is that you mustn't use the variable names vars, list, body, or final in the body. In a production environment, they should rather be given names like `__vars`, `__list`, `__body`, and `__final` to avoid unintended overwritings. [Lars H] 2008-08-05: Revisiting this page, I came up with the following [braintwister] of an implementation that permits arbitrary variable names by having done all substitutions of the special variables ''vars'', ''list'', ''body'', and ''final'' before the '''foreach''': ====== proc async-foreach {vars list body {final ""}} { if {[llength $vars] && [llength $list]} then { foreach $vars $list [ set list [lrange $list [llength $vars] end] list for $body 1 return [ list after idle [ list async-foreach $vars $list $body $final ] ] ] } else $final } ====== (The body of `foreach` is a `for` command, and the ''next'' script of that '''for''' is a '''return''' that terminates both loops.) To demonstrate that it works: % async-foreach {vars list body final} {1 2 3 4 5 6 7} {puts "$vars $list $body $final"} {puts "That's all, folks!"} 1 2 3 4 % 5 6 7 That's all, folks! ''End update.'' [NEM]: Nice improvement. The reason I suggested lambda was precisely to avoid having to have specially named variables. For instance, see the absurd lengths I go to to achieve this at [More functional programming]. I like the "final" clause - could be useful. Here's another version which handles (I think) all the forms of `[foreach]`, allows for cleanup, and allows you to cancel a loop at any time: ====== namespace eval async { variable id 0; variable data } # async::foreach -- # # Usage: async::foreach varlist list ?varlist list...? ?-interval ms|idle? ?-finally script? body proc async::foreach {varlist list args} { variable id; variable data set usage "async::foreach varlist list ?varlist list...? ?-interval ms|idle? ?-finally script? body" if {[llength $args] < 1 || ([llength $args] % 2) != 1} { return -code error "wrong # args: should be \"$usage\"" } set curid [incr id] set body [lindex $args end] set data($curid,final) "" set data($curid,interval) idle set vars $varlist set data($curid,lengths) [list [llength $varlist]] set lists [list $list] ::foreach {key value} [lrange $args 0 end-1] { if {$key eq "-interval"} { set data($curid,interval) $value } elseif {$key eq "-finally"} { set data($curid,final) $value } else { eval lappend vars $key lappend data($curid,lengths) [llength $key] lappend lists $value } } # Create a proc for this body proc body$curid $vars $body set data($curid,event) [after $data($curid,interval) [list ::async::do $curid $lists]] return $curid } # Proc to actually run the body of the foreach proc async::do {id lists} { variable data set call [list ::async::body$id]; set remainder [list] for {set i 0} {$i < [llength $data($id,lengths)]} {incr i} { set clist [lindex $lists $i]; set clen [lindex $data($id,lengths) $i] eval lappend call [lrange $clist 0 [expr {$clen -1}]] lappend remainder [lrange $clist $clen end] } if {[llength $call] == 1} { # Finished cancel $id } else { # Evaluate uplevel 1 $call set data($id,event) [after $data($id,interval) [list ::async::do $id $remainder]] } } # Cancel a running loop proc async::cancel id { variable data after cancel $data($id,event) set final $data($id,final) ::foreach key [array names data $id,*] { unset data($key) } rename ::async::body$id {} # Run -finally script, if any uplevel 1 $final } ====== And a usage example: ====== set id [async::foreach name {Neil Pete Jon} age {23 42 12} -interval 1000 -finally { puts "Done!" } { puts "Name = $name Age = $age" }] after 2100 [list ::async::cancel $id] vwait async::data($id,final) # Produces: # Name = Neil Age = 23 # Name = Pete Age = 42 # Done! ====== ---- [schlenk]: How about moving this async foreach into the control module of tcllib? Could help in the effort to make POP3/IMAP4/NNTP protocols in tcllib capable of async operation. [NEM]: OK. I've just spotted a bug though (doesn't handle the `foreach a {1 2} b {1} ...` case). I'll fix it up and get someone to add it in. async versions of `[for]` and `[while]` would probably be good too. ---- [schlenk]: Here is an asynchronous `[for]` loop. It evaluates the `$start`, `$test` and `$next` expressions in the namespace given by the `-ns` option. ====== proc async::for {start test next args} { variable id; variable data set usage "async::for start test next ?-interval ms|idle? ?-ns namespace? ?-finally script? body" if {[llength $args] < 1 || ([llength $args] %2) != 1} { return -code error "wrong # args: should be \"$usage\"" } set curid [incr id] set body [lindex $args end] set data($curid,final) "" set data($curid,interval) idle set data($curid,test) $test set data($curid,next) $next set data($curid,namespace) [uplevel 1 namespace current] ::foreach {key value} [lrange $args 0 end-1] { if {$key eq "-interval"} { set data($curid,interval) $value } elseif {$key eq "-finally"} { set data($curid,final) $value } elseif {$key eq "-ns"} { set data($curid,namespace) $value } else { return -code error "wrong # args: should be \"$usage\"" } } proc body$curid {} $body # evaluate start code in global scope namespace inscope $data($curid,namespace) $start set data($curid,event) [after $data($curid,interval) [list ::async::dofor $curid]] return $curid } proc async::dofor id { variable data set call [list ::async::body$id] set test [namespace inscope $data($id,namespace) expr $data($id,test)] if {$test} { namespace inscope $data($id,namespace) $data($id,next) uplevel 1 $call set data($id,event) [after $data($id,interval) [list ::async::dofor $id]] } else { cancel $id } } proc async::wait id { vwait ::async::data($id,final) } ====== And a usage example: ====== namespace eval ::scratch { variable i } set id [async::for {set i 0} {$i < 100} {incr i} -ns ::scratch -interval 100 -finally {puts Done} \ {upvar 0 ::scratch::i i; puts $i}] after 2500 [list ::async::cancel $id] async::wait $id ====== ---- [LV]: Given the features in Tcl 8.5 and 8.6, is there a way to take the above idea and marry it with Tcl's coroutines to get a foreach that would work with generators? [NEM] 2008-03-12: ====== proc async-foreach args { set body [lindex $args end] set id ::loop[incr ::loopid] set body "$body;after idle $id;yield" coroutine $id foreach {*}[lrange $args 0 end-1] $body return $id } ====== [LV]: So, what would an example of using it look like? Trying to pattern after the examples above, I guess: ====== puts "example of async-foreach" set id [async-foreach item {1 2 3 4 5 10 20 30 100} { puts "Item = $item" }] after 2500 [list ::async::cancel $id] async::wait $id puts Done! ====== I'm not certain about this though. The above uses a fixed list, rather than a generator. I'm uncertain how to express the generator. <> Concurrency | Example | Tutorial | Control Structure