Bit vector to integer

bit-vector-to-bignum.lisp

(defun to-bignum-reduce (bits)
  (declare (type (simple-array bit (*)) bits))
  (reduce (lambda (a b)
            (declare (type bit b)
                     (type unsigned-byte a))
            (logior (ash a 1) b))
          bits))

(defun to-bignum-direct-1 (bits)
  (declare (type (simple-array bit (*)) bits))
  (loop with result = 0
        for i fixnum from (1- (length bits)) downto 0
        for j fixnum upfrom 0
        do (setf (ldb (byte 1 j) result)
                 (aref bits i))
        finally (return result)))

(defun to-bignum-direct-2 (bits)
  (declare (type (simple-array bit (*)) bits))
  (loop with endpos = (1- (length bits))
        with result = 0
        for i fixnum from 0 to endpos
        do (setf (ldb (byte 1 (- endpos i)) result)
                 (aref bits i))
        finally (return result)))

(defun to-bignum-chunks (bits)
  (declare (type (simple-array bit (*)) bits))
  (let* ((chunk-length #.(integer-length most-positive-fixnum))
         (result 0)
         (chunk 0)
         (j chunk-length))
    (declare (type (and fixnum unsigned-byte) chunk j)
             (type unsigned-byte result))
    (loop for i below (length bits)
          do (when (zerop j)
               (setf result (logior (ash result chunk-length)
                                    chunk)
                     chunk 0
                     j chunk-length))
             (setf chunk (logior (ash chunk 1)
                                 (aref bits i)))
             (decf j))
    (unless (= chunk-length j)
      (setf result (logior (ash result (- chunk-length j))
                           chunk)))
    result))

(defun number-to-bits (n)
  (let ((bits (loop repeat (integer-length n)
                    collect (ldb (byte 1 0) n)
                    do (setf n (ash n -1)))))
    (make-array (length bits)
                :element-type 'bit
                :initial-contents (reverse bits))))

(defun benchmark (&key (width 300) (nreps 100000))
  (let* ((x (random (expt 2 width)))
         (bits (number-to-bits x)))
    (assert (= x (to-bignum-reduce bits)))
    (assert (= x (to-bignum-direct-1 bits)))
    (assert (= x (to-bignum-direct-2 bits)))
    (assert (= x (to-bignum-chunks bits)))
    (time (loop repeat nreps do (to-bignum-reduce bits)))
    (time (loop repeat nreps do (to-bignum-direct-1 bits)))
    (time (loop repeat nreps do (to-bignum-direct-2 bits)))
    (time (loop repeat nreps do (to-bignum-chunks bits)))))