0.8.1.9:

	Implement slightly DWIMish behaviour for (TYPE (ARRAY FOO ..) ..)
	declarations, as discussed on the CLHS "Declaration TYPE" page, and
	on sbcl-help circa 2003-05-08 and with Fufie on #lisp around
	2003-06-24
	... We need the target's UPGRADED-ARRAY-ELEMENT-TYPE, so move
		the definition and define it in SB!XC
	... use it (carefully) in MAKE-ARRAY optimizers and transforms,
		because the declaration behaviour we're implementing
		doesn't extend to (MAKE-ARRAY .. :ELEMENT-TYPE 'FOO)
	... insert appropriate THEs in HAIRY-DATA-VECTOR-{REF,SET} if the
		declared array element type isn't the same as the
		declared upgraded element type

diff --git a/NEWS b/NEWS
index d42783f..10ff16b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1890,6 +1890,14 @@ changes in sbcl-0.8.2 relative to sbcl-0.8.1:
     circumstances could go off-by-one.
   * improved MACHINE-VERSION, especially on Linux (thanks to Lars
     Brinkhoff)
+  * type declarations for array element types now obey the description
+    on the CLHS page "Declaration TYPE", as per discussions on
+    sbcl-help around 2003-05-08.  This means that a declaration 
+    (TYPE (ARRAY FOO) BAR) means that, within the scope of the
+    declaration, all references to BAR will be asserted or assumed
+    (with THE, so dependent on compiler policy) to involve objects of
+    type FOO.  Note that no such declaration is implied in 
+    (MAKE-ARRAY .. :ELEMENT-TYPE 'FOO).
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 5f0709f..d8d04e9 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -65,15 +65,6 @@
   (bug "called FAILED-%WITH-ARRAY-DATA with valid array parameters?"))
 \f
 ;;;; MAKE-ARRAY
-(defun upgraded-array-element-type (spec &optional environment)
-  #!+sb-doc
-  "Return the element type that will actually be used to implement an array
-   with the specifier :ELEMENT-TYPE Spec."
-  (declare (ignore environment))
-  (if (unknown-type-p (specifier-type spec))
-      (error "undefined type: ~S" spec)
-      (type-specifier (array-type-specialized-element-type
-                      (specifier-type `(array ,spec))))))
 (eval-when (:compile-toplevel :execute)
   (sb!xc:defmacro pick-vector-type (type &rest specs)
     `(cond ,@(mapcar (lambda (spec)

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 8e07447..5e00418 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2294,7 +2294,10 @@
                             (mapcar (lambda (x y) (if (eq x '*) y x))
                                     dims1 dims2)))
          :complexp (if (eq complexp1 :maybe) complexp2 complexp1)
-         :element-type (if (eq eltype1 *wild-type*) eltype2 eltype1))))
+         :element-type (cond
+                         ((eq eltype1 *wild-type*) eltype2)
+                         ((eq eltype2 *wild-type*) eltype1)
+                         (t (type-intersection eltype1 eltype2))))))
       *empty-type*))
 
 ;;; Check a supplied dimension list to determine whether it is legal,

diff --git a/src/cold/defun-load-or-cload-xcompiler.lisp b/src/cold/defun-load-or-cload-xcompiler.lisp
index c61e18b..916b026 100644 (file)
--- a/src/cold/defun-load-or-cload-xcompiler.lisp
+++ b/src/cold/defun-load-or-cload-xcompiler.lisp
@@ -123,6 +123,7 @@
                    "STRUCTURE-CLASS"
                    "SUBTYPEP"
                    "TYPE-OF" "TYPEP"
+                   "UPGRADED-ARRAY-ELEMENT-TYPE"
                    "WITH-COMPILATION-UNIT"))
       (export (intern name package-name) package-name)))
   ;; don't watch:

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index d0f9baf..f9a4947 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -41,6 +41,12 @@
        ;; 2002-08-21
        *wild-type*)))
 
