(defstruct (unknown-type (:include hairy-type)
(:copier nil)))
+(defun maybe-reparse-specifier (type)
+ (when (unknown-type-p type)
+ (let* ((spec (unknown-type-specifier type))
+ (name (if (consp spec)
+ (car spec)
+ spec)))
+ (when (info :type :kind name)
+ (let ((new-type (specifier-type spec)))
+ (unless (unknown-type-p new-type)
+ new-type))))))
+
+;;; Evil macro.
+(defmacro maybe-reparse-specifier! (type)
+ (assert (symbolp type))
+ (with-unique-names (new-type)
+ `(let ((,new-type (maybe-reparse-specifier ,type)))
+ (when ,new-type
+ (setf ,type ,new-type)
+ t))))
+
(defstruct (negation-type (:include ctype
(class-info (type-class-or-lose 'negation))
;; FIXME: is this right? It's
(:include args-type
(class-info (type-class-or-lose 'values)))
(:constructor %make-values-type)
+ (:predicate %values-type-p)
(:copier nil)))
+(declaim (inline value-type-p))
+(defun values-type-p (x)
+ (or (eq x *wild-type*)
+ (%values-type-p x)))
+
(defun-cached (make-values-type-cached
:hash-bits 8
- :hash-function (lambda (req opt rest allowp)
- (logand (logxor
- (type-list-cache-hash req)
- (type-list-cache-hash opt)
- (if rest
- (type-hash-value rest)
- 42)
- (sxhash allowp))
- #xFF)))
+ :hash-function
+ (lambda (req opt rest allowp)
+ (logand (logxor
+ (type-list-cache-hash req)
+ (type-list-cache-hash opt)
+ (if rest
+ (type-hash-value rest)
+ 42)
+ ;; Results (logand #xFF (sxhash t/nil))
+ ;; hardcoded to avoid relying on the xc host.
+ (if allowp
+ 194
+ 11))
+ #xFF)))
((required equal-but-no-car-recursion)
(optional equal-but-no-car-recursion)
(rest eq)
(t (values min :maybe))))
()))
+;;; A SIMD-PACK-TYPE is used to represent a SIMD-PACK type.
+#!+sb-simd-pack
+(defstruct (simd-pack-type
+ (:include ctype (class-info (type-class-or-lose 'simd-pack)))
+ (:constructor %make-simd-pack-type (element-type))
+ (:copier nil))
+ (element-type (missing-arg)
+ :type (cons #||(member #.*simd-pack-element-types*) ||#)
+ :read-only t))
+
+#!+sb-simd-pack
+(defun make-simd-pack-type (element-type)
+ (aver (neq element-type *wild-type*))
+ (if (eq element-type *empty-type*)
+ *empty-type*
+ (%make-simd-pack-type
+ (dolist (pack-type *simd-pack-element-types*
+ (error "~S element type must be a subtype of ~
+ ~{~S~#[~;, or ~:;, ~]~}."
+ 'simd-pack *simd-pack-element-types*))
+ (when (csubtypep element-type (specifier-type pack-type))
+ (return (list pack-type)))))))
+
\f
;;;; type utilities
(cond
((and (not (eq spec u))
(info :type :builtin spec)))
+ ((and (consp spec) (symbolp (car spec))
+ (info :type :builtin (car spec))
+ (let ((expander (info :type :expander (car spec))))
+ (and expander (values-specifier-type (funcall expander spec))))))
((eq (info :type :kind spec) :instance)
(find-classoid spec))
((typep spec 'classoid)
"Takes and expands a type specifier once like MACROEXPAND-1.
Returns two values: the expansion, and a boolean that is true when
expansion happened."
- (declare (type-specifier type-specifier))
+ (declare (type type-specifier type-specifier))
(declare (ignore env))
(multiple-value-bind (expander lspec)
(let ((spec type-specifier))
(values nil nil))
((symbolp spec)
(values (info :type :expander spec) (list spec)))
+ ((and (consp spec) (symbolp (car spec)) (info :type :builtin (car spec)))
+ ;; see above
+ (values nil nil))
((and (consp spec) (symbolp (car spec)))
(values (info :type :expander (car spec)) spec))
(t nil)))
"Takes and expands a type specifier repeatedly like MACROEXPAND.
Returns two values: the expansion, and a boolean that is true when
expansion happened."
- (declare (type-specifier type-specifier))
+ (declare (type type-specifier type-specifier))
(multiple-value-bind (expansion flag)
(typexpand-1 type-specifier env)
(if flag
(defun typexpand-all (type-specifier &optional env)
#!+sb-doc
"Takes and expands a type specifier recursively like MACROEXPAND-ALL."
- (declare (type-specifier type-specifier))
+ (declare (type type-specifier type-specifier))
(declare (ignore env))
;; I first thought this would not be a good implementation because
;; it signals an error on e.g. (CONS 1 2) until I realized that
(defun %note-type-defined (name)
(declare (symbol name))
(note-name-defined name :type)
- (when (boundp 'sb!kernel::*values-specifier-type-cache-vector*)
- (values-specifier-type-cache-clear))
+ (values-specifier-type-cache-clear)
(values))
\f