X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftypetran.lisp;h=53f3c64412bede6e520499d7fd88e668f25c4da4;hb=dcd86042bba514f5dfc39246de9cdbb030648569;hp=62d2dcdee8b1f069a8c443cac5958f49394e377c;hpb=8da43adb9b0fe13b1bcad58e1d4588a91adb74dd;p=sbcl.git

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 62d2dcd..53f3c64 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -101,11 +101,11 @@
     (aver ctype)
     (ir1-transform-type-predicate object ctype)))
 
-;;; If FIND-CLASS is called on a constant class, locate the CLASS-CELL
-;;; at load time.
+;;; If FIND-CLASSOID is called on a constant class, locate the
+;;; CLASSOID-CELL at load time.
 (deftransform find-classoid ((name) ((constant-arg symbol)) *)
   (let* ((name (lvar-value name))
-         (cell (find-classoid-cell name)))
+         (cell (find-classoid-cell name :create t)))
     `(or (classoid-cell-classoid ',cell)
          (error "class not yet defined: ~S" name))))
 
@@ -137,6 +137,7 @@
   (define-type-predicate rationalp rational)
   (define-type-predicate realp real)
   (define-type-predicate sequencep sequence)
+  (define-type-predicate extended-sequence-p extended-sequence)
   (define-type-predicate simple-bit-vector-p simple-bit-vector)
   (define-type-predicate simple-string-p simple-string)
   (define-type-predicate simple-vector-p simple-vector)
@@ -491,7 +492,7 @@
             (/noshow "default case -- ,PRED and CLASS-CELL-TYPEP")
             `(and (,pred object)
                   (classoid-cell-typep (,get-layout object)
-                                       ',(find-classoid-cell name)
+                                       ',(find-classoid-cell name :create t)
                                        object)))))))))
 
 ;;; If the specifier argument is a quoted constant, then we consider
@@ -551,7 +552,10 @@
   ;; lvar, transforms it into a quoted form, and gives this
   ;; source transform another chance, so it all works out OK, in a
   ;; weird roundabout way. -- WHN 2001-03-18
-  (if (and (consp spec) (eq (car spec) 'quote))
+  (if (and (consp spec)
+           (eq (car spec) 'quote)
+           (or (not *allow-instrumenting*)
+               (policy *lexenv* (= store-coverage-data 0))))
       (source-transform-typep object (cadr spec))
       (values nil t)))