0.7.1.28:

	merged the third (of 3) patches from CSR "x86, format, types"
		patches (sbcl-devel 2002-02-27)
	worried about the special case of (SPECIFIER-TYPE T), tried to
		protect the patched code from it

diff --git a/BUGS b/BUGS
index bdf4781..b0d7dae 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -337,9 +337,11 @@ WORKAROUND:
           blows up at the level of SPECIFIER-TYPE with
           "Lower bound (0) is greater than upper bound (0)." Probably
           SPECIFIER-TYPE should return the NIL type instead.
           blows up at the level of SPECIFIER-TYPE with
           "Lower bound (0) is greater than upper bound (0)." Probably
           SPECIFIER-TYPE should return the NIL type instead.

-       g: The type system isn't all that smart about relationships
-          between hairy types, as shown in the type.erg test results,
-          e.g. (SUBTYPEP 'CONS '(NOT ATOM)) => NIL, NIL.
+       g: The type system [still] isn't all that smart about relationships
+          between hairy types. [The original example from PVE was
+          (SUBTYPEP 'CONS '(NOT ATOM)) => NIL, NIL, which was fixed
+          by CSR in sbcl-0.7.1.28, but there are still
+           plenty of corner cases out there.]

 
 51:
   miscellaneous errors reported by Peter Van Eynde July 25, 2000:
 
 51:
   miscellaneous errors reported by Peter Van Eynde July 25, 2000:

@@ -1117,6 +1119,11 @@ WORKAROUND:
   T
   T
 
   T
   T
 

+  This is probably due to underzealous clearing of the type caches; a
+  brute-force solution in that case would be to make a defclass expand
+  into something that included a call to SB-KERNEL::CLEAR-TYPE-CACHES,
+  but there may be a better solution.
+

 141: 
   Pretty-printing nested backquotes doesn't work right, as 
   reported by Alexey Dejneka sbcl-devel 2002-01-13:
 141: 
   Pretty-printing nested backquotes doesn't work right, as 
   reported by Alexey Dejneka sbcl-devel 2002-01-13:

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index c909e8d..6ffd5c9 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -976,7 +976,75 @@
          (t
           (values nil nil)))))
 
          (t
           (values nil nil)))))
 

