bootstrap on a system which uses a different value of CHAR-CODE-LIMIT
than SBCL does.
-91:
- (subtypep '(or (integer -1 1)
- unsigned-byte)
- '(or (rational -1 7)
- unsigned-byte
- (integer -1 1))) => NIL,T
- An analogous problem with SINGLE-FLOAT and REAL types was fixed in
- sbcl-0.6.11.22, but some peculiarites of the RATIO type make it
- awkward to generalize the fix to INTEGER and RATIONAL. It's not
- clear what's the best fix. (See the "bug in type handling" discussion
- on cmucl-imp ca. 2001-03-22 and ca. 2001-02-12.)
-
94a:
Inconsistencies between derived and declared VALUES return types for
DEFUN aren't checked very well. E.g. the logic which successfully
figured out how to reproduce).
155:
- Executing
- (defclass standard-gadget (basic-gadget) ())
- (defclass basic-gadget () ())
- gives an error:
- The slot SB-PCL::DIRECT-SUPERCLASSES is unbound in the
- object #<SB-PCL::STANDARD-CLASS "unbound">.
- (reported by Brian Spilsbury sbcl-devel 2002-04-09)
+ (fixed in sbcl-0.7.2.9)
156:
FUNCTION-LAMBDA-EXPRESSION doesn't work right in 0.7.0 or 0.7.2.9:
treated as a valid host by anything else in the system. (Reported by
Erik Naggum on comp.lang.lisp 2002-04-18)
+164:
+ The type system still can't quite deal with all useful identities;
+ for instance, as of sbcl-0.7.2.18, the type specifier '(and (real -1
+ 7) (real 4 8)) is a HAIRY-TYPE rather than that which would be hoped
+ for, viz: '(real 4 7).
+
+
DEFUNCT CATEGORIES OF BUGS
IR1-#:
These labels were used for bugs related to the old IR1 interpreter.
(declare (type ctype type1 type2))
(cond ((eq type1 type2)
type1)
+ ((csubtypep type1 type2) type2)
+ ((csubtypep type2 type1) type1)
((or (union-type-p type1)
(union-type-p type2))
;; Unions of UNION-TYPE should have the UNION-TYPE-TYPES
((type1 eq) (type2 eq))
(declare (type ctype type1 type2))
(cond ((eq type1 type2)
+ ;; FIXME: For some reason, this doesn't catch e.g. type1 =
+ ;; type2 = (SPECIFIER-TYPE
+ ;; 'SOME-UNKNOWN-TYPE). Investigate. - CSR, 2002-04-10
type1)
((or (intersection-type-p type1)
(intersection-type-p type2))
(values (or (eq type1 *empty-type*) (eq type2 *wild-type*)) t))
(!define-type-method (named :complex-subtypep-arg1) (type1 type2)
- (aver (not (eq type1 *wild-type*))) ; * isn't really a type.
+ ;; This AVER causes problems if we write accurate methods for the
+ ;; union (and possibly intersection) types which then delegate to
+ ;; us; while a user shouldn't get here, because of the odd status of
+ ;; *wild-type* a type-intersection executed by the compiler can. -
+ ;; CSR, 2002-04-10
+ ;;
+ ;; (aver (not (eq type1 *wild-type*))) ; * isn't really a type.
(cond ((eq type1 *empty-type*)
t)
(;; When TYPE2 might be the universal type in disguise
(values nil nil))
(t
;; By elimination, TYPE1 is the universal type.
- (aver (eq type1 *universal-type*))
+ (aver (or (eq type1 *wild-type*) (eq type1 *universal-type*)))
;; This case would have been picked off by the SIMPLE-SUBTYPEP
;; method, and so shouldn't appear here.
(aver (not (eq type2 *universal-type*)))
(!define-type-method (hairy :simple-intersection2 :complex-intersection2)
(type1 type2)
- (declare (ignore type1 type2))
- nil)
+ (if (type= type1 type2)
+ type1
+ nil))
(!define-type-method (hairy :simple-=) (type1 type2)
(if (equal (hairy-type-specifier type1)
'list
`(or ,@(mapcar #'type-specifier (union-type-types type)))))
+;;; Two union types are equal if they are each subtypes of each
+;;; other. We need to be this clever because our complex subtypep
+;;; methods are now more accurate; we don't get infinite recursion
+;;; because the simple-subtypep method delegates to complex-subtypep
+;;; of the individual types of type1. - CSR, 2002-04-09
+;;;
+;;; Previous comment, now obsolete, but worth keeping around because
+;;; it is true, though too strong a condition:
+;;;
;;; Two union types are equal if their subtypes are equal sets.
(!define-type-method (union :simple-=) (type1 type2)
- (type=-set (union-type-types type1)
- (union-type-types type2)))
+ (multiple-value-bind (subtype certain?)
+ (csubtypep type1 type2)
+ (if subtype
+ (csubtypep type2 type1)
+ ;; we might as well become as certain as possible.
+ (if certain?
+ (values nil t)
+ (multiple-value-bind (subtype certain?)
+ (csubtypep type2 type1)
+ (declare (ignore subtype))
+ (values nil certain?))))))
+
+(!define-type-method (union :complex-=) (type1 type2)
+ (if (some #'hairy-type-p (union-type-types type2))
+ (values nil nil)
+ (values nil t)))
;;; Similarly, a union type is a subtype of another if and only if
;;; every element of TYPE1 is a subtype of TYPE2.
-(!define-type-method (union :simple-subtypep) (type1 type2)
+(defun union-simple-subtypep (type1 type2)
(every/type (swapped-args-fun #'union-complex-subtypep-arg2)
type2
(union-type-types type1)))
+(!define-type-method (union :simple-subtypep) (type1 type2)
+ (union-simple-subtypep type1 type2))
+
(defun union-complex-subtypep-arg1 (type1 type2)
(every/type (swapped-args-fun #'csubtypep)
type2
(union-type-types type1)))
+
(!define-type-method (union :complex-subtypep-arg1) (type1 type2)
(union-complex-subtypep-arg1 type1 type2))
(defun union-complex-subtypep-arg2 (type1 type2)
- (multiple-value-bind (sub-value sub-certain?)
- (any/type #'csubtypep type1 (union-type-types type2))
+ (multiple-value-bind (sub-value sub-certain?)
+ ;; was: (any/type #'csubtypep type1 (union-type-types type2)),
+ ;; which turns out to be too restrictive, causing bug 91.
+ ;;
+ ;; the following reimplementation might look dodgy. It is
+ ;; dodgy. It depends on the union :complex-= method not doing
+ ;; very much work -- certainly, not using subtypep. Reasoning:
+ (progn
+ ;; At this stage, we know that type2 is a union type and type1
+ ;; isn't. We might as well check this, though:
+ (aver (union-type-p type2))
+ (aver (not (union-type-p type1)))
+ ;; A is a subset of (B1 u B2)
+ ;; <=> A n (B1 u B2) = A
+ ;; <=> (A n B1) u (A n B2) = A
+ ;;
+ ;; But, we have to be careful not to delegate this type= to
+ ;; something that could invoke subtypep, which might get us
+ ;; back here -> stack explosion. We therefore ensure that the
+ ;; second type (which is the one that's dispatched on) is
+ ;; either a union type (where we've ensured that the complex-=
+ ;; method will not call subtypep) or something with no union
+ ;; types involved, in which case we'll never come back here.
+ ;;
+ ;; If we don't do this, then e.g.
+ ;; (SUBTYPEP '(MEMBER 3) '(OR (SATISFIES FOO) (SATISFIES BAR)))
+ ;; would loop infinitely, as the member :complex-= method is
+ ;; implemented in terms of subtypep.
+ ;;
+ ;; Ouch. - CSR, 2002-04-10
+ (type= type1
+ (apply #'type-union
+ (mapcar (lambda (x) (type-intersection type1 x))
+ (union-type-types type2)))))
(if sub-certain?
(values sub-value sub-certain?)
;; The ANY/TYPE expression above is a sufficient condition for
;; certain answer by this CALL-NEXT-METHOD-ish step when the
;; ANY/TYPE expression is uncertain.
(invoke-complex-subtypep-arg1-method type1 type2))))
+
(!define-type-method (union :complex-subtypep-arg2) (type1 type2)
(union-complex-subtypep-arg2 type1 type2))
;; CSUBTYPEP, in order to avoid possibly invoking any methods which
;; might in turn invoke (TYPE-INTERSECTION2 TYPE1 TYPE2) and thus
;; cause infinite recursion.
- (cond ((union-complex-subtypep-arg2 type1 type2)
+ ;;
+ ;; Within this method, type2 is guaranteed to be a union type:
+ (aver (union-type-p type2))
+ ;; Make sure to call only the applicable methods...
+ (cond ((and (union-type-p type1)
+ (union-simple-subtypep type1 type2)) type1)
+ ((and (union-type-p type1)
+ (union-simple-subtypep type2 type1)) type2)
+ ((and (not (union-type-p type1))
+ (union-complex-subtypep-arg2 type1 type2))
type1)
- ((union-complex-subtypep-arg1 type2 type1)
+ ((and (not (union-type-p type1))
+ (union-complex-subtypep-arg1 type2 type1))
type2)
(t
;; KLUDGE: This code accumulates a sequence of TYPE-UNION2
(defmacro assert-t-t (expr)
`(assert (equal '(t t) (multiple-value-list ,expr))))
+(defmacro assert-t-t-or-uncertain (expr)
+ `(assert (let ((list (multiple-value-list ,expr)))
+ (or (equal '(nil nil) list)
+ (equal '(t t) list)))))
+
(let ((types '(character
integer fixnum (integer 0 10)
single-float (single-float -1.0 1.0) (single-float 0.1)
(real 4 8) (real -1 7) (real 2 11)
+ null symbol keyword
(member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3)
- ;; FIXME: When bug 91 is fixed, add these to the list:
- ;; (INTEGER -1 1)
- ;; UNSIGNED-BYTE
- ;; (RATIONAL -1 7) (RATIONAL -2 4)
- ;; RATIO
+ (integer -1 1)
+ unsigned-byte
+ (rational -1 7) (rational -2 4)
+ ratio
)))
(dolist (i types)
(format t "type I=~S~%" i)
;;; corresponding to the NIL type-specifier; we were bogusly returning
;;; NIL, T (indicating surety) for the following:
(assert-nil-nil (subtypep '(satisfies some-undefined-fun) 'nil))
+
+;;; It turns out that, as of sbcl-0.7.2, we require to be able to
+;;; detect this to compile src/compiler/node.lisp (and in particular,
+;;; the definition of the component structure). Since it's a sensible
+;;; thing to want anyway, let's test for it here:
+(assert-t-t (subtypep '(or some-undefined-type (member :no-ir2-yet :dead))
+ '(or some-undefined-type (member :no-ir2-yet :dead))))
\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