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

Make `in-producer' treat any number of values uniformly.

Browse Source 
The previous version was broken in its inconsistent treatment of
multiple values, which was motivated by an `in-generator' use
case.  (`in-generator' should be fixed too now.)  The new version is
much simpler since there's no need for three almost-exact copies of the
same code.
This commit is contained in:
Eli Barzilay 2013-05-10 10:32:58 -04:00
parent 609db13fa7
commit 710e59bf13
1 changed files with 18 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
collects/racket/private/for.rkt
View File

@ -1826,67 +1826,27 @@
(lambda () #'in-producer) (lambda () #'in-producer)
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
[[(id) (_ producer stop more ...)] ;; cheap & simple stop-less and arg-less version
(with-syntax ([(more* ...) (generate-temporaries #'(more ...))]) [[(id ...) (_ producer)]
#'[(id) #'[(id ...)
(:do-in (:do-in ([(producer*) producer]) #t () #t ([(id ...) (producer*)])
;;outer bindings #t #t ())]]
([(producer*) producer] [(more*) more] ... ;; full version
[(stop?) (let ([s stop])
(if (procedure? s) s (lambda (x) (eq? x s))))])
;; outer check
#t
;; loop bindings
()
;; pos check
#t
;; inner bindings
([(id) (producer* more* ...)])
;; pre guard
(not (stop? id))
;; post guard
#t
;; loop args
())])]
[[() (_ producer stop more ...)]
(with-syntax ([(more* ...) (generate-temporaries #'(more ...))])
#'[()
(:do-in
([(producer*) producer] [(more*) more] ...
[(stop?) (let ([s stop])
(if (procedure? s)
s
(lambda (args)
(and (not (null? args))
(eq? (car args) s)))))])
;; outer check
#t
;; loop bindings
()
;; pos check
#t
;; inner bindings
([(check) (call-with-values (lambda () (producer* more* ...))
(lambda vs vs))])
;; pre guard
(not (stop? check))
;; post guard
#t
;; loop args
())])]
;; multiple-values version
[[(id ...) (_ producer stop more ...)] [[(id ...) (_ producer stop more ...)]
(with-syntax ([(more* ...) (generate-temporaries #'(more ...))]) (with-syntax ([(more* ...) (generate-temporaries #'(more ...))]
[single? (= 1 (length (syntax->list #'(id ...))))])
#'[(id ...) #'[(id ...)
(:do-in (:do-in
;; outer bindings ;; outer bindings
([(producer*) producer] [(more*) more] ... ([(producer*) producer]
[(stop?) (let ([s stop]) [(more*) more] ...
(if (procedure? s) [(stop?)
s (let ([s stop])
(error 'in-producer (cond [(procedure? s) s]
['single? (lambda (x) (eq? x s))]
[else (error 'in-producer
"stop condition for ~a, got: ~e" "stop condition for ~a, got: ~e"
"multiple values must be a predicate" s)))]) "multiple values must be a predicate" s)]))])
;; outer check ;; outer check
#t #t
;; loop bindings ;; loop bindings
@ -1900,21 +1860,7 @@
;; post guard ;; post guard
#t #t
;; loop args ;; loop args
())])] ())])])))
;; stop-less versions
[[(id) (_ producer)]
#'[(id)
(:do-in ([(producer*) producer]) #t () #t ([(id) (producer*)])
#t #t ())]]
[[() (_ producer)]
#'[()
(:do-in ([(producer*) producer]) #t () #t
([(check) (call-with-values producer* (lambda vs vs))])
#t #t ())]]
[[(id ...) (_ producer stop more ...)]
#'[(id ...)
(:do-in ([(producer*) producer]) #t () #t ([(id ...) (producer*)])
#t #t ())]])))
;; Some iterators that are implemented using `*in-producer' (note: do not use ;; Some iterators that are implemented using `*in-producer' (note: do not use
;; `in-producer', since in this module it is the procedure version). ;; `in-producer', since in this module it is the procedure version).