0.6.10.6:

[sbcl.git] / src / code / early-type.lisp

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index 3c8c59d..1b34a4e 100644 (file)
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -84,8 +84,9 @@
         form)))
 
 ;;; A HAIRY-TYPE represents anything too weird to be described
-;;; reasonably or to be useful, such as AND, NOT and SATISFIES and
-;;; unknown types. We just remember the original type spec.
+;;; reasonably or to be useful, such as NOT, SATISFIES, unknown types,
+;;; and unreasonably complicated types involving AND. We just remember
+;;; the original type spec.
 (defstruct (hairy-type (:include ctype
                                 (class-info (type-class-or-lose 'hairy))
                                 (enumerable t))
@@ -93,7 +94,7 @@
   ;; the Common Lisp type-specifier
   (specifier nil :type t))
 
-(define-type-class hairy)
+(!define-type-class hairy)
 
 ;;; An UNKNOWN-TYPE is a type not known to the type system (not yet
 ;;; defined). We make this distinction since we don't want to complain
@@ -120,7 +121,7 @@
            (:include args-type
                      (class-info (type-class-or-lose 'values)))))
 
-(define-type-class values)
+(!define-type-class values)
 
 (defstruct (function-type
            (:include args-type
@@ -175,9 +176,9 @@
   ;; FIXME: I'm bewildered by FOO-P names for things not intended to
   ;; interpreted as truth values. Perhaps rename this COMPLEXNESS?
   (complexp :real :type (member :real :complex nil))
-  ;; The upper and lower bounds on the value. If null, there is no bound. If
-  ;; a list of a number, the bound is exclusive. Integer types never have
-  ;; exclusive bounds.
+  ;; The upper and lower bounds on the value, or NIL if there is no
+  ;; bound. If a list of a number, the bound is exclusive. Integer
+  ;; types never have exclusive bounds.
   (low nil :type (or number cons null))
   (high nil :type (or number cons null)))
 
@@ -207,15 +208,43 @@
 
 ;;; A UNION-TYPE represents a use of the OR type specifier which can't
 ;;; be canonicalized to something simpler. Canonical form:
-;;;   1. There is never more than one Member-Type component.
-;;;   2. There are never any Union-Type components.
+;;;   1. There is never more than one MEMBER-TYPE component.
+;;;   2. There are never any UNION-TYPE components.
 (defstruct (union-type (:include ctype
                                 (class-info (type-class-or-lose 'union)))
                       (:constructor %make-union-type (enumerable types)))
   ;; The types in the union.
   (types nil :type list))
-\f
-;;; Note that the type Name has been (re)defined, updating the
+
+;;; Return TYPE converted to canonical form for a situation where the
+;;; type '* is equivalent to type T.
+(defun type-*-to-t (type)
+  (if (type= type *wild-type*)
+      *universal-type*
+      type))
+
+;;; A CONS-TYPE is used to represent a CONS type.
+(defstruct (cons-type (:include ctype
+                               (:class-info (type-class-or-lose 'cons)))
+                     (:constructor
+                      ;; ANSI says that for CAR and CDR subtype
+                      ;; specifiers '* is equivalent to T. In order
+                      ;; to avoid special cases in SUBTYPEP and
+                      ;; possibly elsewhere, we slam all CONS-TYPE
+                      ;; objects into canonical form w.r.t. this
+                      ;; equivalence at creation time.
+                      make-cons-type (car-raw-type
+                                      cdr-raw-type
+                                      &aux
+                                      (car-type (type-*-to-t car-raw-type))
+                                      (cdr-type (type-*-to-t cdr-raw-type)))))
+  ;; the CAR and CDR element types (to support ANSI (CONS FOO BAR) types)
+  ;;
+  ;; FIXME: Most or all other type structure slots could also be :READ-ONLY.
+  (car-type (required-argument) :type ctype :read-only t)
+  (cdr-type (required-argument) :type ctype :read-only t))
+
+;;; Note that the type NAME has been (re)defined, updating the
 ;;; undefined warnings and VALUES-SPECIFIER-TYPE cache.
 (defun %note-type-defined (name)
   (declare (symbol name))
@@ -223,10 +252,10 @@
   (when (boundp 'sb!kernel::*values-specifier-type-cache-vector*)
     (values-specifier-type-cache-clear))
   (values))
-\f
-;;;; KLUDGE: not clear this really belongs here, but where?
 
 ;;; Is X a fixnum in the target Lisp?
+;;;
+;;; KLUDGE: not clear this really belongs in early-type.lisp, but where?
 (defun target-fixnump (x)
   (and (integerp x)
        (<= sb!vm:*target-most-negative-fixnum*