config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

dash.el (148312B)


      1 ;;; dash.el --- A modern list library for Emacs  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2012-2024 Free Software Foundation, Inc.
      4 
      5 ;; Author: Magnar Sveen <magnars@gmail.com>
      6 ;; Version: 2.19.1
      7 ;; Package-Requires: ((emacs "24"))
      8 ;; Keywords: extensions, lisp
      9 ;; Homepage: https://github.com/magnars/dash.el
     10 
     11 ;; This program is free software: you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 
     16 ;; This program is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
     23 
     24 ;;; Commentary:
     25 
     26 ;; A modern list API for Emacs.
     27 ;;
     28 ;; See its overview at https://github.com/magnars/dash.el#functions.
     29 
     30 ;;; Code:
     31 
     32 (eval-when-compile
     33   ;; TODO: Emacs 24.3 first introduced `gv', so remove this and all
     34   ;; calls to `defsetf' when support for earlier versions is dropped.
     35   (unless (fboundp 'gv-define-setter)
     36     (require 'cl))
     37 
     38   ;; - 24.3 started complaining about unknown `declare' props.
     39   ;; - 25 introduced `pure' and `side-effect-free'.
     40   ;; - 30 introduced `important-return-value'.
     41   (when (boundp 'defun-declarations-alist)
     42     (dolist (prop '(important-return-value pure side-effect-free))
     43       (unless (assq prop defun-declarations-alist)
     44         (push (list prop #'ignore) defun-declarations-alist)))))
     45 
     46 (defgroup dash ()
     47   "Customize group for Dash, a modern list library."
     48   :group 'extensions
     49   :group 'lisp
     50   :prefix "dash-")
     51 
     52 (defmacro !cons (car cdr)
     53   "Destructive: Set CDR to the cons of CAR and CDR."
     54   (declare (debug (form symbolp)))
     55   `(setq ,cdr (cons ,car ,cdr)))
     56 
     57 (defmacro !cdr (list)
     58   "Destructive: Set LIST to the cdr of LIST."
     59   (declare (debug (symbolp)))
     60   `(setq ,list (cdr ,list)))
     61 
     62 (defmacro --each (list &rest body)
     63   "Evaluate BODY for each element of LIST and return nil.
     64 Each element of LIST in turn is bound to `it' and its index
     65 within LIST to `it-index' before evaluating BODY.
     66 This is the anaphoric counterpart to `-each'."
     67   (declare (debug (form body)) (indent 1))
     68   (let ((l (make-symbol "list"))
     69         (i (make-symbol "i")))
     70     `(let ((,l ,list)
     71            (,i 0))
     72        (while ,l
     73          (let ((it (pop ,l)) (it-index ,i))
     74            (ignore it it-index)
     75            ,@body)
     76          (setq ,i (1+ ,i))))))
     77 
     78 (defun -each (list fn)
     79   "Call FN on each element of LIST.
     80 Return nil; this function is intended for side effects.
     81 
     82 Its anaphoric counterpart is `--each'.
     83 
     84 For access to the current element's index in LIST, see
     85 `-each-indexed'."
     86   (declare (indent 1))
     87   (ignore (mapc fn list)))
     88 
     89 (defalias '--each-indexed '--each)
     90 
     91 (defun -each-indexed (list fn)
     92   "Call FN on each index and element of LIST.
     93 For each ITEM at INDEX in LIST, call (funcall FN INDEX ITEM).
     94 Return nil; this function is intended for side effects.
     95 
     96 See also: `-map-indexed'."
     97   (declare (indent 1))
     98   (--each list (funcall fn it-index it)))
     99 
    100 (defmacro --each-while (list pred &rest body)
    101   "Evaluate BODY for each item in LIST, while PRED evaluates to non-nil.
    102 Each element of LIST in turn is bound to `it' and its index
    103 within LIST to `it-index' before evaluating PRED or BODY.  Once
    104 an element is reached for which PRED evaluates to nil, no further
    105 BODY is evaluated.  The return value is always nil.
    106 This is the anaphoric counterpart to `-each-while'."
    107   (declare (debug (form form body)) (indent 2))
    108   (let ((l (make-symbol "list"))
    109         (i (make-symbol "i"))
    110         (elt (make-symbol "elt")))
    111     `(let ((,l ,list)
    112            (,i 0)
    113            ,elt)
    114        (while (when ,l
    115                 (setq ,elt (car-safe ,l))
    116                 (let ((it ,elt) (it-index ,i))
    117                   (ignore it it-index)
    118                   ,pred))
    119          (let ((it ,elt) (it-index ,i))
    120            (ignore it it-index)
    121            ,@body)
    122          (setq ,i (1+ ,i) ,l (cdr ,l))))))
    123 
    124 (defun -each-while (list pred fn)
    125   "Call FN on each ITEM in LIST, while (PRED ITEM) is non-nil.
    126 Once an ITEM is reached for which PRED returns nil, FN is no
    127 longer called.  Return nil; this function is intended for side
    128 effects.
    129 
    130 Its anaphoric counterpart is `--each-while'."
    131   (declare (indent 2))
    132   (--each-while list (funcall pred it) (funcall fn it)))
    133 
    134 (defmacro --each-r (list &rest body)
    135   "Evaluate BODY for each element of LIST in reversed order.
    136 Each element of LIST in turn, starting at its end, is bound to
    137 `it' and its index within LIST to `it-index' before evaluating
    138 BODY.  The return value is always nil.
    139 This is the anaphoric counterpart to `-each-r'."
    140   (declare (debug (form body)) (indent 1))
    141   (let ((v (make-symbol "vector"))
    142         (i (make-symbol "i")))
    143     ;; Implementation note: building a vector is considerably faster
    144     ;; than building a reversed list (vector takes less memory, so
    145     ;; there is less GC), plus `length' comes naturally.  In-place
    146     ;; `nreverse' would be faster still, but BODY would be able to see
    147     ;; that, even if the modification was undone before we return.
    148     `(let* ((,v (vconcat ,list))
    149             (,i (length ,v))
    150             it it-index)
    151        (ignore it it-index)
    152        (while (> ,i 0)
    153          (setq ,i (1- ,i) it-index ,i it (aref ,v ,i))
    154          ,@body))))
    155 
    156 (defun -each-r (list fn)
    157   "Call FN on each element of LIST in reversed order.
    158 Return nil; this function is intended for side effects.
    159 
    160 Its anaphoric counterpart is `--each-r'."
    161   (--each-r list (funcall fn it)))
    162 
    163 (defmacro --each-r-while (list pred &rest body)
    164   "Eval BODY for each item in reversed LIST, while PRED evals to non-nil.
    165 Each element of LIST in turn, starting at its end, is bound to
    166 `it' and its index within LIST to `it-index' before evaluating
    167 PRED or BODY.  Once an element is reached for which PRED
    168 evaluates to nil, no further BODY is evaluated.  The return value
    169 is always nil.
    170 This is the anaphoric counterpart to `-each-r-while'."
    171   (declare (debug (form form body)) (indent 2))
    172   (let ((v (make-symbol "vector"))
    173         (i (make-symbol "i"))
    174         (elt (make-symbol "elt")))
    175     `(let* ((,v (vconcat ,list))
    176             (,i (length ,v))
    177             ,elt it it-index)
    178        (ignore it it-index)
    179        (while (when (> ,i 0)
    180                 (setq ,i (1- ,i) it-index ,i)
    181                 (setq ,elt (aref ,v ,i) it ,elt)
    182                 ,pred)
    183          (setq it-index ,i it ,elt)
    184          ,@body))))
    185 
    186 (defun -each-r-while (list pred fn)
    187   "Call FN on each ITEM in reversed LIST, while (PRED ITEM) is non-nil.
    188 Once an ITEM is reached for which PRED returns nil, FN is no
    189 longer called.  Return nil; this function is intended for side
    190 effects.
    191 
    192 Its anaphoric counterpart is `--each-r-while'."
    193   (--each-r-while list (funcall pred it) (funcall fn it)))
    194 
    195 (defmacro --dotimes (num &rest body)
    196   "Evaluate BODY NUM times, presumably for side effects.
    197 BODY is evaluated with the local variable `it' temporarily bound
    198 to successive integers running from 0, inclusive, to NUM,
    199 exclusive.  BODY is not evaluated if NUM is less than 1.
    200 This is the anaphoric counterpart to `-dotimes'."
    201   (declare (debug (form body)) (indent 1))
    202   (let ((n (make-symbol "num"))
    203         (i (make-symbol "i")))
    204     `(let ((,n ,num)
    205            (,i 0)
    206            it)
    207        (ignore it)
    208        (while (< ,i ,n)
    209          (setq it ,i ,i (1+ ,i))
    210          ,@body))))
    211 
    212 (defun -dotimes (num fn)
    213   "Call FN NUM times, presumably for side effects.
    214 FN is called with a single argument on successive integers
    215 running from 0, inclusive, to NUM, exclusive.  FN is not called
    216 if NUM is less than 1.
    217 
    218 This function's anaphoric counterpart is `--dotimes'."
    219   (declare (indent 1))
    220   (--dotimes num (funcall fn it)))
    221 
    222 (defun -map (fn list)
    223   "Apply FN to each item in LIST and return the list of results.
    224 
    225 This function's anaphoric counterpart is `--map'."
    226   (declare (important-return-value t))
    227   (mapcar fn list))
    228 
    229 (defmacro --map (form list)
    230   "Eval FORM for each item in LIST and return the list of results.
    231 Each element of LIST in turn is bound to `it' before evaluating
    232 FORM.
    233 This is the anaphoric counterpart to `-map'."
    234   (declare (debug (def-form form)))
    235   `(mapcar (lambda (it) (ignore it) ,form) ,list))
    236 
    237 (defmacro --reduce-from (form init list)
    238   "Accumulate a value by evaluating FORM across LIST.
    239 This macro is like `--each' (which see), but it additionally
    240 provides an accumulator variable `acc' which it successively
    241 binds to the result of evaluating FORM for the current LIST
    242 element before processing the next element.  For the first
    243 element, `acc' is initialized with the result of evaluating INIT.
    244 The return value is the resulting value of `acc'.  If LIST is
    245 empty, FORM is not evaluated, and the return value is the result
    246 of INIT.
    247 This is the anaphoric counterpart to `-reduce-from'."
    248   (declare (debug (form form form)))
    249   `(let ((acc ,init))
    250      (--each ,list (setq acc ,form))
    251      acc))
    252 
    253 (defun -reduce-from (fn init list)
    254   "Reduce the function FN across LIST, starting with INIT.
    255 Return the result of applying FN to INIT and the first element of
    256 LIST, then applying FN to that result and the second element,
    257 etc.  If LIST is empty, return INIT without calling FN.
    258 
    259 This function's anaphoric counterpart is `--reduce-from'.
    260 
    261 For other folds, see also `-reduce' and `-reduce-r'."
    262   (declare (important-return-value t))
    263   (--reduce-from (funcall fn acc it) init list))
    264 
    265 (defmacro --reduce (form list)
    266   "Accumulate a value by evaluating FORM across LIST.
    267 This macro is like `--reduce-from' (which see), except the first
    268 element of LIST is taken as INIT.  Thus if LIST contains a single
    269 item, it is returned without evaluating FORM.  If LIST is empty,
    270 FORM is evaluated with `it' and `acc' bound to nil.
    271 This is the anaphoric counterpart to `-reduce'."
    272   (declare (debug (form form)))
    273   (let ((lv (make-symbol "list-value")))
    274     `(let ((,lv ,list))
    275        (if ,lv
    276            (--reduce-from ,form (car ,lv) (cdr ,lv))
    277          ;; Explicit nil binding pacifies lexical "variable left uninitialized"
    278          ;; warning.  See issue #377 and upstream https://bugs.gnu.org/47080.
    279          (let ((acc nil) (it nil))
    280            (ignore acc it)
    281            ,form)))))
    282 
    283 (defun -reduce (fn list)
    284   "Reduce the function FN across LIST.
    285 Return the result of applying FN to the first two elements of
    286 LIST, then applying FN to that result and the third element, etc.
    287 If LIST contains a single element, return it without calling FN.
    288 If LIST is empty, return the result of calling FN with no
    289 arguments.
    290 
    291 This function's anaphoric counterpart is `--reduce'.
    292 
    293 For other folds, see also `-reduce-from' and `-reduce-r'."
    294   (declare (important-return-value t))
    295   (if list
    296       (-reduce-from fn (car list) (cdr list))
    297     (funcall fn)))
    298 
    299 (defmacro --reduce-r-from (form init list)
    300   "Accumulate a value by evaluating FORM across LIST in reverse.
    301 This macro is like `--reduce-from', except it starts from the end
    302 of LIST.
    303 This is the anaphoric counterpart to `-reduce-r-from'."
    304   (declare (debug (form form form)))
    305   `(let ((acc ,init))
    306      (--each-r ,list (setq acc ,form))
    307      acc))
    308 
    309 (defun -reduce-r-from (fn init list)
    310   "Reduce the function FN across LIST in reverse, starting with INIT.
    311 Return the result of applying FN to the last element of LIST and
    312 INIT, then applying FN to the second-to-last element and the
    313 previous result of FN, etc.  That is, the first argument of FN is
    314 the current element, and its second argument the accumulated
    315 value.  If LIST is empty, return INIT without calling FN.
    316 
    317 This function is like `-reduce-from' but the operation associates
    318 from the right rather than left.  In other words, it starts from
    319 the end of LIST and flips the arguments to FN.  Conceptually, it
    320 is like replacing the conses in LIST with applications of FN, and
    321 its last link with INIT, and evaluating the resulting expression.
    322 
    323 This function's anaphoric counterpart is `--reduce-r-from'.
    324 
    325 For other folds, see also `-reduce-r' and `-reduce'."
    326   (declare (important-return-value t))
    327   (--reduce-r-from (funcall fn it acc) init list))
    328 
    329 (defmacro --reduce-r (form list)
    330   "Accumulate a value by evaluating FORM across LIST in reverse order.
    331 This macro is like `--reduce', except it starts from the end of
    332 LIST.
    333 This is the anaphoric counterpart to `-reduce-r'."
    334   (declare (debug (form form)))
    335   `(--reduce ,form (reverse ,list)))
    336 
    337 (defun -reduce-r (fn list)
    338   "Reduce the function FN across LIST in reverse.
    339 Return the result of applying FN to the last two elements of
    340 LIST, then applying FN to the third-to-last element and the
    341 previous result of FN, etc.  That is, the first argument of FN is
    342 the current element, and its second argument the accumulated
    343 value.  If LIST contains a single element, return it without
    344 calling FN.  If LIST is empty, return the result of calling FN
    345 with no arguments.
    346 
    347 This function is like `-reduce' but the operation associates from
    348 the right rather than left.  In other words, it starts from the
    349 end of LIST and flips the arguments to FN.  Conceptually, it is
    350 like replacing the conses in LIST with applications of FN,
    351 ignoring its last link, and evaluating the resulting expression.
    352 
    353 This function's anaphoric counterpart is `--reduce-r'.
    354 
    355 For other folds, see also `-reduce-r-from' and `-reduce'."
    356   (declare (important-return-value t))
    357   (if list
    358       (--reduce-r (funcall fn it acc) list)
    359     (funcall fn)))
    360 
    361 (defmacro --reductions-from (form init list)
    362   "Return a list of FORM's intermediate reductions across LIST.
    363 That is, a list of the intermediate values of the accumulator
    364 when `--reduce-from' (which see) is called with the same
    365 arguments.
    366 This is the anaphoric counterpart to `-reductions-from'."
    367   (declare (debug (form form form)))
    368   `(nreverse
    369     (--reduce-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc)
    370                    (list ,init)
    371                    ,list)))
    372 
    373 (defun -reductions-from (fn init list)
    374   "Return a list of FN's intermediate reductions across LIST.
    375 That is, a list of the intermediate values of the accumulator
    376 when `-reduce-from' (which see) is called with the same
    377 arguments.
    378 
    379 This function's anaphoric counterpart is `--reductions-from'.
    380 
    381 For other folds, see also `-reductions' and `-reductions-r'."
    382   (declare (important-return-value t))
    383   (--reductions-from (funcall fn acc it) init list))
    384 
    385 (defmacro --reductions (form list)
    386   "Return a list of FORM's intermediate reductions across LIST.
    387 That is, a list of the intermediate values of the accumulator
    388 when `--reduce' (which see) is called with the same arguments.
    389 This is the anaphoric counterpart to `-reductions'."
    390   (declare (debug (form form)))
    391   (let ((lv (make-symbol "list-value")))
    392     `(let ((,lv ,list))
    393        (if ,lv
    394            (--reductions-from ,form (car ,lv) (cdr ,lv))
    395          ;; Explicit nil binding pacifies lexical "variable left uninitialized"
    396          ;; warning.  See issue #377 and upstream https://bugs.gnu.org/47080.
    397          (let ((acc nil) (it nil))
    398            (ignore acc it)
    399            (list ,form))))))
    400 
    401 (defun -reductions (fn list)
    402   "Return a list of FN's intermediate reductions across LIST.
    403 That is, a list of the intermediate values of the accumulator
    404 when `-reduce' (which see) is called with the same arguments.
    405 
    406 This function's anaphoric counterpart is `--reductions'.
    407 
    408 For other folds, see also `-reductions' and `-reductions-r'."
    409   (declare (important-return-value t))
    410   (if list
    411       (--reductions-from (funcall fn acc it) (car list) (cdr list))
    412     (list (funcall fn))))
    413 
    414 (defmacro --reductions-r-from (form init list)
    415   "Return a list of FORM's intermediate reductions across reversed LIST.
    416 That is, a list of the intermediate values of the accumulator
    417 when `--reduce-r-from' (which see) is called with the same
    418 arguments.
    419 This is the anaphoric counterpart to `-reductions-r-from'."
    420   (declare (debug (form form form)))
    421   `(--reduce-r-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc)
    422                     (list ,init)
    423                     ,list))
    424 
    425 (defun -reductions-r-from (fn init list)
    426   "Return a list of FN's intermediate reductions across reversed LIST.
    427 That is, a list of the intermediate values of the accumulator
    428 when `-reduce-r-from' (which see) is called with the same
    429 arguments.
    430 
    431 This function's anaphoric counterpart is `--reductions-r-from'.
    432 
    433 For other folds, see also `-reductions' and `-reductions-r'."
    434   (declare (important-return-value t))
    435   (--reductions-r-from (funcall fn it acc) init list))
    436 
    437 (defmacro --reductions-r (form list)
    438   "Return a list of FORM's intermediate reductions across reversed LIST.
    439 That is, a list of the intermediate values of the accumulator
    440 when `--reduce-re' (which see) is called with the same arguments.
    441 This is the anaphoric counterpart to `-reductions-r'."
    442   (declare (debug (form list)))
    443   (let ((lv (make-symbol "list-value")))
    444     `(let ((,lv (reverse ,list)))
    445        (if ,lv
    446            (--reduce-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc)
    447                           (list (car ,lv))
    448                           (cdr ,lv))
    449          ;; Explicit nil binding pacifies lexical "variable left uninitialized"
    450          ;; warning.  See issue #377 and upstream https://bugs.gnu.org/47080.
    451          (let ((acc nil) (it nil))
    452            (ignore acc it)
    453            (list ,form))))))
    454 
    455 (defun -reductions-r (fn list)
    456   "Return a list of FN's intermediate reductions across reversed LIST.
    457 That is, a list of the intermediate values of the accumulator
    458 when `-reduce-r' (which see) is called with the same arguments.
    459 
    460 This function's anaphoric counterpart is `--reductions-r'.
    461 
    462 For other folds, see also `-reductions-r-from' and
    463 `-reductions'."
    464   (declare (important-return-value t))
    465   (if list
    466       (--reductions-r (funcall fn it acc) list)
    467     (list (funcall fn))))
    468 
    469 (defmacro --filter (form list)
    470   "Return a new list of the items in LIST for which FORM evals to non-nil.
    471 Each element of LIST in turn is bound to `it' and its index
    472 within LIST to `it-index' before evaluating FORM.
    473 This is the anaphoric counterpart to `-filter'.
    474 For the opposite operation, see also `--remove'."
    475   (declare (debug (form form)))
    476   (let ((r (make-symbol "result")))
    477     `(let (,r)
    478        (--each ,list (when ,form (push it ,r)))
    479        (nreverse ,r))))
    480 
    481 (defun -filter (pred list)
    482   "Return a new list of the items in LIST for which PRED returns non-nil.
    483 
    484 Alias: `-select'.
    485 
    486 This function's anaphoric counterpart is `--filter'.
    487 
    488 For similar operations, see also `-keep' and `-remove'."
    489   (declare (important-return-value t))
    490   (--filter (funcall pred it) list))
    491 
    492 (defalias '-select '-filter)
    493 (defalias '--select '--filter)
    494 
    495 (defmacro --remove (form list)
    496   "Return a new list of the items in LIST for which FORM evals to nil.
    497 Each element of LIST in turn is bound to `it' and its index
    498 within LIST to `it-index' before evaluating FORM.
    499 This is the anaphoric counterpart to `-remove'.
    500 For the opposite operation, see also `--filter'."
    501   (declare (debug (form form)))
    502   `(--filter (not ,form) ,list))
    503 
    504 (defun -remove (pred list)
    505   "Return a new list of the items in LIST for which PRED returns nil.
    506 
    507 Alias: `-reject'.
    508 
    509 This function's anaphoric counterpart is `--remove'.
    510 
    511 For similar operations, see also `-keep' and `-filter'."
    512   (declare (important-return-value t))
    513   (--remove (funcall pred it) list))
    514 
    515 (defalias '-reject '-remove)
    516 (defalias '--reject '--remove)
    517 
    518 (defmacro --remove-first (form list)
    519   "Remove the first item from LIST for which FORM evals to non-nil.
    520 Each element of LIST in turn is bound to `it' and its index
    521 within LIST to `it-index' before evaluating FORM.  This is a
    522 non-destructive operation, but only the front of LIST leading up
    523 to the removed item is a copy; the rest is LIST's original tail.
    524 If no item is removed, then the result is a complete copy.
    525 This is the anaphoric counterpart to `-remove-first'."
    526   (declare (debug (form form)))
    527   (let ((front (make-symbol "front"))
    528         (tail (make-symbol "tail")))
    529     `(let ((,tail ,list) ,front)
    530        (--each-while ,tail (not ,form)
    531          (push (pop ,tail) ,front))
    532        (if ,tail
    533            (nconc (nreverse ,front) (cdr ,tail))
    534          (nreverse ,front)))))
    535 
    536 (defun -remove-first (pred list)
    537   "Remove the first item from LIST for which PRED returns non-nil.
    538 This is a non-destructive operation, but only the front of LIST
    539 leading up to the removed item is a copy; the rest is LIST's
    540 original tail.  If no item is removed, then the result is a
    541 complete copy.
    542 
    543 Alias: `-reject-first'.
    544 
    545 This function's anaphoric counterpart is `--remove-first'.
    546 
    547 See also `-map-first', `-remove-item', and `-remove-last'."
    548   (declare (important-return-value t))
    549   (--remove-first (funcall pred it) list))
    550 
    551 ;; TODO: #'-quoting the macro upsets Emacs 24.
    552 (defalias '-reject-first #'-remove-first)
    553 (defalias '--reject-first '--remove-first)
    554 
    555 (defmacro --remove-last (form list)
    556   "Remove the last item from LIST for which FORM evals to non-nil.
    557 Each element of LIST in turn is bound to `it' before evaluating
    558 FORM.  The result is a copy of LIST regardless of whether an
    559 element is removed.
    560 This is the anaphoric counterpart to `-remove-last'."
    561   (declare (debug (form form)))
    562   `(nreverse (--remove-first ,form (reverse ,list))))
    563 
    564 (defun -remove-last (pred list)
    565   "Remove the last item from LIST for which PRED returns non-nil.
    566 The result is a copy of LIST regardless of whether an element is
    567 removed.
    568 
    569 Alias: `-reject-last'.
    570 
    571 This function's anaphoric counterpart is `--remove-last'.
    572 
    573 See also `-map-last', `-remove-item', and `-remove-first'."
    574   (declare (important-return-value t))
    575   (--remove-last (funcall pred it) list))
    576 
    577 (defalias '-reject-last '-remove-last)
    578 (defalias '--reject-last '--remove-last)
    579 
    580 (defalias '-remove-item #'remove
    581   "Return a copy of LIST with all occurrences of ITEM removed.
    582 The comparison is done with `equal'.
    583 \n(fn ITEM LIST)")
    584 
    585 (defmacro --keep (form list)
    586   "Eval FORM for each item in LIST and return the non-nil results.
    587 Like `--filter', but returns the non-nil results of FORM instead
    588 of the corresponding elements of LIST.  Each element of LIST in
    589 turn is bound to `it' and its index within LIST to `it-index'
    590 before evaluating FORM.
    591 This is the anaphoric counterpart to `-keep'."
    592   (declare (debug (form form)))
    593   (let ((r (make-symbol "result"))
    594         (m (make-symbol "mapped")))
    595     `(let (,r)
    596        (--each ,list (let ((,m ,form)) (when ,m (push ,m ,r))))
    597        (nreverse ,r))))
    598 
    599 (defun -keep (fn list)
    600   "Return a new list of the non-nil results of applying FN to each item in LIST.
    601 Like `-filter', but returns the non-nil results of FN instead of
    602 the corresponding elements of LIST.
    603 
    604 Its anaphoric counterpart is `--keep'."
    605   (declare (important-return-value t))
    606   (--keep (funcall fn it) list))
    607 
    608 (defun -non-nil (list)
    609   "Return a copy of LIST with all nil items removed."
    610   (declare (side-effect-free t))
    611   (--filter it list))
    612 
    613 (defmacro --map-indexed (form list)
    614   "Eval FORM for each item in LIST and return the list of results.
    615 Each element of LIST in turn is bound to `it' and its index
    616 within LIST to `it-index' before evaluating FORM.  This is like
    617 `--map', but additionally makes `it-index' available to FORM.
    618 
    619 This is the anaphoric counterpart to `-map-indexed'."
    620   (declare (debug (form form)))
    621   (let ((r (make-symbol "result")))
    622     `(let (,r)
    623        (--each ,list
    624          (push ,form ,r))
    625        (nreverse ,r))))
    626 
    627 (defun -map-indexed (fn list)
    628   "Apply FN to each index and item in LIST and return the list of results.
    629 This is like `-map', but FN takes two arguments: the index of the
    630 current element within LIST, and the element itself.
    631 
    632 This function's anaphoric counterpart is `--map-indexed'.
    633 
    634 For a side-effecting variant, see also `-each-indexed'."
    635   (declare (important-return-value t))
    636   (--map-indexed (funcall fn it-index it) list))
    637 
    638 (defmacro --map-when (pred rep list)
    639   "Anaphoric form of `-map-when'."
    640   (declare (debug (form form form)))
    641   (let ((r (make-symbol "result")))
    642     `(let (,r)
    643        (--each ,list (!cons (if ,pred ,rep it) ,r))
    644        (nreverse ,r))))
    645 
    646 (defun -map-when (pred rep list)
    647   "Use PRED to conditionally apply REP to each item in LIST.
    648 Return a copy of LIST where the items for which PRED returns nil
    649 are unchanged, and the rest are mapped through the REP function.
    650 
    651 Alias: `-replace-where'
    652 
    653 See also: `-update-at'"
    654   (declare (important-return-value t))
    655   (--map-when (funcall pred it) (funcall rep it) list))
    656 
    657 (defalias '-replace-where '-map-when)
    658 (defalias '--replace-where '--map-when)
    659 
    660 (defun -map-first (pred rep list)
    661   "Use PRED to determine the first item in LIST to call REP on.
    662 Return a copy of LIST where the first item for which PRED returns
    663 non-nil is replaced with the result of calling REP on that item.
    664 
    665 See also: `-map-when', `-replace-first'"
    666   (declare (important-return-value t))
    667   (let (front)
    668     (while (and list (not (funcall pred (car list))))
    669       (push (car list) front)
    670       (!cdr list))
    671     (if list
    672         (-concat (nreverse front) (cons (funcall rep (car list)) (cdr list)))
    673       (nreverse front))))
    674 
    675 (defmacro --map-first (pred rep list)
    676   "Anaphoric form of `-map-first'."
    677   (declare (debug (def-form def-form form)))
    678   `(-map-first (lambda (it) (ignore it) ,pred)
    679                (lambda (it) (ignore it) ,rep)
    680                ,list))
    681 
    682 (defun -map-last (pred rep list)
    683   "Use PRED to determine the last item in LIST to call REP on.
    684 Return a copy of LIST where the last item for which PRED returns
    685 non-nil is replaced with the result of calling REP on that item.
    686 
    687 See also: `-map-when', `-replace-last'"
    688   (declare (important-return-value t))
    689   (nreverse (-map-first pred rep (reverse list))))
    690 
    691 (defmacro --map-last (pred rep list)
    692   "Anaphoric form of `-map-last'."
    693   (declare (debug (def-form def-form form)))
    694   `(-map-last (lambda (it) (ignore it) ,pred)
    695               (lambda (it) (ignore it) ,rep)
    696               ,list))
    697 
    698 (defun -replace (old new list)
    699   "Replace all OLD items in LIST with NEW.
    700 
    701 Elements are compared using `equal'.
    702 
    703 See also: `-replace-at'"
    704   (declare (pure t) (side-effect-free t))
    705   (--map-when (equal it old) new list))
    706 
    707 (defun -replace-first (old new list)
    708   "Replace the first occurrence of OLD with NEW in LIST.
    709 
    710 Elements are compared using `equal'.
    711 
    712 See also: `-map-first'"
    713   (declare (pure t) (side-effect-free t))
    714   (--map-first (equal old it) new list))
    715 
    716 (defun -replace-last (old new list)
    717   "Replace the last occurrence of OLD with NEW in LIST.
    718 
    719 Elements are compared using `equal'.
    720 
    721 See also: `-map-last'"
    722   (declare (pure t) (side-effect-free t))
    723   (--map-last (equal old it) new list))
    724 
    725 (defmacro --mapcat (form list)
    726   "Anaphoric form of `-mapcat'."
    727   (declare (debug (form form)))
    728   `(apply #'append (--map ,form ,list)))
    729 
    730 (defun -mapcat (fn list)
    731   "Return the concatenation of the result of mapping FN over LIST.
    732 Thus function FN should return a list."
    733   (declare (important-return-value t))
    734   (--mapcat (funcall fn it) list))
    735 
    736 (defmacro --iterate (form init n)
    737   "Anaphoric version of `-iterate'."
    738   (declare (debug (form form form)))
    739   (let ((res (make-symbol "result"))
    740         (len (make-symbol "n")))
    741     `(let ((,len ,n))
    742        (when (> ,len 0)
    743          (let* ((it ,init)
    744                 (,res (list it)))
    745            (dotimes (_ (1- ,len))
    746              (push (setq it ,form) ,res))
    747            (nreverse ,res))))))
    748 
    749 (defun -iterate (fun init n)
    750   "Return a list of iterated applications of FUN to INIT.
    751 
    752 This means a list of the form:
    753 
    754   (INIT (FUN INIT) (FUN (FUN INIT)) ...)
    755 
    756 N is the length of the returned list."
    757   (declare (important-return-value t))
    758   (--iterate (funcall fun it) init n))
    759 
    760 (defun -flatten (l)
    761   "Take a nested list L and return its contents as a single, flat list.
    762 
    763 Note that because nil represents a list of zero elements (an
    764 empty list), any mention of nil in L will disappear after
    765 flattening.  If you need to preserve nils, consider `-flatten-n'
    766 or map them to some unique symbol and then map them back.
    767 
    768 Conses of two atoms are considered \"terminals\", that is, they
    769 aren't flattened further.
    770 
    771 See also: `-flatten-n'"
    772   (declare (pure t) (side-effect-free t))
    773   (if (and (listp l) (listp (cdr l)))
    774       (-mapcat '-flatten l)
    775     (list l)))
    776 
    777 (defun -flatten-n (num list)
    778   "Flatten NUM levels of a nested LIST.
    779 
    780 See also: `-flatten'"
    781   (declare (pure t) (side-effect-free t))
    782   (dotimes (_ num)
    783     (setq list (apply #'append (mapcar #'-list list))))
    784   list)
    785 
    786 (defalias '-concat #'append
    787   "Concatenate all the arguments and make the result a list.
    788 The result is a list whose elements are the elements of all the arguments.
    789 Each argument may be a list, vector or string.
    790 
    791 All arguments except the last argument are copied.  The last argument
    792 is just used as the tail of the new list.
    793 
    794 \(fn &rest SEQUENCES)")
    795 
    796 (defalias '-copy #'copy-sequence
    797   "Create a shallow copy of LIST.
    798 
    799 \(fn LIST)")
    800 
    801 (defmacro --splice (pred form list)
    802   "Splice lists generated by FORM in place of items satisfying PRED in LIST.
    803 
    804 Evaluate PRED for each element of LIST in turn bound to `it'.
    805 Whenever the result of PRED is nil, leave that `it' is-is.
    806 Otherwise, evaluate FORM with the same `it' binding still in
    807 place.  The result should be a (possibly empty) list of items to
    808 splice in place of `it' in LIST.
    809 
    810 This can be useful as an alternative to the `,@' construct in a
    811 `\\=`' structure, in case you need to splice several lists at
    812 marked positions (for example with keywords).
    813 
    814 This is the anaphoric counterpart to `-splice'."
    815   (declare (debug (form form form)))
    816   (let ((r (make-symbol "result")))
    817     `(let (,r)
    818        (--each ,list
    819          (if ,pred
    820              (--each ,form (push it ,r))
    821            (push it ,r)))
    822        (nreverse ,r))))
    823 
    824 (defun -splice (pred fun list)
    825   "Splice lists generated by FUN in place of items satisfying PRED in LIST.
    826 
    827 Call PRED on each element of LIST.  Whenever the result of PRED
    828 is nil, leave that `it' as-is.  Otherwise, call FUN on the same
    829 `it' that satisfied PRED.  The result should be a (possibly
    830 empty) list of items to splice in place of `it' in LIST.
    831 
    832 This can be useful as an alternative to the `,@' construct in a
    833 `\\=`' structure, in case you need to splice several lists at
    834 marked positions (for example with keywords).
    835 
    836 This function's anaphoric counterpart is `--splice'.
    837 
    838 See also: `-splice-list', `-insert-at'."
    839   (declare (important-return-value t))
    840   (--splice (funcall pred it) (funcall fun it) list))
    841 
    842 (defun -splice-list (pred new-list list)
    843   "Splice NEW-LIST in place of elements matching PRED in LIST.
    844 
    845 See also: `-splice', `-insert-at'"
    846   (declare (important-return-value t))
    847   (-splice pred (lambda (_) new-list) list))
    848 
    849 (defmacro --splice-list (pred new-list list)
    850   "Anaphoric form of `-splice-list'."
    851   (declare (debug (def-form form form)))
    852   `(-splice-list (lambda (it) (ignore it) ,pred) ,new-list ,list))
    853 
    854 (defun -cons* (&rest args)
    855   "Make a new list from the elements of ARGS.
    856 The last 2 elements of ARGS are used as the final cons of the
    857 result, so if the final element of ARGS is not a list, the result
    858 is a dotted list.  With no ARGS, return nil."
    859   (declare (side-effect-free t))
    860   (let* ((len (length args))
    861          (tail (nthcdr (- len 2) args))
    862          (last (cdr tail)))
    863     (if (null last)
    864         (car args)
    865       (setcdr tail (car last))
    866       args)))
    867 
    868 (defun -snoc (list elem &rest elements)
    869   "Append ELEM to the end of the list.
    870 
    871 This is like `cons', but operates on the end of list.
    872 
    873 If any ELEMENTS are given, append them to the list as well."
    874   (declare (side-effect-free t))
    875   (-concat list (list elem) elements))
    876 
    877 (defmacro --first (form list)
    878   "Return the first item in LIST for which FORM evals to non-nil.
    879 Return nil if no such element is found.
    880 Each element of LIST in turn is bound to `it' and its index
    881 within LIST to `it-index' before evaluating FORM.
    882 This is the anaphoric counterpart to `-first'."
    883   (declare (debug (form form)))
    884   (let ((n (make-symbol "needle")))
    885     `(let (,n)
    886        (--each-while ,list (or (not ,form)
    887                                (ignore (setq ,n it))))
    888        ,n)))
    889 
    890 (defun -first (pred list)
    891   "Return the first item in LIST for which PRED returns non-nil.
    892 Return nil if no such element is found.
    893 
    894 To get the first item in the list no questions asked,
    895 use `-first-item'.
    896 
    897 Alias: `-find'.
    898 
    899 This function's anaphoric counterpart is `--first'."
    900   (declare (important-return-value t))
    901   (--first (funcall pred it) list))
    902 
    903 (defalias '-find #'-first)
    904 (defalias '--find '--first)
    905 
    906 (defmacro --some (form list)
    907   "Return non-nil if FORM evals to non-nil for at least one item in LIST.
    908 If so, return the first such result of FORM.
    909 Each element of LIST in turn is bound to `it' and its index
    910 within LIST to `it-index' before evaluating FORM.
    911 This is the anaphoric counterpart to `-some'."
    912   (declare (debug (form form)))
    913   (let ((n (make-symbol "needle")))
    914     `(let (,n)
    915        (--each-while ,list (not (setq ,n ,form)))
    916        ,n)))
    917 
    918 (defun -some (pred list)
    919   "Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil.
    920 
    921 Alias: `-any'.
    922 
    923 This function's anaphoric counterpart is `--some'."
    924   (declare (important-return-value t))
    925   (--some (funcall pred it) list))
    926 
    927 (defalias '-any '-some)
    928 (defalias '--any '--some)
    929 
    930 (defmacro --every (form list)
    931   "Return non-nil if FORM evals to non-nil for all items in LIST.
    932 If so, return the last such result of FORM.  Otherwise, once an
    933 item is reached for which FORM yields nil, return nil without
    934 evaluating FORM for any further LIST elements.
    935 Each element of LIST in turn is bound to `it' and its index
    936 within LIST to `it-index' before evaluating FORM.
    937 
    938 This macro is like `--every-p', but on success returns the last
    939 non-nil result of FORM instead of just t.
    940 
    941 This is the anaphoric counterpart to `-every'."
    942   (declare (debug (form form)))
    943   (let ((a (make-symbol "all")))
    944     `(let ((,a t))
    945        (--each-while ,list (setq ,a ,form))
    946        ,a)))
    947 
    948 (defun -every (pred list)
    949   "Return non-nil if PRED returns non-nil for all items in LIST.
    950 If so, return the last such result of PRED.  Otherwise, once an
    951 item is reached for which PRED returns nil, return nil without
    952 calling PRED on any further LIST elements.
    953 
    954 This function is like `-every-p', but on success returns the last
    955 non-nil result of PRED instead of just t.
    956 
    957 This function's anaphoric counterpart is `--every'."
    958   (declare (important-return-value t))
    959   (--every (funcall pred it) list))
    960 
    961 (defmacro --last (form list)
    962   "Anaphoric form of `-last'."
    963   (declare (debug (form form)))
    964   (let ((n (make-symbol "needle")))
    965     `(let (,n)
    966        (--each ,list
    967          (when ,form (setq ,n it)))
    968        ,n)))
    969 
    970 (defun -last (pred list)
    971   "Return the last x in LIST where (PRED x) is non-nil, else nil."
    972   (declare (important-return-value t))
    973   (--last (funcall pred it) list))
    974 
    975 (defalias '-first-item #'car
    976   "Return the first item of LIST, or nil on an empty list.
    977 
    978 See also: `-second-item', `-last-item', etc.
    979 
    980 \(fn LIST)")
    981 
    982 ;; Ensure that calls to `-first-item' are compiled to a single opcode,
    983 ;; just like `car'.
    984 (put '-first-item 'byte-opcode 'byte-car)
    985 (put '-first-item 'byte-compile 'byte-compile-one-arg)
    986 (put '-first-item 'pure t)
    987 (put '-first-item 'side-effect-free t)
    988 
    989 (defalias '-second-item #'cadr
    990   "Return the second item of LIST, or nil if LIST is too short.
    991 
    992 See also: `-first-item', `-third-item', etc.
    993 
    994 \(fn LIST)")
    995 
    996 (put '-second-item 'pure t)
    997 (put '-second-item 'side-effect-free t)
    998 
    999 (defalias '-third-item
   1000   (if (fboundp 'caddr)
   1001       #'caddr
   1002     (lambda (list) (car (cddr list))))
   1003   "Return the third item of LIST, or nil if LIST is too short.
   1004 
   1005 See also: `-second-item', `-fourth-item', etc.
   1006 
   1007 \(fn LIST)")
   1008 
   1009 (put '-third-item 'pure t)
   1010 (put '-third-item 'side-effect-free t)
   1011 
   1012 (defalias '-fourth-item
   1013   (if (fboundp 'cadddr)
   1014       #'cadddr
   1015     (lambda (list) (cadr (cddr list))))
   1016   "Return the fourth item of LIST, or nil if LIST is too short.
   1017 
   1018 See also: `-third-item', `-fifth-item', etc.
   1019 
   1020 \(fn LIST)")
   1021 
   1022 (put '-fourth-item 'pure t)
   1023 (put '-fourth-item 'side-effect-free t)
   1024 
   1025 (defun -fifth-item (list)
   1026   "Return the fifth item of LIST, or nil if LIST is too short.
   1027 
   1028 See also: `-fourth-item', `-last-item', etc."
   1029   (declare (pure t) (side-effect-free t))
   1030   (car (cddr (cddr list))))
   1031 
   1032 (defun -last-item (list)
   1033   "Return the last item of LIST, or nil on an empty list.
   1034 
   1035 See also: `-first-item', etc."
   1036   (declare (pure t) (side-effect-free t))
   1037   (car (last list)))
   1038 
   1039 ;; Use `with-no-warnings' to suppress unbound `-last-item' or
   1040 ;; undefined `gv--defsetter' warnings arising from both
   1041 ;; `gv-define-setter' and `defsetf' in certain Emacs versions.
   1042 (with-no-warnings
   1043   (if (fboundp 'gv-define-setter)
   1044       (gv-define-setter -last-item (val x) `(setcar (last ,x) ,val))
   1045     (defsetf -last-item (x) (val) `(setcar (last ,x) ,val))))
   1046 
   1047 (defun -butlast (list)
   1048   "Return a list of all items in list except for the last."
   1049   ;; no alias as we don't want magic optional argument
   1050   (declare (pure t) (side-effect-free t))
   1051   (butlast list))
   1052 
   1053 (defmacro --count (pred list)
   1054   "Anaphoric form of `-count'."
   1055   (declare (debug (form form)))
   1056   (let ((r (make-symbol "result")))
   1057     `(let ((,r 0))
   1058        (--each ,list (when ,pred (setq ,r (1+ ,r))))
   1059        ,r)))
   1060 
   1061 (defun -count (pred list)
   1062   "Counts the number of items in LIST where (PRED item) is non-nil."
   1063   (declare (important-return-value t))
   1064   (--count (funcall pred it) list))
   1065 
   1066 (defun ---truthy? (obj)
   1067   "Return OBJ as a boolean value (t or nil)."
   1068   (declare (pure t) (side-effect-free error-free))
   1069   (and obj t))
   1070 
   1071 (defmacro --any? (form list)
   1072   "Anaphoric form of `-any?'."
   1073   (declare (debug (form form)))
   1074   `(and (--some ,form ,list) t))
   1075 
   1076 (defun -any? (pred list)
   1077   "Return t if (PRED X) is non-nil for any X in LIST, else nil.
   1078 
   1079 Alias: `-any-p', `-some?', `-some-p'"
   1080   (declare (important-return-value t))
   1081   (--any? (funcall pred it) list))
   1082 
   1083 (defalias '-some? '-any?)
   1084 (defalias '--some? '--any?)
   1085 (defalias '-any-p '-any?)
   1086 (defalias '--any-p '--any?)
   1087 (defalias '-some-p '-any?)
   1088 (defalias '--some-p '--any?)
   1089 
   1090 (defmacro --all? (form list)
   1091   "Return t if FORM evals to non-nil for all items in LIST.
   1092 Otherwise, once an item is reached for which FORM yields nil,
   1093 return nil without evaluating FORM for any further LIST elements.
   1094 Each element of LIST in turn is bound to `it' and its index
   1095 within LIST to `it-index' before evaluating FORM.
   1096 
   1097 The similar macro `--every' is more widely useful, since it
   1098 returns the last non-nil result of FORM instead of just t on
   1099 success.
   1100 
   1101 Alias: `--all-p', `--every-p', `--every?'.
   1102 
   1103 This is the anaphoric counterpart to `-all?'."
   1104   (declare (debug (form form)))
   1105   `(and (--every ,form ,list) t))
   1106 
   1107 (defun -all? (pred list)
   1108   "Return t if (PRED X) is non-nil for all X in LIST, else nil.
   1109 In the latter case, stop after the first X for which (PRED X) is
   1110 nil, without calling PRED on any subsequent elements of LIST.
   1111 
   1112 The similar function `-every' is more widely useful, since it
   1113 returns the last non-nil result of PRED instead of just t on
   1114 success.
   1115 
   1116 Alias: `-all-p', `-every-p', `-every?'.
   1117 
   1118 This function's anaphoric counterpart is `--all?'."
   1119   (declare (important-return-value t))
   1120   (--all? (funcall pred it) list))
   1121 
   1122 (defalias '-every? '-all?)
   1123 (defalias '--every? '--all?)
   1124 (defalias '-all-p '-all?)
   1125 (defalias '--all-p '--all?)
   1126 (defalias '-every-p '-all?)
   1127 (defalias '--every-p '--all?)
   1128 
   1129 (defmacro --none? (form list)
   1130   "Anaphoric form of `-none?'."
   1131   (declare (debug (form form)))
   1132   `(--all? (not ,form) ,list))
   1133 
   1134 (defun -none? (pred list)
   1135   "Return t if (PRED X) is nil for all X in LIST, else nil.
   1136 
   1137 Alias: `-none-p'"
   1138   (declare (important-return-value t))
   1139   (--none? (funcall pred it) list))
   1140 
   1141 (defalias '-none-p '-none?)
   1142 (defalias '--none-p '--none?)
   1143 
   1144 (defmacro --only-some? (form list)
   1145   "Anaphoric form of `-only-some?'."
   1146   (declare (debug (form form)))
   1147   (let ((y (make-symbol "yes"))
   1148         (n (make-symbol "no")))
   1149     `(let (,y ,n)
   1150        (--each-while ,list (not (and ,y ,n))
   1151          (if ,form (setq ,y t) (setq ,n t)))
   1152        (---truthy? (and ,y ,n)))))
   1153 
   1154 (defun -only-some? (pred list)
   1155   "Return t if different LIST items both satisfy and do not satisfy PRED.
   1156 That is, if PRED returns both nil for at least one item, and
   1157 non-nil for at least one other item in LIST.  Return nil if all
   1158 items satisfy the predicate or none of them do.
   1159 
   1160 Alias: `-only-some-p'"
   1161   (declare (important-return-value t))
   1162   (--only-some? (funcall pred it) list))
   1163 
   1164 (defalias '-only-some-p '-only-some?)
   1165 (defalias '--only-some-p '--only-some?)
   1166 
   1167 (defun -slice (list from &optional to step)
   1168   "Return copy of LIST, starting from index FROM to index TO.
   1169 
   1170 FROM or TO may be negative.  These values are then interpreted
   1171 modulo the length of the list.
   1172 
   1173 If STEP is a number, only each STEPth item in the resulting
   1174 section is returned.  Defaults to 1."
   1175   (declare (side-effect-free t))
   1176   (let ((length (length list))
   1177         (new-list nil))
   1178     ;; to defaults to the end of the list
   1179     (setq to (or to length))
   1180     (setq step (or step 1))
   1181     ;; handle negative indices
   1182     (when (< from 0)
   1183       (setq from (mod from length)))
   1184     (when (< to 0)
   1185       (setq to (mod to length)))
   1186 
   1187     ;; iterate through the list, keeping the elements we want
   1188     (--each-while list (< it-index to)
   1189       (when (and (>= it-index from)
   1190                  (= (mod (- from it-index) step) 0))
   1191         (push it new-list)))
   1192     (nreverse new-list)))
   1193 
   1194 (defmacro --take-while (form list)
   1195   "Take successive items from LIST for which FORM evals to non-nil.
   1196 Each element of LIST in turn is bound to `it' and its index
   1197 within LIST to `it-index' before evaluating FORM.  Return a new
   1198 list of the successive elements from the start of LIST for which
   1199 FORM evaluates to non-nil.
   1200 This is the anaphoric counterpart to `-take-while'."
   1201   (declare (debug (form form)))
   1202   (let ((r (make-symbol "result")))
   1203     `(let (,r)
   1204        (--each-while ,list ,form (push it ,r))
   1205        (nreverse ,r))))
   1206 
   1207 (defun -take-while (pred list)
   1208   "Take successive items from LIST for which PRED returns non-nil.
   1209 PRED is a function of one argument.  Return a new list of the
   1210 successive elements from the start of LIST for which PRED returns
   1211 non-nil.
   1212 
   1213 This function's anaphoric counterpart is `--take-while'.
   1214 
   1215 For another variant, see also `-drop-while'."
   1216   (declare (important-return-value t))
   1217   (--take-while (funcall pred it) list))
   1218 
   1219 (defmacro --drop-while (form list)
   1220   "Drop successive items from LIST for which FORM evals to non-nil.
   1221 Each element of LIST in turn is bound to `it' and its index
   1222 within LIST to `it-index' before evaluating FORM.  Return the
   1223 tail (not a copy) of LIST starting from its first element for
   1224 which FORM evaluates to nil.
   1225 This is the anaphoric counterpart to `-drop-while'."
   1226   (declare (debug (form form)))
   1227   (let ((l (make-symbol "list")))
   1228     `(let ((,l ,list))
   1229        (--each-while ,l ,form (pop ,l))
   1230        ,l)))
   1231 
   1232 (defun -drop-while (pred list)
   1233   "Drop successive items from LIST for which PRED returns non-nil.
   1234 PRED is a function of one argument.  Return the tail (not a copy)
   1235 of LIST starting from its first element for which PRED returns
   1236 nil.
   1237 
   1238 This function's anaphoric counterpart is `--drop-while'.
   1239 
   1240 For another variant, see also `-take-while'."
   1241   (declare (important-return-value t))
   1242   (--drop-while (funcall pred it) list))
   1243 
   1244 (defun -take (n list)
   1245   "Return a copy of the first N items in LIST.
   1246 Return a copy of LIST if it contains N items or fewer.
   1247 Return nil if N is zero or less.
   1248 
   1249 See also: `-take-last'."
   1250   (declare (side-effect-free t))
   1251   (--take-while (< it-index n) list))
   1252 
   1253 (defun -take-last (n list)
   1254   "Return a copy of the last N items of LIST in order.
   1255 Return a copy of LIST if it contains N items or fewer.
   1256 Return nil if N is zero or less.
   1257 
   1258 See also: `-take'."
   1259   (declare (side-effect-free t))
   1260   (copy-sequence (last list n)))
   1261 
   1262 (defalias '-drop #'nthcdr
   1263   "Return the tail (not a copy) of LIST without the first N items.
   1264 Return nil if LIST contains N items or fewer.
   1265 Return LIST if N is zero or less.
   1266 
   1267 For another variant, see also `-drop-last'.
   1268 \n(fn N LIST)")
   1269 
   1270 (defun -drop-last (n list)
   1271   "Return a copy of LIST without its last N items.
   1272 Return a copy of LIST if N is zero or less.
   1273 Return nil if LIST contains N items or fewer.
   1274 
   1275 See also: `-drop'."
   1276   (declare (side-effect-free t))
   1277   (nbutlast (copy-sequence list) n))
   1278 
   1279 (defun -split-at (n list)
   1280   "Split LIST into two sublists after the Nth element.
   1281 The result is a list of two elements (TAKE DROP) where TAKE is a
   1282 new list of the first N elements of LIST, and DROP is the
   1283 remaining elements of LIST (not a copy).  TAKE and DROP are like
   1284 the results of `-take' and `-drop', respectively, but the split
   1285 is done in a single list traversal."
   1286   (declare (side-effect-free t))
   1287   (let (result)
   1288     (--each-while list (< it-index n)
   1289       (push (pop list) result))
   1290     (list (nreverse result) list)))
   1291 
   1292 (defun -rotate (n list)
   1293   "Rotate LIST N places to the right (left if N is negative).
   1294 The time complexity is O(n)."
   1295   (declare (pure t) (side-effect-free t))
   1296   (cond ((null list) ())
   1297         ((zerop n) (copy-sequence list))
   1298         ((let* ((len (length list))
   1299                 (n-mod-len (mod n len))
   1300                 (new-tail-len (- len n-mod-len)))
   1301            (append (nthcdr new-tail-len list) (-take new-tail-len list))))))
   1302 
   1303 (defun -insert-at (n x list)
   1304   "Return a list with X inserted into LIST at position N.
   1305 
   1306 See also: `-splice', `-splice-list'"
   1307   (declare (pure t) (side-effect-free t))
   1308   (let ((split-list (-split-at n list)))
   1309     (nconc (car split-list) (cons x (cadr split-list)))))
   1310 
   1311 (defun -replace-at (n x list)
   1312   "Return a list with element at Nth position in LIST replaced with X.
   1313 
   1314 See also: `-replace'"
   1315   (declare (pure t) (side-effect-free t))
   1316   (let ((split-list (-split-at n list)))
   1317     (nconc (car split-list) (cons x (cdr (cadr split-list))))))
   1318 
   1319 (defun -update-at (n func list)
   1320   "Use FUNC to update the Nth element of LIST.
   1321 Return a copy of LIST where the Nth element is replaced with the
   1322 result of calling FUNC on it.
   1323 
   1324 See also: `-map-when'"
   1325   (declare (important-return-value t))
   1326   (let ((split-list (-split-at n list)))
   1327     (nconc (car split-list)
   1328            (cons (funcall func (car (cadr split-list)))
   1329                  (cdr (cadr split-list))))))
   1330 
   1331 (defmacro --update-at (n form list)
   1332   "Anaphoric version of `-update-at'."
   1333   (declare (debug (form def-form form)))
   1334   `(-update-at ,n (lambda (it) (ignore it) ,form) ,list))
   1335 
   1336 (defun -remove-at (n list)
   1337   "Return LIST with its element at index N removed.
   1338 That is, remove any element selected as (nth N LIST) from LIST
   1339 and return the result.
   1340 
   1341 This is a non-destructive operation: parts of LIST (but not
   1342 necessarily all of it) are copied as needed to avoid
   1343 destructively modifying it.
   1344 
   1345 See also: `-remove-at-indices', `-remove'."
   1346   (declare (pure t) (side-effect-free t))
   1347   (if (zerop n)
   1348       (cdr list)
   1349     (--remove-first (= it-index n) list)))
   1350 
   1351 (defun -remove-at-indices (indices list)
   1352   "Return LIST with its elements at INDICES removed.
   1353 That is, for each index I in INDICES, remove any element selected
   1354 as (nth I LIST) from LIST.
   1355 
   1356 This is a non-destructive operation: parts of LIST (but not
   1357 necessarily all of it) are copied as needed to avoid
   1358 destructively modifying it.
   1359 
   1360 See also: `-remove-at', `-remove'."
   1361   (declare (pure t) (side-effect-free t))
   1362   (setq indices (--drop-while (< it 0) (-sort #'< indices)))
   1363   (let ((i (pop indices)) res)
   1364     (--each-while list i
   1365       (pop list)
   1366       (if (/= it-index i)
   1367           (push it res)
   1368         (while (and indices (= (car indices) i))
   1369           (pop indices))
   1370         (setq i (pop indices))))
   1371     (nconc (nreverse res) list)))
   1372 
   1373 (defmacro --split-with (pred list)
   1374   "Anaphoric form of `-split-with'."
   1375   (declare (debug (form form)))
   1376   (let ((l (make-symbol "list"))
   1377         (r (make-symbol "result"))
   1378         (c (make-symbol "continue")))
   1379     `(let ((,l ,list)
   1380            (,r nil)
   1381            (,c t))
   1382        (while (and ,l ,c)
   1383          (let ((it (car ,l)))
   1384            (if (not ,pred)
   1385                (setq ,c nil)
   1386              (!cons it ,r)
   1387              (!cdr ,l))))
   1388        (list (nreverse ,r) ,l))))
   1389 
   1390 (defun -split-with (pred list)
   1391   "Split LIST into a prefix satisfying PRED, and the rest.
   1392 The first sublist is the prefix of LIST with successive elements
   1393 satisfying PRED, and the second sublist is the remaining elements
   1394 that do not.  The result is like performing
   1395 
   1396   ((-take-while PRED LIST) (-drop-while PRED LIST))
   1397 
   1398 but in no more than a single pass through LIST."
   1399   (declare (important-return-value t))
   1400   (--split-with (funcall pred it) list))
   1401 
   1402 (defmacro -split-on (item list)
   1403   "Split the LIST each time ITEM is found.
   1404 
   1405 Unlike `-partition-by', the ITEM is discarded from the results.
   1406 Empty lists are also removed from the result.
   1407 
   1408 Comparison is done by `equal'.
   1409 
   1410 See also `-split-when'"
   1411   (declare (debug (def-form form)))
   1412   `(-split-when (lambda (it) (equal it ,item)) ,list))
   1413 
   1414 (defmacro --split-when (form list)
   1415   "Anaphoric version of `-split-when'."
   1416   (declare (debug (def-form form)))
   1417   `(-split-when (lambda (it) (ignore it) ,form) ,list))
   1418 
   1419 (defun -split-when (fn list)
   1420   "Split the LIST on each element where FN returns non-nil.
   1421 
   1422 Unlike `-partition-by', the \"matched\" element is discarded from
   1423 the results.  Empty lists are also removed from the result.
   1424 
   1425 This function can be thought of as a generalization of
   1426 `split-string'."
   1427   (declare (important-return-value t))
   1428   (let (r s)
   1429     (while list
   1430       (if (not (funcall fn (car list)))
   1431           (push (car list) s)
   1432         (when s (push (nreverse s) r))
   1433         (setq s nil))
   1434       (!cdr list))
   1435     (when s (push (nreverse s) r))
   1436     (nreverse r)))
   1437 
   1438 (defmacro --separate (form list)
   1439   "Anaphoric form of `-separate'."
   1440   (declare (debug (form form)))
   1441   (let ((y (make-symbol "yes"))
   1442         (n (make-symbol "no")))
   1443     `(let (,y ,n)
   1444        (--each ,list (if ,form (!cons it ,y) (!cons it ,n)))
   1445        (list (nreverse ,y) (nreverse ,n)))))
   1446 
   1447 (defun -separate (pred list)
   1448   "Split LIST into two sublists based on whether items satisfy PRED.
   1449 The result is like performing
   1450 
   1451   ((-filter PRED LIST) (-remove PRED LIST))
   1452 
   1453 but in a single pass through LIST."
   1454   (declare (important-return-value t))
   1455   (--separate (funcall pred it) list))
   1456 
   1457 (defun dash--partition-all-in-steps-reversed (n step list)
   1458   "Like `-partition-all-in-steps', but the result is reversed."
   1459   (when (< step 1)
   1460     (signal 'wrong-type-argument
   1461             `("Step size < 1 results in juicy infinite loops" ,step)))
   1462   (let (result)
   1463     (while list
   1464       (push (-take n list) result)
   1465       (setq list (nthcdr step list)))
   1466     result))
   1467 
   1468 (defun -partition-all-in-steps (n step list)
   1469   "Partition LIST into sublists of length N that are STEP items apart.
   1470 Adjacent groups may overlap if N exceeds the STEP stride.
   1471 Trailing groups may contain less than N items."
   1472   (declare (pure t) (side-effect-free t))
   1473   (nreverse (dash--partition-all-in-steps-reversed n step list)))
   1474 
   1475 (defun -partition-in-steps (n step list)
   1476   "Partition LIST into sublists of length N that are STEP items apart.
   1477 Like `-partition-all-in-steps', but if there are not enough items
   1478 to make the last group N-sized, those items are discarded."
   1479   (declare (pure t) (side-effect-free t))
   1480   (let ((result (dash--partition-all-in-steps-reversed n step list)))
   1481     (while (and result (< (length (car result)) n))
   1482       (pop result))
   1483     (nreverse result)))
   1484 
   1485 (defun -partition-all (n list)
   1486   "Return a new list with the items in LIST grouped into N-sized sublists.
   1487 The last group may contain less than N items."
   1488   (declare (pure t) (side-effect-free t))
   1489   (-partition-all-in-steps n n list))
   1490 
   1491 (defun -partition (n list)
   1492   "Return a new list with the items in LIST grouped into N-sized sublists.
   1493 If there are not enough items to make the last group N-sized,
   1494 those items are discarded."
   1495   (declare (pure t) (side-effect-free t))
   1496   (-partition-in-steps n n list))
   1497 
   1498 (defmacro --partition-by (form list)
   1499   "Anaphoric form of `-partition-by'."
   1500   (declare (debug (form form)))
   1501   (let ((r (make-symbol "result"))
   1502         (s (make-symbol "sublist"))
   1503         (v (make-symbol "value"))
   1504         (n (make-symbol "new-value"))
   1505         (l (make-symbol "list")))
   1506     `(let ((,l ,list))
   1507        (when ,l
   1508          (let* ((,r nil)
   1509                 (it (car ,l))
   1510                 (,s (list it))
   1511                 (,v ,form)
   1512                 (,l (cdr ,l)))
   1513            (while ,l
   1514              (let* ((it (car ,l))
   1515                     (,n ,form))
   1516                (unless (equal ,v ,n)
   1517                  (!cons (nreverse ,s) ,r)
   1518                  (setq ,s nil)
   1519                  (setq ,v ,n))
   1520                (!cons it ,s)
   1521                (!cdr ,l)))
   1522            (!cons (nreverse ,s) ,r)
   1523            (nreverse ,r))))))
   1524 
   1525 (defun -partition-by (fn list)
   1526   "Apply FN to each item in LIST, splitting it each time FN returns a new value."
   1527   (declare (important-return-value t))
   1528   (--partition-by (funcall fn it) list))
   1529 
   1530 (defmacro --partition-by-header (form list)
   1531   "Anaphoric form of `-partition-by-header'."
   1532   (declare (debug (form form)))
   1533   (let ((r (make-symbol "result"))
   1534         (s (make-symbol "sublist"))
   1535         (h (make-symbol "header-value"))
   1536         (b (make-symbol "seen-body?"))
   1537         (n (make-symbol "new-value"))
   1538         (l (make-symbol "list")))
   1539     `(let ((,l ,list))
   1540        (when ,l
   1541          (let* ((,r nil)
   1542                 (it (car ,l))
   1543                 (,s (list it))
   1544                 (,h ,form)
   1545                 (,b nil)
   1546                 (,l (cdr ,l)))
   1547            (while ,l
   1548              (let* ((it (car ,l))
   1549                     (,n ,form))
   1550                (if (equal ,h ,n)
   1551                    (when ,b
   1552                      (!cons (nreverse ,s) ,r)
   1553                      (setq ,s nil)
   1554                      (setq ,b nil))
   1555                  (setq ,b t))
   1556                (!cons it ,s)
   1557                (!cdr ,l)))
   1558            (!cons (nreverse ,s) ,r)
   1559            (nreverse ,r))))))
   1560 
   1561 (defun -partition-by-header (fn list)
   1562   "Apply FN to the first item in LIST. That is the header
   1563 value. Apply FN to each item in LIST, splitting it each time FN
   1564 returns the header value, but only after seeing at least one
   1565 other value (the body)."
   1566   (declare (important-return-value t))
   1567   (--partition-by-header (funcall fn it) list))
   1568 
   1569 (defmacro --partition-after-pred (form list)
   1570   "Partition LIST after each element for which FORM evaluates to non-nil.
   1571 Each element of LIST in turn is bound to `it' before evaluating
   1572 FORM.
   1573 
   1574 This is the anaphoric counterpart to `-partition-after-pred'."
   1575   (let ((l (make-symbol "list"))
   1576         (r (make-symbol "result"))
   1577         (s (make-symbol "sublist")))
   1578     `(let ((,l ,list) ,r ,s)
   1579        (when ,l
   1580          (--each ,l
   1581            (push it ,s)
   1582            (when ,form
   1583              (push (nreverse ,s) ,r)
   1584              (setq ,s ())))
   1585          (when ,s
   1586            (push (nreverse ,s) ,r))
   1587          (nreverse ,r)))))
   1588 
   1589 (defun -partition-after-pred (pred list)
   1590   "Partition LIST after each element for which PRED returns non-nil.
   1591 
   1592 This function's anaphoric counterpart is `--partition-after-pred'."
   1593   (declare (important-return-value t))
   1594   (--partition-after-pred (funcall pred it) list))
   1595 
   1596 (defun -partition-before-pred (pred list)
   1597   "Partition directly before each time PRED is true on an element of LIST."
   1598   (declare (important-return-value t))
   1599   (nreverse (-map #'reverse
   1600                   (-partition-after-pred pred (reverse list)))))
   1601 
   1602 (defun -partition-after-item (item list)
   1603   "Partition directly after each time ITEM appears in LIST."
   1604   (declare (pure t) (side-effect-free t))
   1605   (-partition-after-pred (lambda (ele) (equal ele item))
   1606                          list))
   1607 
   1608 (defun -partition-before-item (item list)
   1609   "Partition directly before each time ITEM appears in LIST."
   1610   (declare (pure t) (side-effect-free t))
   1611   (-partition-before-pred (lambda (ele) (equal ele item))
   1612                           list))
   1613 
   1614 (defmacro --group-by (form list)
   1615   "Anaphoric form of `-group-by'."
   1616   (declare (debug t))
   1617   (let ((n (make-symbol "n"))
   1618         (k (make-symbol "k"))
   1619         (grp (make-symbol "grp")))
   1620     `(nreverse
   1621       (-map
   1622        (lambda (,n)
   1623          (cons (car ,n)
   1624                (nreverse (cdr ,n))))
   1625        (--reduce-from
   1626         (let* ((,k (,@form))
   1627                (,grp (assoc ,k acc)))
   1628           (if ,grp
   1629               (setcdr ,grp (cons it (cdr ,grp)))
   1630             (push
   1631              (list ,k it)
   1632              acc))
   1633           acc)
   1634         nil ,list)))))
   1635 
   1636 (defun -group-by (fn list)
   1637   "Separate LIST into an alist whose keys are FN applied to the
   1638 elements of LIST.  Keys are compared by `equal'."
   1639   (declare (important-return-value t))
   1640   (--group-by (funcall fn it) list))
   1641 
   1642 (defun -interpose (sep list)
   1643   "Return a new list of all elements in LIST separated by SEP."
   1644   (declare (side-effect-free t))
   1645   (let (result)
   1646     (when list
   1647       (!cons (car list) result)
   1648       (!cdr list))
   1649     (while list
   1650       (setq result (cons (car list) (cons sep result)))
   1651       (!cdr list))
   1652     (nreverse result)))
   1653 
   1654 (defun -interleave (&rest lists)
   1655   "Return a new list of the first item in each list, then the second etc."
   1656   (declare (side-effect-free t))
   1657   (when lists
   1658     (let (result)
   1659       (while (-none? 'null lists)
   1660         (--each lists (!cons (car it) result))
   1661         (setq lists (-map 'cdr lists)))
   1662       (nreverse result))))
   1663 
   1664 (defmacro --zip-with (form list1 list2)
   1665   "Zip LIST1 and LIST2 into a new list according to FORM.
   1666 That is, evaluate FORM for each item pair from the two lists, and
   1667 return the list of results.  The result is as long as the shorter
   1668 list.
   1669 
   1670 Each element of LIST1 and each element of LIST2 in turn are bound
   1671 pairwise to `it' and `other', respectively, and their index
   1672 within the list to `it-index', before evaluating FORM.
   1673 
   1674 This is the anaphoric counterpart to `-zip-with'."
   1675   (declare (debug (form form form)))
   1676   (let ((r (make-symbol "result"))
   1677         (l2 (make-symbol "list2")))
   1678     `(let ((,l2 ,list2) ,r)
   1679        (--each-while ,list1 ,l2
   1680          (let ((other (pop ,l2)))
   1681            (ignore other)
   1682            (push ,form ,r)))
   1683        (nreverse ,r))))
   1684 
   1685 (defun -zip-with (fn list1 list2)
   1686   "Zip LIST1 and LIST2 into a new list using the function FN.
   1687 That is, apply FN pairwise taking as first argument the next
   1688 element of LIST1 and as second argument the next element of LIST2
   1689 at the corresponding position.  The result is as long as the
   1690 shorter list.
   1691 
   1692 This function's anaphoric counterpart is `--zip-with'.
   1693 
   1694 For other zips, see also `-zip-lists' and `-zip-fill'."
   1695   (declare (important-return-value t))
   1696   (--zip-with (funcall fn it other) list1 list2))
   1697 
   1698 (defun -zip-lists (&rest lists)
   1699   "Zip LISTS together.
   1700 
   1701 Group the head of each list, followed by the second element of
   1702 each list, and so on.  The number of returned groupings is equal
   1703 to the length of the shortest input list, and the length of each
   1704 grouping is equal to the number of input LISTS.
   1705 
   1706 The return value is always a list of proper lists, in contrast to
   1707 `-zip' which returns a list of dotted pairs when only two input
   1708 LISTS are provided.
   1709 
   1710 See also: `-zip-pair'."
   1711   (declare (pure t) (side-effect-free t))
   1712   (when lists
   1713     (let (results)
   1714       (while (--every it lists)
   1715         (push (mapcar #'car lists) results)
   1716         (setq lists (mapcar #'cdr lists)))
   1717       (nreverse results))))
   1718 
   1719 (defun -zip-lists-fill (fill-value &rest lists)
   1720   "Zip LISTS together, padding shorter lists with FILL-VALUE.
   1721 This is like `-zip-lists' (which see), except it retains all
   1722 elements at positions beyond the end of the shortest list.  The
   1723 number of returned groupings is equal to the length of the
   1724 longest input list, and the length of each grouping is equal to
   1725 the number of input LISTS."
   1726   (declare (pure t) (side-effect-free t))
   1727   (when lists
   1728     (let (results)
   1729       (while (--some it lists)
   1730         (push (--map (if it (car it) fill-value) lists) results)
   1731         (setq lists (mapcar #'cdr lists)))
   1732       (nreverse results))))
   1733 
   1734 (defun -unzip-lists (lists)
   1735   "Unzip LISTS.
   1736 
   1737 This works just like `-zip-lists' (which see), but takes a list
   1738 of lists instead of a variable number of arguments, such that
   1739 
   1740   (-unzip-lists (-zip-lists ARGS...))
   1741 
   1742 is identity (given that the lists comprising ARGS are of the same
   1743 length)."
   1744   (declare (pure t) (side-effect-free t))
   1745   (apply #'-zip-lists lists))
   1746 
   1747 (defalias 'dash--length=
   1748   (if (fboundp 'length=)
   1749       #'length=
   1750     (lambda (list length)
   1751       (cond ((< length 0) nil)
   1752             ((zerop length) (null list))
   1753             ((let ((last (nthcdr (1- length) list)))
   1754                (and last (null (cdr last))))))))
   1755   "Return non-nil if LIST is of LENGTH.
   1756 This is a compatibility shim for `length=' in Emacs 28.
   1757 \n(fn LIST LENGTH)")
   1758 
   1759 (defun dash--zip-lists-or-pair (_form &rest lists)
   1760   "Return a form equivalent to applying `-zip' to LISTS.
   1761 This `compiler-macro' warns about discouraged `-zip' usage and
   1762 delegates to `-zip-lists' or `-zip-pair' depending on the number
   1763 of LISTS."
   1764   (if (not (dash--length= lists 2))
   1765       (cons #'-zip-lists lists)
   1766     (let ((pair (cons #'-zip-pair lists))
   1767           (msg "Use -zip-pair instead of -zip to get a list of pairs"))
   1768       (if (fboundp 'macroexp-warn-and-return)
   1769           (macroexp-warn-and-return msg pair)
   1770         (message msg)
   1771         pair))))
   1772 
   1773 (defun -zip (&rest lists)
   1774   "Zip LISTS together.
   1775 
   1776 Group the head of each list, followed by the second element of
   1777 each list, and so on.  The number of returned groupings is equal
   1778 to the length of the shortest input list, and the number of items
   1779 in each grouping is equal to the number of input LISTS.
   1780 
   1781 If only two LISTS are provided as arguments, return the groupings
   1782 as a list of dotted pairs.  Otherwise, return the groupings as a
   1783 list of proper lists.
   1784 
   1785 Since the return value changes form depending on the number of
   1786 arguments, it is generally recommended to use `-zip-lists'
   1787 instead, or `-zip-pair' if a list of dotted pairs is desired.
   1788 
   1789 See also: `-unzip'."
   1790   (declare (compiler-macro dash--zip-lists-or-pair)
   1791            (pure t) (side-effect-free t))
   1792   ;; For backward compatibility, return a list of dotted pairs if two
   1793   ;; arguments were provided.
   1794   (apply (if (dash--length= lists 2) #'-zip-pair #'-zip-lists) lists))
   1795 
   1796 (defun -zip-pair (&rest lists)
   1797   "Zip LIST1 and LIST2 together.
   1798 
   1799 Make a pair with the head of each list, followed by a pair with
   1800 the second element of each list, and so on.  The number of pairs
   1801 returned is equal to the length of the shorter input list.
   1802 
   1803 See also: `-zip-lists'."
   1804   (declare (advertised-calling-convention (list1 list2) "2.20.0")
   1805            (pure t) (side-effect-free t))
   1806   (if (dash--length= lists 2)
   1807       (--zip-with (cons it other) (car lists) (cadr lists))
   1808     (apply #'-zip-lists lists)))
   1809 
   1810 (defun -zip-fill (fill-value &rest lists)
   1811   "Zip LISTS together, padding shorter lists with FILL-VALUE.
   1812 This is like `-zip' (which see), except it retains all elements
   1813 at positions beyond the end of the shortest list.  The number of
   1814 returned groupings is equal to the length of the longest input
   1815 list, and the length of each grouping is equal to the number of
   1816 input LISTS.
   1817 
   1818 Since the return value changes form depending on the number of
   1819 arguments, it is generally recommended to use `-zip-lists-fill'
   1820 instead, unless a list of dotted pairs is explicitly desired."
   1821   (declare (pure t) (side-effect-free t))
   1822   (cond ((null lists) ())
   1823         ((dash--length= lists 2)
   1824          (let ((list1 (car lists))
   1825                (list2 (cadr lists))
   1826                results)
   1827            (while (or list1 list2)
   1828              (push (cons (if list1 (pop list1) fill-value)
   1829                          (if list2 (pop list2) fill-value))
   1830                    results))
   1831            (nreverse results)))
   1832         ((apply #'-zip-lists-fill fill-value lists))))
   1833 
   1834 (defun -unzip (lists)
   1835   "Unzip LISTS.
   1836 
   1837 This works just like `-zip' (which see), but takes a list of
   1838 lists instead of a variable number of arguments, such that
   1839 
   1840   (-unzip (-zip L1 L2 L3 ...))
   1841 
   1842 is identity (given that the lists are of the same length, and
   1843 that `-zip' is not called with two arguments, because of the
   1844 caveat described in its docstring).
   1845 
   1846 Note in particular that calling `-unzip' on a list of two lists
   1847 will return a list of dotted pairs.
   1848 
   1849 Since the return value changes form depending on the number of
   1850 LISTS, it is generally recommended to use `-unzip-lists' instead."
   1851   (declare (pure t) (side-effect-free t))
   1852   (apply #'-zip lists))
   1853 
   1854 (defun -cycle (list)
   1855   "Return an infinite circular copy of LIST.
   1856 The returned list cycles through the elements of LIST and repeats
   1857 from the beginning."
   1858   (declare (pure t) (side-effect-free t))
   1859   ;; Also works with sequences that aren't lists.
   1860   (let ((newlist (append list ())))
   1861     (nconc newlist newlist)))
   1862 
   1863 (defun -pad (fill-value &rest lists)
   1864   "Pad each of LISTS with FILL-VALUE until they all have equal lengths.
   1865 
   1866 Ensure all LISTS are as long as the longest one by repeatedly
   1867 appending FILL-VALUE to the shorter lists, and return the
   1868 resulting LISTS."
   1869   (declare (pure t) (side-effect-free t))
   1870   (let* ((lens (mapcar #'length lists))
   1871          (maxlen (apply #'max 0 lens)))
   1872     (--map (append it (make-list (- maxlen (pop lens)) fill-value)) lists)))
   1873 
   1874 (defmacro --annotate (form list)
   1875   "Pair each item in LIST with the result of evaluating FORM.
   1876 
   1877 Return an alist of (RESULT . ITEM), where each ITEM is the
   1878 corresponding element of LIST, and RESULT is the value obtained
   1879 by evaluating FORM with ITEM bound to `it'.
   1880 
   1881 This is the anaphoric counterpart to `-annotate'."
   1882   (declare (debug (form form)))
   1883   `(--map (cons ,form it) ,list))
   1884 
   1885 (defun -annotate (fn list)
   1886   "Pair each item in LIST with the result of passing it to FN.
   1887 
   1888 Return an alist of (RESULT . ITEM), where each ITEM is the
   1889 corresponding element of LIST, and RESULT is the value obtained
   1890 by calling FN on ITEM.
   1891 
   1892 This function's anaphoric counterpart is `--annotate'."
   1893   (declare (important-return-value t))
   1894   (--annotate (funcall fn it) list))
   1895 
   1896 (defun dash--table-carry (lists restore-lists &optional re)
   1897   "Helper for `-table' and `-table-flat'.
   1898 
   1899 If a list overflows, carry to the right and reset the list."
   1900   (while (not (or (car lists)
   1901                   (equal lists '(nil))))
   1902     (setcar lists (car restore-lists))
   1903     (pop (cadr lists))
   1904     (!cdr lists)
   1905     (!cdr restore-lists)
   1906     (when re
   1907       (push (nreverse (car re)) (cadr re))
   1908       (setcar re nil)
   1909       (!cdr re))))
   1910 
   1911 (defun -table (fn &rest lists)
   1912   "Compute outer product of LISTS using function FN.
   1913 
   1914 The function FN should have the same arity as the number of
   1915 supplied lists.
   1916 
   1917 The outer product is computed by applying fn to all possible
   1918 combinations created by taking one element from each list in
   1919 order.  The dimension of the result is (length lists).
   1920 
   1921 See also: `-table-flat'"
   1922   (declare (important-return-value t))
   1923   (let ((restore-lists (copy-sequence lists))
   1924         (last-list (last lists))
   1925         (re (make-list (length lists) nil)))
   1926     (while (car last-list)
   1927       (let ((item (apply fn (-map 'car lists))))
   1928         (push item (car re))
   1929         (setcar lists (cdar lists)) ;; silence byte compiler
   1930         (dash--table-carry lists restore-lists re)))
   1931     (nreverse (car (last re)))))
   1932 
   1933 (defun -table-flat (fn &rest lists)
   1934   "Compute flat outer product of LISTS using function FN.
   1935 
   1936 The function FN should have the same arity as the number of
   1937 supplied lists.
   1938 
   1939 The outer product is computed by applying fn to all possible
   1940 combinations created by taking one element from each list in
   1941 order.  The results are flattened, ignoring the tensor structure
   1942 of the result.  This is equivalent to calling:
   1943 
   1944   (-flatten-n (1- (length lists)) (apply \\='-table fn lists))
   1945 
   1946 but the implementation here is much more efficient.
   1947 
   1948 See also: `-flatten-n', `-table'"
   1949   (declare (important-return-value t))
   1950   (let ((restore-lists (copy-sequence lists))
   1951         (last-list (last lists))
   1952         re)
   1953     (while (car last-list)
   1954       (let ((item (apply fn (-map 'car lists))))
   1955         (push item re)
   1956         (setcar lists (cdar lists)) ;; silence byte compiler
   1957         (dash--table-carry lists restore-lists)))
   1958     (nreverse re)))
   1959 
   1960 (defmacro --find-index (form list)
   1961   "Return the first index in LIST for which FORM evals to non-nil.
   1962 Return nil if no such index is found.
   1963 Each element of LIST in turn is bound to `it' and its index
   1964 within LIST to `it-index' before evaluating FORM.
   1965 This is the anaphoric counterpart to `-find-index'."
   1966   (declare (debug (form form)))
   1967   `(--some (and ,form it-index) ,list))
   1968 
   1969 (defun -find-index (pred list)
   1970   "Return the index of the first item satisfying PRED in LIST.
   1971 Return nil if no such item is found.
   1972 
   1973 PRED is called with one argument, the current list element, until
   1974 it returns non-nil, at which point the search terminates.
   1975 
   1976 This function's anaphoric counterpart is `--find-index'.
   1977 
   1978 See also: `-first', `-find-last-index'."
   1979   (declare (important-return-value t))
   1980   (--find-index (funcall pred it) list))
   1981 
   1982 (defun -elem-index (elem list)
   1983   "Return the first index of ELEM in LIST.
   1984 That is, the index within LIST of the first element that is
   1985 `equal' to ELEM.  Return nil if there is no such element.
   1986 
   1987 See also: `-find-index'."
   1988   (declare (pure t) (side-effect-free t))
   1989   (--find-index (equal elem it) list))
   1990 
   1991 (defmacro --find-indices (form list)
   1992   "Return the list of indices in LIST for which FORM evals to non-nil.
   1993 Each element of LIST in turn is bound to `it' and its index
   1994 within LIST to `it-index' before evaluating FORM.
   1995 This is the anaphoric counterpart to `-find-indices'."
   1996   (declare (debug (form form)))
   1997   `(--keep (and ,form it-index) ,list))
   1998 
   1999 (defun -find-indices (pred list)
   2000   "Return the list of indices in LIST satisfying PRED.
   2001 
   2002 Each element of LIST in turn is passed to PRED.  If the result is
   2003 non-nil, the index of that element in LIST is included in the
   2004 result.  The returned indices are in ascending order, i.e., in
   2005 the same order as they appear in LIST.
   2006 
   2007 This function's anaphoric counterpart is `--find-indices'.
   2008 
   2009 See also: `-find-index', `-elem-indices'."
   2010   (declare (important-return-value t))
   2011   (--find-indices (funcall pred it) list))
   2012 
   2013 (defun -elem-indices (elem list)
   2014   "Return the list of indices at which ELEM appears in LIST.
   2015 That is, the indices of all elements of LIST `equal' to ELEM, in
   2016 the same ascending order as they appear in LIST."
   2017   (declare (pure t) (side-effect-free t))
   2018   (--find-indices (equal elem it) list))
   2019 
   2020 (defmacro --find-last-index (form list)
   2021   "Return the last index in LIST for which FORM evals to non-nil.
   2022 Return nil if no such index is found.
   2023 Each element of LIST in turn is bound to `it' and its index
   2024 within LIST to `it-index' before evaluating FORM.
   2025 This is the anaphoric counterpart to `-find-last-index'."
   2026   (declare (debug (form form)))
   2027   (let ((i (make-symbol "index")))
   2028     `(let (,i)
   2029        (--each ,list
   2030          (when ,form (setq ,i it-index)))
   2031        ,i)))
   2032 
   2033 (defun -find-last-index (pred list)
   2034   "Return the index of the last item satisfying PRED in LIST.
   2035 Return nil if no such item is found.
   2036 
   2037 Predicate PRED is called with one argument each time, namely the
   2038 current list element.
   2039 
   2040 This function's anaphoric counterpart is `--find-last-index'.
   2041 
   2042 See also: `-last', `-find-index'."
   2043   (declare (important-return-value t))
   2044   (--find-last-index (funcall pred it) list))
   2045 
   2046 (defun -select-by-indices (indices list)
   2047   "Return a list whose elements are elements from LIST selected
   2048 as `(nth i list)` for all i from INDICES."
   2049   (declare (pure t) (side-effect-free t))
   2050   (let (r)
   2051     (--each indices
   2052       (!cons (nth it list) r))
   2053     (nreverse r)))
   2054 
   2055 (defun -select-columns (columns table)
   2056   "Select COLUMNS from TABLE.
   2057 
   2058 TABLE is a list of lists where each element represents one row.
   2059 It is assumed each row has the same length.
   2060 
   2061 Each row is transformed such that only the specified COLUMNS are
   2062 selected.
   2063 
   2064 See also: `-select-column', `-select-by-indices'"
   2065   (declare (pure t) (side-effect-free t))
   2066   (--map (-select-by-indices columns it) table))
   2067 
   2068 (defun -select-column (column table)
   2069   "Select COLUMN from TABLE.
   2070 
   2071 TABLE is a list of lists where each element represents one row.
   2072 It is assumed each row has the same length.
   2073 
   2074 The single selected column is returned as a list.
   2075 
   2076 See also: `-select-columns', `-select-by-indices'"
   2077   (declare (pure t) (side-effect-free t))
   2078   (--mapcat (-select-by-indices (list column) it) table))
   2079 
   2080 (defmacro -> (x &optional form &rest more)
   2081   "Thread the expr through the forms. Insert X as the second item
   2082 in the first form, making a list of it if it is not a list
   2083 already. If there are more forms, insert the first form as the
   2084 second item in second form, etc."
   2085   (declare (debug (form &rest [&or symbolp (sexp &rest form)])))
   2086   (cond
   2087    ((null form) x)
   2088    ((null more) (if (listp form)
   2089                     `(,(car form) ,x ,@(cdr form))
   2090                   (list form x)))
   2091    (:else `(-> (-> ,x ,form) ,@more))))
   2092 
   2093 (defmacro ->> (x &optional form &rest more)
   2094   "Thread the expr through the forms. Insert X as the last item
   2095 in the first form, making a list of it if it is not a list
   2096 already. If there are more forms, insert the first form as the
   2097 last item in second form, etc."
   2098   (declare (debug ->))
   2099   (cond
   2100    ((null form) x)
   2101    ((null more) (if (listp form)
   2102                     `(,@form ,x)
   2103                   (list form x)))
   2104    (:else `(->> (->> ,x ,form) ,@more))))
   2105 
   2106 (defmacro --> (x &rest forms)
   2107   "Starting with the value of X, thread each expression through FORMS.
   2108 
   2109 Insert X at the position signified by the symbol `it' in the first
   2110 form.  If there are more forms, insert the first form at the position
   2111 signified by `it' in in second form, etc."
   2112   (declare (debug (form body)))
   2113   `(-as-> ,x it ,@forms))
   2114 
   2115 (defmacro -as-> (value variable &rest forms)
   2116   "Starting with VALUE, thread VARIABLE through FORMS.
   2117 
   2118 In the first form, bind VARIABLE to VALUE.  In the second form, bind
   2119 VARIABLE to the result of the first form, and so forth."
   2120   (declare (debug (form symbolp body)))
   2121   (if (null forms)
   2122       `,value
   2123     `(let ((,variable ,value))
   2124        (-as-> ,(if (symbolp (car forms))
   2125                    (list (car forms) variable)
   2126                  (car forms))
   2127               ,variable
   2128               ,@(cdr forms)))))
   2129 
   2130 (defmacro -some-> (x &optional form &rest more)
   2131   "When expr is non-nil, thread it through the first form (via `->'),
   2132 and when that result is non-nil, through the next form, etc."
   2133   (declare (debug ->)
   2134            (indent 1))
   2135   (if (null form) x
   2136     (let ((result (make-symbol "result")))
   2137       `(-some-> (-when-let (,result ,x)
   2138                   (-> ,result ,form))
   2139          ,@more))))
   2140 
   2141 (defmacro -some->> (x &optional form &rest more)
   2142   "When expr is non-nil, thread it through the first form (via `->>'),
   2143 and when that result is non-nil, through the next form, etc."
   2144   (declare (debug ->)
   2145            (indent 1))
   2146   (if (null form) x
   2147     (let ((result (make-symbol "result")))
   2148       `(-some->> (-when-let (,result ,x)
   2149                    (->> ,result ,form))
   2150          ,@more))))
   2151 
   2152 (defmacro -some--> (expr &rest forms)
   2153   "Thread EXPR through FORMS via `-->', while the result is non-nil.
   2154 When EXPR evaluates to non-nil, thread the result through the
   2155 first of FORMS, and when that result is non-nil, thread it
   2156 through the next form, etc."
   2157   (declare (debug (form &rest &or symbolp consp)) (indent 1))
   2158   (if (null forms) expr
   2159     (let ((result (make-symbol "result")))
   2160       `(-some--> (-when-let (,result ,expr)
   2161                    (--> ,result ,(car forms)))
   2162          ,@(cdr forms)))))
   2163 
   2164 (defmacro -doto (init &rest forms)
   2165   "Evaluate INIT and pass it as argument to FORMS with `->'.
   2166 The RESULT of evaluating INIT is threaded through each of FORMS
   2167 individually using `->', which see.  The return value is RESULT,
   2168 which FORMS may have modified by side effect."
   2169   (declare (debug (form &rest &or symbolp consp)) (indent 1))
   2170   (let ((retval (make-symbol "result")))
   2171     `(let ((,retval ,init))
   2172        ,@(mapcar (lambda (form) `(-> ,retval ,form)) forms)
   2173        ,retval)))
   2174 
   2175 (defmacro --doto (init &rest forms)
   2176   "Anaphoric form of `-doto'.
   2177 This just evaluates INIT, binds the result to `it', evaluates
   2178 FORMS, and returns the final value of `it'.
   2179 Note: `it' need not be used in each form."
   2180   (declare (debug (form body)) (indent 1))
   2181   `(let ((it ,init))
   2182      ,@forms
   2183      it))
   2184 
   2185 (defun -grade-up (comparator list)
   2186   "Grade elements of LIST using COMPARATOR relation.
   2187 This yields a permutation vector such that applying this
   2188 permutation to LIST sorts it in ascending order."
   2189   (declare (important-return-value t))
   2190   (->> (--map-indexed (cons it it-index) list)
   2191        (-sort (lambda (it other) (funcall comparator (car it) (car other))))
   2192        (mapcar #'cdr)))
   2193 
   2194 (defun -grade-down (comparator list)
   2195   "Grade elements of LIST using COMPARATOR relation.
   2196 This yields a permutation vector such that applying this
   2197 permutation to LIST sorts it in descending order."
   2198   (declare (important-return-value t))
   2199   (->> (--map-indexed (cons it it-index) list)
   2200        (-sort (lambda (it other) (funcall comparator (car other) (car it))))
   2201        (mapcar #'cdr)))
   2202 
   2203 (defvar dash--source-counter 0
   2204   "Monotonic counter for generated symbols.")
   2205 
   2206 (defun dash--match-make-source-symbol ()
   2207   "Generate a new dash-source symbol.
   2208 
   2209 All returned symbols are guaranteed to be unique."
   2210   (prog1 (make-symbol (format "--dash-source-%d--" dash--source-counter))
   2211     (setq dash--source-counter (1+ dash--source-counter))))
   2212 
   2213 (defun dash--match-ignore-place-p (symbol)
   2214   "Return non-nil if SYMBOL is a symbol and starts with _."
   2215   (and (symbolp symbol)
   2216        (eq (aref (symbol-name symbol) 0) ?_)))
   2217 
   2218 (defun dash--match-cons-skip-cdr (skip-cdr source)
   2219   "Helper function generating idiomatic shifting code."
   2220   (cond
   2221    ((= skip-cdr 0)
   2222     `(pop ,source))
   2223    (t
   2224     `(prog1 ,(dash--match-cons-get-car skip-cdr source)
   2225        (setq ,source ,(dash--match-cons-get-cdr (1+ skip-cdr) source))))))
   2226 
   2227 (defun dash--match-cons-get-car (skip-cdr source)
   2228   "Helper function generating idiomatic code to get nth car."
   2229   (cond
   2230    ((= skip-cdr 0)
   2231     `(car ,source))
   2232    ((= skip-cdr 1)
   2233     `(cadr ,source))
   2234    (t
   2235     `(nth ,skip-cdr ,source))))
   2236 
   2237 (defun dash--match-cons-get-cdr (skip-cdr source)
   2238   "Helper function generating idiomatic code to get nth cdr."
   2239   (cond
   2240    ((= skip-cdr 0)
   2241     source)
   2242    ((= skip-cdr 1)
   2243     `(cdr ,source))
   2244    (t
   2245     `(nthcdr ,skip-cdr ,source))))
   2246 
   2247 (defun dash--match-cons (match-form source)
   2248   "Setup a cons matching environment and call the real matcher."
   2249   (let ((s (dash--match-make-source-symbol))
   2250         (n 0)
   2251         (m match-form))
   2252     (while (and (consp m)
   2253                 (dash--match-ignore-place-p (car m)))
   2254       (setq n (1+ n)) (!cdr m))
   2255     (cond
   2256      ;; when we only have one pattern in the list, we don't have to
   2257      ;; create a temporary binding (--dash-source--) for the source
   2258      ;; and just use the input directly
   2259      ((and (consp m)
   2260            (not (cdr m)))
   2261       (dash--match (car m) (dash--match-cons-get-car n source)))
   2262      ;; handle other special types
   2263      ((> n 0)
   2264       (dash--match m (dash--match-cons-get-cdr n source)))
   2265      ;; this is the only entry-point for dash--match-cons-1, that's
   2266      ;; why we can't simply use the above branch, it would produce
   2267      ;; infinite recursion
   2268      (t
   2269       (cons (list s source) (dash--match-cons-1 match-form s))))))
   2270 
   2271 (defun dash--get-expand-function (type)
   2272   "Get expand function name for TYPE."
   2273   (intern-soft (format "dash-expand:%s" type)))
   2274 
   2275 (defun dash--match-cons-1 (match-form source &optional props)
   2276   "Match MATCH-FORM against SOURCE.
   2277 
   2278 MATCH-FORM is a proper or improper list.  Each element of
   2279 MATCH-FORM is either a symbol, which gets bound to the respective
   2280 value in source or another match form which gets destructured
   2281 recursively.
   2282 
   2283 If the cdr of last cons cell in the list is nil, matching stops
   2284 there.
   2285 
   2286 SOURCE is a proper or improper list."
   2287   (let ((skip-cdr (or (plist-get props :skip-cdr) 0)))
   2288     (cond
   2289      ((consp match-form)
   2290       (cond
   2291        ((cdr match-form)
   2292         (cond
   2293          ((and (symbolp (car match-form))
   2294                (functionp (dash--get-expand-function (car match-form))))
   2295           (dash--match-kv (dash--match-kv-normalize-match-form match-form) (dash--match-cons-get-cdr skip-cdr source)))
   2296          ((dash--match-ignore-place-p (car match-form))
   2297           (dash--match-cons-1 (cdr match-form) source
   2298                               (plist-put props :skip-cdr (1+ skip-cdr))))
   2299          (t
   2300           (-concat (dash--match (car match-form) (dash--match-cons-skip-cdr skip-cdr source))
   2301                    (dash--match-cons-1 (cdr match-form) source)))))
   2302        (t ;; Last matching place, no need for shift
   2303         (dash--match (car match-form) (dash--match-cons-get-car skip-cdr source)))))
   2304      ((eq match-form nil)
   2305       nil)
   2306      (t ;; Handle improper lists.  Last matching place, no need for shift
   2307       (dash--match match-form (dash--match-cons-get-cdr skip-cdr source))))))
   2308 
   2309 (defun dash--match-vector (match-form source)
   2310   "Setup a vector matching environment and call the real matcher."
   2311   (let ((s (dash--match-make-source-symbol)))
   2312     (cond
   2313      ;; don't bind `s' if we only have one sub-pattern
   2314      ((= (length match-form) 1)
   2315       (dash--match (aref match-form 0) `(aref ,source 0)))
   2316      ;; if the source is a symbol, we don't need to re-bind it
   2317      ((symbolp source)
   2318       (dash--match-vector-1 match-form source))
   2319      ;; don't bind `s' if we only have one sub-pattern which is not ignored
   2320      ((let* ((ignored-places (mapcar 'dash--match-ignore-place-p match-form))
   2321              (ignored-places-n (length (-remove 'null ignored-places))))
   2322         (when (= ignored-places-n (1- (length match-form)))
   2323           (let ((n (-find-index 'null ignored-places)))
   2324             (dash--match (aref match-form n) `(aref ,source ,n))))))
   2325      (t
   2326       (cons (list s source) (dash--match-vector-1 match-form s))))))
   2327 
   2328 (defun dash--match-vector-1 (match-form source)
   2329   "Match MATCH-FORM against SOURCE.
   2330 
   2331 MATCH-FORM is a vector.  Each element of MATCH-FORM is either a
   2332 symbol, which gets bound to the respective value in source or
   2333 another match form which gets destructured recursively.
   2334 
   2335 If second-from-last place in MATCH-FORM is the symbol &rest, the
   2336 next element of the MATCH-FORM is matched against the tail of
   2337 SOURCE, starting at index of the &rest symbol.  This is
   2338 conceptually the same as the (head . tail) match for improper
   2339 lists, where dot plays the role of &rest.
   2340 
   2341 SOURCE is a vector.
   2342 
   2343 If the MATCH-FORM vector is shorter than SOURCE vector, only
   2344 the (length MATCH-FORM) places are bound, the rest of the SOURCE
   2345 is discarded."
   2346   (let ((i 0)
   2347         (l (length match-form))
   2348         (re))
   2349     (while (< i l)
   2350       (let ((m (aref match-form i)))
   2351         (push (cond
   2352                ((and (symbolp m)
   2353                      (eq m '&rest))
   2354                 (prog1 (dash--match
   2355                         (aref match-form (1+ i))
   2356                         `(substring ,source ,i))
   2357                   (setq i l)))
   2358                ((and (symbolp m)
   2359                      ;; do not match symbols starting with _
   2360                      (not (eq (aref (symbol-name m) 0) ?_)))
   2361                 (list (list m `(aref ,source ,i))))
   2362                ((not (symbolp m))
   2363                 (dash--match m `(aref ,source ,i))))
   2364               re)
   2365         (setq i (1+ i))))
   2366     (-flatten-n 1 (nreverse re))))
   2367 
   2368 (defun dash--match-kv-normalize-match-form (pattern)
   2369   "Normalize kv PATTERN.
   2370 
   2371 This method normalizes PATTERN to the format expected by
   2372 `dash--match-kv'.  See `-let' for the specification."
   2373   (let ((normalized (list (car pattern)))
   2374         (skip nil)
   2375         (fill-placeholder (make-symbol "--dash-fill-placeholder--")))
   2376     (-each (-zip-fill fill-placeholder (cdr pattern) (cddr pattern))
   2377       (lambda (pair)
   2378         (let ((current (car pair))
   2379               (next (cdr pair)))
   2380           (if skip
   2381               (setq skip nil)
   2382             (if (or (eq fill-placeholder next)
   2383                     (not (or (and (symbolp next)
   2384                                   (not (keywordp next))
   2385                                   (not (eq next t))
   2386                                   (not (eq next nil)))
   2387                              (and (consp next)
   2388                                   (not (eq (car next) 'quote)))
   2389                              (vectorp next))))
   2390                 (progn
   2391                   (cond
   2392                    ((keywordp current)
   2393                     (push current normalized)
   2394                     (push (intern (substring (symbol-name current) 1)) normalized))
   2395                    ((stringp current)
   2396                     (push current normalized)
   2397                     (push (intern current) normalized))
   2398                    ((and (consp current)
   2399                          (eq (car current) 'quote))
   2400                     (push current normalized)
   2401                     (push (cadr current) normalized))
   2402                    (t (error "-let: found key `%s' in kv destructuring but its pattern `%s' is invalid and can not be derived from the key" current next)))
   2403                   (setq skip nil))
   2404               (push current normalized)
   2405               (push next normalized)
   2406               (setq skip t))))))
   2407     (nreverse normalized)))
   2408 
   2409 (defun dash--match-kv (match-form source)
   2410   "Setup a kv matching environment and call the real matcher.
   2411 
   2412 kv can be any key-value store, such as plist, alist or hash-table."
   2413   (let ((s (dash--match-make-source-symbol)))
   2414     (cond
   2415      ;; don't bind `s' if we only have one sub-pattern (&type key val)
   2416      ((= (length match-form) 3)
   2417       (dash--match-kv-1 (cdr match-form) source (car match-form)))
   2418      ;; if the source is a symbol, we don't need to re-bind it
   2419      ((symbolp source)
   2420       (dash--match-kv-1 (cdr match-form) source (car match-form)))
   2421      (t
   2422       (cons (list s source) (dash--match-kv-1 (cdr match-form) s (car match-form)))))))
   2423 
   2424 (defun dash-expand:&hash (key source)
   2425   "Generate extracting KEY from SOURCE for &hash destructuring."
   2426   `(gethash ,key ,source))
   2427 
   2428 (defun dash-expand:&plist (key source)
   2429   "Generate extracting KEY from SOURCE for &plist destructuring."
   2430   `(plist-get ,source ,key))
   2431 
   2432 (defun dash-expand:&alist (key source)
   2433   "Generate extracting KEY from SOURCE for &alist destructuring."
   2434   `(cdr (assoc ,key ,source)))
   2435 
   2436 (defun dash-expand:&hash? (key source)
   2437   "Generate extracting KEY from SOURCE for &hash? destructuring.
   2438 Similar to &hash but check whether the map is not nil."
   2439   (let ((src (make-symbol "src")))
   2440     `(let ((,src ,source))
   2441        (when ,src (gethash ,key ,src)))))
   2442 
   2443 (defalias 'dash-expand:&keys 'dash-expand:&plist)
   2444 
   2445 (defun dash--match-kv-1 (match-form source type)
   2446   "Match MATCH-FORM against SOURCE of type TYPE.
   2447 
   2448 MATCH-FORM is a proper list of the form (key1 place1 ... keyN
   2449 placeN).  Each placeK is either a symbol, which gets bound to the
   2450 value of keyK retrieved from the key-value store, or another
   2451 match form which gets destructured recursively.
   2452 
   2453 SOURCE is a key-value store of type TYPE, which can be a plist,
   2454 an alist or a hash table.
   2455 
   2456 TYPE is a token specifying the type of the key-value store.
   2457 Valid values are &plist, &alist and &hash."
   2458   (-flatten-n 1 (-map
   2459                  (lambda (kv)
   2460                    (let* ((k (car kv))
   2461                           (v (cadr kv))
   2462                           (getter
   2463                            (funcall (dash--get-expand-function type) k source)))
   2464                      (cond
   2465                       ((symbolp v)
   2466                        (list (list v getter)))
   2467                       (t (dash--match v getter)))))
   2468                  (-partition 2 match-form))))
   2469 
   2470 (defun dash--match-symbol (match-form source)
   2471   "Bind a symbol.
   2472 
   2473 This works just like `let', there is no destructuring."
   2474   (list (list match-form source)))
   2475 
   2476 (defun dash--match (match-form source)
   2477   "Match MATCH-FORM against SOURCE.
   2478 
   2479 This function tests the MATCH-FORM and dispatches to specific
   2480 matchers based on the type of the expression.
   2481 
   2482 Key-value stores are disambiguated by placing a token &plist,
   2483 &alist or &hash as a first item in the MATCH-FORM."
   2484   (cond
   2485    ((and (symbolp match-form)
   2486          ;; Don't bind things like &keys as if they were vars (#395).
   2487          (not (functionp (dash--get-expand-function match-form))))
   2488     (dash--match-symbol match-form source))
   2489    ((consp match-form)
   2490     (cond
   2491      ;; Handle the "x &as" bindings first.
   2492      ((and (consp (cdr match-form))
   2493            (symbolp (car match-form))
   2494            (eq '&as (cadr match-form)))
   2495       (let ((s (car match-form)))
   2496         (cons (list s source)
   2497               (dash--match (cddr match-form) s))))
   2498      ((functionp (dash--get-expand-function (car match-form)))
   2499       (dash--match-kv (dash--match-kv-normalize-match-form match-form) source))
   2500      (t (dash--match-cons match-form source))))
   2501    ((vectorp match-form)
   2502     ;; We support the &as binding in vectors too
   2503     (cond
   2504      ((and (> (length match-form) 2)
   2505            (symbolp (aref match-form 0))
   2506            (eq '&as (aref match-form 1)))
   2507       (let ((s (aref match-form 0)))
   2508         (cons (list s source)
   2509               (dash--match (substring match-form 2) s))))
   2510      (t (dash--match-vector match-form source))))))
   2511 
   2512 (defun dash--normalize-let-varlist (varlist)
   2513   "Normalize VARLIST so that every binding is a list.
   2514 
   2515 `let' allows specifying a binding which is not a list but simply
   2516 the place which is then automatically bound to nil, such that all
   2517 three of the following are identical and evaluate to nil.
   2518 
   2519   (let (a) a)
   2520   (let ((a)) a)
   2521   (let ((a nil)) a)
   2522 
   2523 This function normalizes all of these to the last form."
   2524   (--map (if (consp it) it (list it nil)) varlist))
   2525 
   2526 (defmacro -let* (varlist &rest body)
   2527   "Bind variables according to VARLIST then eval BODY.
   2528 
   2529 VARLIST is a list of lists of the form (PATTERN SOURCE).  Each
   2530 PATTERN is matched against the SOURCE structurally.  SOURCE is
   2531 only evaluated once for each PATTERN.
   2532 
   2533 Each SOURCE can refer to the symbols already bound by this
   2534 VARLIST.  This is useful if you want to destructure SOURCE
   2535 recursively but also want to name the intermediate structures.
   2536 
   2537 See `-let' for the list of all possible patterns."
   2538   (declare (debug ((&rest [&or (sexp form) sexp]) body))
   2539            (indent 1))
   2540   (let* ((varlist (dash--normalize-let-varlist varlist))
   2541          (bindings (--mapcat (dash--match (car it) (cadr it)) varlist)))
   2542     `(let* ,bindings
   2543        ,@body)))
   2544 
   2545 (defmacro -let (varlist &rest body)
   2546   "Bind variables according to VARLIST then eval BODY.
   2547 
   2548 VARLIST is a list of lists of the form (PATTERN SOURCE).  Each
   2549 PATTERN is matched against the SOURCE \"structurally\".  SOURCE
   2550 is only evaluated once for each PATTERN.  Each PATTERN is matched
   2551 recursively, and can therefore contain sub-patterns which are
   2552 matched against corresponding sub-expressions of SOURCE.
   2553 
   2554 All the SOURCEs are evalled before any symbols are
   2555 bound (i.e. \"in parallel\").
   2556 
   2557 If VARLIST only contains one (PATTERN SOURCE) element, you can
   2558 optionally specify it using a vector and discarding the
   2559 outer-most parens.  Thus
   2560 
   2561   (-let ((PATTERN SOURCE)) ...)
   2562 
   2563 becomes
   2564 
   2565   (-let [PATTERN SOURCE] ...).
   2566 
   2567 `-let' uses a convention of not binding places (symbols) starting
   2568 with _ whenever it's possible.  You can use this to skip over
   2569 entries you don't care about.  However, this is not *always*
   2570 possible (as a result of implementation) and these symbols might
   2571 get bound to undefined values.
   2572 
   2573 Following is the overview of supported patterns.  Remember that
   2574 patterns can be matched recursively, so every a, b, aK in the
   2575 following can be a matching construct and not necessarily a
   2576 symbol/variable.
   2577 
   2578 Symbol:
   2579 
   2580   a - bind the SOURCE to A.  This is just like regular `let'.
   2581 
   2582 Conses and lists:
   2583 
   2584   (a) - bind `car' of cons/list to A
   2585 
   2586   (a . b) - bind car of cons to A and `cdr' to B
   2587 
   2588   (a b) - bind car of list to A and `cadr' to B
   2589 
   2590   (a1 a2 a3 ...) - bind 0th car of list to A1, 1st to A2, 2nd to A3...
   2591 
   2592   (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST.
   2593 
   2594 Vectors:
   2595 
   2596   [a] - bind 0th element of a non-list sequence to A (works with
   2597         vectors, strings, bit arrays...)
   2598 
   2599   [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st to
   2600                    A1, 2nd to A2, ...
   2601                    If the PATTERN is shorter than SOURCE, the values at
   2602                    places not in PATTERN are ignored.
   2603                    If the PATTERN is longer than SOURCE, an `error' is
   2604                    thrown.
   2605 
   2606   [a1 a2 a3 ... &rest rest] - as above, but bind the rest of
   2607                               the sequence to REST.  This is
   2608                               conceptually the same as improper list
   2609                               matching (a1 a2 ... aN . rest)
   2610 
   2611 Key/value stores:
   2612 
   2613   (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the
   2614                                  SOURCE plist to aK.  If the
   2615                                  value is not found, aK is nil.
   2616                                  Uses `plist-get' to fetch values.
   2617 
   2618   (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the
   2619                                  SOURCE alist to aK.  If the
   2620                                  value is not found, aK is nil.
   2621                                  Uses `assoc' to fetch values.
   2622 
   2623   (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the
   2624                                 SOURCE hash table to aK.  If the
   2625                                 value is not found, aK is nil.
   2626                                 Uses `gethash' to fetch values.
   2627 
   2628 Further, special keyword &keys supports \"inline\" matching of
   2629 plist-like key-value pairs, similarly to &keys keyword of
   2630 `cl-defun'.
   2631 
   2632   (a1 a2 ... aN &keys key1 b1 ... keyN bK)
   2633 
   2634 This binds N values from the list to a1 ... aN, then interprets
   2635 the cdr as a plist (see key/value matching above).
   2636 
   2637 A shorthand notation for kv-destructuring exists which allows the
   2638 patterns be optionally left out and derived from the key name in
   2639 the following fashion:
   2640 
   2641 - a key :foo is converted into `foo' pattern,
   2642 - a key \\='bar is converted into `bar' pattern,
   2643 - a key \"baz\" is converted into `baz' pattern.
   2644 
   2645 That is, the entire value under the key is bound to the derived
   2646 variable without any further destructuring.
   2647 
   2648 This is possible only when the form following the key is not a
   2649 valid pattern (i.e. not a symbol, a cons cell or a vector).
   2650 Otherwise the matching proceeds as usual and in case of an
   2651 invalid spec fails with an error.
   2652 
   2653 Thus the patterns are normalized as follows:
   2654 
   2655    ;; derive all the missing patterns
   2656    (&plist :foo \\='bar \"baz\") => (&plist :foo foo \\='bar bar \"baz\" baz)
   2657 
   2658    ;; we can specify some but not others
   2659    (&plist :foo \\='bar explicit-bar) => (&plist :foo foo \\='bar explicit-bar)
   2660 
   2661    ;; nothing happens, we store :foo in x
   2662    (&plist :foo x) => (&plist :foo x)
   2663 
   2664    ;; nothing happens, we match recursively
   2665    (&plist :foo (a b c)) => (&plist :foo (a b c))
   2666 
   2667 You can name the source using the syntax SYMBOL &as PATTERN.
   2668 This syntax works with lists (proper or improper), vectors and
   2669 all types of maps.
   2670 
   2671   (list &as a b c) (list 1 2 3)
   2672 
   2673 binds A to 1, B to 2, C to 3 and LIST to (1 2 3).
   2674 
   2675 Similarly:
   2676 
   2677   (bounds &as beg . end) (cons 1 2)
   2678 
   2679 binds BEG to 1, END to 2 and BOUNDS to (1 . 2).
   2680 
   2681   (items &as first . rest) (list 1 2 3)
   2682 
   2683 binds FIRST to 1, REST to (2 3) and ITEMS to (1 2 3)
   2684 
   2685   [vect &as _ b c] [1 2 3]
   2686 
   2687 binds B to 2, C to 3 and VECT to [1 2 3] (_ avoids binding as usual).
   2688 
   2689   (plist &as &plist :b b) (list :a 1 :b 2 :c 3)
   2690 
   2691 binds B to 2 and PLIST to (:a 1 :b 2 :c 3).  Same for &alist and &hash.
   2692 
   2693 This is especially useful when we want to capture the result of a
   2694 computation and destructure at the same time.  Consider the
   2695 form (function-returning-complex-structure) returning a list of
   2696 two vectors with two items each.  We want to capture this entire
   2697 result and pass it to another computation, but at the same time
   2698 we want to get the second item from each vector.  We can achieve
   2699 it with pattern
   2700 
   2701   (result &as [_ a] [_ b]) (function-returning-complex-structure)
   2702 
   2703 Note: Clojure programmers may know this feature as the \":as
   2704 binding\".  The difference is that we put the &as at the front
   2705 because we need to support improper list binding."
   2706   (declare (debug ([&or (&rest [&or (sexp form) sexp])
   2707                         (vector [&rest [sexp form]])]
   2708                    body))
   2709            (indent 1))
   2710   (if (vectorp varlist)
   2711       `(let* ,(dash--match (aref varlist 0) (aref varlist 1))
   2712          ,@body)
   2713     (let* ((varlist (dash--normalize-let-varlist varlist))
   2714            (inputs (--map-indexed (list (make-symbol (format "input%d" it-index)) (cadr it)) varlist))
   2715            (new-varlist (--zip-with (list (car it) (car other))
   2716                                     varlist inputs)))
   2717       `(let ,inputs
   2718          (-let* ,new-varlist ,@body)))))
   2719 
   2720 (defmacro -lambda (match-form &rest body)
   2721   "Return a lambda which destructures its input as MATCH-FORM and executes BODY.
   2722 
   2723 Note that you have to enclose the MATCH-FORM in a pair of parens,
   2724 such that:
   2725 
   2726   (-lambda (x) body)
   2727   (-lambda (x y ...) body)
   2728 
   2729 has the usual semantics of `lambda'.  Furthermore, these get
   2730 translated into normal `lambda', so there is no performance
   2731 penalty.
   2732 
   2733 See `-let' for a description of the destructuring mechanism."
   2734   (declare (doc-string 2) (indent defun)
   2735            (debug (&define sexp
   2736                            [&optional stringp]
   2737                            [&optional ("interactive" interactive)]
   2738                            def-body)))
   2739   (cond
   2740    ((nlistp match-form)
   2741     (signal 'wrong-type-argument (list #'listp match-form)))
   2742    ;; No destructuring, so just return regular `lambda' for speed.
   2743    ((-all? #'symbolp match-form)
   2744     `(lambda ,match-form ,@body))
   2745    ((let ((inputs (--map-indexed
   2746                    (list it (make-symbol (format "input%d" it-index)))
   2747                    match-form)))
   2748       ;; TODO: because inputs to the `lambda' are evaluated only once,
   2749       ;; `-let*' need not create the extra bindings to ensure that.
   2750       ;; We should find a way to optimize that.  Not critical however.
   2751       `(lambda ,(mapcar #'cadr inputs)
   2752          (-let* ,inputs ,@body))))))
   2753 
   2754 (defmacro -setq (&rest forms)
   2755   "Bind each MATCH-FORM to the value of its VAL.
   2756 
   2757 MATCH-FORM destructuring is done according to the rules of `-let'.
   2758 
   2759 This macro allows you to bind multiple variables by destructuring
   2760 the value, so for example:
   2761 
   2762   (-setq (a b) x
   2763          (&plist :c c) plist)
   2764 
   2765 expands roughly speaking to the following code
   2766 
   2767   (setq a (car x)
   2768         b (cadr x)
   2769         c (plist-get plist :c))
   2770 
   2771 Care is taken to only evaluate each VAL once so that in case of
   2772 multiple assignments it does not cause unexpected side effects.
   2773 
   2774 \(fn [MATCH-FORM VAL]...)"
   2775   (declare (debug (&rest sexp form))
   2776            (indent 1))
   2777   (when (= (mod (length forms) 2) 1)
   2778     (signal 'wrong-number-of-arguments (list '-setq (1+ (length forms)))))
   2779   (let* ((forms-and-sources
   2780           ;; First get all the necessary mappings with all the
   2781           ;; intermediate bindings.
   2782           (-map (lambda (x) (dash--match (car x) (cadr x)))
   2783                 (-partition 2 forms)))
   2784          ;; To preserve the logic of dynamic scoping we must ensure
   2785          ;; that we `setq' the variables outside of the `let*' form
   2786          ;; which holds the destructured intermediate values.  For
   2787          ;; this we generate for each variable a placeholder which is
   2788          ;; bound to (lexically) the result of the destructuring.
   2789          ;; Then outside of the helper `let*' form we bind all the
   2790          ;; original variables to their respective placeholders.
   2791          ;; TODO: There is a lot of room for possible optimization,
   2792          ;; for start playing with `special-variable-p' to eliminate
   2793          ;; unnecessary re-binding.
   2794          (variables-to-placeholders
   2795           (-mapcat
   2796            (lambda (bindings)
   2797              (-map
   2798               (lambda (binding)
   2799                 (let ((var (car binding)))
   2800                   (list var (make-symbol (concat "--dash-binding-" (symbol-name var) "--")))))
   2801               (--filter (not (string-prefix-p "--" (symbol-name (car it)))) bindings)))
   2802            forms-and-sources)))
   2803     `(let ,(-map 'cadr variables-to-placeholders)
   2804        (let* ,(-flatten-n 1 forms-and-sources)
   2805          (setq ,@(-flatten (-map 'reverse variables-to-placeholders))))
   2806        (setq ,@(-flatten variables-to-placeholders)))))
   2807 
   2808 (defmacro -if-let* (vars-vals then &rest else)
   2809   "If all VALS evaluate to true, bind them to their corresponding
   2810 VARS and do THEN, otherwise do ELSE. VARS-VALS should be a list
   2811 of (VAR VAL) pairs.
   2812 
   2813 Note: binding is done according to `-let*'.  VALS are evaluated
   2814 sequentially, and evaluation stops after the first nil VAL is
   2815 encountered."
   2816   (declare (debug ((&rest (sexp form)) form body))
   2817            (indent 2))
   2818   (->> vars-vals
   2819        (--mapcat (dash--match (car it) (cadr it)))
   2820        (--reduce-r-from
   2821         (let ((var (car it))
   2822               (val (cadr it)))
   2823           `(let ((,var ,val))
   2824              (if ,var ,acc ,@else)))
   2825         then)))
   2826 
   2827 (defmacro -if-let (var-val then &rest else)
   2828   "If VAL evaluates to non-nil, bind it to VAR and do THEN,
   2829 otherwise do ELSE.
   2830 
   2831 Note: binding is done according to `-let'.
   2832 
   2833 \(fn (VAR VAL) THEN &rest ELSE)"
   2834   (declare (debug ((sexp form) form body))
   2835            (indent 2))
   2836   `(-if-let* (,var-val) ,then ,@else))
   2837 
   2838 (defmacro --if-let (val then &rest else)
   2839   "If VAL evaluates to non-nil, bind it to symbol `it' and do THEN,
   2840 otherwise do ELSE."
   2841   (declare (debug (form form body))
   2842            (indent 2))
   2843   `(-if-let (it ,val) ,then ,@else))
   2844 
   2845 (defmacro -when-let* (vars-vals &rest body)
   2846   "If all VALS evaluate to true, bind them to their corresponding
   2847 VARS and execute body. VARS-VALS should be a list of (VAR VAL)
   2848 pairs.
   2849 
   2850 Note: binding is done according to `-let*'.  VALS are evaluated
   2851 sequentially, and evaluation stops after the first nil VAL is
   2852 encountered."
   2853   (declare (debug ((&rest (sexp form)) body))
   2854            (indent 1))
   2855   `(-if-let* ,vars-vals (progn ,@body)))
   2856 
   2857 (defmacro -when-let (var-val &rest body)
   2858   "If VAL evaluates to non-nil, bind it to VAR and execute body.
   2859 
   2860 Note: binding is done according to `-let'.
   2861 
   2862 \(fn (VAR VAL) &rest BODY)"
   2863   (declare (debug ((sexp form) body))
   2864            (indent 1))
   2865   `(-if-let ,var-val (progn ,@body)))
   2866 
   2867 (defmacro --when-let (val &rest body)
   2868   "If VAL evaluates to non-nil, bind it to symbol `it' and
   2869 execute body."
   2870   (declare (debug (form body))
   2871            (indent 1))
   2872   `(--if-let ,val (progn ,@body)))
   2873 
   2874 ;; TODO: Get rid of this dynamic variable, passing it as an argument
   2875 ;; instead?
   2876 (defvar -compare-fn nil
   2877   "Tests for equality use this function, or `equal' if this is nil.
   2878 
   2879 As a dynamic variable, this should be temporarily bound around
   2880 the relevant operation, rather than permanently modified.  For
   2881 example:
   2882 
   2883   (let ((-compare-fn #\\='=))
   2884     (-union \\='(1 2 3) \\='(2 3 4)))")
   2885 
   2886 (defun dash--member-fn ()
   2887   "Return the flavor of `member' that goes best with `-compare-fn'."
   2888   (declare (side-effect-free error-free))
   2889   (let ((cmp -compare-fn))
   2890     (cond ((memq cmp '(nil equal)) #'member)
   2891           ((eq cmp #'eq) #'memq)
   2892           ((eq cmp #'eql) #'memql)
   2893           ((lambda (elt list)
   2894              (while (and list (not (funcall cmp elt (car list))))
   2895                (pop list))
   2896              list)))))
   2897 
   2898 (defun dash--assoc-fn ()
   2899   "Return the flavor of `assoc' that goes best with `-compare-fn'."
   2900   (declare (side-effect-free error-free))
   2901   (let ((cmp -compare-fn))
   2902     (cond ((memq cmp '(nil equal)) #'assoc)
   2903           ((eq cmp #'eq) #'assq)
   2904           ;; Since Emacs 26, `assoc' accepts a custom `testfn'.
   2905           ;; Version testing would be simpler here, but feature
   2906           ;; testing gets more brownie points, I guess.
   2907           ((condition-case nil
   2908                (with-no-warnings (assoc nil () #'eql))
   2909              (wrong-number-of-arguments t))
   2910            (lambda (key alist)
   2911              (--first (and (consp it) (funcall cmp (car it) key)) alist)))
   2912           ((with-no-warnings
   2913              (lambda (key alist)
   2914                (assoc key alist cmp)))))))
   2915 
   2916 (defun dash--hash-test-fn ()
   2917   "Return the hash table test function corresponding to `-compare-fn'.
   2918 Return nil if `-compare-fn' is not a known test function."
   2919   (declare (side-effect-free error-free))
   2920   ;; In theory this could also recognize values that are custom
   2921   ;; `hash-table-test's, but too often the :test name is different
   2922   ;; from the equality function, so it doesn't seem worthwhile.
   2923   (car (memq (or -compare-fn #'equal) '(equal eq eql))))
   2924 
   2925 (defvar dash--short-list-length 32
   2926   "Maximum list length considered short, for optimizations.
   2927 For example, the speedup afforded by hash table lookup may start
   2928 to outweigh its runtime and memory overhead for problem sizes
   2929 greater than this value.  See also the discussion in PR #305.")
   2930 
   2931 (defun -distinct (list)
   2932   "Return a copy of LIST with all duplicate elements removed.
   2933 
   2934 The test for equality is done with `equal', or with `-compare-fn'
   2935 if that is non-nil.
   2936 
   2937 Alias: `-uniq'."
   2938   (declare (important-return-value t))
   2939   (let (test len)
   2940     (cond ((null list) ())
   2941           ;; Use a hash table if `-compare-fn' is a known hash table
   2942           ;; test function and the list is long enough.
   2943           ((and (setq test (dash--hash-test-fn))
   2944                 (> (setq len (length list)) dash--short-list-length))
   2945            (let ((ht (make-hash-table :test test :size len)))
   2946              (--filter (unless (gethash it ht) (puthash it t ht)) list)))
   2947           ((let ((member (dash--member-fn)) uniq)
   2948              (--each list (unless (funcall member it uniq) (push it uniq)))
   2949              (nreverse uniq))))))
   2950 
   2951 (defalias '-uniq #'-distinct)
   2952 
   2953 (defun dash--size+ (size1 size2)
   2954   "Return the sum of nonnegative fixnums SIZE1 and SIZE2.
   2955 Return `most-positive-fixnum' on overflow.  This ensures the
   2956 result is a valid size, particularly for allocating hash tables,
   2957 even in the presence of bignum support."
   2958   (declare (side-effect-free t))
   2959   (if (< size1 (- most-positive-fixnum size2))
   2960       (+ size1 size2)
   2961     most-positive-fixnum))
   2962 
   2963 (defun -union (list1 list2)
   2964   "Return a new list of distinct elements appearing in either LIST1 or LIST2.
   2965 
   2966 The test for equality is done with `equal', or with `-compare-fn'
   2967 if that is non-nil."
   2968   (declare (important-return-value t))
   2969   (let ((lists (list list1 list2)) test len union)
   2970     (cond ((null (or list1 list2)))
   2971           ;; Use a hash table if `-compare-fn' is a known hash table
   2972           ;; test function and the lists are long enough.
   2973           ((and (setq test (dash--hash-test-fn))
   2974                 (> (setq len (dash--size+ (length list1) (length list2)))
   2975                    dash--short-list-length))
   2976            (let ((ht (make-hash-table :test test :size len)))
   2977              (dolist (l lists)
   2978                (--each l (unless (gethash it ht)
   2979                            (puthash it t ht)
   2980                            (push it union))))))
   2981           ((let ((member (dash--member-fn)))
   2982              (dolist (l lists)
   2983                (--each l (unless (funcall member it union) (push it union)))))))
   2984     (nreverse union)))
   2985 
   2986 (defun -intersection (list1 list2)
   2987   "Return a new list of distinct elements appearing in both LIST1 and LIST2.
   2988 
   2989 The test for equality is done with `equal', or with `-compare-fn'
   2990 if that is non-nil."
   2991   (declare (important-return-value t))
   2992   (let (test len)
   2993     (cond ((null (and list1 list2)) ())
   2994           ;; Use a hash table if `-compare-fn' is a known hash table
   2995           ;; test function and either list is long enough.
   2996           ((and (setq test (dash--hash-test-fn))
   2997                 (> (setq len (length list2)) dash--short-list-length))
   2998            (let ((ht (make-hash-table :test test :size len)))
   2999              (--each list2 (puthash it t ht))
   3000              ;; Remove visited elements to avoid duplicates.
   3001              (--filter (when (gethash it ht) (remhash it ht) t) list1)))
   3002           ((let ((member (dash--member-fn)) intersection)
   3003              (--each list1 (and (funcall member it list2)
   3004                                 (not (funcall member it intersection))
   3005                                 (push it intersection)))
   3006              (nreverse intersection))))))
   3007 
   3008 (defun -difference (list1 list2)
   3009   "Return a new list with the distinct members of LIST1 that are not in LIST2.
   3010 
   3011 The test for equality is done with `equal', or with `-compare-fn'
   3012 if that is non-nil."
   3013   (declare (important-return-value t))
   3014   (let (test len1 len2)
   3015     (cond ((null list1) ())
   3016           ((null list2) (-distinct list1))
   3017           ;; Use a hash table if `-compare-fn' is a known hash table
   3018           ;; test function and the subtrahend is long enough.
   3019           ((and (setq test (dash--hash-test-fn))
   3020                 (setq len1 (length list1))
   3021                 (setq len2 (length list2))
   3022                 (> (max len1 len2) dash--short-list-length))
   3023            (let ((ht1 (make-hash-table :test test :size len1))
   3024                  (ht2 (make-hash-table :test test :size len2)))
   3025              (--each list2 (puthash it t ht2))
   3026              ;; Avoid duplicates by tracking visited items in `ht1'.
   3027              (--filter (unless (or (gethash it ht2) (gethash it ht1))
   3028                          (puthash it t ht1))
   3029                        list1)))
   3030           ((let ((member (dash--member-fn)) difference)
   3031              (--each list1
   3032                (unless (or (funcall member it list2)
   3033                            (funcall member it difference))
   3034                  (push it difference)))
   3035              (nreverse difference))))))
   3036 
   3037 (defun -powerset (list)
   3038   "Return the power set of LIST."
   3039   (declare (pure t) (side-effect-free t))
   3040   (if (null list) (list ())
   3041     (let ((last (-powerset (cdr list))))
   3042       (nconc (mapcar (lambda (x) (cons (car list) x)) last)
   3043              last))))
   3044 
   3045 (defun -frequencies (list)
   3046   "Count the occurrences of each distinct element of LIST.
   3047 
   3048 Return an alist of (ELEMENT . N), where each ELEMENT occurs N
   3049 times in LIST.
   3050 
   3051 The test for equality is done with `equal', or with `-compare-fn'
   3052 if that is non-nil.
   3053 
   3054 See also `-count' and `-group-by'."
   3055   (declare (important-return-value t))
   3056   (let (test len freqs)
   3057     (cond ((null list))
   3058           ((and (setq test (dash--hash-test-fn))
   3059                 (> (setq len (length list)) dash--short-list-length))
   3060            (let ((ht (make-hash-table :test test :size len)))
   3061              ;; Share structure between hash table and returned list.
   3062              ;; This affords a single pass that preserves the input
   3063              ;; order, conses less garbage, and is faster than a
   3064              ;; second traversal (e.g., with `maphash').
   3065              (--each list
   3066                (let ((freq (gethash it ht)))
   3067                  (if freq
   3068                      (setcdr freq (1+ (cdr freq)))
   3069                    (push (puthash it (cons it 1) ht) freqs))))))
   3070           ((let ((assoc (dash--assoc-fn)))
   3071              (--each list
   3072                (let ((freq (funcall assoc it freqs)))
   3073                  (if freq
   3074                      (setcdr freq (1+ (cdr freq)))
   3075                    (push (cons it 1) freqs)))))))
   3076     (nreverse freqs)))
   3077 
   3078 (defun dash--numbers<= (nums)
   3079   "Return non-nil if NUMS is a list of non-decreasing numbers."
   3080   (declare (pure t) (side-effect-free t))
   3081   (or (null nums)
   3082       (let ((prev (pop nums)))
   3083         (and (numberp prev)
   3084              (--every (and (numberp it) (<= prev (setq prev it))) nums)))))
   3085 
   3086 (defun dash--next-lex-perm (array n)
   3087   "Update ARRAY of N numbers with its next lexicographic permutation.
   3088 Return nil if there is no such successor.  N should be nonzero.
   3089 
   3090 This implements the salient steps of Algorithm L (Lexicographic
   3091 permutation generation) as described in DE Knuth's The Art of
   3092 Computer Programming, Volume 4A / Combinatorial Algorithms,
   3093 Part I, Addison-Wesley, 2011, § 7.2.1.2, p. 319."
   3094   (setq n (1- n))
   3095   (let* ((l n)
   3096          (j (1- n))
   3097          (al (aref array n))
   3098          (aj al))
   3099     ;; L2. [Find j].
   3100     ;; Decrement j until a[j] < a[j+1].
   3101     (while (and (<= 0 j)
   3102                 (<= aj (setq aj (aref array j))))
   3103       (setq j (1- j)))
   3104     ;; Terminate algorithm if j not found.
   3105     (when (>= j 0)
   3106       ;; L3. [Increase a[j]].
   3107       ;; Decrement l until a[j] < a[l].
   3108       (while (>= aj al)
   3109         (setq l (1- l) al (aref array l)))
   3110       ;; Swap a[j] and a[l].
   3111       (aset array j al)
   3112       (aset array l aj)
   3113       ;; L4. [Reverse a[j+1]...a[n]].
   3114       (setq l n)
   3115       (while (< (setq j (1+ j)) l)
   3116         (setq aj (aref array j))
   3117         (aset array j (aref array l))
   3118         (aset array l aj)
   3119         (setq l (1- l)))
   3120       array)))
   3121 
   3122 (defun dash--lex-perms (vec &optional original)
   3123   "Return a list of permutations of VEC in lexicographic order.
   3124 Specifically, return only the successors of VEC in lexicographic
   3125 order.  Each returned permutation is a list.  VEC should comprise
   3126 one or more numbers, and may be destructively modified.
   3127 
   3128 If ORIGINAL is a vector, then VEC is interpreted as a set of
   3129 indices into ORIGINAL.  In this case, the indices are permuted,
   3130 and the resulting index permutations are used to dereference
   3131 elements of ORIGINAL."
   3132   (let ((len (length vec)) perms)
   3133     (while vec
   3134       (push (if original
   3135                 (--map (aref original it) vec)
   3136               (append vec ()))
   3137             perms)
   3138       (setq vec (dash--next-lex-perm vec len)))
   3139     (nreverse perms)))
   3140 
   3141 (defun dash--uniq-perms (list)
   3142   "Return a list of permutations of LIST.
   3143 LIST is treated as if all its elements are distinct."
   3144   (let* ((vec (vconcat list))
   3145          (idxs (copy-sequence vec)))
   3146     ;; Just construct a vector of the list's indices and permute that.
   3147     (dotimes (i (length idxs))
   3148       (aset idxs i i))
   3149     (dash--lex-perms idxs vec)))
   3150 
   3151 (defun dash--multi-perms (list freqs)
   3152   "Return a list of permutations of the multiset LIST.
   3153 FREQS should be an alist describing the frequency of each element
   3154 in LIST, as returned by `-frequencies'."
   3155   (let (;; Distinct items in `list', aka the cars of `freqs'.
   3156         (uniq (make-vector (length freqs) nil))
   3157         ;; Indices into `uniq'.
   3158         (idxs (make-vector (length list) nil))
   3159         ;; Current index into `idxs'.
   3160         (i 0))
   3161     (--each freqs
   3162       (aset uniq it-index (car it))
   3163       ;; Populate `idxs' with as many copies of each `it-index' as
   3164       ;; there are corresponding duplicates.
   3165       (dotimes (_ (cdr it))
   3166         (aset idxs i it-index)
   3167         (setq i (1+ i))))
   3168     (dash--lex-perms idxs uniq)))
   3169 
   3170 (defun -permutations (list)
   3171   "Return the distinct permutations of LIST.
   3172 
   3173 Duplicate elements of LIST are determined by `equal', or by
   3174 `-compare-fn' if that is non-nil."
   3175   (declare (important-return-value t))
   3176   (cond ((null list) (list ()))
   3177         ;; Optimization: a traversal of `list' is faster than the
   3178         ;; round trip via `dash--uniq-perms' or `dash--multi-perms'.
   3179         ((dash--numbers<= list)
   3180          (dash--lex-perms (vconcat list)))
   3181         ((let ((freqs (-frequencies list)))
   3182            ;; Is each element distinct?
   3183            (unless (--every (= (cdr it) 1) freqs)
   3184              (dash--multi-perms list freqs))))
   3185         ((dash--uniq-perms list))))
   3186 
   3187 (defun -inits (list)
   3188   "Return all prefixes of LIST."
   3189   (declare (pure t) (side-effect-free t))
   3190   (let ((res (list list)))
   3191     (setq list (reverse list))
   3192     (while list
   3193       (push (reverse (!cdr list)) res))
   3194     res))
   3195 
   3196 (defun -tails (list)
   3197   "Return all suffixes of LIST."
   3198   (declare (pure t) (side-effect-free t))
   3199   (-reductions-r-from #'cons nil list))
   3200 
   3201 (defun -common-prefix (&rest lists)
   3202   "Return the longest common prefix of LISTS."
   3203   (declare (pure t) (side-effect-free t))
   3204   (--reduce (--take-while (and acc (equal (pop acc) it)) it)
   3205             lists))
   3206 
   3207 (defun -common-suffix (&rest lists)
   3208   "Return the longest common suffix of LISTS."
   3209   (declare (pure t) (side-effect-free t))
   3210   (nreverse (apply #'-common-prefix (mapcar #'reverse lists))))
   3211 
   3212 (defun -contains? (list element)
   3213   "Return non-nil if LIST contains ELEMENT.
   3214 
   3215 The test for equality is done with `equal', or with `-compare-fn'
   3216 if that is non-nil.  As with `member', the return value is
   3217 actually the tail of LIST whose car is ELEMENT.
   3218 
   3219 Alias: `-contains-p'."
   3220   (declare (important-return-value t))
   3221   (funcall (dash--member-fn) element list))
   3222 
   3223 (defalias '-contains-p #'-contains?)
   3224 
   3225 (defun -same-items? (list1 list2)
   3226   "Return non-nil if LIST1 and LIST2 have the same distinct elements.
   3227 
   3228 The order of the elements in the lists does not matter.  The
   3229 lists may be of different lengths, i.e., contain duplicate
   3230 elements.  The test for equality is done with `equal', or with
   3231 `-compare-fn' if that is non-nil.
   3232 
   3233 Alias: `-same-items-p'."
   3234   (declare (important-return-value t))
   3235   (let (test len1 len2)
   3236     (cond ((null (or list1 list2)))
   3237           ((null (and list1 list2)) nil)
   3238           ;; Use a hash table if `-compare-fn' is a known hash table
   3239           ;; test function and either list is long enough.
   3240           ((and (setq test (dash--hash-test-fn))
   3241                 (setq len1 (length list1))
   3242                 (setq len2 (length list2))
   3243                 (> (max len1 len2) dash--short-list-length))
   3244            (let ((ht1 (make-hash-table :test test :size len1))
   3245                  (ht2 (make-hash-table :test test :size len2)))
   3246              (--each list1 (puthash it t ht1))
   3247              ;; Move visited elements from `ht1' to `ht2'.  This way,
   3248              ;; if visiting all of `list2' leaves `ht1' empty, then
   3249              ;; all elements from both lists have been accounted for.
   3250              (and (--every (cond ((gethash it ht1)
   3251                                   (remhash it ht1)
   3252                                   (puthash it t ht2))
   3253                                  ((gethash it ht2)))
   3254                            list2)
   3255                   (zerop (hash-table-count ht1)))))
   3256           ((let ((member (dash--member-fn)))
   3257              (and (--all? (funcall member it list2) list1)
   3258                   (--all? (funcall member it list1) list2)))))))
   3259 
   3260 (defalias '-same-items-p #'-same-items?)
   3261 
   3262 (defun -is-prefix? (prefix list)
   3263   "Return non-nil if PREFIX is a prefix of LIST.
   3264 
   3265 Alias: `-is-prefix-p'."
   3266   (declare (pure t) (side-effect-free t))
   3267   (--each-while list (and (equal (car prefix) it)
   3268                           (!cdr prefix)))
   3269   (null prefix))
   3270 
   3271 (defun -is-suffix? (suffix list)
   3272   "Return non-nil if SUFFIX is a suffix of LIST.
   3273 
   3274 Alias: `-is-suffix-p'."
   3275   (declare (pure t) (side-effect-free t))
   3276   (equal suffix (last list (length suffix))))
   3277 
   3278 (defun -is-infix? (infix list)
   3279   "Return non-nil if INFIX is infix of LIST.
   3280 
   3281 This operation runs in O(n^2) time
   3282 
   3283 Alias: `-is-infix-p'"
   3284   (declare (pure t) (side-effect-free t))
   3285   (let (done)
   3286     (while (and (not done) list)
   3287       (setq done (-is-prefix? infix list))
   3288       (!cdr list))
   3289     done))
   3290 
   3291 (defalias '-is-prefix-p '-is-prefix?)
   3292 (defalias '-is-suffix-p '-is-suffix?)
   3293 (defalias '-is-infix-p '-is-infix?)
   3294 
   3295 (defun -sort (comparator list)
   3296   "Sort LIST, stably, comparing elements using COMPARATOR.
   3297 Return the sorted list.  LIST is NOT modified by side effects.
   3298 COMPARATOR is called with two elements of LIST, and should return non-nil
   3299 if the first element should sort before the second."
   3300   (declare (important-return-value t))
   3301   ;; Not yet worth changing to (sort list :lessp comparator);
   3302   ;; still seems as fast or slightly faster.
   3303   (sort (copy-sequence list) comparator))
   3304 
   3305 (defmacro --sort (form list)
   3306   "Anaphoric form of `-sort'."
   3307   (declare (debug (def-form form)))
   3308   `(-sort (lambda (it other) (ignore it other) ,form) ,list))
   3309 
   3310 (defun -list (&optional arg &rest args)
   3311   "Ensure ARG is a list.
   3312 If ARG is already a list, return it as is (not a copy).
   3313 Otherwise, return a new list with ARG as its only element.
   3314 
   3315 Another supported calling convention is (-list &rest ARGS).
   3316 In this case, if ARG is not a list, a new list with all of
   3317 ARGS as elements is returned.  This use is supported for
   3318 backward compatibility and is otherwise deprecated."
   3319   (declare (advertised-calling-convention (arg) "2.18.0")
   3320            (pure t) (side-effect-free error-free))
   3321   (if (listp arg) arg (cons arg args)))
   3322 
   3323 (defun -repeat (n x)
   3324   "Return a new list of length N with each element being X.
   3325 Return nil if N is less than 1."
   3326   (declare (side-effect-free t))
   3327   (and (>= n 0) (make-list n x)))
   3328 
   3329 (defun -sum (list)
   3330   "Return the sum of LIST."
   3331   (declare (pure t) (side-effect-free t))
   3332   (apply #'+ list))
   3333 
   3334 (defun -running-sum (list)
   3335   "Return a list with running sums of items in LIST.
   3336 LIST must be non-empty."
   3337   (declare (pure t) (side-effect-free t))
   3338   (or list (signal 'wrong-type-argument (list #'consp list)))
   3339   (-reductions #'+ list))
   3340 
   3341 (defun -product (list)
   3342   "Return the product of LIST."
   3343   (declare (pure t) (side-effect-free t))
   3344   (apply #'* list))
   3345 
   3346 (defun -running-product (list)
   3347   "Return a list with running products of items in LIST.
   3348 LIST must be non-empty."
   3349   (declare (pure t) (side-effect-free t))
   3350   (or list (signal 'wrong-type-argument (list #'consp list)))
   3351   (-reductions #'* list))
   3352 
   3353 (defun -max (list)
   3354   "Return the largest value from LIST of numbers or markers."
   3355   (declare (pure t) (side-effect-free t))
   3356   (apply #'max list))
   3357 
   3358 (defun -min (list)
   3359   "Return the smallest value from LIST of numbers or markers."
   3360   (declare (pure t) (side-effect-free t))
   3361   (apply #'min list))
   3362 
   3363 (defun -max-by (comparator list)
   3364   "Take a comparison function COMPARATOR and a LIST and return
   3365 the greatest element of the list by the comparison function.
   3366 
   3367 See also combinator `-on' which can transform the values before
   3368 comparing them."
   3369   (declare (important-return-value t))
   3370   (--reduce (if (funcall comparator it acc) it acc) list))
   3371 
   3372 (defun -min-by (comparator list)
   3373   "Take a comparison function COMPARATOR and a LIST and return
   3374 the least element of the list by the comparison function.
   3375 
   3376 See also combinator `-on' which can transform the values before
   3377 comparing them."
   3378   (declare (important-return-value t))
   3379   (--reduce (if (funcall comparator it acc) acc it) list))
   3380 
   3381 (defmacro --max-by (form list)
   3382   "Anaphoric version of `-max-by'.
   3383 
   3384 The items for the comparator form are exposed as \"it\" and \"other\"."
   3385   (declare (debug (def-form form)))
   3386   `(-max-by (lambda (it other) (ignore it other) ,form) ,list))
   3387 
   3388 (defmacro --min-by (form list)
   3389   "Anaphoric version of `-min-by'.
   3390 
   3391 The items for the comparator form are exposed as \"it\" and \"other\"."
   3392   (declare (debug (def-form form)))
   3393   `(-min-by (lambda (it other) (ignore it other) ,form) ,list))
   3394 
   3395 (defun -iota (count &optional start step)
   3396   "Return a list containing COUNT numbers.
   3397 Starts from START and adds STEP each time.  The default START is
   3398 zero, the default STEP is 1.
   3399 This function takes its name from the corresponding primitive in
   3400 the APL language."
   3401   (declare (side-effect-free t))
   3402   (unless (natnump count)
   3403     (signal 'wrong-type-argument (list #'natnump count)))
   3404   (or start (setq start 0))
   3405   (or step (setq step 1))
   3406   (if (zerop step)
   3407       (make-list count start)
   3408     (--iterate (+ it step) start count)))
   3409 
   3410 (defun -fix (fn list)
   3411   "Compute the (least) fixpoint of FN with initial input LIST.
   3412 
   3413 FN is called at least once, results are compared with `equal'."
   3414   (declare (important-return-value t))
   3415   (let ((re (funcall fn list)))
   3416     (while (not (equal list re))
   3417       (setq list re)
   3418       (setq re (funcall fn re)))
   3419     re))
   3420 
   3421 (defmacro --fix (form list)
   3422   "Anaphoric form of `-fix'."
   3423   (declare (debug (def-form form)))
   3424   `(-fix (lambda (it) (ignore it) ,form) ,list))
   3425 
   3426 (defun -unfold (fun seed)
   3427   "Build a list from SEED using FUN.
   3428 
   3429 This is \"dual\" operation to `-reduce-r': while -reduce-r
   3430 consumes a list to produce a single value, `-unfold' takes a
   3431 seed value and builds a (potentially infinite!) list.
   3432 
   3433 FUN should return nil to stop the generating process, or a
   3434 cons (A . B), where A will be prepended to the result and B is
   3435 the new seed."
   3436   (declare (important-return-value t))
   3437   (let ((last (funcall fun seed)) r)
   3438     (while last
   3439       (push (car last) r)
   3440       (setq last (funcall fun (cdr last))))
   3441     (nreverse r)))
   3442 
   3443 (defmacro --unfold (form seed)
   3444   "Anaphoric version of `-unfold'."
   3445   (declare (debug (def-form form)))
   3446   `(-unfold (lambda (it) (ignore it) ,form) ,seed))
   3447 
   3448 (defun -cons-pair? (obj)
   3449   "Return non-nil if OBJ is a true cons pair.
   3450 That is, a cons (A . B) where B is not a list.
   3451 
   3452 Alias: `-cons-pair-p'."
   3453   (declare (pure t) (side-effect-free error-free))
   3454   (nlistp (cdr-safe obj)))
   3455 
   3456 (defalias '-cons-pair-p '-cons-pair?)
   3457 
   3458 (defun -cons-to-list (con)
   3459   "Convert a cons pair to a list with `car' and `cdr' of the pair respectively."
   3460   (declare (pure t) (side-effect-free t))
   3461   (list (car con) (cdr con)))
   3462 
   3463 (defun -value-to-list (val)
   3464   "Convert a value to a list.
   3465 
   3466 If the value is a cons pair, make a list with two elements, `car'
   3467 and `cdr' of the pair respectively.
   3468 
   3469 If the value is anything else, wrap it in a list."
   3470   (declare (pure t) (side-effect-free t))
   3471   (if (-cons-pair? val) (-cons-to-list val) (list val)))
   3472 
   3473 (defun -tree-mapreduce-from (fn folder init-value tree)
   3474   "Apply FN to each element of TREE, and make a list of the results.
   3475 If elements of TREE are lists themselves, apply FN recursively to
   3476 elements of these nested lists.
   3477 
   3478 Then reduce the resulting lists using FOLDER and initial value
   3479 INIT-VALUE. See `-reduce-r-from'.
   3480 
   3481 This is the same as calling `-tree-reduce-from' after `-tree-map'
   3482 but is twice as fast as it only traverse the structure once."
   3483   (declare (important-return-value t))
   3484   (cond
   3485    ((null tree) ())
   3486    ((-cons-pair? tree) (funcall fn tree))
   3487    ((consp tree)
   3488     (-reduce-r-from
   3489      folder init-value
   3490      (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree)))
   3491    ((funcall fn tree))))
   3492 
   3493 (defmacro --tree-mapreduce-from (form folder init-value tree)
   3494   "Anaphoric form of `-tree-mapreduce-from'."
   3495   (declare (debug (def-form def-form form form)))
   3496   `(-tree-mapreduce-from (lambda (it) (ignore it) ,form)
   3497                          (lambda (it acc) (ignore it acc) ,folder)
   3498                          ,init-value
   3499                          ,tree))
   3500 
   3501 (defun -tree-mapreduce (fn folder tree)
   3502   "Apply FN to each element of TREE, and make a list of the results.
   3503 If elements of TREE are lists themselves, apply FN recursively to
   3504 elements of these nested lists.
   3505 
   3506 Then reduce the resulting lists using FOLDER and initial value
   3507 INIT-VALUE. See `-reduce-r-from'.
   3508 
   3509 This is the same as calling `-tree-reduce' after `-tree-map'
   3510 but is twice as fast as it only traverse the structure once."
   3511   (declare (important-return-value t))
   3512   (cond
   3513    ((null tree) ())
   3514    ((-cons-pair? tree) (funcall fn tree))
   3515    ((consp tree)
   3516     (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree)))
   3517    ((funcall fn tree))))
   3518 
   3519 (defmacro --tree-mapreduce (form folder tree)
   3520   "Anaphoric form of `-tree-mapreduce'."
   3521   (declare (debug (def-form def-form form)))
   3522   `(-tree-mapreduce (lambda (it) (ignore it) ,form)
   3523                     (lambda (it acc) (ignore it acc) ,folder)
   3524                     ,tree))
   3525 
   3526 (defun -tree-map (fn tree)
   3527   "Apply FN to each element of TREE while preserving the tree structure."
   3528   (declare (important-return-value t))
   3529   (cond
   3530    ((null tree) ())
   3531    ((-cons-pair? tree) (funcall fn tree))
   3532    ((consp tree)
   3533     (mapcar (lambda (x) (-tree-map fn x)) tree))
   3534    ((funcall fn tree))))
   3535 
   3536 (defmacro --tree-map (form tree)
   3537   "Anaphoric form of `-tree-map'."
   3538   (declare (debug (def-form form)))
   3539   `(-tree-map (lambda (it) (ignore it) ,form) ,tree))
   3540 
   3541 (defun -tree-reduce-from (fn init-value tree)
   3542   "Use FN to reduce elements of list TREE.
   3543 If elements of TREE are lists themselves, apply the reduction recursively.
   3544 
   3545 FN is first applied to INIT-VALUE and first element of the list,
   3546 then on this result and second element from the list etc.
   3547 
   3548 The initial value is ignored on cons pairs as they always contain
   3549 two elements."
   3550   (declare (important-return-value t))
   3551   (cond
   3552    ((null tree) ())
   3553    ((-cons-pair? tree) tree)
   3554    ((consp tree)
   3555     (-reduce-r-from
   3556      fn init-value
   3557      (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree)))
   3558    (tree)))
   3559 
   3560 (defmacro --tree-reduce-from (form init-value tree)
   3561   "Anaphoric form of `-tree-reduce-from'."
   3562   (declare (debug (def-form form form)))
   3563   `(-tree-reduce-from (lambda (it acc) (ignore it acc) ,form)
   3564                       ,init-value ,tree))
   3565 
   3566 (defun -tree-reduce (fn tree)
   3567   "Use FN to reduce elements of list TREE.
   3568 If elements of TREE are lists themselves, apply the reduction recursively.
   3569 
   3570 FN is first applied to first element of the list and second
   3571 element, then on this result and third element from the list etc.
   3572 
   3573 See `-reduce-r' for how exactly are lists of zero or one element handled."
   3574   (declare (important-return-value t))
   3575   (cond
   3576    ((null tree) ())
   3577    ((-cons-pair? tree) tree)
   3578    ((consp tree)
   3579     (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree)))
   3580    (tree)))
   3581 
   3582 (defmacro --tree-reduce (form tree)
   3583   "Anaphoric form of `-tree-reduce'."
   3584   (declare (debug (def-form form)))
   3585   `(-tree-reduce (lambda (it acc) (ignore it acc) ,form) ,tree))
   3586 
   3587 (defun -tree-map-nodes (pred fun tree)
   3588   "Call FUN on each node of TREE that satisfies PRED.
   3589 
   3590 If PRED returns nil, continue descending down this node.  If PRED
   3591 returns non-nil, apply FUN to this node and do not descend
   3592 further."
   3593   (cond ((funcall pred tree) (funcall fun tree))
   3594         ((and (listp tree) (listp (cdr tree)))
   3595          (-map (lambda (x) (-tree-map-nodes pred fun x)) tree))
   3596         (tree)))
   3597 
   3598 (defmacro --tree-map-nodes (pred form tree)
   3599   "Anaphoric form of `-tree-map-nodes'."
   3600   (declare (debug (def-form def-form form)))
   3601   `(-tree-map-nodes (lambda (it) (ignore it) ,pred)
   3602                     (lambda (it) (ignore it) ,form)
   3603                     ,tree))
   3604 
   3605 (defun -tree-seq (branch children tree)
   3606   "Return a sequence of the nodes in TREE, in depth-first search order.
   3607 
   3608 BRANCH is a predicate of one argument that returns non-nil if the
   3609 passed argument is a branch, that is, a node that can have children.
   3610 
   3611 CHILDREN is a function of one argument that returns the children
   3612 of the passed branch node.
   3613 
   3614 Non-branch nodes are simply copied."
   3615   (declare (important-return-value t))
   3616   (cons tree
   3617         (and (funcall branch tree)
   3618              (-mapcat (lambda (x) (-tree-seq branch children x))
   3619                       (funcall children tree)))))
   3620 
   3621 (defmacro --tree-seq (branch children tree)
   3622   "Anaphoric form of `-tree-seq'."
   3623   (declare (debug (def-form def-form form)))
   3624   `(-tree-seq (lambda (it) (ignore it) ,branch)
   3625               (lambda (it) (ignore it) ,children)
   3626               ,tree))
   3627 
   3628 (defun -clone (list)
   3629   "Create a deep copy of LIST.
   3630 The new list has the same elements and structure but all cons are
   3631 replaced with new ones.  This is useful when you need to clone a
   3632 structure such as plist or alist."
   3633   (declare (side-effect-free t))
   3634   (-tree-map #'identity list))
   3635 
   3636 ;;; Combinators
   3637 
   3638 (defalias '-partial #'apply-partially)
   3639 
   3640 (defun -rpartial (fn &rest args)
   3641   "Return a function that is a partial application of FN to ARGS.
   3642 ARGS is a list of the last N arguments to pass to FN.  The result
   3643 is a new function which does the same as FN, except that the last
   3644 N arguments are fixed at the values with which this function was
   3645 called.  This is like `-partial', except the arguments are fixed
   3646 starting from the right rather than the left."
   3647   (declare (pure t) (side-effect-free error-free))
   3648   (lambda (&rest args-before) (apply fn (append args-before args))))
   3649 
   3650 (defun -juxt (&rest fns)
   3651   "Return a function that is the juxtaposition of FNS.
   3652 The returned function takes a variable number of ARGS, applies
   3653 each of FNS in turn to ARGS, and returns the list of results."
   3654   (declare (pure t) (side-effect-free error-free))
   3655   (lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns)))
   3656 
   3657 (defun -compose (&rest fns)
   3658   "Compose FNS into a single composite function.
   3659 Return a function that takes a variable number of ARGS, applies
   3660 the last function in FNS to ARGS, and returns the result of
   3661 calling each remaining function on the result of the previous
   3662 function, right-to-left.  If no FNS are given, return a variadic
   3663 `identity' function."
   3664   (declare (pure t) (side-effect-free error-free))
   3665   (let* ((fns (nreverse fns))
   3666          (head (car fns))
   3667          (tail (cdr fns)))
   3668     (cond (tail
   3669            (lambda (&rest args)
   3670              (--reduce-from (funcall it acc) (apply head args) tail)))
   3671           (fns head)
   3672           ((lambda (&optional arg &rest _) arg)))))
   3673 
   3674 (defun -applify (fn)
   3675   "Return a function that applies FN to a single list of args.
   3676 This changes the arity of FN from taking N distinct arguments to
   3677 taking 1 argument which is a list of N arguments."
   3678   (declare (pure t) (side-effect-free error-free))
   3679   (lambda (args) (apply fn args)))
   3680 
   3681 (defun -on (op trans)
   3682   "Return a function that calls TRANS on each arg and OP on the results.
   3683 The returned function takes a variable number of arguments, calls
   3684 the function TRANS on each one in turn, and then passes those
   3685 results as the list of arguments to OP, in the same order.
   3686 
   3687 For example, the following pairs of expressions are morally
   3688 equivalent:
   3689 
   3690   (funcall (-on #\\='+ #\\='1+) 1 2 3) = (+ (1+ 1) (1+ 2) (1+ 3))
   3691   (funcall (-on #\\='+ #\\='1+))       = (+)"
   3692   (declare (pure t) (side-effect-free error-free))
   3693   (lambda (&rest args)
   3694     ;; This unrolling seems to be a relatively cheap way to keep the
   3695     ;; overhead of `mapcar' + `apply' in check.
   3696     (cond ((cddr args)
   3697            (apply op (mapcar trans args)))
   3698           ((cdr args)
   3699            (funcall op (funcall trans (car args)) (funcall trans (cadr args))))
   3700           (args
   3701            (funcall op (funcall trans (car args))))
   3702           ((funcall op)))))
   3703 
   3704 (defun -flip (fn)
   3705   "Return a function that calls FN with its arguments reversed.
   3706 The returned function takes the same number of arguments as FN.
   3707 
   3708 For example, the following two expressions are morally
   3709 equivalent:
   3710 
   3711   (funcall (-flip #\\='-) 1 2) = (- 2 1)
   3712 
   3713 See also: `-rotate-args'."
   3714   (declare (pure t) (side-effect-free error-free))
   3715   (lambda (&rest args) ;; Open-code for speed.
   3716     (cond ((cddr args) (apply fn (nreverse args)))
   3717           ((cdr args) (funcall fn (cadr args) (car args)))
   3718           (args (funcall fn (car args)))
   3719           ((funcall fn)))))
   3720 
   3721 (defun -rotate-args (n fn)
   3722   "Return a function that calls FN with args rotated N places to the right.
   3723 The returned function takes the same number of arguments as FN,
   3724 rotates the list of arguments N places to the right (left if N is
   3725 negative) just like `-rotate', and applies FN to the result.
   3726 
   3727 See also: `-flip'."
   3728   (declare (pure t) (side-effect-free t))
   3729   (if (zerop n)
   3730       fn
   3731     (let ((even (= (% n 2) 0)))
   3732       (lambda (&rest args)
   3733         (cond ((cddr args) ;; Open-code for speed.
   3734                (apply fn (-rotate n args)))
   3735               ((cdr args)
   3736                (let ((fst (car args))
   3737                      (snd (cadr args)))
   3738                  (funcall fn (if even fst snd) (if even snd fst))))
   3739               (args
   3740                (funcall fn (car args)))
   3741               ((funcall fn)))))))
   3742 
   3743 (defun -const (c)
   3744   "Return a function that returns C ignoring any additional arguments.
   3745 
   3746 In types: a -> b -> a"
   3747   (declare (pure t) (side-effect-free error-free))
   3748   (lambda (&rest _) c))
   3749 
   3750 (defmacro -cut (&rest params)
   3751   "Take n-ary function and n arguments and specialize some of them.
   3752 Arguments denoted by <> will be left unspecialized.
   3753 
   3754 See SRFI-26 for detailed description."
   3755   (declare (debug (&optional sexp &rest &or "<>" form)))
   3756   (let* ((i 0)
   3757          (args (--keep (when (eq it '<>)
   3758                          (setq i (1+ i))
   3759                          (make-symbol (format "D%d" i)))
   3760                        params)))
   3761     `(lambda ,args
   3762        ,(let ((body (--map (if (eq it '<>) (pop args) it) params)))
   3763           (if (eq (car params) '<>)
   3764               (cons #'funcall body)
   3765             body)))))
   3766 
   3767 (defun -not (pred)
   3768   "Return a predicate that negates the result of PRED.
   3769 The returned predicate passes its arguments to PRED.  If PRED
   3770 returns nil, the result is non-nil; otherwise the result is nil.
   3771 
   3772 See also: `-andfn' and `-orfn'."
   3773   (declare (pure t) (side-effect-free error-free))
   3774   (lambda (&rest args) (not (apply pred args))))
   3775 
   3776 (defun -orfn (&rest preds)
   3777   "Return a predicate that returns the first non-nil result of PREDS.
   3778 The returned predicate takes a variable number of arguments,
   3779 passes them to each predicate in PREDS in turn until one of them
   3780 returns non-nil, and returns that non-nil result without calling
   3781 the remaining PREDS.  If all PREDS return nil, or if no PREDS are
   3782 given, the returned predicate returns nil.
   3783 
   3784 See also: `-andfn' and `-not'."
   3785   (declare (pure t) (side-effect-free error-free))
   3786   ;; Open-code for speed.
   3787   (cond ((cdr preds) (lambda (&rest args) (--some (apply it args) preds)))
   3788         (preds (car preds))
   3789         (#'ignore)))
   3790 
   3791 (defun -andfn (&rest preds)
   3792   "Return a predicate that returns non-nil if all PREDS do so.
   3793 The returned predicate P takes a variable number of arguments and
   3794 passes them to each predicate in PREDS in turn.  If any one of
   3795 PREDS returns nil, P also returns nil without calling the
   3796 remaining PREDS.  If all PREDS return non-nil, P returns the last
   3797 such value.  If no PREDS are given, P always returns non-nil.
   3798 
   3799 See also: `-orfn' and `-not'."
   3800   (declare (pure t) (side-effect-free error-free))
   3801   ;; Open-code for speed.
   3802   (cond ((cdr preds) (lambda (&rest args) (--every (apply it args) preds)))
   3803         (preds (car preds))
   3804         ;; As a `pure' function, this runtime check may generate
   3805         ;; backward-incompatible bytecode for `(-andfn)' at compile-time,
   3806         ;; but I doubt that's a problem in practice (famous last words).
   3807         ((fboundp 'always) #'always)
   3808         ((lambda (&rest _) t))))
   3809 
   3810 (defun -iteratefn (fn n)
   3811   "Return a function FN composed N times with itself.
   3812 
   3813 FN is a unary function.  If you need to use a function of higher
   3814 arity, use `-applify' first to turn it into a unary function.
   3815 
   3816 With n = 0, this acts as identity function.
   3817 
   3818 In types: (a -> a) -> Int -> a -> a.
   3819 
   3820 This function satisfies the following law:
   3821 
   3822   (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))."
   3823   (declare (pure t) (side-effect-free error-free))
   3824   (lambda (x) (--dotimes n (setq x (funcall fn x))) x))
   3825 
   3826 (defun -counter (&optional beg end inc)
   3827   "Return a closure that counts from BEG to END, with increment INC.
   3828 
   3829 The closure will return the next value in the counting sequence
   3830 each time it is called, and nil after END is reached. BEG
   3831 defaults to 0, INC defaults to 1, and if END is nil, the counter
   3832 will increment indefinitely.
   3833 
   3834 The closure accepts any number of arguments, which are discarded."
   3835   (declare (pure t) (side-effect-free error-free))
   3836   (let ((inc (or inc 1))
   3837         (n (or beg 0)))
   3838     (lambda (&rest _)
   3839       (when (or (not end) (< n end))
   3840         (prog1 n
   3841           (setq n (+ n inc)))))))
   3842 
   3843 (defvar -fixfn-max-iterations 1000
   3844   "The default maximum number of iterations performed by `-fixfn'
   3845   unless otherwise specified.")
   3846 
   3847 (defun -fixfn (fn &optional equal-test halt-test)
   3848   "Return a function that computes the (least) fixpoint of FN.
   3849 
   3850 FN must be a unary function. The returned lambda takes a single
   3851 argument, X, the initial value for the fixpoint iteration. The
   3852 iteration halts when either of the following conditions is satisfied:
   3853 
   3854  1. Iteration converges to the fixpoint, with equality being
   3855     tested using EQUAL-TEST. If EQUAL-TEST is not specified,
   3856     `equal' is used. For functions over the floating point
   3857     numbers, it may be necessary to provide an appropriate
   3858     approximate comparison test.
   3859 
   3860  2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a
   3861     simple counter that returns t after `-fixfn-max-iterations',
   3862     to guard against infinite iteration. Otherwise, HALT-TEST
   3863     must be a function that accepts a single argument, the
   3864     current value of X, and returns non-nil as long as iteration
   3865     should continue. In this way, a more sophisticated
   3866     convergence test may be supplied by the caller.
   3867 
   3868 The return value of the lambda is either the fixpoint or, if
   3869 iteration halted before converging, a cons with car `halted' and
   3870 cdr the final output from HALT-TEST.
   3871 
   3872 In types: (a -> a) -> a -> a."
   3873   (declare (important-return-value t))
   3874   (let ((eqfn   (or equal-test 'equal))
   3875         (haltfn (or halt-test
   3876                     (-not
   3877                      (-counter 0 -fixfn-max-iterations)))))
   3878     (lambda (x)
   3879       (let ((re (funcall fn x))
   3880             (halt? (funcall haltfn x)))
   3881         (while (and (not halt?) (not (funcall eqfn x re)))
   3882           (setq x     re
   3883                 re    (funcall fn re)
   3884                 halt? (funcall haltfn re)))
   3885         (if halt? (cons 'halted halt?)
   3886           re)))))
   3887 
   3888 (defun -prodfn (&rest fns)
   3889   "Return a function that applies each of FNS to each of a list of arguments.
   3890 
   3891 Takes a list of N functions and returns a function that takes a
   3892 list of length N, applying Ith function to Ith element of the
   3893 input list.  Returns a list of length N.
   3894 
   3895 In types (for N=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d)
   3896 
   3897 This function satisfies the following laws:
   3898 
   3899     (-compose (-prodfn f g ...)
   3900               (-prodfn f\\=' g\\=' ...))
   3901   = (-prodfn (-compose f f\\=')
   3902              (-compose g g\\=')
   3903              ...)
   3904 
   3905     (-prodfn f g ...)
   3906   = (-juxt (-compose f (-partial #\\='nth 0))
   3907            (-compose g (-partial #\\='nth 1))
   3908            ...)
   3909 
   3910     (-compose (-prodfn f g ...)
   3911               (-juxt f\\=' g\\=' ...))
   3912   = (-juxt (-compose f f\\=')
   3913            (-compose g g\\=')
   3914            ...)
   3915 
   3916     (-compose (-partial #\\='nth n)
   3917               (-prod f1 f2 ...))
   3918   = (-compose fn (-partial #\\='nth n))"
   3919   (declare (pure t) (side-effect-free t))
   3920   (lambda (x) (--zip-with (funcall it other) fns x)))
   3921 
   3922 ;;; Font lock
   3923 
   3924 (defvar dash--keywords
   3925   `(;; TODO: Do not fontify the following automatic variables
   3926     ;; globally; detect and limit to their local anaphoric scope.
   3927     (,(rx symbol-start (| "acc" "it" "it-index" "other") symbol-end)
   3928      0 font-lock-variable-name-face)
   3929     ;; Macros in dev/examples.el.  Based on `lisp-mode-symbol-regexp'.
   3930     (,(rx ?\( (group (| "defexamples" "def-example-group")) symbol-end
   3931           (+ (in "\t "))
   3932           (group (* (| (syntax word) (syntax symbol) (: ?\\ nonl)))))
   3933      (1 font-lock-keyword-face)
   3934      (2 font-lock-function-name-face))
   3935     ;; Symbols in dev/examples.el.
   3936     ,(rx symbol-start (| "=>" "~>" "!!>") symbol-end)
   3937     ;; Elisp macro fontification was static prior to Emacs 25.
   3938     ,@(when (< emacs-major-version 25)
   3939         (let ((macs '("!cdr"
   3940                       "!cons"
   3941                       "-->"
   3942                       "--all-p"
   3943                       "--all?"
   3944                       "--annotate"
   3945                       "--any"
   3946                       "--any-p"
   3947                       "--any?"
   3948                       "--count"
   3949                       "--dotimes"
   3950                       "--doto"
   3951                       "--drop-while"
   3952                       "--each"
   3953                       "--each-indexed"
   3954                       "--each-r"
   3955                       "--each-r-while"
   3956                       "--each-while"
   3957                       "--every"
   3958                       "--every-p"
   3959                       "--every?"
   3960                       "--filter"
   3961                       "--find"
   3962                       "--find-index"
   3963                       "--find-indices"
   3964                       "--find-last-index"
   3965                       "--first"
   3966                       "--fix"
   3967                       "--group-by"
   3968                       "--if-let"
   3969                       "--iterate"
   3970                       "--keep"
   3971                       "--last"
   3972                       "--map"
   3973                       "--map-first"
   3974                       "--map-indexed"
   3975                       "--map-last"
   3976                       "--map-when"
   3977                       "--mapcat"
   3978                       "--max-by"
   3979                       "--min-by"
   3980                       "--none-p"
   3981                       "--none?"
   3982                       "--only-some-p"
   3983                       "--only-some?"
   3984                       "--partition-after-pred"
   3985                       "--partition-by"
   3986                       "--partition-by-header"
   3987                       "--reduce"
   3988                       "--reduce-from"
   3989                       "--reduce-r"
   3990                       "--reduce-r-from"
   3991                       "--reductions"
   3992                       "--reductions-from"
   3993                       "--reductions-r"
   3994                       "--reductions-r-from"
   3995                       "--reject"
   3996                       "--reject-first"
   3997                       "--reject-last"
   3998                       "--remove"
   3999                       "--remove-first"
   4000                       "--remove-last"
   4001                       "--replace-where"
   4002                       "--select"
   4003                       "--separate"
   4004                       "--some"
   4005                       "--some-p"
   4006                       "--some?"
   4007                       "--sort"
   4008                       "--splice"
   4009                       "--splice-list"
   4010                       "--split-when"
   4011                       "--split-with"
   4012                       "--take-while"
   4013                       "--tree-map"
   4014                       "--tree-map-nodes"
   4015                       "--tree-mapreduce"
   4016                       "--tree-mapreduce-from"
   4017                       "--tree-reduce"
   4018                       "--tree-reduce-from"
   4019                       "--tree-seq"
   4020                       "--unfold"
   4021                       "--update-at"
   4022                       "--when-let"
   4023                       "--zip-with"
   4024                       "->"
   4025                       "->>"
   4026                       "-as->"
   4027                       "-cut"
   4028                       "-doto"
   4029                       "-if-let"
   4030                       "-if-let*"
   4031                       "-lambda"
   4032                       "-let"
   4033                       "-let*"
   4034                       "-setq"
   4035                       "-some-->"
   4036                       "-some->"
   4037                       "-some->>"
   4038                       "-split-on"
   4039                       "-when-let"
   4040                       "-when-let*")))
   4041           `((,(concat "(" (regexp-opt macs 'symbols)) . 1)))))
   4042   "Font lock keywords for `dash-fontify-mode'.")
   4043 
   4044 (defcustom dash-fontify-mode-lighter nil
   4045   "Mode line lighter for `dash-fontify-mode'.
   4046 Either a string to display in the mode line when
   4047 `dash-fontify-mode' is on, or nil to display
   4048 nothing (the default)."
   4049   :package-version '(dash . "2.18.0")
   4050   :type '(choice (string :tag "Lighter" :value " Dash")
   4051                  (const :tag "Nothing" nil)))
   4052 
   4053 ;;;###autoload
   4054 (define-minor-mode dash-fontify-mode
   4055   "Toggle fontification of Dash special variables.
   4056 
   4057 Dash-Fontify mode is a buffer-local minor mode intended for Emacs
   4058 Lisp buffers.  Enabling it causes the special variables bound in
   4059 anaphoric Dash macros to be fontified.  These anaphoras include
   4060 `it', `it-index', `acc', and `other'.  In older Emacs versions
   4061 which do not dynamically detect macros, Dash-Fontify mode
   4062 additionally fontifies Dash macro calls.
   4063 
   4064 See also `dash-fontify-mode-lighter' and
   4065 `global-dash-fontify-mode'."
   4066   :lighter dash-fontify-mode-lighter
   4067   (if dash-fontify-mode
   4068       (font-lock-add-keywords nil dash--keywords t)
   4069     (font-lock-remove-keywords nil dash--keywords))
   4070   (cond ((fboundp 'font-lock-flush) ;; Added in Emacs 25.
   4071          (font-lock-flush))
   4072         ;; `font-lock-fontify-buffer' unconditionally enables
   4073         ;; `font-lock-mode' and is marked `interactive-only' in later
   4074         ;; Emacs versions which have `font-lock-flush', so we guard
   4075         ;; and pacify as needed, respectively.
   4076         (font-lock-mode
   4077          (with-no-warnings
   4078            (font-lock-fontify-buffer)))))
   4079 
   4080 (defun dash--turn-on-fontify-mode ()
   4081   "Enable `dash-fontify-mode' if in an Emacs Lisp buffer."
   4082   (when (derived-mode-p #'emacs-lisp-mode)
   4083     (dash-fontify-mode)))
   4084 
   4085 ;;;###autoload
   4086 (define-globalized-minor-mode global-dash-fontify-mode
   4087   dash-fontify-mode dash--turn-on-fontify-mode)
   4088 
   4089 (defcustom dash-enable-fontlock nil
   4090   "If non-nil, fontify Dash macro calls and special variables."
   4091   :set (lambda (sym val)
   4092          (set-default sym val)
   4093          (global-dash-fontify-mode (if val 1 0)))
   4094   :type 'boolean)
   4095 
   4096 (make-obsolete-variable
   4097  'dash-enable-fontlock #'global-dash-fontify-mode "2.18.0")
   4098 
   4099 (define-obsolete-function-alias
   4100   'dash-enable-font-lock #'global-dash-fontify-mode "2.18.0")
   4101 
   4102 ;;; Info
   4103 
   4104 (defvar dash--info-doc-spec '("(dash) Index" nil "^ -+ .*: " "\\( \\|$\\)")
   4105   "The Dash :doc-spec entry for `info-lookup-alist'.
   4106 It is based on that for `emacs-lisp-mode'.")
   4107 
   4108 (defun dash--info-elisp-docs ()
   4109   "Return the `emacs-lisp-mode' symbol docs from `info-lookup-alist'.
   4110 Specifically, return the cons containing their
   4111 `info-lookup->doc-spec' so that we can modify it."
   4112   (defvar info-lookup-alist)
   4113   (nthcdr 3 (assq #'emacs-lisp-mode (cdr (assq 'symbol info-lookup-alist)))))
   4114 
   4115 ;;;###autoload
   4116 (defun dash-register-info-lookup ()
   4117   "Register the Dash Info manual with `info-lookup-symbol'.
   4118 This allows Dash symbols to be looked up with \\[info-lookup-symbol]."
   4119   (interactive)
   4120   (require 'info-look)
   4121   (let ((docs (dash--info-elisp-docs)))
   4122     (setcar docs (append (car docs) (list dash--info-doc-spec)))
   4123     (info-lookup-reset)))
   4124 
   4125 (defun dash-unload-function ()
   4126   "Remove Dash from `info-lookup-alist'.
   4127 Used by `unload-feature', which see."
   4128   (let ((docs (and (featurep 'info-look)
   4129                    (dash--info-elisp-docs))))
   4130     (when (member dash--info-doc-spec (car docs))
   4131       (setcar docs (remove dash--info-doc-spec (car docs)))
   4132       (info-lookup-reset)))
   4133   nil)
   4134 
   4135 (provide 'dash)
   4136 ;;; dash.el ends here