Version 4 of dicthash: Yet another lightweight object system

Updated 2009-04-23 04:28:05 by slebetman

I was using unknown today to add some syntax sugar to dicts and somehow came up with a simple, lightweight object system that has the feel of javascript objects.

The basic idea is that everything's a value (how very tclish ;-). Methods are simply lambda expressions stored as elements in a dict. Also, I started by stealing the object syntax from Tk widget hierarchies but ended up with a very javascript-like syntax.

Usage Summary:

  # we start with a dict:
  set foo {
    location {
      x 0
      y 0
    }
    heading 0
    move {{distance} {
      %this.location.x = [expr {
        [%this.location.x]+($distance*cos([%this.heading]))
      }]
      %this.location.y = [expr {
        [%this.location.y]+($distance*sin([%this.heading]))
      }]
    }}
  }

  # to get values form the dict simply:
  puts [%foo.location.x]

  # to set values simply:
  %foo.heading = [expr {acos(-1)/8}]

  # to call a method simply apply:
  %foo.move.apply 100

  # There are a couple other conveniences
  # for dict operations.

  # to merge two dicts:
  set newfoo [%foo + {name "tortise"}]

  # to merge another dict into foo:
  %foo += {name "hare"}

I toyed with the idea of implementing method calls as %foo.move($value) but that felt very un-tclish to me. So I opted to use "apply" as the keyword for method invocation.

Here's the implementation:

  # syntax sugar for dict:
  proc dicthash {cmd args} {
    uplevel 1 [string map "CMD $cmd ARGS {{$args}}" {
      set path [split [string range CMD 1 end] .]
      set varname [lindex $path 0]
      set path [lrange $path 1 end]
      
      upvar 1 $varname var
      
      if {[lindex $path end] == "apply"} {
        set path [lrange $path 0 end-1]
        set script [dict get $var {*}$path]
        set body [lindex $script 1]
        regsub -all -- {\y\$this\y} $body "{$var}" body
        regsub -all -- {\%this} $body "dicthash %var" body
        lset script 1 $body
        if {ARGS == ""} {
          return [apply $script]
        } else {
          return [apply $script {*}ARGS]
        }
      } else {
        switch -- [llength ARGS] {
          0 {
            return [dict get $var {*}$path]
          }
          2 {
            set op [lindex ARGS 0]
            set val [lindex ARGS 1]
            
            if {$op == "="} {
              return [dict set var {*}$path $val]
            } elseif {$op == "+"} {
              if {$path == ""} {
                return [dict merge $var $val]
              } else {
                error "invalid dict merge"
              }
            } elseif {$op == "+="} {
              if {$path == ""} {
                return [set var [dict merge $var $val]]
              } else {
                error "invalid dict merge"
              }
            }
          }
        }
      }
      error "unsupported operation on CMD"
    }]
  }
  proc unknown {cmd args} {
    if {[string index $cmd 0] == "%"} {
      return [dicthash $cmd {*}$args]
    } else {
      error "unknown: $cmd $args"
    }
  }

EIAS:

A dicthash "object" is nothing more than a dict. Therefore an object also has a natural string representation. This somehow feels extremely tclish to me :-)

It also means that an object can be modified after instantiation, just like javascript. So for example, taking the example of the "foo" object above, to add a new method to draw it on a canvas you simply assign a lambda expression to it:

  # add a new method:
  dict set foo draw {{canvas} {
    set x [%this.location.x]
    set y [%this.location.y]
    $canvas create oval \
      [expr {$x-5}] [expr {$y-5}] \
      [expr {$x+5}] [expr {$y+5}] \
      -fill red
  }}

  # or using dicthash sugar:
  %foo.draw = {{canvas} {
    set x [%this.location.x]
    set y [%this.location.y]
    $canvas create oval \
      [expr {$x-5}] [expr {$y-5}] \
      [expr {$x+5}] [expr {$y+5}] \
      -fill red
  }}

  # now you can draw foo:
  pack [canvas .c] -fill both -expand 1
  %foo.draw.apply .c

Inheritance:

Originally I didn't think this supports inheritance. After all, I wrote this and I haven't implemented inheritance yet! It turns out that dicthash is a pure prototype base object system. Much more so than javascript thanks to tcl's strict value semantics (also known as everything is a string).

In a prototype based object system you don't inherit. Instead you clone from your parent object and then extend yourself. In tcl this is trivial. In the foo example above I've already shown how newfoo "inherits" from foo. So in dicthash (since objects are simply dicts) inheritance is simply:

  # dict2 "inherits" from dict1:
  set dict2 $dict1

Also, as bonus and because of the excellent design of the dict API, multiple "inheritence" is simply:

  # dict2 "inherits" from dict1 and dict0:
  set dict2 [dict merge $dict1 $dict0]

  # or in dicthash notation:
  set dict2 [%dict1 + $dict0]

A more elaborate example of "inheritance":

  set mammal {
    class mammal
    species unknown
    speak {{} {}}
  }

  # dogs are a type of mammal:
  set dog [%mammal + {
    species dog
    speak {{} {puts Bark!}}
  }]

  # so are humans:
  set human [%mammal + {
    species human
    name ""
    speak {{} {puts "Hello. My name is [%this.name]."}}
  }]

  # create instances:
  set fido [%dog + {name Fido}]
  set charlie [%human + {name Charlie}]

  # hear them speak:
  %fido.speak.apply    ;# Bark!
  %charlie.speak.apply ;# Hello. My name is Charlie.