This is probably the same bug as 162
-217: "Bad type operations with FUNCTION types"
- In sbcl.0.7.7:
-
- * (values-type-union (specifier-type '(function (base-char)))
- (specifier-type '(function (integer))))
-
- #<FUN-TYPE (FUNCTION (BASE-CHAR) *)>
-
- It causes insertion of wrong type assertions into generated
- code. E.g.
-
- (defun foo (x s)
- (let ((f (etypecase x
- (character #'write-char)
- (integer #'write-byte))))
- (funcall f x s)
- (etypecase x
- (character (write-char x s))
- (integer (write-byte x s)))))
-
- Then (FOO #\1 *STANDARD-OUTPUT*) signals type error.
-
- (In 0.7.9.1 the result type is (FUNCTION * *), so Python does not
- produce invalid code, but type checking is not accurate.)
-
235: "type system and inline expansion"
a.
(declaim (ftype (function (cons) number) acc))
(foo '(nil) '(t)) => NIL, T.
+ As of 0.9.15.41 this seems to be due to ACC being inlined only once
+ inside FOO, which results in the second call reusing the FUNCTIONAL
+ resulting from the first -- which doesn't check the type.
+
237: "Environment arguments to type functions"
a. Functions SUBTYPEP, TYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, and
UPGRADED-COMPLEX-PART-TYPE now have an optional environment
bug 367b: Comment out the (DECLAIM (FTYPE ... R367)), and compile
the file. The compiler fails with TYPE-ERROR at compile time.
-368: miscompiled OR (perhaps related to bug 367)
- Trying to relax type declarations to find a workaround for bug 367,
- it turns out that even when the return type isn't declared (or
- declared to be T, anyway) the system remains confused about type
- inference in code similar to that for bug 367:
- (in-package :cl-user)
- (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1)))
- (defstruct e368)
- (defstruct i368)
- (defstruct g368
- (i368s (make-array 0 :fill-pointer t) :type (or (vector i368) null)))
- (defstruct s368
- (g368 (error "missing :G368") :type g368 :read-only t))
- (declaim (ftype (function (fixnum (vector i368) e368) t) r368))
- (declaim (ftype (function (fixnum (vector e368)) t) h368))
- (defparameter *h368-was-called-p* nil)
- (defun nsu (vertices e368)
- (let ((i368s (g368-i368s (make-g368))))
- (let ((fuis (r368 0 i368s e368)))
- (format t "~&FUIS=~S~%" fuis)
- (or fuis (h368 0 i368s)))))
- (defun r368 (w x y)
- (declare (ignore w x y))
- nil)
- (defun h368 (w x)
- (declare (ignore w x))
- (setf *h368-was-called-p* t)
- (make-s368 :g368 (make-g368)))
- (trace r368 h368)
- (format t "~&calling NSU~%")
- (let ((nsu (nsu #() (make-e368))))
- (format t "~&NSU returned ~S~%" nsu)
- (format t "~&*H368-WAS-CALLED-P*=~S~%" *h368-was-called-p*)
- (assert (s368-p nsu))
- (assert *h368-was-called-p*))
- In sbcl-0.8.18, both ASSERTs fail, and (DISASSEMBLE 'NSU) shows
- that no call to H368 is compiled.
-
369: unlike-an-intersection behavior of VALUES-TYPE-INTERSECTION
In sbcl-0.8.18.2, the identity $(x \cap y \cap y)=(x \cap y)$
does not hold for VALUES-TYPE-INTERSECTION, even for types which
* feature: implemented the READER-METHOD-CLASS and
WRITER-METHOD-CLASS portion of the Class Initialization Protocol
as specified by AMOP.
+ * incompatible change: variable SB-EXT:*USE-IMPLEMENTATION-TYPES*
+ no longer exists.
* optimization: faster LOGCOUNT implementation on x86 and x86-64
(thanks to Lutz Euler)
* optimization: hashing of general arrays and vectors has been
types in some cases.
* bug fix: fixed input, output and error redirection in RUN-PROGRAM
for win32. (thanks to Mike Thomas and Yaroslav Kavenchuk)
+ * bug fix: #368: incorrect use of expressed vs. upgraded array
+ element type.
* thread-safety improvements:
** CONDITION-WAIT could return early on Linux, if the thread was
interrupted and subsequently continued with SIGCONT.
;; ..and variables to control compiler policy
"*INLINE-EXPANSION-LIMIT*"
- "*USE-IMPLEMENTATION-TYPES*"
"*DERIVE-FUNCTION-TYPES*"
;; ..and inspector of compiler policy
(define-condition parse-unknown-type (condition)
((specifier :reader parse-unknown-type-specifier :initarg :specifier)))
-;;; FIXME: This really should go away. Alas, it doesn't seem to be so
-;;; simple to make it go away.. (See bug 123 in BUGS file.)
-(defvar *use-implementation-types* t ; actually initialized in cold init
- #!+sb-doc
- "*USE-IMPLEMENTATION-TYPES* is a semi-public flag which determines how
- restrictive we are in determining type membership. If two types are the
- same in the implementation, then we will consider them them the same when
- this switch is on. When it is off, we try to be as restrictive as the
- language allows, allowing us to detect more errors. Currently, this only
- affects array types.")
-(!cold-init-forms (setq *use-implementation-types* t))
-
;;; These functions are used as method for types which need a complex
;;; subtypep method to handle some superclasses, but cover a subtree
;;; of the type graph (i.e. there is no simple way for any other type
(!define-type-class array)
-;;; What this does depends on the setting of the
-;;; *USE-IMPLEMENTATION-TYPES* switch. If true, return the specialized
-;;; element type, otherwise return the original element type.
-(defun specialized-element-type-maybe (type)
- (declare (type array-type type))
- (if *use-implementation-types*
- (array-type-specialized-element-type type)
- (array-type-element-type type)))
-
(!define-type-method (array :simple-=) (type1 type2)
(cond ((not (and (equal (array-type-dimensions type1)
(array-type-dimensions type2))
(aver (not (and (not equalp) certainp)))
(values equalp certainp)))
(t
- (values (type= (specialized-element-type-maybe type1)
- (specialized-element-type-maybe type2))
+ (values (type= (array-type-specialized-element-type type1)
+ (array-type-specialized-element-type type2))
t))))
(!define-type-method (array :negate) (type)
;; types are equal, and they're equal iff the specialized
;; element types are identical.
t
- (values (type= (specialized-element-type-maybe type1)
- (specialized-element-type-maybe type2))
+ (values (type= (array-type-specialized-element-type type1)
+ (array-type-specialized-element-type type2))
t)))))
;;; FIXME: is this dead?
;; do with a rethink and/or a rewrite. -- CSR, 2002-08-21
((or (eq (array-type-specialized-element-type type1) *wild-type*)
(eq (array-type-specialized-element-type type2) *wild-type*)
- (type= (specialized-element-type-maybe type1)
- (specialized-element-type-maybe type2)))
+ (type= (array-type-specialized-element-type type1)
+ (array-type-specialized-element-type type2)))
(values t t))
(t
(complexp1 (array-type-complexp type1))
(complexp2 (array-type-complexp type2))
(eltype1 (array-type-element-type type1))
- (eltype2 (array-type-element-type type2)))
- (specialize-array-type
- (make-array-type
- :dimensions (cond ((eq dims1 '*) dims2)
- ((eq dims2 '*) dims1)
- (t
- (mapcar (lambda (x y) (if (eq x '*) y x))
- dims1 dims2)))
- :complexp (if (eq complexp1 :maybe) complexp2 complexp1)
- :element-type (cond
- ((eq eltype1 *wild-type*) eltype2)
- ((eq eltype2 *wild-type*) eltype1)
- (t (type-intersection eltype1 eltype2))))))
+ (eltype2 (array-type-element-type type2))
+ (stype1 (array-type-specialized-element-type type1))
+ (stype2 (array-type-specialized-element-type type2)))
+ (flet ((intersect ()
+ (make-array-type
+ :dimensions (cond ((eq dims1 '*) dims2)
+ ((eq dims2 '*) dims1)
+ (t
+ (mapcar (lambda (x y) (if (eq x '*) y x))
+ dims1 dims2)))
+ :complexp (if (eq complexp1 :maybe) complexp2 complexp1)
+ :element-type (cond
+ ((eq eltype1 *wild-type*) eltype2)
+ ((eq eltype2 *wild-type*) eltype1)
+ (t (type-intersection eltype1 eltype2))))))
+ (if (or (eq stype1 *wild-type*) (eq stype2 *wild-type*))
+ (specialize-array-type (intersect))
+ (let ((type (intersect)))
+ (aver (type= stype1 stype2))
+ (setf (array-type-specialized-element-type type) stype1)
+ type))))
*empty-type*))
;;; Check a supplied dimension list to determine whether it is legal,
(funcall x))))
nil (constantly 42)))))
+;;; bug 368: array type intersections in the compiler
+(defstruct e368)
+(defstruct i368)
+(defstruct g368
+ (i368s (make-array 0 :fill-pointer t) :type (or (vector i368) null)))
+(defstruct s368
+ (g368 (error "missing :G368") :type g368 :read-only t))
+(declaim (ftype (function (fixnum (vector i368) e368) t) r368))
+(declaim (ftype (function (fixnum (vector e368)) t) h368))
+(defparameter *h368-was-called-p* nil)
+(defun nsu (vertices e368)
+ (let ((i368s (g368-i368s (make-g368))))
+ (let ((fuis (r368 0 i368s e368)))
+ (format t "~&FUIS=~S~%" fuis)
+ (or fuis (h368 0 i368s)))))
+(defun r368 (w x y)
+ (declare (ignore w x y))
+ nil)
+(defun h368 (w x)
+ (declare (ignore w x))
+ (setf *h368-was-called-p* t)
+ (make-s368 :g368 (make-g368)))
+(let ((nsu (nsu #() (make-e368))))
+ (format t "~&NSU returned ~S~%" nsu)
+ (format t "~&*H368-WAS-CALLED-P*=~S~%" *h368-was-called-p*)
+ (assert (s368-p nsu))
+ (assert *h368-was-called-p*))
+
;;; success
;;; 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.15.43"
+"0.9.15.44"
projects / sbcl.git / commitdiff