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

  1.  
  2. Now attempt to translate that same example to Itcl:
  3.  
  4. package require Itcl 4
  5. itcl::class juggler {
  6. variable name
  7. variable target
  8. constructor {_n _t} {
  9. set name $_n
  10. set target $_t
  11. }
  12. destructor {puts DIE:$name}
  13. method toss {{value ""}} {
  14. if {[llength [info level 0]] == 2} {
  15. set value [yield [info coroutine]]
  16. }
  17. if {$value ne ""} {
  18. puts "$name : $value"
  19. lassign [yieldto $target [string replace $value end end]] value
  20. toss $value
  21. puts "$name level [info level]"
  22. return
  23. }
  24. rename [info coroutine] {}
  25. if {[namespace which $target] ne {}} {
  26. $target ""
  27. }
  28. [self] destroy
  29. }
  30. }
  31.  
  32. coroutine j1 [juggler #auto Larry [
  33. coroutine j2 [juggler #auto Curly [
  34. coroutine j3 [juggler #auto Moe j1] toss ]] toss ]] toss Nyuck!Nyuck!Nyuck!
  35.  
  36. Running this produces:
  37.  
  38. Larry : Nyuck!Nyuck!Nyuck!
  39. Curly : Nyuck!Nyuck!Nyuck
  40. Moe : Nyuck!Nyuck!Nyuc
  41. Larry : Nyuck!Nyuck!Nyu
  42. cannot yield: C stack busy
  43. while executing
  44. "yieldto $target [string replace $value end end]"
  45. (object "::juggler2" method "::juggler::toss" body line 7)
  46. invoked from within
  47. "toss $value"
  48. (object "::juggler2" method "::juggler::toss" body line 8)
  49. invoked from within
  50. "juggler2 toss Nyuck!Nyuck!Nyuck!"
  51. invoked from within
  52. "j1 Nyuck!Nyuck!Nyu"
  53. invoked from within
  54. "coroutine j1 [juggler #auto Larry [
  55. coroutine j2 [juggler #auto Curly [
  56. coroutine j3 [juggler #auto Moe j1] toss ]] toss ]] toss Nyuck!Nyuck!Nyuck!"
  57.  
  58. Some NRE support is missing in Itcl.
  59.