Iterator using Closures

An example of implementing iterators using Closures. This is just an experiment!!! -- Todd Coram

The code below (using code from Closures) allows us to create a simple input iterator command in pure Tcl that works with strings, lists, channels and ranges of numbers. This way we can write truly "generic" functions in Tcl that operate on the above without knowledge of type.

Scroll to the bottom for examples.

 make-closure-proc input_iterator {_type _target} {
    variable type $_type
    variable target {$_target}
    variable pos -1
    variable end -1
 } {
    variable type;
    switch -glob -- $type {
        -str* {
            set end [string length $target]
            set currentbody {
                return [string index $target $pos]
            }
            set nextbody {
                incr pos
                if {$pos >= $end} {
                    return {}
                }
                return [string index $target $pos]
            }
        }
        -li* {
            set end [llength $target]
            set currentbody {
                return [lindex $target $pos]
            }
            set nextbody {
                incr pos
                if {$pos >= $end} {
                    return {}
                }
                return [lindex $target $pos]
            }
        }
        -chan* {
            set line ""
            set end {}
            set currentbody {
                return $line
            }
            set nextbody {
                if {[eof $target]} {
                    return {}
                }
                return [set line [gets $target]]
            }
        }
        -rang* {
            set end [lindex $target 1]
            set pos [expr {[lindex $target 0]  - 1}]
            set currentbody {
                return $pos
            }
            set nextbody {
                if {$pos >= $end} {
                    return {}
                }
                return [incr pos]
            }
        }
        default {
            error "input_iterator: bad option \"$type\": must be -string, -list, -channel or -range"
        }
    }

    proc get {{_next {}}} \
        "variable target; variable pos; variable end; 
         if {\$_next != {}} {$nextbody} else {$currentbody}"
    return [namespace current]::get
 }



 make-closure-proc output_iterator {_type _target} {
    variable type $_type
    variable target $_target
 } {
    variable type;
    switch -glob -- $type {
        -str* {
            set nextbody {
                append target_ref $val
            }
        }
        -li* {
            set nextbody {
                lappend target_ref $val
            }
        }
        -chan* {
            set nextbody {
                puts $target $val
            }
        }
        default {
            error "output_iterator: bad option \"$type\": must be -string, -list, or -channel"
        }
    }
    proc out {val} \
        "variable target; upvar \$target target_ref; $nextbody"
    return [namespace current]::out
 }

Here are a few examples:

 set i1 [input_iterator -string "hello world"]
 set i2 [input_iterator -list {hello world}]
 set i3 [input_iterator -channel [open somefile.txt r]]
 set i4 [input_iterator -range {1 100}]

 proc count {iter} {
   set count 0
   while {[$iter next] != {}} {
     incr count
   }
   return $count
 }

 count $i1 ;# returns 11
 count $i2 ;# returns 2
 count $i3 ;# returns the number of characters in the file.
 count $i4 ;# returns 100

Now, let's define some generic functions!

 proc copy {in out} {
    while {[set v [$in next]] != {}} {
        uplevel [list $out $v]
    }
 }

 proc copy_if {in out cmd} {
    while {[set v [$in next]] != {}} {
        if {[$cmd $v]} {
            uplevel [list $out $v]
        }
    }
 }

 proc find {in what} {
    while {[set v [$in next]] != {}} {
        if {$v == $what} {
            return $v
        }
    }
    return {}
 }


 proc map {in out cmd} {
    while {[set v [$in next]] != {}} {
        uplevel $out [eval $cmd $v]
    }
 }

Here are examples on how to (ab)use them:

  proc double {x} {expr {$x * 2}}
  set out [output_iterator -chan stdout]
  map [input_iterator -range {0 10}] $out double
  map [input_iterator -list {1 2 3 4 5}] $out double
  map [input_iterator -chan stdin] $out double ;# double every number entered on the console (1 per line)
  map [input_iterator -string "12345"] $out double ;# this doesn't do what you may expect ;-)

The map proc looks better using lambda:

  map [input_iterator -range {0 10}] $out [lambda x {expr {$x * 2}}]

copy is particularly interesting:

 copy [input_iterator -chan $file1] [output_iterator -chan $file2]; # copy 1 file into another
 copy [input_iterator -chan $file1] [output_iterator -list l]; # copy a file into a list
 copy [input_iterator -range {0 10000}] [output_iterator -chan stdout]; # output the range

 # copy a list into a file.
 #
 set ofile [open /tmp/input.dat w]
 copy [input_iterator -list {
    "# this is a test file with comments"
    "First line"
    "Second line"
    "   # another comment"
    "Third line."}] [output_iterator -chan $ofile]
 close $ofile

 # Now, let's make a copy but without the comment lines
 #
 set ifile [open /tmp/input.dat r]
 set ofile [open /tmp/output.dat w]

 copy_if [input_iterator -chan $ifile] \
    [output_iterator -chan $ofile] \
    [lambda v { return [expr {![string match "\#*" [string trim $v]] }]}]

  close $ifile
  close $ofile

Tweaks, bug fixes and more interesting examples added 9/03/02 -- Todd Coram

DKF: 8.6 has coroutines, making iterators simple.

proc iter {from to} {
   set name iter[incr ::iterCounter]
   tcl::unsupported::coroutine $name apply {{a b} {
      tcl::unsupported::yield
      for {set i $a} {$i <= $b} {incr i} {
         tcl::unsupported::yield $i
      }
      return -code break
   }} $from $to
   return $name
}

set it [iter 1 10]
while 1 {
   puts "got [$it]"
}