[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_unknown

----

A 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!