replace db's sql-bits with data/bit-vector

collects/db/private/generic/sql-data.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
-(require racket/serialize)
+(require racket/serialize
+         data/bit-vector)
 (provide (all-defined-out))
 
 ;; SQL Data
@@ -135,8 +136,31 @@
 
 ;; Bits
 
+;; A sql-bits is now just a bit-vector (see data/bit-vector).
+
+(define (sql-bits? v)
+  (bit-vector? v))
+(define (sql-bits-length b)
+  (bit-vector-length b))
+(define (make-sql-bits len)
+  (make-bit-vector len #f))
+(define (sql-bits-ref b i)
+  (bit-vector-ref b i))
+(define (sql-bits-set! b i v)
+  (bit-vector-set! b i v))
+(define (sql-bits->list b)
+  (bit-vector->list b))
+(define (list->sql-bits l)
+  (list->bit-vector l))
+(define (sql-bits->string b)
+  (bit-vector->string b))
+(define (string->sql-bits s)
+  (string->bit-vector s))
+
+;; ----
+
 #|
-A sql-bits is (sql-bits len bv offset)
+Formerly, a sql-bits was (sql-bits len bv offset)
 where len is the number of bits, and bv is a bytes, offset is nat.
 
 Bit order is little-endian wrt bytes, but big-endian wrt bits within a
@@ -144,98 +168,43 @@ byte. (Because that's PostgreSQL's binary format.) For example:
 
   (bytes 128 3) represents 1000000 0000011
 |#
-(serializable-struct sql-bits (length bv offset))
+;;(serializable-struct sql-bits (length bv offset))
 
-(define (make-sql-bits len)
+(define (make-sql-bits/bytes len bs offset)
-  (sql-bits len (make-bytes (/ceiling len 8) 0) 0))
+  (define bv (make-bit-vector len #f))
+  (for ([i (in-range len)])
+    (let ([n (+ i offset)])
+      (let-values ([(bytei biti) (quotient/remainder n 8)])
+        (when (bitwise-bit-set? (bytes-ref bs bytei) (- 7 biti))
+          (bit-vector-set! bv i #t)))))
+  bv)
 
-(define (make-sql-bits/bytes len bv offset)
+(define deserialize-info:sql-bits-v0
-  (sql-bits len bv offset))
+  (make-deserialize-info
+   make-sql-bits/bytes
+   (lambda () (error 'deserialize-info:sql-bits-v0 "cycles not allowed"))))
 
-(define (check-index fsym b index)
+;; align-sql-bits : bit-vector 'left/'right -> (values nat bytes 0)
-  (let ([len (sql-bits-length b)])
+;; Formats a bit-vector in postgresql ('left) or mysql ('right) binary format.
-    (unless (< index len)
+;; Returns number of bits, byte buffer, and starting point of data in buffer
-      (raise-range-error fsym "sql-bits" "" index b 0 (sub1 len)))))
+;; (as byte index, now always 0).
-
+(define (align-sql-bits bv dir)
-(define (sql-bits-ref b i)
+  (let* ([len (bit-vector-length bv)]
-  (check-index 'sql-bits-ref b i)
+         [offset (case dir
-  (bv-ref (sql-bits-bv b) (+ i (sql-bits-offset b))))
+                   ((left) 0)
-(define (bv-ref bv i)
+                   ((right) (- 8 (remainder len 8))))]
-  (let-values ([(bytei biti) (quotient/remainder i 8)])
+         [bs (make-bytes (/ceiling len 8) 0)])
-    (bitwise-bit-set? (bytes-ref bv bytei) (- 7 biti))))
+    (for ([bvi (in-range len)]
-
+          [bsi (in-naturals offset)])
-(define (sql-bits-set! b i v)
+      (when (bit-vector-ref bv bvi)
-  (check-index 'sql-bits-set! b i)
+        (let-values ([(bytei biti) (quotient/remainder bsi 8)])
-  (bv-set! (sql-bits-bv b) (+ i (sql-bits-offset b)) v))
+          (bytes-set! bs bytei (+ (bytes-ref bs bytei) (arithmetic-shift 1 (- 7 biti)))))))
-(define (bv-set! bv i v)
+    (values len bs 0)))
-  (let-values ([(bytei biti) (quotient/remainder i 8)])
-    (let* ([oldbyte (bytes-ref bv bytei)]
-           [mask (arithmetic-shift 1 (- 7 biti))]
-           [newbyte (bitwise-ior (bitwise-and oldbyte (bitwise-xor 255 mask)) (if v mask 0))])
-      (unless (= oldbyte newbyte)
-        (bytes-set! bv bytei newbyte)))))
-
-(define (sql-bits->list b)
-  (let ([l (sql-bits-length b)]
-        [bv (sql-bits-bv b)]
-        [offset (sql-bits-offset b)])
-    (for/list ([i (in-range l)])
-      (bv-ref bv (+ offset i)))))
-
-(define (sql-bits->string b)
-  (let* ([l (sql-bits-length b)]
-         [bv (sql-bits-bv b)]
-         [offset (sql-bits-offset b)]
-         [s (make-string l)])
-    (for ([i (in-range l)])
-      (string-set! s i (if (bv-ref bv (+ offset i)) #\1 #\0)))
-    s))
-
-(define (list->sql-bits lst)
-  (let* ([b (make-sql-bits (length lst))]
-         [bv (sql-bits-bv b)])
-    (for ([v (in-list lst)]
-          [i (in-naturals)])
-      (bv-set! bv i v))
-    b))
-
-(define (string->sql-bits s)
-  (let* ([b (make-sql-bits (string-length s))]
-         [bv (sql-bits-bv b)])
-    (for ([i (in-range (string-length s))])
-      (case (string-ref s i)
-        ((#\0) (bv-set! bv i #f))
-        ((#\1) (bv-set! bv i #t))
-        (else (raise-type-error 'string->sql-bits "string over {0,1}" 0 s))))
-    b))
 
 (define (/ceiling x y)
   (let-values ([(q r) (quotient/remainder x y)])
     (+ q (if (zero? r) 0 1))))
 
-(define (align-sql-bits b dir)
-  (let* ([len (sql-bits-length b)]
-         [bv (sql-bits-bv b)]
-         [offset (sql-bits-offset b)]
-         [offset* (case dir
-                    ((left) 0)
-                    ((right) (- 8 (remainder len 8))))])
-    (cond [(= (remainder offset 8) offset*)
-           (values len bv (quotient offset 8))]
-          [else
-           (let ([b* (copy-sql-bits b offset*)])
-             (values len (sql-bits-bv b*) 0))])))
-
-(define (copy-sql-bits b [offset* 0])
-  (let* ([len (sql-bits-length b)]
-         [bv0 (sql-bits-bv b)]
-         [offset0 (sql-bits-offset b)]
-         [bytelen* (/ceiling (+ len offset*) 8)]
-         [bv* (make-bytes bytelen* 0)])
-    (for ([i (in-range len)])
-      (bv-set! bv* (+ i offset*) (bv-ref bv0 (+ offset0 i))))
-    (sql-bits len bv* offset*)))
-
 ;; ----------------------------------------
 
 ;; Predicates

collects/db/scribblings/sql-types.scrbl

@@ -80,8 +80,8 @@ along with their corresponding Racket representations.
   @racket['timestamptz]   @& @tt{timestamptz}        @& @racket[sql-timestamp?] 
                                                         or @racket[-inf.0] or @racket[+inf.0] @//
   @racket['interval]      @& @tt{interval}           @& @racket[sql-interval?] @//
-  @racket['bit]           @& @tt{bit}                @& @racket[sql-bits?] @//
+  @racket['bit]           @& @tt{bit}                @& @racket[bit-vector?] @//
-  @racket['varbit]        @& @tt{varbit}             @& @racket[sql-bits?] @//
+  @racket['varbit]        @& @tt{varbit}             @& @racket[bit-vector?] @//
 
   @racket['json]          @& @tt{json}               @& @racket[jsexpr?] @//
   @racket['int4range]     @& @tt{int4range}          @& @racket[pg-range-or-empty?] @//
@@ -200,7 +200,7 @@ with their corresponding Racket representations.
   @racket['var-binary]         @& @racket[bytes?] @//
   @racket['blob]               @& @racket[bytes?] @//
 
-  @racket['bit]                @& @racket[sql-bits?] @//
+  @racket['bit]                @& @racket[bit-vector?] @//
   @racket['geometry]           @& @racket[geometry2d?]
 }
 }
@@ -211,7 +211,7 @@ of Racket values to parameters accepts strings, numbers
 (@racket[rational?]---no infinities or NaN), bytes, SQL date/time
 structures (@racket[sql-date?], @racket[sql-time?],
 @racket[sql-timestamp?], and @racket[sql-day-time-interval?]), bits
-(@racket[sql-bits?]), and geometric values
+(@racket[bit-vector?]), and geometric values
 (@racket[geometry2d?]). Numbers are sent as 64-bit signed integers, if
 possible, or as double-precision floating point numbers otherwise.
 
@@ -508,55 +508,30 @@ values.
 @subsection{Bits}
 
 The @tt{BIT} and @tt{BIT VARYING} (@tt{VARBIT}) SQL types are
-represented by sql-bits values.
+represented by bit-vectors (@racketmodname[data/bit-vector]).
 
+The following functions are provided for backwards compatibility. They
+are deprecated and will be removed in a future release of Racket.
+
+@deftogether[[
 @defproc[(make-sql-bits [len exact-nonnegative-integer?]) 
-         sql-bits?]{
+         sql-bits?]
-
+@defproc[(sql-bits? [v any/c]) boolean?]
-  Creates a new sql-bits value containing @racket[len] zeros.
-}
-
-@defproc[(sql-bits? [v any/c]) boolean?]{
-
-  Returns @racket[#t] if @racket[v] is a sql-bits value, @racket[#f]
-  otherwise.
-}
-
 @defproc[(sql-bits-length [b sql-bits?])
-         exact-nonnegative-integer?]{
+         exact-nonnegative-integer?]
-
-  Returns the number of bits stored in @racket[b].
-}
-
 @defproc[(sql-bits-ref [b sql-bits?] [i exact-nonnegative-integer?])
-         boolean?]{
+         boolean?]
-
-  Returns the bit stored by @racket[b] at index @racket[i] as a
-  boolean.
-}
-
 @defproc[(sql-bits-set! [b sql-bits?] 
                         [i exact-nonnegative-integer?] 
                         [v boolean?])
-         void?]{
+         void?]
-
-  Updates @racket[b], setting the bit at index @racket[i] to @racket[v].
-}
-
-@deftogether[[
 @defproc[(sql-bits->list [b sql-bits?]) (listof boolean?)]
 @defproc[(sql-bits->string [b sql-bits?]) string?]
 @defproc[(list->sql-bits [lst (listof boolean?)]) sql-bits?]
 @defproc[(string->sql-bits [s string?]) sql-bits?]]]{
 
-  Converts a sql-bits value to or from its representation as a list or
+Deprecated; use @racketmodname[data/bit-vector] instead.
-  string.
 
-@examples[#:eval the-eval
-(sql-bits->list (string->sql-bits "1011"))
-(sql-bits->string (query-value pgc "select B'010110111'"))
-]
 }
 
-
 @(close-eval the-eval)

collects/tests/db/db/sql-types.rkt

@@ -457,9 +457,11 @@
     (type-test-case '(varbit bit)
       (call-with-connection
        (lambda (c)
-         (check-roundtrip* c (string->sql-bits "1011") check-bits-equal?)
+         (for ([s (list "1011"
-         (check-roundtrip* c (string->sql-bits "000000") check-bits-equal?)
+                        "000000"
-         (check-roundtrip* c (string->sql-bits (make-string 30 #\1)) check-bits-equal?))))
+                        (make-string 30 #\1)
+                        (string-append (make-string 10 #\1) (make-string 20 #\0)))])
+           (check-roundtrip* c (string->sql-bits s) check-bits-equal?)))))
 
     (type-test-case '(point geometry)
       (call-with-connection

collects/tests/db/gen/sql-types.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require rackunit
          racket/class
+         racket/serialize
          (prefix-in srfi: srfi/19)
          db/base
          db/private/generic/sql-convert
@@ -25,4 +26,32 @@
       (check-equal? (exact->scaled-integer 1/4) (cons 25 2))
       (check-equal? (exact->scaled-integer 1/10) (cons 1 1))
       (check-equal? (exact->scaled-integer 1/20) (cons 5 2))
-      (check-equal? (exact->scaled-integer 1/3) #f))))
+      (check-equal? (exact->scaled-integer 1/3) #f))
+    (test-case "sql-bits deserialization"
+      (check-equal? (deserialize 
+                     '((3)
+                       1
+                       (((lib "db/private/generic/sql-data.rkt") . deserialize-info:sql-bits-v0))
+                       0
+                       ()
+                       ()
+                       (0 0 (u . #"") 0)))
+                    (string->sql-bits ""))
+      (check-equal? (deserialize
+                     '((3)
+                       1
+                       (((lib "db/private/generic/sql-data.rkt") . deserialize-info:sql-bits-v0))
+                       0
+                       ()
+                       ()
+                       (0 4 (u . #"\260") 0)))
+                    (string->sql-bits "1011"))
+      (check-equal? (deserialize
+                     '((3)
+                       1
+                       (((lib "db/private/generic/sql-data.rkt") . deserialize-info:sql-bits-v0))
+                       0
+                       ()
+                       ()
+                       (0 30 (u . #"\377\377\360\0") 0)))
+                    (string->sql-bits (string-append (make-string 20 #\1) (make-string 10 #\0)))))))