diff --git a/collects/tests/generics/iterator.rkt b/collects/tests/generics/iterator.rkt new file mode 100644 index 0000000000..2c2cf86d5a --- /dev/null +++ b/collects/tests/generics/iterator.rkt @@ -0,0 +1,69 @@ +#lang racket/base + +(require racket/private/generics racket/sequence) + +;; This was designed as a higher-level interface on top of sequences, +;; but it turns out streams can do all that already (including state), +;; making iterators redundant. Kept around as extra tests. + + +(define-values (prop:iterator iterator? iterator-accessor) + (make-struct-type-property + 'iterator + #f + ;; Iterators are automatically sequences, but don't have the full + ;; flexibility of sequences: they are their own initial state, and + ;; they can only look at their state to decide if iteration is over. + ;; Given that extra field can be added to the iterator, there is no + ;; loss of expressiveness. + (list (cons prop:sequence + (lambda (method-table) ; 3-vector + (define iterator-first (vector-ref method-table 0)) + (define iterator-rest (vector-ref method-table 1)) + (define iterator-continue? (vector-ref method-table 2)) + (lambda (t) + (make-do-sequence + (lambda () + (values iterator-first + iterator-rest ; needs to create a new struct + t + iterator-continue? + (lambda (v) #t) + (lambda (t v) #t)))))))))) + +(define-generics (iterator prop:iterator iterator? + #:defined-table dummy + #:coerce-method-table #f + #:prop-defined-already? iterator-accessor) + (iterator-first iterator) + (iterator-rest iterator) + (iterator-continue? iterator)) + +(struct list-iterator (l) + #:property prop:iterator + (methods iterator + (define (iterator-first x) (car (list-iterator-l x))) + (define (iterator-rest x) (list-iterator (cdr (list-iterator-l x)))) + (define (iterator-continue? x) (not (null? (list-iterator-l x)))))) + +(struct vector-iterator (i v) + #:property prop:iterator + (methods iterator + (define (iterator-first x) (vector-ref (vector-iterator-v x) + (vector-iterator-i x))) + (define (iterator-rest x) (vector-iterator (add1 (vector-iterator-i x)) + (vector-iterator-v x))) + (define (iterator-continue? x) (not (>= (vector-iterator-i x) + (vector-length + (vector-iterator-v x))))))) + +(module+ test + (require rackunit) + + (define s1 (list-iterator '(#t #t #f))) + (check-true (sequence-ormap values s1)) + (check-false (sequence-andmap values s1)) + + (define s2 (vector-iterator 0 '#(1 2 3))) + (check-equal? (sequence-fold + 0 s2) 6) + ) diff --git a/collects/tests/generics/stream.rkt b/collects/tests/generics/stream.rkt index fbd35d1d39..f09bdf039e 100644 --- a/collects/tests/generics/stream.rkt +++ b/collects/tests/generics/stream.rkt @@ -12,6 +12,18 @@ (define (stream-rest generic-stream) (rest (list-stream-v generic-stream))))) +(struct vector-stream (i v) + #:property prop:stream + (methods generic-stream + (define (stream-first x) (vector-ref (vector-stream-v x) + (vector-stream-i x))) + (define (stream-rest x) (vector-stream (add1 (vector-stream-i x)) + (vector-stream-v x))) + (define (stream-empty? x) (>= (vector-stream-i x) + (vector-length + (vector-stream-v x)))))) + + (module+ test (require rackunit) @@ -29,4 +41,9 @@ (define l3 (stream-rest l2)) (check-true (stream? l3)) - (check-true (stream-empty? l3))) + (check-true (stream-empty? l3)) + + + (define s2 (vector-stream 0 '#(1 2 3))) + (check-equal? (sequence-fold + 0 s2) 6) + ) diff --git a/collects/tests/generics/tests.rkt b/collects/tests/generics/tests.rkt index 8090a20800..fef50575ff 100644 --- a/collects/tests/generics/tests.rkt +++ b/collects/tests/generics/tests.rkt @@ -4,4 +4,5 @@ (submod "alist.rkt" test) (submod "from-docs.rkt" test) (submod "coercion.rkt" test) - (submod "stream.rkt" test)) + (submod "stream.rkt" test) + (submod "iterator.rkt" test))