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). Hope you like it!
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).
# funtcl --
#
# Morphs the current interpreter into one based on functional programming
# ideas. Does a number of things:
# - Unifies command and variable namespaces
# - 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.1
namespace eval funtcl {
namespace export lambda proc map filter foldl foldr unknown compose
}
# First up - create the lambda command
interp alias {} ::funtcl::lambda {} list ::funtcl::apply
# 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]} {
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 -2] 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 {[info exists ret(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
}
# 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 $item $res]]
}
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 \[$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} {
if {[lindex $cmd 0] eq "::funtcl::apply"} {
uplevel 1 $cmd $args
} elseif {[uplevel 1 [list info exists $cmd]]} {
# It's a var
uplevel 1 [uplevel 1 [list set $cmd]] $args
} elseif {[uplevel #0 [list info exists $cmd]]} {
# Global var (we keep same command resolution scheme as Tcl)
uplevel 1 [uplevel #0 [list set $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
rename ::unknown funtcl::orig_unknown
# And alias it back for now
interp alias {} ::unknown {} ::funtcl::orig_unknownA few examples of use:
% 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 {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 [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 toy!