Posted to tcl by Poor Yorick at Thu Feb 10 11:06:53 GMT 2022view pretty
proc done {} { variable status puts {Zipped and sent!} set status 0 } proc download {dir url} { puts [list downloading $url] waitforstuff set content [list content of $url] if {$url eq {two}} { error {not two!} } save_file $dir $url $content lindex $url } proc downloaderror {cres copts} { set msg [list {error downloading} $cres] if {[dict exists $copts task]} { lappend msg task [dict get $copts task]] } puts stderr $msg } proc downloads {dir urls err} { set length [llength $urls] set tasks [lmap url $urls { list download $dir $url }] parallel $tasks err $err return } proc downloadzipandmail {dir urls} { downloads $dir $urls downloaderror zip $dir mail done } proc du {} { waitforstuff return {disk size done} } proc errhandler {cres copts} { puts [list {got this error} $cres] if {[dict exists $copts task]} { puts [list {error task} [dict get $copts task]] } } proc mail {} { puts [list mailed stuff] } proc parallel {tasks args} { while {[llength $args]} { set args [lassign $args[set args {}] arg] switch $arg { err { set args [lassign $args[set args {}] err] puts [list bugga $err] } default { error [list {unknown argument} $arg] } } } set length [llength $tasks] foreach task $tasks { after 0 [ list worker proxy $task [list [info coroutine]]] } while {[incr length -1] >= 0} { if {[catch {return {*}[ yieldto lindex [list [info coroutine]]] } cres copts]} { if {[info exists err]} { {*}$err $cres $copts } return -options $copts $cres } } } proc proxy {task return} { catch $task cres copts dict set copts task $task {*}$return -options $copts $cres } proc save_file {dirvar url content} { namespace upvar [namespace current] $dirvar dir puts [list saving to dir $dirvar] dict set dir $url $content } proc zip dirvar { namespace upvar [namespace current] $dirvar dir waitforstuff foreach {key value} $dir { puts [list $key $value] } } proc waitforstuff {} { set elapsed [expr {entier(rand() * 2000)}] after $elapsed [list [info coroutine]] yield } proc worker args { coroutine [info cmdcount] {*}$args } proc main_coro {argv0 argv} { yield [list [info coroutine]] set dir mydir set urls {one two three} parallel [list [list downloadzipandmail $dir $urls] du] err errhandler } after 0 [coroutine main main_coro $argv0 $argv] vwait status