Re: Potential infinite loop in sb-c::array-type-upgraded-element-type with sb-kernel:union-type

Okay, here's the example stripped away from my libraries and reproduceable in a
fresh SBCL 2.4.7.  Below, ARRAY-STORAGE-SUM/ROW-MAJOR-AREF compiles, but
ARRAY-STORAGE-SUM/AREF does not. The compilation is also successful if we remove
the (DECLARE (TYPE ARRAY ARRAY)) from ARRAY-STORAGE-SUM/AREF.


    (in-package :cl-user)

    (deftype size () `(unsigned-byte 62))

    (declaim (inline cl-array-offset))
    (declaim (ftype (function (cl:array) size) cl-array-offset))
    (defun cl-array-offset (array)
      (declare (optimize speed)
               (type cl:array array))
      (loop :with total-offset :of-type (signed-byte 61) := 0
            :if (typep array 'cl:simple-array)
              :do (return total-offset)
            :else
              :do (multiple-value-bind (displaced-to offset)
                      (cl:array-displacement array)
                    (declare (type (signed-byte 61) offset))
                    (incf total-offset offset)
                    (setq array displaced-to))))

    (declaim (inline array-storage)
             (ftype (function (cl:array) (cl:simple-array * 1))))
    (defun array-storage (array)
      (declare (optimize speed))
      (loop :with array := array
            :do (typecase array
                  ((cl:simple-array * (*)) (return array))
                  (cl:simple-array (sb-ext:array-storage-vector array))
                  (t (setq array (cl:array-displacement array))))))

    (defun array-storage-sum/row-major-aref (array)
      (declare (type array array))
      (let ((asv (array-storage array))
            (offset (cl-array-offset array))
            (sum 0))
        (loop :for i :from offset :below (+ offset (array-total-size array))
              :do (incf sum (row-major-aref asv i)))
        sum))
    
    (defun array-storage-sum/aref (array)
      (declare (type array array))
      (let ((asv (array-storage array))
            (offset (cl-array-offset array))
            (sum 0))
        (loop :for i :from offset :below (+ offset (array-total-size array))
              :do (incf sum (aref asv i)))
        sum))