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'.
This commit is contained in:
Matthew Flatt
parent
028d14a877
commit
4ed45a6aef
|
|
@ -1,7 +1,6 @@
|
|||
#lang racket/base
|
||||
(require (for-syntax racket/base
|
||||
unstable/wrapc
|
||||
syntax/for-body)
|
||||
(require (for-syntax racket/base)
|
||||
racket/private/vector-wraps
|
||||
racket/match
|
||||
racket/dict
|
||||
racket/contract/base
|
||||
|
|
@ -41,12 +40,15 @@
|
|||
(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])]))
|
||||
(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]))
|
||||
|
||||
(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)
|
||||
(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)
|
||||
(define (bit-vector-length 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)))
|
||||
(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))]
|
||||
[(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-count
|
||||
(-> bit-vector? exact-nonnegative-integer? boolean? any)]
|
||||
[bit-vector-length
|
||||
(-> bit-vector? any)]
|
||||
[bit-vector-copy
|
||||
(-> bit-vector? bit-vector?)])
|
||||
(rename bit-vector-copy*
|
||||
bit-vector-copy
|
||||
(-> bit-vector? bit-vector?)))
|
||||
|
||||
(provide in-bit-vector for/bit-vector for*/bit-vector)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
same elements as the bit-vector @racket[bv].
|
||||
Creates a fresh bit-vector with the
|
||||
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)
|
||||
([maybe-length (code:line)
|
||||
(code:line #:length length-expr)
|
||||
(code:line #:length length-expr #:fill fill-expr)])
|
||||
#:contracts ([length-expr exact-nonnegative-integer?])]{
|
||||
@defform[(for*/bit-vector maybe-length (for-clause ...)
|
||||
body-or-break ... body)]{
|
||||
|
||||
Like @racket[for/bit-vector] but with the implicit nesting of @racket[for*].
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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"]
|
||||
|
|
|
|||
|
|
@ -32,8 +32,8 @@
|
|||
(bit-vector->vector bv))
|
||||
'#(#t #f #t))
|
||||
|
||||
(test-equal? "bit-vector-count"
|
||||
(bit-vector-count (bit-vector #t #f #t))
|
||||
(test-equal? "bit-vector-length"
|
||||
(bit-vector-length (bit-vector #t #f #t))
|
||||
3)
|
||||
|
||||
(test-equal? "in-bit-vector"
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user