SS: An interesting object oriented programming language, basic ideas comes from SmallTalk but SELF is more flexible and powerful, and probably even more pure.
SELF was used as test-bed for new ideas about compilation and virtual machines of very high level programming languages. More info at [L1 ] and [L2 ].
It should be possible to build an object-system for TCL that uses ideas from SELF, maybe it was already implemented. Please if you know more, or have some code to show, write it here.
RS wrote On things, which might interest you.
SS - great! it is pretty similar to SELF, I like the design RS used to add it to TCL.
Artur Trzewik - Some of SELF ideas are also included in XOTcl, that are mixins. Also in XOTcl the object has relative more importance than class. Classes are also objects and the relationship between objects and classes is dynamic. Self is prototype-based OO language but some of programing technigues one can good simulated with XOTcl mixins and filters. The manier how to program with SELF, is also implemented in XOTclIDE. That is interatively extent or change runing, "living" system. The same way Smalltalker are programming.
SS: I see a fundamental difference between SELF and XOTcl btw: SELF is simple, there is even no difference between a method and instance variable, everything is a slot, and there are many other semplifications like no classes at all. On the exact contrary XOTcl has a lot of concepts, so I think the essence is very different, while of course with every kind of OO-related feature you can fake the coding way of prototype based systems, class based systems and so on.
MJ -- Basic implementation of a self like OO system in plain Tcl. Supports super, self and slot in slot bodies. Furthermore it allows object aggregates with addChild so that the children will be cleaned up when the object containing the children is destroyed. If a slot cannot be found, the unknown slot is called on the object receiving the message.
# parents* for method dispatch
# children* for aggregated objects
proc Object {args} {
set self [lindex [info level 0] 0]
set slot [lindex $args 0]
set obj $self
if {[info exists ::${self}($slot)]} {
return [apply [set ::${self}($slot)] {expand}[lrange $args 1 end]]
}
set ancestors [$self parents*]
set visited {}
while {true} {
set obj [lindex $ancestors 0]
if {$obj eq ""} {
break
}
# keep a visited objects list to prevent circular lookups
if {[lsearch -exact $visited $obj]>-1} {
set ancestors [lrange $ancestors 1 end]
continue
}
lappend visited $obj
set ancestors [list {expand}[lrange $ancestors 1 end] {expand}[::$obj parents*]]
if {[info exists ::${obj}($slot)]} {
return [apply [set ::${obj}($slot)] {expand}[lrange $args 1 end]]
}
}
$self unknown {expand}$args
}
set _nr 0
proc self {args} {
set self [uplevel 2 {set self}]
if {[llength $args]==0} {
return $self
} else {
return [uplevel 1 [list $self {expand}$args]]
}
}
proc slot {} {
uplevel 2 {set slot}
}
proc super {args} {
set currObj [uplevel 2 {set obj}]
set slot [uplevel 2 {set slot}]
set tmp [Object clone]
$tmp valueSlot parents* [$currObj parents*]
set err [catch {$tmp $slot {expand}$args} res]
$tmp destroy
if {$err} {
error $res
} else {
return $res
}
}
set Object(slot) {
{name args body} {
set ::[self]($name) [list $args $body]
return $name
}
}
Object slot valueSlot {name value} {
[self] slot $name {args} [list if {[llength $args] == 0} [list return $value] else {[self] valueSlot [slot] [lindex $args 0]}]
return $value
}
Object valueSlot parents* {}
Object valueSlot children* {}
Object slot clone {{new {}}} {
if {$new eq {}} {
set new _o[incr ::_nr]
}
# we need the parent slot before we can do any method dispatch
set ::[set new](parents*) [list {} [list return [self]]]
set ::[set new](children*) [list {} {return}]
proc $new args [info body [self]]
return $new
}
Object slot destroy {} {
foreach child [self children*] {$child destroy}
unset ::[self]
rename ::[self] {}
}
Object slot slots {} {
return [lsort [array names ::[self]]]
}
Object slot addParent {parent} {
set parents [list $parent {expand}[self parents*]]
self valueSlot parents* $parents
}
Object slot print {} {
puts "Object: [self]\n parents: [self parents*]\n slots: [self slots]\n children [self children*]"
}
Object slot addChild {slot child} {
self valueSlot $slot $child
set children [self children*]
lappend children $child
self valueSlot children* $children
}
Object slot unknown {args} {
error "slot \"[lindex $args 0]\" not defined for [self]"
}
package provide self 0.1examples
source ./self.tcl
Object clone Point
Point slot create {x y} {
set obj [self clone]
$obj valueSlot x $x
$obj valueSlot y $y
return $obj
}
Object clone Line
Line slot create {p1 p2} {
set obj [self clone]
$obj addChild p1 $p1
$obj addChild p2 $p2
return $obj
}
Line slot length {} {
set dx [expr {[[self p1] x] - [[self p2] x]}]
set dy [expr {[[self p1] y] - [[self p2] y]}]
return [expr {sqrt($dx*$dx + $dy*$dy)}]
}
set l [Line create [Point create 0 0] [Point create 1 1]]
$l print
puts "Length: [$l length]"
parray $l
$l destroy