aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/emacs-lisp/cl-seq.el70
-rw-r--r--test/lisp/emacs-lisp/cl-seq-tests.el1
2 files changed, 39 insertions, 32 deletions
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index ed27b7c7d05..3f8b1eec66e 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -151,8 +151,8 @@ called.
151 (cl--parsing-keywords ((:start 0) :end) () 151 (cl--parsing-keywords ((:start 0) :end) ()
152 (if (listp cl-seq) 152 (if (listp cl-seq)
153 (let ((p (nthcdr cl-start cl-seq)) 153 (let ((p (nthcdr cl-start cl-seq))
154 (n (if cl-end (- cl-end cl-start) 8000000))) 154 (n (and cl-end (- cl-end cl-start))))
155 (while (and p (>= (setq n (1- n)) 0)) 155 (while (and p (or (null n) (>= (cl-decf n) 0)))
156 (setcar p cl-item) 156 (setcar p cl-item)
157 (setq p (cdr p)))) 157 (setq p (cdr p))))
158 (or cl-end (setq cl-end (length cl-seq))) 158 (or cl-end (setq cl-end (length cl-seq)))
@@ -180,16 +180,20 @@ SEQ1 is destructively modified, then returned.
180 (elt cl-seq2 (+ cl-start2 cl-n)))))) 180 (elt cl-seq2 (+ cl-start2 cl-n))))))
181 (if (listp cl-seq1) 181 (if (listp cl-seq1)
182 (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) 182 (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
183 (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) 183 (cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
184 (if (listp cl-seq2) 184 (if (listp cl-seq2)
185 (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) 185 (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
186 (cl-n (min cl-n1 186 (cl-n (cond ((and cl-n1 cl-end2)
187 (if cl-end2 (- cl-end2 cl-start2) 4000000)))) 187 (min cl-n1 (- cl-end2 cl-start2)))
188 (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) 188 ((and cl-n1 (null cl-end2)) cl-n1)
189 ((and (null cl-n1) cl-end2) (- cl-end2 cl-start2)))))
190 (while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 0)))
189 (setcar cl-p1 (car cl-p2)) 191 (setcar cl-p1 (car cl-p2))
190 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) 192 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
191 (setq cl-end2 (min (or cl-end2 (length cl-seq2)) 193 (setq cl-end2 (if (null cl-n1)
192 (+ cl-start2 cl-n1))) 194 (or cl-end2 (length cl-seq2))
195 (min (or cl-end2 (length cl-seq2))
196 (+ cl-start2 cl-n1))))
193 (while (and cl-p1 (< cl-start2 cl-end2)) 197 (while (and cl-p1 (< cl-start2 cl-end2))
194 (setcar cl-p1 (aref cl-seq2 cl-start2)) 198 (setcar cl-p1 (aref cl-seq2 cl-start2))
195 (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) 199 (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
@@ -215,9 +219,10 @@ to avoid corrupting the original SEQ.
215\n(fn ITEM SEQ [KEYWORD VALUE]...)" 219\n(fn ITEM SEQ [KEYWORD VALUE]...)"
216 (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end 220 (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
217 (:start 0) :end) () 221 (:start 0) :end) ()
218 (if (<= (or cl-count (setq cl-count 8000000)) 0) 222 (let ((len (length cl-seq)))
223 (if (<= (or cl-count (setq cl-count len)) 0)
219 cl-seq 224 cl-seq
220 (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) 225 (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2))))
221 (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end 226 (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end
222 cl-from-end))) 227 cl-from-end)))
223 (if cl-i 228 (if cl-i
@@ -229,7 +234,7 @@ to avoid corrupting the original SEQ.
229 (if (listp cl-seq) cl-res 234 (if (listp cl-seq) cl-res
230 (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) 235 (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
231 cl-seq)) 236 cl-seq))
232 (setq cl-end (- (or cl-end 8000000) cl-start)) 237 (setq cl-end (- (or cl-end len) cl-start))
233 (if (= cl-start 0) 238 (if (= cl-start 0)
234 (while (and cl-seq (> cl-end 0) 239 (while (and cl-seq (> cl-end 0)
235 (cl--check-test cl-item (car cl-seq)) 240 (cl--check-test cl-item (car cl-seq))
@@ -250,7 +255,7 @@ to avoid corrupting the original SEQ.
250 :start 0 :end (1- cl-end) 255 :start 0 :end (1- cl-end)
251 :count (1- cl-count) cl-keys)))) 256 :count (1- cl-count) cl-keys))))
252 cl-seq)) 257 cl-seq))
253 cl-seq))))) 258 cl-seq))))))
254 259
255;;;###autoload 260;;;###autoload
256(defun cl-remove-if (cl-pred cl-list &rest cl-keys) 261(defun cl-remove-if (cl-pred cl-list &rest cl-keys)
@@ -278,20 +283,21 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
278\n(fn ITEM SEQ [KEYWORD VALUE]...)" 283\n(fn ITEM SEQ [KEYWORD VALUE]...)"
279 (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end 284 (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
280 (:start 0) :end) () 285 (:start 0) :end) ()
281 (if (<= (or cl-count (setq cl-count 8000000)) 0) 286 (let ((len (length cl-seq)))
287 (if (<= (or cl-count (setq cl-count len)) 0)
282 cl-seq 288 cl-seq
283 (if (listp cl-seq) 289 (if (listp cl-seq)
284 (if (and cl-from-end (< cl-count 4000000)) 290 (if (and cl-from-end (< cl-count (/ len 2)))
285 (let (cl-i) 291 (let (cl-i)
286 (while (and (>= (setq cl-count (1- cl-count)) 0) 292 (while (and (>= (setq cl-count (1- cl-count)) 0)
287 (setq cl-i (cl--position cl-item cl-seq cl-start 293 (setq cl-i (cl--position cl-item cl-seq cl-start
288 cl-end cl-from-end))) 294 cl-end cl-from-end)))
289 (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) 295 (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
290 (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) 296 (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
291 (setcdr cl-tail (cdr (cdr cl-tail))))) 297 (setcdr cl-tail (cdr (cdr cl-tail)))))
292 (setq cl-end cl-i)) 298 (setq cl-end cl-i))
293 cl-seq) 299 cl-seq)
294 (setq cl-end (- (or cl-end 8000000) cl-start)) 300 (setq cl-end (- (or cl-end len) cl-start))
295 (if (= cl-start 0) 301 (if (= cl-start 0)
296 (progn 302 (progn
297 (while (and cl-seq 303 (while (and cl-seq
@@ -312,7 +318,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
312 (setq cl-p (cdr cl-p))) 318 (setq cl-p (cdr cl-p)))
313 (setq cl-end (1- cl-end))))) 319 (setq cl-end (1- cl-end)))))
314 cl-seq) 320 cl-seq)
315 (apply 'cl-remove cl-item cl-seq cl-keys))))) 321 (apply 'cl-remove cl-item cl-seq cl-keys))))))
316 322
317;;;###autoload 323;;;###autoload
318(defun cl-delete-if (cl-pred cl-list &rest cl-keys) 324(defun cl-delete-if (cl-pred cl-list &rest cl-keys)
@@ -396,15 +402,17 @@ to avoid corrupting the original SEQ.
396 (cl--parsing-keywords (:test :test-not :key :if :if-not :count 402 (cl--parsing-keywords (:test :test-not :key :if :if-not :count
397 (:start 0) :end :from-end) () 403 (:start 0) :end :from-end) ()
398 (if (or (eq cl-old cl-new) 404 (if (or (eq cl-old cl-new)
399 (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) 405 (<= (or cl-count (setq cl-from-end nil
406 cl-count (length cl-seq))) 0))
400 cl-seq 407 cl-seq
401 (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end))) 408 (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end)))
402 (if (not cl-i) 409 (if (not cl-i)
403 cl-seq 410 cl-seq
404 (setq cl-seq (copy-sequence cl-seq)) 411 (setq cl-seq (copy-sequence cl-seq))
405 (or cl-from-end 412 (unless cl-from-end
406 (progn (setf (elt cl-seq cl-i) cl-new) 413 (setf (elt cl-seq cl-i) cl-new)
407 (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) 414 (cl-incf cl-i)
415 (cl-decf cl-count))
408 (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count 416 (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
409 :start cl-i cl-keys)))))) 417 :start cl-i cl-keys))))))
410 418
@@ -434,17 +442,18 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
434\n(fn NEW OLD SEQ [KEYWORD VALUE]...)" 442\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
435 (cl--parsing-keywords (:test :test-not :key :if :if-not :count 443 (cl--parsing-keywords (:test :test-not :key :if :if-not :count
436 (:start 0) :end :from-end) () 444 (:start 0) :end :from-end) ()
437 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) 445 (let ((len (length cl-seq)))
438 (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) 446 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0)
447 (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2))))
439 (let ((cl-p (nthcdr cl-start cl-seq))) 448 (let ((cl-p (nthcdr cl-start cl-seq)))
440 (setq cl-end (- (or cl-end 8000000) cl-start)) 449 (setq cl-end (- (or cl-end len) cl-start))
441 (while (and cl-p (> cl-end 0) (> cl-count 0)) 450 (while (and cl-p (> cl-end 0) (> cl-count 0))
442 (if (cl--check-test cl-old (car cl-p)) 451 (if (cl--check-test cl-old (car cl-p))
443 (progn 452 (progn
444 (setcar cl-p cl-new) 453 (setcar cl-p cl-new)
445 (setq cl-count (1- cl-count)))) 454 (setq cl-count (1- cl-count))))
446 (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) 455 (setq cl-p (cdr cl-p) cl-end (1- cl-end))))
447 (or cl-end (setq cl-end (length cl-seq))) 456 (or cl-end (setq cl-end len))
448 (if cl-from-end 457 (if cl-from-end
449 (while (and (< cl-start cl-end) (> cl-count 0)) 458 (while (and (< cl-start cl-end) (> cl-count 0))
450 (setq cl-end (1- cl-end)) 459 (setq cl-end (1- cl-end))
@@ -457,7 +466,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
457 (progn 466 (progn
458 (aset cl-seq cl-start cl-new) 467 (aset cl-seq cl-start cl-new)
459 (setq cl-count (1- cl-count)))) 468 (setq cl-count (1- cl-count))))
460 (setq cl-start (1+ cl-start)))))) 469 (setq cl-start (1+ cl-start)))))))
461 cl-seq)) 470 cl-seq))
462 471
463;;;###autoload 472;;;###autoload
@@ -513,14 +522,13 @@ Return the index of the matching item, or nil if not found.
513 522
514(defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end) 523(defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
515 (if (listp cl-seq) 524 (if (listp cl-seq)
516 (let ((cl-p (nthcdr cl-start cl-seq))) 525 (let ((cl-p (nthcdr cl-start cl-seq))
517 (or cl-end (setq cl-end 8000000)) 526 cl-res)
518 (let ((cl-res nil)) 527 (while (and cl-p (or (null cl-end) (< cl-start cl-end)) (or (null cl-res) cl-from-end))
519 (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
520 (if (cl--check-test cl-item (car cl-p)) 528 (if (cl--check-test cl-item (car cl-p))
521 (setq cl-res cl-start)) 529 (setq cl-res cl-start))
522 (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) 530 (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
523 cl-res)) 531 cl-res)
524 (or cl-end (setq cl-end (length cl-seq))) 532 (or cl-end (setq cl-end (length cl-seq)))
525 (if cl-from-end 533 (if cl-from-end
526 (progn 534 (progn
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index cc393f40583..02d9246db21 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -294,7 +294,6 @@ Body are forms defining the test."
294 294
295(ert-deftest cl-seq-test-bug24264 () 295(ert-deftest cl-seq-test-bug24264 ()
296 "Test for http://debbugs.gnu.org/24264 ." 296 "Test for http://debbugs.gnu.org/24264 ."
297 :expected-result :failed
298 (let ((list (append (make-list 8000005 1) '(8))) 297 (let ((list (append (make-list 8000005 1) '(8)))
299 (list2 (make-list 8000005 2))) 298 (list2 (make-list 8000005 2)))
300 (should (cl-position 8 list)) 299 (should (cl-position 8 list))