Updated 2012-01-20 13:43:24 by dkf

Yet another object system in Tcl edit

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

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 var $name u "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...

See also LOST, by Larry Smith and Richard Suchenwirth

Also see BOOP, a minimal all-tcl object oriented system that doesn't redefine any built-in tcl commands, and plays nice with debuggers.

French-speaking users should take a look at this French Tcler's Wiki page [1]. 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.