suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

switch generator' implementation to use prompt' and `call/cc'

Browse Source 
Instead of `shift' and `reset'. Performance is a little better,
since `call/cc' acts as hint to the run-time system that the
continuation doesn't need to compose.
This commit is contained in:
Matthew Flatt 2012-09-18 13:51:45 -06:00
parent 21e0d9e031
commit 07e5526d6a
1 changed files with 24 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/racket/generator.rkt
View File

@ -52,7 +52,7 @@
[(v) ((current-yielder) v)] [(v) ((current-yielder) v)]
[vs (apply (current-yielder) vs)])) [vs (apply (current-yielder) vs)]))
(define yield-tag (make-continuation-prompt-tag)) (define yield-tag (make-continuation-prompt-tag 'yield))
(define-syntax (generator stx) (define-syntax (generator stx)
(syntax-case stx () (syntax-case stx ()
@ -84,20 +84,28 @@
(define (create-generator start) (define (create-generator start)
(let ([state 'fresh]) (let ([state 'fresh])
(define (cont . init-formals)
(define (yielder . vs) (define (yielder . vs)
(set! state 'suspended) (set! state 'suspended)
(shift-at yield-tag k (set! cont k) (apply values vs))) (call/cc (lambda (k)
(set! cont k)
(apply abort-current-continuation yield-tag vs))
yield-tag))
(define (cont . init-formals)
(set! state 'running) (set! state 'running)
(reset-at yield-tag
(parameterize ([current-yielder yielder])
(call-with-values (call-with-values
(lambda () (lambda ()
(apply start init-formals)) (apply start init-formals))
;; get here only on at the end of the generator ;; get here only on at the end of the generator
(lambda rs (lambda rs
(set! cont (lambda () (set! state 'done) (apply values rs))) (set! cont (lambda () (set! state 'done) (apply values rs)))
(cont)))))) (cont))))
(define (call-cont vs)
(call-with-continuation-prompt
(lambda ()
(parameterize ([current-yielder yielder])
(apply cont vs)))
yield-tag
values))
(define (err [what "send a value to"]) (define (err [what "send a value to"])
(raise-arguments-error 'generator (raise-arguments-error 'generator
(format "cannot ~a a ~a generator" what state) (format "cannot ~a a ~a generator" what state)
@ -106,15 +114,15 @@
(case-lambda (case-lambda
[() (if (eq? state 'running) [() (if (eq? state 'running)
(err "call") (err "call")
(begin (set! state 'running) (cont)))] (begin (set! state 'running) (call-cont null)))]
;; yield-tag means return the state (see `generator-state' below) ;; yield-tag means return the state (see `generator-state' below)
[(x) (cond [(eq? x yield-tag) state] [(x) (cond [(eq? x yield-tag) state]
[(memq state '(suspended running fresh)) [(memq state '(suspended running fresh))
(set! state 'running) (set! state 'running)
(cont x)] (call-cont (list x))]
[else (err)])] [else (err)])]
[xs (if (memq state '(suspended running fresh)) [xs (if (memq state '(suspended running fresh))
(begin (set! state 'running) (apply cont xs)) (begin (set! state 'running) (call-cont xs))
(err))])) (err))]))
(define self (make-generator generator)) (define self (make-generator generator))
self)) self))