[NEM] 2010-07-20: The discussion at the end of [SELF] inspired me to flesh out some code I've had on
the back-burner for a while now. The idea is to develop an asynchronous message-passing ''Actor Model''
[http://en.wikipedia.org/wiki/Actor_model] of concurrent computation on top of [Tcl] 8.6's [coroutine]
mechanism. The basic idea is that an ''actor'' is an object (in the [OO]) sense, but with the extra feature
that all calls to methods on other objects (actors) actually occur asynchronously, through the [event loop].

There's still some serious problems to fix in the code, but hopefully others can help out as I've got real work
to do now:
======
package require Tcl     8.6
package provide actor   0.1

namespace eval ::actor {
    namespace export {[a-z]*}
    namespace ensemble create

    proc create {name} {
        # An actor consists of two parts: a core namespace ensemble (object)
        # that dispatches messages to methods that handle them; and an external
        # actor interface which handles messages from other actors. Messages
        # from other actors are always asynchronous, using the event loop and
        # coroutines.
        
        # Ensure $name is fully-qualified
        set name [qualify 1 $name]

        # Use the naming convention: $name is the actor interface, $name.self is
        # the internal ensemble
        namespace ensemble create -command $name.self -map {}
        slot $name slot     = ::actor slot $name
        slot $name slots    = ::actor slots $name
        slot $name method   = ::actor method $name

        # Create the message dispatcher coroutine
        coroutine $name ::actor dispatch $name.self

        # Rename and install a send interface
        rename $name $name.coro
        interp alias {} $name {} ::actor send $name

        return $name
    }

    proc slot {actor slot = cmd args} {
        set actor [uplevel 1 [list namespace which -command $actor.self]]
        set slots [namespace ensemble configure $actor -map]
        dict set slots $slot [list {*}$cmd {*}$args]
        namespace ensemble configure $actor -map $slots
        return $slot
    }

    proc slots {actor {pattern *}} {
        set actor [uplevel 1 [list namespace which -command $actor.self]]
        set slots [namespace ensemble configure $actor -map]
        return [dict keys $slots $pattern]
    }

    proc method {actor name params body} {
        slot $actor $name = ::apply [list $params $body ::]
    }
    
    proc send {actor args} {
        # Schedule the message to be delivered using the event loop
        after 0 [list ::actor deliver [info coroutine] $actor.coro $args]
        # Then yield and wait for the reply
       # puts "About to yield:"
       # foreach event [after info] { puts "\t$event: [after info $event]" }
        lassign [yield] result options
       # puts "Returning: $result $options"
        return -options $options $result
    }

    proc deliver {from to message} {
        set result [$to $message]
        $from $result
    }

    proc self args {
        set self [info coroutine].self
        tailcall $self {*}$args
    }

    proc dispatch actor {
        set result ""
        set options [dict create]
        while 1 {

            # Yield the result of this message, and receive the next
            set message [yield [list $result $options]]

            #puts "Dispatching: $message"

            # Dispatch the message to the actor ensemble
            catch { $actor {*}$message } result options
        }
    }

    # qualify level name
    #
    #       Returns the fully-qualified version of $name. This is done by
    #       prefixing the name given with the namespace that is current at
    #       $level. In contrast to [namespace which], this command is intended
    #       to be used for commands that have not yet been created.
    #
    proc qualify {level name} {
        if {[string match ::* $name]} { return $name }
        if {[string is integer -strict $level] && $level >= 0} { incr level }
        set ns [uplevel $level { namespace current }]
        if {$ns eq "::"} { return ::$name }
        return $ns\::$name
    }

    # A coroutine-enabled REPL shell for testing
    proc shell {} {
        coroutine ::actor::main ::actor::repl
        vwait forever
    }
    proc repl {} {
        while 1 {
            set cmd [get-command]
            set code [catch { uplevel #0 $cmd } result opts]
            if {$code == 1} {
                puts [dict get $opts -errorinfo]
            } elseif {[string length $result]} {
                puts $result
            }
        }
    }

    proc get-command {} {
        set cmd [prompt %]
        while {![info complete $cmd]} {
            append cmd \n [prompt >]
        }
        return $cmd
    }

    proc prompt p {
        puts -nonewline "$p "
        flush stdout
        fileevent stdin readable [lambda return {
            $return [gets stdin]
        } [info coroutine]]
        yield
    }
    proc lambda {params body args} {
        list ::apply [list $params $body] {*}$args
    }
}

if {$argv0 eq [info script]} {
    actor shell
}
======
As well as the coroutine code, I've also included [a coroutine-enabled interactive command line] for testing purposes:
======
$ tclsh actor.tcl
% actor create adder
::adder
% adder method add {a b} { expr {$a + $b} }
add
% adder add 2 3
5
% actor create summer
::summer
% summer method sum args {
>   set sum 0
>   foreach x $args { set sum [adder add $sum $x] }
>   puts "sum = $sum"
> }
sum
% summer sum 1 2 3 4 5
% sum = 15
======
So, what's special about this? It looks just like a fairly boring [OO] demonstration. Which it is. Except that each method call
between objects (actors) occurs asynchronously using the event loop. This opens the door to rather simple concurrency,
with all the advantages and disadvantages that entails.

<<categories>>Concurrency