[NEM] ''19 Apr 2006'': This page shows a simple technique I've been using for a little
while now, making use of some of the cool new features in the 8.5 development version of
Tcl. I thought I'd write up this page to show how you can create lightweight closures
and simple objects using these techniques, and how the new features enable this.

A closure is a function or procedure that captures the lexical/static environment in
which it is defined: it ''closes over'' the local variables that are visible at
the moment of definition. Tcl's procedures don't do this: the only variables that are
visible in a procedure by default are parameters and any local variables created
in the body of the procedure. The [global]/[variable] and [upvar] commands allow you
to also import other variables from the global and dynamic scope when the procedure
is called, but there is no general way to remember the environment in which a
procedure was defined. This page shows a limited way to do this.

Firstly, we need a way to capture the current environment. This is easy enough to do
with Tcl's powerful [introspection] capabilities:

 proc capture {} {
     set env [dict create]
     foreach name [uplevel 1 { info locals }] {
         if {$name eq "__env__"} { continue }
         upvar 1 $name var
         catch { dict set env $name $var } ;# no arrays
     }
     return $env
 }

This simple procedure captures the current value of every local variable in the
current environment. Note that we don't bother capturing global variables, as these
are available anyway. Note also that we only capture the current ''value'' of each
variable, and not the variable itself. This is a limitation of the current approach,
which it is hard to work around: variables are not first-class values in Tcl, so
we can't put them in a dictionary. Nevertheless, there is a lot you can do with just
values as we shall see.

Now we can capture the current environment, we need to create a ''constructor'' for
creating our closures. We will call this "func", and give it a similar syntax to that
for [proc], but with the addition that we will allow the name argument to be optional:

 proc func args {
     if {[llength $args] < 2 || [llength $args] > 3} {
         error "wrong # args: should be \"func ?name? params body\""
     }
     # func ?name? params body
     set params [lindex $args end-1]
     set body   [lindex $args end]
     # Capture environment and namespace of definition
     set env [uplevel 1 { capture }]
     set ns  [uplevel 1 { namespace current }]
     # Arrange to restore the environment when run
     set params [linsert $params 0 __env__]
     set body [list dict with __env__ $body]
     # Use 8.5's [apply] command to evaluate the procedure
     set func [list $params $body $ns]
     set cmd [list ::apply $func $env]
     if {[llength $args] == 3} {
         set name [nsjoin $ns [lindex $args 0]]
         interp alias {} $name {} {expand}$cmd
         return $name
     } else {
         return $cmd
     }
 }
 # A little helper to make a name fully-qualified
 proc nsjoin {ns name} {
     if {![string match ::* $name]} {
         if {$ns eq "::"} {
             set name ::$name
         } else {
             set name ${ns}::$name
         }
     }
     return $name
 }

This looks a bit more complicated, but it is really fairly simple when stripped to its basics.
Firstly, we capture the current environment using our "capture" procedure. Then, we rearrange
the parameters of the procedure to take an initial "__env__" argument. This is similar to the
technique used in some implementations of [object oriented] programming where a method takes
an initial "self" parameter. We then construct a call to [apply] which will take care of
evaluating the procedure when it is called. Apply is a new command in 8.5 for creating
anonymous procedures, and here we see how flexible it is. As well as the parameters, body,
and namespace of definition, we also add on the captured environment as the first argument
to the procedure. We then adjust the body of the procedure to call [dict] with, which will
restore the environment by creating local variables corresponding to each element in the
dictionary.

So, let's see how this works by trying some examples:

 % func make-adder a { func b { expr {$a + $b} } }
 ::make-adder

This is a function that takes a number "a", and returns a new function that will add "a" to
any argument it is passed:

 % set plus2 [make-adder 2]
 ::apply {{__env__ b} {dict with __env__ { expr {$a + $b} }} ::} {a 2}
 % eval $plus2 3
 5
 % eval $plus2 8
 10
 % eval $plus2 [eval [make-adder 5] 3]
 10

OK, apart from the ugly string representation of our adder functions, everything seems to
work correctly. Let's try some more advanced examples. Here we show how similar closures are
to objects, by creating a simple ''person'' "class", complete with instances and methods.
Like an object, this is an example of ''procedural abstraction'' in that we have hidden the
details of our person instances inside a function which only allows you to invoke defined
methods:

 % func person {name age} {
     set getName [func {} { return $name }]
     set getAge  [func {} { return $age  }]
     return [func {method args} { eval [set $method] $args }]
 }
 ::person
 % set neil [person "Neil Madden" 25]
 ::apply ... (lengthy string rep elided) ...
 % eval $neil getName
 Neil Madden
 % eval $neil getAge
 25

We can start tidying this up a bit by creating "class" and "method" functions that hide
some of this [boilerplate]:

 proc class {name slots body} {
     func $name $slots {
         eval $body
         func {method args} { eval [set $method] $args }
     }
     return $name
 }
 proc method {name params body} {
     uplevel 1 "set $name \[func [list $params] [list $body]\]"
 }
 proc send {object args} { uplevel 1 $object $args }

Now our code starts looking a bit more familiar:

 % class Point {x y z} {
     method getX {} { return $x }
     method getY {} { return $y }
     method getZ {} { return $z }
     method add p2 {
         Point [+ $x [send $p2 getX]] \
               [+ $y [send $p2 getY]] \
               [+ $z [send $p2 getZ]]
     }
     method toString {} { return "($x,$y,$z)" }
 }
 Point
 % proc + {a b} { expr {$a + $b} }
 +
 % set p1 [Point 3 4 5]
 ... (much stuff!) ...
 % set p2 [send $p1 add $p1]
 ... (more stuff) ...
 % puts "p2 = [send $p2 toString]"
 p2 = (6,8,10)

As you can see, there is still a way to go before something like this rivals serious OO
frameworks like [XOTcl] or [Incr Tcl], but hopefully it shows that you can do quite a lot
with very little code in Tcl 8.5. It is also worth noting that these objects, like [TOOT]
objects, are ''values'': they are automatically cleaned up when no longer referenced.
If nothing else, this gives a nice little demo of some of the powerful new features in Tcl
8.5, and another perspective on what an object is.

----
[[ [Category Example] | [Category Object Orientation] ]]