;;; 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.
-;;;
-;;; Note: VALUES-SPECIFIER-TYPE-CACHE-CLEAR must be called whenever a
-;;; type is defined (or redefined).
-(defun-cached (values-specifier-type
- :hash-function (lambda (x)
- ;; FIXME: the THE FIXNUM stuff is
- ;; redundant in SBCL (or modern CMU
- ;; CL) because of type inference.
- (the fixnum
- (logand (the fixnum (sxhash x))
- #x3FF)))
- :hash-bits 10
- :init-wrapper !cold-init-forms)
- ((orig eq))
- (let ((u (uncross orig)))
- (or (info :type :builtin u)
- (let ((spec (type-expand u)))
- (cond
- ((and (not (eq spec u))
- (info :type :builtin spec)))
- ((eq (info :type :kind spec) :instance)
- (sb!xc:find-class spec))
- ((typep spec 'class)
- ;; There doesn't seem to be any way to translate
- ;; (TYPEP SPEC 'BUILT-IN-CLASS) into something which can be
- ;; executed on the host Common Lisp at cross-compilation time.
- #+sb-xc-host (error
- "stub: (TYPEP SPEC 'BUILT-IN-CLASS) on xc host")
- (if (typep spec 'built-in-class)
- (or (built-in-class-translation spec) spec)
- spec))
- (t
- (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)))
- (symbolp spec))
- (when *type-system-initialized*
- (signal 'parse-unknown-type :specifier spec))
- ;; (The RETURN-FROM here inhibits caching.)
- (return-from values-specifier-type
- (make-unknown-type :specifier spec)))
- (t
- (error "bad thing to be a type specifier: ~S"
- spec))))))))))
-
-;;; Like VALUES-SPECIFIER-TYPE, except that we guarantee to never
-;;; return a VALUES type.
-(defun specifier-type (x)
- (let ((res (values-specifier-type x)))
- (when (values-type-p res)
- (error "VALUES type illegal in this context:~% ~S" x))
- res))
-
-;;; Similar to MACROEXPAND, but expands DEFTYPEs. We don't bother
-;;; returning a second value.
-(defun type-expand (form)
- (let ((def (cond ((symbolp form)
- (info :type :expander form))
- ((and (consp form) (symbolp (car form)))
- (info :type :expander (car form)))
- (t nil))))
- (if def
- (type-expand (funcall def (if (consp form) form (list form))))
- form)))
+;;;; representations of types
;;; A HAIRY-TYPE represents anything too weird to be described
;;; reasonably or to be useful, such as NOT, SATISFIES, unknown types,
;;; the original type spec.
(defstruct (hairy-type (:include ctype
(class-info (type-class-or-lose 'hairy))
- (enumerable t))
+ (enumerable t)
+ (might-contain-other-types-p t))
(:copier nil)
#!+cmu (:pure nil))
- ;; the Common Lisp type-specifier
+ ;; the Common Lisp type-specifier of the type we represent
(specifier nil :type t))
(!define-type-class hairy)
(defstruct (unknown-type (:include hairy-type)
(:copier nil)))
+(defstruct (negation-type (:include ctype
+ (class-info (type-class-or-lose 'negation))
+ ;; FIXME: is this right? It's
+ ;; what they had before, anyway
+ (enumerable t)
+ (might-contain-other-types-p t))
+ (:copier nil)
+ #!+cmu (:pure nil))
+ (type (missing-arg) :type ctype))
+
+(!define-type-class negation)
+
;;; ARGS-TYPE objects are used both to represent VALUES types and
;;; to represent FUNCTION types.
(defstruct (args-type (:include ctype)
;; Lists of the type for each required and optional argument.
(required nil :type list)
(optional nil :type list)
- ;; The type for the rest arg. NIL if there is no rest arg.
+ ;; The type for the rest arg. NIL if there is no &REST arg.
(rest nil :type (or ctype null))
- ;; True if keyword arguments are specified.
+ ;; true if &KEY arguments are specified
(keyp nil :type boolean)
- ;; List of key-info structures describing the keyword arguments.
+ ;; list of KEY-INFO structures describing the &KEY arguments
(keywords nil :type list)
- ;; True if other keywords are allowed.
+ ;; true if other &KEY arguments are allowed
(allowp nil :type boolean))
(defstruct (values-type
(:include args-type
(class-info (type-class-or-lose 'values)))
+ (:constructor %make-values-type)
(:copier nil)))
+(define-cached-synonym make-values-type)
(!define-type-class values)
-(defstruct (function-type
- (:include args-type
- (class-info (type-class-or-lose 'function))))
- ;; True if the arguments are unrestrictive, i.e. *.
+;;; (SPECIFIER-TYPE 'FUNCTION) and its subtypes
+(defstruct (fun-type (:include args-type
+ (class-info (type-class-or-lose 'function))))
+ ;; true if the arguments are unrestrictive, i.e. *
(wild-args nil :type boolean)
- ;; Type describing the return values. This is a values type
+ ;; type describing the return values. This is a values type
;; when multiple values were specified for the return.
- (returns (required-argument) :type ctype))
+ (returns (missing-arg) :type ctype))
-;;; The CONSTANT-TYPE structure represents a use of the
-;;; CONSTANT-ARGUMENT "type specifier", which is only meaningful in
-;;; function argument type specifiers used within the compiler. (It
-;;; represents something that the compiler knows to be a constant.)
+;;; The CONSTANT-TYPE structure represents a use of the CONSTANT-ARG
+;;; "type specifier", which is only meaningful in function argument
+;;; type specifiers used within the compiler. (It represents something
+;;; that the compiler knows to be a constant.)
(defstruct (constant-type
(:include ctype
(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))
+ (type (missing-arg) :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 * and NIL aren't
-;;; classes anyway, so it wouldn't make much sense to make them built-in
-;;; classes.
+;;; 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 * 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)))
(:copier nil))
(name nil :type symbol))
+;;; a list of all the float "formats" (i.e. internal representations;
+;;; nothing to do with #'FORMAT), in order of decreasing precision
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *float-formats*
+ '(long-float double-float single-float short-float)))
+
+;;; The type of a float format.
+(deftype float-format () `(member ,@*float-formats*))
+
;;; A NUMERIC-TYPE represents any numeric type, including things
;;; such as FIXNUM.
(defstruct (numeric-type (:include ctype
- (class-info (type-class-or-lose
- 'number)))
- #!+negative-zero-is-not-zero
- (:constructor %make-numeric-type))
- ;; The kind of numeric type we have. NIL if not specified (just NUMBER or
- ;; COMPLEX).
+ (class-info (type-class-or-lose 'number)))
+ (:constructor %make-numeric-type)
+ (:copier nil))
+ ;; the kind of numeric type we have, or NIL if not specified (just
+ ;; NUMBER or COMPLEX)
;;
;; KLUDGE: A slot named CLASS for a non-CLASS value is bad.
;; Especially when a CLASS value *is* stored in another slot (called
;; weird that comment above says "Numeric-Type is used to represent
;; all numeric types" but this slot doesn't allow COMPLEX as an
;; option.. how does this fall into "not specified" NIL case above?
- (class nil :type (member integer rational float nil))
- ;; Format for a float type. NIL if not specified or not a float. Formats
- ;; which don't exist in a given implementation don't appear here.
- (format nil :type (or float-format null))
- ;; Is this a complex numeric type? Null if unknown (only in NUMBER.)
+ ;; Perhaps someday we can switch to CLOS and make NUMERIC-TYPE
+ ;; be an abstract base class and INTEGER-TYPE, RATIONAL-TYPE, and
+ ;; whatnot be concrete subclasses..
+ (class nil :type (member integer rational float nil) :read-only t)
+ ;; "format" for a float type (i.e. type specifier for a CPU
+ ;; representation of floating point, e.g. 'SINGLE-FLOAT -- nothing
+ ;; to do with #'FORMAT), or NIL if not specified or not a float.
+ ;; Formats which don't exist in a given implementation don't appear
+ ;; here.
+ (format nil :type (or float-format null) :read-only t)
+ ;; Is this a complex numeric type? Null if unknown (only in NUMBER).
;;
;; 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))
+ (complexp :real :type (member :real :complex nil) :read-only t)
;; 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)))
+ ;; types never have exclusive bounds, i.e. they may have them on
+ ;; input, but they're canonicalized to inclusive bounds before we
+ ;; store them here.
+ (low nil :type (or number cons null) :read-only t)
+ (high nil :type (or number cons null) :read-only t))
+
+;;; Impose canonicalization rules for NUMERIC-TYPE. Note that in some
+;;; cases, despite the name, we return *EMPTY-TYPE* instead of a
+;;; NUMERIC-TYPE.
+(defun make-numeric-type (&key class format (complexp :real) low high
+ enumerable)
+ ;; if interval is empty
+ (if (and low
+ high
+ (if (or (consp low) (consp high)) ; if either bound is exclusive
+ (>= (type-bound-number low) (type-bound-number high))
+ (> low high)))
+ *empty-type*
+ (multiple-value-bind (canonical-low canonical-high)
+ (case class
+ (integer
+ ;; INTEGER types always have their LOW and HIGH bounds
+ ;; represented as inclusive, not exclusive values.
+ (values (if (consp low)
+ (1+ (type-bound-number low))
+ low)
+ (if (consp high)
+ (1- (type-bound-number high))
+ high)))
+ #!+negative-zero-is-not-zero
+ (float
+ ;; Canonicalize a low bound of (-0.0) to 0.0, and a high
+ ;; bound of (+0.0) to -0.0.
+ (values (if (and (consp low)
+ (floatp (car low))
+ (zerop (car low))
+ (minusp (float-sign (car low))))
+ (float 0.0 (car low))
+ low)
+ (if (and (consp high)
+ (floatp (car high))
+ (zerop (car high))
+ (plusp (float-sign (car high))))
+ (float -0.0 (car high))
+ high)))
+ (t
+ ;; no canonicalization necessary
+ (values low high)))
+ (%make-numeric-type :class class
+ :format format
+ :complexp complexp
+ :low canonical-low
+ :high canonical-high
+ :enumerable enumerable))))
-;;; The Array-Type is used to represent all array types, including
+(defun modified-numeric-type (base
+ &key
+ (class (numeric-type-class base))
+ (format (numeric-type-format base))
+ (complexp (numeric-type-complexp base))
+ (low (numeric-type-low base))
+ (high (numeric-type-high base))
+ (enumerable (numeric-type-enumerable base)))
+ (make-numeric-type :class class
+ :format format
+ :complexp complexp
+ :low low
+ :high high
+ :enumerable enumerable))
+
+;;; An ARRAY-TYPE is used to represent any array type, including
;;; things such as SIMPLE-STRING.
(defstruct (array-type (:include ctype
(class-info (type-class-or-lose 'array)))
+ (:constructor %make-array-type)
(:copier nil))
;; the dimensions of the array, or * if unspecified. If a dimension
;; is unspecified, it is *.
;; 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
- (element-type (required-argument) :type ctype)
+ (element-type (missing-arg) :type ctype)
;; the element type as it is specialized in this implementation
(specialized-element-type *wild-type* :type ctype))
+(define-cached-synonym make-array-type)
;;; A MEMBER-TYPE represent a use of the MEMBER type specifier. We
;;; bother with this at this level because MEMBER types are fairly
;; 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)
+;;; 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
+ (might-contain-other-types-p t))
(: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.
+;;; A UNION-TYPE represents a use of the OR type specifier which we
+;;; couldn't canonicalize to something simpler. Canonical form:
+;;; 1. All possible pairwise simplifications (using the UNION2 type
+;;; methods) have been performed. Thus e.g. there is never more
+;;; than one MEMBER-TYPE component. FIXME: As of sbcl-0.6.11.13,
+;;; this hadn't been fully implemented yet.
;;; 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))
(:copier nil)))
+(define-cached-synonym make-union-type)
;;; 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.
+;;; which we couldn't canonicalize to something simpler. Canonical form:
+;;; 1. All possible pairwise simplifications (using the INTERSECTION2
+;;; type methods) have been performed. Thus e.g. there is never more
+;;; than one MEMBER-TYPE component.
+;;; 2. There are never any INTERSECTION-TYPE components: we've
+;;; flattened everything into a single INTERSECTION-TYPE object.
+;;; 3. There are never any UNION-TYPE components. Either we should
+;;; use the distributive rule to rearrange things so that
+;;; unions contain intersections and not vice versa, or we
+;;; should just punt to using a HAIRY-TYPE.
(defstruct (intersection-type (:include compound-type
(class-info (type-class-or-lose
'intersection)))
type))
;;; A CONS-TYPE is used to represent a CONS type.
-(defstruct (cons-type (:include ctype
- (:class-info (type-class-or-lose 'cons)))
+(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
;; 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))
+ (car-type (missing-arg) :type ctype :read-only t)
+ (cdr-type (missing-arg) :type ctype :read-only t))
+\f
+;;;; type utilities
+
+;;; Return the type structure corresponding to a type specifier. We
+;;; pick off structure types as a special case.
+;;;
+;;; Note: VALUES-SPECIFIER-TYPE-CACHE-CLEAR must be called whenever a
+;;; type is defined (or redefined).
+(defun-cached (values-specifier-type
+ :hash-function (lambda (x)
+ (logand (sxhash x) #x3FF))
+ :hash-bits 10
+ :init-wrapper !cold-init-forms)
+ ((orig equal-but-no-car-recursion))
+ (let ((u (uncross orig)))
+ (or (info :type :builtin u)
+ (let ((spec (type-expand u)))
+ (cond
+ ((and (not (eq spec u))
+ (info :type :builtin spec)))
+ ((eq (info :type :kind spec) :instance)
+ (sb!xc:find-class spec))
+ ((typep spec 'class)
+ ;; There doesn't seem to be any way to translate
+ ;; (TYPEP SPEC 'BUILT-IN-CLASS) into something which can be
+ ;; executed on the host Common Lisp at cross-compilation time.
+ #+sb-xc-host (error
+ "stub: (TYPEP SPEC 'BUILT-IN-CLASS) on xc host")
+ (if (typep spec 'built-in-class)
+ (or (built-in-class-translation spec) spec)
+ spec))
+ (t
+ (let* (;; FIXME: This automatic promotion of FOO-style
+ ;; specs to (FOO)-style specs violates the ANSI
+ ;; standard. Unfortunately, we can't fix the
+ ;; problem just by removing it, since then things
+ ;; downstream should break. But at some point we
+ ;; should fix this and the things downstream too.
+ (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)))
+ (symbolp spec))
+ (when (and *type-system-initialized*
+ (not (eq (info :type :kind spec)
+ :forthcoming-defclass-type)))
+ (signal 'parse-unknown-type :specifier spec))
+ ;; (The RETURN-FROM here inhibits caching.)
+ (return-from values-specifier-type
+ (make-unknown-type :specifier spec)))
+ (t
+ (error "bad thing to be a type specifier: ~S"
+ spec))))))))))
+
+;;; This is like VALUES-SPECIFIER-TYPE, except that we guarantee to
+;;; never return a VALUES type.
+(defun specifier-type (x)
+ (let ((res (values-specifier-type x)))
+ (when (values-type-p res)
+ (error "VALUES type illegal in this context:~% ~S" x))
+ res))
+
+(defun single-value-specifier-type (x)
+ (let ((res (specifier-type x)))
+ (if (eq res *wild-type*)
+ *universal-type*
+ res)))
+
+;;; Similar to MACROEXPAND, but expands DEFTYPEs. We don't bother
+;;; returning a second value.
+(defun type-expand (form)
+ (let ((def (cond ((symbolp form)
+ (info :type :expander form))
+ ((and (consp form) (symbolp (car form)))
+ (info :type :expander (car form)))
+ (t nil))))
+ (if def
+ (type-expand (funcall def (if (consp form) form (list form))))
+ form)))
;;; Note that the type NAME has been (re)defined, updating the
;;; undefined warnings and VALUES-SPECIFIER-TYPE cache.
(when (boundp 'sb!kernel::*values-specifier-type-cache-vector*)
(values-specifier-type-cache-clear))
(values))
-
-;;; 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*
- x
- sb!vm:*target-most-positive-fixnum*)))
-
+\f
(!defun-from-collected-cold-init-forms !early-type-cold-init)
projects / sbcl.git / blobdiff