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