** Yet another object system in Tcl **
The twist with this [Object orientation%|%object system] is that objects are implemented as key-value lists ([dict%|%dictionaries] in modern terminology), and that everything goes through variable names. If taken to an extreme, there would be no need for Tcl commands at all. For now, "!" 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 + a body tuple. Here's an object with three properties:
======
obj1 {color red size 10 type apple}
======
To retrieve the color, one would do:
======
! obj1 color
======
And here's an object with a property and a method:
======
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 use it to double a numeric argument:
======
puts [! obj2 times 123]
======
Things still missing from this design are inheritance, basic construction/destruction, clean-up, 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 a proof of concept: to show that they are sufficient to build a little OO system. The second reason is that lists are first-order objects in Tcl and can thus be passed around, unlike arrays. The third reason is that a prototype-based OO design like this one might turn out to be quite efficient — sharing maximally when objects are copied.
** Code **
*** Original ***
The original implementation works at least as far back as Tcl 7.6 with a shim for `[lassign]` and `[lset forward compatibility%|%lset]`.
Download with [wiki-reaper]: `wiki-reaper 3271 0 > yao.tcl`
'''[jcw] 2002-04-20:'''
======
# 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 ne {}} {
lset v $i $b
} else {
set v [lreplace $v [expr {$i-1}] $i]
}
return $b
}
incr i 2
}
if {$b ne {}} {
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 ne {}} {
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 eq {args}} {
set args [lrange $args [expr {[llength $params]-1}] end]
break
}
set $1 $2
}
eval $body
}
======
*** Modernized ***
**** Fully compatible ****
2018-03-17 [dbohdan]: This modification replaces `ihash` with `[dict]`. It has been tested against Tcl 8.5-8.6 and [Jim Tcl] 0.76.
Download with [wiki-reaper]: `wiki-reaper 3271 1 > yao.tcl`
======
proc ! {self method args} {
upvar $self me
lassign [dict get $me $method] params body
if {$body eq {}} {
# Get value.
if {[llength $args] == 0} {
return $params
}
# Set value.
lassign $args a
dict set me $method $a
return $a
}
# Evaluate method.
foreach 1 $params 2 $args {
if {$1 eq {args}} {
set args [lrange $args [expr {[llength $params]-1}] end]
break
}
set $1 $2
}
eval $body
}
======
**** Modified ****
The following code replaces `[eval]` with `[apply]`. It allows you to set the default values for the method arguments and improves the performance of some methods. However, it is not fully compatible with the original:
* An argument does not default to an empty string; arguments without an explicit default are required;
* Argument names that consist of several Tcl [word%|%words] (have whitespace) need extra quotes;
* It is an error to give useless extra arguments after the new value of a property;
* The variables `self`, `method`, `params`, and `body` are not defined when the body of the method is evaluated.
This means that you must replace, e.g., `puts [! counter incr]` with `puts [! counter incr 1]` in the examples below when using this version.
Download with [wiki-reaper]: `wiki-reaper 3271 2 > yao.tcl`
======
proc ! {self method args} {
upvar $self me
lassign [dict get $me $method] params body
if {$body eq ""} {
# Get value.
if {[llength $args] == 0} {
return $params
} elseif {[llength $args] >= 2} {
error {too many arguments}
}
# Set value.
lassign $args a
dict set me $method $a
return $a
}
# Evaluate method.
set preamble [list upvar $self me]
uplevel 1 [list apply [list $params $preamble\n$body] {*}$args]
}
======
** Examples **
*** Property ***
======
set obj1 {color red size 10 type apple}
puts [! obj1 color]
======
*** Method ***
======
set obj2 {factor 10 times {{x} { expr {$x * [! me factor]} }}}
! obj2 factor 2
puts [! obj2 times 123]
======
*** A more complex object ***
======
# 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
======
*** Counter ***
======
set counter {
i 0
incr {n {
if {$n eq {}} { set n 1 }
! me i [expr {[! me i] + $n}]
}}
}
puts [! counter incr] ;# 1
puts [! counter incr] ;# 2
set copy $counter
puts [! counter incr 98] ;# 100
puts [! copy incr] ;# 3
======
*** Gotcha ***
======
set obj {
hello Hello!
greet {{} {
puts [! me hello]
}}
}
! obj greet ;# Hello!
set obj {
hello {Hello, World!}
greet {{} {
puts [! me hello]
}}
}
catch { ! obj greet } err
puts $err ;# invalid command name "World!"
# correct
set obj {
hello {{Hello, World!}}
greet {{} {
puts [! me hello]
}}
}
! obj greet ;# Hello, World!
======
** Benchmark **
*** Code ***
======
source yao.tcl
proc benchmark-counter-field {counterStart max} {
set counter $counterStart
for {set i 0} {$i < $max} {incr i} {
! counter i [expr {[! counter i] + 1}]
}
}
proc benchmark-counter-method {counterStart max} {
set counter $counterStart
for {set i 0} {$i < $max} {incr i} {
! counter incr
}
}
proc run {{max 10000} {times 5}} {
set counterStart {
i 0
incr {{{n 1}} {
! me i [expr { [! me i] + $n }]
}}
}
puts "Counting up to $max $times times."
puts -nonewline { counter field: }
puts [time {benchmark-counter-field $counterStart $max} $times]
puts -nonewline {counter method: }
puts [time {benchmark-counter-method $counterStart $max} $times]
}
run {*}$argv
======
*** Results ***
======none
Counting up to 10000 5 times.
counter field: 48657.8 microseconds per iteration
counter method: 293073.6 microseconds per iteration
======
** See also **
* [Classy YAO]
* [CritLib] for `ihash` (obsolete)
* [TOOT], a similarly [transparent] object system
** Discussion **
''Actually, the "!" could be dropped by extending the package unknown mechanism... hm, yes, that would allow for much cleaner uses...''
----
[RS]: [Package] unknown? Shall every object be treated as a separate package? I think this refers rather to the normal [unknown] from init.tcl. But this should be a last resort - maybe it's cleaner and faster to use an [interp] alias, e.g. in this simple "constructor":
======
proc yao {name value} {
if [llength [info commands $name]] {
error "cannot override command $name"
}
uplevel 1 [set $name $value] ;# creating "yet another object"
interp alias {} $name {} ! $name ;# shorthand for calling it uplevel 1 [list trace add variable $name unset "interp alias {} $name {} ;#"]
}
======
where the unset [trace] cleans up the alias (so you can omit the !), when the variable disappears ("destructor" - a "yao" is destroyed with [unset] or implicitly when leaving scope). Non-existence of the command has to be checked, as ''[interp] alias'' silently clobbers any command...
----
[JCW]: Ah, yes, of course, silly me - too much "package" work lately, it pollutes my brain now. Thanks for the correction - I'll edit out this mistake in a few days.
Richard, as always you add more magic to things. I like your alias and its self-cleanup style. And the "yao" name (I started with "yaos", but your choice is closer to "tao" - and indeed, it's all about Zen).
Note that one hideous little plan of mine is to see if one can throw out all commands, namespaces (even files and packages, but that's another story...). So the alias is great in the current world, but maybe one day all one needs is variables and arrays (or nested variables, possibly). So that the notation "name arg1 arg2 ..." means: find name as object, and either apply arg1 as method or fall back to a default if not found. No more commands at all, at the core level, just a re-implementation on top of variables and something like the above yao data model? Just a thought...
----
French-speaking users should take a look at this French Tcler's Wiki page [http://wfr.tcl.tk/1044].
There is an object system without inheritance that clones namespaces. You may define a class (une classe) as a
single ''namespace eval''-like command, then instanciate individual namespaces, each with its own variables.
Instances behave ''exactly'' as namespaces, without any need to reference a ''this'' or ''self'' pointer.
<<categories>> Jim Package | Object Orientation | Arts and crafts of Tcl-Tk programming