+(defun extract-declared-element-type (array)
+  (let ((type (continuation-type array)))
+    (if (array-type-p type)
+       (array-type-element-type type)
+       *wild-type*)))
+
 ;;; The ``new-value'' for array setters must fit in the array, and the
 ;;; return type is going to be the same as the new-value for SETF
 ;;; functions.
@@ -136,7 +142,12 @@
          `(,(if simple 'simple-array 'array)
             ,(cond ((not element-type) t)
                    ((constant-continuation-p element-type)
-                    (continuation-value element-type))
+                   (let ((ctype (careful-specifier-type
+                                 (continuation-value element-type))))
+                     (cond
+                       ((or (null ctype) (unknown-type-p ctype)) '*)
+                       (t (sb!xc:upgraded-array-element-type
+                           (continuation-value element-type))))))
                    (t
                     '*))
             ,(cond ((constant-continuation-p dims)
@@ -338,8 +349,14 @@
         (len (if (constant-continuation-p length)
                  (continuation-value length)
                  '*))
-        (result-type-spec `(simple-array ,eltype (,len)))
         (eltype-type (ir1-transform-specifier-type eltype))
+        (result-type-spec
+         `(simple-array
+           ,(if (unknown-type-p eltype-type)
+                (give-up-ir1-transform
+                 "ELEMENT-TYPE is an unknown type: ~S" eltype)
+                (sb!xc:upgraded-array-element-type eltype))
+           (,len)))
         (saetp (find-if (lambda (saetp)
                           (csubtypep eltype-type (saetp-ctype saetp)))
                         *specialized-array-element-type-properties*)))
@@ -415,8 +432,11 @@
               (rank (length dims))
               (spec `(simple-array
                       ,(cond ((null element-type) t)
-                             ((constant-continuation-p element-type)
-                              (continuation-value element-type))
+                             ((and (constant-continuation-p element-type)
+                                   (ir1-transform-specifier-type
+                                    (continuation-value element-type)))
+                              (sb!xc:upgraded-array-element-type
+                               (continuation-value element-type)))
                              (t '*))
                           ,(make-list rank :initial-element '*))))
          `(let ((header (make-array-header sb!vm:simple-array-widetag ,rank)))

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index 19f6a0f..bf9bfbb 100644 (file)
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -303,6 +303,8 @@
        ;; SIGNED-BYTE arrays, so better make it break now if it ever
        ;; will:
        #+sb-xc-host
+       ;; not SB!XC:UPGRADED-ARRAY-ELEMENT-TYPE, because we are
+       ;; worried about whether the host's implementation of arrays.
        (aver (subtypep (upgraded-array-element-type specializer) 
                        'unsigned-byte))
        (coerce seq `(simple-array ,specializer (*)))))))

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index e5d27c7..e394ac4 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -44,7 +44,7 @@
 (defknown type-of (t) t (foldable flushable))
 
 ;;; These can be affected by type definitions, so they're not FOLDABLE.
-(defknown (upgraded-complex-part-type upgraded-array-element-type)
+(defknown (upgraded-complex-part-type sb!xc:upgraded-array-element-type)
          (type-specifier &optional lexenv-designator) type-specifier
   (unsafely-flushable))
 \f

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 852a086..634e687 100644 (file)
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -43,7 +43,8 @@
 
 (deftransform hairy-data-vector-ref ((array index) (array t) * :important t)
   "avoid runtime dispatch on array element type"
-  (let ((element-ctype (extract-upgraded-element-type array)))
+  (let ((element-ctype (extract-upgraded-element-type array))
+       (declared-element-ctype (extract-declared-element-type array)))
     (declare (type ctype element-ctype))
     (when (eq *wild-type* element-ctype)
       (give-up-ir1-transform
@@ -56,7 +57,11 @@
       `(multiple-value-bind (array index)
           (%data-vector-and-index array index)
         (declare (type (simple-array ,element-type-specifier 1) array))
-        (data-vector-ref array index)))))
+        ,(let ((bare-form '(data-vector-ref array index)))
+           (if (type= element-ctype declared-element-ctype)
+               bare-form
+               `(the ,(type-specifier declared-element-ctype)
+                     ,bare-form)))))))
 
 (deftransform data-vector-ref ((array index)
                                (simple-array t))
@@ -80,7 +85,8 @@
                                     *
                                     :important t)
   "avoid runtime dispatch on array element type"
