dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

dash.el (124410B)


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