0.9.16.30:

[sbcl.git] / src / compiler / generic / primtype.lisp

diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index 1232ca1..e3e59b2 100644 (file)
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -313,19 +313,33 @@
                              (return (any)))))))))))
         (intersection-type
          (let ((types (intersection-type-types type))
-               (res (any))
-               (exact nil))
-           (dolist (type types (values res exact))
-             (multiple-value-bind (ptype ptype-exact)
+               (res (any)))
+           ;; why NIL for the exact?  Well, we assume that the
+           ;; intersection type is in fact doing something for us:
+           ;; that is, that each of the types in the intersection is
+           ;; in fact cutting off some of the type lattice.  Since no
+           ;; intersection type is represented by a primitive type and
+           ;; primitive types are mutually exclusive, it follows that
+           ;; no intersection type can represent the entirety of the
+           ;; primitive type.  (And NIL is the conservative answer,
+           ;; anyway).  -- CSR, 2006-09-14
+           (dolist (type types (values res nil))
+             (multiple-value-bind (ptype)
                  (primitive-type type)
-               (when ptype-exact
-                 (aver (or (not exact) (eq ptype res)))
-                 (setq exact t))
-               (when (or ptype-exact (and (not exact) (eq res (any))))
-                 ;; Try to find a narrower representation then
-                 ;; (any). Takes care of undecidable types in
-                 ;; intersections with decidable ones.
-                 (setq res ptype))))))
+               (cond
+                 ;; if the result so far is (any), any improvement on
+                 ;; the specificity of the primitive type is valid.
+                 ((eq res (any))
+                  (setq res ptype))
+                 ;; if the primitive type returned is (any), the
+                 ;; result so far is valid.  Likewise, if the
+                 ;; primitive type is the same as the result so far,
+                 ;; everything is fine.
+                 ((or (eq ptype (any)) (eq ptype res)))
+                 ;; otherwise, we have something hairy and confusing,
+                 ;; such as (and condition funcallable-instance).
+                 ;; Punt.
+                 (t (return (any))))))))
         (member-type
          (let* ((members (member-type-members type))
                 (res (primitive-type-of (first members))))