- (let ((cont (nth (1- n) (combination-args call))))
- (when (and cont (constant-continuation-p cont))
- (let* ((specifier (continuation-value cont))
- (lspecifier (if (atom specifier) (list specifier) specifier)))
- (cond
- ((eq (car lspecifier) 'string)
- (destructuring-bind (string &rest size)
- lspecifier
- (declare (ignore string))
- (careful-specifier-type
- `(vector character ,@(when size size)))))
- ((eq (car lspecifier) 'simple-string)
- (destructuring-bind (simple-string &rest size)
- lspecifier
- (declare (ignore simple-string))
- (careful-specifier-type
- `(simple-array character ,@(if size (list size) '((*)))))))
- (t (careful-specifier-type specifier))))))))
+ (let ((lvar (nth (1- n) (combination-args call))))
+ (when (and lvar (constant-lvar-p lvar))
+ (let* ((specifier (lvar-value lvar))
+ (lspecifier (if (atom specifier) (list specifier) specifier)))
+ (cond
+ ((eq (car lspecifier) 'string)
+ (destructuring-bind (string &rest size)
+ lspecifier
+ (declare (ignore string))
+ (careful-specifier-type
+ `(vector character ,@(when size size)))))
+ ((eq (car lspecifier) 'simple-string)
+ (destructuring-bind (simple-string &rest size)
+ lspecifier
+ (declare (ignore simple-string))
+ (careful-specifier-type
+ `(simple-array character ,@(if size (list size) '((*)))))))
+ (t
+ (let ((ctype (careful-specifier-type specifier)))
+ (if (and (array-type-p ctype)
+ (eq (array-type-specialized-element-type ctype)
+ *wild-type*))
+ ;; I don't think I'm allowed to modify what I get
+ ;; back from SPECIFIER-TYPE; it is, after all,
+ ;; cached. Better copy it, then.
+ (let ((real-ctype (copy-structure ctype)))
+ (setf (array-type-element-type real-ctype)
+ *universal-type*
+ (array-type-specialized-element-type real-ctype)
+ *universal-type*)
+ real-ctype)
+ ctype)))))))))