X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=5551e171e7968930f52d69c41126f4edf29119f4;hb=b767eae48831153473226b985511c8f7a3ef98c5;hp=c6dae10e3bff0dbb7e335b87e1dfc4ba205f6de0;hpb=1bfc464c657a8f4ad24ef612f76a38d8f6f1bbad;p=sbcl.git

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index c6dae10..5551e17 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -141,24 +141,24 @@
 
 ;;; Convert VECTOR into a MAKE-ARRAY followed by SETFs of all the
 ;;; elements.
-(def-source-transform vector (&rest elements)
+(define-source-transform vector (&rest elements)
   (let ((len (length elements))
 	(n -1))
     (once-only ((n-vec `(make-array ,len)))
       `(progn
-	 ,@(mapcar #'(lambda (el)
-		       (once-only ((n-val el))
-			 `(locally (declare (optimize (safety 0)))
-				   (setf (svref ,n-vec ,(incf n))
-					 ,n-val))))
+	 ,@(mapcar (lambda (el)
+		     (once-only ((n-val el))
+		       `(locally (declare (optimize (safety 0)))
+				 (setf (svref ,n-vec ,(incf n))
+				       ,n-val))))
 		   elements)
 	 ,n-vec))))
 
 ;;; Just convert it into a MAKE-ARRAY.
-(def-source-transform make-string (length &key
-					  (element-type ''base-char)
-					  (initial-element
-					   '#.*default-init-char-form*))
+(define-source-transform make-string (length &key
+					     (element-type ''base-char)
+					     (initial-element
+					      '#.*default-init-char-form*))
   `(make-array (the index ,length)
 	       :element-type ,element-type
 	       :initial-element ,initial-element))
@@ -339,9 +339,9 @@
 				   '(:initial-element initial-element))))
 	     (setf (%array-displaced-p header) nil)
 	     ,@(let ((axis -1))
-		 (mapcar #'(lambda (dim)
-			     `(setf (%array-dimension header ,(incf axis))
-				    ,dim))
+		 (mapcar (lambda (dim)
+			   `(setf (%array-dimension header ,(incf axis))
+				  ,dim))
 			 dims))
 	     (truly-the ,spec header))))))
 
@@ -595,9 +595,9 @@
 ;;; assertions on the array.
 (macrolet ((define-frob (reffer setter type)
 	     `(progn
-		(def-source-transform ,reffer (a &rest i)
+		(define-source-transform ,reffer (a &rest i)
 		  `(aref (the ,',type ,a) ,@i))
-		(def-source-transform ,setter (a &rest i)
+		(define-source-transform ,setter (a &rest i)
 		  `(%aset (the ,',type ,a) ,@i)))))
   (define-frob svref %svset simple-vector)
   (define-frob schar %scharset simple-string)
@@ -682,20 +682,28 @@
 ;;;; and eliminates the need for any VM-dependent transforms to handle
 ;;;; these cases.
 
-(dolist (fun '(bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor bit-andc1
-		       bit-andc2 bit-orc1 bit-orc2))
-  ;; Make a result array if result is NIL or unsupplied.
-  (deftransform fun ((bit-array-1 bit-array-2 &optional result-bit-array)
-		     '(bit-vector bit-vector &optional null) '*
-		     :eval-name t
-		     :policy (>= speed space))
-    `(,fun bit-array-1 bit-array-2
-	   (make-array (length bit-array-1) :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 (member t)) '*
-		     :eval-name t)
-    `(,fun bit-array-1 bit-array-2 bit-array-1)))
+(macrolet ((def (fun)
+             `(progn
+               (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
+                   (make-array (length bit-array-1) :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 (member t)) *)
+                 `(,',fun bit-array-1 bit-array-2 bit-array-1)))))
+  (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)
@@ -704,10 +712,10 @@
   '(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.