Updated 2016-02-15 18:07:12 by dbohdan

for ... in is a drop-in replacement for for. 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. package require is optional, and indicates how to use this command as part of ycl.

Synopsis  edit

package require ycl::iter
for {varname1 ...} in iterator_name1 [{varname {varnameX ... } in iterator_nameX] ... script 

Description  edit

This drop-in replacement for for is distributed with ycl, and is also presented below.

like foreach for lists, 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 is 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.

Changes  edit

PYK 2012-12-12: use set instead of variable. This fixes "already exists" error. Added tailcall per DKF's suggestion.

PYK 2013-10-28: fix to make relative procedure names work

Code  edit

newer code may be available in the ycl repository

tcllib is only needed for ErrorInfoAsCaller, which is trivial to remove.
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[set args {}] varnames /dev/null iter]
            if {$iter ne {} \
                && [set iter [uplevel [list namespace which $iter]]] eq {}} {
                return -code error \
                    "no such iterator: $iter.  Was \[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 unset iters $iter
                        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 set $varname $val]
                }
                set code [catch {uplevel $body} result]
                switch -exact -- $code {
                    0 {}
                    1 {
                        return -errorinfo [
                            ::control::ErrorInfoAsCaller uplevel for...in]  \
                        -errorcode $::errorCode -code error $result
                    }
                    3 {
                        # FRINK: nocheck
                        return
                    }
                    4 {}
                        default {
                        return -code $code $result
                    }
                }
            } else {
                break
            }
        }
    } else {
        if {[namespace which ::tailcall] ne {}} {
            tailcall for_orig {*}$args
        } else {
            uplevel [list [namespace current]::for_orig {*}$args]
        }
    }
}

This older version didn't take care to leave variables in their last-used state
package require control
namespace import ::control::ErrorInfoAsCaller
rename ::for for_orig
interp alias {} ::for {} [namespace current]::for

proc for_old 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]
        set code [catch {uplevel "while {[join $conditions { || }]} {
            $assigns
            if {!([join $conditions { || }])} {
                break
            }
            $args
        }"} result]
        switch -exact -- $code {
            0 {}
            1 {
            return -errorinfo [::control::ErrorInfoAsCaller uplevel for...in]  \
                -errorcode $::errorCode -code error $result
            }
            3 {
            # FRINK: nocheck
            return
            }
            4 {}
            default {
            return -code $code $result
            }
        }
    } else {
        if {[namespace which ::tailcall] ne {}} {
            tailcall for_orig {*}$args
        } else {
            uplevel [list [namespace current]::for_orig {*}$args]
        }
    }
}

Example:  edit

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 {}

See Also  edit

  • lcomp: List comprehension package that also uses "for ... in" notation