if 0 {[Richard Suchenwirth] 2005-03-16 - Here's a little experiment in [OO], using the [Jim] feature that procs and [lambda]s can have a "closure" (a set of static variables) associated. 

(Note that this code does normally not run on regular Tcl interpreters - use [Jim] instead - or [Jimulation]!)

This way, the only physical location of an object (the closure with its instance variables) is its lambda. No namespaces needed (or possible in Jim ;^) Jim's lambdas are just [proc]s with a generated name, but they will be garbage-collected when no longer used.

'''[Steve Bennett] 22 Oct 2010''' Excellent Richard. I've updated your example using recent features of [Jim] such as default arguments before the first. How is this for a version which supports class methods, instance methods, and inheritance, all in 24 lines of actual code.
----
 # Very simple OO support for Jim Tcl, with inheritance
 
 # Create a new class $classname, with the given
 # dictionary as instance variables. These are the initial
 # variables which all newly created objects of this class are
 # initialised with.
 # If $baseclass is given, methods and instance variables are inherited
 proc class {classname {baseclass {}} instvars} {
     if {$baseclass ne ""} {
         # Start by mapping all methods to the parent class
         foreach method [$baseclass.methods] { alias $classname.$method $baseclass.$method }
         # Now import the base class initial variables
         set instvars [$baseclass.instvars $instvars]
     }
     # pre-create some class methods
     proc $classname.vars {} instvars { dict keys $instvars }
     proc $classname.instvars {{dict {}}} instvars { array set instvars $dict; return $instvars }
     proc $classname.classname {} classname { return $classname }
     proc $classname.methods {} classname { lmap p [info procs $classname.*] { lindex [split $p .] 1 } }
     # and instance methods
     method $classname destroy {} { rename $self "" }
 
     # This is the constructor for class $classname
     # Any variable values in $args override class defaults
     proc $classname {args} {classname instvars} {
         # Initialise vars
         array set instvars $args
 
         # This is the object dispatcher for $classname.
         # Don't use lambda here so that we can use a more meaningful ref tag
         proc [ref {} $classname lambda.finalizer] {method args} {classname instvars} {
             $classname.$method {*}$args
         }
     }
 }
 
 # Create method $method on class $classname
 proc method {classname method arglist body} {
     proc $classname.$method $arglist {classname body} {
         lassign [info level -1] self
         foreach i [$self vars] {upvar 1 instvars($i) $i}
         eval $body
     }
 }
----
Test code:
 package require oo
 
 # Create a class, the usual bank account, with two instance variables:
 class Account {
     balance 0
     name "Unknown"
 }
 
 # We have some class methods predefined
 puts "---- class Account ----"
 puts vars=[Account.vars]
 puts methods=[Account.methods]
 puts ""
 
 # Now flesh out the class with some methods
 
 method Account deposit {amount} {
     set balance [+ $balance $amount]
 }
 method Account see {} {
     set balance
 }
 method Account withdraw {amount} {
     if {$amount > $balance} {error "Sorry $name, can only withdraw $balance"}
     set balance [- $balance $amount]
 }
 method Account describe {} {
     puts "I am object $self of class [$self classname]"
     puts "My variables are:"
     foreach i [$self vars] {
         puts "  $i=[set $i]"
     }
 }
 
 puts methods=[Account.methods]
 
 # Now an instance, initialisition some fields
 set a [Account name "Bob Smith"]
 
 puts "---- object Account ----"
 # We can use class methods on the instance too
 puts a.vars=[$a vars]
 puts a.classname=[$a classname]
 
 # Now object methods
 $a deposit 100
 puts "deposit 100 -> [$a see]"
 
 $a withdraw 40
 puts "withdraw 40 -> [$a see]"
 
 catch {$a withdraw 1000} res
 puts "withdraw 1000 -> $res\n"
 
 # Tell me something about the object
 $a describe
 puts ""
 
 # Now create a new superclass
 class CreditAccount Account {
     limit -1000
 }
 # Allow overdrawing
 method CreditAccount withdraw {amount} {
     if {$balance - $amount < $limit} {error "Sorry $name, that would exceed your credit limit of [expr -$limit]"}
     set balance [- $balance $amount]
 }
 
 puts "---- class CreditAccount ----"
 puts vars=[CreditAccount.vars]
 puts methods=[CreditAccount.methods]
 puts ""
 
 puts "---- object CreditAccount ----"
 set b [CreditAccount name "John White"]
 
 puts b.vars=[$b vars]
 puts b.classname=[$b classname]
 
 $b deposit 100
 puts "deposit 100 -> [$b see]"
 
 $b withdraw 40
 puts "withdraw 40 -> [$b see]"
 
 $b withdraw 1000
 puts "withdraw 1000 -> [$b see]"
 puts ""
 
 # Tell me something about the object
 $b describe
 
 # And goodbye
 $a destroy
 $b destroy

----
And the output:
 ---- class Account ----
 vars=name balance
 methods=classname destroy methods instvars vars
 
 methods=deposit destroy describe instvars vars classname see methods withdraw
 ---- object Account ----
 a.vars=name balance
 a.classname=Account
 deposit 100 -> 100
 withdraw 40 -> 60
 withdraw 1000 -> Sorry Bob Smith, can only withdraw 60
 
 I am object <reference.<Account>.00000000000000000000> of class Account
 My variables are:
   name=Bob Smith
   balance=60
 
 ---- class CreditAccount ----
 vars=name balance limit
 methods=deposit describe destroy instvars vars withdraw methods see classname
 
 ---- object CreditAccount ----
 b.vars=name balance limit
 b.classname=CreditAccount
 deposit 100 -> 100
 withdraw 40 -> 60
 withdraw 1000 -> -940
 
 I am object <reference.<CreditA>.00000000000000000001> of class CreditAccount
 My variables are:
   name=John White
   balance=-940
   limit=-1000
----

'''Richard's Original Code'''

Here's a "constructor" the hard (bare-bones) way:}
 proc Account args {
    lambda {method args} {{balance 0}} {eval Account'$method $args}
 }
if 0 {Alternatively, if you want to use more than one class, here's factoring out the generic part. It also adds an introspection method for the names of instance vars. Other methods that all classes shall have, can be placed here too:}
 proc class {name instvars} {
    proc $name args \
       [list lambda {method args} $instvars "eval $name'\$method \$args"]
    proc $name'vars {} [list return [lmap i $instvars {lindex $i 0}]]
 }
#-- Let's re-create a first class, the usual bank account, with one instance variable:
 class Account {
    {balance 0}
 }
#-- Bare-bone methods are [proc]s with ''class'method'' names. They need to [upvar] the instance vars they use:

 proc Account'deposit amount {
    upvar 1 balance balance
    set balance [+ $balance $amount]
 }
#-- Here's a wrapper to implicitly do those [upvar]s in methods:
 proc method {class name argl body} {
   proc $class'$name $argl "foreach i \[\[self] vars] {upvar 1 \$i \$i} \n$body"
 }
#-- Methods can be written much slicker now:
 method Account see {} {set balance}
 
 method Account withdraw amount {
    if {($balance-$amount) < 0} {error "can only withdraw $balance"}
    set balance [- $balance $amount]
 }

if 0 {"Who am I?" is a deep philosophical question. Inside methods, it's easily answered - the name of the caller's caller, i.e. the object lambda:}
 proc self {} {lindex [info level -2] 0}

if 0 {Now testing:
 set a [Account]
 puts a:$a
 $a deposit 100
 puts "deposit 100 -> [$a see]"
 $a withdraw 40
 catch {$a withdraw 1000} res
 puts $res
shows on stdout
 a:<reference.<functio>.00000000000000000000>
 deposit 100 -> 100
 can only withdraw 60
Conclusion: For years, I wondered what exactly [closures] are. After seeing their simplicity and power in this example (9 LOC for class-based OO without inheritance - for the convenience wrappers ''class'', ''method'', and ''self''; if you use only "bare-bones" constructors and methods as shown above, you need zero LOC of framework :-), I strongly advocate that Tcl adopts them too, for [proc]s. And we can have it today, with [Jimulation] :)
----
[SS] Very nice! It seems to me a very natural hack to try to implement objects via closures. Also your way to do the dispatch is impressive ;)
----
MiR: Question: Is there any way to do inheritance with closures?
----
[Arts and crafts of Tcl-Tk programming] | 
[Category Object Orientation] | 
[Category Jim]
}