X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=61bd015cca665497b14fa07e5975cbb12c48b4d1;hb=e0814eee6f6dea52db010b45a330100f2fe65832;hp=4b4337f813b9f9b50e200879559b71ccae4e5a54;hpb=e33fb894f991b2926d8f3bace9058e4c0b2c3a37;p=sbcl.git diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 4b4337f..61bd015 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -146,11 +146,11 @@ (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)))) @@ -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)))))) @@ -682,20 +682,27 @@ ;;;; 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-frob (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-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)) ;;; Similar for BIT-NOT, but there is only one arg... (deftransform bit-not ((bit-array-1 &optional result-bit-array)