(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"))))
(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))
'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
: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)))
\f
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
,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
(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
(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)
(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)
projects / sbcl.git / blobdiff