code.delx.au - gnu-emacs-elpa/blob - packages/seq/seq-25.el

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