lisp/emacs-lisp/cl-seq.el

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