lisp/emacs-lisp/cl-seq.el

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