seq-24.el (18499B)
1 ;;; seq-24.el --- seq.el implementation for Emacs 24.x -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2014-2023 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 <https://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 ;;; Code: 40 41 (defmacro seq-doseq (spec &rest body) 42 "Loop over a sequence. 43 Similar to `dolist' but can be applied to lists, strings, and vectors. 44 45 Evaluate BODY with VAR bound to each element of SEQ, in turn. 46 47 \(fn (VAR SEQ) BODY...)" 48 (declare (indent 1) (debug ((symbolp form &optional form) body))) 49 (let ((length (make-symbol "length")) 50 (seq (make-symbol "seq")) 51 (index (make-symbol "index"))) 52 `(let* ((,seq ,(cadr spec)) 53 (,length (if (listp ,seq) nil (seq-length ,seq))) 54 (,index (if ,length 0 ,seq))) 55 (while (if ,length 56 (< ,index ,length) 57 (consp ,index)) 58 (let ((,(car spec) (if ,length 59 (prog1 (seq-elt ,seq ,index) 60 (setq ,index (+ ,index 1))) 61 (pop ,index)))) 62 ,@body))))) 63 64 ;; Implementation of `seq-let' compatible with Emacs<25.1. 65 (defmacro seq-let (args sequence &rest body) 66 "Bind the variables in ARGS to the elements of SEQUENCE then evaluate BODY. 67 68 ARGS can also include the `&rest' marker followed by a variable 69 name to be bound to the rest of SEQUENCE." 70 (declare (indent 2) (debug t)) 71 (let ((seq-var (make-symbol "seq"))) 72 `(let* ((,seq-var ,sequence) 73 ,@(seq--make-bindings args seq-var)) 74 ,@body))) 75 76 (defun seq-drop (sequence n) 77 "Return a subsequence of SEQUENCE without its first N elements. 78 The result is a sequence of the same type as SEQUENCE. 79 80 If N is a negative integer or zero, SEQUENCE is returned." 81 (if (<= n 0) 82 sequence 83 (if (listp sequence) 84 (seq--drop-list sequence n) 85 (let ((length (seq-length sequence))) 86 (seq-subseq sequence (min n length) length))))) 87 88 (defun seq-take (sequence n) 89 "Return a subsequence of SEQUENCE with its first N elements. 90 The result is a sequence of the same type as SEQUENCE. 91 92 If N is a negative integer or zero, an empty sequence is 93 returned." 94 (if (listp sequence) 95 (seq--take-list sequence n) 96 (seq-subseq sequence 0 (min (max n 0) (seq-length sequence))))) 97 98 (defun seq-drop-while (predicate sequence) 99 "Return a sequence from the first element for which (PREDICATE element) is nil in SEQUENCE. 100 The result is a sequence of the same type as SEQUENCE." 101 (if (listp sequence) 102 (seq--drop-while-list predicate sequence) 103 (seq-drop sequence (seq--count-successive predicate sequence)))) 104 105 (defun seq-take-while (predicate sequence) 106 "Return the successive elements for which (PREDICATE element) is non-nil in SEQUENCE. 107 The result is a sequence of the same type as SEQUENCE." 108 (if (listp sequence) 109 (seq--take-while-list predicate sequence) 110 (seq-take sequence (seq--count-successive predicate sequence)))) 111 112 (defun seq-filter (predicate sequence) 113 "Return a list of all the elements for which (PREDICATE element) is non-nil in SEQUENCE." 114 (let ((exclude (make-symbol "exclude"))) 115 (delq exclude (seq-map (lambda (elt) 116 (if (funcall predicate elt) 117 elt 118 exclude)) 119 sequence)))) 120 121 (defun seq-map-indexed (function sequence) 122 "Return the result of applying FUNCTION to each element of SEQUENCE. 123 Unlike `seq-map', FUNCTION takes two arguments: the element of 124 the sequence, and its index within the sequence." 125 (let ((index 0)) 126 (seq-map (lambda (elt) 127 (prog1 128 (funcall function elt index) 129 (setq index (1+ index)))) 130 sequence))) 131 132 (defun seq-remove (predicate sequence) 133 "Return a list of all the elements for which (PREDICATE element) is nil in SEQUENCE." 134 (seq-filter (lambda (elt) (not (funcall predicate elt))) 135 sequence)) 136 137 (defun seq-reduce (function sequence initial-value) 138 "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE. 139 140 Return the result of calling FUNCTION with INITIAL-VALUE and the 141 first element of SEQUENCE, then calling FUNCTION with that result and 142 the second element of SEQUENCE, then with that result and the third 143 element of SEQUENCE, etc. 144 145 If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called." 146 (if (seq-empty-p sequence) 147 initial-value 148 (let ((acc initial-value)) 149 (seq-doseq (elt sequence) 150 (setq acc (funcall function acc elt))) 151 acc))) 152 153 (defun seq-some (predicate sequence) 154 "Return the first value for which if (PREDICATE element) is non-nil for in SEQUENCE." 155 (catch 'seq--break 156 (seq-doseq (elt sequence) 157 (let ((result (funcall predicate elt))) 158 (when result 159 (throw 'seq--break result)))) 160 nil)) 161 162 (defun seq-find (predicate sequence &optional default) 163 "Return the first element for which (PREDICATE element) is non-nil in SEQUENCE. 164 If no element is found, return DEFAULT. 165 166 Note that `seq-find' has an ambiguity if the found element is 167 identical to DEFAULT, as it cannot be known if an element was 168 found or not." 169 (catch 'seq--break 170 (seq-doseq (elt sequence) 171 (when (funcall predicate elt) 172 (throw 'seq--break elt))) 173 default)) 174 175 (defun seq-every-p (predicate sequence) 176 "Return non-nil if (PREDICATE element) is non-nil for all elements of the sequence SEQUENCE." 177 (catch 'seq--break 178 (seq-doseq (elt sequence) 179 (or (funcall predicate elt) 180 (throw 'seq--break nil))) 181 t)) 182 183 (defun seq-count (predicate sequence) 184 "Return the number of elements for which (PREDICATE element) is non-nil in SEQUENCE." 185 (let ((count 0)) 186 (seq-doseq (elt sequence) 187 (when (funcall predicate elt) 188 (setq count (+ 1 count)))) 189 count)) 190 191 (defun seq-empty-p (sequence) 192 "Return non-nil if the sequence SEQUENCE is empty, nil otherwise." 193 (if (listp sequence) 194 (null sequence) 195 (= 0 (seq-length sequence)))) 196 197 (defun seq-sort (predicate sequence) 198 "Return a sorted sequence comparing using PREDICATE the elements of SEQUENCE. 199 The result is a sequence of the same type as SEQUENCE." 200 (if (listp sequence) 201 (sort (seq-copy sequence) predicate) 202 (let ((result (seq-sort predicate (append sequence nil)))) 203 (seq-into result (type-of sequence))))) 204 205 (defun seq-sort-by (function pred sequence) 206 "Sort SEQUENCE using PRED as a comparison function. 207 Elements of SEQUENCE are transformed by FUNCTION before being 208 sorted. FUNCTION must be a function of one argument." 209 (seq-sort (lambda (a b) 210 (funcall pred 211 (funcall function a) 212 (funcall function b))) 213 sequence)) 214 215 (defun seq-contains (sequence elt &optional testfn) 216 "Return the first element in SEQUENCE that equals to ELT. 217 Equality is defined by TESTFN if non-nil or by `equal' if nil." 218 (seq-some (lambda (e) 219 (funcall (or testfn #'equal) elt e)) 220 sequence)) 221 222 (defun seq-set-equal-p (sequence1 sequence2 &optional testfn) 223 "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order. 224 Equality is defined by TESTFN if non-nil or by `equal' if nil." 225 (and (seq-every-p (lambda (item1) (seq-contains sequence2 item1 testfn)) sequence1) 226 (seq-every-p (lambda (item2) (seq-contains sequence1 item2 testfn)) sequence2))) 227 228 (defun seq-position (sequence elt &optional testfn) 229 "Return the index of the first element in SEQUENCE that is equal to ELT. 230 Equality is defined by TESTFN if non-nil or by `equal' if nil." 231 (let ((index 0)) 232 (catch 'seq--break 233 (seq-doseq (e sequence) 234 (when (funcall (or testfn #'equal) e elt) 235 (throw 'seq--break index)) 236 (setq index (1+ index))) 237 nil))) 238 239 (defun seq-uniq (sequence &optional testfn) 240 "Return a list of the elements of SEQUENCE with duplicates removed. 241 TESTFN is used to compare elements, or `equal' if TESTFN is nil." 242 (let ((result '())) 243 (seq-doseq (elt sequence) 244 (unless (seq-contains result elt testfn) 245 (setq result (cons elt result)))) 246 (nreverse result))) 247 248 (defun seq-subseq (sequence start &optional end) 249 "Return the subsequence of SEQUENCE from START to END. 250 If END is omitted, it defaults to the length of the sequence. 251 If START or END is negative, it counts from the end." 252 (cond ((or (stringp sequence) (vectorp sequence)) (substring sequence start end)) 253 ((listp sequence) 254 (let (len (errtext (format "Bad bounding indices: %s, %s" start end))) 255 (and end (< end 0) (setq end (+ end (setq len (seq-length sequence))))) 256 (if (< start 0) (setq start (+ start (or len (setq len (seq-length sequence)))))) 257 (when (> start 0) 258 (setq sequence (nthcdr (1- start) sequence)) 259 (or sequence (error "%s" errtext)) 260 (setq sequence (cdr sequence))) 261 (if end 262 (let ((res nil)) 263 (while (and (>= (setq end (1- end)) start) sequence) 264 (push (pop sequence) res)) 265 (or (= (1+ end) start) (error "%s" errtext)) 266 (nreverse res)) 267 (seq-copy sequence)))) 268 (t (error "Unsupported sequence: %s" sequence)))) 269 270 (defun seq-concatenate (type &rest seqs) 271 "Concatenate, into a sequence of type TYPE, the sequences SEQS. 272 TYPE must be one of following symbols: vector, string or list. 273 274 \n(fn TYPE SEQUENCE...)" 275 (pcase type 276 (`vector (apply #'vconcat seqs)) 277 (`string (apply #'concat seqs)) 278 (`list (apply #'append (append seqs '(nil)))) 279 (_ (error "Not a sequence type name: %S" type)))) 280 281 (defun seq-mapcat (function sequence &optional type) 282 "Concatenate the result of applying FUNCTION to each element of SEQUENCE. 283 The result is a sequence of type TYPE, or a list if TYPE is nil." 284 (apply #'seq-concatenate (or type 'list) 285 (seq-map function sequence))) 286 287 (defun seq-mapn (function sequence &rest seqs) 288 "Like `seq-map' but FUNCTION is mapped over all SEQS. 289 The arity of FUNCTION must match the number of SEQS, and the 290 mapping stops on the shortest sequence. 291 Return a list of the results. 292 293 \(fn FUNCTION SEQS...)" 294 (let ((result nil) 295 (seqs (seq-map (lambda (s) 296 (seq-into s 'list)) 297 (cons sequence seqs)))) 298 (while (not (memq nil seqs)) 299 (push (apply function (seq-map #'car seqs)) result) 300 (setq seqs (seq-map #'cdr seqs))) 301 (nreverse result))) 302 303 (defun seq-partition (sequence n) 304 "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N. 305 The last sequence may contain less than N elements. If N is a 306 negative integer or 0, nil is returned." 307 (unless (< n 1) 308 (let ((result '())) 309 (while (not (seq-empty-p sequence)) 310 (push (seq-take sequence n) result) 311 (setq sequence (seq-drop sequence n))) 312 (nreverse result)))) 313 314 (defun seq-intersection (seq1 seq2 &optional testfn) 315 "Return a list of the elements that appear in both SEQ1 and SEQ2. 316 Equality is defined by TESTFN if non-nil or by `equal' if nil." 317 (seq-reduce (lambda (acc elt) 318 (if (seq-contains seq2 elt testfn) 319 (cons elt acc) 320 acc)) 321 (seq-reverse seq1) 322 '())) 323 324 (defun seq-difference (seq1 seq2 &optional testfn) 325 "Return a list of the elements that appear in SEQ1 but not in SEQ2. 326 Equality is defined by TESTFN if non-nil or by `equal' if nil." 327 (seq-reduce (lambda (acc elt) 328 (if (not (seq-contains seq2 elt testfn)) 329 (cons elt acc) 330 acc)) 331 (seq-reverse seq1) 332 '())) 333 334 (defun seq-group-by (function sequence) 335 "Apply FUNCTION to each element of SEQUENCE. 336 Separate the elements of SEQUENCE into an alist using the results as 337 keys. Keys are compared using `equal'." 338 (seq-reduce 339 (lambda (acc elt) 340 (let* ((key (funcall function elt)) 341 (cell (assoc key acc))) 342 (if cell 343 (setcdr cell (push elt (cdr cell))) 344 (push (list key elt) acc)) 345 acc)) 346 (seq-reverse sequence) 347 nil)) 348 349 (defalias 'seq-reverse 350 (if (ignore-errors (reverse [1 2])) 351 #'reverse 352 (lambda (sequence) 353 "Return the reversed copy of list, vector, or string SEQUENCE. 354 See also the function `nreverse', which is used more often." 355 (let ((result '())) 356 (seq-map (lambda (elt) (push elt result)) 357 sequence) 358 (if (listp sequence) 359 result 360 (seq-into result (type-of sequence))))))) 361 362 (defun seq-into (sequence type) 363 "Convert the sequence SEQUENCE into a sequence of type TYPE. 364 TYPE can be one of the following symbols: vector, string or list." 365 (pcase type 366 (`vector (seq--into-vector sequence)) 367 (`string (seq--into-string sequence)) 368 (`list (seq--into-list sequence)) 369 (_ (error "Not a sequence type name: %S" type)))) 370 371 (defun seq-min (sequence) 372 "Return the smallest element of SEQUENCE. 373 SEQUENCE must be a sequence of numbers or markers." 374 (apply #'min (seq-into sequence 'list))) 375 376 (defun seq-max (sequence) 377 "Return the largest element of SEQUENCE. 378 SEQUENCE must be a sequence of numbers or markers." 379 (apply #'max (seq-into sequence 'list))) 380 381 (defun seq-random-elt (sequence) 382 "Return a random element from SEQUENCE. 383 Signal an error if SEQUENCE is empty." 384 (if (seq-empty-p sequence) 385 (error "Sequence cannot be empty") 386 (seq-elt sequence (random (seq-length sequence))))) 387 388 (defun seq--drop-list (list n) 389 "Return a list from LIST without its first N elements. 390 This is an optimization for lists in `seq-drop'." 391 (nthcdr n list)) 392 393 (defun seq--take-list (list n) 394 "Return a list from LIST made of its first N elements. 395 This is an optimization for lists in `seq-take'." 396 (let ((result '())) 397 (while (and list (> n 0)) 398 (setq n (1- n)) 399 (push (pop list) result)) 400 (nreverse result))) 401 402 (defun seq--drop-while-list (predicate list) 403 "Return a list from the first element for which (PREDICATE element) is nil in LIST. 404 This is an optimization for lists in `seq-drop-while'." 405 (while (and list (funcall predicate (car list))) 406 (setq list (cdr list))) 407 list) 408 409 (defun seq--take-while-list (predicate list) 410 "Return the successive elements for which (PREDICATE element) is non-nil in LIST. 411 This is an optimization for lists in `seq-take-while'." 412 (let ((result '())) 413 (while (and list (funcall predicate (car list))) 414 (push (pop list) result)) 415 (nreverse result))) 416 417 (defun seq--count-successive (predicate sequence) 418 "Return the number of successive elements for which (PREDICATE element) is non-nil in SEQUENCE." 419 (let ((n 0) 420 (len (seq-length sequence))) 421 (while (and (< n len) 422 (funcall predicate (seq-elt sequence n))) 423 (setq n (+ 1 n))) 424 n)) 425 426 ;; Helper function for the Backward-compatible version of `seq-let' 427 ;; for Emacs<25.1. 428 (defun seq--make-bindings (args sequence &optional bindings) 429 "Return a list of bindings of the variables in ARGS to the elements of a sequence. 430 if BINDINGS is non-nil, append new bindings to it, and return 431 BINDINGS." 432 (let ((index 0) 433 (rest-marker nil)) 434 (seq-doseq (name args) 435 (unless rest-marker 436 (pcase name 437 ((pred seqp) 438 (setq bindings (seq--make-bindings (seq--elt-safe args index) 439 `(seq--elt-safe ,sequence ,index) 440 bindings))) 441 (`&rest 442 (progn (push `(,(seq--elt-safe args (1+ index)) 443 (seq-drop ,sequence ,index)) 444 bindings) 445 (setq rest-marker t))) 446 (_ 447 (push `(,name (seq--elt-safe ,sequence ,index)) bindings)))) 448 (setq index (1+ index))) 449 bindings)) 450 451 (defun seq--elt-safe (sequence n) 452 "Return element of SEQUENCE at the index N. 453 If no element is found, return nil." 454 (when (or (listp sequence) 455 (and (sequencep sequence) 456 (> (seq-length sequence) n))) 457 (seq-elt sequence n))) 458 459 (defun seq--activate-font-lock-keywords () 460 "Activate font-lock keywords for some symbols defined in seq." 461 (font-lock-add-keywords 'emacs-lisp-mode 462 '("\\<seq-doseq\\>" "\\<seq-let\\>"))) 463 464 (defalias 'seq-copy #'copy-sequence) 465 (defalias 'seq-elt #'elt) 466 (defalias 'seq-length #'length) 467 (defalias 'seq-do #'mapc) 468 (defalias 'seq-each #'seq-do) 469 (defalias 'seq-map #'mapcar) 470 (defalias 'seqp #'sequencep) 471 472 (defun seq--into-list (sequence) 473 "Concatenate the elements of SEQUENCE into a list." 474 (if (listp sequence) 475 sequence 476 (append sequence nil))) 477 478 (defun seq--into-vector (sequence) 479 "Concatenate the elements of SEQUENCE into a vector." 480 (if (vectorp sequence) 481 sequence 482 (vconcat sequence))) 483 484 (defun seq--into-string (sequence) 485 "Concatenate the elements of SEQUENCE into a string." 486 (if (stringp sequence) 487 sequence 488 (concat sequence))) 489 490 (unless (fboundp 'elisp--font-lock-flush-elisp-buffers) 491 ;; In Emacsā„25, (via elisp--font-lock-flush-elisp-buffers and a few others) 492 ;; we automatically highlight macros. 493 (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords)) 494 495 (provide 'seq-24) 496 ;;; seq-24.el ends here