|
(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 }
© 1994-2009 Laurent Demailly, Last update: Sat Oct 24 1998 |