memory usage issue for double-float operations

Hi,

Is there a way to modify the example below so that the final form does
not allocate memory in SBCL?  (To be fair, I tried several other Lisps
as well, and all of them allocated memory.)

(declaim (optimize (compilation-speed 0) (debug 0) (speed 3) (space 0)
                   (safety 0)))

(defvar *ar* (make-array '(5000)
                         :element-type 'double-float
                         :initial-element 0.0d0))

(loop with i of-type (integer 0 *) = 0 do
      (cond ((>= i 5000)
             (return))
            (t (progn (setf (aref *ar* i)
                            (float i 0.0d0))
                      (setq i (1+ i))))))

(defun foo ()
  (loop with i of-type fixnum = 0 do 
        (cond
         ((>= i 4999) ; <-- for i from 0 to 4999 ... 
          (return))
         (t (setf (aref *ar* i)
                  (the double-float
                       (+ 1.0d0
                          (the double-float (aref *ar* i)))))
            (setq i (the fixnum (1+ i)))))))

(time (foo))

Thanks,
Matt