'''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]'.

This here is a second version: twice as fast in the methcall benchmark, backed by a namespace array. The original is at [eos original].
----
'''eos''' is a slot based system. It provides ''cloning''.

''To be continued ...''

 namespace eval eos {
      variable nobjs 0
      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?\""
          }
          variable nobjs
          incr nobjs
          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$nobjs
          }
          set var ::eos::OVAR$nobjs
          array set $var [list *var $var]
          uplevel \#0 [list namespace ensemble create \
                         -command $name \
                           -map [dict create *var [list ::set ${var}(*var)]]  \
                         -unknown ::eos::unknown\
                         -prefixes 0\
                        ]
          trace add command $name delete "::unset $var;\#"
          return $name
      }
 
      # 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 args} {
         if {[llength $args]} {
             *slot $self $slot ::set [$self *var]($slot)
             return [$self $slot [lindex $args 0]]
         }
         *slot $self $slot
         unset -nocomplain [$self *var]($slot)
      }
 
     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:: {expand}$args]]
         set selfvar [$self *var]
         set newvar  [$new *var]
         array set $newvar [array get $selfvar]
         set conf [*config $self]
         set conf [dict remove $conf -namespace]
         set pat ${selfvar}\(*
         set selfend [expr {[string length $selfvar] -1}]
         dict for {slot meth} [dict get $conf -map] {
             set last [lindex $meth end]
             if {$last eq $self} {
                 dict set conf -map $slot [lreplace $meth end end $new]
             } elseif {[string match $pat $last]} {
                 set mod [string replace $last 0 $selfend $newvar]
                 dict set conf -map $slot [lreplace $meth end end $mod]
             }
         }
         *config $new {expand}$conf
         $new value *var $newvar
         return $new
     }
 
     proc *delete {self} {
         uplevel 1 [rename $self {}]
     }
 }

----
This thing is ''very fast'': running the methcall benchmarks (see [Comparing Performance of Tcl OO extensions]) I get
 xotcl:   2.47user 0.01system 0:02.63elapsed 94%CPU 
 stooop:  4.81user 0.01system 0:04.93elapsed 97%CPU 
 eos0:    4.44user 0.00system 0:04.54elapsed 97%CPU 
 eos:     2.06user 0.00system 0:02.16elapsed 95%CPU 
Note that is slughtly unfair: both [XOTcl] and [stooop] are dispatching via inheritance, '''eos''' is cloning.

The code running in eos is
 source eos.tcl

 ::eos:: Toggle
 Toggle method activate {} {$self state [expr {![$self state]}]; return $self}
 Toggle value state 1

 Toggle clone NthToggle
 NthToggle value max 3
 NthToggle value counter 0
 NthToggle method activate {} {
     $self counter [expr {[$self counter]+1}]
     if {[$self counter]>=[$self max]} {
	 $self state [expr {![$self state]}]
     }
     return $self
 }

 proc main {n} {
     set val 1
     set toggle [Toggle clone]
     $toggle state 1
     for {set i 0} {$i<$n} {incr i} {
	 set val [[$toggle activate] state]
     }
     if {$val} {puts true} else {puts false}
     $toggle delete
     set val 1
     set ntoggle [NthToggle clone]
     $ntoggle state 1
     $ntoggle max 3
     for {set i 0} {$i<$n} {incr i} {
 	set val [[$ntoggle activate] state]
     }
     if {$val} {puts true} else {puts false}
     $ntoggle delete
 }
 main [expr {$argc==1?[lindex $argv 0]:1}]
----
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 {expand}$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.
----
[Category Object Orientation]