;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
+;;; FIXME: Many of the functions in this file could probably be
+;;; byte-compiled, since they're one-pass, cons-heavy code.
+
(in-package "SB!C")
\f
;;;; type predicate translation
(member ,@(remove nil members))))))))
(t
(once-only ((n-obj object))
- `(or ,@(mapcar #'(lambda (x)
- `(typep ,n-obj ',(type-specifier x)))
+ `(or ,@(mapcar (lambda (x)
+ `(typep ,n-obj ',(type-specifier x)))
types)))))))
+;;; Do source transformation for TYPEP of a known intersection type.
+(defun source-transform-intersection-typep (object type)
+ (once-only ((n-obj object))
+ `(and ,@(mapcar (lambda (x)
+ `(typep ,n-obj ',(type-specifier x)))
+ (intersection-type-types type)))))
+
;;; If necessary recurse to check the cons type.
(defun source-transform-cons-typep (object type)
(let* ((car-type (cons-type-car-type type))
',(find-class-cell name)
object)))))))))
-#|
-;;; Return (VALUES BEST-GUESS EXACT?), where BEST-GUESS is a CTYPE
-;;; which corresponds to the value returned by
-;;; CL:UPGRADED-ARRAY-ELEMENT-TYPE, and EXACT? tells whether that
-;;; result might change when we encounter a DEFTYPE.
-(declaim (maybe-inline upgraded-array-element-ctype-2))
-(defun upgraded-array-element-ctype-2 (spec)
- (let ((ctype (specifier-type `(array ,spec))))
- (values (array-type-specialized-element-type
- (specifier-type `(array ,spec)))
- (not (unknown-type-p (array-type-element-type ctype))))))
-|#
-
;;; If the specifier argument is a quoted constant, then we consider
;;; converting into a simple predicate or other stuff. If the type is
;;; constant, but we can't transform the call, then we convert to
(source-transform-hairy-typep object type))
(union-type
(source-transform-union-typep object type))
+ (intersection-type
+ (source-transform-intersection-typep object type))
(member-type
`(member ,object ',(member-type-members type)))
(args-type