X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=3e3329b35de0e8713a3d3fb2f8dc636d2a777ab8;hb=bcbbce86c47a1c530d488c7876a453100fcd933e;hp=61bd015cca665497b14fa07e5975cbb12c48b4d1;hpb=e0814eee6f6dea52db010b45a330100f2fe65832;p=sbcl.git

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 61bd015..3e3329b 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -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)
@@ -711,24 +712,23 @@
   '(bit-not bit-array-1
 	    (make-array (length bit-array-1) :element-type 'bit)))
 (deftransform bit-not ((bit-array-1 result-bit-array)
-		       (bit-vector (constant-argument t)))
+		       (bit-vector (constant-arg t)))
   '(bit-not bit-array-1 bit-array-1))
-;;; FIXME: What does (CONSTANT-ARGUMENT T) mean? Is it the same thing
-;;; as (CONSTANT-ARGUMENT (MEMBER T)), or does it mean any constant
+;;; FIXME: What does (CONSTANT-ARG T) mean? Is it the same thing
+;;; as (CONSTANT-ARG (MEMBER T)), or does it mean any constant
 ;;; value?
 
 ;;; 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))))))