X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftypetran.lisp;h=6abf25c2d8b227b0e63648e8323da98d2a1027c9;hb=c553e4be6da2d18f0827f190589c88e837b8b8a6;hp=4f47e172178744b148aa04c313c2c8fc1ee5338d;hpb=5a9a81ca693a7b82d810cbe725818cd96244099e;p=sbcl.git

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 4f47e17..6abf25c 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -406,14 +406,24 @@
              ;; not safe to assume here that it will eventually
              ;; have (UPGRADED-ARRAY-ELEMENT-TYPE type)=T, so punt.)
              (not (unknown-type-p (array-type-element-type type)))
-             (eq (array-type-complexp stype) (array-type-complexp type)))
-          (once-only ((n-obj obj))
-            (multiple-value-bind (tests headerp)
-                (test-array-dimensions n-obj type stype)
-              `(and (,pred ,n-obj)
-                    ,@tests
-                    ,@(test-array-element-type n-obj type stype headerp))))
-          `(%typep ,obj ',(type-specifier type)))))
+             (or (eq (array-type-complexp stype) (array-type-complexp type))
+                 (and (eql (array-type-complexp stype) :maybe)
+                      (eql (array-type-complexp type) t))))
+        (once-only ((n-obj obj))
+          (multiple-value-bind (tests headerp)
+              (test-array-dimensions n-obj type stype)
+            `(and (,pred ,n-obj)
+                  ,@(when (and (eql (array-type-complexp stype) :maybe)
+                               (eql (array-type-complexp type) t))
+                      ;; KLUDGE: this is a bit lame; if we get here,
+                      ;; we already know that N-OBJ is an array, but
+                      ;; (NOT SIMPLE-ARRAY) doesn't know that.  On the
+                      ;; other hand, this should get compiled down to
+                      ;; two widetag tests, so it's only a bit lame.
+                      `((typep ,n-obj '(not simple-array))))
+                  ,@tests
+                  ,@(test-array-element-type n-obj type stype headerp))))
+        `(%typep ,obj ',(type-specifier type)))))
 
 ;;; Transform a type test against some instance type. The type test is
 ;;; flushed if the result is known at compile time. If not properly