0.6.11.40:
[sbcl.git] / src / compiler / typetran.lisp
index 1c72075..b23410c 100644 (file)
@@ -71,7 +71,7 @@
 (defun ir1-transform-type-predicate (object type)
   (declare (type continuation object) (type ctype type))
   (let ((otype (continuation-type object)))
-    (cond ((not (types-intersect otype type))
+    (cond ((not (types-equal-or-intersect otype type))
           nil)
          ((csubtypep otype type)
           t)
@@ -94,7 +94,7 @@
                          (continuation-use
                           (basic-combination-fun node))))
                        *backend-predicate-types*)))
-    (assert ctype)
+    (aver ctype)
     (ir1-transform-type-predicate object ctype)))
 
 ;;; If FIND-CLASS is called on a constant class, locate the CLASS-CELL
 ;;; sometimes be generated when byte compiling inline functions, but
 ;;; it's quite uncommon.) -- WHN 20000523
 (deftransform %instance-typep ((object spec) * * :when :both)
-  (assert (constant-continuation-p spec))
+  (aver (constant-continuation-p spec))
   (let* ((spec (continuation-value spec))
         (class (specifier-type spec))
         (name (sb!xc:class-name class))
                   (if (and res (not (layout-invalid res)))
                       res
                       nil))))
-    (/noshow "entering DEFTRANSFORM %INSTANCE-TYPEP" otype spec class name layout)
     (cond
       ;; Flush tests whose result is known at compile time.
-      ((not (types-intersect otype class))
-       (/noshow "flushing constant NIL")
+      ((not (types-equal-or-intersect otype class))
        nil)
       ((csubtypep otype class)
-       (/noshow "flushing constant T")
        t)
       ;; If not properly named, error.
       ((not (and name (eq (sb!xc:find-class name) class)))
              (values '%instancep '%instance-layout))
             (t
              (values '(lambda (x) (declare (ignore x)) t) 'layout-of)))
-        (/noshow pred get-layout)
         (cond
           ((and (eq (class-state class) :sealed) layout
                 (not (class-subclasses class)))
            ;; Sealed and has no subclasses.
-           (/noshow "sealed and has no subclasses")
            (let ((n-layout (gensym)))
              `(and (,pred object)
                    (let ((,n-layout (,get-layout object)))
                                  (%layout-invalid-error object ',layout))))
                      (eq ,n-layout ',layout)))))
           ((and (typep class 'basic-structure-class) layout)
-           (/noshow "structure type tests; hierarchical layout depths")
            ;; structure type tests; hierarchical layout depths
            (let ((depthoid (layout-depthoid layout))
                  (n-layout (gensym)))