Initial import of bit-vectors
This commit is contained in:
Jens Axel Søgaard
Matthew Flatt
parent
4af72a5825
commit
028d14a877
266
collects/data/bit-vector.rkt
Normal file
266
collects/data/bit-vector.rkt
Normal 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)
|
||||
145
collects/data/scribblings/bit-vector.scrbl
Normal file
145
collects/data/scribblings/bit-vector.scrbl
Normal 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]
|
||||
98
collects/tests/data/bit-vector.rkt
Normal file
98
collects/tests/data/bit-vector.rkt
Normal 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)))))
|
||||
Loading…
Reference in New Issue
Block a user