X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Farray-tran.lisp;h=abf8141f1de063f882b9678784de7ed60c8d94e9;hb=e0697854ef9f4999c8585b64be1b282ce4725176;hp=02cbb75d097322a154078c23e9033b7bbfb6f78d;hpb=a2feba471e773f549aa575586370adb5438856f2;p=sbcl.git

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 02cbb75..abf8141 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -242,11 +242,15 @@
 		 ((not (ctypep value (sb!vm:saetp-ctype saetp)))
 		  ;; this case will cause an error at runtime, so we'd
 		  ;; better WARN about it now.
-		  (compiler-warn "~@<~S is not a ~S (which is the ~
-                                 UPGRADED-ARRAY-ELEMENT-TYPE of ~S).~@:>"
-				 value
-				 (type-specifier (sb!vm:saetp-ctype saetp))
-				 eltype))
+		  (warn 'array-initial-element-mismatch
+			:format-control "~@<~S is not a ~S (which is the ~
+                                         ~S of ~S).~@:>"
+			:format-arguments 
+			(list 
+			 value
+			 (type-specifier (sb!vm:saetp-ctype saetp))
+			 'upgraded-array-element-type
+			 eltype)))
 		 ((not (ctypep value eltype-type))
 		  ;; this case will not cause an error at runtime, but
 		  ;; it's still worth STYLE-WARNing about.
@@ -634,7 +638,6 @@
 				;; WHN, and also CSR 2002-05-26
 				((or vector simple-array) index (or index null))
 				*
-				:important t
 				:node node
 				:policy (> speed space))
   "inline non-SIMPLE-vector-handling logic"
@@ -647,14 +650,20 @@
 
 ;;; We convert all typed array accessors into AREF and %ASET with type
 ;;; assertions on the array.
-(macrolet ((define-frob (reffer setter type)
+(macrolet ((define-bit-frob (reffer setter simplep)
 	     `(progn
 		(define-source-transform ,reffer (a &rest i)
-		  `(aref (the ,',type ,a) ,@i))
+		  `(aref (the (,',(if simplep 'simple-array 'array)
+				  bit
+				  ,(mapcar (constantly '*) i))
+			   ,a) ,@i))
 		(define-source-transform ,setter (a &rest i)
-		  `(%aset (the ,',type ,a) ,@i)))))
-  (define-frob sbit %sbitset (simple-array bit))
-  (define-frob bit %bitset (array bit)))
+		  `(%aset (the (,',(if simplep 'simple-array 'array)
+				   bit
+				   ,(cdr (mapcar (constantly '*) i)))
+			    ,a) ,@i)))))
+  (define-bit-frob sbit %sbitset t)
+  (define-bit-frob bit %bitset nil))
 (macrolet ((define-frob (reffer setter type)
 	     `(progn
 		(define-source-transform ,reffer (a i)