Don't purify in Fmake_byte_code.
[bpt/emacs.git] / lisp / emacs-lisp / cl-seq.el
CommitLineData
08f5e965 1;;; cl-seq.el --- Common Lisp features, part 3
fcd73769 2
acaf905b 3;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
fcd73769
RS
4
5;; Author: Dave Gillespie <daveg@synaptics.com>
6;; Version: 2.02
7;; Keywords: extensions
bd78fa1d 8;; Package: emacs
fcd73769
RS
9
10;; This file is part of GNU Emacs.
11
d6cba7ae 12;; GNU Emacs is free software: you can redistribute it and/or modify
fcd73769 13;; it under the terms of the GNU General Public License as published by
d6cba7ae
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
fcd73769
RS
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
d6cba7ae 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
fcd73769 24
07b3798c 25;;; Commentary:
fcd73769
RS
26
27;; These are extensions to Emacs Lisp that provide a degree of
28;; Common Lisp compatibility, beyond what is already built-in
29;; in Emacs Lisp.
30;;
31;; This package was written by Dave Gillespie; it is a complete
32;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
33;;
fcd73769
RS
34;; Bug reports, comments, and suggestions are welcome!
35
36;; This file contains the Common Lisp sequence and list functions
37;; which take keyword arguments.
38
39;; See cl.el for Change Log.
40
41
07b3798c 42;;; Code:
fcd73769 43
7c1898a7 44(require 'cl-lib)
fcd73769 45
fcd73769
RS
46;;; Keyword parsing. This is special-cased here so that we can compile
47;;; this file independent from cl-macs.
48
49(defmacro cl-parsing-keywords (kwords other-keys &rest body)
f291fe60 50 (declare (indent 2) (debug (sexp sexp &rest form)))
fcd73769
RS
51 (cons
52 'let*
53 (cons (mapcar
54 (function
55 (lambda (x)
56 (let* ((var (if (consp x) (car x) x))
57 (mem (list 'car (list 'cdr (list 'memq (list 'quote var)
58 'cl-keys)))))
64a4c526 59 (if (eq var :test-not)
fcd73769 60 (setq mem (list 'and mem (list 'setq 'cl-test mem) t)))
64a4c526 61 (if (eq var :if-not)
fcd73769
RS
62 (setq mem (list 'and mem (list 'setq 'cl-if mem) t)))
63 (list (intern
64 (format "cl-%s" (substring (symbol-name var) 1)))
65 (if (consp x) (list 'or mem (car (cdr x))) mem)))))
66 kwords)
67 (append
68 (and (not (eq other-keys t))
69 (list
70 (list 'let '((cl-keys-temp cl-keys))
71 (list 'while 'cl-keys-temp
72 (list 'or (list 'memq '(car cl-keys-temp)
73 (list 'quote
74 (mapcar
75 (function
76 (lambda (x)
77 (if (consp x)
78 (car x) x)))
79 (append kwords
80 other-keys))))
81 '(car (cdr (memq (quote :allow-other-keys)
82 cl-keys)))
83 '(error "Bad keyword argument %s"
84 (car cl-keys-temp)))
85 '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
86 body))))
fcd73769
RS
87
88(defmacro cl-check-key (x)
f291fe60 89 (declare (debug edebug-forms))
fcd73769
RS
90 (list 'if 'cl-key (list 'funcall 'cl-key x) x))
91
92(defmacro cl-check-test-nokey (item x)
f291fe60 93 (declare (debug edebug-forms))
fcd73769
RS
94 (list 'cond
95 (list 'cl-test
96 (list 'eq (list 'not (list 'funcall 'cl-test item x))
97 'cl-test-not))
98 (list 'cl-if
99 (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not))
100 (list 't (list 'if (list 'numberp item)
101 (list 'equal item x) (list 'eq item x)))))
102
103(defmacro cl-check-test (item x)
f291fe60 104 (declare (debug edebug-forms))
fcd73769
RS
105 (list 'cl-check-test-nokey item (list 'cl-check-key x)))
106
107(defmacro cl-check-match (x y)
f291fe60 108 (declare (debug edebug-forms))
fcd73769
RS
109 (setq x (list 'cl-check-key x) y (list 'cl-check-key y))
110 (list 'if 'cl-test
111 (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not)
112 (list 'if (list 'numberp x)
113 (list 'equal x y) (list 'eq x y))))
114
fcd73769
RS
115(defvar cl-test) (defvar cl-test-not)
116(defvar cl-if) (defvar cl-if-not)
117(defvar cl-key)
118
119
323698cc 120;;;###autoload
7c1898a7 121(defun cl-reduce (cl-func cl-seq &rest cl-keys)
47bc4b3f
JB
122 "Reduce two-argument FUNCTION across SEQ.
123\nKeywords supported: :start :end :from-end :initial-value :key
124\n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
fcd73769
RS
125 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
126 (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
7c1898a7 127 (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
fcd73769 128 (if cl-from-end (setq cl-seq (nreverse cl-seq)))
64a4c526 129 (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
ca50d9e6 130 (cl-seq (cl-check-key (pop cl-seq)))
fcd73769
RS
131 (t (funcall cl-func)))))
132 (if cl-from-end
133 (while cl-seq
ca50d9e6 134 (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
fcd73769
RS
135 cl-accum)))
136 (while cl-seq
137 (setq cl-accum (funcall cl-func cl-accum
ca50d9e6 138 (cl-check-key (pop cl-seq))))))
fcd73769
RS
139 cl-accum)))
140
323698cc 141;;;###autoload
7c1898a7 142(defun cl-fill (seq item &rest cl-keys)
fcd73769 143 "Fill the elements of SEQ with ITEM.
47bc4b3f
JB
144\nKeywords supported: :start :end
145\n(fn SEQ ITEM [KEYWORD VALUE]...)"
fcd73769
RS
146 (cl-parsing-keywords ((:start 0) :end) ()
147 (if (listp seq)
148 (let ((p (nthcdr cl-start seq))
149 (n (if cl-end (- cl-end cl-start) 8000000)))
150 (while (and p (>= (setq n (1- n)) 0))
151 (setcar p item)
152 (setq p (cdr p))))
153 (or cl-end (setq cl-end (length seq)))
154 (if (and (= cl-start 0) (= cl-end (length seq)))
155 (fillarray seq item)
156 (while (< cl-start cl-end)
157 (aset seq cl-start item)
158 (setq cl-start (1+ cl-start)))))
159 seq))
160
323698cc 161;;;###autoload
7c1898a7 162(defun cl-replace (cl-seq1 cl-seq2 &rest cl-keys)
fcd73769
RS
163 "Replace the elements of SEQ1 with the elements of SEQ2.
164SEQ1 is destructively modified, then returned.
47bc4b3f
JB
165\nKeywords supported: :start1 :end1 :start2 :end2
166\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
fcd73769
RS
167 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
168 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
169 (or (= cl-start1 cl-start2)
170 (let* ((cl-len (length cl-seq1))
171 (cl-n (min (- (or cl-end1 cl-len) cl-start1)
172 (- (or cl-end2 cl-len) cl-start2))))
173 (while (>= (setq cl-n (1- cl-n)) 0)
174 (cl-set-elt cl-seq1 (+ cl-start1 cl-n)
175 (elt cl-seq2 (+ cl-start2 cl-n))))))
176 (if (listp cl-seq1)
177 (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
178 (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
179 (if (listp cl-seq2)
180 (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
181 (cl-n (min cl-n1
182 (if cl-end2 (- cl-end2 cl-start2) 4000000))))
183 (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
184 (setcar cl-p1 (car cl-p2))
185 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
186 (setq cl-end2 (min (or cl-end2 (length cl-seq2))
187 (+ cl-start2 cl-n1)))
188 (while (and cl-p1 (< cl-start2 cl-end2))
189 (setcar cl-p1 (aref cl-seq2 cl-start2))
190 (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
191 (setq cl-end1 (min (or cl-end1 (length cl-seq1))
192 (+ cl-start1 (- (or cl-end2 (length cl-seq2))
193 cl-start2))))
194 (if (listp cl-seq2)
195 (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
196 (while (< cl-start1 cl-end1)
197 (aset cl-seq1 cl-start1 (car cl-p2))
198 (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
199 (while (< cl-start1 cl-end1)
200 (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
201 (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
202 cl-seq1))
203
323698cc 204;;;###autoload
7c1898a7 205(defun cl-remove (cl-item cl-seq &rest cl-keys)
fcd73769
RS
206 "Remove all occurrences of ITEM in SEQ.
207This is a non-destructive function; it makes a copy of SEQ if necessary
208to avoid corrupting the original SEQ.
47bc4b3f
JB
209\nKeywords supported: :test :test-not :key :count :start :end :from-end
210\n(fn ITEM SEQ [KEYWORD VALUE]...)"
fcd73769
RS
211 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
212 (:start 0) :end) ()
213 (if (<= (or cl-count (setq cl-count 8000000)) 0)
214 cl-seq
215 (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
4735906a
SM
216 (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end
217 cl-from-end)))
fcd73769 218 (if cl-i
7c1898a7 219 (let ((cl-res (apply 'cl-delete cl-item (append cl-seq nil)
fcd73769 220 (append (if cl-from-end
64a4c526
DL
221 (list :end (1+ cl-i))
222 (list :start cl-i))
fcd73769
RS
223 cl-keys))))
224 (if (listp cl-seq) cl-res
225 (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
226 cl-seq))
227 (setq cl-end (- (or cl-end 8000000) cl-start))
228 (if (= cl-start 0)
229 (while (and cl-seq (> cl-end 0)
230 (cl-check-test cl-item (car cl-seq))
231 (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
232 (> (setq cl-count (1- cl-count)) 0))))
233 (if (and (> cl-count 0) (> cl-end 0))
234 (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
235 (setq cl-end (1- cl-end)) (cdr cl-seq))))
236 (while (and cl-p (> cl-end 0)
237 (not (cl-check-test cl-item (car cl-p))))
238 (setq cl-p (cdr cl-p) cl-end (1- cl-end)))
239 (if (and cl-p (> cl-end 0))
7c1898a7 240 (nconc (cl-ldiff cl-seq cl-p)
fcd73769
RS
241 (if (= cl-count 1) (cdr cl-p)
242 (and (cdr cl-p)
7c1898a7 243 (apply 'cl-delete cl-item
fcd73769 244 (copy-sequence (cdr cl-p))
64a4c526
DL
245 :start 0 :end (1- cl-end)
246 :count (1- cl-count) cl-keys))))
fcd73769
RS
247 cl-seq))
248 cl-seq)))))
249
323698cc 250;;;###autoload
7c1898a7 251(defun cl-remove-if (cl-pred cl-list &rest cl-keys)
fcd73769
RS
252 "Remove all items satisfying PREDICATE in SEQ.
253This is a non-destructive function; it makes a copy of SEQ if necessary
254to avoid corrupting the original SEQ.
47bc4b3f
JB
255\nKeywords supported: :key :count :start :end :from-end
256\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 257 (apply 'cl-remove nil cl-list :if cl-pred cl-keys))
fcd73769 258
323698cc 259;;;###autoload
7c1898a7 260(defun cl-remove-if-not (cl-pred cl-list &rest cl-keys)
fcd73769
RS
261 "Remove all items not satisfying PREDICATE in SEQ.
262This is a non-destructive function; it makes a copy of SEQ if necessary
263to avoid corrupting the original SEQ.
47bc4b3f
JB
264\nKeywords supported: :key :count :start :end :from-end
265\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 266 (apply 'cl-remove nil cl-list :if-not cl-pred cl-keys))
fcd73769 267
323698cc 268;;;###autoload
7c1898a7 269(defun cl-delete (cl-item cl-seq &rest cl-keys)
fcd73769
RS
270 "Remove all occurrences of ITEM in SEQ.
271This is a destructive function; it reuses the storage of SEQ whenever possible.
47bc4b3f
JB
272\nKeywords supported: :test :test-not :key :count :start :end :from-end
273\n(fn ITEM SEQ [KEYWORD VALUE]...)"
fcd73769
RS
274 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
275 (:start 0) :end) ()
276 (if (<= (or cl-count (setq cl-count 8000000)) 0)
277 cl-seq
278 (if (listp cl-seq)
279 (if (and cl-from-end (< cl-count 4000000))
280 (let (cl-i)
281 (while (and (>= (setq cl-count (1- cl-count)) 0)
4735906a
SM
282 (setq cl-i (cl--position cl-item cl-seq cl-start
283 cl-end cl-from-end)))
fcd73769
RS
284 (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
285 (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
286 (setcdr cl-tail (cdr (cdr cl-tail)))))
287 (setq cl-end cl-i))
288 cl-seq)
289 (setq cl-end (- (or cl-end 8000000) cl-start))
290 (if (= cl-start 0)
291 (progn
292 (while (and cl-seq
293 (> cl-end 0)
294 (cl-check-test cl-item (car cl-seq))
295 (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
296 (> (setq cl-count (1- cl-count)) 0)))
297 (setq cl-end (1- cl-end)))
298 (setq cl-start (1- cl-start)))
299 (if (and (> cl-count 0) (> cl-end 0))
300 (let ((cl-p (nthcdr cl-start cl-seq)))
301 (while (and (cdr cl-p) (> cl-end 0))
302 (if (cl-check-test cl-item (car (cdr cl-p)))
303 (progn
304 (setcdr cl-p (cdr (cdr cl-p)))
305 (if (= (setq cl-count (1- cl-count)) 0)
306 (setq cl-end 1)))
307 (setq cl-p (cdr cl-p)))
308 (setq cl-end (1- cl-end)))))
309 cl-seq)
7c1898a7 310 (apply 'cl-remove cl-item cl-seq cl-keys)))))
fcd73769 311
323698cc 312;;;###autoload
7c1898a7 313(defun cl-delete-if (cl-pred cl-list &rest cl-keys)
fcd73769
RS
314 "Remove all items satisfying PREDICATE in SEQ.
315This is a destructive function; it reuses the storage of SEQ whenever possible.
47bc4b3f
JB
316\nKeywords supported: :key :count :start :end :from-end
317\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 318 (apply 'cl-delete nil cl-list :if cl-pred cl-keys))
fcd73769 319
323698cc 320;;;###autoload
7c1898a7 321(defun cl-delete-if-not (cl-pred cl-list &rest cl-keys)
fcd73769
RS
322 "Remove all items not satisfying PREDICATE in SEQ.
323This is a destructive function; it reuses the storage of SEQ whenever possible.
47bc4b3f
JB
324\nKeywords supported: :key :count :start :end :from-end
325\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 326 (apply 'cl-delete nil cl-list :if-not cl-pred cl-keys))
fcd73769 327
323698cc 328;;;###autoload
7c1898a7 329(defun cl-remove-duplicates (cl-seq &rest cl-keys)
fcd73769 330 "Return a copy of SEQ with all duplicate elements removed.
47bc4b3f
JB
331\nKeywords supported: :test :test-not :key :start :end :from-end
332\n(fn SEQ [KEYWORD VALUE]...)"
4735906a 333 (cl--delete-duplicates cl-seq cl-keys t))
fcd73769 334
323698cc 335;;;###autoload
7c1898a7 336(defun cl-delete-duplicates (cl-seq &rest cl-keys)
fcd73769 337 "Remove all duplicate elements from SEQ (destructively).
47bc4b3f
JB
338\nKeywords supported: :test :test-not :key :start :end :from-end
339\n(fn SEQ [KEYWORD VALUE]...)"
4735906a 340 (cl--delete-duplicates cl-seq cl-keys nil))
fcd73769 341
4735906a 342(defun cl--delete-duplicates (cl-seq cl-keys cl-copy)
fcd73769
RS
343 (if (listp cl-seq)
344 (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
345 ()
346 (if cl-from-end
347 (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
348 (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
349 (while (> cl-end 1)
350 (setq cl-i 0)
4735906a
SM
351 (while (setq cl-i (cl--position (cl-check-key (car cl-p))
352 (cdr cl-p) cl-i (1- cl-end)))
fcd73769
RS
353 (if cl-copy (setq cl-seq (copy-sequence cl-seq)
354 cl-p (nthcdr cl-start cl-seq) cl-copy nil))
355 (let ((cl-tail (nthcdr cl-i cl-p)))
356 (setcdr cl-tail (cdr (cdr cl-tail))))
357 (setq cl-end (1- cl-end)))
358 (setq cl-p (cdr cl-p) cl-end (1- cl-end)
359 cl-start (1+ cl-start)))
360 cl-seq)
361 (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
362 (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
4735906a
SM
363 (cl--position (cl-check-key (car cl-seq))
364 (cdr cl-seq) 0 (1- cl-end)))
fcd73769
RS
365 (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
366 (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
367 (setq cl-end (1- cl-end) cl-start 1) cl-seq)))
368 (while (and (cdr (cdr cl-p)) (> cl-end 1))
4735906a
SM
369 (if (cl--position (cl-check-key (car (cdr cl-p)))
370 (cdr (cdr cl-p)) 0 (1- cl-end))
fcd73769
RS
371 (progn
372 (if cl-copy (setq cl-seq (copy-sequence cl-seq)
373 cl-p (nthcdr (1- cl-start) cl-seq)
374 cl-copy nil))
375 (setcdr cl-p (cdr (cdr cl-p))))
376 (setq cl-p (cdr cl-p)))
377 (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
378 cl-seq)))
4735906a 379 (let ((cl-res (cl--delete-duplicates (append cl-seq nil) cl-keys nil)))
fcd73769
RS
380 (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
381
323698cc 382;;;###autoload
7c1898a7 383(defun cl-substitute (cl-new cl-old cl-seq &rest cl-keys)
fcd73769
RS
384 "Substitute NEW for OLD in SEQ.
385This is a non-destructive function; it makes a copy of SEQ if necessary
386to avoid corrupting the original SEQ.
47bc4b3f
JB
387\nKeywords supported: :test :test-not :key :count :start :end :from-end
388\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
fcd73769
RS
389 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
390 (:start 0) :end :from-end) ()
391 (if (or (eq cl-old cl-new)
392 (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
393 cl-seq
4735906a 394 (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end)))
fcd73769
RS
395 (if (not cl-i)
396 cl-seq
397 (setq cl-seq (copy-sequence cl-seq))
398 (or cl-from-end
399 (progn (cl-set-elt cl-seq cl-i cl-new)
400 (setq cl-i (1+ cl-i) cl-count (1- cl-count))))
7c1898a7 401 (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
64a4c526 402 :start cl-i cl-keys))))))
fcd73769 403
323698cc 404;;;###autoload
7c1898a7 405(defun cl-substitute-if (cl-new cl-pred cl-list &rest cl-keys)
fcd73769
RS
406 "Substitute NEW for all items satisfying PREDICATE in SEQ.
407This is a non-destructive function; it makes a copy of SEQ if necessary
408to avoid corrupting the original SEQ.
47bc4b3f
JB
409\nKeywords supported: :key :count :start :end :from-end
410\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 411 (apply 'cl-substitute cl-new nil cl-list :if cl-pred cl-keys))
fcd73769 412
323698cc 413;;;###autoload
7c1898a7 414(defun cl-substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
fcd73769
RS
415 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
416This is a non-destructive function; it makes a copy of SEQ if necessary
417to avoid corrupting the original SEQ.
47bc4b3f
JB
418\nKeywords supported: :key :count :start :end :from-end
419\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 420 (apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys))
fcd73769 421
323698cc 422;;;###autoload
7c1898a7 423(defun cl-nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
fcd73769
RS
424 "Substitute NEW for OLD in SEQ.
425This is a destructive function; it reuses the storage of SEQ whenever possible.
47bc4b3f
JB
426\nKeywords supported: :test :test-not :key :count :start :end :from-end
427\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
fcd73769
RS
428 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
429 (:start 0) :end :from-end) ()
430 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
431 (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
432 (let ((cl-p (nthcdr cl-start cl-seq)))
433 (setq cl-end (- (or cl-end 8000000) cl-start))
434 (while (and cl-p (> cl-end 0) (> cl-count 0))
435 (if (cl-check-test cl-old (car cl-p))
436 (progn
437 (setcar cl-p cl-new)
438 (setq cl-count (1- cl-count))))
439 (setq cl-p (cdr cl-p) cl-end (1- cl-end))))
440 (or cl-end (setq cl-end (length cl-seq)))
441 (if cl-from-end
442 (while (and (< cl-start cl-end) (> cl-count 0))
443 (setq cl-end (1- cl-end))
444 (if (cl-check-test cl-old (elt cl-seq cl-end))
445 (progn
446 (cl-set-elt cl-seq cl-end cl-new)
447 (setq cl-count (1- cl-count)))))
448 (while (and (< cl-start cl-end) (> cl-count 0))
449 (if (cl-check-test cl-old (aref cl-seq cl-start))
450 (progn
451 (aset cl-seq cl-start cl-new)
452 (setq cl-count (1- cl-count))))
453 (setq cl-start (1+ cl-start))))))
454 cl-seq))
455
323698cc 456;;;###autoload
7c1898a7 457(defun cl-nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
fcd73769
RS
458 "Substitute NEW for all items satisfying PREDICATE in SEQ.
459This is a destructive function; it reuses the storage of SEQ whenever possible.
47bc4b3f
JB
460\nKeywords supported: :key :count :start :end :from-end
461\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 462 (apply 'cl-nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
fcd73769 463
323698cc 464;;;###autoload
7c1898a7 465(defun cl-nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
fcd73769
RS
466 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
467This is a destructive function; it reuses the storage of SEQ whenever possible.
47bc4b3f
JB
468\nKeywords supported: :key :count :start :end :from-end
469\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 470 (apply 'cl-nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
fcd73769 471
323698cc 472;;;###autoload
7c1898a7 473(defun cl-find (cl-item cl-seq &rest cl-keys)
47bc4b3f 474 "Find the first occurrence of ITEM in SEQ.
fcd73769 475Return the matching ITEM, or nil if not found.
47bc4b3f
JB
476\nKeywords supported: :test :test-not :key :start :end :from-end
477\n(fn ITEM SEQ [KEYWORD VALUE]...)"
7c1898a7 478 (let ((cl-pos (apply 'cl-position cl-item cl-seq cl-keys)))
fcd73769
RS
479 (and cl-pos (elt cl-seq cl-pos))))
480
323698cc 481;;;###autoload
7c1898a7 482(defun cl-find-if (cl-pred cl-list &rest cl-keys)
47bc4b3f
JB
483 "Find the first item satisfying PREDICATE in SEQ.
484Return the matching item, or nil if not found.
485\nKeywords supported: :key :start :end :from-end
486\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 487 (apply 'cl-find nil cl-list :if cl-pred cl-keys))
fcd73769 488
323698cc 489;;;###autoload
7c1898a7 490(defun cl-find-if-not (cl-pred cl-list &rest cl-keys)
47bc4b3f
JB
491 "Find the first item not satisfying PREDICATE in SEQ.
492Return the matching item, or nil if not found.
493\nKeywords supported: :key :start :end :from-end
494\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 495 (apply 'cl-find nil cl-list :if-not cl-pred cl-keys))
fcd73769 496
323698cc 497;;;###autoload
7c1898a7 498(defun cl-position (cl-item cl-seq &rest cl-keys)
47bc4b3f 499 "Find the first occurrence of ITEM in SEQ.
fcd73769 500Return the index of the matching item, or nil if not found.
47bc4b3f
JB
501\nKeywords supported: :test :test-not :key :start :end :from-end
502\n(fn ITEM SEQ [KEYWORD VALUE]...)"
fcd73769
RS
503 (cl-parsing-keywords (:test :test-not :key :if :if-not
504 (:start 0) :end :from-end) ()
4735906a 505 (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
fcd73769 506
4735906a 507(defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
fcd73769
RS
508 (if (listp cl-seq)
509 (let ((cl-p (nthcdr cl-start cl-seq)))
510 (or cl-end (setq cl-end 8000000))
511 (let ((cl-res nil))
512 (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
513 (if (cl-check-test cl-item (car cl-p))
514 (setq cl-res cl-start))
515 (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
516 cl-res))
517 (or cl-end (setq cl-end (length cl-seq)))
518 (if cl-from-end
519 (progn
520 (while (and (>= (setq cl-end (1- cl-end)) cl-start)
521 (not (cl-check-test cl-item (aref cl-seq cl-end)))))
522 (and (>= cl-end cl-start) cl-end))
523 (while (and (< cl-start cl-end)
524 (not (cl-check-test cl-item (aref cl-seq cl-start))))
525 (setq cl-start (1+ cl-start)))
526 (and (< cl-start cl-end) cl-start))))
527
323698cc 528;;;###autoload
7c1898a7 529(defun cl-position-if (cl-pred cl-list &rest cl-keys)
47bc4b3f 530 "Find the first item satisfying PREDICATE in SEQ.
fcd73769 531Return the index of the matching item, or nil if not found.
47bc4b3f
JB
532\nKeywords supported: :key :start :end :from-end
533\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 534 (apply 'cl-position nil cl-list :if cl-pred cl-keys))
fcd73769 535
323698cc 536;;;###autoload
7c1898a7 537(defun cl-position-if-not (cl-pred cl-list &rest cl-keys)
47bc4b3f 538 "Find the first item not satisfying PREDICATE in SEQ.
fcd73769 539Return the index of the matching item, or nil if not found.
47bc4b3f
JB
540\nKeywords supported: :key :start :end :from-end
541\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 542 (apply 'cl-position nil cl-list :if-not cl-pred cl-keys))
fcd73769 543
323698cc 544;;;###autoload
7c1898a7 545(defun cl-count (cl-item cl-seq &rest cl-keys)
47bc4b3f
JB
546 "Count the number of occurrences of ITEM in SEQ.
547\nKeywords supported: :test :test-not :key :start :end
548\n(fn ITEM SEQ [KEYWORD VALUE]...)"
fcd73769
RS
549 (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
550 (let ((cl-count 0) cl-x)
551 (or cl-end (setq cl-end (length cl-seq)))
552 (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
553 (while (< cl-start cl-end)
ca50d9e6 554 (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
fcd73769
RS
555 (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
556 (setq cl-start (1+ cl-start)))
557 cl-count)))
558
323698cc 559;;;###autoload
7c1898a7 560(defun cl-count-if (cl-pred cl-list &rest cl-keys)
47bc4b3f
JB
561 "Count the number of items satisfying PREDICATE in SEQ.
562\nKeywords supported: :key :start :end
563\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 564 (apply 'cl-count nil cl-list :if cl-pred cl-keys))
fcd73769 565
323698cc 566;;;###autoload
7c1898a7 567(defun cl-count-if-not (cl-pred cl-list &rest cl-keys)
47bc4b3f
JB
568 "Count the number of items not satisfying PREDICATE in SEQ.
569\nKeywords supported: :key :start :end
570\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
7c1898a7 571 (apply 'cl-count nil cl-list :if-not cl-pred cl-keys))
fcd73769 572
323698cc 573;;;###autoload
7c1898a7 574(defun cl-mismatch (cl-seq1 cl-seq2 &rest cl-keys)
fcd73769
RS
575 "Compare SEQ1 with SEQ2, return index of first mismatching element.
576Return nil if the sequences match. If one sequence is a prefix of the
d22f8da4 577other, the return value indicates the end of the shorter sequence.
47bc4b3f
JB
578\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
579\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
fcd73769
RS
580 (cl-parsing-keywords (:test :test-not :key :from-end
581 (:start1 0) :end1 (:start2 0) :end2) ()
582 (or cl-end1 (setq cl-end1 (length cl-seq1)))
583 (or cl-end2 (setq cl-end2 (length cl-seq2)))
584 (if cl-from-end
585 (progn
586 (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
587 (cl-check-match (elt cl-seq1 (1- cl-end1))
588 (elt cl-seq2 (1- cl-end2))))
589 (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
590 (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
591 (1- cl-end1)))
592 (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
593 (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
594 (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
595 (cl-check-match (if cl-p1 (car cl-p1)
596 (aref cl-seq1 cl-start1))
597 (if cl-p2 (car cl-p2)
598 (aref cl-seq2 cl-start2))))
599 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
600 cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
601 (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
602 cl-start1)))))
603
323698cc 604;;;###autoload
7c1898a7 605(defun cl-search (cl-seq1 cl-seq2 &rest cl-keys)
fcd73769
RS
606 "Search for SEQ1 as a subsequence of SEQ2.
607Return the index of the leftmost element of the first match found;
608return nil if there are no matches.
47bc4b3f
JB
609\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
610\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
fcd73769
RS
611 (cl-parsing-keywords (:test :test-not :key :from-end
612 (:start1 0) :end1 (:start2 0) :end2) ()
613 (or cl-end1 (setq cl-end1 (length cl-seq1)))
614 (or cl-end2 (setq cl-end2 (length cl-seq2)))
615 (if (>= cl-start1 cl-end1)
616 (if cl-from-end cl-end2 cl-start2)
617 (let* ((cl-len (- cl-end1 cl-start1))
618 (cl-first (cl-check-key (elt cl-seq1 cl-start1)))
619 (cl-if nil) cl-pos)
620 (setq cl-end2 (- cl-end2 (1- cl-len)))
621 (while (and (< cl-start2 cl-end2)
4735906a
SM
622 (setq cl-pos (cl--position cl-first cl-seq2
623 cl-start2 cl-end2 cl-from-end))
7c1898a7 624 (apply 'cl-mismatch cl-seq1 cl-seq2
64a4c526
DL
625 :start1 (1+ cl-start1) :end1 cl-end1
626 :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
627 :from-end nil cl-keys))
fcd73769
RS
628 (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
629 (and (< cl-start2 cl-end2) cl-pos)))))
630
323698cc 631;;;###autoload
7c1898a7 632(defun cl-sort (cl-seq cl-pred &rest cl-keys)
47bc4b3f
JB
633 "Sort the argument SEQ according to PREDICATE.
634This is a destructive function; it reuses the storage of SEQ if possible.
635\nKeywords supported: :key
636\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
fcd73769 637 (if (nlistp cl-seq)
7c1898a7 638 (cl-replace cl-seq (apply 'cl-sort (append cl-seq nil) cl-pred cl-keys))
fcd73769
RS
639 (cl-parsing-keywords (:key) ()
640 (if (memq cl-key '(nil identity))
641 (sort cl-seq cl-pred)
642 (sort cl-seq (function (lambda (cl-x cl-y)
643 (funcall cl-pred (funcall cl-key cl-x)
644 (funcall cl-key cl-y)))))))))
645
323698cc 646;;;###autoload
7c1898a7 647(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
47bc4b3f
JB
648 "Sort the argument SEQ stably according to PREDICATE.
649This is a destructive function; it reuses the storage of SEQ if possible.
650\nKeywords supported: :key
651\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
7c1898a7 652 (apply 'cl-sort cl-seq cl-pred cl-keys))
fcd73769 653
323698cc 654;;;###autoload
7c1898a7 655(defun cl-merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
fcd73769 656 "Destructively merge the two sequences to produce a new sequence.
47bc4b3f
JB
657TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
658sequences, and PREDICATE is a `less-than' predicate on the elements.
659\nKeywords supported: :key
660\n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
fcd73769
RS
661 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
662 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
663 (cl-parsing-keywords (:key) ()
664 (let ((cl-res nil))
665 (while (and cl-seq1 cl-seq2)
666 (if (funcall cl-pred (cl-check-key (car cl-seq2))
667 (cl-check-key (car cl-seq1)))
ca50d9e6
SM
668 (push (pop cl-seq2) cl-res)
669 (push (pop cl-seq1) cl-res)))
7c1898a7 670 (cl-coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
fcd73769
RS
671
672;;; See compiler macro in cl-macs.el
323698cc 673;;;###autoload
7c1898a7 674(defun cl-member (cl-item cl-list &rest cl-keys)
fcd73769
RS
675 "Find the first occurrence of ITEM in LIST.
676Return the sublist of LIST whose car is ITEM.
47bc4b3f
JB
677\nKeywords supported: :test :test-not :key
678\n(fn ITEM LIST [KEYWORD VALUE]...)"
d9857e53 679 (declare (compiler-macro cl--compiler-macro-member))
fcd73769
RS
680 (if cl-keys
681 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
682 (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
683 (setq cl-list (cdr cl-list)))
684 cl-list)
685 (if (and (numberp cl-item) (not (integerp cl-item)))
686 (member cl-item cl-list)
687 (memq cl-item cl-list))))
d9857e53 688(autoload 'cl--compiler-macro-member "cl-macs")
fcd73769 689
323698cc 690;;;###autoload
7c1898a7 691(defun cl-member-if (cl-pred cl-list &rest cl-keys)
fcd73769
RS
692 "Find the first item satisfying PREDICATE in LIST.
693Return the sublist of LIST whose car matches.
47bc4b3f
JB
694\nKeywords supported: :key
695\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
7c1898a7 696 (apply 'cl-member nil cl-list :if cl-pred cl-keys))
fcd73769 697
323698cc 698;;;###autoload
7c1898a7 699(defun cl-member-if-not (cl-pred cl-list &rest cl-keys)
fcd73769
RS
700 "Find the first item not satisfying PREDICATE in LIST.
701Return the sublist of LIST whose car matches.
47bc4b3f
JB
702\nKeywords supported: :key
703\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
7c1898a7 704 (apply 'cl-member nil cl-list :if-not cl-pred cl-keys))
fcd73769 705
323698cc 706;;;###autoload
4735906a 707(defun cl--adjoin (cl-item cl-list &rest cl-keys)
fcd73769 708 (if (cl-parsing-keywords (:key) t
7c1898a7 709 (apply 'cl-member (cl-check-key cl-item) cl-list cl-keys))
fcd73769
RS
710 cl-list
711 (cons cl-item cl-list)))
712
713;;; See compiler macro in cl-macs.el
323698cc 714;;;###autoload
7c1898a7 715(defun cl-assoc (cl-item cl-alist &rest cl-keys)
fcd73769 716 "Find the first item whose car matches ITEM in LIST.
47bc4b3f
JB
717\nKeywords supported: :test :test-not :key
718\n(fn ITEM LIST [KEYWORD VALUE]...)"
d9857e53 719 (declare (compiler-macro cl--compiler-macro-assoc))
fcd73769
RS
720 (if cl-keys
721 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
722 (while (and cl-alist
723 (or (not (consp (car cl-alist)))
724 (not (cl-check-test cl-item (car (car cl-alist))))))
725 (setq cl-alist (cdr cl-alist)))
726 (and cl-alist (car cl-alist)))
727 (if (and (numberp cl-item) (not (integerp cl-item)))
728 (assoc cl-item cl-alist)
729 (assq cl-item cl-alist))))
d9857e53 730(autoload 'cl--compiler-macro-assoc "cl-macs")
fcd73769 731
323698cc 732;;;###autoload
7c1898a7 733(defun cl-assoc-if (cl-pred cl-list &rest cl-keys)
fcd73769 734 "Find the first item whose car satisfies PREDICATE in LIST.
47bc4b3f
JB
735\nKeywords supported: :key
736\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
7c1898a7 737 (apply 'cl-assoc nil cl-list :if cl-pred cl-keys))
fcd73769 738
323698cc 739;;;###autoload
7c1898a7 740(defun cl-assoc-if-not (cl-pred cl-list &rest cl-keys)
fcd73769 741 "Find the first item whose car does not satisfy PREDICATE in LIST.
47bc4b3f
JB
742\nKeywords supported: :key
743\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
7c1898a7 744 (apply 'cl-assoc nil cl-list :if-not cl-pred cl-keys))
fcd73769 745
323698cc 746;;;###autoload
7c1898a7 747(defun cl-rassoc (cl-item cl-alist &rest cl-keys)
fcd73769 748 "Find the first item whose cdr matches ITEM in LIST.
47bc4b3f
JB
749\nKeywords supported: :test :test-not :key
750\n(fn ITEM LIST [KEYWORD VALUE]...)"
fcd73769
RS
751 (if (or cl-keys (numberp cl-item))
752 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
753 (while (and cl-alist
754 (or (not (consp (car cl-alist)))
755 (not (cl-check-test cl-item (cdr (car cl-alist))))))
756 (setq cl-alist (cdr cl-alist)))
757 (and cl-alist (car cl-alist)))
758 (rassq cl-item cl-alist)))
759
323698cc 760;;;###autoload
7c1898a7 761(defun cl-rassoc-if (cl-pred cl-list &rest cl-keys)
fcd73769 762 "Find the first item whose cdr satisfies PREDICATE in LIST.
47bc4b3f
JB
763\nKeywords supported: :key
764\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
7c1898a7 765 (apply 'cl-rassoc nil cl-list :if cl-pred cl-keys))
fcd73769 766
323698cc 767;;;###autoload
7c1898a7 768(defun cl-rassoc-if-not (cl-pred cl-list &rest cl-keys)
fcd73769 769 "Find the first item whose cdr does not satisfy PREDICATE in LIST.
47bc4b3f
JB
770\nKeywords supported: :key
771\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
7c1898a7 772 (apply 'cl-rassoc nil cl-list :if-not cl-pred cl-keys))
fcd73769 773
323698cc 774;;;###autoload
7c1898a7 775(defun cl-union (cl-list1 cl-list2 &rest cl-keys)
fcd73769 776 "Combine LIST1 and LIST2 using a set-union operation.
86361e1e 777The resulting list contains all items that appear in either LIST1 or LIST2.
fcd73769
RS
778This is a non-destructive function; it makes a copy of the data if necessary
779to avoid corrupting the original LIST1 and LIST2.
47bc4b3f
JB
780\nKeywords supported: :test :test-not :key
781\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
fcd73769
RS
782 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
783 ((equal cl-list1 cl-list2) cl-list1)
784 (t
785 (or (>= (length cl-list1) (length cl-list2))
786 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
787 (while cl-list2
788 (if (or cl-keys (numberp (car cl-list2)))
7c1898a7 789 (setq cl-list1 (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys))
fcd73769 790 (or (memq (car cl-list2) cl-list1)
ca50d9e6
SM
791 (push (car cl-list2) cl-list1)))
792 (pop cl-list2))
fcd73769
RS
793 cl-list1)))
794
323698cc 795;;;###autoload
7c1898a7 796(defun cl-nunion (cl-list1 cl-list2 &rest cl-keys)
fcd73769 797 "Combine LIST1 and LIST2 using a set-union operation.
86361e1e 798The resulting list contains all items that appear in either LIST1 or LIST2.
fcd73769
RS
799This is a destructive function; it reuses the storage of LIST1 and LIST2
800whenever possible.
47bc4b3f
JB
801\nKeywords supported: :test :test-not :key
802\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
fcd73769 803 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
7c1898a7 804 (t (apply 'cl-union cl-list1 cl-list2 cl-keys))))
fcd73769 805
323698cc 806;;;###autoload
7c1898a7 807(defun cl-intersection (cl-list1 cl-list2 &rest cl-keys)
fcd73769 808 "Combine LIST1 and LIST2 using a set-intersection operation.
86361e1e 809The resulting list contains all items that appear in both LIST1 and LIST2.
fcd73769
RS
810This is a non-destructive function; it makes a copy of the data if necessary
811to avoid corrupting the original LIST1 and LIST2.
47bc4b3f
JB
812\nKeywords supported: :test :test-not :key
813\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
fcd73769
RS
814 (and cl-list1 cl-list2
815 (if (equal cl-list1 cl-list2) cl-list1
816 (cl-parsing-keywords (:key) (:test :test-not)
817 (let ((cl-res nil))
818 (or (>= (length cl-list1) (length cl-list2))
819 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
820 (while cl-list2
821 (if (if (or cl-keys (numberp (car cl-list2)))
7c1898a7 822 (apply 'cl-member (cl-check-key (car cl-list2))
fcd73769
RS
823 cl-list1 cl-keys)
824 (memq (car cl-list2) cl-list1))
ca50d9e6
SM
825 (push (car cl-list2) cl-res))
826 (pop cl-list2))
fcd73769
RS
827 cl-res)))))
828
323698cc 829;;;###autoload
7c1898a7 830(defun cl-nintersection (cl-list1 cl-list2 &rest cl-keys)
fcd73769 831 "Combine LIST1 and LIST2 using a set-intersection operation.
86361e1e 832The resulting list contains all items that appear in both LIST1 and LIST2.
fcd73769
RS
833This is a destructive function; it reuses the storage of LIST1 and LIST2
834whenever possible.
47bc4b3f
JB
835\nKeywords supported: :test :test-not :key
836\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
7c1898a7 837 (and cl-list1 cl-list2 (apply 'cl-intersection cl-list1 cl-list2 cl-keys)))
fcd73769 838
323698cc 839;;;###autoload
7c1898a7 840(defun cl-set-difference (cl-list1 cl-list2 &rest cl-keys)
fcd73769 841 "Combine LIST1 and LIST2 using a set-difference operation.
86361e1e 842The resulting list contains all items that appear in LIST1 but not LIST2.
fcd73769
RS
843This is a non-destructive function; it makes a copy of the data if necessary
844to avoid corrupting the original LIST1 and LIST2.
47bc4b3f
JB
845\nKeywords supported: :test :test-not :key
846\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
fcd73769
RS
847 (if (or (null cl-list1) (null cl-list2)) cl-list1
848 (cl-parsing-keywords (:key) (:test :test-not)
849 (let ((cl-res nil))
850 (while cl-list1
851 (or (if (or cl-keys (numberp (car cl-list1)))
7c1898a7 852 (apply 'cl-member (cl-check-key (car cl-list1))
fcd73769
RS
853 cl-list2 cl-keys)
854 (memq (car cl-list1) cl-list2))
ca50d9e6
SM
855 (push (car cl-list1) cl-res))
856 (pop cl-list1))
fcd73769
RS
857 cl-res))))
858
323698cc 859;;;###autoload
7c1898a7 860(defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys)
fcd73769 861 "Combine LIST1 and LIST2 using a set-difference operation.
86361e1e 862The resulting list contains all items that appear in LIST1 but not LIST2.
fcd73769
RS
863This is a destructive function; it reuses the storage of LIST1 and LIST2
864whenever possible.
47bc4b3f
JB
865\nKeywords supported: :test :test-not :key
866\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
fcd73769 867 (if (or (null cl-list1) (null cl-list2)) cl-list1
7c1898a7 868 (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)))
fcd73769 869
323698cc 870;;;###autoload
7c1898a7 871(defun cl-set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
fcd73769 872 "Combine LIST1 and LIST2 using a set-exclusive-or operation.
86361e1e 873The resulting list contains all items appearing in exactly one of LIST1, LIST2.
fcd73769
RS
874This is a non-destructive function; it makes a copy of the data if necessary
875to avoid corrupting the original LIST1 and LIST2.
47bc4b3f
JB
876\nKeywords supported: :test :test-not :key
877\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
fcd73769
RS
878 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
879 ((equal cl-list1 cl-list2) nil)
7c1898a7
SM
880 (t (append (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)
881 (apply 'cl-set-difference cl-list2 cl-list1 cl-keys)))))
fcd73769 882
323698cc 883;;;###autoload
7c1898a7 884(defun cl-nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
fcd73769 885 "Combine LIST1 and LIST2 using a set-exclusive-or operation.
86361e1e 886The resulting list contains all items appearing in exactly one of LIST1, LIST2.
fcd73769
RS
887This is a destructive function; it reuses the storage of LIST1 and LIST2
888whenever possible.
47bc4b3f
JB
889\nKeywords supported: :test :test-not :key
890\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
fcd73769
RS
891 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
892 ((equal cl-list1 cl-list2) nil)
7c1898a7
SM
893 (t (nconc (apply 'cl-nset-difference cl-list1 cl-list2 cl-keys)
894 (apply 'cl-nset-difference cl-list2 cl-list1 cl-keys)))))
fcd73769 895
323698cc 896;;;###autoload
7c1898a7 897(defun cl-subsetp (cl-list1 cl-list2 &rest cl-keys)
213233f0 898 "Return true if LIST1 is a subset of LIST2.
fcd73769 899I.e., if every element of LIST1 also appears in LIST2.
47bc4b3f
JB
900\nKeywords supported: :test :test-not :key
901\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
fcd73769
RS
902 (cond ((null cl-list1) t) ((null cl-list2) nil)
903 ((equal cl-list1 cl-list2) t)
904 (t (cl-parsing-keywords (:key) (:test :test-not)
905 (while (and cl-list1
7c1898a7 906 (apply 'cl-member (cl-check-key (car cl-list1))
fcd73769 907 cl-list2 cl-keys))
ca50d9e6 908 (pop cl-list1))
fcd73769
RS
909 (null cl-list1)))))
910
323698cc 911;;;###autoload
7c1898a7 912(defun cl-subst-if (cl-new cl-pred cl-tree &rest cl-keys)
fcd73769
RS
913 "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
914Return a copy of TREE with all matching elements replaced by NEW.
47bc4b3f
JB
915\nKeywords supported: :key
916\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
7c1898a7 917 (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
fcd73769 918
323698cc 919;;;###autoload
7c1898a7 920(defun cl-subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
fcd73769
RS
921 "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
922Return a copy of TREE with all non-matching elements replaced by NEW.
47bc4b3f
JB
923\nKeywords supported: :key
924\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
7c1898a7 925 (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
fcd73769 926
323698cc 927;;;###autoload
7c1898a7 928(defun cl-nsubst (cl-new cl-old cl-tree &rest cl-keys)
fcd73769
RS
929 "Substitute NEW for OLD everywhere in TREE (destructively).
930Any element of TREE which is `eql' to OLD is changed to NEW (via a call
931to `setcar').
47bc4b3f
JB
932\nKeywords supported: :test :test-not :key
933\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
7c1898a7 934 (apply 'cl-nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
fcd73769 935
323698cc 936;;;###autoload
7c1898a7 937(defun cl-nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
fcd73769
RS
938 "Substitute NEW for elements matching PREDICATE in TREE (destructively).
939Any element of TREE which matches is changed to NEW (via a call to `setcar').
47bc4b3f
JB
940\nKeywords supported: :key
941\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
7c1898a7 942 (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
fcd73769 943
323698cc 944;;;###autoload
7c1898a7 945(defun cl-nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
fcd73769
RS
946 "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
947Any element of TREE which matches is changed to NEW (via a call to `setcar').
47bc4b3f
JB
948\nKeywords supported: :key
949\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
7c1898a7 950 (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
fcd73769 951
323698cc 952;;;###autoload
7c1898a7 953(defun cl-sublis (cl-alist cl-tree &rest cl-keys)
fcd73769
RS
954 "Perform substitutions indicated by ALIST in TREE (non-destructively).
955Return a copy of TREE with all matching elements replaced.
47bc4b3f
JB
956\nKeywords supported: :test :test-not :key
957\n(fn ALIST TREE [KEYWORD VALUE]...)"
fcd73769
RS
958 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
959 (cl-sublis-rec cl-tree)))
960
961(defvar cl-alist)
962(defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if*
963 (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist))
964 (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
965 (setq cl-p (cdr cl-p)))
966 (if cl-p (cdr (car cl-p))
967 (if (consp cl-tree)
968 (let ((cl-a (cl-sublis-rec (car cl-tree)))
969 (cl-d (cl-sublis-rec (cdr cl-tree))))
970 (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
971 cl-tree
972 (cons cl-a cl-d)))
973 cl-tree))))
974
323698cc 975;;;###autoload
7c1898a7 976(defun cl-nsublis (cl-alist cl-tree &rest cl-keys)
fcd73769
RS
977 "Perform substitutions indicated by ALIST in TREE (destructively).
978Any matching element of TREE is changed via a call to `setcar'.
47bc4b3f
JB
979\nKeywords supported: :test :test-not :key
980\n(fn ALIST TREE [KEYWORD VALUE]...)"
fcd73769
RS
981 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
982 (let ((cl-hold (list cl-tree)))
983 (cl-nsublis-rec cl-hold)
984 (car cl-hold))))
985
986(defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if*
987 (while (consp cl-tree)
988 (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist))
989 (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
990 (setq cl-p (cdr cl-p)))
991 (if cl-p (setcar cl-tree (cdr (car cl-p)))
992 (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree))))
993 (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist)
994 (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
995 (setq cl-p (cdr cl-p)))
996 (if cl-p
997 (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
998 (setq cl-tree (cdr cl-tree))))))
999
323698cc 1000;;;###autoload
7c1898a7 1001(defun cl-tree-equal (cl-x cl-y &rest cl-keys)
47bc4b3f 1002 "Return t if trees TREE1 and TREE2 have `eql' leaves.
fcd73769 1003Atoms are compared by `eql'; cons cells are compared recursively.
47bc4b3f
JB
1004\nKeywords supported: :test :test-not :key
1005\n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
fcd73769
RS
1006 (cl-parsing-keywords (:test :test-not :key) ()
1007 (cl-tree-equal-rec cl-x cl-y)))
1008
1009(defun cl-tree-equal-rec (cl-x cl-y)
1010 (while (and (consp cl-x) (consp cl-y)
1011 (cl-tree-equal-rec (car cl-x) (car cl-y)))
1012 (setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
1013 (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y)))
1014
1015
1016(run-hooks 'cl-seq-load-hook)
1017
323698cc 1018;; Local variables:
08f5e965
GM
1019;; byte-compile-dynamic: t
1020;; byte-compile-warnings: (not cl-functions)
323698cc
SM
1021;; generated-autoload-file: "cl-loaddefs.el"
1022;; End:
1023
fcd73769 1024;;; cl-seq.el ends here