More functional programming

NEM 20Mar2004 - I've been thinking a bit recently about some of the ideas on this wiki for doing functional programming in Tcl, like at Lambda in Tcl, and thought I'd add yet another take on it. This method also combines some of the more radical ideas from Getting rid of the value/command dichotomy for Tcl 9 - namely unifying the variable/command namespaces, and slightly changing the command resolution procedure to allow auto-expanding of leading words (this makes functions as values easier to do, as shown below). The package below implements all of these ideas. It's not very efficient (lambdas aren't byte-compiled, relies on [unknown] etc), but it's quite fun to play with. Also provided are some common higher-order functions (map, filter, compose, foldl, foldr). Note also, that these lambdas really are values (and aren't just cleverly named procs) - so they have the benefit of Tcl's reference-counting memory management (they go away when nothing refers to them). Hope you like it!

See also Functions As Values for another way to do almost exactly the same thing. There are a couple of difference - notably the string rep choosen for anonymous functions, and the method for evaluating the body.

To use, just package require and namespace import -force funtcl::* (you don't have to import, but it makes things a bit easier, and registers the unknown handler). If you want the lambdas etc, without the more radical unification of command and var namespaces (not totally decided on that myself), then just delete the first two clauses in the funtcl::unknown handler. You will then have to prefix lambdas with $, like so:

 if {0} {
     set a [lambda {a b} { expr {$a + $b} }]
     $a 1 2
     a 1 2 ;# ambiguous command name "a"...
 }

21Mar04 Update: I've disabled the unifying of command and variable namespaces by default. It's not a good idea for Tcl I think, as it breaks too many extensions. You can re-enable the functionality by adding "proc" to the export list, and uncommenting a few lines in the funtcl::unknown handler.


 # funtcl --
 #
 #   Morphs the current interpreter into one based on functional programming
 #   ideas. Does a number of things:
 #   - Unifies command and variable namespaces (optional)
 #   - Defines a [lambda] command for defining first-class function values
 #   - Redefines [proc] in terms of lambda
 #   - Supplies some common higher-order functions
 #

 package provide funtcl 0.2

 namespace eval funtcl {
     namespace export lambda map filter foldl foldr compose fix curry
     #namespace export proc
 }
 # First up - create the lambda command
 interp alias {} ::funtcl::lambda {} list ::funtcl::apply
 interp alias {} ::funtcl::curry {} list

 # Apply - used for the lambda. This and the next proc go to rather absurd
 # lengths to make this work just like a proc - no variables are visible to the
 # body of the lambda other than those which are defined by argument passing,
 # and any which are retreived through global/upvar etc. The lambda always
 # executes in the funtcl namespace though...
 proc funtcl::apply {arglist body args} {
     # This bit of magic ensures that only args defined in the arglist actually
     # get defined (as far as the body is concerned).
     ApplyArgs [K $body [unset body]] \
         [K $arglist [unset arglist]] [K $args [unset args]]
 }

 # Sets up variables in the callers scope according to the argument spec given,
 # and the actual arguments passed. This should behave exactly like Tcl's
 # argument passing to procedures.
 proc funtcl::ApplyArgs {body argspec arglist} {
     set index 0
     array set ret {}
     foreach item $argspec {
         if {$index < [llength $arglist]} {
             if {[lindex $item 0] eq "args" && 
                 $index == ([llength $argspec]-1)} {
                 # Deal with remaining args
                 set ret(args) [lrange $arglist $index end]
                 set index [llength $arglist]
             } else {
                 set ret([lindex $item 0]) [lindex $arglist $index]
             }
         } elseif {[llength $item] == 2} {
             set ret([lindex $item 0]) [lindex $item 1]
         } else {
             # Possibly not enough args
             if {$item eq "args" && $index == ([llength $argspec]-1)} {
                 # ok
                 set ret(args) [list]
             } else {
                 # Build up a good error message
                 set err "wrong # args: should be \""
                 # Grab how we were invoked from [info level]
                 set cmdname [lindex [info level -1] 0]
                 append err $cmdname
                 foreach item $argspec {
                     if {[llength $item] == 1} {
                         append err " $item"
                     } else {
                         append err " ?${item}?"
                     }
                 }
                 append err "\""
                 error $err
             }
         }
         incr index
     }
     # Any left over?
     if {$index < [llength $arglist]} {
         if {[lindex $argspec end 0] eq "args"} {
             for {set i $index} {$i < [llength $arglist]} {incr i} {
                 lappend ret(args) [lindex $arglist $i]
             }
         } else {
             error "too many args to lambda"
         }
     }
     # Add these all to caller's scope
     foreach {name value} [array get ret] {
         upvar 1 $name n
         set n $value
     }
     # Finally, uplevel the body
     uplevel 1 $body
 }

 # "Fix" a lambda to a proc. Also works with curried commands.
 proc funtcl::fix {name lambda} {
     uplevel 1 [list interp alias {} $name {} $lambda]
 }

 # Redefine proc in terms of set and lambda
 proc funtcl::proc {name arglist body} {
     uplevel 1 [list set $name [lambda $arglist $body]]
 }

 # Maps a function to each element of a list, and returns a list of the
 # results.
 proc funtcl::map {func list} {
     set ret [list]
     foreach item $list {
         lappend ret [eval $func [list $item]]
     }
     return $ret
 }

 # Filters a list, returning only those items which pass the filter.
 proc funtcl::filter {func list} {
     set ret [list]
     foreach item $list {
         if {[eval $func [list $item]]} {
             lappend ret $item
         }
     }
     return $ret
 }

 # Useful higher-order functions which replace common uses of recursion
 # foldl (fold left)
 # foldl - 0 {1 2 3} -> ((0-1)-2)-3
 proc funtcl::foldl {func default list} {
     set res $default
     foreach item $list {
         set res [eval $func [list $res $item]]
     }
     return $res
 }

 # foldr (fold right)
 # foldr + 0 {1 2 3} -> 1+(2+(3+0))
 proc funtcl::foldr {func default list} {
     set tot $default
     # Go in reverse
     for {set i [llength $list]} {$i > 0} {incr i -1} {
         set tot [eval $func [list [lindex $list [expr {$i-1}]] $tot]]
     }
     return $tot
 }

 # compose - compose two functions together
 # [compose f g] $args -> f [g $args]
 proc funtcl::compose {f g} {
     return [lambda {args} "$f \[eval [list $g] \$args\]"]
 }
 # The K combinator - obscure, but very useful.
 proc funtcl::K {a b} { set a }

 # The unknown handler which makes the magic work...
 proc funtcl::unknown {cmd args} {
     # Uncomment these lines to unify command/var namespaces
     #if {![catch {uplevel 1 set $cmd} val]} {
     #    # It's a varname in callers scope - deref and try again
     #    uplevel 1 [list $val] $args
     #} elseif {![catch {uplevel #0 set $cmd} val]} {
     #    # Varname at global scope
     #    uplevel 1 [list $val] $args
     #} elseif {[llength $cmd] > 1} 
     if {[llength $cmd] > 1} {
         # Try to expand and try again
         uplevel 1 $cmd $args
     } else {
         # Call Tcl's usual unknown handler
         uplevel 1 [list funtcl::orig_unknown $cmd] $args
     }
 }

 # Save the original unknown command for later use
 catch {
     rename ::unknown funtcl::orig_unknown
     # Alias it to our version...
     interp alias {} ::unknown {} ::funtcl::unknown
 }

A few examples of use (with unified command/var namespaces):

 % package require funtcl
 0.1
 % namespace import -force funtcl::*
 % set + [lambda {a b} { expr {$a + $b} }]
 ::funtcl::apply {a b} { expr {$a + $b} }
 % # Use the foldr function to make a sum command
 % set sum [curry foldr + 0]
 foldr + 0
 % sum {1 2 3}
 6
 % # Use compose, to create a command which sums a sorted list (!)
 % set sum_sorted [compose sum lsort]
 ::funtcl::apply args {sum [eval [list lsort] $args]}
 % sum_sorted {3 4 1}
 8
 % # Demonstrate how [proc] is now defined in terms of lambda
 % proc foo {} { puts "Hello, World!" }
 ::functcl::apply {} { puts "Hello, World!" }

Well, you get the picture. Everything mostly works as you would expect. There may be some edge cases left still - but this is just a quick fun project! But maybe there are some interesting ideas in here for Tcl 9? Unifying command and variable namespaces is perhaps a bit controversial. Automatic expansion of leading word might be interesting though. Being able to have byte-coded lambdas would also be great!