#lang racket

(provide next-chunk-size-multiple
         make-boolean-vector boolean-vector-length
         boolean-vector-ref boolean-vector-set! 
         boolean-vector-count boolean-vector->vector
         boolean-vector-for-each do-boolean-vector
         )

(define chunk-size 8)

(define (chunks-needed n)
  (+ (quotient n chunk-size)
     (if (zero? (modulo n chunk-size)) 
       0
       1)))

;; rounds to the next multiple of chunk-size.
(define (next-chunk-size-multiple n)
  (* (chunks-needed n) chunk-size))

(define (make-boolean-vector q init)
  (make-bytes (chunks-needed q)
              (case init
                ((#f) 0)
                ((#t) 255)
                (else (error 'make-boolean-vectors)))))

;; (define (indici i)
;;   (let* ((ii (arithmetic-shift i -3))
;;          (mm (bitwise-and i 7)))
;;     (list ii mm)))

(define (boolean-vector-ref s i)
  (let ((ii (arithmetic-shift i -3))
        (mm (bitwise-and i 7)))
    (bitwise-bit-set? (bytes-ref s ii) mm)))

(define (boolean-vector-set! s i v)
  (let* ((ii (arithmetic-shift i -3))
         (mm (bitwise-and i 7))
         (mask (arithmetic-shift 1 mm)))
    (bytes-set! s ii
                (if v
                  (bitwise-ior (bytes-ref s ii) mask)
                  (bitwise-and (bytes-ref s ii) (bitwise-not mask))))))

(define (count-byte b)
  (if (zero? b)
    0
    (let ((cc (count-byte (arithmetic-shift b -1))))
      (if (odd? b)
        (+ 1 cc)
        cc))))

(define (make-byte-count-vector limit)
  (let ((v (make-vector limit)))
    (let nexti ((i 0))
      (if (= i limit)
        v
        (begin
          (vector-set! v i (count-byte i))
          (nexti (add1 i)))))))

(define byte-count-vector
  (make-byte-count-vector (expt 2 chunk-size)))

;; returns count of #t
(define (boolean-vector-count s)
  (let ((limit (bytes-length s)))
    (let ancora ((i 0) (conto 0))
      (if (= i limit)
        conto
        (ancora (+ i 1) 
                (+ conto
                   (vector-ref byte-count-vector (bytes-ref s i))))))))

(define (boolean-vector->vector b)
  (let* ((dim (boolean-vector-length b))
         (v (make-vector dim)))
    (do-boolean-vector (index value b v)
      (vector-set! v index value))))

(define (boolean-vector-length v)
  (* chunk-size (bytes-length v)))

(define (boolean-vector-for-each fun bv)
  (do-boolean-vector (i e bv)
    (fun i e)))

(define-syntax do-boolean-vector
  (syntax-rules ()
    ((_ (index boolean-element boolean-vector result)
        expr ...)
     (let ((number-of-chunks (bytes-length boolean-vector)))
       (let next-chunk ((c 0) (index 0))
         (unless (= c number-of-chunks)
           (let ((chunk (bytes-ref boolean-vector c)))
             (let next-element ((bit 0) (index index))
               (if (= bit chunk-size)
                 (next-chunk (+ c 1) index)
                 (let ((boolean-element (bitwise-bit-set? chunk bit)))
                   expr ...
                   (next-element (+ bit 1) (+ index 1))))))))
       result))
    ((_ (index boolean-element boolean-vector)
        expr ...)
     (do-boolean-vector (index boolean-element boolean-vector (void))
       expr ...))))