0.7.3.7:

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

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 98befa5..2f3585a 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -199,7 +199,7 @@
                    ;; (SIMPLE-STRINGs are stored with an extra trailing
                    ;; #\NULL for convenience in calling out to C.)
                    :n-pad-elements 1)
-        (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-widetag)
+        (single-float 0.0f0 32 ,sb!vm:simple-array-single-float-widetag)
         (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-widetag)
         #!+long-float (long-float 0.0L0 #!+x86 96 #!+sparc 128
                                   ,sb!vm:simple-array-long-float-widetag)
@@ -213,7 +213,7 @@
         ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-widetag)
         ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-widetag)
         ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-widetag)
-        ((complex single-float) #C(0.0s0 0.0s0) 64
+        ((complex single-float) #C(0.0f0 0.0f0) 64
          ,sb!vm:simple-array-complex-single-float-widetag)
         ((complex double-float) #C(0.0d0 0.0d0) 128
          ,sb!vm:simple-array-complex-double-float-widetag)
@@ -243,7 +243,7 @@
                         *specialized-array-element-type-properties*)))
     (unless saetp
       (give-up-ir1-transform
-       "cannot open-code creation of ~S" spec))
+       "cannot open-code creation of ~S" result-type-spec))
 
     (let* ((initial-element-default (saetp-initial-element-default saetp))
           (n-bits-per-element (saetp-n-bits saetp))
@@ -682,9 +682,10 @@
 ;;;; and eliminates the need for any VM-dependent transforms to handle
 ;;;; these cases.
 
-(macrolet ((def-frob (fun)
+(macrolet ((def (fun)
              `(progn
-               (deftransform ,fun ((bit-array-1 bit-array-2 &optional result-bit-array)
+               (deftransform ,fun ((bit-array-1 bit-array-2
+                                               &optional result-bit-array)
                                    (bit-vector bit-vector &optional null) *
                                    :policy (>= speed space))
                  `(,',fun bit-array-1 bit-array-2
@@ -693,16 +694,16 @@
                (deftransform ,fun ((bit-array-1 bit-array-2 result-bit-array)
                                    (bit-vector bit-vector (member t)) *)
                  `(,',fun bit-array-1 bit-array-2 bit-array-1)))))
-  (def-frob bit-and)
-  (def-frob bit-ior)
-  (def-frob bit-xor)
-  (def-frob bit-eqv)
-  (def-frob bit-nand)
-  (def-frob bit-nor)
-  (def-frob bit-andc1)
-  (def-frob bit-andc2)
-  (def-frob bit-orc1)
-  (def-frob bit-orc2))
+  (def bit-and)
+  (def bit-ior)
+  (def bit-xor)
+  (def bit-eqv)
+  (def bit-nand)
+  (def bit-nor)
+  (def bit-andc1)
+  (def bit-andc2)
+  (def bit-orc1)
+  (def bit-orc2))
 
 ;;; Similar for BIT-NOT, but there is only one arg...
 (deftransform bit-not ((bit-array-1 &optional result-bit-array)
@@ -720,15 +721,14 @@
 ;;; Pick off some constant cases.
 (deftransform array-header-p ((array) (array))
   (let ((type (continuation-type array)))
-    (declare (optimize (safety 3)))
     (unless (array-type-p type)
       (give-up-ir1-transform))
     (let ((dims (array-type-dimensions type)))
       (cond ((csubtypep type (specifier-type '(simple-array * (*))))
-            ;; No array header.
+            ;; no array header
             nil)
            ((and (listp dims) (> (length dims) 1))
-            ;; Multi-dimensional array, will have a header.
+            ;; multi-dimensional array, will have a header
             t)
            (t
             (give-up-ir1-transform))))))