X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftypetran.lisp;h=b601e7a731c51b7cd49c2935a53c2511a49a67ca;hb=559d0ded238d8ec852fcd485656ef14578fc405f;hp=71061b0fbce1969242932e7a5b6958168d9ceb67;hpb=0aecc2b20142e08068c3434273500131cb13fe2d;p=sbcl.git

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 71061b0..b601e7a 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -497,42 +497,43 @@
   ;; weird roundabout way. -- WHN 2001-03-18
   (if (and (consp spec) (eq (car spec) 'quote))
       (let ((type (careful-specifier-type (cadr spec))))
-        (or (when (not type)
-              (compiler-warn "illegal type specifier for TYPEP: ~S"
-                             (cadr spec))
-              `(%typep ,object ,spec))
-            (let ((pred (cdr (assoc type *backend-type-predicates*
-                                    :test #'type=))))
-              (when pred `(,pred ,object)))
-            (typecase type
-              (hairy-type
-               (source-transform-hairy-typep object type))
-              (negation-type
-               (source-transform-negation-typep object type))
-              (union-type
-               (source-transform-union-typep object type))
-              (intersection-type
-               (source-transform-intersection-typep object type))
-              (member-type
-               `(if (member ,object ',(member-type-members type)) t))
-              (args-type
-               (compiler-warn "illegal type specifier for TYPEP: ~S"
-                              (cadr spec))
-               `(%typep ,object ,spec))
-              (t nil))
-            (typecase type
-              (numeric-type
-               (source-transform-numeric-typep object type))
-              (classoid
-               `(%instance-typep ,object ,spec))
-              (array-type
-               (source-transform-array-typep object type))
-              (cons-type
-               (source-transform-cons-typep object type))
-              (character-set-type
-               (source-transform-character-set-typep object type))
-              (t nil))
-            `(%typep ,object ,spec)))
+        (block bail
+          (or (when (not type)
+                (compiler-warn "illegal type specifier for TYPEP: ~S"
+                               (cadr spec))
+                (return-from bail (values nil t)))
+              (let ((pred (cdr (assoc type *backend-type-predicates*
+                                      :test #'type=))))
+                (when pred `(,pred ,object)))
+              (typecase type
+                (hairy-type
+                 (source-transform-hairy-typep object type))
+                (negation-type
+                 (source-transform-negation-typep object type))
+                (union-type
+                 (source-transform-union-typep object type))
+                (intersection-type
+                 (source-transform-intersection-typep object type))
+                (member-type
+                 `(if (member ,object ',(member-type-members type)) t))
+                (args-type
+                 (compiler-warn "illegal type specifier for TYPEP: ~S"
+                                (cadr spec))
+                 (return-from bail (values nil t)))
+                (t nil))
+              (typecase type
+                (numeric-type
+                 (source-transform-numeric-typep object type))
+                (classoid
+                 `(%instance-typep ,object ,spec))
+                (array-type
+                 (source-transform-array-typep object type))
+                (cons-type
+                 (source-transform-cons-typep object type))
+                (character-set-type
+                 (source-transform-character-set-typep object type))
+                (t nil))
+              `(%typep ,object ,spec))))
       (values nil t)))
 
 ;;;; coercion