-(!define-type-method (hairy :complex-subtypep-arg1 :complex-=) (type1 type2)
+(!define-type-method (hairy :complex-subtypep-arg1) (type1 type2)
+  (let ((hairy-spec (hairy-type-specifier type1)))
+     (cond ((and (consp hairy-spec) (eq (car hairy-spec) 'not))
+           ;; You may not believe this. I couldn't either. But then I
+           ;; sat down and drew lots of Venn diagrams. Comments
+           ;; involving a and b refer to the call (subtypep '(not a)
+           ;; 'b) -- CSR, 2002-02-27.
+           (block nil
+             ;; (Several logical truths in this block are true as
+             ;; long as b/=T. As of sbcl-0.7.1.28, it seems
+             ;; impossible to construct a case with b=T where we
+             ;; actually reach this type method, but we'll test for
+             ;; and exclude this case anyway, since future
+             ;; maintenance might make it possible for it to end up
+             ;; in this code.)
+             (multiple-value-bind (equal certain)
+                 (type= type2 (specifier-type t))
+               (unless certain
+                 (return (values nil nil)))
+               (when equal
+                 (return (values t t))))
+             (let ((complement-type1 (specifier-type (cadr hairy-spec))))
+               ;; Do the special cases first, in order to give us a
+               ;; chance if subtype/supertype relationships are hairy.
+               (multiple-value-bind (equal certain) 
+                   (type= complement-type1 type2)
+                 ;; If a = b, ~a is not a subtype of b (unless b=T,
+                 ;; which was excluded above).
+                 (unless certain
+                   (return (values nil nil)))
+                 (when equal
+                   (return (values nil t))))
+               ;; This (TYPE= TYPE1 TYPE2) branch would never be
+               ;; taken, as type1 and type2 will only be equal if
+               ;; they're both NOT types, and then the
+               ;; :SIMPLE-SUBTYPEP method would be used instead.
+               ;; ((type= type1 type2) (values t t))
+               (multiple-value-bind (equal certain)
+                   (csubtypep complement-type1 type2)
+                 ;; If a is a subtype of b, ~a is not a subtype of b
+                 ;; (unless b=T, which was excluded above).
+                 (unless certain
+                   (return (values nil nil)))
+                 (when equal
+                   (return (values nil t))))
+               (multiple-value-bind (equal certain)
+                   (csubtypep type2 complement-type1)
+                 ;; If b is a subtype of a, ~a is not a subtype of b.
+                 ;; (FIXME: That's not true if a=T. Do we know at
+                 ;; this point that a is not T?)
+                 (unless certain
+                   (return (values nil nil)))
+                 (when equal
+                   (return (values nil t))))
+               ;; Other cases here would rely on being able to catch
+               ;; all possible cases, which the fragility of this
+               ;; type system doesn't inspire me; for instance, if a
+               ;; is type= to ~b, then we want T, T; if this is not
+               ;; the case and the types are disjoint (have an
+               ;; intersection of *empty-type*) then we want NIL, T;
+               ;; else if the union of a and b is the
+               ;; *universal-type* then we want T, T. So currently we
+               ;; still claim to be unsure about e.g. (subtypep '(not
+               ;; fixnum) 'single-float).
+               )))
+          (t
+           (values nil nil)))))
+
+(!define-type-method (hairy :complex-=) (type1 type2)

   (declare (ignore type1 type2))
   (values nil nil))
 
   (declare (ignore type1 type2))
   (values nil nil))
 

@@ -996,9 +1064,11 @@
   ;; Check legality of arguments.
   (destructuring-bind (not typespec) whole
     (declare (ignore not))
   ;; Check legality of arguments.
   (destructuring-bind (not typespec) whole
     (declare (ignore not))

-    (specifier-type typespec)) ; must be legal typespec
-  ;; Create object.
-  (make-hairy-type :specifier whole))
+    (let ((spec (type-specifier (specifier-type typespec)))) ; must be legal typespec
+      (if (and (listp spec) (eq (car spec) 'not))
+         ;; canonicalize (not (not foo))
+         (specifier-type (cadr spec))
+         (make-hairy-type :specifier whole)))))

 
 (!def-type-translator satisfies (&whole whole fun)
   (declare (ignore fun))
 
 (!def-type-translator satisfies (&whole whole fun)
   (declare (ignore fun))

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 3b6a76b..19e24e0 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -101,6 +101,36 @@
 (assert (not (subtypep 'symbol 'keyword)))
 (assert (subtypep 'ratio 'real))
 (assert (subtypep 'ratio 'number))
 (assert (not (subtypep 'symbol 'keyword)))
 (assert (subtypep 'ratio 'real))
 (assert (subtypep 'ratio 'number))

+
+;;; bug 50.g: Smarten up hairy type specifiers slightly. We may wish
+;;; to revisit this, perhaps by implementing a COMPLEMENT type
+;;; (analogous to UNION and INTERSECTION) to take the logic out of the
+;;; HAIRY domain.
+(assert-nil-t (subtypep 'atom 'cons))
+(assert-nil-t (subtypep 'cons 'atom))
+(assert-nil-t (subtypep '(not list) 'cons))
+(assert-nil-t (subtypep '(not float) 'single-float))
+(assert-t-t (subtypep '(not atom) 'cons))
+(assert-t-t (subtypep 'cons '(not atom)))
+;;; FIXME: Another thing to revisit is %INVOKE-TYPE-METHOD.
+;;; Essentially, the problem is that when the two arguments to
+;;; subtypep are of different specifier-type types (e.g. HAIRY and
+;;; UNION), there are two applicable type methods -- in this case
+;;; HAIRY-COMPLEX-SUBTYPEP-ARG1-TYPE-METHOD and
+;;; UNION-COMPLEX-SUBTYPEP-ARG2-TYPE-METHOD.  Both of these exist, but
+;;; [!%]INVOKE-TYPE-METHOD aren't smart enough to know that if one of
+;;; them returns NIL, NIL (indicating uncertainty) it should try the
+;;; other; this is complicated by the presence of other TYPE-METHODS
+;;; (e.g. INTERSECTION and UNION) whose return convention may or may
+;;; not follow the same standard.
+#||
+(assert-nil-t (subtypep '(not cons) 'list))
+(assert-nil-t (subtypep '(not single-float) 'float))
+||#
+;;; If we fix the above FIXME, we should for free have fixed bug 58.
+#||
+(assert-t-t (subtypep '(and zilch integer) 'zilch))
+||#

 \f
 ;;;; Douglas Thomas Crosher rewrote the CMU CL type test system to
 ;;;; allow inline type tests for CONDITIONs and STANDARD-OBJECTs, and
 \f
 ;;;; Douglas Thomas Crosher rewrote the CMU CL type test system to
 ;;;; allow inline type tests for CONDITIONs and STANDARD-OBJECTs, and

diff --git a/version.lisp-expr b/version.lisp-expr
index 0a08b94..60879d7 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 

-"0.7.1.27"
+"0.7.1.28"