X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-type.lisp;h=c4fe88a07e7e91934e73334a1e5dff0416742ffe;hb=212ef8043aeaceaa627f2924e04554fbc37b8ee1;hp=db84f2dc7d7e6bfa60f56847848b521c4326e80a;hpb=3aff5655417da74a19ce576f55b2cb6999cda6c5;p=sbcl.git

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index db84f2d..c4fe88a 100644
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -93,7 +93,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 +120,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
@@ -207,15 +207,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))
 
-;;; 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))