(defun digits (n &optional (b 10))
  (loop for i = n then (floor i b) with lst = ()
     do (push (mod i b) lst)
     while (> i (1- b))
     finally (return lst)))

(defun onep (n) (equal 1 n))
(defun count-ones (n)
  (reduce #'+ (remove-if-not #'onep (digits n))))

(defun count-ones-find (fun)
  (loop for i = 1 then (1+ i) with sum = 0
     do (progn
	  (setf sum (+ sum (funcall fun i))))
     until (and (> i 1) (equal i sum))
     finally (return i)))

; CL-USER> (time (count-ones-find #'count-ones))
; Evaluation took:
;   0.081 seconds of real time
;   0.084005 seconds of total run time (0.084005 user, 0.000000 system)
;   103.70% CPU
;   248,871,367 processor cycles
;   23,818,080 bytes consed
;  
; 199981