Comment 1 for bug 1310574

An attempt at fixing the problem, not sure if it handles all types correctly, or if expanding to (THE (MEMBER ...) ...) is the right way to specify the result type if it isn't a constant:

(defun array-type-rank-or-give-up (type)
  (labels ((maybe-array-type-ranks (type)
             (typecase type
               (array-type
                (list
                 (if (listp (array-type-dimensions type))
                     (length (array-type-dimensions type))
                     '*)))
               (union-type
                (remove-duplicates
                 (remove nil (mapcan #'maybe-array-type-ranks
                                     (union-type-types type)))))
               (intersection-type
                (let ((d (array-type-dimensions-or-give-up type)))
                  (list (if (consp d) (length d) d)))))))
    (or (maybe-array-type-ranks type)
        (give-up-ir1-transform
         (print "~@<don't know how to extract array dimensions from type ~S~:@>")
         (type-specifier type)))))

(deftransform array-rank ((array) (array) * :node node)
  (let ((array-type (lvar-type array)))
    (let ((dims (array-type-rank-or-give-up array-type)))
      (cond ((and (consp dims)
                  (every #'numberp dims))
             (if (every (lambda (a) (= a (car dims))) (cdr dims))
                 (car dims)
                 `(the (member ,@dims)
                       (%array-rank array))))
            ((eq t (and (array-type-p array-type)
                        (array-type-complexp array-type)))
             '(%array-rank array))
            (t
             (delay-ir1-transform node :constraint)
             `(if (array-header-p array)
                  (%array-rank array)
                  1))))))