Posted to tcl by aspect at Sun Feb 12 10:46:13 GMT 2017view raw

  1. proc putl args {puts $args}
  2.  
  3. proc roalias {src dst} {
  4. uplevel 1 [list set $dst {}] ;# create the var so we can resolve it and add traces
  5. set dst [uplevel 1 [list namespace which -var $dst]]
  6. set src [uplevel 1 [list namespace which -var $src]]
  7. trace add variable $dst read [list rotrace:read $src]
  8. trace add variable $dst write [list rotrace:setdst $src]
  9. trace add variable $src write [list rotrace:setsrc $src]
  10. trace add variable $dst unset [list rotrace:unset $src $dst]
  11. }
  12.  
  13. # on read: copy the value of $src
  14. proc rotrace:read {src varname args} {
  15. tailcall set $varname [set $src]
  16. }
  17.  
  18. # on change src: clear the dst var (discard the stale value)
  19. proc rotrace:setsrc {src dst args} {
  20. set $dst {}
  21. }
  22.  
  23. # disallow change dst, and immediately discard the value
  24. proc rotrace:setdst {src varname args} {
  25. putl no set! $varname
  26. tailcall set $varname {}
  27. }
  28.  
  29. # on unset dst, remove traces on src
  30. proc rotrace:unset {src dst args} {
  31. trace remove variable $src write [list set $dst {}]]
  32. }
  33.  
  34. namespace eval foo {
  35. variable bla
  36.  
  37. set bla 23
  38.  
  39. coroutine lol apply [list {} {
  40. yieldto after 0 [info coroutine]
  41. variable bla
  42. set i 23
  43. while 1 {
  44. set old $bla
  45. set bla [incr i 1000]
  46. putl [namespace which -var bla] : $old -> $bla
  47. yieldto after 1000 [info coroutine]
  48. }
  49. } [namespace current]]
  50. }
  51.  
  52. namespace eval bar {
  53. roalias ::foo::bla bla
  54.  
  55. coroutine lol apply [list {} {
  56. yieldto after 500 [info coroutine]
  57. variable bla
  58. set i 42
  59. while 1 {
  60. set old $bla
  61. set bla [incr i 1000]
  62. putl [namespace which -var bla] : $old -> $bla
  63. after 1000 [info coroutine]
  64. yield
  65. }
  66. } [namespace current]]
  67. }
  68.  
  69. vwait forever
  70.