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:: {expand}$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 {expand}$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
% toggle method self {} {return $self}
% toggle self
::toggle
% time {toggle self} 1000
8.049 microseconds per iteration
% proc a x {return $x}
% time {a dummy} 1000
5.287 microseconds per iterationNote 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
}To use this in the above example, one could have defined
toggle method activate {} {$self setstate [expr {![$self state]}]}
toggle delegate setstate ::eos::*slot ::toggle state ::eos::constHowever, 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 access (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 {expand}[dict values [dict get $vars $self]]
dict unset vars $self
}
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]} {
set myvars [dict get $vars $self]
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 $map $varname]
*config $self -map $map
return
}
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
}
}Timings: running the file
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