don't check SUBTYPEP of ELEMENT-TYPE in ADJUST-ARRAY unnecessarily

[sbcl.git] / src / code / array.lisp

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 0d44b09..90b7a99 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -836,18 +836,17 @@ of specialized arrays is supported."
            (setf (%array-fill-pointer array) (1+ fill-pointer))
            fill-pointer))))
 
-(defun vector-push-extend (new-element
-                           vector
-                           &optional
-                           (min-extension
-                            (let ((length (length vector)))
-                              (min (1+ length)
-                                   (- array-dimension-limit length)))))
-  (declare (fixnum min-extension))
+(defun vector-push-extend (new-element vector &optional min-extension)
+  (declare (type (or null fixnum) min-extension))
   (let ((fill-pointer (fill-pointer vector)))
     (declare (fixnum fill-pointer))
     (when (= fill-pointer (%array-available-elements vector))
-      (adjust-array vector (+ fill-pointer (max 1 min-extension))))
+      (let ((min-extension
+             (or min-extension
+                 (let ((length (length vector)))
+                   (min (1+ length)
+                        (- array-dimension-limit length))))))
+        (adjust-array vector (+ fill-pointer (max 1 min-extension)))))
     ;; disable bounds checking
     (locally (declare (optimize (safety 0)))
       (setf (aref vector fill-pointer) new-element))
@@ -872,7 +871,7 @@ of specialized arrays is supported."
 ;;;; ADJUST-ARRAY
 
 (defun adjust-array (array dimensions &key
-                           (element-type (array-element-type array))
+                           (element-type (array-element-type array) element-type-p)
                            (initial-element nil initial-element-p)
                            (initial-contents nil initial-contents-p)
                            fill-pointer
@@ -885,7 +884,8 @@ of specialized arrays is supported."
     (cond ((/= (the fixnum (length (the list dimensions)))
                (the fixnum (array-rank array)))
            (error "The number of dimensions not equal to rank of array."))
-          ((not (subtypep element-type (array-element-type array)))
+          ((and element-type-p
+                (not (subtypep element-type (array-element-type array))))
            (error "The new element type, ~S, is incompatible with old type."
                   element-type))
           ((and fill-pointer (not (array-has-fill-pointer-p array)))