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