0.9.3.37:

	Fix a pair of bugs relating to cons types, noted by Brian
	Mastenbrook (chandler on #lisp) in paste
	http://paste.lisp.org/display/10664
	... named :complex-=/:complex-subtypep needs to realise that
		CONS types can be *EMPTY-TYPE* (but no other type)
		in disguise;
	... cons :simple-subtypep was just plain wrong when computing
		its certainty value.

diff --git a/NEWS b/NEWS
index 8a32718..742056c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -22,6 +22,8 @@ changes in sbcl-0.9.4 relative to sbcl-0.9.3:
     regular LAMBDA.
   * bug fix: PARSE-INTEGER no longer depends on the whitespaceness of
     characters in the current readtable.  (reported by Nicholas Neuss)
+  * bug fix: SUBTYPEP on various CONS types returns more a more
+    accurate acknowledgment of its certainty.
   * optimizations: REMOVE-DUPLICATES now runs in linear time on
     lists in some cases.  This partially fixes bug 384.
   * flush all standard streams before prompting in the REPL and the

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 1f0f2a7..6ec1446 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -1057,15 +1057,35 @@
   ;;(aver (not (eq type1 *wild-type*))) ; * isn't really a type.
   (values (eq type1 type2) t))
 
+(defun cons-type-might-be-empty-type (type)
+  (declare (type cons-type type))
+  (let ((car-type (cons-type-car-type type))
+        (cdr-type (cons-type-cdr-type type)))
+    (or
+     (if (cons-type-p car-type)
+         (cons-type-might-be-empty-type car-type)
+         (multiple-value-bind (yes surep)
+             (type= car-type *empty-type*)
+           (aver (not yes))
+           (not surep)))
+     (if (cons-type-p cdr-type)
+         (cons-type-might-be-empty-type cdr-type)
+         (multiple-value-bind (yes surep)
+             (type= cdr-type *empty-type*)
+           (aver (not yes))
+           (not surep))))))
+
 (!define-type-method (named :complex-=) (type1 type2)
   (cond
     ((and (eq type2 *empty-type*)
-          (intersection-type-p type1)
-          ;; not allowed to be unsure on these... FIXME: keep the list
-          ;; of CL types that are intersection types once and only
-          ;; once.
-          (not (or (type= type1 (specifier-type 'ratio))
-                   (type= type1 (specifier-type 'keyword)))))
+          (or (and (intersection-type-p type1)
+                   ;; not allowed to be unsure on these... FIXME: keep
+                   ;; the list of CL types that are intersection types
+                   ;; once and only once.
+                   (not (or (type= type1 (specifier-type 'ratio))
+                            (type= type1 (specifier-type 'keyword)))))
+              (and (cons-type-p type1)
+                   (cons-type-might-be-empty-type type1))))
      ;; things like (AND (EQL 0) (SATISFIES ODDP)) or (AND FUNCTION
      ;; STREAM) can get here.  In general, we can't really tell
      ;; whether these are equal to NIL or not, so
@@ -1116,7 +1136,9 @@
   (aver (not (eq type2 *wild-type*))) ; * isn't really a type.
   (cond ((eq type2 *universal-type*)
          (values t t))
-        ((type-might-contain-other-types-p type1)
+        ((or (type-might-contain-other-types-p type1)
+             (and (cons-type-p type1)
+                  (cons-type-might-be-empty-type type1)))
          ;; those types can be *EMPTY-TYPE* or *UNIVERSAL-TYPE* in
          ;; disguise.  So we'd better delegate.
          (invoke-complex-subtypep-arg1-method type1 type2))
@@ -2845,7 +2867,8 @@
         (csubtypep (cons-type-cdr-type type1) (cons-type-cdr-type type2))
       (if (and val-car val-cdr)
           (values t (and win-car win-cdr))
-          (values nil (or win-car win-cdr))))))
+          (values nil (or (and (not val-car) win-car)
+                          (and (not val-cdr) win-cdr)))))))
 
 ;;; Give up if a precise type is not possible, to avoid returning
 ;;; overly general types.

diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp
index 5e4b98d..3bddb5b 100644 (file)
--- a/tests/type.pure.lisp
+++ b/tests/type.pure.lisp
@@ -266,3 +266,26 @@
 ACTUAL ~D DERIVED ~D~%"
                                               op a b c d minimize brute derived)
                                       (assert (= brute derived)))))))))))))
+
+;;; subtypep on CONS types wasn't taking account of the fact that a
+;;; CONS type could be the empty type (but no other non-CONS type) in
+;;; disguise.
+(multiple-value-bind (yes win)
+    (subtypep '(and function stream) 'nil)
+  (multiple-value-bind (cyes cwin)
+      (subtypep '(cons (and function stream) t)
+                '(cons nil t))
+    (assert (eq yes cyes))
+    (assert (eq win cwin))))
+
+;;; CONS type subtypep could be too enthusiastic about thinking it was
+;;; certain
+(multiple-value-bind (yes win)
+    (subtypep '(satisfies foo) '(satisfies bar))
+  (assert (null yes))
+  (assert (null win))
+  (multiple-value-bind (cyes cwin)
+      (subtypep '(cons (satisfies foo) t)
+                '(cons (satisfies bar) t))
+    (assert (null cyes))
+    (assert (null cwin))))

diff --git a/version.lisp-expr b/version.lisp-expr
index b30a6b6..15fc5fb 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.9.3.36"
+"0.9.3.37"