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