if 0 { Yet another object system in Tcl
The twist here is that such objects are implemented as key-value lists, and that everything goes through variable names. Taken to extremes, there would be no need for Tcl commands at all. For now, a "!" must precede all invocations.
Objects can contain values (properties) and member functions (methods). Values consist of a single item, while methods consist of a lambda-like parameter + body tuple. Here's an object with three properties:
set obj1 {color red size 10 type apple}To display the color, one would do:
puts [! obj1 color]
And here's an object with a property and a method:
set obj2 {factor 10 times {{x} { expr {$x * [! me factor]} }}}The above example also illustrates how to get at "instance variables". Let's give the factor property a new value:
! obj2 factor 2
Now, let's apply it to double the specified numeric argument:
puts [! obj2 times 123]
Things still missing from this design are inheritance, basic construction / destruction, cleanup, plus some syntactic sugar to make it more readable. What it offers is a pure data-centric design which would be trivial to make fully persistent, with optional efficient hashed name lookup coded in C.
Why lists? Well, first of all just as proof of concept: to show that it is sufficient to build a little OO system. A second reason is that lists are first-order objects in Tcl and can thus be passed around, unlike arrays. A third reason is that a prototype-based OO design like this one might turn out to be quite efficient - sharing maximally when copied.
20-4-2002 jcw }
# optional: fast C-coded version of ihash, built with CriTcl #package require ihash
# Tcl version, get or set items in a "key value key value ..." list
proc ihash {vref cmd args} {
upvar $vref v
lassign $args a b
switch $cmd {
get {
foreach {x y} $v {
if {$x == $a} {
return $y
}
}
}
set {
set i 1
foreach {x y} $v {
if {$x == $a} {
if {$b != ""} {
lset v $i $b
} else {
set v [lreplace $v [expr {$i-1}] $i]
}
return $b
}
incr i 2
}
if {$b != ""} {
lappend v $a $b
}
return $b
}
default { error "$cmd: not implemented" }
}
}# all objects must be accessed as "! varname method args"
proc ! {self method args} {
upvar $self me
lassign [ihash me get $method] params body
if {$body == ""} {
if {[llength $args] == 0} {
return $params
}
set a [lindex $args 0]
ihash me set $method $a
return $a
}
foreach 1 $params 2 $args {
if {$1 == "args"} {
set args [lrange $args [expr {[llength $params]-1}] end]
break
}
set $1 $2
}
eval $body
}# example 1
set obj1 {color red size 10 type apple}
puts [! obj1 color]# example 2
set obj2 {factor 10 times {{x} { expr {$x * [! me factor]} }}}
! obj2 factor 2
puts [! obj2 times 123]# a more readable example: raw definition of an "object" called "two"
set two {
value 2
times {{x} {
return [expr {$x*2}]
}}
combine {{k args} {
set v {}
foreach x $args {
lappend v [list $k $x]
}
return $v
}}
}# property access
puts [! two value]
# property setting
puts [! two value 3]
# member call
puts [! two times 5]
# member call with variable args
puts [! two combine 1 a b c]
# dump the full "object" again
puts $two
Actually, the "!" could be dropped by extending the package unknown mechanism... hm, yes, that would allow for much cleaner uses...