data/bit-vector: some adjustments for consistency

Change `bit-vector-count' to `bit-vector-length', add arguments
to `bit-vector-copy', use `racket/private/vector-wraps' (which
should be moved to a public place) to implement things like
`for/bit-vector'.

collects/data/bit-vector.rkt

@@ -1,7 +1,6 @@
 #lang racket/base
-(require (for-syntax racket/base
+(require (for-syntax racket/base)
-                     unstable/wrapc
+         racket/private/vector-wraps
-                     syntax/for-body)
          racket/match
          racket/dict         
          racket/contract/base
@@ -41,12 +40,15 @@
          (default)
          default)]
     [else
+     (unsafe-bit-vector-ref bv n)]))
+
+(define (unsafe-bit-vector-ref bv n)
   (define-values (wi bi) (quotient/remainder n bits-in-a-word))
   (match bv
     [(struct bit-vector (words size word-size))
      (define word (vector-ref words wi))
      (define bit  (bitwise-bit-set? word bi))
-        bit])]))
+     bit]))
 
 (define (bit-vector-iterate-first bv)
   (if (zero? (bit-vector-size bv)) #f 0))
@@ -63,8 +65,6 @@
   (bit-vector-ref bv key))
 
 (define (bit-vector-set! bv n b)
-  (unless (boolean? b)
-    (error 'bit-vector-set! "expected boolean as third argument, got ~a" b))
   (define-values (wi bi) (quotient/remainder n bits-in-a-word))
   (match bv
     [(struct bit-vector (words size word-size))
@@ -73,40 +73,31 @@
      (unless (eq? bit b)
        (vector-set! words wi (bitwise-xor word (expt 2 bi))))]))
 
-(define (in-bit-vector/fun bv)
+(define (bit-vector-length bv)
-  (unless (bit-vector? bv)
-    (raise-type-error 'in-bit-vector "bit-vector" bv))
-  (in-dict-values bv))
-
-(define-sequence-syntax in-bit-vector
-  (lambda () #'in-bit-vector/fun)
-  (lambda (stx)
-    (syntax-case stx ()
-      [[(var) (in-bv bv-expr)]
-       (with-syntax ([bv-expr-c (wrap-expr/c #'bit-vector? #'bv-expr #:macro #'in-bv)])
-         (syntax/loc stx
-           [(var)
-            (:do-in ([(bv) bv-expr-c])
-                    (void) ;; outer-check; handled by contract
-                    ([n 0] [size (bit-vector-size bv)]) ;; loop bindings
-                    (< n size) ;; pos-guard
-                    ([(var) (bit-vector-ref bv n)]) ;; inner bindings
-                    #t ;; pre-guard
-                    #t ;; post-guard
-                    ((add1 n) (bit-vector-size bv)))]))]
-      [[(var ...) (in-bv bv-expr)]
-       (with-syntax ([bv-expr-c (wrap-expr/c #'bit-vector? #'bv-expr #:macro #'in-bv)])
-         (syntax/loc stx
-           [(var ...) (in-bit-vector bit-expr-c)]))]
-      [_ #f])))
-
-(define (bit-vector-count bv)
   (bit-vector-size bv))
 
-(define (bit-vector-copy bv)
+(define bit-vector-copy*
+  (let ([bit-vector-copy
+         (case-lambda
+          [(bv)
            (bit-vector (vector-copy (bit-vector-words bv))
                        (bit-vector-size bv)
-              (bit-vector-word-size bv)))
+                       (bit-vector-word-size bv))]
+          [(bv start)
+           (bit-vector-copy bv start)]
+          [(bv start end)
+           (bit-vector-copy bv start end)])])
+    bit-vector-copy))
+
+(define-vector-wraps "bit-vector"
+  bit-vector? bit-vector-length bit-vector-ref bit-vector-set! make-bit-vector
+  unsafe-bit-vector-ref bit-vector-set! bit-vector-length
+  in-bit-vector*
+  in-bit-vector
+  for/bit-vector
+  for*/bit-vector
+  bit-vector-copy
+  #f)
 
 ; A bit vector is represented as a vector of words.
 ; Each word contains 30 or 62 bits depending on the size of a fixnum.
@@ -120,7 +111,7 @@
                           #f ;; set
                           #f ;; remove!
                           #f ;; remove
-                          bit-vector-count
+                          bit-vector-length
                           bit-vector-iterate-first
                           bit-vector-iterate-next
                           bit-vector-iterate-key
@@ -155,98 +146,6 @@
    (define hash2-proc hash-code)]
   #:property prop:sequence in-bit-vector)
 
-(define (grow-bit-vector bv)
-  (define s (bit-vector-size bv))
-  (define w (bit-vector-words bv))
-  (define v (make-vector (* 2 (vector-length w)) 0))
-  (define new (bit-vector v (* 2 s) (bit-vector-word-size bv)))
-  (for ([i (in-range (vector-length w))])
-    (vector-set! v i (vector-ref w i)))
-  new)
-
-(define (shrink-bit-vector bv i)
-  (define nws (add1 (quotient i bits-in-a-word)))
-  (bit-vector (vector-copy (bit-vector-words bv) 0 nws)
-              i nws))
-
-(define-for-syntax (for_/vector stx orig-stx for_/vector-stx 
-                                for_/fold/derived-stx wrap-all?)
-  (syntax-case stx ()
-    [(_ (for-clause ...) body ...)
-     (with-syntax ([orig-stx orig-stx]
-                   [for_/fold/derived for_/fold/derived-stx]
-                   [((middle-body ...) (last-body ...)) 
-                    (split-for-body stx #'(body ...))])
-       (syntax/loc stx
-         (let-values ([(bv i)
-                       (for_/fold/derived
-                        orig-stx
-                        ([bv (make-bit-vector (* 16 bits-in-a-word))]
-                         [i 0])
-                        (for-clause ...) 
-                        middle-body ...
-                        (let ([new-bv (if (eq? i (bit-vector-size bv))
-                                          (grow-bit-vector bv)
-                                          bv)])
-                          (bit-vector-set! new-bv i (let () last-body ...))
-                          (values new-bv (unsafe-fx+ i 1))))])
-           (shrink-bit-vector bv i))))]
-    [(_ #:length length-expr #:fill fill-expr (for-clause ...) body ...)
-     (with-syntax ([orig-stx orig-stx]
-                   [(limited-for-clause ...)
-                    ;; If `wrap-all?', wrap all binding clauses. Otherwise, wrap
-                    ;; only the first and the first after each keyword clause:
-                    (let loop ([fcs (syntax->list #'(for-clause ...))] [wrap? #t])
-                      (cond
-                        [(null? fcs) null]
-                        [(keyword? (syntax-e (car fcs)))
-                         (if (null? (cdr fcs))
-                             fcs
-                             (list* (car fcs) (cadr fcs) (loop (cddr fcs) #t)))]
-                        [(not wrap?)
-                         (cons (car fcs) (loop (cdr fcs) #f))]
-                        [else
-                         (define fc (car fcs))
-                         (define wrapped-fc
-                           (syntax-case fc ()
-                             [[ids rhs]
-                              (or (identifier? #'ids)
-                                  (let ([l (syntax->list #'ids)])
-                                    (and l (andmap identifier? l))))
-                              (syntax/loc fc [ids (stop-after
-                                                   rhs
-                                                   (lambda x
-                                                     (unsafe-fx= i len)))])]
-                             [_ fc]))
-                         (cons wrapped-fc
-                               (loop (cdr fcs) wrap-all?))]))]
-                   [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))]
-                   [for_/vector for_/vector-stx]
-                   [for_/fold/derived for_/fold/derived-stx])
-       (syntax/loc stx
-         (let ([len length-expr])
-           (unless (exact-nonnegative-integer? len)
-             (raise-argument-error 'for_/vector "exact-nonnegative-integer?" len))
-           (let ([v (make-bit-vector len fill-expr)])
-             (unless (zero? len)
-               (for_/fold/derived
-                orig-stx 
-                ([i 0])
-                (limited-for-clause ...)
-                middle-body ...
-                (bit-vector-set! v i (let () last-body ...))
-                (add1 i)))
-             v))))]
-    [(_ #:length length-expr (for-clause ...) body ...)
-     (for_/vector #'(fv #:length length-expr #:fill #f (for-clause ...) body ...) 
-                  orig-stx for_/vector-stx for_/fold/derived-stx wrap-all?)]))
-
-(define-syntax (for/bit-vector stx)
-  (for_/vector stx stx #'for/bit-vector #'for/fold/derived #f))
-
-(define-syntax (for*/bit-vector stx)
-  (for_/vector stx stx #'for*/bit-vector #'for*/fold/derived #t))
-
 (provide/contract
  [bit-vector?
   (-> any/c any)]
@@ -257,10 +156,11 @@
  [bit-vector-ref
   (->* (bit-vector? exact-nonnegative-integer?) (any/c) any)]
  [bit-vector-set!
-  (-> bit-vector? exact-nonnegative-integer? any/c any)] 
+  (-> bit-vector? exact-nonnegative-integer? boolean? any)] 
- [bit-vector-count
+ [bit-vector-length
   (-> bit-vector? any)]
- [bit-vector-copy
+ (rename bit-vector-copy*
-  (-> bit-vector? bit-vector?)])
+         bit-vector-copy
+         (-> bit-vector? bit-vector?)))
 
 (provide in-bit-vector for/bit-vector for*/bit-vector)

collects/data/scribblings/bit-vector.scrbl

@@ -16,7 +16,7 @@
 
 @author[@author+email["Jens Axel Søgaard" "soegaard@racket-lang.org"]]
 
-A bit vector (bit-vector) is a mutable sequence whose elements 
+A @deftech{bit vector} is a mutable sequence whose elements 
 are booleans. A bit vector also acts as a dictionary (@racket[dict?]
 from @racketmodname[racket/dict]), where the keys are zero-based
 indexes and the values are the elements of the bit-vector. A bit-vector 
@@ -45,9 +45,9 @@ Creates a new bit-vector containing each @racket[elem] in order.
 (bit-vector-ref bv 1)]
 }
 
-@defproc[(bit-vector? [x any/c]) boolean?]{
+@defproc[(bit-vector? [v any/c]) boolean?]{
 
-Returns @racket[#t] if @racket[x] is a bit-vector, @racket[#f] otherwise.
+Returns @racket[#t] if @racket[v] is a bit-vector, @racket[#f] otherwise.
 }
 
 @defproc[(bit-vector-ref [bv bit-vector?]
@@ -56,14 +56,14 @@ Returns @racket[#t] if @racket[x] is a bit-vector, @racket[#f] otherwise.
          any/c]{
 
 Returns the element at index @racket[index], if @racket[index] is less
-than @racket[(bit-vector-count gv)]. Otherwise, @racket[default] is
+than @racket[(bit-vector-length gv)]. Otherwise, @racket[default] is
 invoked if it is a procedure, returned otherwise.
 }
 
 @defproc[(bit-vector-set! 
           [bv bit-vector?]
           [index (and/c exact-nonnegative-integer? 
-                        (</c (+ 1 (bit-vector-count vv))))]
+                        (</c (+ 1 (bit-vector-length vv))))]
           [value boolean?])
          void?]{
 
@@ -73,17 +73,20 @@ Sets the value at index @racket[index] to be @racket[value].
 (bit-vector-ref bv 1)]
 }
 
-@defproc[(bit-vector-count [bv bit-vector?])
+@defproc[(bit-vector-length [bv bit-vector?])
          exact-nonnegative-integer?]{
 
 Returns the number of items in the bit-vector @racket[bv].
 }
 
-@defproc[(bit-vector-copy [bv bit-vector?])
+@defproc[(bit-vector-copy [bv bit-vector?]
+                          [start exact-nonnegative-integer? 0]
+                          [end exact-nonnegative-integer? (vector-length v)])
          bit-vector?]{
 
-Creates a fresh bit-vector of the same size and with the
+Creates a fresh bit-vector with the
-same elements as the bit-vector @racket[bv].
+same elements as @racket[bv] from @racket[start] (inclusive)
+to @racket[end] (exclusive).
 }
 
 @defproc[(in-bit-vector [bv bit-vector?])
@@ -101,7 +104,8 @@ from a snapshot of @racket[gv], use @racket[(in-vector
 (for/list ([x (in-bit-vector bv)]) x)]
 }
 
-@defform/subs[(for/bit-vector maybe-length (for-clause ...) body-or-break ... body)
+@defform/subs[(for/bit-vector maybe-length (for-clause ...) 
+                body-or-break ... body)
               ([maybe-length (code:line)
                              (code:line #:length length-expr)
                              (code:line #:length length-expr #:fill fill-expr)])
@@ -125,7 +129,8 @@ the default argument of @racket[make-bit-vector]).
 (to-list (for/bit-vector ([i '(1 2 3)]) (odd? i)))
 (to-list (for/bit-vector #:length 2 ([i '(1 2 3)]) (odd? i)))
 (to-list (for/bit-vector #:length 4 ([i '(1 2 3)]) (odd? i)))
-(to-list (for/bit-vector #:length 4 #:fill #t ([i '(1 2 3)]) (odd? i)))
+(to-list 
+ (for/bit-vector #:length 4 #:fill #t ([i '(1 2 3)]) (odd? i)))
 ]
 
 The @racket[for/bit-vector] form may allocate a bit-vector and mutate it 
@@ -133,11 +138,8 @@ after each iteration of @racket[body], which means that capturing a
 continuation during @racket[body] and applying it multiple times may
 mutate a shared bit-vector.}
 
-@defform/subs[(for*/bit-vector maybe-length (for-clause ...) body-or-break ... body)
+@defform[(for*/bit-vector maybe-length (for-clause ...)
-              ([maybe-length (code:line)
+           body-or-break ... body)]{
-                             (code:line #:length length-expr)
-                             (code:line #:length length-expr #:fill fill-expr)])
-              #:contracts ([length-expr exact-nonnegative-integer?])]{
 
 Like @racket[for/bit-vector] but with the implicit nesting of @racket[for*].
 }

collects/data/scribblings/data.scrbl

@@ -23,3 +23,4 @@ This manual documents data structure libraries available in the
 @include-section["interval-map.scrbl"]
 @include-section["heap.scrbl"]
 @include-section["integer-set.scrbl"]
+@include-section["bit-vector.scrbl"]

collects/tests/data/bit-vector.rkt

@@ -32,8 +32,8 @@
                (bit-vector->vector bv))
              '#(#t #f #t))
 
-(test-equal? "bit-vector-count"
+(test-equal? "bit-vector-length"
-             (bit-vector-count (bit-vector #t #f #t))
+             (bit-vector-length (bit-vector #t #f #t))
              3)
 
 (test-equal? "in-bit-vector"