[NEM] '''24June2004''' - 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 # Produces: # 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: % 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, from the [after] command) 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. ''Update 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 the '''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 acheive 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? ---- !!!!!! %| [Category Concurrency] | [Category Example] | [Category Tutorial] | [Category Control Structure] |% !!!!!!