;;; a test that the host Lisp object OBJECT translates to a target SBCL
;;; type TYPE. (This behavior is needed e.g. to test for the validity of
;;; numeric subtype bounds read when cross-compiling.)
-;;;
-;;; KLUDGE: In classic CMU CL this was wrapped in a (DECLAIM (START-BLOCK
-;;; TYPEP %TYPEP CLASS-CELL-TYPEP)) to make calls efficient. Once I straighten
-;;; out bootstrapping and cross-compiling issues it'd likely be a good idea to
-;;; do this again. -- WHN 19990413
(defun typep (object type)
#!+sb-doc
"Return T iff OBJECT is of type TYPE."
;;; return whether the object is of that type as the first value and
;;; second value true. Otherwise return NIL, NIL.
;;;
-;;; We give up on unknown types and pick off FUNCTION and UNION types.
-;;; For structure types, we require that the type be defined in both
-;;; the current and compiler environments, and that the INCLUDES be
-;;; the same.
+;;; We give up on unknown types and pick off FUNCTION- and COMPOUND-
+;;; types. For STRUCTURE- types, we require that the type be defined
+;;; in both the current and compiler environments, and that the
+;;; INCLUDES be the same.
(defun ctypep (obj type)
(declare (type ctype type))
(etypecase type
named-type
member-type
array-type
- sb!xc:built-in-class)
+ sb!xc:built-in-class
+ cons-type)
(values (%typep obj type) t))
(sb!xc:class
(if (if (csubtypep type (specifier-type 'funcallable-instance))
(values (sb!xc:typep obj type) t)
(values nil nil))
(values nil t)))
- (union-type
- (dolist (mem (union-type-types type) (values nil t))
- (multiple-value-bind (val win) (ctypep obj mem)
- (unless win (return (values nil nil)))
- (when val (return (values t t))))))
+ (compound-type
+ (let ((certain? t))
+ (etypecase type
+ ;; FIXME: The cases here are very similar to #'EVERY/TYPE and
+ ;; #'ANY/TYPE. It would be good to fix them so that they
+ ;; share the same code. (That will require making sure that
+ ;; the two-value return convention for CTYPEP really is
+ ;; exactly compatible with the two-value convention the
+ ;; quantifier/TYPE functions operate on, and probably also
+ ;; making sure that things are inlined and defined early
+ ;; enough that consing can be avoided.)
+ (union-type
+ (dolist (mem (union-type-types type) (values nil certain?))
+ (multiple-value-bind (val win) (ctypep obj mem)
+ (if win
+ (when val (return (values t t)))
+ (setf certain? nil)))))
+ (intersection-type
+ (dolist (mem (intersection-type-types type)
+ (if certain? (values t t) (values nil nil)))
+ (multiple-value-bind (val win) (ctypep obj mem)
+ (if win
+ (unless val (return (values nil t)))
+ (setf certain? nil))))))))
(function-type
(values (functionp obj) t))
(unknown-type
\f
;;;; miscellaneous interfaces
-;;; Clear memoization of all type system operations that can be altered by
-;;; type definition/redefinition.
+;;; Clear memoization of all type system operations that can be
+;;; altered by type definition/redefinition.
(defun clear-type-caches ()
(when *type-system-initialized*
(dolist (sym '(values-specifier-type-cache-clear
type-union-cache-clear
values-subtypep-cache-clear
csubtypep-cache-clear
- type-intersection-cache-clear
+ type-intersection2-cache-clear
values-type-intersection-cache-clear))
(funcall (symbol-function sym))))
(values))
-;;; Like TYPE-OF, only we return a CTYPE structure instead of a type specifier,
-;;; and we try to return the type most useful for type checking, rather than
-;;; trying to come up with the one that the user might find most informative.
+;;; Like TYPE-OF, only we return a CTYPE structure instead of a type
+;;; specifier, and we try to return the type most useful for type
+;;; checking, rather than trying to come up with the one that the user
+;;; might find most informative.
(declaim (ftype (function (t) ctype) ctype-of))
(defun-cached (ctype-of
:hash-function (lambda (x) (logand (sxhash x) #x1FF))
:complexp (not (typep x 'simple-array))
:element-type etype
:specialized-element-type etype)))
+ (cons
+ (make-cons-type *universal-type* *universal-type*))
(t
(sb!xc:class-of x))))