lambda.tcl

#
# 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 
}