A Coroutine-Enabled Interactive Command Line

NEM 2009-07-31: Here's a simple interactive tclsh-style application, with the difference that it runs inside a coroutine. This allows you to have complex event-driven interactions appear as if they are happening in a blocking, non-event-driven manner. For example, you can have Tk GUI applications responding to events while you are apparently in a blocking HTTP request.

# corotcl --
#
#       A coroutine-enabled tclsh
#
package require Tk
proc lambda {params body args} {
    list ::apply [list $params $body] {*}$args
}
proc prompt p {
    puts -nonewline "$p "
    flush stdout
    fileevent stdin readable [lambda return {
        $return [gets stdin]
    } [info coroutine]]
    yield
}
proc get-command {} {
    set cmd [prompt %]
    while {![info complete $cmd]} {
        append cmd \n [prompt >]
    }
    return $cmd
}
proc repl {} {
    while 1 {
        set cmd [get-command]
        set code [catch { uplevel #0 $cmd } result opts]
        if {$code == 1} {
            puts [dict get $opts -errorinfo]
        } else { puts $result }
    }
}
coroutine main repl
#vwait forever ;# if no Tk

An example of use. First, we bring up a simple Tk interface to check that everything keeps running in the background:

% pack [button .b -text Test -command {puts Test}]
.b

Testing this will show that it does print "Test" in the console when clicked. So far, so normal. Now, we create a coroutine-enabled version of http::geturl:

% package require http
2.7.2
% proc fetch url {
>   http::geturl $url -command [info coroutine]
>   yield
> }

We can now use this to fetch data from the web, just like the usual geturl. The difference is that this works in the background: you can still click on the Tk button and it will still print to the console even while the fetch is still in progress:

% set t [fetch https://wiki.tcl-lang.org/4]
Test
Test
Test
::http::1

There we go: an interactive Tcl interpreter that is fully coroutine enabled.

Next step? Futures?

CMcC - 2009-07-31 11:36:54

Very cool.

Here's a variant which uses a TclOO object called Shell so one can have multiple of these constructed with different chans as i/o. If you construct it with a 'port' argument, it'll listen on localhost.

# Shell -- a coroutine enabled tcl evaluator
#
# From Neil Madden's corotcl https://wiki.tcl-lang.org/24060
#
# Usage:
#
# [Shell new] - create a shell listening on stdio
# [Shell new in $chan out $chan] - shell connected to chan
# [Shell new port $port] - shell server on localhost port $port

package require TclOO
namespace import oo::*

package provide Shell

class create Shell {
    variable interp
    constructor {args} {
        # prompt for input, collect it and return
        proc prompt {in out p} {
            puts -nonewline $out "$p "
            chan flush $out
            chan event $in readable [list ::apply {{return in} {
                $return [gets $in]
            }} [info coroutine] $in]
            return [yield]
        }

        # read-eval-print loop - prompt, gets input, evaluate it, print result
        proc repl {self in out} {
            variable interp
            while {1} {
                set cmd [prompt $in $out %]
                while {![info complete $cmd]} {
                    append cmd \n [prompt $in $out >]
                }

                try {
                    {*}$interp $cmd
                } on error {result eo} {
                    puts $out [dict get $eo -errorinfo]
                } on return {result} {
                    break
                } on ok {result} {
                    puts $out $result
                }
            }

            # close the i/o unless it's stdio
            if {$in ne "stdin"} {
                chan close $in read
            } else {
                chan event $in readable {}        ;# stop listening to stdin
            }
            if {![string match std* $out]} {
                chan close $out write
            }

            return $result
        }

        set interp {uplevel #0}
        set in stdin; set out "";# default - use stdio
        set host localhost        ;# default - listen only to localhost

        dict with args {
            if {[info exists port]} {
                # what is wanted is a listener
                socket -server [list ::apply {{sock addr port} {
                    set shell [Shell new in $sock]
                }}]  -myaddr $host $port
            } else {
                # we have a chan (or a couple of chans)
                if {$out eq ""} {
                    if {$in eq "stdin"} {
                        set out stdout
                    } else {
                        set out $in
                    }
                }
                chan configure $out -buffering line
                coroutine [self]_CORO repl [self] $in $out
            }
        }
    }
}

if {[info exists argv0] && ($argv0 eq [info script])} {
    puts "Shell on stdio"
    Shell new
    puts "Shell on localhost port 8082"
    Shell new port 8082 interp {uplevel #1}
    vwait forever
}

CMcC - 2009-07-31 22:31:19

Further development of Shell has been moved into Wub. For the latest version (including a login facility) please consult: https://code.google.com/p/wub/source/browse/Utilities/Shell.tcl

APN Could someone explain the following two points - how come the channel does not need to be set to non-blocking mode? Couldn't the [gets] block preventing the coroutine from yielding and effectively blocking the gui as well ? Secondly, without coroutines, I could see doing something like this using a combination of async reads and update. Do the caveats regarding use of update also apply to using coroutines? If not, why not. If yes, then what advantage do coroutines afford over async i/o and update in such scenarios ?

NEM 2011-02-16: These are both good questions:

Yes, the channel should probably be in non-blocking mode, as the gets could block if there is not a full line available.
Absolutely, yes. A yield to the event loop is roughly similar to an update and similar care should be taken. Most importantly you should not invoke the event loop (by any means: update, vwait, yield to event loop, tk_messageBox, etc) in the middle of a "critical section", such as a channel event callback. Notice that the majority of uses of yield to the event loop on this wiki do so only in a tailcall position, i.e., as the last possible action. The general pattern is to ensure your app is in a consistent state, setup any callbacks needed for further processing, and finally yield to the event loop. The "fetch" procedure example near the top of this page is a prime demonstration of this pattern: initiates an action, registers a callback, and finally yields to the event loop. You can make event-loop yields (and even updates) work in the middle of a procedure, but you really need a good understanding of the possible concurrent interactions in your program to do that.

APN As an aside, if you are planning to use this as substitute for tclsh, note two minor issues - line continuations using backslashes are not handled correctly (meaning as in tclsh), and commands returning empty strings result in extraneous blank lines in the output. Both are simply fixed and left as an exercise for the reader.

Category Event Loop

Category Example