prettier backtraces

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

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index a4160a2..1b395f1 100644 (file)
--- 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)
@@ -547,6 +553,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 +625,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)))
@@ -698,8 +711,7 @@ Experimental."
 (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