Updated 2018-03-27 17:55:11 by dbohdan

Yet another object system in Tcl  edit

The twist with this object system is that objects are implemented as key-value lists (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  edit

Original

The original implementation works at least as far back as Tcl 7.6 with a shim for lassign and lset.

Download with wiki-reaper: wiki-reaper 3271 0 > yao.tcl

2002-04-20 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
}

Modernized

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
}

The following further replaces eval with apply, which allows you to use default values in method arguments and should improve method performance. However, as a result it is not fully compatible with the original: the arguments are processed differently and different variables are defined when the body of the method runs (no self, method, params, or body).

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
        }
        # 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  edit

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!

See also  edit

Discussion  edit

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

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.