X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-type.lisp;h=102c8b5e8a7daee8d724e2b763136dbf78d17c32;hb=53dd919e3b97fe7a63b6826d812eef6bac0ca9ad;hp=08adf4daadfd9596803308412ac4ad3b1d1bf4b4;hpb=bb471853b088e65a3e7821b6ab23494c4fe67af3;p=sbcl.git

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 08adf4d..102c8b5 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -1167,7 +1167,7 @@
                   (values nil t))
                  ((eq type1 (find-classoid 'function))
                   (values nil t))
-                 ((or (basic-structure-classoid-p type1)
+                 ((or (structure-classoid-p type1)
                       #+nil
                       (condition-classoid-p type1))
                   (values t t))
@@ -1196,9 +1196,15 @@
      (if (classoid-p type1)
          (if (and (not (member type1 *non-instance-classoid-types*
                                :key #'find-classoid))
+                  (not (eq type1 (find-classoid 'function)))
                   (not (find (classoid-layout (find-classoid 'function))
                              (layout-inherits (classoid-layout type1)))))
-             type1
+             (if (or (structure-classoid-p type1)
+                     (and (not (eq type1 (find-classoid 'stream)))
+                          (not (find (classoid-layout (find-classoid 'stream))
+                                     (layout-inherits (classoid-layout type1))))))
+                 type1
+                 nil)
              *empty-type*)
          (if (type-might-contain-other-types-p type1)
              nil
@@ -1211,7 +1217,7 @@
                         (layout-inherits (classoid-layout type1))))
              type1
              (if (type= type1 (find-classoid 'function))
-                 type1
+                 type2
                  nil))
          (if (fun-type-p type1)
              nil
@@ -2118,7 +2124,8 @@ used for a COMPLEX component.~:@>"
                          nil))
                     (t
                      (if (<= most-negative-single-float cx most-positive-single-float)
-                         (coerce cx format)
+                         ;; FIXME: bug #389
+                         (coerce cx (or format 'single-float))
                          nil)))))
              (if (consp x) (list res) res)))))
       nil))
@@ -2245,23 +2252,25 @@ used for a COMPLEX component.~:@>"
       (array-type-element-type type)))
 
 (!define-type-method (array :simple-=) (type1 type2)
-  (if (or (unknown-type-p (array-type-element-type type1))
-          (unknown-type-p (array-type-element-type type2)))
-      (multiple-value-bind (equalp certainp)
-          (type= (array-type-element-type type1)
-                 (array-type-element-type type2))
-        ;; By its nature, the call to TYPE= should never return NIL,
-        ;; T, as we don't know what the UNKNOWN-TYPE will grow up to
-        ;; be.  -- CSR, 2002-08-19
-        (aver (not (and (not equalp) certainp)))
-        (values equalp certainp))
-      (values (and (equal (array-type-dimensions type1)
+  (cond ((not (and (equal (array-type-dimensions type1)
                           (array-type-dimensions type2))
                    (eq (array-type-complexp type1)
-                       (array-type-complexp type2))
-                   (type= (specialized-element-type-maybe type1)
-                          (specialized-element-type-maybe type2)))
-              t)))
+                       (array-type-complexp type2))))
+         (values nil t))
+        ((or (unknown-type-p (array-type-element-type type1))
+             (unknown-type-p (array-type-element-type type2)))
+         (multiple-value-bind (equalp certainp)
+             (type= (array-type-element-type type1)
+                    (array-type-element-type type2))
+           ;; By its nature, the call to TYPE= should never return
+           ;; NIL, T, as we don't know what the UNKNOWN-TYPE will grow
+           ;; up to be.  -- CSR, 2002-08-19
+           (aver (not (and (not equalp) certainp)))
+           (values equalp certainp)))
+        (t
+         (values (type= (specialized-element-type-maybe type1)
+                        (specialized-element-type-maybe type2))
+                 t))))
 
 (!define-type-method (array :negate) (type)
   ;; FIXME (and hint to PFD): we're vulnerable here to attacks of the
@@ -2333,12 +2342,15 @@ used for a COMPLEX component.~:@>"
           ;; if the TYPE2 element type is wild.
           ((eq (array-type-element-type type2) *wild-type*)
            (values t t))
-          (;; Since we didn't match any of the special cases above, we
-           ;; can't give a good answer unless both the element types
-           ;; have been defined.
+          (;; Since we didn't match any of the special cases above, if
+           ;; either element type is unknown we can only give a good
+           ;; answer if they are the same.
            (or (unknown-type-p (array-type-element-type type1))
                (unknown-type-p (array-type-element-type type2)))
-           (values nil nil))
+           (if (type= (array-type-element-type type1)
+                      (array-type-element-type type2))
+               (values t t)
+               (values nil nil)))
           (;; Otherwise, the subtype relationship holds iff the
            ;; types are equal, and they're equal iff the specialized
            ;; element types are identical.