X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=24fe5ce10de350c0ae1b86fe1ecbd37463622616;hb=3ea6f2688adf11331a7a9c243f77a602785d1e1b;hp=4a75395fc1fe725a67334bb833238e9d49be7619;hpb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;p=sbcl.git diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 4a75395..24fe5ce 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -153,7 +153,8 @@ (tests `(endp ,index)))) ((csubtypep type (specifier-type 'vector)) (process-vector `(length ,seq-name)) - (places `(aref ,seq-name index))) + (places `(locally (declare (optimize (insert-array-bounds-checks 0))) + (aref ,seq-name index)))) (t (give-up-ir1-transform "can't determine sequence argument type")))) @@ -161,7 +162,7 @@ (process-vector `(array-dimension ,into 0)))) (when found-vector-p (bindings `(length (min ,@(vector-lengths)))) - (tests `(= index length))) + (tests `(>= index length))) `(do (,@(bindings)) ((or ,@(tests)) ,result) (declare ,@(declarations)) @@ -202,7 +203,7 @@ 'list) (t (give-up-ir1-transform - "can't determine result type"))))) + "result type unsuitable"))))) (cond ((and result-type-value (null seqs)) ;; The consing arity-1 cases can be implemented ;; reasonably efficiently as function calls, and the cost @@ -261,7 +262,8 @@ :result '(when (array-has-fill-pointer-p result) (setf (fill-pointer result) index)) :into 'result - :body '(setf (aref result index) funcall-result)) + :body '(locally (declare (optimize (insert-array-bounds-checks 0))) + (setf (aref result index) funcall-result))) result))) @@ -777,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 @@ -970,7 +1005,11 @@ ,n-sequence ,start ,n-end))) (block ,block (macrolet ((maybe-return () - '(let ((,element (aref ,sequence ,index))) + ;; WITH-ARRAY-DATA has already performed bounds + ;; checking, so we can safely elide the checks + ;; in the inner loop. + '(let ((,element (locally (declare (optimize (insert-array-bounds-checks 0))) + (aref ,sequence ,index)))) (when ,done-p-expr (return-from ,block (values ,element @@ -1077,7 +1116,8 @@ (macrolet ((define-find-position (fun-name values-index) `(deftransform ,fun-name ((item sequence &key from-end (start 0) end - key test test-not)) + key test test-not) + (t (or list vector) &rest t)) '(nth-value ,values-index (%find-position item sequence from-end start @@ -1091,7 +1131,8 @@ (macrolet ((define-find-position-if (fun-name values-index) `(deftransform ,fun-name ((predicate sequence &key from-end (start 0) - end key)) + end key) + (t (or list vector) &rest t)) '(nth-value ,values-index (%find-position-if (%coerce-callable-to-fun predicate) @@ -1124,7 +1165,8 @@ (macrolet ((define-find-position-if-not (fun-name values-index) `(deftransform ,fun-name ((predicate sequence &key from-end (start 0) - end key)) + end key) + (t (or list vector) &rest t)) '(nth-value ,values-index (%find-position-if-not (%coerce-callable-to-fun predicate)