Skip to content

@zeeshanlakhani /generator-ttd.scm forked from apg/generator-ttd.scm
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
generators (like python yield), in scheme, a language that doesn't normally have them.
;; 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..."
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.