public
Created — forked from apg/generator-ttd.scm

generators (like python yield), in scheme, a language that doesn't normally have them.

  • Download Gist
generator-ttd.scm
Scheme
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
;; Deriving something like generators, but I didn't really feel like
;; doing exactly that.
 
;; It doesn't, for instance, support sending back into the generator
 
;; This applys a function across a range from 0 to x.
(define (apply-to-range f i x)
(when (< i x)
(f i)
(apply-to-range f (+ 1 i) x)))
 
;; (apply-to-range display 1 10) => #unspecified, but prints 123456789
 
;; At each step, it essentially does this.
;; Pass it a new value for i and apply the function `f'
(define (apply-to-range f x)
(lambda (i)
(when (< i x)
(f i))))
 
;; Essentially, here, we've separated the core logic from the
;; iteration. Big woop.
 
;; Let's modify this so that we can return it as a list.
(define (apply-to-range f i x)
(let loop ((i i)
(accum '()))
(if (< i x)
(loop (+ i 1) (cons (f i) accum))
(reverse accum))))
 
;; (apply-to-range - 1 10) => (-1 -2 -3 -4 -5 -6 -7 -8 -9)
 
;; Let's add the state back, but remove the iteration...
(define (apply-to-range f i x)
(let ((i i))
(lambda ()
(if (< i x)
(let ((current (f i)))
(set! i (+ 1 i))
current)))))
 
;; Now, we get to say:
;; (define counter (apply-to-range - 1 10)
;; (counter) => -1
;; (counter) => -2
;; ...
 
;; But, now while we get the desired results of a generator, which
;; returns after each value is returned, the program became clunky.
;; There isn't an obvious looping construct involved at all.
 
 
;; But, notice something. Essentially, we've replaced the value of `i'
;; on each invocation of the closure returned. Iteration was manual.
 
;; What if we could automatically replace the returned closure with a new
;; one that started at a different `i'?
 
 
;; First things first, if we still want the looping construct (we do),
;; how do we break out of the loop early?
;; Continuations!
(define (apply-to-range f i x)
(call-with-current-continuation
(lambda (bail)
(let loop ((i i))
(when (< i x)
(bail (f i))
(loop (+ 1 i))))))
;; calling `bail' puts us here, essentially breaking out of the loop.
)
 
;; So, now, we executed the loop code, but only called `f' once.
;; (apply-to-range - i 10) => -1
;; The loop is in the code, and we have no way of resuming it, once out.
 
;; What if we were able to save our spot where we exited and resume
;; there when we're ready?
 
;; The `bail' function represented the exit point of the function
;; `apply-to-range', can we represent the point in the program
;; where `bail' was called?
 
;; Sure! But, let's go one step further. Let's REPLACE the
;; `main-logic' function with that new frame of reference.
;; This is essentially the automatic replacement of the returned closure
;; like we wondered about before.
 
;; (we also add a sentinel to tell us we're done; the symbol done)
 
(define (apply-to-range f i x)
(letrec ((main-logic
(lambda (suspend)
(let loop ((i i))
(if (< i x)
(suspend 'done)
(begin
(call-with-current-continuation
(lambda (new-bail)
(set! main-logic (lambda (cont)
(set! suspend cont)
(new-bail i)))
(suspend (f i))))
; calling (new-bail) takes us here.
(display "continuing...")
(newline)
(loop (+ 1 i))))))))
(lambda ()
(call-with-current-continuation
(lambda (exit-function)
(main-logic exit-function))))))
 
;; So, let's talk about what's going on here.
 
;; First of all, we define a procedure `main-logic` which is the
;; main entry point into our iteration. It takes a single argument
;; called `suspend,' which we'll get back to in a second.
 
;; Within `main-logic', you can see our original loop, but instead
;; of our simple call to `bail' like before, we've got a complicated
;; mess.
 
;; Well, we first get the current continuation and slot that into
;; `new-bail.' When called, `new-bail' jumps to right before
;; our call to `(display "continuing...")' -- nothing note worthy
;; yet, as we've essentially seen that already above (we just moved
;; it the place we return to within the function instead of exiting
;; the function all together)
 
;; The first time through this code we don't even call `new-bail.'
;; Instead, we call the original `exit-function' continuation that
;; gets passed into `main-logic' on the first call to the closure
;; created by calling `apply-to-range,' but not before we setup a
;; new `main-logic' which replaces our suspend execution operator,
;; `suspend,' with a new function that resets `suspend' to the
;; continuation of the reinvocation of the closure.
 
;; Essentially, after we get a closure, `x,' returned by a call to
;; `apply-to-range,' reinvocations of `x' will always begin at the
;; call to `(display "continuing")' and when suspended, will call
;; the continuation of the call to `x.'
 
 
;; #;chicken-repl> (let ((counter (apply-to-range - 1 10)))
;; (let ((c1 (counter)))
;; (counter)
;; (let ((c2 (counter)))
;; (printf "~a + ~a = ~a~n" c1 c2 (+ c1 c2))
;; (printf "~a~n" (counter))
;; (printf "~a~n" (counter)))))
;; continuing...
;; continuing...
;; -1 + -3 = -4
;; continuing...
;; -4
;; continuing...
;; -5
 
 
;; (let ((counter (apply-to-range - 1 7)))
;; (let ((c1 (counter)))
;; (counter)
;; (let ((c2 (counter)))
;; (printf "~a + ~a = ~a~n" c1 c2 (+ c1 c2))
;; (printf "~a~n" (counter))
;; (printf "~a~n" (counter)))))
 
 
;; But damn, that's a lot of code to get the desired effect...
;; We've created a sort of framework, which we can "template"
;; in the form of a macro
 
(define-syntax define-generator
(syntax-rules ()
((_ (name arg1 ...) yielder body1 ...)
(define (name arg1 ...)
(letrec ((main-logic
(lambda (suspend)
;; we're just turning it into a function that
;; can be called within the expanded code.
(let ((yielder
(lambda v
(begin
(call-with-current-continuation
(lambda (new-bail)
(set! main-logic (lambda (cont)
(set! suspend cont)
(apply new-bail v)))
(apply suspend v)))))))
(let name ((arg1 arg1) ...)
body1 ...)))))
(lambda ()
(call-with-current-continuation
(lambda (exit-function)
(main-logic exit-function)))))))))
 
;; Now, we use it, and create something that looks very much like
;; the first function, but suspends the loop and upon recalling
;; restores exactly where it left off.
(define-generator (apply-to-range f i x) suspend
(if (< i x)
(begin
(suspend (f i))
(display "continuing...")
(newline)
(apply-to-range f (+ i 1) x))
'done))
 
;; Looks a bit nicer, still works the same way.
;; (define counter (apply-to-range - 1 10))
;; (counter) => -1
;; (counter) => -2, but it outputs "continuing..."
;; (counter) => -3, but it outputs "continuing..."
;; ...
;; (counter) => done, but it outputs "continuing..."

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.