lisp/emacs-lisp/cl-seq.el

   1 ;;; cl-seq.el --- Common Lisp features, part 3
   2
   3 ;; Copyright (C) 1993, 2001-2011  Free Software Foundation, Inc.
   4
   5 ;; Author: Dave Gillespie <daveg@synaptics.com>
   6 ;; Version: 2.02
   7 ;; Keywords: extensions
   8 ;; Package: emacs
   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 3 of the License, or
  15 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  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 ;;
  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
  42 ;;; Code:
  43
  44 (require 'cl)
  45
  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)
  50   (declare (indent 2) (debug (sexp sexp &rest form)))
  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)))))
  59                (if (eq var :test-not)
  60                    (setq mem (list 'and mem (list 'setq 'cl-test mem) t)))
  61                (if (eq var :if-not)
  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))))
  87
  88 (defmacro cl-check-key (x)
  89   (declare (debug edebug-forms))
  90   (list 'if 'cl-key (list 'funcall 'cl-key x) x))
  91
  92 (defmacro cl-check-test-nokey (item x)
  93   (declare (debug edebug-forms))
  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)
 104   (declare (debug edebug-forms))
 105   (list 'cl-check-test-nokey item (list 'cl-check-key x)))
 106
 107 (defmacro cl-check-match (x y)
 108   (declare (debug edebug-forms))
 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
 115 (defvar cl-test) (defvar cl-test-not)
 116 (defvar cl-if) (defvar cl-if-not)
 117 (defvar cl-key)
 118
 119
 120 ;;;###autoload
 121 (defun reduce (cl-func cl-seq &rest cl-keys)
 122   "Reduce two-argument FUNCTION across SEQ.
 123 \nKeywords supported:  :start :end :from-end :initial-value :key
 124 \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
 125   (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
 126     (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
 127     (setq cl-seq (subseq cl-seq cl-start cl-end))
 128     (if cl-from-end (setq cl-seq (nreverse cl-seq)))
 129     (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
 130                           (cl-seq (cl-check-key (pop cl-seq)))
 131                           (t (funcall cl-func)))))
 132       (if cl-from-end
 133           (while cl-seq
 134             (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
 135                                     cl-accum)))
 136         (while cl-seq
 137           (setq cl-accum (funcall cl-func cl-accum
 138                                   (cl-check-key (pop cl-seq))))))
 139       cl-accum)))
 140
 141 ;;;###autoload
 142 (defun fill (seq item &rest cl-keys)
 143   "Fill the elements of SEQ with ITEM.
 144 \nKeywords supported:  :start :end
 145 \n(fn SEQ ITEM [KEYWORD VALUE]...)"
 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
 161 ;;;###autoload
 162 (defun replace (cl-seq1 cl-seq2 &rest cl-keys)
 163   "Replace the elements of SEQ1 with the elements of SEQ2.
 164 SEQ1 is destructively modified, then returned.
 165 \nKeywords supported:  :start1 :end1 :start2 :end2
 166 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
 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
 204 ;;;###autoload
 205 (defun remove* (cl-item cl-seq &rest cl-keys)
 206   "Remove all occurrences of ITEM in SEQ.
 207 This is a non-destructive function; it makes a copy of SEQ if necessary
 208 to avoid corrupting the original SEQ.
 209 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 210 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
 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)))
 216           (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end
 217                                    cl-from-end)))
 218             (if cl-i
 219                 (let ((cl-res (apply 'delete* cl-item (append cl-seq nil)
 220                                      (append (if cl-from-end
 221                                                  (list :end (1+ cl-i))
 222                                                (list :start cl-i))
 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))
 240                   (nconc (ldiff cl-seq cl-p)
 241                          (if (= cl-count 1) (cdr cl-p)
 242                            (and (cdr cl-p)
 243                                 (apply 'delete* cl-item
 244                                        (copy-sequence (cdr cl-p))
 245                                        :start 0 :end (1- cl-end)
 246                                        :count (1- cl-count) cl-keys))))
 247                 cl-seq))
 248           cl-seq)))))
 249
 250 ;;;###autoload
 251 (defun remove-if (cl-pred cl-list &rest cl-keys)
 252   "Remove all items satisfying PREDICATE in SEQ.
 253 This is a non-destructive function; it makes a copy of SEQ if necessary
 254 to avoid corrupting the original SEQ.
 255 \nKeywords supported:  :key :count :start :end :from-end
 256 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
 257   (apply 'remove* nil cl-list :if cl-pred cl-keys))
 258
 259 ;;;###autoload
 260 (defun remove-if-not (cl-pred cl-list &rest cl-keys)
 261   "Remove all items not satisfying PREDICATE in SEQ.
 262 This is a non-destructive function; it makes a copy of SEQ if necessary
 263 to avoid corrupting the original SEQ.
 264 \nKeywords supported:  :key :count :start :end :from-end
 265 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
 266   (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
 267
 268 ;;;###autoload
 269 (defun delete* (cl-item cl-seq &rest cl-keys)
 270   "Remove all occurrences of ITEM in SEQ.
 271 This is a destructive function; it reuses the storage of SEQ whenever possible.
 272 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 273 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
 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)
 282                             (setq cl-i (cl-position cl-item cl-seq cl-start
 283                                                     cl-end cl-from-end)))
 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)
 310         (apply 'remove* cl-item cl-seq cl-keys)))))
 311
 312 ;;;###autoload
 313 (defun delete-if (cl-pred cl-list &rest cl-keys)
 314   "Remove all items satisfying PREDICATE in SEQ.
 315 This is a destructive function; it reuses the storage of SEQ whenever possible.
 316 \nKeywords supported:  :key :count :start :end :from-end
 317 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
 318   (apply 'delete* nil cl-list :if cl-pred cl-keys))
 319
 320 ;;;###autoload
 321 (defun delete-if-not (cl-pred cl-list &rest cl-keys)
 322   "Remove all items not 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-not cl-pred cl-keys))
 327
 328 ;;;###autoload
 329 (defun remove-duplicates (cl-seq &rest cl-keys)
 330   "Return a copy of SEQ with all duplicate elements removed.
 331 \nKeywords supported:  :test :test-not :key :start :end :from-end
 332 \n(fn SEQ [KEYWORD VALUE]...)"
 333   (cl-delete-duplicates cl-seq cl-keys t))
 334
 335 ;;;###autoload
 336 (defun delete-duplicates (cl-seq &rest cl-keys)
 337   "Remove all duplicate elements from SEQ (destructively).
 338 \nKeywords supported:  :test :test-not :key :start :end :from-end
 339 \n(fn SEQ [KEYWORD VALUE]...)"
 340   (cl-delete-duplicates cl-seq cl-keys nil))
 341
 342 (defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
 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)
 351                 (while (setq cl-i (cl-position (cl-check-key (car cl-p))
 352                                                (cdr cl-p) cl-i (1- cl-end)))
 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)
 363                       (cl-position (cl-check-key (car cl-seq))
 364                                    (cdr cl-seq) 0 (1- cl-end)))
 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))
 369               (if (cl-position (cl-check-key (car (cdr cl-p)))
 370                                (cdr (cdr cl-p)) 0 (1- cl-end))
 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)))
 379     (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
 380       (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
 381
 382 ;;;###autoload
 383 (defun substitute (cl-new cl-old cl-seq &rest cl-keys)
 384   "Substitute NEW for OLD in SEQ.
 385 This is a non-destructive function; it makes a copy of SEQ if necessary
 386 to avoid corrupting the original SEQ.
 387 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 388 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
 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
 394       (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end)))
 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))))
 401           (apply 'nsubstitute cl-new cl-old cl-seq :count cl-count
 402                  :start cl-i cl-keys))))))
 403
 404 ;;;###autoload
 405 (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
 406   "Substitute NEW for all items satisfying PREDICATE in SEQ.
 407 This is a non-destructive function; it makes a copy of SEQ if necessary
 408 to avoid corrupting the original SEQ.
 409 \nKeywords supported:  :key :count :start :end :from-end
 410 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
 411   (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
 412
 413 ;;;###autoload
 414 (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
 415   "Substitute NEW for all items not satisfying PREDICATE in SEQ.
 416 This is a non-destructive function; it makes a copy of SEQ if necessary
 417 to avoid corrupting the original SEQ.
 418 \nKeywords supported:  :key :count :start :end :from-end
 419 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
 420   (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
 421
 422 ;;;###autoload
 423 (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
 424   "Substitute NEW for OLD in SEQ.
 425 This is a destructive function; it reuses the storage of SEQ whenever possible.
 426 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 427 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
 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
 456 ;;;###autoload
 457 (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
 458   "Substitute NEW for all items satisfying PREDICATE in SEQ.
 459 This is a destructive function; it reuses the storage of SEQ whenever possible.
 460 \nKeywords supported:  :key :count :start :end :from-end
 461 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
 462   (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
 463
 464 ;;;###autoload
 465 (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
 466   "Substitute NEW for all items not 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-not cl-pred cl-keys))
 471
 472 ;;;###autoload
 473 (defun find (cl-item cl-seq &rest cl-keys)
 474   "Find the first occurrence of ITEM in SEQ.
 475 Return the matching ITEM, or nil if not found.
 476 \nKeywords supported:  :test :test-not :key :start :end :from-end
 477 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
 478   (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
 479     (and cl-pos (elt cl-seq cl-pos))))
 480
 481 ;;;###autoload
 482 (defun find-if (cl-pred cl-list &rest cl-keys)
 483   "Find the first item satisfying PREDICATE in SEQ.
 484 Return the matching item, or nil if not found.
 485 \nKeywords supported:  :key :start :end :from-end
 486 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
 487   (apply 'find nil cl-list :if cl-pred cl-keys))
 488
 489 ;;;###autoload
 490 (defun find-if-not (cl-pred cl-list &rest cl-keys)
 491   "Find the first item not 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-not cl-pred cl-keys))
 496
 497 ;;;###autoload
 498 (defun position (cl-item cl-seq &rest cl-keys)
 499   "Find the first occurrence of ITEM in SEQ.
 500 Return the index of the matching item, or nil if not found.
 501 \nKeywords supported:  :test :test-not :key :start :end :from-end
 502 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
 503   (cl-parsing-keywords (:test :test-not :key :if :if-not
 504                         (:start 0) :end :from-end) ()
 505     (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
 506
 507 (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
 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
 528 ;;;###autoload
 529 (defun position-if (cl-pred cl-list &rest cl-keys)
 530   "Find the first item satisfying PREDICATE in SEQ.
 531 Return the index of the matching item, or nil if not found.
 532 \nKeywords supported:  :key :start :end :from-end
 533 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
 534   (apply 'position nil cl-list :if cl-pred cl-keys))
 535
 536 ;;;###autoload
 537 (defun position-if-not (cl-pred cl-list &rest cl-keys)
 538   "Find the first item not 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-not cl-pred cl-keys))
 543
 544 ;;;###autoload
 545 (defun count (cl-item cl-seq &rest cl-keys)
 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]...)"
 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)
 554         (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
 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
 559 ;;;###autoload
 560 (defun count-if (cl-pred cl-list &rest cl-keys)
 561   "Count the number of items satisfying PREDICATE in SEQ.
 562 \nKeywords supported:  :key :start :end
 563 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
 564   (apply 'count nil cl-list :if cl-pred cl-keys))
 565
 566 ;;;###autoload
 567 (defun count-if-not (cl-pred cl-list &rest cl-keys)
 568   "Count the number of items not satisfying PREDICATE in SEQ.
 569 \nKeywords supported:  :key :start :end
 570 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
 571   (apply 'count nil cl-list :if-not cl-pred cl-keys))
 572
 573 ;;;###autoload
 574 (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
 575   "Compare SEQ1 with SEQ2, return index of first mismatching element.
 576 Return nil if the sequences match.  If one sequence is a prefix of the
 577 other, the return value indicates the end of the shorter sequence.
 578 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 579 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
 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
 604 ;;;###autoload
 605 (defun search (cl-seq1 cl-seq2 &rest cl-keys)
 606   "Search for SEQ1 as a subsequence of SEQ2.
 607 Return the index of the leftmost element of the first match found;
 608 return nil if there are no matches.
 609 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 610 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
 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)
 622                     (setq cl-pos (cl-position cl-first cl-seq2
 623                                               cl-start2 cl-end2 cl-from-end))
 624                     (apply 'mismatch cl-seq1 cl-seq2
 625                            :start1 (1+ cl-start1) :end1 cl-end1
 626                            :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
 627                            :from-end nil cl-keys))
 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
 631 ;;;###autoload
 632 (defun sort* (cl-seq cl-pred &rest cl-keys)
 633   "Sort the argument SEQ according to PREDICATE.
 634 This is a destructive function; it reuses the storage of SEQ if possible.
 635 \nKeywords supported:  :key
 636 \n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
 637   (if (nlistp cl-seq)
 638       (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
 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
 646 ;;;###autoload
 647 (defun stable-sort (cl-seq cl-pred &rest cl-keys)
 648   "Sort the argument SEQ stably according to PREDICATE.
 649 This is a destructive function; it reuses the storage of SEQ if possible.
 650 \nKeywords supported:  :key
 651 \n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
 652   (apply 'sort* cl-seq cl-pred cl-keys))
 653
 654 ;;;###autoload
 655 (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
 656   "Destructively merge the two sequences to produce a new sequence.
 657 TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
 658 sequences, and PREDICATE is a `less-than' predicate on the elements.
 659 \nKeywords supported:  :key
 660 \n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
 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)))
 668             (push (pop cl-seq2) cl-res)
 669           (push (pop cl-seq1) cl-res)))
 670       (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
 671
 672 ;;; See compiler macro in cl-macs.el
 673 ;;;###autoload
 674 (defun member* (cl-item cl-list &rest cl-keys)
 675   "Find the first occurrence of ITEM in LIST.
 676 Return the sublist of LIST whose car is ITEM.
 677 \nKeywords supported:  :test :test-not :key
 678 \n(fn ITEM LIST [KEYWORD VALUE]...)"
 679   (if cl-keys
 680       (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
 681         (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
 682           (setq cl-list (cdr cl-list)))
 683         cl-list)
 684     (if (and (numberp cl-item) (not (integerp cl-item)))
 685         (member cl-item cl-list)
 686       (memq cl-item cl-list))))
 687
 688 ;;;###autoload
 689 (defun member-if (cl-pred cl-list &rest cl-keys)
 690   "Find the first item satisfying PREDICATE in LIST.
 691 Return the sublist of LIST whose car matches.
 692 \nKeywords supported:  :key
 693 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
 694   (apply 'member* nil cl-list :if cl-pred cl-keys))
 695
 696 ;;;###autoload
 697 (defun member-if-not (cl-pred cl-list &rest cl-keys)
 698   "Find the first item not 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-not cl-pred cl-keys))
 703
 704 ;;;###autoload
 705 (defun cl-adjoin (cl-item cl-list &rest cl-keys)
 706   (if (cl-parsing-keywords (:key) t
 707         (apply 'member* (cl-check-key cl-item) cl-list cl-keys))
 708       cl-list
 709     (cons cl-item cl-list)))
 710
 711 ;;; See compiler macro in cl-macs.el
 712 ;;;###autoload
 713 (defun assoc* (cl-item cl-alist &rest cl-keys)
 714   "Find the first item whose car matches ITEM in LIST.
 715 \nKeywords supported:  :test :test-not :key
 716 \n(fn ITEM LIST [KEYWORD VALUE]...)"
 717   (if cl-keys
 718       (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
 719         (while (and cl-alist
 720                     (or (not (consp (car cl-alist)))
 721                         (not (cl-check-test cl-item (car (car cl-alist))))))
 722           (setq cl-alist (cdr cl-alist)))
 723         (and cl-alist (car cl-alist)))
 724     (if (and (numberp cl-item) (not (integerp cl-item)))
 725         (assoc cl-item cl-alist)
 726       (assq cl-item cl-alist))))
 727
 728 ;;;###autoload
 729 (defun assoc-if (cl-pred cl-list &rest cl-keys)
 730   "Find the first item whose car satisfies PREDICATE in LIST.
 731 \nKeywords supported:  :key
 732 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
 733   (apply 'assoc* nil cl-list :if cl-pred cl-keys))
 734
 735 ;;;###autoload
 736 (defun assoc-if-not (cl-pred cl-list &rest cl-keys)
 737   "Find the first item whose car does not satisfy PREDICATE in LIST.
 738 \nKeywords supported:  :key
 739 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
 740   (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
 741
 742 ;;;###autoload
 743 (defun rassoc* (cl-item cl-alist &rest cl-keys)
 744   "Find the first item whose cdr matches ITEM in LIST.
 745 \nKeywords supported:  :test :test-not :key
 746 \n(fn ITEM LIST [KEYWORD VALUE]...)"
 747   (if (or cl-keys (numberp cl-item))
 748       (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
 749         (while (and cl-alist
 750                     (or (not (consp (car cl-alist)))
 751                         (not (cl-check-test cl-item (cdr (car cl-alist))))))
 752           (setq cl-alist (cdr cl-alist)))
 753         (and cl-alist (car cl-alist)))
 754     (rassq cl-item cl-alist)))
 755
 756 ;;;###autoload
 757 (defun rassoc-if (cl-pred cl-list &rest cl-keys)
 758   "Find the first item whose cdr satisfies PREDICATE in LIST.
 759 \nKeywords supported:  :key
 760 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
 761   (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
 762
 763 ;;;###autoload
 764 (defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
 765   "Find the first item whose cdr does not satisfy PREDICATE in LIST.
 766 \nKeywords supported:  :key
 767 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
 768   (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
 769
 770 ;;;###autoload
 771 (defun union (cl-list1 cl-list2 &rest cl-keys)
 772   "Combine LIST1 and LIST2 using a set-union operation.
 773 The resulting list contains all items that appear in either LIST1 or LIST2.
 774 This is a non-destructive function; it makes a copy of the data if necessary
 775 to avoid corrupting the original LIST1 and LIST2.
 776 \nKeywords supported:  :test :test-not :key
 777 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 778   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
 779         ((equal cl-list1 cl-list2) cl-list1)
 780         (t
 781          (or (>= (length cl-list1) (length cl-list2))
 782              (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
 783          (while cl-list2
 784            (if (or cl-keys (numberp (car cl-list2)))
 785                (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys))
 786              (or (memq (car cl-list2) cl-list1)
 787                  (push (car cl-list2) cl-list1)))
 788            (pop cl-list2))
 789          cl-list1)))
 790
 791 ;;;###autoload
 792 (defun nunion (cl-list1 cl-list2 &rest cl-keys)
 793   "Combine LIST1 and LIST2 using a set-union operation.
 794 The resulting list contains all items that appear in either LIST1 or LIST2.
 795 This is a destructive function; it reuses the storage of LIST1 and LIST2
 796 whenever possible.
 797 \nKeywords supported:  :test :test-not :key
 798 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 799   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
 800         (t (apply 'union cl-list1 cl-list2 cl-keys))))
 801
 802 ;;;###autoload
 803 (defun intersection (cl-list1 cl-list2 &rest cl-keys)
 804   "Combine LIST1 and LIST2 using a set-intersection operation.
 805 The resulting list contains all items that appear in both LIST1 and LIST2.
 806 This is a non-destructive function; it makes a copy of the data if necessary
 807 to avoid corrupting the original LIST1 and LIST2.
 808 \nKeywords supported:  :test :test-not :key
 809 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 810   (and cl-list1 cl-list2
 811        (if (equal cl-list1 cl-list2) cl-list1
 812          (cl-parsing-keywords (:key) (:test :test-not)
 813            (let ((cl-res nil))
 814              (or (>= (length cl-list1) (length cl-list2))
 815                  (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
 816              (while cl-list2
 817                (if (if (or cl-keys (numberp (car cl-list2)))
 818                        (apply 'member* (cl-check-key (car cl-list2))
 819                               cl-list1 cl-keys)
 820                      (memq (car cl-list2) cl-list1))
 821                    (push (car cl-list2) cl-res))
 822                (pop cl-list2))
 823              cl-res)))))
 824
 825 ;;;###autoload
 826 (defun nintersection (cl-list1 cl-list2 &rest cl-keys)
 827   "Combine LIST1 and LIST2 using a set-intersection operation.
 828 The resulting list contains all items that appear in both LIST1 and LIST2.
 829 This is a destructive function; it reuses the storage of LIST1 and LIST2
 830 whenever possible.
 831 \nKeywords supported:  :test :test-not :key
 832 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 833   (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
 834
 835 ;;;###autoload
 836 (defun set-difference (cl-list1 cl-list2 &rest cl-keys)
 837   "Combine LIST1 and LIST2 using a set-difference operation.
 838 The resulting list contains all items that appear in LIST1 but not LIST2.
 839 This is a non-destructive function; it makes a copy of the data if necessary
 840 to avoid corrupting the original LIST1 and LIST2.
 841 \nKeywords supported:  :test :test-not :key
 842 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 843   (if (or (null cl-list1) (null cl-list2)) cl-list1
 844     (cl-parsing-keywords (:key) (:test :test-not)
 845       (let ((cl-res nil))
 846         (while cl-list1
 847           (or (if (or cl-keys (numberp (car cl-list1)))
 848                   (apply 'member* (cl-check-key (car cl-list1))
 849                          cl-list2 cl-keys)
 850                 (memq (car cl-list1) cl-list2))
 851               (push (car cl-list1) cl-res))
 852           (pop cl-list1))
 853         cl-res))))
 854
 855 ;;;###autoload
 856 (defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
 857   "Combine LIST1 and LIST2 using a set-difference operation.
 858 The resulting list contains all items that appear in LIST1 but not LIST2.
 859 This is a destructive function; it reuses the storage of LIST1 and LIST2
 860 whenever possible.
 861 \nKeywords supported:  :test :test-not :key
 862 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 863   (if (or (null cl-list1) (null cl-list2)) cl-list1
 864     (apply 'set-difference cl-list1 cl-list2 cl-keys)))
 865
 866 ;;;###autoload
 867 (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
 868   "Combine LIST1 and LIST2 using a set-exclusive-or operation.
 869 The resulting list contains all items appearing in exactly one of LIST1, LIST2.
 870 This is a non-destructive function; it makes a copy of the data if necessary
 871 to avoid corrupting the original LIST1 and LIST2.
 872 \nKeywords supported:  :test :test-not :key
 873 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 874   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
 875         ((equal cl-list1 cl-list2) nil)
 876         (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
 877                    (apply 'set-difference cl-list2 cl-list1 cl-keys)))))
 878
 879 ;;;###autoload
 880 (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
 881   "Combine LIST1 and LIST2 using a set-exclusive-or operation.
 882 The resulting list contains all items appearing in exactly one of LIST1, LIST2.
 883 This is a destructive function; it reuses the storage of LIST1 and LIST2
 884 whenever possible.
 885 \nKeywords supported:  :test :test-not :key
 886 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 887   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
 888         ((equal cl-list1 cl-list2) nil)
 889         (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
 890                   (apply 'nset-difference cl-list2 cl-list1 cl-keys)))))
 891
 892 ;;;###autoload
 893 (defun subsetp (cl-list1 cl-list2 &rest cl-keys)
 894   "Return true if LIST1 is a subset of LIST2.
 895 I.e., if every element of LIST1 also appears in LIST2.
 896 \nKeywords supported:  :test :test-not :key
 897 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
 898   (cond ((null cl-list1) t) ((null cl-list2) nil)
 899         ((equal cl-list1 cl-list2) t)
 900         (t (cl-parsing-keywords (:key) (:test :test-not)
 901              (while (and cl-list1
 902                          (apply 'member* (cl-check-key (car cl-list1))
 903                                 cl-list2 cl-keys))
 904                (pop cl-list1))
 905              (null cl-list1)))))
 906
 907 ;;;###autoload
 908 (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
 909   "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
 910 Return a copy of TREE with all matching elements replaced by NEW.
 911 \nKeywords supported:  :key
 912 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
 913   (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
 914
 915 ;;;###autoload
 916 (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
 917   "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
 918 Return a copy of TREE with all non-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-not cl-pred cl-keys))
 922
 923 ;;;###autoload
 924 (defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
 925   "Substitute NEW for OLD everywhere in TREE (destructively).
 926 Any element of TREE which is `eql' to OLD is changed to NEW (via a call
 927 to `setcar').
 928 \nKeywords supported:  :test :test-not :key
 929 \n(fn NEW OLD TREE [KEYWORD VALUE]...)"
 930   (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
 931
 932 ;;;###autoload
 933 (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
 934   "Substitute NEW for elements matching PREDICATE in TREE (destructively).
 935 Any element of TREE which matches is changed to NEW (via a call to `setcar').
 936 \nKeywords supported:  :key
 937 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
 938   (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
 939
 940 ;;;###autoload
 941 (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
 942   "Substitute NEW for elements not 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-not cl-pred cl-keys))
 947
 948 ;;;###autoload
 949 (defun sublis (cl-alist cl-tree &rest cl-keys)
 950   "Perform substitutions indicated by ALIST in TREE (non-destructively).
 951 Return a copy of TREE with all matching elements replaced.
 952 \nKeywords supported:  :test :test-not :key
 953 \n(fn ALIST TREE [KEYWORD VALUE]...)"
 954   (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
 955     (cl-sublis-rec cl-tree)))
 956
 957 (defvar cl-alist)
 958 (defun cl-sublis-rec (cl-tree)   ; uses cl-alist/key/test*/if*
 959   (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist))
 960     (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
 961       (setq cl-p (cdr cl-p)))
 962     (if cl-p (cdr (car cl-p))
 963       (if (consp cl-tree)
 964           (let ((cl-a (cl-sublis-rec (car cl-tree)))
 965                 (cl-d (cl-sublis-rec (cdr cl-tree))))
 966             (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
 967                 cl-tree
 968               (cons cl-a cl-d)))
 969         cl-tree))))
 970
 971 ;;;###autoload
 972 (defun nsublis (cl-alist cl-tree &rest cl-keys)
 973   "Perform substitutions indicated by ALIST in TREE (destructively).
 974 Any matching element of TREE is changed via a call to `setcar'.
 975 \nKeywords supported:  :test :test-not :key
 976 \n(fn ALIST TREE [KEYWORD VALUE]...)"
 977   (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
 978     (let ((cl-hold (list cl-tree)))
 979       (cl-nsublis-rec cl-hold)
 980       (car cl-hold))))
 981
 982 (defun cl-nsublis-rec (cl-tree)   ; uses cl-alist/temp/p/key/test*/if*
 983   (while (consp cl-tree)
 984     (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist))
 985       (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
 986         (setq cl-p (cdr cl-p)))
 987       (if cl-p (setcar cl-tree (cdr (car cl-p)))
 988         (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree))))
 989       (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist)
 990       (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
 991         (setq cl-p (cdr cl-p)))
 992       (if cl-p
 993           (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
 994         (setq cl-tree (cdr cl-tree))))))
 995
 996 ;;;###autoload
 997 (defun tree-equal (cl-x cl-y &rest cl-keys)
 998   "Return t if trees TREE1 and TREE2 have `eql' leaves.
 999 Atoms are compared by `eql'; cons cells are compared recursively.
1000 \nKeywords supported:  :test :test-not :key
1001 \n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
1002   (cl-parsing-keywords (:test :test-not :key) ()
1003     (cl-tree-equal-rec cl-x cl-y)))
1004
1005 (defun cl-tree-equal-rec (cl-x cl-y)
1006   (while (and (consp cl-x) (consp cl-y)
1007               (cl-tree-equal-rec (car cl-x) (car cl-y)))
1008     (setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
1009   (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y)))
1010
1011
1012 (run-hooks 'cl-seq-load-hook)
1013
1014 ;; Local variables:
1015 ;; byte-compile-dynamic: t
1016 ;; byte-compile-warnings: (not cl-functions)
1017 ;; generated-autoload-file: "cl-loaddefs.el"
1018 ;; End:
1019
1020 ;;; cl-seq.el ends here