-  (let ((element-ctype (extract-upgraded-element-type array)))
+  (let ((element-ctype (extract-upgraded-element-type array))
+       (declared-element-ctype (extract-declared-element-type array)))
     (declare (type ctype element-ctype))
     (when (eq *wild-type* element-ctype)
       (give-up-ir1-transform
@@ -90,9 +96,12 @@
           (%data-vector-and-index array index)
         (declare (type (simple-array ,element-type-specifier 1) array)
                  (type ,element-type-specifier new-value))
-        (data-vector-set array
-                         index
-                         new-value)))))
+        ,(if (type= element-ctype declared-element-ctype)
+             '(data-vector-set array index new-value)
+             `(truly-the ,(type-specifier declared-element-ctype)
+                (data-vector-set array index
+                 (the ,(type-specifier declared-element-ctype)
+                      new-value))))))))
 
 (deftransform data-vector-set ((array index new-value)
                                (simple-array t t))

diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index 9c50878..4b47009 100644 (file)
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -150,6 +150,16 @@
                    (return stype))))))
     type))
 
+(defun sb!xc:upgraded-array-element-type (spec &optional environment)
+  #!+sb-doc
+  "Return the element type that will actually be used to implement an array
+   with the specifier :ELEMENT-TYPE Spec."
+  (declare (ignore environment))
+  (if (unknown-type-p (specifier-type spec))
+      (error "undefined type: ~S" spec)
+      (type-specifier (array-type-specialized-element-type
+                      (specifier-type `(array ,spec))))))
+
 ;;; Return the most specific integer type that can be quickly checked that
 ;;; includes the given type.
 (defun containing-integer-type (subtype)

diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp
index 21b5b69..1b7f9cd 100644 (file)
--- a/tests/array.pure.lisp
+++ b/tests/array.pure.lisp
@@ -127,3 +127,6 @@
   (assert fail)
   (assert (raises-error? (funcall fun) type-error)))
 
+(multiple-value-bind (fun warn fail)
+    (compile nil '(lambda () (make-array 5 :element-type 'undefined-type)))
+  (assert warn))

diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp
index 6d61de0..8f89da4 100644 (file)
--- a/tests/compiler-1.impure-cload.lisp
+++ b/tests/compiler-1.impure-cload.lisp
@@ -103,12 +103,14 @@
 ;;; bug 31 turned out to be a manifestation of non-ANSI array type
 ;;; handling, fixed by CSR in sbcl-0.7.3.8.
 (defun array-element-type-handling (x)
+  (declare (optimize safety))
   (declare (type (vector cons) x))
   (when (consp (aref x 0))
     (aref x 0)))
-(assert (eq (array-element-type-handling
-            (make-array 3 :element-type t :initial-element 0))
-           nil))
+(assert (raises-error?
+        (array-element-type-handling
+         (make-array 3 :element-type t :initial-element 0))
+        type-error))
 
 ;;; bug 220: type check inserted after all arguments in MV-CALL caused
 ;;; failure of stack analysis

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 30cc9dc..64f425e 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -457,3 +457,8 @@
     (assert (equal y #*00))
     (funcall f y 1)
     (assert (equal y #*10))))
+
+(handler-bind ((sb-ext:compiler-note #'error))
+  (compile nil '(lambda (x)
+                (declare (type (simple-array (simple-string 3) (5)) x))
+                (aref (aref x 0) 0))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 2f31f00..0c26546 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; 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.8.1.8"
+"0.8.1.9"