0.6.11.11:
[sbcl.git] / src / code / early-type.lisp
index 480a778..ff5252d 100644 (file)
 ;;; Has the type system been properly initialized? (I.e. is it OK to
 ;;; use it?)
 (defvar *type-system-initialized* #+sb-xc-host nil) ; (set in cold load)
+
+;;; Use experimental type functionality?
+;;;
+;;; REMOVEME: Eventually the new type functionality should be stable
+;;; enough that nothing depends on this, and we can remove it again.
+(defvar *xtype?*)
+(!cold-init-forms (setf *xtype?* nil))
 \f
 ;;; Return the type structure corresponding to a type specifier. We
 ;;; pick off structure types as a special case.
@@ -49,7 +56,8 @@
                (or (built-in-class-translation spec) spec)
                spec))
           (t
-           (let* ((lspec (if (atom spec) (list spec) spec))
+           (let* (;; FIXME: This 
+                  (lspec (if (atom spec) (list spec) spec))
                   (fun (info :type :translator (car lspec))))
              (cond (fun (funcall fun lspec))
                    ((or (and (consp spec) (symbolp (car spec)))
         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))
+                      (:copier nil)
                       #!+cmu (:pure nil))
   ;; 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
 ;;; about types that are hairy but defined.
-(defstruct (unknown-type (:include hairy-type)))
+(defstruct (unknown-type (:include hairy-type)
+                        (:copier nil)))
 
 ;;; ARGS-TYPE objects are used both to represent VALUES types and
 ;;; to represent FUNCTION types.
 (defstruct (args-type (:include ctype)
-                     (:constructor nil))
+                     (:constructor nil)
+                     (:copier nil))
   ;; Lists of the type for each required and optional argument.
   (required nil :type list)
   (optional nil :type list)
 
 (defstruct (values-type
            (:include args-type
-                     (class-info (type-class-or-lose 'values)))))
+                     (class-info (type-class-or-lose 'values)))
+           (:copier nil)))
 
-(define-type-class values)
+(!define-type-class values)
 
 (defstruct (function-type
            (:include args-type
 ;;; represents something that the compiler knows to be a constant.)
 (defstruct (constant-type
            (:include ctype
-                     (class-info (type-class-or-lose 'constant))))
+                     (class-info (type-class-or-lose 'constant)))
+           (:copier nil))
   ;; The type which the argument must be a constant instance of for this type
   ;; specifier to win.
   (type (required-argument) :type ctype))
 
 ;;; The NAMED-TYPE is used to represent *, T and NIL. These types must be
-;;; super or sub types of all types, not just classes and * & NIL aren't
+;;; super- or sub-types of all types, not just classes and * and NIL aren't
 ;;; classes anyway, so it wouldn't make much sense to make them built-in
 ;;; classes.
 (defstruct (named-type (:include ctype
-                                (class-info (type-class-or-lose 'named))))
+                                (class-info (type-class-or-lose 'named)))
+                      (:copier nil))
   (name nil :type symbol))
 
-;;; The Numeric-Type is used to represent all numeric types, including things
+;;; A NUMERIC-TYPE represents any numeric type, including things
 ;;; such as FIXNUM.
 (defstruct (numeric-type (:include ctype
                                   (class-info (type-class-or-lose
   ;; 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)))
 
 ;;; The Array-Type is used to represent all array types, including
 ;;; things such as SIMPLE-STRING.
 (defstruct (array-type (:include ctype
-                                (class-info (type-class-or-lose 'array))))
-  ;; The dimensions of the array. * if unspecified. If a dimension is
-  ;; unspecified, it is *.
+                                (class-info (type-class-or-lose 'array)))
+                      (:copier nil))
+  ;; the dimensions of the array, or * if unspecified. If a dimension
+  ;; is unspecified, it is *.
   (dimensions '* :type (or list (member *)))
   ;; Is this not a simple array type? (:MAYBE means that we don't know.)
   (complexp :maybe :type (member t nil :maybe))
-  ;; The element type as originally specified.
+  ;; the element type as originally specified
   (element-type (required-argument) :type ctype)
-  ;; The element type as it is specialized in this implementation.
+  ;; the element type as it is specialized in this implementation
   (specialized-element-type *wild-type* :type ctype))
 
-;;; The Member-Type represents uses of the MEMBER type specifier. We
+;;; A MEMBER-TYPE represent a use of the MEMBER type specifier. We
 ;;; bother with this at this level because MEMBER types are fairly
 ;;; important and union and intersection are well defined.
 (defstruct (member-type (:include ctype
                                  (class-info (type-class-or-lose 'member))
                                  (enumerable t))
+                       (:copier nil)
                        #-sb-xc-host (:pure nil))
-  ;; The things in the set, with no duplications.
+  ;; the things in the set, with no duplications
   (members nil :type list))
 
+;;; A COMPOUND-TYPE is a type defined out of a set of types, 
+;;; the common parent of UNION-TYPE and INTERSECTION-TYPE.
+(defstruct (compound-type (:include ctype)
+                         (:constructor nil)
+                         (:copier nil))
+  (types nil :type list :read-only t))
+
 ;;; 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.
-(defstruct (union-type (:include ctype
+;;;   1. There is never more than one MEMBER-TYPE component.
+;;;   2. There are never any UNION-TYPE components.
+(defstruct (union-type (:include compound-type
                                 (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
+                      (:constructor %make-union-type (enumerable types))
+                      (:copier nil)))
+
+;;; An INTERSECTION-TYPE represents a use of the AND 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 INTERSECTION-TYPE or UNION-TYPE components.
+(defstruct (intersection-type (:include compound-type
+                                       (class-info (type-class-or-lose
+                                                    'intersection)))
+                             (:constructor %make-intersection-type
+                                           (enumerable types))
+                             (:copier nil)))
+
+;;; Return TYPE converted to canonical form for a situation where the
+;;; "type" '* (which SBCL still represents as a type even though ANSI
+;;; CL defines it as a related but different kind of placeholder) 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))))
+                     (:copier nil))
+  ;; 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))
   (when (boundp 'sb!kernel::*values-specifier-type-cache-vector*)
     (values-specifier-type-cache-clear))
   (values))
-\f
-
-;;; MNA: cons compound-type patch
-;;; FIXIT: all commented out
-;;;; Cons types:
-;;; The Cons-Type is used to represent cons types.
-;;;
-;; (defstruct (cons-type (:include ctype
-;;                             (:class-info (type-class-or-lose 'cons)))
-;;                              (:print-function %print-type))
-;;   ;;
-;;   ;; The car element type.
-;;   (car-type *wild-type* :type ctype)
-;;   ;;
-;;   ;; The cdr element type.
-;;   (cdr-type *wild-type* :type ctype))
-
-;; (define-type-class cons)
-
-;;;; 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*