Initial import of bit-vectors

This commit is contained in:
Jens Axel Søgaard 2012-11-22 22:22:34 +01:00 committed by Matthew Flatt
parent 4af72a5825
commit 028d14a877
3 changed files with 509 additions and 0 deletions

View File

@ -0,0 +1,266 @@
#lang racket/base
(require (for-syntax racket/base
unstable/wrapc
syntax/for-body)
racket/match
racket/dict
racket/contract/base
racket/vector
racket/unsafe/ops)
(define bits-in-a-word
(if (fixnum? (expt 2 61))
; 32 or 64-bit fixnums?
62 30))
(define largest-fixnum
(- (expt 2 bits-in-a-word) 1))
(define ((bad-index-error who index))
(raise-mismatch-error who "index out of range: " index))
(define (make-bit-vector size [fill #f])
(define word-size (add1 (quotient size bits-in-a-word)))
(define words (make-vector word-size (if fill largest-fixnum 0)))
(bit-vector words size word-size))
(define (bit-vector* . init-bits)
(define bv (make-bit-vector (length init-bits)))
(for ([i (in-naturals)]
[b (in-list init-bits)])
(bit-vector-set! bv i b))
bv)
(define (bit-vector-ref bv n
[default (bad-index-error 'bit-vector-ref n)])
(unless (exact-nonnegative-integer? n)
(raise-type-error 'bit-vector-ref "exact nonnegative integer" n))
(cond
[(>= n (bit-vector-size bv))
(if (procedure? default)
(default)
default)]
[else
(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])]))
(define (bit-vector-iterate-first bv)
(if (zero? (bit-vector-size bv)) #f 0))
(define (bit-vector-iterate-next bv pos)
(if (>= (+ pos 1) (bit-vector-size bv))
#f
(+ pos 1)))
(define (bit-vector-iterate-key bv key)
key)
(define (bit-vector-iterate-value bv key)
(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))
(define word (vector-ref words wi))
(define bit (bitwise-bit-set? word bi))
(unless (eq? bit b)
(vector-set! words wi (bitwise-xor word (expt 2 bi))))]))
(define (in-bit-vector/fun 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)
(bit-vector (vector-copy (bit-vector-words bv))
(bit-vector-size bv)
(bit-vector-word-size bv)))
; A bit vector is represented as a vector of words.
; Each word contains 30 or 62 bits depending on the size of a fixnum.
(struct bit-vector (words size word-size)
; words is the vector of words
; size is the number of bits in bitvector
; word-size is the number of words in words
#:property prop:dict/contract
(list (vector-immutable bit-vector-ref
bit-vector-set!
#f ;; set
#f ;; remove!
#f ;; remove
bit-vector-count
bit-vector-iterate-first
bit-vector-iterate-next
bit-vector-iterate-key
bit-vector-iterate-value)
(vector-immutable exact-nonnegative-integer?
boolean?
exact-nonnegative-integer?
#f #f #f))
#:methods gen:equal+hash
[(define (equal-proc x y recursive-equal?)
(let ([vx (bit-vector-words x)]
[vy (bit-vector-words y)]
[nx (bit-vector-size x)]
[ny (bit-vector-size y)]
[wsx (bit-vector-word-size x)]
[wsy (bit-vector-word-size y)])
(and (= nx ny) (= wsx wsy)
(for/and ([index (in-range (- (vector-length vx) 1))])
(eqv? (vector-ref vx index)
(vector-ref vy index)))
; TODO: check last word
)))
(define (hash-code x hc)
(let ([v (bit-vector-words x)]
[n (bit-vector-size x)]
[ws (bit-vector-word-size x)])
(bitwise-xor
(hc ws) (hc n)
(for/fold ([h 1]) ([i (in-range (vector-length v))])
(bitwise-xor h (hc (vector-ref v i)))))))
(define hash-proc hash-code)
(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)]
[rename bit-vector* bit-vector
(->* () () #:rest (listof boolean?) bit-vector?)]
[make-bit-vector
(->* (exact-nonnegative-integer?) (boolean?) bit-vector?)]
[bit-vector-ref
(->* (bit-vector? exact-nonnegative-integer?) (any/c) any)]
[bit-vector-set!
(-> bit-vector? exact-nonnegative-integer? any/c any)]
[bit-vector-count
(-> bit-vector? any)]
[bit-vector-copy
(-> bit-vector? bit-vector?)])
(provide in-bit-vector for/bit-vector for*/bit-vector)

View File

@ -0,0 +1,145 @@
#lang scribble/manual
@(require scribble/eval
(for-label data/bit-vector
racket/contract
racket/dict
racket/base)
data/bit-vector)
@title[#:tag "bit-vector"]{Bit Vectors}
@(define the-eval (make-base-eval))
@(the-eval '(require data/bit-vector))
@(the-eval '(require racket/dict))
@defmodule[data/bit-vector]
@author[@author+email["Jens Axel Søgaard" "soegaard@racket-lang.org"]]
A bit vector (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
has a fixed size.
Two bit-vectors are @racket[equal?] if they contain the same number of
elements and if they contain equal elements at each index.
@defproc[(make-bit-vector [size exact-integer?] [fill boolean? #f])
bit-vector?]{
Creates a new bit-vector of size @racket[size]. All elements
are initialized to @racket[fill].
@examples[#:eval the-eval
(define bv (make-bit-vector 3))
(bit-vector-ref bv 1)]
}
@defproc[(bit-vector [elem boolean?] ...)
bit-vector?]{
Creates a new bit-vector containing each @racket[elem] in order.
@examples[#:eval the-eval
(define bv (bit-vector #f #t #f))
(bit-vector-ref bv 1)]
}
@defproc[(bit-vector? [x any/c]) boolean?]{
Returns @racket[#t] if @racket[x] is a bit-vector, @racket[#f] otherwise.
}
@defproc[(bit-vector-ref [bv bit-vector?]
[index exact-nonnegative-integer?]
[default any/c (error ....)])
any/c]{
Returns the element at index @racket[index], if @racket[index] is less
than @racket[(bit-vector-count 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))))]
[value boolean?])
void?]{
Sets the value at index @racket[index] to be @racket[value].
@examples[#:eval the-eval
(define bv (bit-vector #f #t #f))
(bit-vector-ref bv 1)]
}
@defproc[(bit-vector-count [bv bit-vector?])
exact-nonnegative-integer?]{
Returns the number of items in the bit-vector @racket[bv].
}
@defproc[(bit-vector-copy [bv bit-vector?])
bit-vector?]{
Creates a fresh bit-vector of the same size and with the
same elements as the bit-vector @racket[bv].
}
@defproc[(in-bit-vector [bv bit-vector?])
sequence?]{
Returns a sequence whose elements are the elements of the bit-vector
@racket[bv]. Mutation of @racket[bv] while the sequence is running
changes the elements produced by the sequence. To obtain a sequence
from a snapshot of @racket[gv], use @racket[(in-vector
(bit-vector-copy bv))] instead.
@examples[#:eval the-eval
(define bv (bit-vector #f #t #f))
(for/list ([x (in-bit-vector bv)]) x)]
}
@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)])
#:contracts ([length-expr exact-nonnegative-integer?])]{
Iterates like @racket[for/vector], but results are accumulated into
a bit-vector instead of a vector.
If the optional @racket[#:length] clause is specified, the result of
@racket[length-expr] determines the length of the result bit-vector.
In that case, the iteration can be performed more efficiently, and it
terminates when the bit-vector is full or the requested number of
iterations have been performed, whichever comes first. If
@racket[length-expr] specifies a length longer than the number of
iterations, then the remaining slots of the vector are initialized to
the value of @racket[fill-expr], which defaults to @racket[#f] (i.e.,
the default argument of @racket[make-bit-vector]).
@examples[#:eval the-eval
(define (to-list bv) (for/list ([x bv]) x))
(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)))
]
The @racket[for/bit-vector] form may allocate a bit-vector and mutate it
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)
([maybe-length (code:line)
(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*].
}
@close-eval[the-eval]

View File

@ -0,0 +1,98 @@
#lang racket/base
(require data/bit-vector
racket/dict
rackunit)
(define (bit-vector->vector bv)
(for/vector ([b (in-bit-vector bv)])
b))
(test-equal? "bit-vector"
(bit-vector->vector (bit-vector #t #f #t))
'#(#t #f #t))
(test-equal? "make-bit-vector"
(make-bit-vector 3)
(bit-vector #f #f #f))
(test-equal? "make-bit-vector"
(make-bit-vector 3 #t)
(bit-vector #t #t #t))
(test-equal? "bit-vector-ref"
(let ([bv (bit-vector #t #f #t)])
;; 3 valid refs + 1 not-found
(for/list ([index '(0 1 2)])
(bit-vector-ref bv index)))
'(#t #f #t))
(test-equal? "bit-vector-set!"
(let ([bv (bit-vector #t #t #t)])
(bit-vector-set! bv 1 #f)
(bit-vector->vector bv))
'#(#t #f #t))
(test-equal? "bit-vector-count"
(bit-vector-count (bit-vector #t #f #t))
3)
(test-equal? "in-bit-vector"
(let ([bv (bit-vector #t #f #t)])
(for/list ([x (in-bit-vector bv)]) x))
'(#t #f #t))
(test-equal? "in-bit-vector expression form"
(let* ([bv (bit-vector #t #f #t)]
[bv-sequence (in-bit-vector bv)])
(for/list ([x bv-sequence]) x))
'(#t #f #t))
(test-equal? "bit-vector as sequence"
(let ([bv (bit-vector #t #f #t)])
(for/list ([x bv]) x))
'(#t #f #t))
(test-case "bitvector, lots of sets"
(let ([bv (make-bit-vector 1000)])
(for ([i (in-range 0 1000)])
(bit-vector-set! bv i (odd? i)))
(for ([i (in-range 0 1000)])
(check-equal? (bit-vector-ref bv i) (odd? i)))))
(test-equal? "bit-vector, dict-map"
(dict-map (bit-vector #t #f #t) list)
'((0 #t) (1 #f) (2 #t)))
(test-equal? "bit-vector, dict-ref"
(dict-ref (bit-vector #t #f #t) 0)
#t)
(test-equal? "bit-vector, dict-ref out of range"
(dict-ref (bit-vector #t #f #t) 5 'not-found)
'not-found)
(test-case "bit-vector-copy"
(let ([bv (bit-vector #t #f #t #f #t)])
(check-equal? (bit-vector-copy bv) bv)))
(test-case "bit-vector, hash-equal"
(check-equal?
(equal-hash-code (bit-vector #t #f #t #f #t))
(equal-hash-code (bit-vector #t #f #t #f #t))))
(test-case "bit-vector, hash-eq"
(check-equal?
(= (eq-hash-code (bit-vector #t #f #t #f #t))
(eq-hash-code (bit-vector #t #f #t #f #t)))
#f))
(test-case "for/bit-vector"
(check-equal? (for/bit-vector ([i 5]) (odd? i))
(bit-vector #f #t #f #t #f))
(check-equal? (for/bit-vector #:length 4 ([i 2]) (odd? i))
(bit-vector #f #t #f #f))
(check-equal? (for/bit-vector #:length 4 #:fill #t ([i 2]) (odd? i))
(bit-vector #f #t #t #t))
(let ([bv (make-bit-vector 1000)])
(bit-vector-set! bv 400 #t)
(check-equal? bv (for/bit-vector ([i 1000]) (= i 400)))))