(list (length sequence2))
(vector (length sequence2)))))
(new-declarations '(type index length2)))
+ ((function predicate)
+ (new-args arg)
+ (adjustments `(,arg (%coerce-callable-to-fun ,arg))))
(t (let ((info (cdr (assoc arg *sequence-keyword-info*))))
(cond (info
(destructuring-bind (default supplied-p adjuster type) info
(cons (cond
((eq (car type) 'string) `(vector character ,@(cdr type)))
((eq (car type) 'simple-string)
- `(simple-array character ,@(when (cdr type)
- (list (cdr type)))))
+ `(simple-array character ,(if (cdr type)
+ (cdr type)
+ '(*))))
(t type)))
(t type)))
(type (specifier-type adjusted-type)))
(1- source-index)))
((= target-index (the fixnum (1- target-start))) target-sequence)
(declare (fixnum target-index source-index))
+ ;; disable bounds checking
+ (declare (optimize (safety 0)))
(setf (aref target-sequence target-index)
(aref source-sequence source-index))))
(do ((target-index target-start (1+ target-index))
(= source-index (the fixnum source-end)))
target-sequence)
(declare (fixnum target-index source-index))
+ ;; disable bounds checking
+ (declare (optimize (safety 0)))
(setf (aref target-sequence target-index)
(aref source-sequence source-index)))))
(when (null source-end) (setq source-end (length source-sequence)))
(mumble-replace-from-mumble))
+#!+sb-unicode
+(defun simple-character-string-replace-from-simple-character-string*
+ (target-sequence source-sequence
+ target-start target-end source-start source-end)
+ (declare (type (simple-array character (*)) target-sequence source-sequence))
+ (when (null target-end) (setq target-end (length target-sequence)))
+ (when (null source-end) (setq source-end (length source-sequence)))
+ (mumble-replace-from-mumble))
+
(define-sequence-traverser replace
(sequence1 sequence2 &key start1 end1 start2 end2)
#!+sb-doc
ref)
`(do ((index ,start (1+ index))
(value ,initial-value))
- ((= index (the fixnum ,end)) value)
- (declare (fixnum index))
+ ((>= index ,end) value)
(setq value (funcall ,function value
(apply-key ,key (,ref ,sequence index))))))
`(do ((index (1- ,end) (1- index))
(value ,initial-value)
(terminus (1- ,start)))
- ((= index terminus) value)
- (declare (fixnum index terminus))
+ ((<= index terminus) value)
(setq value (funcall ,function
(apply-key ,key (,ref ,sequence index))
value))))
initial-value
ivp)
`(let ((sequence (nthcdr ,start ,sequence)))
- (do ((count (if ,ivp ,start (1+ (the fixnum ,start)))
+ (do ((count (if ,ivp ,start (1+ ,start))
(1+ count))
(sequence (if ,ivp sequence (cdr sequence))
(cdr sequence))
(value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
(funcall ,function value (apply-key ,key (car sequence)))))
- ((= count (the fixnum ,end)) value)
- (declare (fixnum count)))))
+ ((>= count ,end) value))))
(sb!xc:defmacro list-reduce-from-end (function
sequence
end
initial-value
ivp)
- `(let ((sequence (nthcdr (- (the fixnum (length ,sequence))
- (the fixnum ,end))
+ `(let ((sequence (nthcdr (- (length ,sequence) ,end)
(reverse ,sequence))))
- (do ((count (if ,ivp ,start (1+ (the fixnum ,start)))
+ (do ((count (if ,ivp ,start (1+ ,start))
(1+ count))
(sequence (if ,ivp sequence (cdr sequence))
(cdr sequence))
(value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
(funcall ,function (apply-key ,key (car sequence)) value)))
- ((= count (the fixnum ,end)) value)
- (declare (fixnum count)))))
+ ((>= count ,end) value))))
) ; EVAL-WHEN
(define-sequence-traverser remove-if
(predicate sequence &key from-end start end count key)
#!+sb-doc
- "Return a copy of sequence with elements such that predicate(element)
- is non-null removed"
+ "Return a copy of sequence with elements satisfying PREDICATE removed."
(declare (fixnum start))
(let ((end (or end length)))
(declare (type index end))
(define-sequence-traverser remove-if-not
(predicate sequence &key from-end start end count key)
#!+sb-doc
- "Return a copy of sequence with elements such that predicate(element)
- is null removed"
+ "Return a copy of sequence with elements not satisfying PREDICATE removed."
(declare (fixnum start))
(let ((end (or end length)))
(declare (type index end))
(declare (fixnum index))
(setq splice (cdr (rplacd splice (list (car current)))))
(setq current (cdr current)))
- (do ((index 0 (1+ index)))
+ (do ((index start (1+ index)))
((or (and end (= index (the fixnum end)))
(atom current)))
(declare (fixnum index))
start count end key)
#!+sb-doc
"Return a sequence of the same kind as SEQUENCE with the same elements,
- except that all elements equal to OLD are replaced with NEW. See manual
- for details."
+ except that all elements equal to OLD are replaced with NEW."
(declare (fixnum start))
(let ((end (or end length)))
(declare (type index end))
;;;; SUBSTITUTE-IF, SUBSTITUTE-IF-NOT
(define-sequence-traverser substitute-if
- (new pred sequence &key from-end start end count key)
+ (new predicate sequence &key from-end start end count key)
#!+sb-doc
"Return a sequence of the same kind as SEQUENCE with the same elements
- except that all elements satisfying the PRED are replaced with NEW. See
- manual for details."
+ except that all elements satisfying the PRED are replaced with NEW."
(declare (fixnum start))
(let ((end (or end length))
- (test pred)
- test-not
+ (test predicate)
+ (test-not nil)
old)
(declare (type index length end))
(subst-dispatch 'if)))
(define-sequence-traverser substitute-if-not
- (new pred sequence &key from-end start end count key)
+ (new predicate sequence &key from-end start end count key)
#!+sb-doc
"Return a sequence of the same kind as SEQUENCE with the same elements
- except that all elements not satisfying the PRED are replaced with NEW.
- See manual for details."
+ except that all elements not satisfying the PRED are replaced with NEW."
(declare (fixnum start))
(let ((end (or end length))
- (test pred)
- test-not
+ (test predicate)
+ (test-not nil)
old)
(declare (type index length end))
(subst-dispatch 'if-not)))
end count key start)
#!+sb-doc
"Return a sequence of the same kind as SEQUENCE with the same elements
- except that all elements equal to OLD are replaced with NEW. The SEQUENCE
- may be destructively modified. See manual for details."
+ except that all elements equal to OLD are replaced with NEW. SEQUENCE
+ may be destructively modified."
(declare (fixnum start))
(let ((end (or end length)))
(if (listp sequence)
;;;; NSUBSTITUTE-IF, NSUBSTITUTE-IF-NOT
(define-sequence-traverser nsubstitute-if
- (new pred sequence &key from-end start end count key)
+ (new predicate sequence &key from-end start end count key)
#!+sb-doc
"Return a sequence of the same kind as SEQUENCE with the same elements
- except that all elements satisfying the PRED are replaced with NEW.
- SEQUENCE may be destructively modified. See manual for details."
+ except that all elements satisfying PREDICATE are replaced with NEW.
+ SEQUENCE may be destructively modified."
(declare (fixnum start))
(let ((end (or end length)))
(declare (fixnum end))
(if from-end
(let ((length (length sequence)))
(nreverse (nlist-substitute-if*
- new pred (nreverse (the list sequence))
+ new predicate (nreverse (the list sequence))
(- length end) (- length start) count key)))
- (nlist-substitute-if* new pred sequence
+ (nlist-substitute-if* new predicate sequence
start end count key))
(if from-end
- (nvector-substitute-if* new pred sequence -1
+ (nvector-substitute-if* new predicate sequence -1
(1- end) (1- start) count key)
- (nvector-substitute-if* new pred sequence 1
+ (nvector-substitute-if* new predicate sequence 1
start end count key)))))
(defun nlist-substitute-if* (new test sequence start end count key)
(setq count (1- count)))))
(define-sequence-traverser nsubstitute-if-not
- (new pred sequence &key from-end start end count key)
+ (new predicate sequence &key from-end start end count key)
#!+sb-doc
"Return a sequence of the same kind as SEQUENCE with the same elements
- except that all elements not satisfying the TEST are replaced with NEW.
- SEQUENCE may be destructively modified. See manual for details."
+ except that all elements not satisfying PREDICATE are replaced with NEW.
+ SEQUENCE may be destructively modified."
(declare (fixnum start))
(let ((end (or end length)))
(declare (fixnum end))
(if from-end
(let ((length (length sequence)))
(nreverse (nlist-substitute-if-not*
- new pred (nreverse (the list sequence))
+ new predicate (nreverse (the list sequence))
(- length end) (- length start) count key)))
- (nlist-substitute-if-not* new pred sequence
+ (nlist-substitute-if-not* new predicate sequence
start end count key))
(if from-end
- (nvector-substitute-if-not* new pred sequence -1
+ (nvector-substitute-if-not* new predicate sequence -1
(1- end) (1- start) count key)
- (nvector-substitute-if-not* new pred sequence 1
+ (nvector-substitute-if-not* new predicate sequence 1
start end count key)))))
(defun nlist-substitute-if-not* (new test sequence start end count key)
(simple-base-string (frob2))
(t (vector*-frob sequence))))
(declare (type (or index null) p))
- (values f (and p (the index (+ p offset))))))))))
+ (values f (and p (the index (- p offset))))))))))
(defun %find-position (item sequence-arg from-end start end key test)
(macrolet ((frob (sequence from-end)
`(%find-position item ,sequence
#!+sb-doc
"Return the number of elements in SEQUENCE satisfying PRED(el)."
(declare (fixnum start))
- (let ((end (or end length)))
+ (let ((end (or end length))
+ (pred (%coerce-callable-to-fun pred)))
(declare (type index end))
(seq-dispatch sequence
(if from-end
#!+sb-doc
"Return the number of elements in SEQUENCE not satisfying TEST(el)."
(declare (fixnum start))
- (let ((end (or end length)))
+ (let ((end (or end length))
+ (pred (%coerce-callable-to-fun pred)))
(declare (type index end))
(seq-dispatch sequence
(if from-end
projects / sbcl.git / blobdiff