code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/seq.el

   1 ;;; seq.el --- Sequence manipulation functions  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Petton <nicolas@petton.fr>
   6 ;; Keywords: sequences
   7 ;; Version: 2.1
   8 ;; Package: seq
   9
  10 ;; Maintainer: emacs-devel@gnu.org
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; Sequence-manipulation functions that complement basic functions
  30 ;; provided by subr.el.
  31 ;;
  32 ;; All functions are prefixed with "seq-".
  33 ;;
  34 ;; All provided functions work on lists, strings and vectors.
  35 ;;
  36 ;; Functions taking a predicate or iterating over a sequence using a
  37 ;; function as argument take the function as their first argument and
  38 ;; the sequence as their second argument.  All other functions take
  39 ;; the sequence as their first argument.
  40 ;;
  41 ;; While seq.el version 1.8 is in GNU ELPA for convenience, seq.el
  42 ;; version 2.0 requires Emacs>=25.1.
  43 ;;
  44 ;; seq.el can be extended to support new type of sequences.  Here are
  45 ;; the generic functions that must be implemented by new seq types:
  46 ;; - `seq-elt'
  47 ;; - `seq-length'
  48 ;; - `seq-do'
  49 ;; - `seq-p'
  50 ;; - `seq-subseq'
  51 ;; - `seq-into-sequence'
  52 ;; - `seq-copy'
  53 ;; - `seq-into'
  54 ;;
  55 ;; All functions are tested in test/automated/seq-tests.el
  56
  57 ;;; Code:
  58
  59 (eval-when-compile (require 'cl-generic))
  60 (require 'cl-extra) ;; for cl-subseq
  61
  62 (defmacro seq-doseq (spec &rest body)
  63   "Loop over a sequence.
  64 Evaluate BODY with VAR bound to each element of SEQUENCE, in turn.
  65
  66 Similar to `dolist' but can be applied to lists, strings, and vectors.
  67
  68 \(fn (VAR SEQUENCE) BODY...)"
  69   (declare (indent 1) (debug ((symbolp form &optional form) body)))
  70   `(seq-do (lambda (,(car spec))
  71              ,@body)
  72            ,(cadr spec)))
  73
  74 (pcase-defmacro seq (&rest patterns)
  75   "Build a `pcase' pattern that matches elements of SEQUENCE.
  76
  77 The `pcase' pattern will match each element of PATTERNS against the
  78 corresponding element of SEQUENCE.
  79
  80 Extra elements of the sequence are ignored if fewer PATTERNS are
  81 given, and the match does not fail."
  82   `(and (pred seq-p)
  83         ,@(seq--make-pcase-bindings patterns)))
  84
  85 (defmacro seq-let (args sequence &rest body)
  86   "Bind the variables in ARGS to the elements of SEQUENCE, then evaluate BODY.
  87
  88 ARGS can also include the `&rest' marker followed by a variable
  89 name to be bound to the rest of SEQUENCE."
  90   (declare (indent 2) (debug t))
  91   `(pcase-let ((,(seq--make-pcase-patterns args) ,sequence))
  92      ,@body))
  93 \f
  94
  95 ;;; Basic seq functions that have to be implemented by new sequence types
  96 (cl-defgeneric seq-elt (sequence n)
  97   "Return Nth element of SEQUENCE."
  98   (elt sequence n))
  99
 100 ;; Default gv setters for `seq-elt'.
 101 ;; It can be a good idea for new sequence implementations to provide a
 102 ;; "gv-setter" for `seq-elt'.
 103 (cl-defmethod (setf seq-elt) (store (sequence array) n)
 104   (aset sequence n store))
 105
 106 (cl-defmethod (setf seq-elt) (store (sequence cons) n)
 107   (setcar (nthcdr n sequence) store))
 108
 109 (cl-defgeneric seq-length (sequence)
 110   "Return the number of elements of SEQUENCE."
 111   (length sequence))
 112
 113 (cl-defgeneric seq-do (function sequence)
 114   "Apply FUNCTION to each element of SEQUENCE, presumably for side effects.
 115 Return SEQUENCE."
 116   (mapc function sequence))
 117
 118 (defalias 'seq-each #'seq-do)
 119
 120 (cl-defgeneric seq-p (sequence)
 121   "Return non-nil if SEQUENCE is a sequence, nil otherwise."
 122   (sequencep sequence))
 123
 124 (cl-defgeneric seq-copy (sequence)
 125   "Return a shallow copy of SEQUENCE."
 126   (copy-sequence sequence))
 127
 128 (cl-defgeneric seq-subseq (sequence start &optional end)
 129   "Return the sequence of elements of SEQUENCE from START to END.
 130 END is inclusive.
 131
 132 If END is omitted, it defaults to the length of the sequence.  If
 133 START or END is negative, it counts from the end.  Signal an
 134 error if START or END are outside of the sequence (i.e too large
 135 if positive or too small if negative)."
 136   (cl-subseq sequence start end))
 137
 138 \f
 139 (cl-defgeneric seq-map (function sequence)
 140   "Return the result of applying FUNCTION to each element of SEQUENCE."
 141   (let (result)
 142     (seq-do (lambda (elt)
 143               (push (funcall function elt) result))
 144             sequence)
 145     (nreverse result)))
 146
 147 ;; faster implementation for sequences (sequencep)
 148 (cl-defmethod seq-map (function (sequence sequence))
 149   (mapcar function sequence))
 150
 151 (cl-defgeneric seq-drop (sequence n)
 152   "Remove the first N elements of SEQUENCE and return the result.
 153 The result is a sequence of the same type as SEQUENCE.
 154
 155 If N is a negative integer or zero, SEQUENCE is returned."
 156   (if (<= n 0)
 157       sequence
 158     (let ((length (seq-length sequence)))
 159       (seq-subseq sequence (min n length) length))))
 160
 161 (cl-defgeneric seq-take (sequence n)
 162   "Take the first N elements of SEQUENCE and return the result.
 163 The result is a sequence of the same type as SEQUENCE.
 164
 165 If N is a negative integer or zero, an empty sequence is
 166 returned."
 167   (seq-subseq sequence 0 (min (max n 0) (seq-length sequence))))
 168
 169 (cl-defgeneric seq-drop-while (pred sequence)
 170   "Remove the successive elements of SEQUENCE for which PRED returns non-nil.
 171 PRED is a function of one argument.  The result is a sequence of
 172 the same type as SEQUENCE."
 173   (seq-drop sequence (seq--count-successive pred sequence)))
 174
 175 (cl-defgeneric seq-take-while (pred sequence)
 176   "Take the successive elements of SEQUENCE for which PRED returns non-nil.
 177 PRED is a function of one argument.  The result is a sequence of
 178 the same type as SEQUENCE."
 179   (seq-take sequence (seq--count-successive pred sequence)))
 180
 181 (cl-defgeneric seq-empty-p (sequence)
 182   "Return non-nil if the SEQUENCE is empty, nil otherwise."
 183   (= 0 (seq-length sequence)))
 184
 185 (cl-defgeneric seq-sort (pred sequence)
 186   "Sort SEQUENCE using PRED as comparison function.
 187 The result is a sequence of the same type as SEQUENCE."
 188   (let ((result (seq-sort pred (append sequence nil))))
 189     (seq-into result (type-of sequence))))
 190
 191 (cl-defmethod seq-sort (pred (list list))
 192   (sort (seq-copy list) pred))
 193
 194 (cl-defgeneric seq-reverse (sequence)
 195   "Return a sequence with elements of SEQUENCE in reverse order."
 196   (let ((result '()))
 197     (seq-map (lambda (elt)
 198                (push elt result))
 199              sequence)
 200     (seq-into result (type-of sequence))))
 201
 202 ;; faster implementation for sequences (sequencep)
 203 (cl-defmethod seq-reverse ((sequence sequence))
 204   (reverse sequence))
 205
 206 (cl-defgeneric seq-concatenate (type &rest sequences)
 207   "Concatenate SEQUENCES into a single sequence of type TYPE.
 208 TYPE must be one of following symbols: vector, string or list.
 209
 210 \n(fn TYPE SEQUENCE...)"
 211   (apply #'cl-concatenate type (seq-map #'seq-into-sequence sequences)))
 212
 213 (cl-defgeneric seq-into-sequence (sequence)
 214   "Convert SEQUENCE into a sequence.
 215
 216 The default implementation is to signal an error if SEQUENCE is not a
 217 sequence, specific functions should be implemented for new types
 218 of sequence."
 219   (unless (sequencep sequence)
 220     (error "Cannot convert %S into a sequence" sequence))
 221   sequence)
 222
 223 (cl-defgeneric seq-into (sequence type)
 224   "Concatenate the elements of SEQUENCE into a sequence of type TYPE.
 225 TYPE can be one of the following symbols: vector, string or
 226 list."
 227   (pcase type
 228     (`vector (vconcat sequence))
 229     (`string (concat sequence))
 230     (`list (append sequence nil))
 231     (_ (error "Not a sequence type name: %S" type))))
 232
 233 (cl-defgeneric seq-filter (pred sequence)
 234   "Return a list of all the elements for which (PRED element) is non-nil in SEQUENCE."
 235   (let ((exclude (make-symbol "exclude")))
 236     (delq exclude (seq-map (lambda (elt)
 237                              (if (funcall pred elt)
 238                                  elt
 239                                exclude))
 240                            sequence))))
 241
 242 (cl-defgeneric seq-remove (pred sequence)
 243   "Return a list of all the elements for which (PRED element) is nil in SEQUENCE."
 244   (seq-filter (lambda (elt) (not (funcall pred elt)))
 245               sequence))
 246
 247 (cl-defgeneric seq-reduce (function sequence initial-value)
 248   "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
 249
 250 Return the result of calling FUNCTION with INITIAL-VALUE and the
 251 first element of SEQUENCE, then calling FUNCTION with that result and
 252 the second element of SEQUENCE, then with that result and the third
 253 element of SEQUENCE, etc.
 254
 255 If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
 256   (if (seq-empty-p sequence)
 257       initial-value
 258     (let ((acc initial-value))
 259       (seq-doseq (elt sequence)
 260         (setq acc (funcall function acc elt)))
 261       acc)))
 262
 263 (cl-defgeneric seq-every-p (pred sequence)
 264   "Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
 265   (catch 'seq--break
 266     (seq-doseq (elt sequence)
 267       (or (funcall pred elt)
 268           (throw 'seq--break nil)))
 269     t))
 270
 271 (cl-defgeneric seq-some (pred sequence)
 272   "Return the first value for which if (PRED element) is non-nil for in SEQUENCE."
 273   (catch 'seq--break
 274     (seq-doseq (elt sequence)
 275       (let ((result (funcall pred elt)))
 276         (when result
 277           (throw 'seq--break result))))
 278     nil))
 279
 280 (cl-defgeneric seq-find (pred sequence &optional default)
 281   "Return the first element for which (PRED element) is non-nil in SEQUENCE.
 282 If no element is found, return DEFAULT.
 283
 284 Note that `seq-find' has an ambiguity if the found element is
 285 identical to DEFAULT, as it cannot be known if an element was
 286 found or not."
 287   (catch 'seq--break
 288     (seq-doseq (elt sequence)
 289       (when (funcall pred elt)
 290         (throw 'seq--break elt)))
 291     default))
 292
 293 (cl-defgeneric seq-count (pred sequence)
 294   "Return the number of elements for which (PRED element) is non-nil in SEQUENCE."
 295   (let ((count 0))
 296     (seq-doseq (elt sequence)
 297       (when (funcall pred elt)
 298         (setq count (+ 1 count))))
 299     count))
 300
 301 (cl-defgeneric seq-contains (sequence elt &optional testfn)
 302   "Return the first element in SEQUENCE that is equal to ELT.
 303 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 304   (seq-some (lambda (e)
 305               (funcall (or testfn #'equal) elt e))
 306             sequence))
 307
 308 (cl-defgeneric seq-position (sequence elt &optional testfn)
 309   "Return the index of the first element in SEQUENCE that is equal to ELT.
 310 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 311   (let ((index 0))
 312     (catch 'seq--break
 313       (seq-doseq (e sequence)
 314         (when (funcall (or testfn #'equal) e elt)
 315           (throw 'seq--break index))
 316         (setq index (1+ index)))
 317       nil)))
 318
 319 (cl-defgeneric seq-uniq (sequence &optional testfn)
 320   "Return a list of the elements of SEQUENCE with duplicates removed.
 321 TESTFN is used to compare elements, or `equal' if TESTFN is nil."
 322   (let ((result '()))
 323     (seq-doseq (elt sequence)
 324       (unless (seq-contains result elt testfn)
 325         (setq result (cons elt result))))
 326     (nreverse result)))
 327
 328 (cl-defgeneric seq-mapcat (function sequence &optional type)
 329   "Concatenate the result of applying FUNCTION to each element of SEQUENCE.
 330 The result is a sequence of type TYPE, or a list if TYPE is nil."
 331   (apply #'seq-concatenate (or type 'list)
 332          (seq-map function sequence)))
 333
 334 (cl-defgeneric seq-partition (sequence n)
 335   "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
 336 The last sequence may contain less than N elements.  If N is a
 337 negative integer or 0, nil is returned."
 338   (unless (< n 1)
 339     (let ((result '()))
 340       (while (not (seq-empty-p sequence))
 341         (push (seq-take sequence n) result)
 342         (setq sequence (seq-drop sequence n)))
 343       (nreverse result))))
 344
 345 (cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
 346   "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
 347 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 348   (seq-reduce (lambda (acc elt)
 349                 (if (seq-contains sequence2 elt testfn)
 350                     (cons elt acc)
 351                   acc))
 352               (seq-reverse sequence1)
 353               '()))
 354
 355 (cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
 356   "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
 357 Equality is defined by TESTFN if non-nil or by `equal' if nil."
 358   (seq-reduce (lambda (acc elt)
 359                 (if (not (seq-contains sequence2 elt testfn))
 360                     (cons elt acc)
 361                   acc))
 362               (seq-reverse sequence1)
 363               '()))
 364
 365 (cl-defgeneric seq-group-by (function sequence)
 366   "Apply FUNCTION to each element of SEQUENCE.
 367 Separate the elements of SEQUENCE into an alist using the results as
 368 keys.  Keys are compared using `equal'."
 369   (seq-reduce
 370    (lambda (acc elt)
 371      (let* ((key (funcall function elt))
 372             (cell (assoc key acc)))
 373        (if cell
 374            (setcdr cell (push elt (cdr cell)))
 375          (push (list key elt) acc))
 376        acc))
 377    (seq-reverse sequence)
 378    nil))
 379
 380 (cl-defgeneric seq-min (sequence)
 381   "Return the smallest element of SEQUENCE.
 382 SEQUENCE must be a sequence of numbers or markers."
 383   (apply #'min (seq-into sequence 'list)))
 384
 385 (cl-defgeneric seq-max (sequence)
 386   "Return the largest element of SEQUENCE.
 387 SEQUENCE must be a sequence of numbers or markers."
 388   (apply #'max (seq-into sequence 'list)))
 389
 390 (defun seq--count-successive (pred sequence)
 391   "Return the number of successive elements for which (PRED element) is non-nil in SEQUENCE."
 392   (let ((n 0)
 393         (len (seq-length sequence)))
 394     (while (and (< n len)
 395                 (funcall pred (seq-elt sequence n)))
 396       (setq n (+ 1 n)))
 397     n))
 398
 399 (defun seq--make-pcase-bindings (args)
 400   "Return a list of bindings of the variables in ARGS to the elements of a sequence."
 401   (let ((bindings '())
 402         (index 0)
 403         (rest-marker nil))
 404     (seq-doseq (name args)
 405       (unless rest-marker
 406         (pcase name
 407           (`&rest
 408            (progn (push `(app (pcase--flip seq-drop ,index)
 409                               ,(seq--elt-safe args (1+ index)))
 410                         bindings)
 411                   (setq rest-marker t)))
 412           (_
 413            (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
 414       (setq index (1+ index)))
 415     bindings))
 416
 417 (defun seq--make-pcase-patterns (args)
 418   "Return a list of `(seq ...)' pcase patterns from the argument list ARGS."
 419   (cons 'seq
 420         (seq-map (lambda (elt)
 421                    (if (seq-p elt)
 422                        (seq--make-pcase-patterns elt)
 423                      elt))
 424                  args)))
 425
 426 ;; TODO: make public?
 427 (defun seq--elt-safe (sequence n)
 428   "Return element of SEQUENCE at the index N.
 429 If no element is found, return nil."
 430   (ignore-errors (seq-elt sequence n)))
 431 \f
 432
 433 ;;; Optimized implementations for lists
 434
 435 (cl-defmethod seq-drop ((list list) n)
 436   "Optimized implementation of `seq-drop' for lists."
 437   (while (and list (> n 0))
 438     (setq list (cdr list)
 439           n (1- n)))
 440   list)
 441
 442 (cl-defmethod seq-take ((list list) n)
 443   "Optimized implementation of `seq-take' for lists."
 444   (let ((result '()))
 445     (while (and list (> n 0))
 446       (setq n (1- n))
 447       (push (pop list) result))
 448     (nreverse result)))
 449
 450 (cl-defmethod seq-drop-while (pred (list list))
 451   "Optimized implementation of `seq-drop-while' for lists."
 452   (while (and list (funcall pred (car list)))
 453     (setq list (cdr list)))
 454   list)
 455
 456 (cl-defmethod seq-empty-p ((list list))
 457   "Optimized implementation of `seq-empty-p' for lists."
 458   (null list))
 459 \f
 460
 461 (defun seq--activate-font-lock-keywords ()
 462   "Activate font-lock keywords for some symbols defined in seq."
 463   (font-lock-add-keywords 'emacs-lisp-mode
 464                           '("\\<seq-doseq\\>" "\\<seq-let\\>")))
 465
 466 (unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
 467   ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
 468   ;; we automatically highlight macros.
 469   (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
 470
 471 (provide 'seq)
 472 ;;; seq.el ends here