Updated 2013-12-01 02:29:21 by AMG

eos: ensemble object system (neo is a much better name, RS was faster ...)

This system is closely related to neo, and inspired by NEM's 'Using namespace ensemble without a namespace'.

eos is a slot based system. It provides cloning.

To be continued ...
namespace eval eos {
     variable nobjs0
     namespace export *

     # ::eos:: Create a new object

     proc {} args {
         if {[set len [llength $args]] > 1} {
             set cmd [lindex [info level 1] 0]
             return -code error "wrong # args: should be \"$cmd ?objname?\""
          if {$len == 1} {
             set name [lindex $args 0]
             if {[string range $name 0 1] ne "::"} {
                 set ns [uplevel 1 [list namespace current]]
                 if {![llength $ns]} {set ns ::}
                 set name $ns$name
         } else {
             variable nobjs
             set name ::eos::OBJ[incr nobjs]
         uplevel \#0 [list namespace ensemble create \
                        -command $name \
                        -map {}  \
                        -unknown ::eos::unknown\
         return $name

     proc const v {return $v}

     # The proc unknown defines the default slots, ie, the "class" of the
     # object. It processes all not-found instances, as it is the -unknown
     # option in the ensemble as set above.
     # A new "class" just requires defining a new unknown processor, and setting
     # it as the -unknown processor in the ensemble.

     proc unknown {obj cmd args} {list ::eos::*$cmd $obj}

     # Define the default functions for the "class": by convention, the names
     # start with '*'. These are found by the utility function "unknown" above

     interp alias {} ::eos::*config {} namespace ensemble configure

     proc *slot {self slot args} {
         set map [namespace ensemble configure $self -map]
         if {[llength $args]} {
             dict set map $slot $args
         } else {
             set map [dict remove $map $slot]
         namespace ensemble configure $self -map $map

     proc *method {self name params body {ns ::}} {
         set params [linsert $params 0 self]
         *slot $self $name ::apply [list $params $body $ns] $self

     proc *value {self slot value} {
         *slot $self $slot ::eos::const $value
         return $value

     proc *clone {self args} {
         # Assumes that $self only appears at the end (as in methods)
         if {[llength $args] > 1} {
                 return -code error "wrong # args: should be \"$self clone ?cloneName?\""
         set new [uplevel 1 [list ::eos:: {*}$args]]
         set conf [namespace ensemble configure $self]
         set conf [dict remove $conf -namespace]
         dict for {slot meth} [dict get $conf -map] {
             if {[lindex $meth end] eq $self} {
                 dict set conf -map $slot [lreplace $meth end end $new]
         namespace ensemble configure $new {*}$conf
         return $new

     proc *delete {self} {
         uplevel 1 [rename $self {}]

Dispatch is very fast (but getting the value of constant slots less so). For comparison with standard proc dispatching:
 % ::eos:: toggle
 % toggle method self {} {return $self}
 % toggle self
 % time {toggle self} 1000
 8.049 microseconds per iteration
 % proc a x {return $x}
 % time {a dummy} 1000
 5.287 microseconds per iteration

Note that delegation is easy (to other eos objects, or actually to any other command or object): it suffices to define the default method
 proc ::eos::*delegate {source method target args} {
     set target [uplevel 1 [list namespace which -command $target]]
     *slot $source $method $target {*}$args

However, this is properly the field for an extension of the system: delegation should be combined with proper lifetime management of whatever sub-object might be created for the purpose of delegation.

It is also relatively simple to save values in backup variables - managed by traces. The advantages are speed of writing (see below), and also the possibility of putting traces on the variables.

A first cut at an implementation could be
 namespace eval eos {
     variable nvars 0 vars {}
     proc deleteTrace {self args} {
         variable vars
         unset {*}[dict values [dict get $vars $self]]
         dict unset vars $self
     proc *unset {self varname} {
         variable vars
         if {[dict exists $vars $self]} {
             set myvars [dict get $vars $self]
             if {[dict exists $myvars $varname]} {
                 unset [dict get $myvars $varname]
                 dict unset myvars $varname
                 if {![dict size $myvars]} {
                     dict unset vars $self
                     trace remove command $self delete ::eos::deleteTrace
                 } else {
                     dict set vars $self $myvars
         set map [dict remove [*config $self -map] $varname]
         *config $self -map $map

     proc *variable {self varname args} {
         set len [llength $args]
         if {$len > 1} {
             return -code error "wrong # args: should be \"$self variable varname ?value?\""
         variable vars
         set map [*config $self -map]
         if {$len == 0} {
             if {[dict exists $vars $self $varname]} {
                return [dict get $vars $self $varname]
            } else {
                return -code error "there is no variable called \"$varname\""
         variable nvars 
         set [set v ::eos::VAR[incr nvars]] [lindex $args 0]
         if {![dict exists $vars $self]} {
             trace add command $self delete ::eos::deleteTrace
         dict set vars $self $varname $v
         *slot $self $varname ::set $v

The following file times different implementations of an object that has an internal 0/1 state, and a method "activate" that toggles it.
 source eos.tcl
 set res {}
 ::eos:: toggle
 toggle value state 1
 # Using default method 'value'
 toggle method activate {} {$self value state [expr {![$self state]}]}
 time {toggle activate} 1000
 lappend res [time {toggle activate} 1000]
 # Using obj's method 'value'
 toggle method value {slot v} {::eos::*slot $self $slot ::eos::const $v; set v}
 lappend res [time {toggle activate} 1000]
 # Using delegated method 'setstate'
 toggle method activate {} {$self setstate [expr {![$self state]}]}
 toggle delegate setstate ::eos::*slot ::toggle state ::eos::const
 lappend res [time {toggle activate} 1000]
 # delegating to a namespace variable
 toggle variable state 1
 toggle method activate {} {$self state [expr {![$self state]}]}
 lappend res [time {toggle activate} 1000]
 toggle delete
 foreach l $res {puts $l}

the results are
 65.525 microseconds per iteration
 49.12 microseconds per iteration
 47.055 microseconds per iteration
 20.583 microseconds per iteration

(further tests show that external variables are not really faster for reading, only for writing. The constraining speed is in ::eos::*slot, a [namespace ensemble configure $cmd -editmap] that does [dict replace] and [dict remove] in place would make a lot of difference.