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:
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:
(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))
;; 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))
(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
projects / sbcl.git / commitdiff