0.8.6.19:

	Fix for CONS.SUBTYPEP.xx from PFD's test suite
	... more work in the CONS union method.

	                      ALERT ALERT ALERT

	this change reportedly makes PFD's random tester crawl, slowing it
	by a factor of 15 on input terms (type specifiers) of size 50.
	Options include
	  * ignoring this;
	  * having a cutoff in time or complexity beyond which we return
	    NIL, NIL;
	  * optimizing (NOT <cons>) some more;
	  * ...
	but at least it's slightly more correct now.

diff --git a/NEWS b/NEWS
index 239beb5..1f832e6 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2208,6 +2208,9 @@ changes in sbcl-0.8.7 relative to sbcl-0.8.6:
     ** the value of the :REHASH-THRESHOLD argument to MAKE-HASH-TABLE
        is ignored if it is too small, rather than propagating through
        to cause DIVIDE-BY-ZERO or FLOATING-POINT-OVERFLOW errors.
+    ** extremely complex negations of CONS types were not being
+       sufficiently canonicalized, leading to inconsistencies in
+       SUBTYPEP.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 930ea76..c1a29d9 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2778,15 +2778,20 @@
   (let ((car-type1 (cons-type-car-type type1))
        (car-type2 (cons-type-car-type type2))
        (cdr-type1 (cons-type-cdr-type type1))
-       (cdr-type2 (cons-type-cdr-type type2)))
+       (cdr-type2 (cons-type-cdr-type type2))
+       car-not1
+       car-not2)
     ;; UGH.  -- CSR, 2003-02-24
-    (macrolet ((frob-car (car1 car2 cdr1 cdr2)
+    (macrolet ((frob-car (car1 car2 cdr1 cdr2
+                         &optional (not1 nil not1p))
                 `(type-union
                   (make-cons-type ,car1 (type-union ,cdr1 ,cdr2))
                   (make-cons-type
                    (type-intersection ,car2
-                    (specifier-type
-                     `(not ,(type-specifier ,car1))))
+                    ,(if not1p
+                         not1
+                         `(specifier-type
+                           `(not ,(type-specifier ,car1)))))
                    ,cdr2))))
       (cond ((type= car-type1 car-type2)
             (make-cons-type car-type1
@@ -2798,6 +2803,17 @@
             (frob-car car-type1 car-type2 cdr-type1 cdr-type2))
            ((csubtypep car-type2 car-type1)
             (frob-car car-type2 car-type1 cdr-type2 cdr-type1))
+           ;; more general case of the above, but harder to compute
+           ((progn
+              (setf car-not1 (specifier-type
+                              `(not ,(type-specifier car-type1))))
+              (not (csubtypep car-type2 car-not1)))
+            (frob-car car-type1 car-type2 cdr-type1 cdr-type2 car-not1))
+           ((progn
+              (setf car-not2 (specifier-type
+                              `(not ,(type-specifier car-type2))))
+              (not (csubtypep car-type1 car-not2)))
+            (frob-car car-type2 car-type1 cdr-type2 cdr-type1 car-not2))
            ;; Don't put these in -- consider the effect of taking the
            ;; union of (CONS (INTEGER 0 2) (INTEGER 5 7)) and
            ;; (CONS (INTEGER 0 3) (INTEGER 5 6)).

diff --git a/version.lisp-expr b/version.lisp-expr
index 07e6d61..4c8bcc8 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.6.18"
+"0.8.6.19"