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