Posted to tcl by pooryorick at Fri Jun 18 07:21:59 GMT 2021view pretty

proc yieldall {} {
	set this [info coroutine]
	set next $this
	while 1 {
		set body {
			try {
				$next {*}[::yieldto $this [list [::info coroutine]]]
			} on error {} {
				$this -code break
			}
		}
		set script "::apply [list [
			list {this next} $body [namespace current]]] [list $this] [list $next]"
		set res [return -level 0 {*}[yieldto try $script]]
		lassign $res next
	}
	return $next
}


proc p1 {} {
	yield
	puts one
	c2
	puts two
}


proc p2 {} {
	yield
	puts three
	c3
	puts four
}


proc p3 {} {
	variable done
	yield
	puts five
	set yup [yieldall]
	after 100 [list $yup {something else} {and more}]
	set res [yieldto return -level 0]
	puts [list six $res]
	set done 1
}

coroutine c1 p1
coroutine c2 p2
coroutine c3 p3
after 0 [list [namespace which c1]]
vwait [namespace current]::done