diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index 88733cac4a..c1b852f284 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -65,6 +65,7 @@ stream-first stream-rest prop:stream + stream-ref ; only provided for racket/stream sequence->stream empty-stream make-do-stream diff --git a/collects/racket/private/pre-base.rkt b/collects/racket/private/pre-base.rkt index 59da173128..57a802aa28 100644 --- a/collects/racket/private/pre-base.rkt +++ b/collects/racket/private/pre-base.rkt @@ -166,7 +166,7 @@ define-in-vector-like define-:vector-like-gen make-in-vector-like - stream? stream-empty? stream-first stream-rest + stream? stream-ref stream-empty? stream-first stream-rest prop:stream in-stream empty-stream make-do-stream) (all-from "kernstruct.rkt") #%top-interaction diff --git a/collects/racket/stream.rkt b/collects/racket/stream.rkt index 3e5db6f31e..d33d6e2e4a 100644 --- a/collects/racket/stream.rkt +++ b/collects/racket/stream.rkt @@ -1,6 +1,11 @@ #lang racket/base -(require "private/for.rkt" +(require racket/private/generics + (rename-in "private/for.rkt" + [stream-ref stream-get-generics] + [stream-empty? -stream-empty] + [stream-first -stream-first] + [stream-rest -stream-rest]) "private/sequence.rkt" (only-in "private/stream-cons.rkt" stream-cons)) @@ -8,9 +13,14 @@ (provide empty-stream stream-cons stream? - stream-empty? - stream-first - stream-rest + generic-stream + ;; we don't need the generics versions of these because + ;; 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]) prop:stream in-stream @@ -29,6 +39,16 @@ stream-add-between stream-count) +(define-generics (generic-stream prop:stream stream? + #:defined-table defined-table + #:coerce-method-table #f + #:prop-defined-already? stream-get-generics) + ;; These three are never used for the reasons explained above. + ;; We still need the headers for clients who extend racket/stream. + (stream-empty? generic-stream) + (stream-first generic-stream) + (stream-rest generic-stream)) + (define-syntax stream (syntax-rules () ((_) diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index 32aa2e425c..e2eddab344 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -701,16 +701,22 @@ A shorthand for nested @racket[stream-cons]es ending with but with @racket[e] between each pair of elements in @racket[s]. The new stream is constructed lazily.} -@defthing[prop:stream struct-type-property?]{ +@deftogether[[ +@defthing[generic-stream any/c] +@defthing[prop:stream struct-type-property?]]]{ Associates three procedures to a structure type to implement stream - operations for instances of the structure type. + methods for instances of the stream generics. - The property value must be a vector of three procedures: a - @racket[stream-empty?] implementation, a @racket[stream-first] - implementation, and a @racket[stream-rest] implementation. The - procedures are applied only to instances of the structure type that - has the property value.} + To supply method implementations, the @racket[methods] form should be used. + The methods are applied only to instances of the structure type that has + the property value. The following three methods should be implemented: + +@itemize[ + @item{@racket[stream-empty?] : accepts one argument} + @item{@racket[stream-first] : accepts one argument} + @item{@racket[stream-rest] : accepts one argument} +]} @; ====================================================================== @section{Generators} diff --git a/collects/tests/generics/stream.rkt b/collects/tests/generics/stream.rkt new file mode 100644 index 0000000000..fbd35d1d39 --- /dev/null +++ b/collects/tests/generics/stream.rkt @@ -0,0 +1,32 @@ +#lang racket + +(require racket/generics racket/stream) + +(define-struct list-stream (v) + #:property prop:stream + (methods generic-stream + (define (stream-empty? generic-stream) + (empty? (list-stream-v generic-stream))) + (define (stream-first generic-stream) + (first (list-stream-v generic-stream))) + (define (stream-rest generic-stream) + (rest (list-stream-v generic-stream))))) + + +(module+ test + (require rackunit) + + (define l1 (list-stream '(1 2))) + + (check-true (stream? l1)) + (check-false (stream-empty? l1)) + (check-equal? (stream-first l1) 1) + + (define l2 (stream-rest l1)) + (check-true (stream? l2)) + (check-false (stream-empty? l2)) + (check-equal? (stream-first l2) 2) + + (define l3 (stream-rest l2)) + (check-true (stream? l3)) + (check-true (stream-empty? l3))) diff --git a/collects/tests/generics/tests.rkt b/collects/tests/generics/tests.rkt index 83416847ba..8090a20800 100644 --- a/collects/tests/generics/tests.rkt +++ b/collects/tests/generics/tests.rkt @@ -3,4 +3,5 @@ (require (submod "custom-hash.rkt" test) (submod "alist.rkt" test) (submod "from-docs.rkt" test) - (submod "coercion.rkt" test)) + (submod "coercion.rkt" test) + (submod "stream.rkt" test))