diff --git a/collects/data/gvector.rkt b/collects/data/gvector.rkt index a7843d1649..e856169a89 100644 --- a/collects/data/gvector.rkt +++ b/collects/data/gvector.rkt @@ -149,16 +149,20 @@ (syntax-case stx () [(_ (clause ...) . body) (quasisyntax/loc stx - (let ([gv (make-gvector)]) - (for/fold/derived #,stx () (clause ...) . body) + (let ([gv (make-gvector*)]) + (for/fold/derived #,stx () (clause ...) + (call-with-values (lambda () . body) + (lambda args (apply gvector-add! gv args) (values)))) gv))])) (define-syntax (for*/gvector stx) (syntax-case stx () [(_ (clause ...) . body) (quasisyntax/loc stx - (let ([gv (make-gvector)]) - (for*/fold/derived #,stx () (clause ...) . body) + (let ([gv (make-gvector*)]) + (for*/fold/derived #,stx () (clause ...) + (call-with-values (lambda () . body) + (lambda args (apply gvector-add! gv args) (values)))) gv))])) (define-struct gvector (vec n) @@ -174,6 +178,25 @@ gvector-iterate-next gvector-iterate-key gvector-iterate-value) + #:property prop:equal+hash + (let ([equals + (lambda (x y recursive-equal?) + (let ([vx (gvector-vec x)] + [vy (gvector-vec y)] + [nx (gvector-n x)] + [ny (gvector-n y)]) + (and (= nx ny) + (for/and ([index (in-range nx)]) + (recursive-equal? (vector-ref vx index) + (vector-ref vy index))))))] + [hash-code + (lambda (x hc) + (let ([v (gvector-vec x)] + [n (gvector-n x)]) + (for/fold ([h 1]) ([i (in-range n)]) + ;; FIXME: better way of combining hashcodes + (+ h (hc (vector-ref v i))))))]) + (list equals hash-code hash-code)) #:property prop:sequence in-gvector) (provide/contract @@ -196,4 +219,6 @@ [gvector->vector (-> gvector? vector?)]) -(provide (rename-out [in-gvector* in-gvector])) +(provide (rename-out [in-gvector* in-gvector]) + for/gvector + for*/gvector) diff --git a/collects/data/scribblings/gvector.scrbl b/collects/data/scribblings/gvector.scrbl index bd5fa8ccf4..34ae36be62 100644 --- a/collects/data/scribblings/gvector.scrbl +++ b/collects/data/scribblings/gvector.scrbl @@ -23,6 +23,9 @@ be extended by adding an element to the end, and it can be shrunk by removing any element, although removal can take time linear in the number of elements in the gvector. +Two gvectors are @racket[equal?] if they contain the same number of +elements and if the contain equal elements at each index. + @defproc[(make-gvector [#:capacity capacity exact-positive-integer? 10]) gvector?]{ @@ -102,3 +105,15 @@ changes the elements produced by the sequence. To obtain a sequence from a snapshot of @racket[gv], use @racket[(in-vector (gvector->vector gv))] instead. } + +@deftogether[[ +@defform[(for/gvector (for-clause ...) body ...+)] +@defform[(for*/gvector (for-clause ...) body ...+)]]]{ + +Analogous to @racket[for/list] and @racket[for*/list], but constructs +a gvector instead of a list. + +Unlike @racket[for/list], the @racket[body] may return zero or +multiple values; all returned values are added to the gvector, in +order, on each iteration. +} diff --git a/collects/tests/data/gvector.rkt b/collects/tests/data/gvector.rkt new file mode 100644 index 0000000000..1b2591d32f --- /dev/null +++ b/collects/tests/data/gvector.rkt @@ -0,0 +1,125 @@ +#lang racket/base +(require data/gvector + racket/dict + rackunit) + +(test-equal? "gvector" + (gvector->vector (gvector 1 2 3)) + '#(1 2 3)) + +(test-equal? "gvector-add! (one)" + (gvector->vector + (let ([gv (make-gvector)]) + (for ([x '(1 2 3)]) + (gvector-add! gv x)) + gv)) + '#(1 2 3)) + +(test-equal? "gvector-add! (multi)" + (gvector->vector + (let ([gv (make-gvector)]) + (gvector-add! gv 1 2 3) + gv)) + '#(1 2 3)) + +(test-equal? "gvector-ref" + (let ([gv (gvector 1 2 3)]) + ;; 3 valid refs + 1 not-found + (for/list ([index '(0 1 2 3)]) + (gvector-ref gv index #f))) + '(1 2 3 #f)) + +(test-equal? "gvector-set! (in range)" + (let ([gv (gvector 1 2 3)]) + (gvector-set! gv 1 'apple) + (gvector->vector gv)) + '#(1 apple 3)) + +(test-equal? "gvector-set! as add" + (let ([gv (gvector 1 2 3)]) + (gvector-set! gv 3 4) + (gvector->vector gv)) + '#(1 2 3 4)) + +(test-equal? "gvector-remove! at end" + (let ([gv (gvector 1 2 3)]) + (gvector-remove! gv 2) + (gvector->vector gv)) + '#(1 2)) + +(test-equal? "gvector-remove! at beginning" + (let ([gv (gvector 1 2 3)]) + (gvector-remove! gv 0) + (gvector->vector gv)) + '#(2 3)) + +(test-equal? "gvector-count" + (gvector-count (gvector 1 2 3)) + 3) + +(test-equal? "gvector-count / add" + (let ([gv (gvector 1 2 3)]) + (gvector-add! gv 4 5 6) + (gvector-count gv)) + 6) + +(test-equal? "in-gvector" + (let ([gv (gvector 1 2 3)]) + (for/list ([x (in-gvector gv)]) x)) + '(1 2 3)) + +(test-equal? "gvector as sequence" + (let ([gv (gvector 1 2 3)]) + (for/list ([x gv]) x)) + '(1 2 3)) + +(test-equal? "for/gvector" + (gvector->vector (for/gvector ([x '(1 2 3)]) x)) + '#(1 2 3)) + +(test-case "gvector, lots of adds" + (let ([gv (make-gvector)]) + (for ([x (in-range 0 1000)]) + (gvector-add! gv x)) + (for ([x (in-range 0 1000)]) + (check-equal? (gvector-ref gv x) x)) + (check-equal? (gvector-count gv) 1000))) + +(test-equal? "gvector, dict-map" + (dict-map (gvector 1 2 3) list) + '((0 1) (1 2) (2 3))) +(test-equal? "gvector, dict-ref" + (dict-ref (gvector 1 2 3) 0) + 1) + +(test-equal? "gvector, dict-ref out of range" + (dict-ref (gvector 1 2 3) 5 #f) + #f) + +(test-equal? "gvector, equals, empty" + (gvector) + (make-gvector #:capacity 50)) + +(test-case "gvector, equals" + (let ([g1 (make-gvector)] + [g2 (make-gvector)]) + (for ([x (in-range 1000)]) + (check-equal? g1 g2) + (check-equal? (equal-hash-code g1) (equal-hash-code g2)) + (gvector-add! g1 x) + (gvector-add! g2 x)))) + +(test-case "gvector, equals, w cycles" + (let ([g1 (make-gvector)] + [g2 (make-gvector)]) + (for ([x (in-range 10)]) + (check-equal? g1 g2) + (check-equal? (equal-hash-code g1) (equal-hash-code g2)) + (gvector-add! g1 (if (zero? (modulo x 2)) g1 g2)) + (gvector-add! g2 (if (zero? (modulo x 3)) g1 g2))))) + +(test-case "gvector, not equal, same length" + (check-not-equal? (gvector 1) (gvector 2))) + +(test-case "gvector, not equal, extension" + (check-not-equal? (gvector 1) (gvector 1 2)))