Posted to tcl by dgp at Mon May 11 13:17:17 GMT 2015view raw

  1.  
  2. The coroutine.n documentation contains a "juggler" example
  3. to illustrate use of [yieldto]. Here's a modification using
  4. TclOO objects instead of a proc, and adding a few puts to
  5. track the control flow:
  6.  
  7. oo::class create juggler {
  8. variable name target
  9. constructor {_n _t} {
  10. set name $_n
  11. set target $_t
  12. }
  13. destructor {puts DIE:$name}
  14. method toss {{value ""}} {
  15. if {[llength [info level 0]] == 2} {
  16. set value [yield [info coroutine]]
  17. }
  18. if {$value ne ""} {
  19. puts "$name : $value"
  20. lassign [yieldto $target [string replace $value end end]] value
  21. my toss $value
  22. puts "$name level [info level]"
  23. return
  24. }
  25. rename [info coroutine] {}
  26. if {[namespace which $target] ne {}} {
  27. $target ""
  28. }
  29. [self] destroy
  30. }
  31. }
  32.  
  33. coroutine j1 [juggler new Larry [
  34. coroutine j2 [juggler new Curly [
  35. coroutine j3 [juggler new Moe j1] toss ]] toss ]] toss Nyuk!Nyuk!Nyuk!
  36.  
  37. Running it produces:
  38.  
  39. Larry : Nyuk!Nyuk!Nyuk!
  40. Curly : Nyuk!Nyuk!Nyuk
  41. Moe : Nyuk!Nyuk!Nyu
  42. Larry : Nyuk!Nyuk!Ny
  43. Curly : Nyuk!Nyuk!N
  44. Moe : Nyuk!Nyuk!
  45. Larry : Nyuk!Nyuk
  46. Curly : Nyuk!Nyu
  47. Moe : Nyuk!Ny
  48. Larry : Nyuk!N
  49. Curly : Nyuk!
  50. Moe : Nyuk
  51. Larry : Nyu
  52. Curly : Ny
  53. Moe : N
  54. DIE:Moe
  55. Moe level 5
  56. Moe level 4
  57. Moe level 3
  58. Moe level 2
  59. Moe level 1
  60. DIE:Curly
  61. Curly level 5
  62. Curly level 4
  63. Curly level 3
  64. Curly level 2
  65. Curly level 1
  66. DIE:Larry
  67. Larry level 5
  68. Larry level 4
  69. Larry level 3
  70. Larry level 2
  71. Larry level 1
  72.