async methods for objects

Motivation

It seems to me that it would be nice if, for some object O, a method call such as get_stuff in this:

   set stuff [$O get_stuff]

could internally suspend and return stuff after completion of some asynchronous, event driven processing.

The motivation for this is that tcl then automatically preserves execution state and you get to write asynchronous code in much simpler procedural, synchronous style.

Also I have never quite mastered the Promise idea used by other languages; this seems much simpler.

First attempt

By incorporating coroutines in special object methods (called async_functions in code below) I was able to get the following. The syntax is a bit more complicated than a normal method but it does achieve a procedural style.

set p [Object clone o]

$p async_function ding {} {
   #
   # you can do stuff here including nested or recursive async calls to self or 
   # calling async methods on other objects
   #
   # or you can do cool stuff like
   #
   #   chan event $channel readable [info coroutine]
   #   yield
   #   set data [read $channel]
   #   ....

   # but for now we just bounce off another async function in self
   cc-call $self dong 2
   cc-next [yield]
}

$p async_function dong {n} {
   cc-next [incr n]
}

#
# initiate the async processing providing an anonymous function to
# call on completion
#
$p async ding {} {apply {{n} {
   set ::done $n
}}}

# assuming we are running in tclsh we now wait for stuff to happen
vwait ::done

# prints 3
puts $done

The Code

This is the code for the above example; it is based on the prototype objects in Self on a class-based OO system (some detais are omitted to help highlight the async implementation).

The Object prototype is extended with methods to define and call async functions using coroutines.

namespace eval ::def {
   namespace export Object cc-next cc-call

   oo::class create Object {
      superclass ::oo::class
      self mixin ::def::Object
      
      variable state
      variable functions
      variable sequence

      unexport create new
      self unexport create new
 
      method initialise {} {
         set functions {}
         array set state {}
      }

      method clone {name {constructor {}}} {
        set o [my new [list superclass [self]]]
        ::oo::objdefine $o mixin $o
        set clone_name [uplevel 1 [list rename $o $name]\;[list namespace which $name]]
        $clone_name initialise
        return $clone_name
      }

      # declare async function
      method async_function {name arguments body} {
         set cr_name [self].$name.cr
         dict set functions $name $cr_name
         proc $cr_name [concat self next $arguments] $body
      }

      method get_function {name} {
         if {[dict exists $functions $name]} {
            dict get $functions $name
          } elseif {[set parent [info object class [self]]] ne "::oo::class"} {
            $parent get_function $name
         }
      }

      # call async function
      method async {name {arglist {}} {next {}}} {
         if {![dict exists $functions $name]} {
            set fn [[self] get_function $name]
            dict set functions $name $fn
         } 
         if {[dict exists $functions $name]} {
            set fn [dict get $functions $name]
            coroutine [self].$name.[incr sequence].crn $fn [self] $next {*}$arglist
         } else {
            cc-next [list 0 "unknown function $name"]
         }
      }
   }

   #
   # just syntax to simplify calling an async function
   # (a bit of a nod to scheme's call-with-current-continuation)
   #
   proc cc-call {self name {arguments {}} {next {}}} {
      if {$next eq {}} {
         set next [info coroutine]
      }
      ::after 0 $self async $name [list $arguments] [list $next]
   }
   
   #
   # just syntax to simplify calling async continuation
   #
   proc cc-next {args} {
      upvar next next
      if {[info exists next]} {
         tailcall ::after 0 $next $args
      } else {
         puts "*** did not find next var in async call frame"
         exit 0
      }
   }
}

namespace import ::def::*