lisp/emacs-lisp/cl-seq.el

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