Posted to tcl by colin at Thu Apr 15 03:03:44 GMT 2010view raw

  1. Assume a Coroutine which generates a command taking multiple args, and a coroutine as we have it implemented:
  2.  
  3. # Coroutine in coroutine:
  4. proc Coroutine {name command args} {
  5. set ns [namespace qualifiers $name]
  6. if {$ns eq ""} {
  7. set ns [uplevel 1 {namespace current}]
  8. }
  9. set name [namespace tail $name]
  10.  
  11. set coco [::coroutine ${ns}::_C$name $command {*}args]
  12. trace add command ${ns}::_C$name delete "rename ${ns}::name {}"
  13. proc ${ns}::$name {args} {
  14. set name [lindex [info level 0] 0]
  15. set ns [namespace qualifiers $name]
  16. if {$ns eq ""} {
  17. set ns [uplevel 1 {namespace current}]
  18. }
  19. set name [namespace tail $name]
  20.  
  21. ${ns}::_C$name $args
  22. }
  23. }
  24.  
  25. proc coyield {args} {
  26. return [::yield $args]
  27. }
  28.  
  29. proc yieldv {value args} {
  30. uplevel 1 [::yield $value] {*}$args
  31. }
  32.  
  33. # coroutine in cocoroutine:
  34. proc coroutine {name command args} {
  35. set ns [namespace qualifiers $name]
  36. if {$ns eq ""} {
  37. set ns [uplevel 1 {namespace current}]
  38. }
  39. set name [namespace tail $name]
  40.  
  41. Coroutine ${ns}::$name $command {*}$args
  42. }
  43.  
  44. proc ::yield2 {value} {
  45. return [lindex [::yield $value] 0]
  46. }