if 0 { '''Yet another object system in Tcl'''

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 faster to use an [interp] alias:
 proc yao {name value} {
    uplevel 1 [set $name $value]
    interp alias {} $name {} ! $name
    uplevel 1 [list trace var $name u "interp alias {} $name {} ;#"
 }
where the unset [trace] cleans up the alias.

----
[Object orientation]|[Arts and crafts of Tcl-Tk programming]