|
 |
(use "save as..." on this link (lambda.tcl) if you want to save and use locally)
#
# lisp like functions for Tcl
#
# $Id: lambda.tcl,v 1.4 1994/01/03 21:59:39 dl Exp dl $
#
# 1993 by DL
#
# $Log: lambda.tcl,v $
# Revision 1.4 1994/01/03 21:59:39 dl
# -> english
#
# Revision 1.3 1993/12/29 16:09:41 dl
# chgt keyword
#
# Revision 1.2 1993/12/29 16:07:27 dl
# ajout keywrd
#
#
# double check lambda_test.tcl to see error conditions, syntax, etc...
###
# utils
###
# proc nullp : return 1 if arg == {}, 0 otherwise
proc nullp arg {
expr {"$arg"=={}}
}
# proc p : return 1 if arg != {}, 0 otherwise
proc p arg {
expr {"$arg"!={}}
}
####
# recursiv mapping of a list, applying a function to
# each element
####
proc mapply {func list} {
if {[llength $list]>1} {
set res {}
foreach elem $list {
lappend res [mapply $func $elem]
}
return $res
}
eval $func [list $list]
}
########
# lambda
########
set lambdaNum 0
proc lambda {params body args} {
global lambdaNum
set curv [incr lambdaNum]
proc lambda_$curv $params $body
if [p $args] {
set err [catch "eval lambda_$curv $args" res]
rename lambda_$curv {}
if $err {
regsub "( to )?\"lambda_$curv\" ?" $res {} res
error "lambda {$params} {$body} $args : $res" $res
}
return $res
} else {
return lambda_$curv
}
}
#
#
#
# sample use :
#
# mapply {lambda {x} {expr 2*($x)}} {1 -2 {-3 3} 4+4 5-6}
# -> {2 -4 {-6 6} 16 -2}
#
# less trivial use : [that shows the need of ` macros and real lexical
# closures]
#
###
# listKmul : returns a function that can recursively multiplicate a
# list by a given parameter
###
proc listKmul {k} {
set l1 "lambda {x} {expr ($k)*\$x}"
lambda {list} "mapply {$l1} \$list"
}
# set km3 [listKmul 3]
# set km5 [listKmul 5]
# $km3 {1 -2 {-3 3} 4+4 5-6}
# -> 3 -6 {-9 9} 16 9
# $km5 {1 -2 {-3 3} 4+4 5-6}
# -> 5 -10 {-15 15} 24 19
###
# cleanup lambda_'s
###
proc lambdaClean {} {
global lambdaNum
set lambdas [info procs lambda_*]
if [p $lambdas] {
mapply {lambda {x} {rename $x {}}} $lambdas
}
set lambdaNum 0
}
Tcl top | Overview | TclRCX | Tcl Plug-in | Apps.& Ext. | More Links
© 1994-2009
Laurent Demailly,
Last update: Sat Oct 24 1998
|