Posted to tcl by dgp at Mon May 11 13:17:17 GMT 2015view pretty

The coroutine.n documentation contains a "juggler" example
to illustrate use of [yieldto].  Here's a modification using
TclOO objects instead of a proc, and adding a few puts to
track the control flow:

oo::class create juggler {
    variable name target
    constructor {_n _t} {
        set name $_n
        set target $_t
    }
    destructor {puts DIE:$name}
    method toss {{value ""}} {
        if {[llength [info level 0]] == 2} {
            set value [yield [info coroutine]]
        }
        if {$value ne ""} {
            puts "$name : $value"
            lassign [yieldto $target [string replace $value end end]] value
            my toss $value
            puts "$name level [info level]"
            return
        }
        rename [info coroutine] {}
        if {[namespace which $target] ne {}} {
            $target ""
        }
        [self] destroy
    }
}

coroutine j1 [juggler new Larry [
coroutine j2 [juggler new Curly [
coroutine j3 [juggler new Moe j1] toss ]] toss ]] toss Nyuk!Nyuk!Nyuk!

Running it produces:

Larry : Nyuk!Nyuk!Nyuk!
Curly : Nyuk!Nyuk!Nyuk
Moe : Nyuk!Nyuk!Nyu
Larry : Nyuk!Nyuk!Ny
Curly : Nyuk!Nyuk!N
Moe : Nyuk!Nyuk!
Larry : Nyuk!Nyuk
Curly : Nyuk!Nyu
Moe : Nyuk!Ny
Larry : Nyuk!N
Curly : Nyuk!
Moe : Nyuk
Larry : Nyu
Curly : Ny
Moe : N
DIE:Moe
Moe level 5
Moe level 4
Moe level 3
Moe level 2
Moe level 1
DIE:Curly
Curly level 5
Curly level 4
Curly level 3
Curly level 2
Curly level 1
DIE:Larry
Larry level 5
Larry level 4
Larry level 3
Larry level 2
Larry level 1