X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-type.lisp;h=166e38aff337e9232298c57d56b08bea7c624938;hb=212ef8043aeaceaa627f2924e04554fbc37b8ee1;hp=b3415d24e4cbc1f55db04b8da159546e906c08b2;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp
index b3415d2..166e38a 100644
--- a/src/code/target-type.lisp
+++ b/src/code/target-type.lisp
@@ -29,13 +29,14 @@
   "Return T iff OBJECT is of type TYPE."
   (%typep object type))
 
-;;; If Type is a type that we can do a compile-time test on, then return the
-;;; whether the object is of that type as the first value and second value
-;;; true. Otherwise return NIL, NIL.
+;;; If TYPE is a type that we can do a compile-time test on, then
+;;; 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 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.
 (defun ctypep (obj type)
   (declare (type ctype type))
   (etypecase type
@@ -43,7 +44,8 @@
 	 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))
@@ -145,8 +147,8 @@
 
 ;;;; 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
@@ -159,9 +161,10 @@
       (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))
@@ -200,6 +203,8 @@
 			: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))))