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

racket/stream: unbreak chained lazy streams

Browse Source 
The new implementation attempting to collapse lazy streams was broken.
This commit is contained in:
Matthew Flatt 2021-03-27 08:22:22 -06:00
parent a5615a7bae
commit e31003b0ad
2 changed files with 59 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
pkgs/racket-test-core/tests/racket/stream.rktl
View File

@ -134,6 +134,17 @@
(in-parallel '(1 3) '(2 4))))))
list)
;; check `#:eager`
(test #t stream? (stream-cons (/ 1 0) (/ 1 0)))
(test #t stream? (stream-cons #:eager 1 (/ 1 0)))
(test #t stream? (stream-cons (/ 1 0) #:eager '(1)))
(test #t stream? (stream-cons #:eager 0 #:eager '(1)))
(err/rt-test (stream-cons 1 #:eager (/ 1 0)))
(err/rt-test (stream-cons #:eager (/ 1 0) '(1)))
(err/rt-test (stream-cons #:eager (/ 1 0) #:eager '(1)))
(err/rt-test (stream-cons #:eager 1 #:eager (/ 1 0)))
(err/rt-test (stream-cons #:eager 1 #:eager 1))
;; stream-rest doesn't force rest expr
(test #t stream? (stream-rest (stream-cons 1 'oops)))
@ -178,4 +189,9 @@
(letrec ([s (stream-cons 1 (stream-force (stream-rest s)))])
(err/rt-test (stream-empty? (stream-rest s)) exn:fail:contract? #rx"reentrant or broken"))
;; regression test for chain of lazy streams
(test 1 stream-first (stream-lazy
(stream-lazy
(stream-lazy '(1)))))
(report-errs)

80
racket/collects/racket/private/stream-cons.rkt
View File

@ -33,10 +33,10 @@
(lambda (p) (stream-force-first p))
(lambda (p) (eagerly-created-stream-rest p))))
;; A lazily constructed stream uses an mpair redirection to facilitate
;; flattening chains of lazily constructed streams. The pair starts with
;; #f if the stream is forced, a symbol for the constructing form otherwise
(define-struct lazily-created-stream (mpair)
;; A lazily constructed stream starts with #f if the stream is forced,
;; a symbol for the constructing form otherwise; a #t in place of a
;; symbol means 'stream-cons
(define-struct lazily-created-stream (creator-if-unforced thunk-or-stream)
#:mutable
#:reflection-name 'stream
#:property for:prop:stream (vector
@ -52,9 +52,9 @@
(define-syntax stream-lazy
(syntax-rules ()
[(stream-lazy expr)
(make-lazily-created-stream (mcons 'stream-lazy (lambda () expr)))]
(make-lazily-created-stream 'stream-lazy (lambda () expr))]
[(stream-lazy #:who who-expr expr)
(make-lazily-created-stream (mcons (or who-expr 'stream-lazy) (lambda () expr)))]))
(make-lazily-created-stream (or who-expr 'stream-lazy) (lambda () expr))]))
(define reentrant-error
(lambda () (raise-arguments-error 'stream "reentrant or broken delay")))
@ -63,34 +63,40 @@
(define (stream-force s)
(cond
[(lazily-created-stream? s)
(define p (lazily-created-stream-mpair s))
(cond
[(not (mcar p)) (mcdr p)]
[else
(define thunk (mcdr p))
(set-mcdr! p reentrant-error)
(define v (thunk))
(cond
[(lazily-created-stream? v)
;; flatten the result lazy stream and try again
(set-lazily-created-stream-mpair! s (lazily-created-stream-mpair v))
(stream-force v)]
[(for:stream? v)
;; any other kind of stream is success
(set-mcar! p #f)
(set-mcdr! p v)
v]
[else
(define who (mcar p))
(if (symbol? who)
(raise-arguments-error
who
"delayed expression produced a non-stream"
"result" v)
(raise-arguments-error
'stream-cons
"rest expression produced a non-stream"
"rest result" v))])])]
(let loop ([s s] [dep-ses '()])
(cond
[(not (lazily-created-stream-creator-if-unforced s))
(define v (lazily-created-stream-thunk-or-stream s))
(for ([dep-s (in-list dep-ses)])
(set-lazily-created-stream-creator-if-unforced! dep-s #f)
(set-lazily-created-stream-thunk-or-stream! dep-s v))
v]
[else
(define thunk (lazily-created-stream-thunk-or-stream s))
(set-lazily-created-stream-thunk-or-stream! s reentrant-error)
(define v (thunk))
(cond
[(lazily-created-stream? v)
;; try again
(loop v (cons s dep-ses))]
[(for:stream? v)
;; any other kind of stream is success
(set-lazily-created-stream-creator-if-unforced! s #f)
(set-lazily-created-stream-thunk-or-stream! s v)
(if (null? dep-ses)
v
(loop s dep-ses))]
[else
(define who (lazily-created-stream-creator-if-unforced s))
(if (symbol? who)
(raise-arguments-error
who
"delayed expression produced a non-stream"
"result" v)
(raise-arguments-error
'stream-cons
"rest expression produced a non-stream"
"rest result" v))])]))]
[(for:stream? s) s]
[else (raise-argument-error 'stream-force "stream?" s)]))
@ -122,10 +128,10 @@
(syntax-rules ()
((stream-cons obj strm)
(eagerly-created-stream #f (lambda () obj)
(lazily-created-stream (mcons #t (lambda () strm)))))
(lazily-created-stream #t (lambda () strm))))
((stream-cons #:eager obj strm)
(eagerly-created-stream #t obj
(lazily-created-stream (mcons #t (lambda () strm)))))
(lazily-created-stream #t (lambda () strm))))
((stream-cons obj #:eager strm)
(eagerly-created-stream #f (lambda () obj)
(stream-assert strm)))
@ -150,4 +156,4 @@
(eagerly-created-stream-rest v)
(for:stream-rest v))))
(define stream-null (lazily-created-stream (mcons #f '())))
(define stream-null (lazily-created-stream #f '()))