Posted to tcl by kostix at Sun Aug 17 11:34:53 GMT 2008view pretty
rename unknown unknown.orig proc unknown {name args} { if {[string match lmap* $name]} { eval mlmap [string range $name 4 end] $args } else { eval unknown.orig $name $args } } proc mlmap {n s L} { set v {}; set i 0; set b "" set N [expr {$n == "" ? 1 : $n}] if {$N == 0} { error "invaild lmap factor: 0" } while {[incr i] <= $N} { append b "upvar 1 $i $i\n" lappend v $i } append b " set out {} foreach [list $v] \$L { lappend out \[uplevel 1 \$s\] } set out " proc lmap$n {s L} $b lmap$n $s $L } Examples: % info comm lmap* % lmap {expr {$1 + 3}} {1 2 3 4 5 6} 4 5 6 7 8 9 % info comm lmap* lmap % lmap2 {expr {$1*$2}} {1 2 3 4 5 6} 2 12 30 % info comm lmap* lmap lmap2 % info args lmap2 s L % info body lmap2 upvar 1 1 1 upvar 1 2 2 set out {} foreach {1 2} $L { lappend out [uplevel 1 $s] } set out % lmap3 {expr {$1*$2+$3}} {1 2 3 4 5 6} 5 26