Smalltick

Smalltalk-like object system in pure-Tcl.

• Author: George Peter Staplin
• License: BSD/Tcl
• Downloads: http://www.xmission.com/~georgeps/implementation/software/Smalltick/

Projects:

Smalltick Widgets with Inheritance

Smalltick DrawingEditor

Smalltick is not a typical Tcl object system. It uses instance inheritance, so you aren't limited by the definition of a class. You can add new methods dynamically easily. It does not use namespaces to store methods and variables, but it also doesn't prevent you from using them. Instance variables are stored in a private array, and each method uses a unique-command-name prefix, so collisions are not a problem.

Classes in Smalltick are just procs with commands that associate variables and methods with an object.

 $ tclsh8.4
 % source ./Smalltick.tcl
 % set obj [new.object]
 cmd-2108840903
 % $obj set {var value}
 value
 % $obj get var
 value
 % $obj : foo {} { puts FOO }
 cmd-2108840903->foo
 % $obj foo
 FOO
 % $obj : bar arg { $self set [list var $arg] }
 cmd-2108840903->bar
 % $obj bar 123
 123
 % $obj get var
 123

You may notice that the instance variable setting is a little weird. This is due to the generic application of method invocation. For instance $obj -foo arg -bar arg is generalized to treat the argument to the method as a single list. If you want to pass multiple arguments define a method like so:

 $obj : mul {a b} {expr {$a + $b}} 

and then use it in this manner:

 $obj mul [list 1 2]

Redistribution/Licensing: OLL

 #Copyright 2004 George Peter Staplin

 proc get.unique.command.name {} {
  while 1 {
   if {"" == [info commands [set n cmd[clock clicks]]]} {
    return $n
   }
  }
 }
 
 proc instance.handler {obj args} {
  if {":" == [lindex $args 0]} {
   proc $obj->[lindex $args 1] \
    [lindex $args 2] \
    "set self $obj; [lindex $args 3]"
   return $obj->[lindex $args 1]
  } else {
   set r ""
   foreach {msg arg} $args {
    switch -- [llength $arg] {
     0 {
      set r [$obj->[set msg]]
     }
     1 {
      set r [$obj->[set msg] [lindex $arg 0]]
     }
     2 {
      set r [$obj->[set msg] [lindex $arg 0] [lindex $arg 1]]
     } 
     3 {
      set r [$obj->[set msg] [lindex $arg 0] [lindex $arg 1] [lindex $arg 2]]
     }
     4 {
      set r [$obj->[set msg] [lindex $arg 0] [lindex $arg 1] [lindex $arg 2] [lindex $arg 3]]
     }
     5 {
      set r [$obj->[set msg] [lindex $arg 0] [lindex $arg 1] [lindex $arg 2] [lindex $arg 3] [lindex $arg 4]]
     }
    }
   }
   return $r
  }
 }
 
 proc new.object {} {
  set obj [get.unique.command.name]
  interp alias {} $obj {} instance.handler $obj
 
  $obj : ?set {var value} {
   if {![info exists ::_priv_instances($self,$var)]} {
    return -code error "expected $var to exist in $self"
   }
   set ::_priv_instances($self,$var) $value
  }
  $obj : decr var {
   incr ::_priv_instances($self,$var) -1
  }
  $obj : destroy {} {
   foreach cmd [info commands [set self]*] {
    rename $cmd {}
   } 
   array unset ::_priv_instances [set self],*
  }
  $obj : get var {
   return [set ::_priv_instances($self,$var)]
  }
  $obj : incr var {
   incr ::_priv_instances($self,$var)
  }
  $obj : set {var value} {
   set ::_priv_instances($self,$var) $value
  }
  return $obj
 }

escargo 5 Jul 2004 - Could you explain what you mean when you say, "It uses instance inheritance...." What other object systems (not just Tcl ones) are like this? Is it like prototype-based systems?

George Peter Staplin: July 5, 2004 - I mean that methods and instance variables can be added at any time -- in or out of a class. Some object systems only allow adding a method or variable within a class which the object or another class inherits-from/extends-with.

escargo 6 Jul 2004 - Does that mean if I dynamically update a class, that existing instances will then inherit the changes? How does instance inheritance do inheritance?