Posted to tcl by kostix at Sun Aug 17 11:34:53 GMT 2008view raw

  1. rename unknown unknown.orig
  2.  
  3. proc unknown {name args} {
  4. if {[string match lmap* $name]} {
  5. eval mlmap [string range $name 4 end] $args
  6. } else {
  7. eval unknown.orig $name $args
  8. }
  9. }
  10.  
  11. proc mlmap {n s L} {
  12. set v {}; set i 0; set b ""
  13. set N [expr {$n == "" ? 1 : $n}]
  14. if {$N == 0} { error "invaild lmap factor: 0" }
  15. while {[incr i] <= $N} {
  16. append b "upvar 1 $i $i\n"
  17. lappend v $i
  18. }
  19. append b "
  20. set out {}
  21. foreach [list $v] \$L {
  22. lappend out \[uplevel 1 \$s\]
  23. }
  24. set out
  25. "
  26. proc lmap$n {s L} $b
  27. lmap$n $s $L
  28. }
  29.  
  30. Examples:
  31.  
  32. % info comm lmap*
  33. % lmap {expr {$1 + 3}} {1 2 3 4 5 6}
  34. 4 5 6 7 8 9
  35. % info comm lmap*
  36. lmap
  37. % lmap2 {expr {$1*$2}} {1 2 3 4 5 6}
  38. 2 12 30
  39. % info comm lmap*
  40. lmap lmap2
  41. % info args lmap2
  42. s L
  43. % info body lmap2
  44. upvar 1 1 1
  45. upvar 1 2 2
  46. set out {}
  47. foreach {1 2} $L {
  48. lappend out [uplevel 1 $s]
  49. }
  50. set out
  51. % lmap3 {expr {$1*$2+$3}} {1 2 3 4 5 6}
  52. 5 26