X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-type.lisp;h=20f164293f76c8182e73159d6ac39784800e79b1;hb=cd1b14acf6f548b28b8a14e554d779f0473122ec;hp=ec513da4c6f09e9e9b1fd8e7241c8ace44b43162;hpb=4084b6b95c1d5e0a45e073a9b875d8471efd8505;p=sbcl.git

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index ec513da..20f1642 100644
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -134,8 +134,14 @@
             (: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)
@@ -527,6 +533,29 @@
          (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)))))))
+
 
 ;;;; type utilities
 
@@ -547,6 +576,10 @@
           (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)
@@ -615,6 +648,9 @@ expansion happened."
                (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)))