Closures in Tcl

While closely following the discussions spawned from the recent Tcl/Tk 9.0 release, I've noticed a point that keeps coming up: the absence of closures. Usually the cue for every Tcl hacker in the world (a very large mob, let me tell you) to start showcasing various contraptions to emulate them. So here's my turn.

What kind of closures §

But first, let me explain that what I think of when I read the word "closure". You see, most C++ers would say that this is a closure:

#include <cstdio>

auto make_counter(int x = 0)
{
    return [x]() mutable {return ++x;};
}

int main(void)
{
    auto counter = make_counter();
    printf("counter: %d\n", counter()); // => counter: 1
    printf("counter: %d\n", counter()); // => counter: 2
}

But the environment isn't closed over here, it's simply copied and this copy is then allowed to be mutated. You could capture x by reference, but then it'd become a dangling reference outside its scope (thus lifetime, for stack variables)… Let's see how Python works in comparison:

def make_counter(x=0):
    def counter():
        nonlocal x
        x += 1
        return x
    counter()
    print(f'x: {x}') # => x: 1
    return counter

counter = make_counter()
print(f'counter: {counter()}') # => counter: 2
print(f'counter: {counter()}') # => counter: 3

As you can see here, the closed over variable is truly captured, not just its value, but the closure stays valid outside its scope. In C++, this could be achieved if all local variables were in fact std::shared_ptr captured by value.

You might wonder why you'd ever need such a strange behaviour, right? Well, I've encountered this use case a few times in Lisp:

(defun tree-walk (tree callback)
  ...)

(defun find-integer-nodes (tree)
  (let ((result))
    (tree-walk tree (lambda (node)
                      (if (integerp node)
                          (push node result))))
    result))

where a callback is used to collect various items. Again, this specific case would work using capture-by-reference in C++, but it's nice to know these closures also work outside their scope because variable lifetime is tied to their binding.

If you have some mental energy to spare, I strongly recommend this fantastic article about the nitty-gritty of closures (actually, binding scope and lifetime) in ANSI Common Lisp to better understand the subtleties at play.

In Tcl §

Tcl being a very small language, it doesn't have lambdas or closures builtin, but we did get apply with 8.5! A dead simple wrapper later, and we have our lambdas and even partial application as a one-liner bonus:

proc lambda {args body {ns ""}} {
    if {$ns eq ""} {
        set ns [uplevel 1 namespace current]
    }
    list apply [list $args $body $ns]
}

set l [lambda args {puts $args}]
{*}$l c "d e"; # => "c {d e}"

# Partial application of {*} style callables
proc papply {callable args} {
    concat $callable $args
}

But for closures, the task does seem a little harder… because while values are reference counted, variable bindings disappear once their stack frame is destroyed. The only way to keep those variables alive is by storing them in a namespace or maybe in the top-level stack frame.

Since TclOO (the builtin object system) is a clean way to instantiate uniquely named namespaces, that's what I went with:

 namespace eval closure {
    proc new {vars args body {ns ""}} {
        if {$ns eq ""} {
            set ns [uplevel 1 namespace current]
        }
        list [closure_class new $vars $args $body $ns] apply
    }
    # Simply forward to closure_class
    proc destroy {closure} {[lindex $closure 0] destroy}
    proc lexenv {closure args} {[lindex $closure 0] lexenv {*}$args}

    oo::class create closure_class {
        constructor {vars args body ns} {
            variable fun [list $args [string map [list @ [list $body]] {
                upvar 1 lexenv lexenv
                dict with lexenv @
            }] $ns]
            variable lexenv [dict create]
            foreach var $vars {
                if {[llength $var] == 2} {
                    dict set lexenv {*}$var
                } else {
                    dict set lexenv $var [uplevel 2 set $var]
                }
            }
        }

        method apply args {
            my variable fun lexenv
            apply $fun {*}$args
        }

        method lexenv {{var ""}} {
            my variable lexenv
            if {$var ne ""} {
                dict get $lexenv $var
            } else {
                set lexenv
            }
        }
    }

    namespace export new lexenv destroy
    namespace ensemble create
}

set i 0
set counter [closure new {i} {} {incr i}]
# Same as [closure new {{i 0}} {} {incr i}]
puts "counter: [{*}$counter]"; # => counter: 1
puts "counter: [{*}$counter]"; # => counter: 2
puts "lexenv: [closure lexenv $counter]"; # => lexenv: i 2
puts "lexenv: [closure lexenv $counter i]"; # => lexenv: 2
closure destroy $counter; # Needed to avoid leaks

In the end, I had the same limitations as the C++ version (environment being copied), but being able to access the stored environment via that lexenv method does make the aforementioned gathering trick possible, even if a bit different in appearance.

The destroy method call being necessary until TIP 550 is implemented is a bit of a pain, but that's how it is.

In the craziest parts of my mind, I did imagine an environment writeback after each apply method call together with a way to disable that once leaving the stack frame where the closure was created (via an uplevel'd defer) but I'll let the idea sit for a while.