;;;; predicates so complex that the only reasonable implentation is
;;;; via function call.
;;;;
-;;;; Some standard types (such as SEQUENCE) are best tested by letting
-;;;; the TYPEP source transform do its thing with the expansion. These
+;;;; Some standard types (such as ATOM) are best tested by letting the
+;;;; TYPEP source transform do its thing with the expansion. These
;;;; types (and corresponding predicates) are not maintained in this
;;;; association. In this case, there need not be any predicate
;;;; function unless it is required by the Common Lisp specification.
(define-type-predicate numberp number)
(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)
class:~% ~S"
class))
(t
- ;; Delay the type transform to give type propagation a chance.
- (delay-ir1-transform node :constraint)
+ ;; Delay the type transform to give type propagation a chance.
+ (delay-ir1-transform node :constraint)
;; Otherwise transform the type test.
(multiple-value-bind (pred get-layout)
(n-layout (gensym)))
`(and (,pred object)
(let ((,n-layout (,get-layout object)))
- ,@(when (policy *lexenv* (>= safety speed))
- `((when (layout-invalid ,n-layout)
- (%layout-invalid-error object ',layout))))
+ ;; we used to check for invalid layouts here,
+ ;; but in fact that's both unnecessary and
+ ;; wrong; it's unnecessary because structure
+ ;; classes can't be redefined, and it's wrong
+ ;; because it is quite legitimate to pass an
+ ;; object with an invalid layout to a structure
+ ;; type test.
(if (eq ,n-layout ',layout)
t
(and (> (layout-depthoid ,n-layout)
,depthoid)
(locally (declare (optimize (safety 0)))
- (eq (svref (layout-inherits ,n-layout)
- ,depthoid)
+ ;; Use DATA-VECTOR-REF directly,
+ ;; since that's what SVREF in a
+ ;; SAFETY 0 lexenv will eventually be
+ ;; transformed to. This can give a
+ ;; large compilation speedup, since
+ ;; %INSTANCE-TYPEPs are frequently
+ ;; created during GENERATE-TYPE-CHECKS,
+ ;; and the normal aref transformation path
+ ;; is pretty heavy.
+ (eq (data-vector-ref (layout-inherits ,n-layout)
+ ,depthoid)
',layout))))))))
((and layout (>= (layout-depthoid layout) 0))
;; hierarchical layout depths for other things (e.g.
- ;; CONDITIONs)
+ ;; CONDITION, STREAM)
(let ((depthoid (layout-depthoid layout))
(n-layout (gensym))
(n-inherits (gensym)))
`(and (,pred object)
(let ((,n-layout (,get-layout object)))
- ,@(when (policy *lexenv* (>= safety speed))
- `((when (layout-invalid ,n-layout)
- (%layout-invalid-error object ',layout))))
+ (when (layout-invalid ,n-layout)
+ (setq ,n-layout (update-object-layout-or-invalid
+ object ',layout)))
(if (eq ,n-layout ',layout)
t
(let ((,n-inherits (layout-inherits ,n-layout)))
(declare (optimize (safety 0)))
(and (> (length ,n-inherits) ,depthoid)
- (eq (svref ,n-inherits ,depthoid)
+ ;; See above.
+ (eq (data-vector-ref ,n-inherits ,depthoid)
',layout))))))))
(t
(/noshow "default case -- ,PRED and CLASS-CELL-TYPEP")
;; 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)))
\f