From 3ea6f2688adf11331a7a9c243f77a602785d1e1b Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 3 Mar 2007 17:21:58 +0000 Subject: [PATCH] 1.0.3.20: better SEARCH transform * Better type declarations for index variables -- fixes the performance regression in BENCH-STRINGS from the NaN-comparison changes. * Extend the transform to work with general vectors, arbitrary :TEST and :KEY, and constant but arbitrary :FROM-END. * Tests. --- NEWS | 3 +- src/compiler/seqtran.lisp | 71 +++++++++++++++++++++++++++++++++------------ tests/seq.impure.lisp | 18 +++++++++++- version.lisp-expr | 2 +- 4 files changed, 72 insertions(+), 22 deletions(-) diff --git a/NEWS b/NEWS index 8c44ad8..c29650c 100644 --- a/NEWS +++ b/NEWS @@ -6,7 +6,8 @@ changes in sbcl-1.0.4 relative to sbcl-1.0.3: and gethostbyname, on platforms where the newer functions are available. As a result, the ALIASES field of HOST-ENT will always be NIL on these platforms. - * optimization: code using alien values with undeclared types is much faster + * optimization: code using alien values with undeclared types is much faster. + * optimization: the compiler is now able to open code SEARCH in more cases. * bug fix: >= and <= gave wrong results when used with NaNs. * bug fix: the #= and ## reader macros now interact reasonably with funcallable instances. diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index de9f0ff..24fe5ce 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -779,27 +779,60 @@ finally (return `(progn ,@forms))))) (define-copy-seq-transforms)) -;;; FIXME: this would be a valid transform for certain excluded cases: -;;; * :TEST 'CHAR= or :TEST #'CHAR= -;;; * :TEST 'EQL or :TEST #'EQL -;;; * :FROM-END NIL (or :FROM-END non-NIL, with a little ingenuity) -(deftransform search ((pattern text &key (start1 0) (start2 0) end1 end2) - (simple-string simple-string &rest t) +;;; FIXME: it really should be possible to take advantage of the +;;; macros used in code/seq.lisp here to avoid duplication of code, +;;; and enable even funkier transformations. +(deftransform search ((pattern text &key (start1 0) (start2 0) end1 end2 + (test #'eql) + (key #'identity) + from-end) + (vector vector &rest t) * :policy (> speed (max space safety))) - `(block search - (let ((end1 (or end1 (length pattern))) - (end2 (or end2 (length text)))) - (do ((index2 start2 (1+ index2))) - ((>= index2 end2) nil) - (when (do ((index1 start1 (1+ index1)) - (index2 index2 (1+ index2))) - ((>= index1 end1) t) - (when (= index2 end2) - (return-from search nil)) - (when (char/= (char pattern index1) (char text index2)) - (return nil))) - (return index2)))))) + "open code" + (let ((from-end (when (lvar-p from-end) + (unless (constant-lvar-p from-end) + (give-up-ir1-transform ":FROM-END is not constant.")) + (lvar-value from-end))) + (keyp (lvar-p key)) + (testp (lvar-p test))) + `(block search + (let ((end1 (or end1 (length pattern))) + (end2 (or end2 (length text))) + ,@(when keyp + '((key (coerce key 'function)))) + ,@(when testp + '((test (coerce test 'function))))) + (declare (type index start1 start2 end1 end2)) + (do (,(if from-end + '(index2 (- end2 (- end1 start1)) (1- index2)) + '(index2 start2 (1+ index2)))) + (,(if from-end + '(< index2 start2) + '(>= index2 end2)) + nil) + ;; INDEX2 is FIXNUM, not an INDEX, as right before the loop + ;; terminates is hits -1 when :FROM-END is true and :START2 + ;; is 0. + (declare (type fixnum index2)) + (when (do ((index1 start1 (1+ index1)) + (index2 index2 (1+ index2))) + ((>= index1 end1) t) + (declare (type index index1 index2)) + ,@(unless from-end + '((when (= index2 end2) + (return-from search nil)))) + (unless (,@(if testp + '(funcall test) + '(eql)) + ,(if keyp + '(funcall key (aref pattern index1)) + '(aref pattern index1)) + ,(if keyp + '(funcall key (aref text index2)) + '(aref text index2))) + (return nil))) + (return index2))))))) ;;; FIXME: It seems as though it should be possible to make a DEFUN ;;; %CONCATENATE (with a DEFTRANSFORM to translate constant RTYPE to diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp index ee254df..ae10560 100644 --- a/tests/seq.impure.lisp +++ b/tests/seq.impure.lisp @@ -162,7 +162,23 @@ (eql 3 (position-if #'plusp seq :from-end t :key '1- :start 2)) (null (position-if #'plusp seq :from-end t :key '1- :start 2 :end 2)) (null (find-if-not #'plusp seq)) - (eql 0 (position-if-not #'evenp seq)))) + (eql 0 (position-if-not #'evenp seq)) + (eql 0 (search #(1) seq)) + (eql 1 (search #(4 5) seq :key 'oddp)) + (eql 1 (search #(-2) seq :test (lambda (a b) (= (- a) b)))) + (eql 4 (search #(1) seq :start2 1)) + (null (search #(3) seq :start2 3)) + (eql 2 (search #(3) seq :start2 2)) + (eql 0 (search #(1 2) seq)) + (null (search #(2 1 3) seq)) + (eql 0 (search #(0 1 2 4) seq :start1 1 :end1 3)) + (eql 3 (search #(0 2 1 4) seq :start1 1 :end1 3)) + (eql 4 (search #(1) seq :from-end t)) + (eql 0 (search #(1 2) seq :from-end t)) + (null (search #(1 2) seq :from-end t :start2 1)) + (eql 0 (search #(0 1 2 4) seq :from-end t :start1 1 :end1 3)) + (eql 3 (search #(0 2 1 4) seq :from-end t :start1 1 :end1 3)) + (null (search #(2 1 3) seq :from-end t)))) (for-every-seq "string test" '((null (find 0 seq)) (null (find #\D seq :key #'char-upcase)) diff --git a/version.lisp-expr b/version.lisp-expr index 5550796..d4d9a05 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.3.19" +"1.0.3.20" -- 1.7.10.4