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

Fix stream bug introduced by generics

Browse Source 
Stream generic operations stopped working for lists
since the operations used only the generic dispatcher
instead of the real generic functions.

(Moral of this story: write more tests)
This commit is contained in:
Asumu Takikawa 2012-08-22 17:36:50 -04:00
parent 7a0281c571
commit 07119c371d
2 changed files with 45 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
collects/racket/stream.rkt
View File

@ -3,7 +3,7 @@
(require racket/private/generic
(rename-in "private/for.rkt"
[stream-ref stream-get-generics]
[stream-empty? -stream-empty]
[stream-empty? -stream-empty?]
[stream-first -stream-first]
[stream-rest -stream-rest])
"private/sequence.rkt"
@ -18,9 +18,9 @@
;; the original sequence functions will work fine
;; for the dispatch. (the method table layout is
;; identical)
(rename-out [-stream-empty stream-empty?]
[-stream-first stream-first]
[-stream-rest stream-rest])
(rename-out [-stream-empty? stream-empty?]
[-stream-first stream-first]
[-stream-rest stream-rest])
prop:stream
in-stream
@ -61,9 +61,9 @@
(define (stream-length s)
(unless (stream? s) (raise-argument-error 'stream-length "stream?" s))
(let loop ([s s] [len 0])
(if (stream-empty? s)
(if (-stream-empty? s)
len
(loop (stream-rest s) (add1 len)))))
(loop (-stream-rest s) (add1 len)))))
(define (stream-ref st i)
(unless (stream? st) (raise-argument-error 'stream-ref "stream?" st))
@ -71,15 +71,15 @@
(raise-argument-error 'stream-ref "exact-nonnegative-integer?" i))
(let loop ([n i] [s st])
(cond
[(stream-empty? s)
[(-stream-empty? s)
(raise-arguments-error 'stream-ref
"stream ended before index"
"index" i
"stream" st)]
[(zero? n)
(stream-first s)]
(-stream-first s)]
[else
(loop (sub1 n) (stream-rest s))])))
(loop (sub1 n) (-stream-rest s))])))
(define (stream-tail st i)
(unless (stream? st) (raise-argument-error 'stream-tail "stream?" st))
@ -88,13 +88,13 @@
(let loop ([n i] [s st])
(cond
[(zero? n) s]
[(stream-empty? s)
[(-stream-empty? s)
(raise-arguments-error 'stream-tail
"stream ended before index"
"index" i
"stream" st)]
[else
(loop (sub1 n) (stream-rest s))])))
(loop (sub1 n) (-stream-rest s))])))
(define (stream-append . l)
(for ([s (in-list l)])
@ -104,19 +104,19 @@
(define (streams-append l)
(cond
[(null? l) empty-stream]
[(stream-empty? (car l)) (streams-append (cdr l))]
[(-stream-empty? (car l)) (streams-append (cdr l))]
[else
(make-do-stream (lambda () #f)
(lambda () (stream-first (car l)))
(lambda () (streams-append (cons (stream-rest (car l)) (cdr l)))))]))
(lambda () (-stream-first (car l)))
(lambda () (streams-append (cons (-stream-rest (car l)) (cdr l)))))]))
(define (stream-map f s)
(unless (procedure? f) (raise-argument-error 'stream-map "procedure?" f))
(unless (stream? s) (raise-argument-error 'stream-map "stream?" s))
(let loop ([s s])
(if (stream-empty? s)
(if (-stream-empty? s)
empty-stream
(stream-cons (f (stream-first s)) (loop (stream-rest s))))))
(stream-cons (f (-stream-first s)) (loop (-stream-rest s))))))
(define (stream-andmap f s)
(unless (procedure? f) (raise-argument-error 'stream-andmap "procedure?" f))
@ -147,7 +147,7 @@
(unless (procedure? f) (raise-argument-error 'stream-filter "procedure?" f))
(unless (stream? s) (raise-argument-error 'stream-filter "stream?" s))
(cond
[(stream-empty? s) empty-stream]
[(-stream-empty? s) empty-stream]
[else
(let ([done? #f]
[empty? #f]
@ -157,13 +157,13 @@
(unless done?
(let loop ([s s])
(cond
[(stream-empty? s)
[(-stream-empty? s)
(set! done? #t)
(set! empty? #t)]
[(f (stream-first s))
(set! fst (stream-first s))
(set! rst (stream-filter f (stream-rest s)))]
[else (loop (stream-rest s))]))
[(f (-stream-first s))
(set! fst (-stream-first s))
(set! rst (stream-filter f (-stream-rest s)))]
[else (loop (-stream-rest s))]))
(set! done? #t)))
(make-do-stream (lambda () (force!) empty?)
(lambda () (force!) fst)
@ -172,11 +172,11 @@
(define (stream-add-between s e)
(unless (stream? s)
(raise-argument-error 'stream-add-between "stream?" s))
(if (stream-empty? s)
(if (-stream-empty? s)
empty-stream
(stream-cons
(stream-first s)
(let loop ([s (stream-rest s)])
(cond [(stream-empty? s) empty-stream]
[else (stream-cons e (stream-cons (stream-first s)
(loop (stream-rest s))))])))))
(-stream-first s)
(let loop ([s (-stream-rest s)])
(cond [(-stream-empty? s) empty-stream]
[else (stream-cons e (stream-cons (-stream-first s)
(loop (-stream-rest s))))])))))

17
collects/tests/racket/stream.rktl
View File

@ -36,4 +36,21 @@
(test 2 'stream (stream-length (stream 1 (/ 0))))
(test 'a 'stream (stream-first (stream 'a (/ 0))))
;; make sure stream operations work on lists
(test #t stream-empty? '())
(test 1 stream-first '(1 2 3))
(test '(2 3) stream-rest '(1 2 3))
(test 3 stream-length '(1 2 3))
(test 1 stream-ref '(1 2 3) 0)
(test '(2 3) stream-tail '(1 2 3) 1)
(test '(1 2 3 4 5) stream->list (stream-append '(1 2 3) '(4 5)))
(test '(1 2 3) stream->list (stream-map values '(1 2 3)))
(test #f stream-andmap even? '(1 2 3))
(test #t stream-ormap even? '(1 2 3))
(test #t void? (stream-for-each void '(1 2 3)))
(test 6 stream-fold + 0 '(1 2 3))
(test 1 stream-count even? '(1 2 3))
(test '(1 3) stream->list (stream-filter odd? '(1 2 3)))
(test '(1 a 2 a 3) stream->list (stream-add-between '(1 2 3) 'a))
(report-errs)