tcl-hacks

Check-in [b7c919f21e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:experiments in iterators
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:b7c919f21eccb21e6bebafa7aa2ce12341d0a97b
User & Date: aspect 2018-05-03 13:08:09
Context
2018-07-22
01:11
procmap changes for Tk Leaf check-in: 9191547c1f user: aspect tags: procmap-tk
2018-05-14
14:31
Add [getline]. This is mostly complete, and replaces the experimental mess that was lineedit with a better structured, more-capable almost-package. check-in: 625cf86df3 user: aspect tags: trunk
2018-05-03
13:08
experiments in iterators check-in: b7c919f21e user: aspect tags: trunk
12:46
add socks tamper tool check-in: 23cb074f5b user: aspect tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added hacks/miniter.tcl.



























































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
# composing filters over iterators is really composing a script
# maybe there's something in that?

proc putl args {puts $args}

#  definition helper to enforce iterator protocol.
proc defiter {name args body} {
    set pre { yield [info coroutine] }
    set post { while 1 {yieldto throw {ITERATOR DONE} "Iterator exhausted!" } }
    tailcall proc $name $args "$pre\n$body\n$post"
}

#  the essential iterator
defiter range_ {start stop step} {
    for {set i $start} {$i < $stop} {incr i} {
        yield $i
    }
}

# arg parsing wrapper
proc range {args} {
    set start 0
    set stop Inf
    set step 1
    switch [llength $args] {
        3 { lassign $args start stop step }
        2 { lassign $args start stop }
        1 { lassign $args stop }
        default { return -code error "Invalid arguments, expected <stop>, <start stop>, or <start stop step>" }
    }
    range_ $start $stop $step
}

#  iterator control:
proc start {args} {
    tailcall {*}$args
}
proc next {iter} {
    $iter
}
proc destroy {iter} {
    rename $iter {}
}
defiter memo {varName iter} {
    upvar 1 $varName cache
    foriter i $iter {
        lappend cache $i
        yield $i
    }
}

proc gensym {{name gensym#}} {
    regexp {(.*)(#\d*)?} $name -> name suffix
    set i -1
    while {[namespace which -command [set n $name#$i]] ne ""} { incr i }
    return $n
}

defiter dup {iter} {
    # nope, too wild
    set old [gensym $iter]
    rename $iter $old
    rename [memo cache $old] $iter
    start fromcache cache $iter
}

defiter fromcache {list iter}
proc push {iter args} {
    $iter {*}$args
}
proc done? {iter} {
}

#  control structure for consuming iterators:
proc foriter {args} {
    if {[llength $args] % 2 == 0} {
        return -code error "Invalid arguments, expected \"iterate varName iterable ?varName iterable ..? script\""
    }
    set script [lindex $args end]
    foreach {v i} [lrange $args 0 end-1] {
        lappend vars $v
        lappend iters $i
        append setup    [format {::set %s [start %s];}    [list $v] $i]
        append pre      [format {::set %s [next %s];}    [list $v]   [list $v]]
        append cleanup  [format {catch {rename %s ""}}          [list $i]]
    }
    set script $pre$script
    set script [list ::while 1 $script]
    puts $setup
    uplevel 1 $setup
    putl ::try $script trap {ITERATOR DONE} {} $cleanup
    tailcall ::try $script trap {ITERATOR DONE} {} $cleanup
}

#  conversions:
proc tolist {iter} {
    foriter i $iter {lappend result $i}
    lappend result
}
defiter fromlist {xs} {
    foreach x $xs {yield $x}
}

proc assert {expr {msg ""}} {
    if {$msg eq ""} {set msg $expr}
    if {![uplevel 1 [list ::expr $expr]]} {
        throw {ASSERT FAILED} $msg
    }
}

append test {
    assert {[tolist {range 10}] eq {0 1 2 3 4 5 6 7 8 9 10}}
    #assert {[iterator tolist [iterator fromlist {a b c d e}]] eq {a b c d e}}
}

#  filters: skipping elements
defiter take {n iter} {
    foriter i $iter {
        if {[incr n -1]<0} break
        yield $i
    }
}
defiter drop {n iter} {
    foriter i $iter {
        if {[incr n -1]>=0} continue
        yield $i
    }
}

#  filters: mixing
defiter iconcat args {
    foreach iter $args {
        foreach i $iter {
            yield $i
        }
    }
}

# interleave stops as soon as one iterator is exhausted
# it consumes them all - the still-open ones cannot be
# continued
defiter interleave {xs ys} {    ;# must break early!
    set xs [$xs]
    set ys [$ys]
    foriter _ [range] {
        yield [xs]
        yield [ys]
    }
}

# zip returns "" for missing elements
defiter zip {xs ys} {           ;# must break late!
    foriter x $xs y $ys {
        yield $x
        yield $y
    }
}

#  filters: conditions
# defiter ifilter {i_ iter cond} {
#     upvar 1 $i_ i
#     foreach i $iter {
#         if {!$cond} continue
#         yield $i
#     }
# }
# defiter iwhile {i_ iter cond} {
#     upvar 1 $i_ i
#     foreach i $iter {
#         if {!$cond} break
#         yield $i
#     }
# }
# defiter iuntil {i_ iter cond} {
#     upvar 1 $i_ i
#     foreach i $iter {
#         if {!$cond} break
#         yield $i
#     }
# }

# those are easier with:
defiter icase {_i iter args} {
    upvar 1 $_i i
    foreach i $iter {
        foreach {cond then} $args {
            if $cond $then
        }
        yield $i
    }
}
defiter ifilter {_i iter cond} { tailcall icase $_i $iter !($cond) continue }
defiter iwhile  {_i iter cond} { tailcall icase $_i $iter !($cond) break }
defiter iuntil  {_i iter cond} { tailcall icase $_i $iter $cond break }

defiter even {iter} {ifilter i $iter {$i % 2 == 0}}
defiter odd  {iter} {icase i $iter {$i % 2} continue}


# now, we've already seen a pattern where iterators are modified by a limited number of means.
# What constraints can we stand?

# an iterator that needs state:
defiter uniq {iter} {
    # we can cheat by instantiating the iterator twice!
    foriter j [take 1 $iter] {
        yield $j
    }
    # we have already yielded the first element as $j,
    # so it will be considered a dup.
    foriter i $iter {
        if {$i ne $j} {yield $i}
        set j $i
    }
}

set Nat {{}for {set x 0} {1} {$x+1} {yield $x}}

set Even? {{}for {} {} {} {if {$x%2} continue}}

eval $test