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

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index eb23711..6abf25c 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -238,7 +238,8 @@
            `(%typep ,object ',spec))
           (t
            (ecase (first spec)
-             (satisfies `(if (funcall #',(second spec) ,object) t nil))
+             (satisfies
+              `(if (funcall (global-function ,(second spec)) ,object) t nil))
              ((not and)
               (once-only ((n-obj object))
                 `(,(first spec) ,@(mapcar (lambda (x)
@@ -405,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
@@ -621,6 +632,11 @@
               `(if (typep x ',tval)
                    x
                    (replace (make-array (length x) :element-type 'character) x)))
+             ;; Special case VECTOR
+             ((eq tval 'vector)
+              `(if (vectorp x)
+                   x
+                   (replace (make-array (length x)) x)))
              ;; Handle specialized element types for 1D arrays.
              ((csubtypep tspec (specifier-type '(array * (*))))
               ;; Can we avoid checking for dimension issues like (COERCE FOO