0.9.1.48:

[sbcl.git] / src / compiler / array-tran.lisp

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 3d6448a..ab21afa 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -293,8 +293,7 @@
       (give-up-ir1-transform
        "cannot open-code creation of ~S" result-type-spec))
     #-sb-xc-host
-    (unless (csubtypep (ctype-of (sb!vm:saetp-initial-element-default saetp))
-                      eltype-type)
+    (unless (ctypep (sb!vm:saetp-initial-element-default saetp) eltype-type)
       ;; This situation arises e.g. in (MAKE-ARRAY 4 :ELEMENT-TYPE
       ;; '(INTEGER 1 5)) ANSI's definition of MAKE-ARRAY says "If
       ;; INITIAL-ELEMENT is not supplied, the consequences of later
@@ -523,7 +522,7 @@
            ((:maybe)
             (give-up-ir1-transform
              "The array type is ambiguous; must call ~
-             ARRAY-HAS-FILL-POINTER-P at runtime.")))))))
+               ARRAY-HAS-FILL-POINTER-P at runtime.")))))))
 
 ;;; Primitive used to verify indices into arrays. If we can tell at
 ;;; compile-time or we are generating unsafe code, don't bother with
@@ -638,7 +637,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"
@@ -651,14 +649,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)
@@ -673,7 +677,7 @@
           ;; 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)
@@ -753,7 +757,7 @@
                                    (bit-vector bit-vector &optional null) *
                                    :policy (>= speed space))
                  `(,',fun bit-array-1 bit-array-2
-                   (make-array (length bit-array-1) :element-type 'bit)))
+                   (make-array (array-dimension bit-array-1 0) :element-type 'bit)))
                ;; If result is T, make it the first arg.
                (deftransform ,fun ((bit-array-1 bit-array-2 result-bit-array)
                                    (bit-vector bit-vector (eql t)) *)
@@ -774,7 +778,7 @@
                       (bit-vector &optional null) *
                       :policy (>= speed space))
   '(bit-not bit-array-1
-           (make-array (length bit-array-1) :element-type 'bit)))
+           (make-array (array-dimension bit-array-1 0) :element-type 'bit)))
 (deftransform bit-not ((bit-array-1 result-bit-array)
                       (bit-vector (eql t)))
   '(bit-not bit-array-1 bit-array-1))