LV I'd more characterize the situation as that "it is clear that there are those in the Tcl community who desire a single OOP system distributed with the core Tcl distribution". Does that seem a fair rewording of your premise? SS: No ;) If you want, you can write that LV is not included in "we". A fair rewording is that "Most in the Tcl comunity desire ..." IMHO.But I may be wrong.. so Poll: do you want OOP?.LV Fair enough - in your opinion, most want this, in my opinion, most do not. Alas, most of the tcl community don't participate in these types of polls, so our opinions will, in all likelihood, remain the same, unless your poll ends up with several hundred thousand respondents...
It is not clear what's the best available, nor if it's wise to get an already developed one, or to create a new one using the experience we collected thanks to the fact that there are a number of OOP systems for Tcl. So while the discussion is hot... I want to express my opinion about it.I called this object system Odys. The name is related to Dynamic Object System. This are the main ideas:
- Tcl object system should be very simple semantically, but very dynamic in order to compensate for the simplicity
- The object system only supports single inheritance
- The object system is class based, and the syntax is very natural to understand
- Classes are objects with methods, like every other object
- Every class object has methods to alter and introspect its methods at runtime
- Objects can change class at runtime, classes can change parents at runtime
- When a method is called, $this is always set to the name of the object that is receiving the message.
class Toaster {
var crumbs 0
method toast nslices {
if {[$this crumbs] > 50} {
error "== FIRE! FIRE! =="
}
$this crumbs [expr {[$this crumbs]+4*$nslices}]
}
method clean {} {
$this crumbs 0
}
}
class SmartToaster extends Toaster {
method toast nslices {
if {[$this crumbs] > 40} {
$this clean
}
$this parent toast $nslices
}
}As you can see:- There is no difference between variables and methods in the object usage.
- It is natural to call methods defined in the parent's class
class foobar {
var x 100
classvar y
method ciao name {puts "Ciao $name! I'm $this, x = [$this x]"}
method hello {} {puts "Hello!"}
}
set o [new foobar]
set class [$o class]
puts "The '[$class name]' class methods are: [$class methods]"
puts "The '[$class name]' instance vars are: [$class vars]"
puts "The '[$class name]' class vars are: [$class classvars]"
puts "Method 'ciao' args are: [$class args ciao]"
puts "Method 'ciao' body is:\n[$class body ciao]"
puts {}
puts "Adding a new method to the class..."
$class setmethod newmethod {} {puts newmethod}
puts "Now the list of methods is: [$class methods]"
puts {}
puts "Deleting the new method..."
$class delmethod newmethod
puts "Now the list of methods is: [$class methods]"Because classes are objects to define a new method there is just to write [$class setmethod foobar ...], and so on.- Objects are names, so they can be used as references to create data structures.
class node {
var next {}
var value {}
}
class linkedlist {
var head {}
method push value {
set newnode [new node]
$newnode value $value
$newnode next [$this head]
$this head $newnode
return $this
}
method pop {} {
if {[$this head] eq {}} {
error "Pop against empty linkedlist object"
}
set head [$this head]
set val [$head value]
$this head [$head next]
free $head
return $val
}
method len {} {
set node [$this head]
set len 0
while {$node ne {}} {
incr len
set node [$node next]
}
return $len
}
}
set ll [new linkedlist]
for {set i 0} {$i < 10} {incr i} {
$ll push $i
}
set node [$ll head]
while {$node ne {}} {
puts [$node value]
set node [$node next]
}
puts [$ll pop]
puts [$ll pop]
puts [$ll pop]
puts "Len: [$ll len]"That's all for now. Note that this is just a draft, but I think the main ideas are already present. Every kind of comment, even if very negative, is welcomed.'''Prototype implementation'''
# The ODYS object system
# TODO:
#
# - 'class' class methods to set methods, get methods lists, and
# similar things for vars and classvars.
#
# - Ability to create objects that are auto-destroied when the
# procedure where they are created returns. [MSW]: solved by [[local]],
# see below.
#
# - Object to string convertion, and vice versa.
#
# FEATURES TO REMEMBER:
#
# - method with empty name is called when the object is
# used as a procedure without arguments, like [$myobj].
# For example, in a file object this may return the whole file content.
namespace eval odys {}
namespace eval odysObj {}
set ::odys::objId -1
array set ::odys::class {}
array set ::odys::classMethod {}
set ::odys::debugFlag 0
proc ::odys::debug str {
if {$::odys::debugFlag} {
puts $str
}
}
proc new {class args} {
set objName "::odysObj::obj[incr ::odys::objId]"
# Get the class object
if {[catch {set classObj $::odys::class($class)}]} {
error "Unknown class '$class'"
}
namespace eval $objName {}
set ${objName}::__class__ $classObj
# Copy instance variables into the object
set t $classObj
while {$classObj ne {}} {
foreach var [info vars ${classObj}::vars::*] {
set tail [namespace tail $var]
set ${objName}::${tail} [set $var]
}
set classObj [set ${classObj}::parent]
}
# Create the alias
interp alias {} $objName {} ::odys::dispatch $objName
uplevel 1 $objName init $args
return $objName
}
proc local {class args} {
set obj [uplevel new $class $args]
set fobj [string map {: _} $obj]
uplevel set $fobj 1
uplevel trace var $fobj u cleanObj
return $obj
}
proc cleanObj {obj args} {
set obj [string map {_ :} $obj]
free $obj
}
proc ::odys::dispatch {id args} {
::odys::debug "Object $id received message '$args'"
set classObj [set ${id}::__class__]
# Handle 'parent' special method
while {[lindex $args 0] eq {parent}} {
if {[set ${classObj}::parent] eq {}} {
error "Object's class has not parent."
}
set classObj [set ${classObj}::parent]
set args [lrange $args 1 end]
}
# Method lookup
while 1 {
if {[info proc ${classObj}::methods::[lindex $args 0]] ne {}} {
return [uplevel 1 ${classObj}::methods::[lindex $args 0] $id \
[lrange $args 1 end]]
}
if {[set ${classObj}::parent] eq {}} {
error "No such method '$method'"
}
# Retry with the parent
set classObj [set ${classObj}::parent]
}
}
set ::odys::class(class) {}
proc free id {
$id free
namespace delete $id
interp alias {} $id {}
}
proc class {name args} {
switch -- [llength $args] {
1 {set parentClassObj {}; set body [lindex $args 0]}
3 {
if {[lindex $args 0] ne {extends}} {
error {wrong args: second argument must be "extends" if present}
}
set parent [lindex $args 1]; set body [lindex $args 2]
if {[catch {set parentClassObj $::odys::class($parent)}]} {
error "Unknown class '$class'"
}
}
default {
error {wrong # args: should be "class className ?extends parentName? body"}
}
}
set classObj [new class]
namespace eval ${classObj}::methods {}
namespace eval ${classObj}::vars {}
namespace eval ${classObj}::classvars {}
interp alias {} ${classObj}::method {} ::odys::method
interp alias {} ${classObj}::var {} ::odys::var
interp alias {} ${classObj}::classvar {} ::odys::classvar
proc ${classObj}::methods::init this {}
proc ${classObj}::methods::free this {}
proc ${classObj}::methods::class this {
set ${this}::__class__
}
set ${classObj}::name $name
if {[catch {namespace eval $classObj $body} errmsg]} {
free $classObj
error $errmsg
}
set ${classObj}::parent $parentClassObj
set ::odys::class($name) $classObj
}
proc ::odys::method {name arglist body} {
set classObj [uplevel namespace current]
proc ${classObj}::methods::${name} [concat this $arglist] $body
}
proc ::odys::var {name {value {}}} {
set classObj [uplevel namespace current]
proc ${classObj}::methods::${name} {this args} [format {
if {[llength $args] == 0} {
return [set ${this}::%s]
} elseif {[llength $args] == 1} {
return [set ${this}::%s [lindex $args 0]]
} else {
error {instance variable access method can accept 0 or 1 arg.}
}
} $name $name]
set ${classObj}::vars::${name} $value
}
proc ::odys::classvar {name {value {}}} {
set classObj [uplevel namespace current]
proc ${classObj}::methods::${name} {this args} [format {
if {[llength $args] == 0} {
return [set [set ${this}::__class__]::classvars::%s]
} elseif {[llength $args] == 1} {
return [set [set ${this}::__class__]::classvars::%s [lindex $args 0]]
} else {
error {class variable access method can accept 0 or 1 arg.}
}
} $name $name]
set ${classObj}::classvars::${name} $value
}
proc ::odys::isClassObj id {
if {![namespace exists $id]} {return 0}
if {[$id class] ne $::odys::classClassObj} {return 0}
return 1
}
############################### The 'class' class ##############################
# This class is build by hand because it's somewhat special, and
# the [class] command itself requires this class to be already-working.
# Create the 'class' class.
namespace eval ::odysObj::obj0 {set parent {}}
namespace eval ::odysObj::obj0::methods {}
proc ::odysObj::obj0::methods::init this {}
set ::odys::class(class) ::odysObj::obj0
set ::odys::classClassObj [new class]
# Initialize this class by hand.
namespace eval ${::odys::classClassObj}::methods {}
namespace eval ${::odys::classClassObj}::vars {}
namespace eval ${::odys::classClassObj}::classvars {}
set ${::odys::classClassObj}::vars::methods {}
set ${::odys::classClassObj}::vars::vars {}
set ${::odys::classClassObj}::vars::classvars {}
set ${::odys::classClassObj}::parent {}
set ${::odys::classClassObj}::__class__ $::odys::classClassObj
proc ${::odys::classClassObj}::methods::free {this} {}
proc ${::odys::classClassObj}::methods::name {this} {set ${this}::name}
proc ${::odys::classClassObj}::methods::setparent {this args} {
if {[llength $args] == 1} {
set newparent [lindex $args 0]
if {$newparent ne {} && ![::odys::isClassObj $newparent]} {
error "Can't set '$newparent' as parent. Not a class object."
}
set ${this}::parent $newparent
} elseif {[llength $args] == 0} {
set ${this}::parent
} else {
error "bad # of args: setparent can accept 0 or 1 argument."
}
}
proc ${::odys::classClassObj}::methods::methods this {
set methods [info procs ${this}::methods::*]
set tails {}
foreach m $methods {
lappend tails [namespace tail $m]
}
return $tails
}
proc ${::odys::classClassObj}::methods::vars this {
set vars [info vars ${this}::vars::*]
set tails {}
foreach v $vars {
lappend tails [namespace tail $v]
}
return $tails
}
proc ${::odys::classClassObj}::methods::classvars this {
set vars [info vars ${this}::classvars::*]
set tails {}
foreach v $vars {
lappend tails [namespace tail $v]
}
return $tails
}
proc ${::odys::classClassObj}::methods::args {this name} {
lrange [info args ${this}::methods::${name}] 1 end
}
proc ${::odys::classClassObj}::methods::body {this name} {
info body ${this}::methods::${name}
}
proc ${::odys::classClassObj}::methods::setmethod {this name args body} {
set args [concat this $args]
proc ${this}::methods::${name} $args $body
}
proc ${::odys::classClassObj}::methods::delmethod {this name} {
rename ${this}::methods::${name} {}
}
set ::odys::class(class) ${::odys::classClassObj}
Some more example of usageThis is a file object: source odys.tcl
class file {
var fd {}
method init args {
if {[llength $args] == 0} return
eval $this open $args
}
method free {} {
set fd [$this fd]
if {$fd ne {}} {
::close $fd
}
}
method open args {
$this fd [eval ::open $args]
}
method close {} {
::close [$this fd]
$this fd {}
}
method gets args {
switch [llength $args] {
0 {::gets [$this fd]}
1 {
upvar 1 [lindex $args 0] line
::gets [$this fd] line
}
default {
error "wrong # of args, try: gets ?varname?"
}
}
}
method rewind {} {
seek [$this fd] 0
}
method foreach {varname script} {
set fd [$this fd]
upvar $varname line
while {[::gets $fd line] != -1} {
uplevel 1 $script
}
}
method {} {} {
$this rewind
set buf [read [$this fd]]
$this rewind
return $buf
}
}
set t [new file /etc/passwd]
$t foreach line {puts -nonewline "[string length $line] "}
puts {}
$t close
free $t
set t [new file /etc/resolv.conf]
puts [$t]
free $t
'''Class vars example'''
source odys.tcl
class foobar {
classvar x 0
}
set a [new foobar]
set b [new foobar]
$a x 100
puts [$a x]
puts [$b x]
'''Auto clean example'''
source odys.tcl
class tst {
var msg {}
method init args {
$this msg $args
}
method free {} {
puts "Freeing [$this msg]"
}
}
proc a {} {
set t1 [new tst "Test #1"]
set t2 [local tst "Test #2"]
}
a CommentsWHD: Implementing instance variables as methods is interesting, but ultimately frustrating; you lose incr, lappend, etc. You need to have instance variables that can be handed to another object and traced, e.g., as -textvariables. Also, you're going to need array variables. DKF has done some interesting stuff using Tcl 8.5 dicts to store instance variables; the dict with command brings all of the dict fields into scope as variables, and packs any changes back into the dict.SS: Hello! I'm not sure how this will evolve, but as you suggest it's very likely that Odys will be implemented using dict and not namespaces because a derivated of Odys is going to be the default OOP system of Jim that has no namespaces but supports dicts. About instance variables as methods, I've the idea to fix the problem about the fact that they don't combine very well with commands accepting var names as arguments using a with similar to dict itself, i.e.:$obj with x {incr x}The with method will care to map 'x' to the value returned by the method, and then set it back to the object, not only, if 'x' already exists tehre will be no collision, the 'x' is saved (or is saved the fact that it didn't existed), and then it's restored with the old content or destroied at all. This should make Odys able to take the "the only interface to objects is to send they messages", without to make it a pain to use. Thank you very much for your comment.WHD: "$obj with x" is an interesting thought; would the "with" method be available to outside users, or would it work only within methods? And if you do this, you'd best make it work with lists of instance variables, e.g., "$obj with {x y} ..." On the other hand, if you store instance variables as dicts you can make them transparently available in your methods, which would be nicer.SS: yep, "with" should be available to outside users, another design principle of Odys is that there is no method privare, nor instance variable public, while a derived class may decide to override a parent's method with an [error "you can't call this"]. Also it seems to me a good idea to allow lists of instance variables, and I may even support something like: [$obj with {x y} as {a b} { .... }] that I think will be rarely used, but may be a good way to deal with cases where there is collision between object's instance variables names and variables defined in the current context that you want to use inside the "with" script. Even if I implement Odys with dict, still I think that can be nice to allow to access the object only via methods: the derived class can override methods and instance variables in the same way, also to support polymorphism seems simpler this way. My only support for instance variables is in the class definition where it's nice if Odys will auto-create the default method to set/get the variable. Performances should not be a big problem since all this will be implemented in C inside Jim... but there is to test to really check I'll be able to reach usable-level performances.WHD: Override instance variables in subclasses? That sounds like a quick trip to hell, to me. In fact, the more I think about having all of your instance variables be publicly available as methods, the less I like it. Part of good design is protecting your object's invariants. You can't protect them if every instance variable is accessible to all comers. At the very, very least you should adopt a naming convention where (say) capitalized methods and variables are intended for use internally, while lowercase methods and variables are for external use. It doesn't need to be enforced by Odys, but it'll help make it clear to the reader just what the real interface is.SS: you are right, I didn't considered this well enough. The design I want to reach is that the only way to use an object is by methods, i.e. there must be no concept of accessing an object's instance variable directly like C++'s obj.c = 5. I may like to apply the same concept even in derivated classes, that should be able to use the inherithed class only via the exported interface. This basically means no explicit control of what is public/private. All methods public, all instance variables private, and the class will export when appropriate methods to allow modification of the object's instance variables (and generally, state). In order to reach this, is probaby wise to implement instance variables not as methods, but as you suggested like normal-looking variables. To make simpler to build methods that have just the semantic of [$obj x] to return $x, and [$obj x $newVal] to set 'x' to the new value, maybe I can allow to write:class foobar {
set x 0
varmethod x
}instead ofclass foobar {
set x 0
method x {args} { if [llength $args] .... }
}In this new shape, does this OOP system sound more sane? My priority is to make it usable, class-based, dynamic, and with very few concepts. Thanks for your help. Salvatore.WHD: Much more sane. In my experience, "public methods, private variables" is almost always right. There are rare occasions, as I say, when you want to give an external entity access to a variable, e.g., as a label widget's -textvariable; as DKF has shown, though, you can do that even if your instance variables aren't real Tcl variables by creating a Tcl variable and a read trace when you need one.SS: Ok, in Jim there are no variable traces... I don't want to add traces, but other guys involved in the project may like they. I'm pondering... btw I think for now I'll ignore this rare cases where to export an instance var is needed ;). I'll update this page when the OOP extension of Jim (following this guidelines) is ready. Thanks.