0.8.15:
[sbcl.git] / src / compiler / array-tran.lisp
index 02cbb75..6dae535 100644 (file)
                 ((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.
                                ;; 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"
 
 ;;; 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)
           ;; given a set of indices. We wrap each index with a call
           ;; to %CHECK-BOUND to ensure that everything works out
           ;; correctly. We can wrap all the interior arithmetic with
-          ;; TRULY-THE INDEX because we know the the resultant
+          ;; TRULY-THE INDEX because we know the resultant
           ;; row-major index must be an index.
           (with-row-major-index ((array indices index &optional new-value)
                                  &rest body)