Posted to tcl by evilotto at Mon Jun 17 22:25:51 GMT 2013view raw

  1. package require Tcl 8.6
  2. package require struct::queue
  3.  
  4. set pipes [dict create]
  5.  
  6. proc pipeproc {cmd} {
  7. yield
  8. eval $cmd
  9. writepipe EOF
  10. }
  11.  
  12. proc pipecmds {pscript} {
  13. set plist {}
  14. foreach pcmd [split $pscript "\n"] {
  15. set pcmd [string trim $pcmd]
  16. if {$pcmd eq ""} continue
  17. if {[string match "#*" $pcmd]} continue
  18. lappend plist $pcmd
  19. }
  20. return $plist
  21. }
  22.  
  23. proc dopipe {pscript} {
  24. runpipe [pipecmds $pscript]
  25. }
  26.  
  27. proc runpipe {plist} {
  28. set pi 0
  29. set in {}
  30. foreach p $plist {
  31. set pn pipe[incr pi]
  32. dict set ::pipes ::$pn reader $in
  33. dict set ::pipes ::$pn writer [struct::queue]
  34. coroutine $pn pipeproc $p
  35. set in [dict get $::pipes ::$pn writer]
  36. }
  37. while {[llength [dict keys $::pipes]] > 0} {
  38. foreach p [dict keys $::pipes] {
  39. if {[info commands $p] eq $p} {
  40. $p
  41. } else {
  42. dict unset ::pipes $p
  43. }
  44. }
  45. }
  46. }
  47.  
  48. proc writepipe {v} {
  49. [dict get $::pipes [info coroutine] writer] put $v
  50. yield
  51. }
  52.  
  53. proc readpipe {var} {
  54. upvar 1 $var v
  55. set q [dict get $::pipes [info coroutine] reader]
  56. while {1} {
  57. if {[$q size] > 0} {
  58. set v [$q get]
  59. if {$v == "EOF"} {
  60. return false
  61. } else {
  62. return true
  63. }
  64. } else {
  65. yield
  66. }
  67. }
  68. }
  69.  
  70. proc generate {} {
  71. for {set x 0} {$x < 100} {incr x} {
  72. writepipe "generate $x"
  73. }
  74. }
  75.  
  76. proc transform {a b} {
  77. while {[readpipe v]} {
  78. writepipe "transform: [string map [list $a $b] $v]"
  79. }
  80. }
  81.  
  82. proc out {} {
  83. while {[readpipe v]} {
  84. puts "out: $v"
  85. }
  86. }
  87.  
  88.  
  89. dopipe {
  90. generate
  91. transform gener MAKE
  92. # transform MAKE ""
  93. out
  94. }