svn: r15805
This commit is contained in:
Eli Barzilay 2009-08-26 21:05:04 +00:00
parent f61f933b8b
commit ab7caff9bc

View File

@ -7,32 +7,35 @@
(provide yield lambda-generator define-generator) (provide yield lambda-generator define-generator)
(define-syntax-parameter yield (lambda (stx) (define-syntax-parameter yield
(lambda (stx)
(raise-syntax-error #f "yield is only bound inside a sequence generator"))) (raise-syntax-error #f "yield is only bound inside a sequence generator")))
;; better version of shift/reset using continuation tags ;; better version of shift/reset using continuation tags also use a
;; also use a unique value to determine the end of the sequence instead of using #f ;; unique value to determine the end of the sequence instead of using #f
(define-syntax lambda-generator (define-syntax lambda-generator
(syntax-rules () (syntax-rules ()
[(_ (args ...) body0 bodies ...) [(_ (args ...) body0 bodies ...)
(lambda (args ...) (lambda (args ...)
(let* ([last (lambda () (void))] (let* ([last (lambda () (void))]
;; current is a function that invokes user code and produces values ;; current is a function that invokes user code and
[current (lambda () ;; produces values
[current
(lambda ()
;; a unique tag to jump to ;; a unique tag to jump to
(define tag (make-continuation-prompt-tag)) (define tag (make-continuation-prompt-tag))
;; give the value to the sequence ;; give the value to the sequence
(define next (lambda (value) (define next (lambda (value)
(shift-at tag f (values value f)))) (shift-at tag f (values value f))))
(syntax-parameterize ([yield (make-rename-transformer #'next)]) (syntax-parameterize ([yield (make-rename-transformer #'next)])
(reset-at tag (reset-at tag body0 bodies ... (values #f last))))]
body0 bodies ... [seq
(values #f last) (make-do-sequence
)))] (lambda ()
[seq (make-do-sequence (lambda ()
(values (values
;; produce a value and a continuation ;; produce a value and a continuation
(lambda (i) (let-values ([(value next) (current)]) (lambda (i)
(let-values ([(value next) (current)])
;; set! is ugly but can we do better? ;; set! is ugly but can we do better?
(set! current next) (set! current next)
value)) value))