diff --git a/collects/db/private/generic/sql-data.rkt b/collects/db/private/generic/sql-data.rkt index 569a5bcfdd..ad7f0ea1dc 100644 --- a/collects/db/private/generic/sql-data.rkt +++ b/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) - (sql-bits len (make-bytes (/ceiling len 8) 0) 0)) +(define (make-sql-bits/bytes len bs offset) + (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) - (sql-bits len bv offset)) +(define deserialize-info:sql-bits-v0 + (make-deserialize-info + make-sql-bits/bytes + (lambda () (error 'deserialize-info:sql-bits-v0 "cycles not allowed")))) -(define (check-index fsym b index) - (let ([len (sql-bits-length b)]) - (unless (< index len) - (raise-range-error fsym "sql-bits" "" index b 0 (sub1 len))))) - -(define (sql-bits-ref b i) - (check-index 'sql-bits-ref b i) - (bv-ref (sql-bits-bv b) (+ i (sql-bits-offset b)))) -(define (bv-ref bv i) - (let-values ([(bytei biti) (quotient/remainder i 8)]) - (bitwise-bit-set? (bytes-ref bv bytei) (- 7 biti)))) - -(define (sql-bits-set! b i v) - (check-index 'sql-bits-set! b i) - (bv-set! (sql-bits-bv b) (+ i (sql-bits-offset b)) v)) -(define (bv-set! bv i v) - (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)) +;; align-sql-bits : bit-vector 'left/'right -> (values nat bytes 0) +;; Formats a bit-vector in postgresql ('left) or mysql ('right) binary format. +;; Returns number of bits, byte buffer, and starting point of data in buffer +;; (as byte index, now always 0). +(define (align-sql-bits bv dir) + (let* ([len (bit-vector-length bv)] + [offset (case dir + ((left) 0) + ((right) (- 8 (remainder len 8))))] + [bs (make-bytes (/ceiling len 8) 0)]) + (for ([bvi (in-range len)] + [bsi (in-naturals offset)]) + (when (bit-vector-ref bv bvi) + (let-values ([(bytei biti) (quotient/remainder bsi 8)]) + (bytes-set! bs bytei (+ (bytes-ref bs bytei) (arithmetic-shift 1 (- 7 biti))))))) + (values len bs 0))) (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 diff --git a/collects/db/scribblings/sql-types.scrbl b/collects/db/scribblings/sql-types.scrbl index b30149bade..d943df36db 100644 --- a/collects/db/scribblings/sql-types.scrbl +++ b/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['varbit] @& @tt{varbit} @& @racket[sql-bits?] @// + @racket['bit] @& @tt{bit} @& @racket[bit-vector?] @// + @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?]{ - - 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. -} - + sql-bits?] +@defproc[(sql-bits? [v any/c]) boolean?] @defproc[(sql-bits-length [b sql-bits?]) - exact-nonnegative-integer?]{ - - Returns the number of bits stored in @racket[b]. -} - + exact-nonnegative-integer?] @defproc[(sql-bits-ref [b sql-bits?] [i exact-nonnegative-integer?]) - boolean?]{ - - Returns the bit stored by @racket[b] at index @racket[i] as a - boolean. -} - + boolean?] @defproc[(sql-bits-set! [b sql-bits?] [i exact-nonnegative-integer?] [v boolean?]) - void?]{ - - Updates @racket[b], setting the bit at index @racket[i] to @racket[v]. -} - -@deftogether[[ + void?] @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 - string. +Deprecated; use @racketmodname[data/bit-vector] instead. -@examples[#:eval the-eval -(sql-bits->list (string->sql-bits "1011")) -(sql-bits->string (query-value pgc "select B'010110111'")) -] } - @(close-eval the-eval) diff --git a/collects/tests/db/db/sql-types.rkt b/collects/tests/db/db/sql-types.rkt index 992718182c..1adc9138d0 100644 --- a/collects/tests/db/db/sql-types.rkt +++ b/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?) - (check-roundtrip* c (string->sql-bits "000000") check-bits-equal?) - (check-roundtrip* c (string->sql-bits (make-string 30 #\1)) check-bits-equal?)))) + (for ([s (list "1011" + "000000" + (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 diff --git a/collects/tests/db/gen/sql-types.rkt b/collects/tests/db/gen/sql-types.rkt index 032aa3a0a8..b61ca1bdc6 100644 --- a/collects/tests/db/gen/sql-types.rkt +++ b/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)))))))