MAKE-ARRAY can't detect some ELEMENT-TYPE in compile-time

[Hugo Sansaqua]

(defun test-ubyte32 (vector)
  (declare (optimize (speed 3) (safety 0))
           ((simple-array (unsigned-byte 32) (*)) vector))
  (let* ((n (length vector))
         (res (make-array n :element-type (array-element-type vector))))
    (dotimes (i n res)
      (setf (aref res i) (aref vector i)))))

; note: unable to
; optimize
; due to type uncertainty:
; The first argument is a (SIMPLE-ARRAY * (*)), not a SIMPLE-STRING.

MAKE-ARRAY can't detect that RES has the same element type as VECTOR and fails to optimize it. On the other hand, the following example is successfully optimized:

(defun test-fixnum (vector)
  (declare (optimize (speed 3) (safety 0))
           ((simple-array fixnum (*)) vector))
  (let* ((n (length vector))
         (res (make-array n :element-type (array-element-type vector))))
    (dotimes (i n res)
      (setf (aref res i) (aref vector i)))))

As far as I can see, the cause of this phenomenon is that CONS-TYPE is not a singleton. LVAR-TYPE of ELEMENT-TYPE is (CONS (MEMBER UNSIGNED-BYTE) (CONS (INTEGER 32 32) NULL)) in the first example but is (MEMBER FIXNUM) in the second one. Only the latter is constant-folded as FIXNUM.

By introducing the function TYPE-CONSTANT-CONS-P and calling it from LVAR-VALUE and CONSTANT-LVAR-P, it seems to me this problem is fixed (at least superficially). I know little about the internals and it's a quick-fix, however. (In the first place, can I regard a CONS type of singletons as constant?) There were no newly failing test cases after this change in my environment, Windows 8.

Results of compilations:
https://wandbox.org/permlink/yg2YqdQY4i9rfV8Q

[Stas Boukarev (stassats)]

That changes
(defparameter *cons* '(0))

(defun test (x)
  (declare (optimize (speed 3) (safety 0))
           ((cons (integer 0 0) null) x))
  (find x '(#.*cons*)))

(test *cons*) => NIL.

[Hugo Sansaqua (privet-kitty)]

Thanks for giving me an example. Do you know what happens if the change is limited to ELEMENT-TYPE, then?

[Stas Boukarev (stassats)]

I'd just do
(deftransform array-element-type ((array))
  (let ((type (lvar-type array)))
    (if (and (array-type-p type)
             (neq (array-type-specialized-element-type type) *wild-type*))
        `',(type-specifier (array-type-specialized-element-type type))
        (give-up-ir1-transform))))

[Stas Boukarev (stassats)]

9f0d12e7ab961828931d01c0b2a76a5885ad35d2