[Self Programming Language%|%SELF] is a [Prototype pattern in
Tcl%|%prototype]-based [object orientation%|%OO] language that uses objects
that only have slots.  This page describes the Self extension.



** See Also **

   [Selfish]:  a pure Tcl extension which inspired this extension


** Description **

[MJ]:  In a recent (2006-10) [object orientation%|%OO] frenzy on the [Tcl chatroom] resulting in code gems like [neo] and [eos], I decided to write a  [SELF]-like extension for Tcl. 

The resulting C extension can be downloaded from [http://marknet.tk/wiki/tcl/self].

After loading the extension, one object (Object) is known and the three commands (''self'', ''next'' and ''super'') are imported. Every other object in the system will be cloned from Object or its clones and will have slots defined containing values or methods.

'''Object'''

The generic prototype Object can be used to create new objects with ''clone''. The generic object contains the following slots:

   * clone new: creates a new object with name $new
   * slot ''name'' ''value'': create a value slot that will return $value if called without arguments and set the value if called with one argument
   * slot ''name'' ''args'' ''body'': will create a method slot
   * slots: returns a list of all the defined slots on the object
   * destroy: will destroy the object
   * parents*: contains a list with all the parents of the object. This information is used for method dispatch. Object initially has no parents. Note that the parents* slot can be a value slot (as it is by default) TODO or a method slot which can allow dynamic inheritance hierachies as long as a list of objects is returned.

'''Cloning'''

clone will create a new object with only the parents* slot defined. The parents* slot will contain the name of the receiver of the clone message. The parents* slot will be used in slot dispatch resulting in inheritance and can be updated during runtime, allowing for mixin-like behaviour.

''cloned object''
    * parents* {receiver of the clone message}    

'''Command dispatch'''

Slots are executed by sending messages to the object. A depth-first search of the object and the parents* list will be done to find the implementation of a slot. When a slot is found the slot is executed in the context of the object receiving the message. If no implementation of a slot is found, the dispatcher tries to call an ''unknown'' slot with the slotname and arguments as args. If that also fails, a standard error is returned.
During evaluation of a slot, three additional commands are available:

   * self ''slotname'' ''args'': will call slot $slotname on the receiver of the initial message. Without arguments it will return the name of the receiver.
   * next: will call the same slot with the same args as currently executing, but the dispatcher will start looking for the slot only in the parents of the implementor of the currently executing slot, which is not the same as self for inherited slots.   
   * super ''slotname'' ''args'': will call a different slot $slotname on the parents of the implementor of the currently executing slot.

'''Problems'''

Currently there are some missing features which would be nice to have when using the extension:

   * Variable slots are not real variables, so it is not possible to add traces to them.
   * Currently method dispatch in a very deep parent child chain is slow. Doing dispatch on a slot that is defined 999 objects higher in the inheritance tree takes approximately 1000 microseconds on my machine, where as in the [TIP] 257 [http://wiki.tcl.tk/14754] implementation it takes only 12. This can be resolved using slot/call chain caching.   
   * It would be nice to be able to delegate methods based on their signature (an unknown on steroids), which is very useful for building [megawidget]s. For instance:

 a slot delegate* {}
 a delegate* {{cget .t} {* {self unknown}}}
 # the unknown slot is now a normal slot.
 # delegates will be called with the slotname and args

'''Examples'''

 package require self
 
 # create a Point object.
 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] ([self x],[self 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} {
  self 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

 # 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]

'''Intercepting slot calls for debugging purposes'''
 
 Object clone A
 A slot test args {return}
 
 A clone a
 a test

 A clone debug
 debug slot test {args} {puts "called test with $args"; next}
 
 a parents* {debug}
 a test 1 2 3

'''Demonstrating unknown to create a read-only text widget''' 

======
 # example demostrating how to override a widget
 package require self
 package require Tk

 proc debugtext name {
        text $name
        rename $name _$name
        Object clone $name
        $name slot unknown args {
           puts "[self] $args"
           _[self] {*}$args
        }
        $name slot destroy {} {
                destroy _[self]
                rename _[self] {}
                next
        }
        return $name
 }

 debugtext .t 

 pack .t -expand 1 -fill both
 
 button .b -text "Make readonly" -command make_ro
 pack .b
 
 proc make_ro {} {
  # allows on the fly redefining of behaviour
  .t slot insert args {puts stderr "readonly"}
  .t slot delete args {puts stderr "readonly"}
 }
======

----
With all of these [Self]-like extensions, is it possible to make singleton objects by removing the clone function?
Does that even make sense for prototype-based object systems? -- [escargo] 20 Oct 2006

[NEM]: A singleton would just be an object. Perhaps an example of what you would be
using the singleton for would be useful? I tend to avoid singletons. About the only
place I use them is when defining the base case of some structure (e.g., if you
define a binary search tree as two cases: Branch(left,right,val) and
Empty, then the Empty case can be a singleton).

[MJ]: As [NEM] already mentions above, a singleton only makes sense in a class based OO system where you want to instantiate a class only once. In a prototype based OO system everything is a singleton (there are no classes). However if you just want to disallow cloning of a specific object you can use the fact that clone is just a slot and redefine it e.g.:
 
 % Object clone a
 % a slot clone {args} {error "cannot clone"}
 % a clone b
 cannot clone
----
[NEM]: I've not tried the implementation yet, but I very much like the specification of this
extension. If I make a slot contain an object, what is the syntax for sending messages to that
object? From your description, it sounds like it would be something like:
 MyObj slot pos [Point create $x $y] 
 puts "pos = [[MyObj pos] to_s]"
Is that correct? Would it be possible to make it like the following?
 puts "pos = [MyObj pos to_s]"

[MJ]: In the point implementation from above that create call should actually be ''Point create pos $x $y'' (note that automatic clone naming is trivial to add in the clone slot). Apart from that, you are correct.  I guess it would be possible to implement this, but I cannot see a clear way to add this in the current implementation and not break anything else. It will certainly make slot dispatch more complicated; it has to do number of arguments checking for instance. Even figuring out if a slot contains another object is not straightforward in the current implementation. However, one could implement it with the existing functionality something like this:


======
 Object slot addChild {object} {
   self slot $object {slot args} "return \[$object \$slot \{*\}\$args \]"   
 }

 Object clone a   
 Object clone pos

 pos slot to_s {} {return "I am [self]"}
 a addChild pos
 puts [a pos to_s]

 # even nested 
 Object clone b
 b slot to_s {} {return "I am [self]"}
 pos addChild b

 puts [a pos b to_s]

Or more elaborate:

 package require self

 Object slot children* {}

 Object slot addChild {name object} {
   self slot $name {slot args} "return \[$object \$slot \{*\}\$args \]"
   self children* [lappend [self children*] $object]
 }


 Object slot delete {} {
    foreach child [self children*] {
        $child delete
    }
    self destroy
 }

 Object clone Point

  Object slot to_s {} {
  return "[self]"
 }

 namespace eval self {
  namespace eval objs {
   variable counter
  }
 }

 Point slot x {args} {error "abstract slot, override in clone"}
 Point slot y {args} {error "abstract slot, override in clone"}

 Point slot to_s {} {
  return "id: [next] ([self x],[self y])"
 }

 Point slot create {x y} {
  set obj [self clone ::self::objs::obj[incr ::self::objs::counter]]
  $obj slot x $x
  $obj slot y $y
  return $obj
 }

 Object clone MousePointer
 MousePointer addChild pos [Point create 130 140]
 
 MousePointer pos x
 MousePointer pos to_s
 
 MousePointer delete
 # child is gone
 info commands ::self::objs::*
======

On a side note, implementing something like this will take away some of the simplicity of the design IMO and I have tried to make the extension as simple as possible while still offering enough flexibility.

[Zarutian] 15:35 26. oktober 2006 UTC: I find this extension intresting but I havent tried it out yet but plan to do just that.

<<categories>> Package | Object Orientation