(deftransform %check-vector-sequence-bounds ((vector start end)
(vector * *) *
:node node)
- (if (policy node (< safety speed))
+ (if (policy node (= 0 insert-array-bounds-checks))
'(or end (length vector))
'(let ((length (length vector)))
- (if (<= 0 start (or end length) length)
- (or end length)
- (sb!impl::signal-bounding-indices-bad-error vector start end)))))
+ (if (<= 0 start (or end length) length)
+ (or end length)
+ (sequence-bounding-indices-bad-error vector start end)))))
(defun specialized-list-seek-function-name (function-name key-functions)
(or (find-symbol (with-output-to-string (s)
(values
`(with-array-data ((data seq)
(start start)
- (end end))
+ (end end)
+ :check-fill-pointer t)
(declare (type (simple-array ,element-type 1) data))
(declare (type fixnum start end))
(do ((i start (1+ i)))
,(unless (policy node (= safety 0))
`(progn
(unless (<= 0 start1 end1 len1)
- (sb!impl::signal-bounding-indices-bad-error seq1 start1 end1))
+ (sequence-bounding-indices-bad-error seq1 start1 end1))
(unless (<= 0 start2 end2 len2)
- (sb!impl::signal-bounding-indices-bad-error seq2 start2 end2))))
+ (sequence-bounding-indices-bad-error seq2 start2 end2))))
,',(cond
((and saetp (valid-bit-bash-saetp-p saetp))
(let* ((n-element-bits (sb!vm:saetp-n-bits saetp))
,(unless (policy node (= safety 0))
'(progn
(unless (<= 0 start end length)
- (sb!impl::signal-bounding-indices-bad-error seq start end))))
+ (sequence-bounding-indices-bad-error seq start end))))
(let* ((size (- end start))
(result (make-array size :element-type ',element-type)))
,(maybe-expand-copy-loop-inline 'seq (if (constant-lvar-p start)
'result 0 'size element-type)
result)))))
+(deftransform subseq ((seq start &optional end)
+ (list t &optional t))
+ `(list-subseq* seq start end))
+
(deftransform copy-seq ((seq) ((or (simple-unboxed-array (*)) simple-vector)) *)
(let ((array-type (lvar-type seq)))
(unless (array-type-p array-type)
from-end)
(vector vector &rest t)
*
+ :node node
:policy (> speed (max space safety)))
"open code"
(let ((from-end (when (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)))
+ (testp (lvar-p test))
+ (check-bounds-p (policy node (plusp insert-array-bounds-checks))))
`(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)))))))
+ (flet ((oops (vector start end)
+ (sequence-bounding-indices-bad-error vector start end)))
+ (let* ((len1 (length pattern))
+ (len2 (length text))
+ (end1 (or end1 len1))
+ (end2 (or end2 len2))
+ ,@(when keyp
+ '((key (coerce key 'function))))
+ ,@(when testp
+ '((test (coerce test 'function)))))
+ (declare (type index start1 start2 end1 end2))
+ ,@(when check-bounds-p
+ `((unless (<= start1 end1 len1)
+ (oops pattern start1 end1))
+ (unless (<= start2 end2 len2)
+ (oops pattern start2 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)
+ (optimize (insert-array-bounds-checks 0)))
+ ,@(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))))))))
;;; Open-code CONCATENATE for strings. It would be possible to extend
(declare (type index index))
(dolist (i sequence
(if (and end (> end index))
- (sb!impl::signal-bounding-indices-bad-error
+ (sequence-bounding-indices-bad-error
sequence start end)
(values find position)))
(let ((key-i (funcall key i)))
end-arg
element
done-p-expr)
- (with-unique-names (offset block index n-sequence sequence n-end end)
- `(let ((,n-sequence ,sequence-arg)
- (,n-end ,end-arg))
+ (with-unique-names (offset block index n-sequence sequence end)
+ `(let* ((,n-sequence ,sequence-arg))
(with-array-data ((,sequence ,n-sequence :offset-var ,offset)
(,start ,start)
- (,end (%check-vector-sequence-bounds
- ,n-sequence ,start ,n-end)))
+ (,end ,end-arg)
+ :check-fill-pointer t)
(block ,block
(macrolet ((maybe-return ()
;; WITH-ARRAY-DATA has already performed bounds
;; 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
- (- ,index ,offset)))))))
+ (when ,done-p-expr
+ (return-from ,block
+ (values ,element
+ (- ,index ,offset)))))))
(if ,from-end
(loop for ,index
;; (If we aren't fastidious about declaring that
from (1- ,end) downto ,start do
(maybe-return))
(loop for ,index of-type index from ,start below ,end do
- (maybe-return))))
+ (maybe-return))))
(values nil nil))))))
(def!macro %find-position-vector-macro (item sequence
"expand inline"
(check-inlineability-of-find-position-if sequence from-end)
'(%find-position-vector-macro item sequence
- from-end start end key test))
+ from-end start end key test))
;;; logic to unravel :TEST, :TEST-NOT, and :KEY options in FIND,
;;; POSITION-IF, etc.
projects / sbcl.git / blobdiff