Posted to tcl by aspect at Sun Feb 12 10:46:13 GMT 2017view pretty
proc putl args {puts $args} proc roalias {src dst} { uplevel 1 [list set $dst {}] ;# create the var so we can resolve it and add traces set dst [uplevel 1 [list namespace which -var $dst]] set src [uplevel 1 [list namespace which -var $src]] trace add variable $dst read [list rotrace:read $src] trace add variable $dst write [list rotrace:setdst $src] trace add variable $src write [list rotrace:setsrc $src] trace add variable $dst unset [list rotrace:unset $src $dst] } # on read: copy the value of $src proc rotrace:read {src varname args} { tailcall set $varname [set $src] } # on change src: clear the dst var (discard the stale value) proc rotrace:setsrc {src dst args} { set $dst {} } # disallow change dst, and immediately discard the value proc rotrace:setdst {src varname args} { putl no set! $varname tailcall set $varname {} } # on unset dst, remove traces on src proc rotrace:unset {src dst args} { trace remove variable $src write [list set $dst {}]] } namespace eval foo { variable bla set bla 23 coroutine lol apply [list {} { yieldto after 0 [info coroutine] variable bla set i 23 while 1 { set old $bla set bla [incr i 1000] putl [namespace which -var bla] : $old -> $bla yieldto after 1000 [info coroutine] } } [namespace current]] } namespace eval bar { roalias ::foo::bla bla coroutine lol apply [list {} { yieldto after 500 [info coroutine] variable bla set i 42 while 1 { set old $bla set bla [incr i 1000] putl [namespace which -var bla] : $old -> $bla after 1000 [info coroutine] yield } } [namespace current]] } vwait forever