Optimize MAKE-ARRAY on unknown element-type.

[sbcl.git] / src / code / early-type.lisp

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index 5b761c0..f3db7a3 100644 (file)
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -134,19 +134,30 @@
             (: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)
@@ -527,6 +538,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)))))))
+
 \f
 ;;;; type utilities
 
@@ -561,10 +595,9 @@
             (when (and (atom spec)
                        (member spec '(and or not member eql satisfies values)))
               (error "The symbol ~S is not valid as a type specifier." spec))
-            (let* ((lspec (if (atom spec) (list spec) spec))
-                   (fun (info :type :translator (car lspec))))
+            (let ((fun (info :type :translator (if (consp spec) (car spec) spec))))
               (cond (fun
-                     (funcall fun lspec))
+                     (funcall fun (if (atom spec) (list spec) spec)))
                     ((or (and (consp spec) (symbolp (car spec))
                               (not (info :type :builtin (car spec))))
                          (and (symbolp spec) (not (info :type :builtin spec))))
@@ -618,7 +651,7 @@ expansion happened."
                ;; b) so (EQUAL (TYPEXPAND 'STRING) (TYPEXPAND-ALL 'STRING))
                (values nil nil))
               ((symbolp spec)
-               (values (info :type :expander spec) (list spec)))
+               (values (info :type :expander spec) spec))
               ((and (consp spec) (symbolp (car spec)) (info :type :builtin (car spec)))
                ;; see above
                (values nil nil))
@@ -626,7 +659,10 @@ expansion happened."
                (values (info :type :expander (car spec)) spec))
               (t nil)))
     (if expander
-        (values (funcall expander lspec) t)
+        (values (funcall expander (if (symbolp lspec)
+                                      (list lspec)
+                                      lspec))
+                t)
         (values type-specifier nil))))
 
 (defun typexpand (type-specifier &optional env)