Tcl Source Code

Artifact 6a0b5b68ea2e0fa1fa90adf7b49ea59077d48fc3:

Attachment "lambda.tcl" to ticket [940207ffff] added by msofer 2004-04-23 06:27:28.

---

#
# LAMBDA IMPLEMENTATION (TIP 187)
#

# The canonical form of the string rep of the lambda
# expressions will be
#
#     [lambda $argList $body] <==> 
#         ::${Prefix}[list $argList $body]
#
# Note that the prefix determines also if the expressions live 
# in a namespace different from ::
#
# The code tries to interpret as lambda expressions the command 
# names that satisfy
#        (1) [regsub "^\\s*:*\\s*$Prefix" $cmdName shortName] == 1
#        (2) [llength shortName] == 2

#
# Some of the suggested variants are:
#  set Prefix {lambda }        ;# closest to the TIP
#  set Prefix {tcl::lambda::} 
#  set Prefix {# }

set Prefix {# }

#

namespace eval ::tcl::lambda {

    proc lambda {argList body} [string map "\$Prefix {$Prefix}" {
	set name "::$Prefix[list $argList $body]"
	if {[info proc $name] == {}} {
	    Create $name $argList $body
	}
	set name 
    }]

    proc Create {name argList body} {
	uplevel \#0 [list proc $name $argList $body]
	uplevel \#0 [list ::tcl::unsupported::SetAutoCleaningCmd $name]
    }

    variable unknown [string map "\$lambdaRe {^\\s*:*\\s*$Prefix}" { 
	set cmdName [lindex $args 0]
	if {[regsub {$lambdaRe} $cmdName {} name]} {
	    if {[llength $name] == 2} {
		foreach {argList body} $name {}
		::tcl::lambda::Create $cmdName $argList $body
		return [uplevel 1 $args]
	    }
	}
	unset cmdName name
    }]

    unset Prefix
    namespace export lambda
}

namespace import ::tcl::lambda::lambda
proc unknown args ${::tcl::lambda::unknown}\n[info body unknown]