Posted to tcl by evilotto at Mon Jun 17 22:25:51 GMT 2013view raw
- package require Tcl 8.6
- package require struct::queue
- set pipes [dict create]
- proc pipeproc {cmd} {
- yield
- eval $cmd
- writepipe EOF
- }
- proc pipecmds {pscript} {
- set plist {}
- foreach pcmd [split $pscript "\n"] {
- set pcmd [string trim $pcmd]
- if {$pcmd eq ""} continue
- if {[string match "#*" $pcmd]} continue
- lappend plist $pcmd
- }
- return $plist
- }
- proc dopipe {pscript} {
- runpipe [pipecmds $pscript]
- }
- proc runpipe {plist} {
- set pi 0
- set in {}
- foreach p $plist {
- set pn pipe[incr pi]
- dict set ::pipes ::$pn reader $in
- dict set ::pipes ::$pn writer [struct::queue]
- coroutine $pn pipeproc $p
- set in [dict get $::pipes ::$pn writer]
- }
- while {[llength [dict keys $::pipes]] > 0} {
- foreach p [dict keys $::pipes] {
- if {[info commands $p] eq $p} {
- $p
- } else {
- dict unset ::pipes $p
- }
- }
- }
- }
- proc writepipe {v} {
- [dict get $::pipes [info coroutine] writer] put $v
- yield
- }
- proc readpipe {var} {
- upvar 1 $var v
- set q [dict get $::pipes [info coroutine] reader]
- while {1} {
- if {[$q size] > 0} {
- set v [$q get]
- if {$v == "EOF"} {
- return false
- } else {
- return true
- }
- } else {
- yield
- }
- }
- }
- proc generate {} {
- for {set x 0} {$x < 100} {incr x} {
- writepipe "generate $x"
- }
- }
- proc transform {a b} {
- while {[readpipe v]} {
- writepipe "transform: [string map [list $a $b] $v]"
- }
- }
- proc out {} {
- while {[readpipe v]} {
- puts "out: $v"
- }
- }
- dopipe {
- generate
- transform gener MAKE
- # transform MAKE ""
- out
- }