From 0eafb8764315871b03a457e2ff61bd3ec7a05a31 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 2 Mar 2002 15:51:23 +0000 Subject: [PATCH] 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 --- BUGS | 13 ++++++-- src/code/late-type.lisp | 78 ++++++++++++++++++++++++++++++++++++++++++++--- tests/type.impure.lisp | 30 ++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 115 insertions(+), 8 deletions(-) diff --git a/BUGS b/BUGS index bdf4781..b0d7dae 100644 --- 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. - 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: @@ -1117,6 +1119,11 @@ WORKAROUND: 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: diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index c909e8d..6ffd5c9 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -976,7 +976,75 @@ (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)) @@ -996,9 +1064,11 @@ ;; 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)) diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp index 3b6a76b..19e24e0 100644 --- 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)) + +;;; 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)) +||# ;;;; 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 --- 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".) -"0.7.1.27" +"0.7.1.28" -- 1.7.10.4