Updated 2013-09-07 16:23:45 by RLE

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