From: Paul Khuong Date: Tue, 21 Jun 2011 00:44:07 +0000 (-0400) Subject: Faster MAP[-INTO] when (> SPEED SPACE) X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=65a29e8b22383bda1d4ac20796c9b56529c02a6e;p=sbcl.git Faster MAP[-INTO] when (> SPEED SPACE) Expand into WITH-ARRAY-DATA for non-simple vectors in such cases, and avoid hairy vector accesses. Also make sure to exploit that in conset code. --- diff --git a/NEWS b/NEWS index f73e8fb..f052c31 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,8 @@ changes relative to sbcl-1.0.49: COMPILATION-SPEED > SPEED. * optimization: extracting bits of a single-float on x86-64 has been optimized. (lp#555201) + * optimization: MAP and MAP-INTO are more efficient for non-simple vectors, + when (> SPEED SPACE). * meta-optimization: improved compilation speed, especially for large functions. (lp#792363 and lp#394206) * bug fix: bound derivation for floating point operations is now more diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index 88a8252..5056510 100644 --- a/src/compiler/constraint.lisp +++ b/src/compiler/constraint.lisp @@ -427,6 +427,7 @@ (when ,constraints (let ((,min (conset-min ,conset)) (,max (conset-max ,conset))) + (declare (optimize speed)) (map nil (lambda (constraint) (declare (type constraint constraint)) (let ((number (constraint-number constraint))) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 67ecb5a..d086e3e 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -126,14 +126,15 @@ ;;; MAP-INTO. RESULT and BODY are forms, which can use variables ;;; FUNCALL-RESULT, containing the result of application of FUN, and ;;; INDEX, containing the current position in sequences. -(defun build-sequence-iterator (seqs seq-names &key result into body) +(defun build-sequence-iterator (seqs seq-names &key result into body fast) (declare (type list seqs seq-names) (type symbol into)) (collect ((bindings) (declarations) (vector-lengths) (tests) - (places)) + (places) + (around)) (let ((found-vector-p nil)) (flet ((process-vector (length) (unless found-vector-p @@ -150,10 +151,22 @@ (declarations `(type list ,index)) (places `(car ,index)) (tests `(endp ,index)))) - ((csubtypep type (specifier-type 'vector)) + ((or (csubtypep type (specifier-type '(simple-array * 1))) + (and (not fast) + (csubtypep type (specifier-type 'vector)))) (process-vector `(length ,seq-name)) (places `(locally (declare (optimize (insert-array-bounds-checks 0))) (aref ,seq-name index)))) + ((csubtypep type (specifier-type 'vector)) + (let ((data (gensym "DATA")) + (start (gensym "START")) + (end (gensym "END"))) + (around `(with-array-data ((,data ,seq-name) + (,start) + (,end (length ,seq-name))))) + (process-vector `(- ,end ,start)) + (places `(locally (declare (optimize (insert-array-bounds-checks 0))) + (aref ,data (truly-the index (+ index ,start))))))) (t (give-up-ir1-transform "can't determine sequence argument type")))) @@ -162,12 +175,18 @@ (when found-vector-p (bindings `(length (min ,@(vector-lengths)))) (tests `(>= index length))) - `(do (,@(bindings)) - ((or ,@(tests)) ,result) - (declare ,@(declarations)) - (let ((funcall-result (funcall fun ,@(places)))) - (declare (ignorable funcall-result)) - ,body))))) + (let ((body `(do (,@(bindings)) + ((or ,@(tests)) ,result) + (declare ,@(declarations)) + (let ((funcall-result (funcall fun ,@(places)))) + (declare (ignorable funcall-result)) + ,body)))) + (if (around) + (reduce (lambda (wrap body) (append wrap (list body))) + (around) + :from-end t + :initial-value body) + body))))) ;;; Try to compile %MAP efficiently when we can determine sequence ;;; argument types at compile time. @@ -182,7 +201,7 @@ ;;; the reader, because the code is complicated enough already and I ;;; don't happen to need that functionality right now. -- WHN 20000410 (deftransform %map ((result-type fun seq &rest seqs) * * - :policy (>= speed space)) + :node node :policy (>= speed space)) "open code" (unless (constant-lvar-p result-type) (give-up-ir1-transform "RESULT-TYPE argument not constant")) @@ -244,25 +263,45 @@ ,(build-sequence-iterator seqs seq-args :result result - :body push-dacc)))))))))) + :body push-dacc + :fast (policy node (> speed space)))))))))))) ;;; MAP-INTO (deftransform map-into ((result fun &rest seqs) (vector * &rest *) - *) + * :node node) "open code" (let ((seqs-names (mapcar (lambda (x) (declare (ignore x)) (gensym)) seqs))) `(lambda (result fun ,@seqs-names) - ,(build-sequence-iterator - seqs seqs-names - :result '(when (array-has-fill-pointer-p result) - (setf (fill-pointer result) index)) - :into 'result - :body '(locally (declare (optimize (insert-array-bounds-checks 0))) - (setf (aref result index) funcall-result))) + ,(if (and (policy node (> speed space)) + (not (csubtypep (lvar-type result) + (specifier-type '(simple-array * 1))))) + (let ((data (gensym "DATA")) + (start (gensym "START")) + (end (gensym "END"))) + `(with-array-data ((,data result) + (,start) + (,end)) + (declare (ignore ,end)) + ,(build-sequence-iterator + seqs seqs-names + :result '(when (array-has-fill-pointer-p result) + (setf (fill-pointer result) index)) + :into 'result + :body `(locally (declare (optimize (insert-array-bounds-checks 0))) + (setf (aref ,data (truly-the index (+ index ,start))) + funcall-result)) + :fast t))) + (build-sequence-iterator + seqs seqs-names + :result '(when (array-has-fill-pointer-p result) + (setf (fill-pointer result) index)) + :into 'result + :body '(locally (declare (optimize (insert-array-bounds-checks 0))) + (setf (aref result index) funcall-result)))) result)))