X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-type.lisp;h=d1eaa9e40be7acb7ea798c3d04e8b0215bdb0ad0;hb=65aa68a4f6a671db80596f136dec549322b28ddd;hp=56c8c7902219ff1bf7c6dd70e30e4aba86d7eb4c;hpb=9ca5f2d431133c37793fff74e1ecbd229574222d;p=sbcl.git

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 56c8c79..d1eaa9e 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -432,8 +432,9 @@
       1
       (values-type-max-value-count type)))
 
+;;; VALUES type with a single value.
 (defun type-single-value-p (type)
-  (and (values-type-p type)
+  (and (%values-type-p type)
        (not (values-type-rest type))
        (null (values-type-optional type))
        (singleton-p (values-type-required type))))
@@ -1731,7 +1732,7 @@
              (eql low high)
              (eql (numeric-type-complexp type) :real)
              (member (numeric-type-class type) '(integer rational
-                                                 #!-sb-xc-host float)))
+                                                 #-sb-xc-host float)))
         (values t (numeric-type-low type))
         (values nil nil))))
 
@@ -2903,11 +2904,12 @@ used for a COMPLEX component.~:@>"
                           :high (if (null (numeric-type-high type1))
                                     nil
                                     (list (1+ (numeric-type-high type1)))))))
-         (type-union type1
-                     (apply #'type-intersection
-                            (remove (specifier-type '(not integer))
-                                    (intersection-type-types type2)
-                                    :test #'type=))))
+         (let* ((intersected (intersection-type-types type2))
+                (remaining   (remove (specifier-type '(not integer))
+                                     intersected
+                                     :test #'type=)))
+           (and (not (equal intersected remaining))
+                (type-union type1 (apply #'type-intersection remaining)))))
         (t
          (let ((accumulator *universal-type*))
            (do ((t2s (intersection-type-types type2) (cdr t2s)))