if 0 {[Richard Suchenwirth] 2005-03-17 - [Jim] is a fantastic
proving-ground for "tomorrow's Tcl today". As a super-subset of [Tcl], it adds
very interesting new features, while lacking many others
(from [regexp] to Unicode support, Tk...) I wanted to have my Tcl cake and
eat Jim too, so I hacked up this "Jimulation" that runs in my 8.4.5 (on
W95!), and provides exactly those [Jim] features needed for
[Tiny OO with Jim]:
   * [proc] and [lambda] with optional [closures]
   * prefix math for + - * /
   * lmap 
[Garbage collection] is missing, though.- Feel free to add more as needed!
}
 catch {rename proc 'proc} ;#-- good for repeated sourcing
 'proc proc {name argl args} {
    switch [llength $args] {
        1   {foreach {body stat} $args break ;# dirty trick yet elegant :)}
        2   {foreach {stat body} $args break}
        default {error "usage: proc name arglist ?statics? body"}
    }
    set prefix ""
    if [llength $stat] {
        namespace eval ::Jim {namespace eval closure {}}
        set ns ::Jim::closure::$name
        foreach var $stat {
            if {[llength $var]==1} {lappend var [uplevel 1 set $var]}
            namespace eval $ns [linsert $var 0 variable]
            set vname [lindex $var 0]
            append prefix "upvar 0 ${ns}::$vname $vname\n"
        }
     }
     'proc $name $argl $prefix$body
 }
#-- A first test, will also be needed in [lambda]...
 proc intgen {} {{i -1}} {incr i}
#-- ...and now for the anonymous function generator itself:
 'proc lambda {argl args} {
    switch [llength $args] {
        1   {foreach {body stat} $args break}
        2   {foreach {stat body} $args break}
        default {error "usage: lambda arglist ?statics? body"}
    }
    K [set name lambda[intgen]] [proc $name $argl $stat $body]
 }
#-- I couldn't resist to use the glorious [K] combinator here :)
 proc K {a b} {set a}
#-- export [expr] operators as prefix binary functions:
 foreach op {+ - * /} {'proc $op {a b} "expr {\$a $op \$b}"}
#-- [[lmap]] (a "collecting [foreach]") is a good one, too:
 'proc lmap {_var list body} {
    upvar 1 $_var e
    set res {}
    foreach e $list {lappend res [uplevel 1 $body]}
    set res
 }
#-- quick test: 
 puts [lmap i {1 2 3 4} {* $i $i}]
if 0 {should print
 1 4 9 16
Now for the proof of the pudding: the code from [Tiny OO with Jim]
should work if I've done it all right... and it does here :}
 source bank.tcl
if 0 {
----
[Arts and crafts of Tcl-Tk programming]
}