(defun count-1-bits/optimized (n &aux (bits 0))
  (declare (optimize (speed 3) (debug 0))
           (type (and unsigned-byte fixnum) bits)
           (type unsigned-byte n))
  (if (typep n 'fixnum)
      (locally
          (declare (type fixnum n))
        (loop :while (plusp n) :do
          (when (oddp n)
            (incf bits))
          (setf n (ash n -1))))
      (loop :while (plusp n) :do
        (when (oddp n)
          (incf bits))
        (setf n (ash n -1))))
  bits)

(defun count-1-bits/not-optimized (n)
  (check-type n unsigned-byte)
  (labels ((count-bits (n)
             (if (< n 256)
                 (aref #.(coerce (loop
                                   :for n :below 256
                                   :collect (loop :for i :below 8 :when (logbitp i n) :sum 1))
                                 'vector)
                       n)
                 (let ((divisor (expt 2 (truncate (integer-length n) 2))))
                   (multiple-value-bind (left right)  (truncate n divisor)
                     (+ (count-bits left)
                        (count-bits right)))))))
    (count-bits n)))



(defun count-1-bits/not-optimized-loop (n)
  (check-type n unsigned-byte)
  (loop
    :for i :below (integer-length n) :by 8
    :for byte := (ldb (byte 8 i) n)
    :sum (aref #.(coerce (loop
                           :for n :below 256
                           :collect (loop :for i :below 8 :when (logbitp i n) :sum 1))
                         'vector)
               byte)))


(defun test ()
  (loop
    :with sa := 0
    :with sb := 0
    :with sc := 0
    :with rep := 20
    :repeat rep
    :do (let ((n (random (expt 2 4096))))
          (let* ((a)
                 (b)
                 (c)
                 (ta (com.informatimago.common-lisp.cesarum.time:chrono-run-time
                       (setf a (count-1-bits/optimized n))))
                 (tb (com.informatimago.common-lisp.cesarum.time:chrono-run-time
                       (setf b (count-1-bits/not-optimized n))))
                 (tc (com.informatimago.common-lisp.cesarum.time:chrono-run-time
                       (setf c (count-1-bits/not-optimized-loop n)))))
            (assert (= a b c))
            (incf sa ta)
            (incf sb tb)
            (incf sc tc)))
    :finally (format t "~&average optimized          = ~,9f~%average non-optimized      = ~,9f~%average non-optimized-loop = ~,9f~%"
                     (/ sa rep) (/ sb rep) (/ sc rep))))