Fun with TclOO, coroutines and apply

Summary

CMcC 2009-02-28: You can call a coroutine as a method of an object. You can create a coroutine in a method of an object, and later invoke the coro as if it were a method of the object. The coro can access object variables and invoke methods of the object from the coro.

Description

package require TclOO
namespace import oo::*

class create coro_oo {
    variable var        ;# can be referenced from the coro by ::variable
    method meth {v} {puts $v}        ;# can be called by the coro by [my meth]

    method start {} {
        coroutine moop ::apply [list args {
            variable var        ;# this variable is the object's variable
            while {1} {
                set args [yield $var]
                my meth        $var                ;# call a method from the coro
            }
        } [self]]
        objdefine [self] forward moop [self]::moop        ;# forward the method to the coro
    }

    constructor {} {
        set var "this var (v) can be seen from the coro via 'variable' command"
    }
}

set x [coro_oo new]        ;# create the test object
$x start        ;# call start to generate the coro
puts [$x moop "calling via forward"]

Similar methodology would permit you to use proc instead of apply (because you can create a proc within a method of an object, too, and use that as the functional content of your coro), but apply is so cool.

DKF: Here's a variation on this theme, a class (designed for subclassing) that intermingles itself with a coroutine, which I wrote for the subtasks of this page (where I'm using it to do arithmetic over infinite continued fractions):

oo::class create Generator {
    constructor {} {
        coroutine [namespace current]::coro my Apply
    }
    destructor {
        catch {rename [namespace current]::coro {}}
    }
    method Apply {} {
        yield
        my Produce
        my destroy
        return -code break
    }
    forward generate coro
    method unknown args {
        if {![llength $args]} {
            tailcall coro
        }
        next {*}$args
    }
    method collect {} {
        set result {}
        while 1 {
            lappend result [my generate]
        }
        return $result
    }
    method take {n {suffix ""}} {
        set result {}
        for {set i 0} {$i < $n} {incr i} {
            lappend result [my generate]
        }
        while {$suffix ne ""} {
            my generate
            lappend result $suffix
            break
        }
        return $result
    }
}

Example use:

oo::class create SpitOutOnes {
    superclass Generator
    method Produce {} {
        while true {
            yield 1
        }
    }
}
set seq [SpitOutOnes new]
puts [join [$seq take 20 "\u2026"] ","]

Which produces this output

 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,…

Category Object Orientation