[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 coro [info coroutine]
        regexp {^(.*)\.coro$} $coro -> coro
        set self $coro.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.

----
'''[dkf] - 2010-07-20 06:44:53'''

There is a very real sense in which [TclOO] is a message-passing model, though a purely synchronous one. (The key marker is that it is possible to set up interceptors for arbitrary messages, i.e., any method call. Indeed, it supports two types of interceptors, the '''unknown''' method for otherwise-unhandled messages and '''filters''' for any message.)

[NEM] Yes, the code above could be shortened to just a couple of procedures using [TclOO] as the majority of the code is
a simple hand-rolled OO system (based on [neo] etc.). The interesting thing about message-passing, which was hinted at
in the original [Smalltalk] documentation, if not before, is the separation between the notion of a ''message'' (which is sent
to an object/actor) and a ''method'' that responds to it. This separation is almost entirely lost in "modern" OO languages like
[Java] and [C#]. As you say, one consequence of maintaining the separation is that you can handle [unknown] messages and
filter all messages. Another consequence is that you can change the way that messages are mapped to methods, such as
by making delivery asynchronous (as here). Another possibility is that there may be more than one method corresponding to
a given message, and then you can use some guard condition or other deliberative mechanism to choose which method to
run. At the simplest level, these guards might correspond to the sort of guarded functions used in [functional programming]
languages such as [Haskell], where we can write (reading the | character as "when"):
======
myFunc x y | x < y = x
myFunc x y | otherwise = y
======
At the more sophisticated end of the spectrum we can combine this with techniques from [logic programming] and [databases]
so that our guard clauses can not only test the arguments to the function, but also perform complex queries against an
internal database ("belief-base"). This end of the spectrum is being explored currently in various agent-oriented programming
languages, such as AgentSpeak(L), Jason, 2APL/3APL, GOAL, etc. There you can combine [Prolog]-style logic programming
databases with event-condition-action rules such as the following (pseudo-code):
======
parent(X,Y) :- father(X,Y).
parent(X,Y) :- mother(X,Y).
ancestor(X,Y) :- parent(X,Y).
ancestor(X,Z) :- parent(X,Y), ancestor(Y,Z).

on see(Person) | ancestor(Person,jeff) -> say("Hello, " + Person + " who is an ancestor of Jeff!").
on see(Person) | otherwise             -> say("Hello, " + Person).
======
This is a highly contrived example, obviously, but you can see the potential: a message is matched to a method not only by its
name, but also potentially on the content of the message and by arbitrarily complex queries over the object's (actor's/agent's)
internal database. Add in persistence and transactions to that database, and you have the basis of an extremely powerful
approach to programming. 'Would be great to implement ''that'' on top of [TclOO]. Someday soon...

----
'''[AKgnome] - 2010-07-20 14:45:03'''

Another way where the distinction between message and method is important is time. Add in some delays, maybe configurable, and the above is also a framework for event-based simulation of processes, like digital electronic circuits. Due to the use of Tcl's event loop such can then also be fitted with a nice GUI without disrupting anything.


<<categories>>Concurrency | Object Orientation