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

Added a `running' state, which is visible only from inside the

Browse Source 
generator.  (Also considered making it an error when the generator is
called while it is running, but that doesn't allow (yield (yield X))
fun.)

svn: r17982
This commit is contained in:
Eli Barzilay 2010-02-05 03:22:09 +00:00
parent 2f62cb192e
commit 3a08648dab
2 changed files with 27 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/scheme/generator.ss
View File

@ -55,10 +55,14 @@
(let ([state 'fresh])
(define (cont)
(define yielder
;; this `case-lambda' is ... um ... for "speed"...
(case-lambda
[() (shift-at yield-tag k (set! cont k) (values))]
[(v) (shift-at yield-tag k (set! cont k) v)]
[vs (shift-at yield-tag k (set! cont k) (apply values vs))]))
[() (set! state 'suspended)
(shift-at yield-tag k (set! cont k) (values))]
[(v) (set! state 'suspended)
(shift-at yield-tag k (set! cont k) v)]
[vs (set! state 'suspended)
(shift-at yield-tag k (set! cont k) (apply values vs))]))
(set! state 'running)
(reset-at yield-tag
(parameterize ([current-yielder yielder])
@ -75,16 +79,22 @@
[rs (set! cont (lambda () (apply values rs)))]))
(set! state 'done)
(cont))))
(define (err)
(error 'generator "cannot send a value to a ~a generator" state))
(define (err [what "send a value to"])
(error 'generator "cannot ~a a ~a generator" what state))
(define generator
(case-lambda
[() (cont)]
[() (if #t ; (memq state '(fresh suspended done))
(begin (set! state 'running) (cont))
(err "call"))]
;; yield-tag means return the state (see `generator-state' below)
[(x) (cond [(eq? x yield-tag) state]
[(eq? state 'running) (cont x)]
[(memq state '(suspended running))
(set! state 'running)
(cont x)]
[else (err)])]
[xs (if (eq? state 'running) (apply cont xs) (err))]))
[xs (if (memq state '(suspended running))
(begin (set! state 'running) (apply cont xs))
(err))]))
generator))
;; Get the state -- this is a hack: uses yield-tag as a hidden value that makes
@ -93,7 +103,7 @@
;; deceived, but that will be harmless).
(define (generator-state g)
(let ([s (and (procedure? g) (procedure-arity-includes? g 1) (g yield-tag))])
(if (memq s '(fresh running done))
(if (memq s '(fresh running suspended done))
s
(raise-type-error 'generator-state "generator" g))))

9
collects/tests/mzscheme/for.ss
View File

@ -241,9 +241,16 @@
(let ([g (generator (yield (yield (yield 1))))])
(test '(1 2 3 4 4 4) list (g) (g 2) (g 3) (g 4) (g) (g)))
(let ([g (g)])
(test '(fresh 1 running 2 running 3 running last done)
(test '(fresh 1 suspended 2 suspended 3 suspended last done)
list (generator-state g) (g)
(generator-state g) (g)
(generator-state g) (g)
(generator-state g) (g 'last)
(generator-state g)))
(letrec ([g (generator (yield (generator-state g))
(yield (generator-state g)))])
(test '(fresh running suspended running suspended last done)
list (generator-state g) (g)
(generator-state g) (g)
(generator-state g) (g 'last)
(generator-state g))))