Posted to tcl by colin at Fri Aug 13 01:43:22 GMT 2010view pretty
# the new yieldm multi-arg coro call does not exist. # this is the older coroutine implementation interp alias {} ::yieldm {} ::yield proc ::delshim {name x y op} { catch {::rename $name {}} ;# delete shim } proc ::Coroutine {name command args} { # determine the appropriate namespace for coro creation set ns [namespace qualifiers $name] if {![string match ::* $ns]} { set ns [uplevel 1 namespace current]::$ns } set name [namespace tail $name] # create a like-named coro set x [uplevel 1 [list ::coroutine ${ns}_$name $command {*}$args]] # wrap the coro in a shim proc ${ns}$name {args} [string map [list $x %N%] { tailcall %N% $args ;# wrap the args into a list for the old-style coro }] # the two commands need to be paired for destruction trace add command ${ns}_$name delete [list ::delshim ${ns}$name] trace add command ${ns}$name delete [list ::delshim ${ns}_$name] # tell it we created the one they requested return ${ns}$name }