Posted to tcl by pooryorick at Fri Jun 18 07:21:59 GMT 2021view raw

  1. proc yieldall {} {
  2. set this [info coroutine]
  3. set next $this
  4. while 1 {
  5. set body {
  6. try {
  7. $next {*}[::yieldto $this [list [::info coroutine]]]
  8. } on error {} {
  9. $this -code break
  10. }
  11. }
  12. set script "::apply [list [
  13. list {this next} $body [namespace current]]] [list $this] [list $next]"
  14. set res [return -level 0 {*}[yieldto try $script]]
  15. lassign $res next
  16. }
  17. return $next
  18. }
  19.  
  20.  
  21. proc p1 {} {
  22. yield
  23. puts one
  24. c2
  25. puts two
  26. }
  27.  
  28.  
  29. proc p2 {} {
  30. yield
  31. puts three
  32. c3
  33. puts four
  34. }
  35.  
  36.  
  37. proc p3 {} {
  38. variable done
  39. yield
  40. puts five
  41. set yup [yieldall]
  42. after 100 [list $yup {something else} {and more}]
  43. set res [yieldto return -level 0]
  44. puts [list six $res]
  45. set done 1
  46. }
  47.  
  48. coroutine c1 p1
  49. coroutine c2 p2
  50. coroutine c3 p3
  51. after 0 [list [namespace which c1]]
  52. vwait [namespace current]::done
  53.