'''MS''' (Miguel Sofer): Richard Suchenwirth's wonderful pages [On things], [Doing things], [Doing things in namespaces], [Toasters and things] got me thinking about these things; I like them a lot. While playing around, I tried some variants, and thought about sharing them. You'll find here a slightly modified version of [Doing things in namespaces]; important modifications are marked in the code by #-# comments. 1. '''a bug fix''' (and API change): in Richard's version, a ''way'' shadows a variable with the same name at the same or lower level; a variable shadows a way with the same name at a lower level. The effect is shown clearly (after running the test) by the command Socrates set sing badly This command does set a variable named ''sing'' for Socrates, but (a) it returns an error, and (b) the variable is not accessible through Socrates's ways ... In order to fix this, I eliminated the possibility of finding Socrates' number of legs by simply Socrates legs The usage of a way is now compulsory, you now DO have to Socrates set legs 2. '''an API extension''': added the capability to chain commands - i.e., to call a same-named way at lower levels. For instance Socrates wayto sing { {- text} { subst "$text-haha, but also [::thing::chain $text]" } } will substitute the human song for the expression in brackets ... 3. '''slight API change''': the names of currently existing things can be retrieved by either of namespace children ::thing ::thing::names The list ::thing::names does not exist any longer ... 4. '''didactical changes''': I thought it interesting to restructure the file so that the properties of ''thing'' are defined using a minimal infrastructure and defining new properties via ''thing wayto ...''. Added some comments. 5. '''attempts at optimisation''': some slight changes - no really noticeable effect though ... 6. '''cosmetic changes''': these are (of course) quite personal ... ---- '''ON THING (object) AGGREGATION''' (comments here are '''particularly''' appreciated) Things as defined here (as modified today) are created at global scope; if a fully qualified name is given (and the corresponding namespace already exists), the thing will be created in that namespace. Same-named things in different namespaces will not collide if they were created using fully qualified names. In this sense thing aggregation is already present in this model: namespace eval ::realEstate {} thing new ::realEstate::house3 namespace eval ::realEstate::house3 {} thing new ::realEstate::house3::kitchen creates the things ::realEstate::house3 and ::realEstate::house3::kitchen; their vars and ways live under ::thing::realEstate::house3 and ::thing::realEstate::house3::kitchen respectively. It is easy to extend this behaviour to allow for correct thing creation when given a relative name, in the manner of namespace eval ::realEstate { thing new house3 } namespace eval ::realEstate::house3 { thing new kitchen } However, I do not quite like this behaviour, and am thinking about alternatives. What I dislike is: * the existence of TWO different namespaces for the same thing (one at ::, the other at ::thing) * the extra parsing load for method calling * the fact that the structure under ::thing lost its simplicity * the fact that some namespaces under ::thing do not correspond to things - in the example, ::thing::realEstate (assuming ::realEstate is a ''bona-fide'' namespace, and not a thing) So, I think it would be better to have a SINGLE namespace containing the aggregated things. I have been exploring the possibility of ''auto-numbering'' things at creation time, so that the 'real name' of a thing is an ID - different from the calling command. For instance, this would mean that %info body thing ::thing::dispatch 0 $way $args instead of the present %info body thing ::thing::dispatch thing $way $args In this model, the example above could be generated via an API like namespace eval ::realEstate { thing new house3 house3 addChild thing new kitchen } generating for instance the namespaces ::thing::25 and ::thing::26 and a proc ::thing::25::kitchen Now the sub-thing "kitchen" is a wayto of house3, so that you would call ::realEstate::house3 kitchen set heatSource electricity or namespace eval ::realEstate { house3 kitchen set heatSource electricity } What I like about this one is: * all things live directly under ::thing - simple structure * everything under ::thing IS a thing * sub-things are simply waytos of the containing thing * it is easy to move things from one container to the other - it rarely happens that kitchens are moved, but football players do switch teams ... What I dislike about this one is: * it generates recursive calls to the dispatcher * it is difficult to introspect - distinguish between 'real waytos' and sub-things? * things require an additional variable (@name maybe) to store the name of the command PLEASE enter your thoughts right here: ---- '''NOTES ON USAGE AND CAPABILITIES''' Remark that the ''is-a'' list controls the search path for ways and variables; you can actually do anything you want with it - at your own risk! Some creative uses might be * prepend another thing to obtain a ''mixin'' behaviour (the ways and variables of the prepended thing will have priority over the own ones; these are reachable via ::thing::chain) * insert other things to obtain the effect of ''multiple inheritance'' with a clearly defined priority path ---- '''THE CODE''' (revised 15-dec-2000) ====== ####################################################################### # The very basic infrastructure ####################################################################### catch {namespace delete ::thing} ;# good for repeated sourcing in tests namespace eval thing { proc dispatch {name way lst} { # This is the core of the "things" engine set level 0 foreach i [set ::thing::${name}::is-a] { if [llength [info command [set cmd ${i}::$way]]] { return [eval $cmd $name $lst] } incr level; #-# we now count the levels } error "$way? Use one of: [join [Info $name command] {, }]" } proc chain {args} { #-# new proc, almost the same as dispatch! upvar 2 name name level level0 way way set level [expr {$level0 + 1}] foreach i [lrange [::set ::thing::${name}::is-a] $level end] { if [llength [info command [set cmd ${i}::$way]]] { return [eval $cmd $name $args] } incr level } } proc get {name var} { #-# new proc, avoids the shadowing effect foreach i [set ::thing::${name}::is-a] { if [llength [info vars [set nvar ${i}::$var]]] { return [set $nvar] } } error "$var? No such property for $name" } #-- create "basic things": they can ONLY get new ways ... proc wayto {self way lambda} { # way to define a new way. eval proc ::thing::${self}::$way $lambda } namespace export wayto proc new {name} { namespace eval ::thing::$name { namespace import ::thing::wayto } ::set ::thing::${name}::is-a $name trace var ::thing::${name}::is-a u "::rename ::$name {};#" proc ::$name {{way ""} args} "::thing::dispatch $name \$way \$args" } #----------------------------- some helpers for introspection proc names {} { foreach i [namespace children ::thing] { regsub ::thing:: $i "" name lappend names $name } lsort $names } proc Info {name what} { # retrieve all own and inherited procs/properties of 'name' foreach i [set ::thing::${name}::is-a] { foreach j [info $what ::thing::${i}::*] { regsub ::thing::${i}:: $j "" j2 set res($j2) {} } } lsort [array names res] } proc lambda {name way} { # retrieve [list argl body] for way of thing name #-# it builds a list, not a string foreach i [set ${name}::is-a] { if [llength [set proc [info command ${i}::$way]]] { foreach i [info args $proc] { if [info default $proc $i value] { lappend args [list $i $value] } else { lappend args $i } } return [list $args [info body $proc]] } } error "$way? No way for $name" } } ####################################################################### # Create the minimal thing: it can ONLY get new ways ... ####################################################################### ::thing::new thing ####################################################################### # giving thing some capabilities ... # ------------------------------------------- # 1: deal with itself: reproduce, suicide # thing wayto new { {self name args} { #way to create a new thing 'name' that is-a 'self' if [llength [::info command ::$name]] { error "can't create thing $name: command exists" } ::set t [concat $name [::set ::thing::${self}::is-a]] namespace eval ::thing::$name variable is-a [list $t] trace var ::thing::${name}::is-a u "::rename $name {};#" #--------- so it can be called by name proc ::$name {{way ""} args} "::thing::dispatch $name \$way \$args" foreach {key value} $args {$name set $key $value} ::set name } } thing wayto clone { {self name args} { eval $self new $name [$self] $args namespace eval ::thing::$name "::set is-a \[lreplace \${is-a} 0 0 $name\]" ::set pre ::thing::${self} foreach i [::info proc ${pre}::*] { regsub ${pre}:: $i "" i2 ::thing::wayto $name $i2 [$self wayto $i2] } if {[llength [::info proc ${pre}::wayto]]} { if {[::set orig [namespace origin ${pre}::wayto]] != $pre} { ::rename ::thing::${name}::wayto ::"" namespace eval ::thing::${name} namespace import ${orig} } } ::set name } } thing wayto delete { {self} { namespace delete ::thing::$self } } # ------------------------------------------- # 2: deal with internal variables: set, unset # thing wayto set { {self args} { #way to set, retrieve, or list properties switch [llength $args] { 1 {return [::thing::get $self [lindex $args 0]]} 2 { foreach {name value} $args { return [::set ::thing::${self}::$name $value] } } 0 {return [::thing::Info $self vars]} default {error "Usage: $name set ?name ?value??"} } } } thing wayto unset { {self args} { foreach i $args {::unset ::thing::${self}::$i} } } #---------------------------------------------------------- # 3: rename ways, remove unneeded ones # thing wayto rename { {self way newWay} { if {$newWay == ""} { namespace inscope :: rename ::thing::${self}::$way {} } else { set ns ::thing::$self ::rename ${ns}::$way ${ns}::$newWay } } } #---------------------------------------------------------- # 4: introspection, and an introspecting wayto # thing wayto wayto { {self args} { # way to define a, retrieve a, or list every way available foreach {way lambda} $args break switch [llength $args] { 1 {return [::thing::lambda $self $way]} 2 { eval proc ::thing::${self}::$way $lambda return $lambda } 0 {return [::thing::Info $self command]} default {error "Usage: $self wayto ?name ?lambda??"} } } } thing wayto is-a { {self} { ::set ::thing::${self}::is-a } } thing wayto {} { {self} { # empty way: pairlist of all property names and values ::set res [list] foreach i [lsort [::info var ::thing::${self}::*]] { regsub ::thing::${self}:: $i "" i2 lappend res $i2 [::set $i] } ::set res } } thing wayto which { {self name} { # way to know where a property or way came from foreach i [::set ::thing::${self}::is-a] { if [llength [::info command ::thing::${i}::$name]] { return $i } if [::info exists ::thing::${i}::$name] { return $i } } error "no $name for $self known" } } thing wayto info {{self what} {::thing::Info $self $what}} #----------------------------------------------- now testing... proc test {} { set test { thing new human legs 2 mortal 1 human new philosopher philosopher new Socrates hair white Socrates set mortal Socrates set legs Socrates set legs Socrates set legs 3 Socrates set legs Socrates unset legs Socrates set legs Socrates set beard long Socrates set human wayto sing {{- text} {subst $text,$text,lala.}} Socrates sing Kalimera Socrates wayto sing {{- text} {subst $text-haha}} Socrates sing Kalimera [thing new Plato] wayto sing [Socrates wayto sing] Plato sing Kalispera [human new Joe] sing hey Socrates Socrates wayto sing {{- text} {subst "[::thing::chain $text-haha], $text-haha"}} Socrates sing Kalimera } set n 0 foreach i [split $test \n] { puts -nonewline [incr n]$i=> puts [uplevel $i] } puts OK } time test ====== <> Object Orientation