From 07119c371d4611c942361d5b942ad59ec2f37645 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Wed, 22 Aug 2012 17:36:50 -0400 Subject: [PATCH] Fix stream bug introduced by generics 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) --- collects/racket/stream.rkt | 56 +++++++++++++++---------------- collects/tests/racket/stream.rktl | 17 ++++++++++ 2 files changed, 45 insertions(+), 28 deletions(-) diff --git a/collects/racket/stream.rkt b/collects/racket/stream.rkt index efe26e3832..278b6b84f6 100644 --- a/collects/racket/stream.rkt +++ b/collects/racket/stream.rkt @@ -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))))]))))) diff --git a/collects/tests/racket/stream.rktl b/collects/tests/racket/stream.rktl index 884f01f91c..3a75e12ca0 100644 --- a/collects/tests/racket/stream.rktl +++ b/collects/tests/racket/stream.rktl @@ -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)