0.8.3.8:

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

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index e0b7317..da4f37f 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -627,28 +627,28 @@
 
 (defun-cached (values-type-intersection :hash-function type-cache-hash
                                        :hash-bits 8
-                                       :values 2
-                                       :default (values nil :empty)
+                                       :default (values nil)
                                        :init-wrapper !cold-init-forms)
     ((type1 eq) (type2 eq))
   (declare (type ctype type1 type2))
-  (cond ((eq type1 *wild-type*) (values (coerce-to-values type2) t))
+  (cond ((eq type1 *wild-type*)
+         (coerce-to-values type2))
         ((or (eq type2 *wild-type*) (eq type2 *universal-type*))
-         (values type1 t))
+         type1)
         ((or (eq type1 *empty-type*) (eq type2 *empty-type*))
          *empty-type*)
         ((and (not (values-type-p type2))
               (values-type-required type1))
          (let ((req1 (values-type-required type1)))
-         (make-values-type :required (cons (type-intersection (first req1) type2)
-                                           (rest req1))
-                           :optional (values-type-optional type1)
-                           :rest (values-type-rest type1)
-                           :allowp (values-type-allowp type1))))
+           (make-values-type :required (cons (type-intersection (first req1) type2)
+                                             (rest req1))
+                             :optional (values-type-optional type1)
+                             :rest (values-type-rest type1)
+                             :allowp (values-type-allowp type1))))
         (t
-         (values-type-op type1 (coerce-to-values type2)
-                         #'type-intersection
-                         #'max))))
+         (values (values-type-op type1 (coerce-to-values type2)
+                                 #'type-intersection
+                                 #'max)))))
 
 ;;; This is like TYPES-EQUAL-OR-INTERSECT, except that it sort of
 ;;; works on VALUES types. Note that due to the semantics of
@@ -660,9 +660,9 @@
         ((or (eq type1 *wild-type*) (eq type2 *wild-type*))
          (values t t))
        (t
-        (multiple-value-bind (res win) (values-type-intersection type1 type2)
+        (let ((res (values-type-intersection type1 type2)))
           (values (not (eq res *empty-type*))
-                  win)))))
+                  t)))))
 
 ;;; a SUBTYPEP-like operation that can be used on any types, including
 ;;; VALUES types
@@ -1503,11 +1503,15 @@
 
 (!define-type-class number)
 
+(declaim (inline numeric-type-equal))
+(defun numeric-type-equal (type1 type2)
+  (and (eq (numeric-type-class type1) (numeric-type-class type2))
+       (eq (numeric-type-format type1) (numeric-type-format type2))
+       (eq (numeric-type-complexp type1) (numeric-type-complexp type2))))
+
 (!define-type-method (number :simple-=) (type1 type2)
   (values
-   (and (eq (numeric-type-class type1) (numeric-type-class type2))
-       (eq (numeric-type-format type1) (numeric-type-format type2))
-       (eq (numeric-type-complexp type1) (numeric-type-complexp type2))
+   (and (numeric-type-equal type1 type2)
        (equalp (numeric-type-low type1) (numeric-type-low type2))
        (equalp (numeric-type-high type1) (numeric-type-high type2)))
    t))