Version 2 of A plugin replacement for proc supporting lambdas and ensembles

Updated 2008-01-21 22:01:39 by lars_h

NEM 2008-01-21: A rather long title for a simple page. This is a simple backwards-compatible replacement for the built-in proc command that generalises the procName argument to be optional or to consist of several words. If no procName is given then the command constructs and returns an anonymous procedure (based on apply) that can be used with eval or uplevel and various callbacks. With multiple procName arguments, the command creates a series of namespace ensembles automatically for the command. Some examples of use:

===proc foo {a b} { expr {$a + $b} }===
Works as now.
===set a [proc {a b} { expr {$a + $b} }]; eval $a 1 2===
Anonymous procedure/lambda.
===proc mycmd foo {a b} { expr {$a + $b} }; mycmd foo 1 2===
Ensembles.

Code

# proc.tcl --
#
#       A compatible replacement for [proc] that supports both creating
#       anonymous procedures and for creating namespace ensembles, by
#       generalising the name parameter to accept 0 or more arguments. For
#       instance:
#
#           proc foo {args} { ... } ;# as now
#           set a [proc {args} { ... }] ;# lambda
#           proc mydict foo {args} { ... } ;# ensemble
#
# Author: Neil Madden, 2008.
# This software is placed in the public domain.
#

package require Tcl 8.5
package provide proc 1.0

# Move original into the ::tcl namespace
if {[llength [info commands ::tcl::proc]] == 0} {
    rename ::proc ::tcl::proc
}

::tcl::proc ::proc args {
    if {[llength $args] < 2} {
        error "wrong # args: should be \"proc ?name...? params body\""
    }
    if {[llength $args] == 2} {
        # Lambda
        lassign $args params body
        set ns [uplevel 1 { namespace current }]
        return [list ::apply [list $params $body $ns]]
    } else {
        set name [lrange $args 0 end-2]
        set params [lindex $args end-1]
        set body [lindex $args end]
        set cmd [list ::tcl::proc [lindex $name end] $params $body]
        foreach ns [lreverse [lrange $name 0 end-1]] {
            set cmd [list namespace eval $ns $cmd]
        }
        # Define the procedure
        uplevel 1 $cmd
        # Now define all the necessary ensembles
        set cmd {namespace export %s; namespace ensemble create}
        for {set i 0} {$i < [llength $name]-1} {incr i} {
            set ns [join [lrange $name 0 $i] ::]
            set cm [list namespace eval $ns [format $cmd [lindex $name $i+1]]]
            uplevel 1 $cm
        }
    }
}

enter categories here