Self is a prototype-based OO language that uses objects that only have slots. This page presents a Tcl package by the same name that was inspired by Self.
(For the self TclOO command, see self - TclOO)
MJ: In a recent (oct-2006) OO frenzy on the Tcl chatroom resulting in code gems like neo and eos, I decided to write a Self-like extension for Tcl.
Initially this was a C extension to allow payload with procedure definitions. But I have rewritten it in plain Tcl using [interp alias] available from https://github.com/mpcjanssen/self
After loading the extension, one object (Object) is known and the two commands (self and next) are imported. Every other object in the system will be cloned or copied 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 or copy. The generic object contains the following slots:
NB: The slot assignment syntax has be changed from slot name to name: to be less verbose and better in line with Self.
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
Copying
copy will create an exact copy of the receiver (in other words: _state is exactly the same).
Command dispatch
Slots are executed by sending messages to the object. A depth-first search of the object slots 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:
Problems
Currently there are some missing features which would be nice to have when using the extension:
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 argsExamples
package require self
# create a Point object.
Object clone Point
# add a to_s slot to display information of the object
Object to_s: {} {
return "[self]"
}
# add x and y slots for the point, notice that these slots cannot be called for now.
Point x: {args} {error "abstract slot, override in clone"}
Point y: {args} {error "abstract slot, override in clone"}
# extend default behavior from parent (Object)
Point 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 create: {name x y} {
self clone $name
$name x: $x
$name 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 test: args {return}
A clone a
a test
A clone debug
debug test: {args} {puts "called test with $args"; next}
a parents*: {debug}
a test 1 2 3Demonstrating 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 unknown: args {
puts "[self] $args"
_[self] {*}$args
}
$name 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 insert: args {puts stderr "readonly"}
.t 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 clone: {args} {error "cannot clone"}
% a clone b
cannot cloneNEM: 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 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 addChild: {object} {
self $object: {slot args} "return \[$object \$slot \{*\}\$args \]"
}
Object clone a
Object clone pos
pos to_s: {} {return "I am [self]"}
a addChild pos
puts [a pos to_s]
# even nested
Object clone b
b to_s: {} {return "I am [self]"}
pos addChild b
puts [a pos b to_s]
Or more elaborate:
package require self
Object children*: {}
Object addChild: {name object} {
self $name: {slot args} "return \[$object \$slot \{*\}\$args \]"
self children* [lappend [self children*] $object]
}
Object delete: {} {
foreach child [self children*] {
$child delete
}
self destroy
}
Object clone Point
Object to_s: {} {
return "[self]"
}
namespace eval self {
namespace eval objs {
variable counter
}
}
Point x: {args} {error "abstract slot, override in clone"}
Point y: {args} {error "abstract slot, override in clone"}
Point to_s: {} {
return "id: [next] ([self x],[self y])"
}
Point create: {x y} {
set obj [self clone ::self::objs::obj[incr ::self::objs::counter]]
$obj x: $x
$obj 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 2006-10-26 15:35 UTC: I find this extension interesting but I haven't tried it out yet but plan to do just that.