[MJ] - Will add some documentation here.

 package require TclOO
 namespace import ::oo::*
 
 namespace eval self {
   namespace export Object
   namespace eval _ {
     proc create_prototype {name parent} {
       # doesn't work: class create ::self::cl::$name [list mixin $parent]
       class create ::self::cl::$name [list superclass $parent]
       oo::define ::self::cl::$name destructor {
         [self class] destroy
       }
       namespace eval :: [list ::self::cl::$name create $name]
     }
   }
 }
 
 class create ::self::cl::Object {
   method clone name {
     ::self::_::create_prototype $name [oo::InfoObject class [self]]	
   }
 
   method slot {name arg {body {}}} {
     if {$body eq {}} {
       ::oo::define [oo::InfoObject class [self]] method $name {} [list return $arg]
       set body  "[self] slot [list $name] \$val"
       ::oo::define [oo::InfoObject class [self]] method $name: {val} $body
     } else {
       ::oo::define [oo::InfoObject class [self]] method $name $arg $body
     }
   }
 
   method slots {} {
     oo::InfoClass methods [oo::InfoObject class [self]]
   }
 
   method parents* {{new {}}} {
     oo::InfoClass mixins [oo::InfoObject class [self]]
   }
 }
 
 
 ::self::cl::Object create ::self::Object
 
 package provide self 0.6
 
 puts "#### Examples ####"
 namespace import ::self::Object
 
 Object clone test
 
 test slot test {} {puts "test slot in [self]"}
 test slot nop {} {#}
 
 test test
 puts "test slots: [test slots]"
 
 test destroy
 
 puts "#### Point demo ####"
 
 
 Object clone Point
 
 # add a to_s slot to display information of the object
 Object slot to_s {} {
   return "[self]"
 }
 
 
 # add x and y slots for the point, notice that these slots cannot be called for now.
 Point slot x {args} {error "abstract slot, override in clone"}
 Point slot y {args} {error "abstract slot, override in clone"}
 
 # extend default behavior from parent (Object)
 Point slot to_s {} {
   return "id: [next] ([my x],[my y])"
   # Here next will search for a slot named to_s in the parents of the implementor of the current method (Point)
   # finding the Object slot to_s and the execute it in the context of the receiver (which will be a clone of Point)
 }
 
 # define a point factory
 Point slot create {name x y} {
   my clone $name
   $name slot x $x
   $name slot y $y
 }
 
 # clone a Point
 Point clone p1
 
 # to_s will fail because the x and y slots in Point are called
 catch {p1 to_s} err
 puts $err
 
 p1 destroy
 
 # use the Point factory which will define x and y slots
 Point create p1 0 0
 
 # to_s will now work
 puts [p1 to_s]
 
 p1 x: 12
 puts [p1 to_s]
 
 puts "##### Benchmarks #####"
 puts "clone/destroy: [time {Object clone a ; a destroy} 1000]"
 Object clone test0
 test0 slot nop {} {#}
 
 for {set i 0} {$i < 999} {} {
   test$i clone test[incr i]
 }
 
 puts "nested slot dispatch 999 deep: [time {test999 nop} 1000]"