Name: Anonymous 2010-02-04 16:24
ITT: /prog/ writes me the code needed for those snazzy drop down menus at the top
#lang scheme
(define generator%
(class object%
(init first)
(define next-proc first)
(super-new)
(define (next-helper)
(call-with-exception-handler (lambda (error)
(when (string=? error "StopIteration")
(set! next-helper (lambda () (raise "StopIteration"))))
(raise error))
(lambda ()
(let* ((v (next-proc))
(next (vector-ref v 1))
(return-values (vector-ref v 0)))
(set! next-proc next)
(apply values return-values)))))
(define/public (next) (next-helper))))
(define-syntax (generator stx)
(syntax-case stx ()
((generator expr rest ...)
(with-syntax ((yield (datum->syntax #'generator 'yield)))
#'(new generator% (first
(lambda ()
(call/cc (lambda (escape)
(let ((yield (lambda args
(call/cc (lambda (next)
(escape (vector args next)))))))
expr
rest ...
(raise "StopIteration")))))))))))
(define (make-fibonacci-generator)
(generator
(let loop ((x 0) (y 1))
(yield x)
(loop y (+ x y)))))
;; Examples
;> (define fibs (make-fibonacci-generator))
;> (send fibs next)
;0
;> (send fibs next)
;1
;> (send fibs next)
;1
;> (send fibs next)
;2
;> (send fibs next)
;3
;> (send fibs next)
;5
;> (send fibs next)
;8
;> (send fibs next)
;13
;> (send fibs next)
;21
;> (send fibs next)
;34
;> (send fibs next)
;55
;> (send fibs next)
;89
;> (send fibs next)
;144
;> (send fibs next)
;233
;> (send fibs next)
;377
;> (send fibs next)
;610