[SS] 14 Dec 2004:

It is clear for the Tcl comunity that we need a "standard OOP system" for Tcl.
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

So, what is lost in power because of semantical simplicity, is gained because all is dynamic.
This is the way I think at Tcl itself. Imagine Tcl without introspection, without [uplevel], and so on...
As a result of this first design principle:

   * 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.

This is the classical toaster example:

 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.

Instance variables are just methods, if called with a single argument like [[$obj foo]] the value of
the instance variable foo is returned. Instead it can be called with two arguments to set a new value
like in [[$obj foo $newval]]. So instance variables are always accessed using methods, or in other terms,
sending messages to the object.

   * It is natural to call methods defined in the parent's class

If the object $o is of class xyz that inherits from xy, to call the method foobar of xy with $o as target
there is just to write [[$o parent foobar]]. parent can be used multiple times, like [[$o parent parent parent foobar]].
Parent is just a method (semantically...), that exists in every class created.


About the fact that it's dynamic. This is what is possible to do:

  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.

If you write [[new foobar]], what you get is something like: ::odysObj::obj0,
so to create data structures using objects is simple. This is an example of linked list implementation:

 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 usage'''

This 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  

----

'''Comments'''

[WHD]: 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 [dict]s. 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.

----
[Category Object Orientation]