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
% 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 {*}$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 are65.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.
