This is a drop-in replacement for the standard for command. It supports an expanded syntax for looping over iterators, and is fully compatible with the standard for command. It can be downloaded as a part of ycl, or copied straight from this page. The [package require] command is not required, but indicates how to use this command as part of ycl.
package require ycl::iter for {varname1 ...} in iterator_name1 [{varname {varnameX ... } in iterator_nameX] ... script
like foreach does with list, it can operate on multiple iterators and take an arbitrary number of items each time from each iterator. Also like foreach, empty strings are produced as necessary for any iterator which becomes depleted before the others.
note that [return -code break] within an iterator will cause the for loop to break, so it should be used with care.
newer code may be available in the ycl repository
rename ::for for_core interp alias {} ::for {} [namespace current]::for proc for args { if {[lindex $args 1] eq "in"} { if {[llength $args] % 3 != 1} { return -code error "wrong # of arguments" } set iters [::dict create] set vars [::dict create] while {[llength $args] > 1} { set args [lassign $args[unset args] varnames /dev/null iter] if {$iter ne {} && [uplevel [::list namespace which $iter]] eq {}} { return -code error "no such iterator: $iter. Maybe \[foreach] was intended?" } ::dict set iters $iter 1 ::dict set vars $varnames $iter } set body [lindex $args[set args {}] 0] while {[::dict size $iters]} { set newvals[set newvals {}] [::dict create] ::dict for {varnames iter} $vars { foreach varname $varnames { if {[namespace which $iter] eq {}} { dict set newvals $varname {} } else { ::dict set newvals $varname [uplevel [::list $iter]] if {[namespace which $iter] eq {}} { ::dict unset iters $iter ::dict set newvals $varname {} } } } } if {[::dict size $iters]} { ::dict for {varname val} $newvals { uplevel [::list variable $varname $val] } uplevel $body } else { break } } } else { uplevel [::list [namespace current]::for_core {*}$args] } }
DKF: I suggest using:
if {[lindex $args 1] ne "in"} { tailcall for_core {*}$args }
(The for_core will be resolved in the current context, so it needs no namespace prefixing.)
This older version didn't take care to leave variables in their last-used state
rename ::for for_core interp alias {} ::for {} [namespace current]::for proc for args { if {[lindex $args 1] eq "in"} { if {[llength $args] % 3 != 1} { return -code error "wrong # of arguments" } set assigns {} set assign_template { if {[namespace which $iter] eq {}} { variable $varname {} } else { variable $varname [$iter] if {[namespace which $iter] eq {}} { variable $varname {} } } } set conditions {} set condition_template {[namespace which $iter] ne {}} while {[llength $args] > 1} { set args [lassign $args[unset args] varnames /dev/null iter] if {$iter ne {} && [uplevel [::list namespace which $iter]] eq {}} { return -code error "no such iterator: $iter. Maybe \[foreach] was intended?" } foreach varname $varnames { lappend assigns [::string map [::list \$iter [::list $iter] \$varname [::list $varname]] \ $assign_template] } lappend conditions [::string map [::list \$iter [::list $iter]] $condition_template] } set assigns [join $assigns \n] set args [join $args \n] uplevel "while {[join $conditions { || }]} { $assigns if {!([join $conditions { || }])} { break } $args }" } else { uplevel [::list [namespace current]::for_core {*}$args] } }
namespace eval basket { set items [list apples oranges bananas kiwis pears] set current 0 proc next {} { variable items variable current if {$current < [llength $items]} { return [lindex $items [expr {[incr current]-1}]] } rename [info level 0] {} } } set result [list] for fruit in basket::next { lappend result $fruit } puts $result
produces
apples oranges bananas kiwis pears
example
set result [list] for {key val} in [coroutine students apply {{} { yield [info coroutine] set db { Jack 97 Sally 89 Bob 83 Jill 77 John 72 } set index -1 foreach {name score} $db { yield $name yield $score } }}] prize in [coroutine prizes apply {{} { yield [info coroutine] foreach item { first second third } { yield $item } }}] { lappend result $key $val $prize } puts $result
produces:
Jack 97 first Sally 89 second Bob 83 third Jill 77 {} John 72 {}