Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1392/src/compiler
Modified Files:
array-tran.lisp
Log Message:
0.9.9.9:
Fix bug #399 (gwking on #lisp / paste 16110; reduced case by
NJF)
... we need to be able to derive DATA-VECTOR-REF's return type
when we have a SIMPLE-STRING, even if the array's type
isn't represented directly as an ARRAY-TYPE
Index: array-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/array-tran.lisp,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -d -r1.69 -r1.70
--- array-tran.lisp 14 Jul 2005 18:52:37 -0000 1.69
+++ array-tran.lisp 27 Jan 2006 22:42:56 -0000 1.70
@@ -28,18 +28,33 @@
;;; type is going to be the array upgraded element type.
(defun extract-upgraded-element-type (array)
(let ((type (lvar-type array)))
- ;; Note that this IF mightn't be satisfied even if the runtime
- ;; value is known to be a subtype of some specialized ARRAY, because
- ;; we can have values declared e.g. (AND SIMPLE-VECTOR UNKNOWN-TYPE),
- ;; which are represented in the compiler as INTERSECTION-TYPE, not
- ;; array type.
- (if (array-type-p type)
- (array-type-specialized-element-type type)
- ;; KLUDGE: there is no good answer here, but at least
- ;; *wild-type* won't cause HAIRY-DATA-VECTOR-{REF,SET} to be
- ;; erroneously optimized (see generic/vm-tran.lisp) -- CSR,
- ;; 2002-08-21
- *wild-type*)))
+ (cond
+ ;; Note that this IF mightn't be satisfied even if the runtime
+ ;; value is known to be a subtype of some specialized ARRAY, because
+ ;; we can have values declared e.g. (AND SIMPLE-VECTOR UNKNOWN-TYPE),
+ ;; which are represented in the compiler as INTERSECTION-TYPE, not
+ ;; array type.
+ ((array-type-p type) (array-type-specialized-element-type type))
+ ;; fix for bug #396. This type logic corresponds to the special
+ ;; case for strings in HAIRY-DATA-VECTOR-REF
+ ;; (generic/vm-tran.lisp)
+ ((csubtypep type (specifier-type 'simple-string))
+ (cond
+ ((csubtypep type (specifier-type '(simple-array character (*))))
+ (specifier-type 'character))
+ #!+sb-unicode
+ ((csubtypep type (specifier-type '(simple-array base-char (*))))
+ (specifier-type 'base-char))
+ ((csubtypep type (specifier-type '(simple-array nil (*))))
+ *empty-type*)
+ ;; see KLUDGE below.
+ (t *wild-type*)))
+ (t
+ ;; KLUDGE: there is no good answer here, but at least
+ ;; *wild-type* won't cause HAIRY-DATA-VECTOR-{REF,SET} to be
+ ;; erroneously optimized (see generic/vm-tran.lisp) -- CSR,
+ ;; 2002-08-21
+ *wild-type*))))
(defun extract-declared-element-type (array)
(let ((type (lvar-type array)))
|