, which I found quite informative somewhere along my way into Tcl, and from there have distilled into an updated take on how to create such systems. This walkthrough serves both as a tutorial on creating a particular object system, and as an introduction to the facilities provided by namespace.The primary principles of the system presented below are:- A namespace ensemble is the interface to the object. It is also the name of the object, i.e. the name of the namespace that represents the object.
- Each object command is registered in the namespace ensemble map such that a call to object command is a call to a dispatcher that resolves and calls the actual command, passing it the name of the current object.
- namespaces that contribute commands to the object are accessed through the namespace path of the object.
}
proc ====== args {
# This proc is just for wiki formatting purposes
}namespace eval timer {
proc [namespace current] name {
set _ [uplevel 1 [list namespace eval $name {namespace current}]]
namespace eval $_ {
if 0 {Define the interface of the object by adding commands to the ensemble map. } ::apply [list {} {
foreach action {elapsed lap running start stop} {
dict set map $action [list ::apply [list {_ action args} {
tailcall $action $_ {*}$args
} [namespace current]] [namespace current] $action]
}
namespace ensemble create -map $map
} [namespace current]]
# Initialize the object data
variable elapsed [expr 0]
variable running [expr 0]
variable start [expr -1]
namespace current
}if 0 {To determine the vartimer namespace, look at the namespace and name of the current procedure. Then add the vartimer namespace to the path of the new object. } namespace eval $name [list namespace path [list [
namespace current]::[namespace tail [lindex [
info level 0] 0]] {*}[namespace eval $name {namespace path}]]]
return $_
}
# [start], [stop], [elapsed], and [running] will live in this namespace as well
}if 0 {apply and tailcall are used to avoid adding an extra level to the interpreter when the subcommand is called. If namespace code didn't add that level, the above could be written like this instead: }# This code is a non-working example
if 0 {
namespace ensemble create -map [dict create \
elapsed [namespace code elapsed [namespace current] {*}$args] \
running [namespace code running [namespace current] {*}$args] \
start [namespace code start [namespace current] {*}$args] \
stop [namespace code stop [namespace current] {*}$args] \
]
}if 0 {To create a new timer:}timer timer1if 0 {The next step is to implement the commands. Although timer1 already exists as these commands are created, they implement the functionality of timer1: }
namespace eval timer {
proc lap _ {
namespace upvar $_ elapsed elapsed start start
expr {[clock clicks] - $start}
}
proc elapsed _ {
namespace upvar $_ elapsed elapsed
$_ stop
$_ start
return $elapsed
}
proc running _ {
namespace upvar $_ running running
return $running
}
proc stop _ {
namespace upvar $_ elapsed elapsed running running start start
set running [expr 0]
set elapsed [expr {$elapsed + [$_ lap]}]
set start [expr -1]
return $elapsed
}
proc start _ {
namespace upvar $_ running running start start
if {$start == -1} {
set start [clock clicks]
}
}
}if 0 {namespace upvar is used to access object data.Now, to test it out: }timer1 start after 2000 puts [timer1 elapsed]if 0 {Deriving another kind of timer from this one is a matter of manipulating the map and the namespace path in the new timer creator: }
namespace eval vartimer {
proc [namespace current] name {
set _ [uplevel 1 [list [namespace which timer] $name]]if 0 {Add the path of vartimer1 to the new object:} namespace eval $_ [list namespace path [list [namespace current]::[
namespace tail [lindex [info level 0] 0]] {*}[
namespace eval $_ {namespace path}]]]if 0 {Extend the interface with some new commands:}
set map [namespace ensemble configure $_ -map]
foreach action {faster slower} {
dict set map $action [list ::apply [list {_ action args} {
tailcall $action $_ {*}$args
} $_] $_ $action]
}
namespace ensemble configure $_ -map $map
namespace eval $_ {
variable factor 1.0
}
return $_
}if 0 {Define the commands that provide the new functionality: } proc faster _ {
namespace upvar $_ factor factor
set factor [expr {$factor * 1.25}]
}
proc slower _ {
namespace upvar $_ factor factor
set factor [expr {$factor * .25}]
}if 0 {lap overrides the previous lap, but still uses it internally. It's not very elegant to call timer directly. Later on, we'll add a more general mechanism for calling the shadowed command. } proc lap _ {
namespace upvar $_ factor factor elapsed elapsed
set lap [[namespace which timer]::lap $_]
set elapsed [expr {$elapsed + ($lap * $factor)}]
}
}if 0 { Now to try it out:}vartimer timer2 timer2 faster timer2 faster timer2 start after 2000 puts [timer2 elapsed]if 0 {Now comes the fun part: Taking the functionality sketched out above and packaging it into a general system that's convenient to use. This increases the complexity of the implementation, of course, but makes it easier to compose and manage objects. To make something that's friendly to use, as well as more orthogonal, a few things will have to change. First, the basic functionality is encapsulated into a primordial object, the thing from which all other objects spring. This object will be a namespace ensemble, so it will no longer be possible to call it directly to create new objects. Instead, it will have an object command, new, for that purpose. The two most basic things an object should be able to do is configure what it is, and what it does. Thus, the next two commands to be implemented are is and does.Bootstrapping the first object in the known universe is always a little problematic, but in this case, it's not too bad, just a matter of calling a couple of commands directly instead of calling them through the object name, as all other objects will do.}
namespace eval object {if 0 {is mixes the commands of another object into this object by adding the path to that object into its own path, the other object's interface into its own interface.} proc is {_ what} {
if {![string match ::* $what]} {
set what [uplevel 1 [list namespace which $what]]
}
set _path [namespace eval $_ {namespace path}]
if {$what ni $_path} {
namespace eval $_ [list namespace path [list $what {*}$_path]]
}
set map_orig [namespace ensemble configure $_ -map]
set map_add [namespace ensemble configure $what -map]
namespace ensemble configure $_ -map [dict merge $map_add $map_orig]
}
if 0 {does just adds a command to the interface of the object.} proc does {_ args} {
if {[llength $args]} {
set map [namespace ensemble configure $_ -map]
foreach what $args {
if {[llength $what] == 2} {
lassign what what target
} else {
set target $what
}
dict set map $what [list ::apply [list {_ target args} {
tailcall $target $_ {*}$args
} $_] $_ $target]
}
namespace ensemble configure $_ -map $map
}
dict keys [namespace ensemble configure $_ -map]
}
proc init {_ args} {}
proc new {_ name} {
set name [uplevel 1 [::list namespace eval $name {
::namespace ensemble create
::namespace current
}]]
set map {}
if 0 { In the map, replace the name of the old Object with the name of the new object. This is the mechanism that "binds" commands to the object.} foreach {cmd target} [namespace ensemble configure $_ -map] {
set args [lassign $target apply function arg1]
set function [lreplace $function 2 2 $name]
set target [list $apply $function $name {*}$args]
dict set map $cmd $target
}
namespace ensemble configure $name -map $map
namespace eval $name [list namespace path [namespace eval $_ {namespace path}]]
$name is $_
$name does init
$name init
return $name
}
# bootstrap the system
namespace ensemble create
does [namespace current] is
does [namespace current] does
[namespace current] is [namespace current]
[namespace current] does new
}if 0 {Let's make a command to make it more convenient to evaluate scripts in the object namespace:}namespace eval object {
proc eval {_ args} {
::tailcall namespace eval $_ [join $args]
}
}
object does evalif 0 {Many object systems provide some way for an object command to call an object command by the same name in an ancestor object. Let's add one to the object. The \0 namespace is just used as an empty namespace separate from the normal object, that can be configured with the path of the object in order to look up the next command. Since the path of an object may change dynamically, it's best to grab that path and configure `\0' with it just before the lookup.}namespace eval object {
proc shadowed {_ args} {
set current [uplevel 1 {namespace current}]
set path [namespace eval $_ {namespace path}]
while {[set idx [lsearch -exact $path $current]] >= 0} {
set path [lreplace $path $idx $idx]
}
namespace eval \0 [list namespace path $path]
tailcall apply [list {_ cmd args} {
tailcall $cmd $_ {*}$args
} [namespace current]::\0] $_ {*}$args
}
}
object does shadowedif 0 { Now that the primordial object exists, it can be used to create another object as the timer:}#rename timer {}
object new timer
timer does lap elapsed running start stopif 0 {Create a command to initialize the timer:}timer eval {
proc init _ {
namespace upvar $_ elapsed elapsed running running start start
set elapsed [expr 0]
set running [expr 0]
set start [expr -1]
return $_
}
}
timer new timer1
timer1 start
after 2000
puts [timer1 elapsed]if 0 {To create a specialized timer, create a timer and then override the object commands to as needed:}timer new vartimer
vartimer does faster slower
vartimer eval {
proc init _ {
namespace upvar $_ factor factor
$_ shadowed init
set factor 1.0
}
}
vartimer new timer2
timer2 faster
timer2 faster
timer2 start
after 2000
puts [timer2 elapsed]if 0 {That's it. The object system presented on this page has a sufficient feature set to use in real projects. ycl shelf is built on many of these techniques, and features more bells and whistles.}
