dash.el

;;; dash.el --- A modern list library for Emacs  -*- lexical-binding: t -*-

;; Copyright (C) 2012-2021 Free Software Foundation, Inc.

;; Author: Magnar Sveen <magnars@gmail.com>
;; Version: 2.19.1
;; Package-Requires: ((emacs "24"))
;; Keywords: extensions, lisp
;; Homepage: https://github.com/magnars/dash.el

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; A modern list API for Emacs.
;;
;; See its overview at https://github.com/magnars/dash.el#functions.

;;; Code:

;; TODO: `gv' was introduced in Emacs 24.3, so remove this and all
;; calls to `defsetf' when support for earlier versions is dropped.
(eval-when-compile
  (unless (fboundp 'gv-define-setter)
    (require 'cl)))

(defgroup dash ()
  "Customize group for Dash, a modern list library."
  :group 'extensions
  :group 'lisp
  :prefix "dash-")

(defmacro !cons (car cdr)
  "Destructive: Set CDR to the cons of CAR and CDR."
  (declare (debug (form symbolp)))
  `(setq ,cdr (cons ,car ,cdr)))

(defmacro !cdr (list)
  "Destructive: Set LIST to the cdr of LIST."
  (declare (debug (symbolp)))
  `(setq ,list (cdr ,list)))

(defmacro --each (list &rest body)
  "Evaluate BODY for each element of LIST and return nil.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating BODY.
This is the anaphoric counterpart to `-each'."
  (declare (debug (form body)) (indent 1))
  (let ((l (make-symbol "list"))
        (i (make-symbol "i")))
    `(let ((,l ,list)
           (,i 0)
           it it-index)
       (ignore it it-index)
       (while ,l
         (setq it (pop ,l) it-index ,i ,i (1+ ,i))
         ,@body))))

(defun -each (list fn)
  "Call FN on each element of LIST.
Return nil; this function is intended for side effects.

Its anaphoric counterpart is `--each'.

For access to the current element's index in LIST, see
`-each-indexed'."
  (declare (indent 1))
  (ignore (mapc fn list)))

(defalias '--each-indexed '--each)

(defun -each-indexed (list fn)
  "Call FN on each index and element of LIST.
For each ITEM at INDEX in LIST, call (funcall FN INDEX ITEM).
Return nil; this function is intended for side effects.

See also: `-map-indexed'."
  (declare (indent 1))
  (--each list (funcall fn it-index it)))

(defmacro --each-while (list pred &rest body)
  "Evaluate BODY for each item in LIST, while PRED evaluates to non-nil.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating PRED or BODY.  Once
an element is reached for which PRED evaluates to nil, no further
BODY is evaluated.  The return value is always nil.
This is the anaphoric counterpart to `-each-while'."
  (declare (debug (form form body)) (indent 2))
  (let ((l (make-symbol "list"))
        (i (make-symbol "i"))
        (elt (make-symbol "elt")))
    `(let ((,l ,list)
           (,i 0)
           ,elt it it-index)
       (ignore it it-index)
       (while (and ,l (setq ,elt (pop ,l) it ,elt it-index ,i) ,pred)
         (setq it ,elt it-index ,i ,i (1+ ,i))
         ,@body))))

(defun -each-while (list pred fn)
  "Call FN on each ITEM in LIST, while (PRED ITEM) is non-nil.
Once an ITEM is reached for which PRED returns nil, FN is no
longer called.  Return nil; this function is intended for side
effects.

Its anaphoric counterpart is `--each-while'."
  (declare (indent 2))
  (--each-while list (funcall pred it) (funcall fn it)))

(defmacro --each-r (list &rest body)
  "Evaluate BODY for each element of LIST in reversed order.
Each element of LIST in turn, starting at its end, is bound to
`it' and its index within LIST to `it-index' before evaluating
BODY.  The return value is always nil.
This is the anaphoric counterpart to `-each-r'."
  (declare (debug (form body)) (indent 1))
  (let ((v (make-symbol "vector"))
        (i (make-symbol "i")))
    ;; Implementation note: building a vector is considerably faster
    ;; than building a reversed list (vector takes less memory, so
    ;; there is less GC), plus `length' comes naturally.  In-place
    ;; `nreverse' would be faster still, but BODY would be able to see
    ;; that, even if the modification was undone before we return.
    `(let* ((,v (vconcat ,list))
            (,i (length ,v))
            it it-index)
       (ignore it it-index)
       (while (> ,i 0)
         (setq ,i (1- ,i) it-index ,i it (aref ,v ,i))
         ,@body))))

(defun -each-r (list fn)
  "Call FN on each element of LIST in reversed order.
Return nil; this function is intended for side effects.

Its anaphoric counterpart is `--each-r'."
  (--each-r list (funcall fn it)))

(defmacro --each-r-while (list pred &rest body)
  "Eval BODY for each item in reversed LIST, while PRED evals to non-nil.
Each element of LIST in turn, starting at its end, is bound to
`it' and its index within LIST to `it-index' before evaluating
PRED or BODY.  Once an element is reached for which PRED
evaluates to nil, no further BODY is evaluated.  The return value
is always nil.
This is the anaphoric counterpart to `-each-r-while'."
  (declare (debug (form form body)) (indent 2))
  (let ((v (make-symbol "vector"))
        (i (make-symbol "i"))
        (elt (make-symbol "elt")))
    `(let* ((,v (vconcat ,list))
            (,i (length ,v))
            ,elt it it-index)
       (ignore it it-index)
       (while (when (> ,i 0)
                (setq ,i (1- ,i) it-index ,i)
                (setq ,elt (aref ,v ,i) it ,elt)
                ,pred)
         (setq it-index ,i it ,elt)
         ,@body))))

(defun -each-r-while (list pred fn)
  "Call FN on each ITEM in reversed LIST, while (PRED ITEM) is non-nil.
Once an ITEM is reached for which PRED returns nil, FN is no
longer called.  Return nil; this function is intended for side
effects.

Its anaphoric counterpart is `--each-r-while'."
  (--each-r-while list (funcall pred it) (funcall fn it)))

(defmacro --dotimes (num &rest body)
  "Evaluate BODY NUM times, presumably for side effects.
BODY is evaluated with the local variable `it' temporarily bound
to successive integers running from 0, inclusive, to NUM,
exclusive.  BODY is not evaluated if NUM is less than 1.
This is the anaphoric counterpart to `-dotimes'."
  (declare (debug (form body)) (indent 1))
  (let ((n (make-symbol "num"))
        (i (make-symbol "i")))
    `(let ((,n ,num)
           (,i 0)
           it)
       (ignore it)
       (while (< ,i ,n)
         (setq it ,i ,i (1+ ,i))
         ,@body))))

(defun -dotimes (num fn)
  "Call FN NUM times, presumably for side effects.
FN is called with a single argument on successive integers
running from 0, inclusive, to NUM, exclusive.  FN is not called
if NUM is less than 1.

This function's anaphoric counterpart is `--dotimes'."
  (declare (indent 1))
  (--dotimes num (funcall fn it)))

(defun -map (fn list)
  "Apply FN to each item in LIST and return the list of results.

This function's anaphoric counterpart is `--map'."
  (mapcar fn list))

(defmacro --map (form list)
  "Eval FORM for each item in LIST and return the list of results.
Each element of LIST in turn is bound to `it' before evaluating
FORM.
This is the anaphoric counterpart to `-map'."
  (declare (debug (def-form form)))
  `(mapcar (lambda (it) (ignore it) ,form) ,list))

(defmacro --reduce-from (form init list)
  "Accumulate a value by evaluating FORM across LIST.
This macro is like `--each' (which see), but it additionally
provides an accumulator variable `acc' which it successively
binds to the result of evaluating FORM for the current LIST
element before processing the next element.  For the first
element, `acc' is initialized with the result of evaluating INIT.
The return value is the resulting value of `acc'.  If LIST is
empty, FORM is not evaluated, and the return value is the result
of INIT.
This is the anaphoric counterpart to `-reduce-from'."
  (declare (debug (form form form)))
  `(let ((acc ,init))
     (--each ,list (setq acc ,form))
     acc))

(defun -reduce-from (fn init list)
  "Reduce the function FN across LIST, starting with INIT.
Return the result of applying FN to INIT and the first element of
LIST, then applying FN to that result and the second element,
etc.  If LIST is empty, return INIT without calling FN.

This function's anaphoric counterpart is `--reduce-from'.

For other folds, see also `-reduce' and `-reduce-r'."
  (--reduce-from (funcall fn acc it) init list))

(defmacro --reduce (form list)
  "Accumulate a value by evaluating FORM across LIST.
This macro is like `--reduce-from' (which see), except the first
element of LIST is taken as INIT.  Thus if LIST contains a single
item, it is returned without evaluating FORM.  If LIST is empty,
FORM is evaluated with `it' and `acc' bound to nil.
This is the anaphoric counterpart to `-reduce'."
  (declare (debug (form form)))
  (let ((lv (make-symbol "list-value")))
    `(let ((,lv ,list))
       (if ,lv
           (--reduce-from ,form (car ,lv) (cdr ,lv))
         ;; Explicit nil binding pacifies lexical "variable left uninitialized"
         ;; warning.  See issue #377 and upstream https://bugs.gnu.org/47080.
         (let ((acc nil) (it nil))
           (ignore acc it)
           ,form)))))

(defun -reduce (fn list)
  "Reduce the function FN across LIST.
Return the result of applying FN to the first two elements of
LIST, then applying FN to that result and the third element, etc.
If LIST contains a single element, return it without calling FN.
If LIST is empty, return the result of calling FN with no
arguments.

This function's anaphoric counterpart is `--reduce'.

For other folds, see also `-reduce-from' and `-reduce-r'."
  (if list
      (-reduce-from fn (car list) (cdr list))
    (funcall fn)))

(defmacro --reduce-r-from (form init list)
  "Accumulate a value by evaluating FORM across LIST in reverse.
This macro is like `--reduce-from', except it starts from the end
of LIST.
This is the anaphoric counterpart to `-reduce-r-from'."
  (declare (debug (form form form)))
  `(let ((acc ,init))
     (--each-r ,list (setq acc ,form))
     acc))

(defun -reduce-r-from (fn init list)
  "Reduce the function FN across LIST in reverse, starting with INIT.
Return the result of applying FN to the last element of LIST and
INIT, then applying FN to the second-to-last element and the
previous result of FN, etc.  That is, the first argument of FN is
the current element, and its second argument the accumulated
value.  If LIST is empty, return INIT without calling FN.

This function is like `-reduce-from' but the operation associates
from the right rather than left.  In other words, it starts from
the end of LIST and flips the arguments to FN.  Conceptually, it
is like replacing the conses in LIST with applications of FN, and
its last link with INIT, and evaluating the resulting expression.

This function's anaphoric counterpart is `--reduce-r-from'.

For other folds, see also `-reduce-r' and `-reduce'."
  (--reduce-r-from (funcall fn it acc) init list))

(defmacro --reduce-r (form list)
  "Accumulate a value by evaluating FORM across LIST in reverse order.
This macro is like `--reduce', except it starts from the end of
LIST.
This is the anaphoric counterpart to `-reduce-r'."
  (declare (debug (form form)))
  `(--reduce ,form (reverse ,list)))

(defun -reduce-r (fn list)
  "Reduce the function FN across LIST in reverse.
Return the result of applying FN to the last two elements of
LIST, then applying FN to the third-to-last element and the
previous result of FN, etc.  That is, the first argument of FN is
the current element, and its second argument the accumulated
value.  If LIST contains a single element, return it without
calling FN.  If LIST is empty, return the result of calling FN
with no arguments.

This function is like `-reduce' but the operation associates from
the right rather than left.  In other words, it starts from the
end of LIST and flips the arguments to FN.  Conceptually, it is
like replacing the conses in LIST with applications of FN,
ignoring its last link, and evaluating the resulting expression.

This function's anaphoric counterpart is `--reduce-r'.

For other folds, see also `-reduce-r-from' and `-reduce'."
  (if list
      (--reduce-r (funcall fn it acc) list)
    (funcall fn)))

(defmacro --reductions-from (form init list)
  "Return a list of FORM's intermediate reductions across LIST.
That is, a list of the intermediate values of the accumulator
when `--reduce-from' (which see) is called with the same
arguments.
This is the anaphoric counterpart to `-reductions-from'."
  (declare (debug (form form form)))
  `(nreverse
    (--reduce-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc)
                   (list ,init)
                   ,list)))

(defun -reductions-from (fn init list)
  "Return a list of FN's intermediate reductions across LIST.
That is, a list of the intermediate values of the accumulator
when `-reduce-from' (which see) is called with the same
arguments.

This function's anaphoric counterpart is `--reductions-from'.

For other folds, see also `-reductions' and `-reductions-r'."
  (--reductions-from (funcall fn acc it) init list))

(defmacro --reductions (form list)
  "Return a list of FORM's intermediate reductions across LIST.
That is, a list of the intermediate values of the accumulator
when `--reduce' (which see) is called with the same arguments.
This is the anaphoric counterpart to `-reductions'."
  (declare (debug (form form)))
  (let ((lv (make-symbol "list-value")))
    `(let ((,lv ,list))
       (if ,lv
           (--reductions-from ,form (car ,lv) (cdr ,lv))
         (let (acc it)
           (ignore acc it)
           (list ,form))))))

(defun -reductions (fn list)
  "Return a list of FN's intermediate reductions across LIST.
That is, a list of the intermediate values of the accumulator
when `-reduce' (which see) is called with the same arguments.

This function's anaphoric counterpart is `--reductions'.

For other folds, see also `-reductions' and `-reductions-r'."
  (if list
      (--reductions-from (funcall fn acc it) (car list) (cdr list))
    (list (funcall fn))))

(defmacro --reductions-r-from (form init list)
  "Return a list of FORM's intermediate reductions across reversed LIST.
That is, a list of the intermediate values of the accumulator
when `--reduce-r-from' (which see) is called with the same
arguments.
This is the anaphoric counterpart to `-reductions-r-from'."
  (declare (debug (form form form)))
  `(--reduce-r-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc)
                    (list ,init)
                    ,list))

(defun -reductions-r-from (fn init list)
  "Return a list of FN's intermediate reductions across reversed LIST.
That is, a list of the intermediate values of the accumulator
when `-reduce-r-from' (which see) is called with the same
arguments.

This function's anaphoric counterpart is `--reductions-r-from'.

For other folds, see also `-reductions' and `-reductions-r'."
  (--reductions-r-from (funcall fn it acc) init list))

(defmacro --reductions-r (form list)
  "Return a list of FORM's intermediate reductions across reversed LIST.
That is, a list of the intermediate values of the accumulator
when `--reduce-re' (which see) is called with the same arguments.
This is the anaphoric counterpart to `-reductions-r'."
  (declare (debug (form list)))
  (let ((lv (make-symbol "list-value")))
    `(let ((,lv (reverse ,list)))
       (if ,lv
           (--reduce-from (cons (let ((acc (car acc))) (ignore acc) ,form) acc)
                          (list (car ,lv))
                          (cdr ,lv))
         ;; Explicit nil binding pacifies lexical "variable left uninitialized"
         ;; warning.  See issue #377 and upstream https://bugs.gnu.org/47080.
         (let ((acc nil) (it nil))
           (ignore acc it)
           (list ,form))))))

(defun -reductions-r (fn list)
  "Return a list of FN's intermediate reductions across reversed LIST.
That is, a list of the intermediate values of the accumulator
when `-reduce-r' (which see) is called with the same arguments.

This function's anaphoric counterpart is `--reductions-r'.

For other folds, see also `-reductions-r-from' and
`-reductions'."
  (if list
      (--reductions-r (funcall fn it acc) list)
    (list (funcall fn))))

(defmacro --filter (form list)
  "Return a new list of the items in LIST for which FORM evals to non-nil.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.
This is the anaphoric counterpart to `-filter'.
For the opposite operation, see also `--remove'."
  (declare (debug (form form)))
  (let ((r (make-symbol "result")))
    `(let (,r)
       (--each ,list (when ,form (push it ,r)))
       (nreverse ,r))))

(defun -filter (pred list)
  "Return a new list of the items in LIST for which PRED returns non-nil.

Alias: `-select'.

This function's anaphoric counterpart is `--filter'.

For similar operations, see also `-keep' and `-remove'."
  (--filter (funcall pred it) list))

(defalias '-select '-filter)
(defalias '--select '--filter)

(defmacro --remove (form list)
  "Return a new list of the items in LIST for which FORM evals to nil.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.
This is the anaphoric counterpart to `-remove'.
For the opposite operation, see also `--filter'."
  (declare (debug (form form)))
  `(--filter (not ,form) ,list))

(defun -remove (pred list)
  "Return a new list of the items in LIST for which PRED returns nil.

Alias: `-reject'.

This function's anaphoric counterpart is `--remove'.

For similar operations, see also `-keep' and `-filter'."
  (--remove (funcall pred it) list))

(defalias '-reject '-remove)
(defalias '--reject '--remove)

(defmacro --remove-first (form list)
  "Remove the first item from LIST for which FORM evals to non-nil.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.  This is a
non-destructive operation, but only the front of LIST leading up
to the removed item is a copy; the rest is LIST's original tail.
If no item is removed, then the result is a complete copy.
This is the anaphoric counterpart to `-remove-first'."
  (declare (debug (form form)))
  (let ((front (make-symbol "front"))
        (tail (make-symbol "tail")))
    `(let ((,tail ,list) ,front)
       (--each-while ,tail (not ,form)
         (push (pop ,tail) ,front))
       (if ,tail
           (nconc (nreverse ,front) (cdr ,tail))
         (nreverse ,front)))))

(defun -remove-first (pred list)
  "Remove the first item from LIST for which PRED returns non-nil.
This is a non-destructive operation, but only the front of LIST
leading up to the removed item is a copy; the rest is LIST's
original tail.  If no item is removed, then the result is a
complete copy.

Alias: `-reject-first'.

This function's anaphoric counterpart is `--remove-first'.

See also `-map-first', `-remove-item', and `-remove-last'."
  (--remove-first (funcall pred it) list))

(defalias '-reject-first '-remove-first)
(defalias '--reject-first '--remove-first)

(defmacro --remove-last (form list)
  "Remove the last item from LIST for which FORM evals to non-nil.
Each element of LIST in turn is bound to `it' before evaluating
FORM.  The result is a copy of LIST regardless of whether an
element is removed.
This is the anaphoric counterpart to `-remove-last'."
  (declare (debug (form form)))
  `(nreverse (--remove-first ,form (reverse ,list))))

(defun -remove-last (pred list)
  "Remove the last item from LIST for which PRED returns non-nil.
The result is a copy of LIST regardless of whether an element is
removed.

Alias: `-reject-last'.

This function's anaphoric counterpart is `--remove-last'.

See also `-map-last', `-remove-item', and `-remove-first'."
  (--remove-last (funcall pred it) list))

(defalias '-reject-last '-remove-last)
(defalias '--reject-last '--remove-last)

(defalias '-remove-item #'remove
  "Return a copy of LIST with all occurrences of ITEM removed.
The comparison is done with `equal'.
\n(fn ITEM LIST)")

(defmacro --keep (form list)
  "Eval FORM for each item in LIST and return the non-nil results.
Like `--filter', but returns the non-nil results of FORM instead
of the corresponding elements of LIST.  Each element of LIST in
turn is bound to `it' and its index within LIST to `it-index'
before evaluating FORM.
This is the anaphoric counterpart to `-keep'."
  (declare (debug (form form)))
  (let ((r (make-symbol "result"))
        (m (make-symbol "mapped")))
    `(let (,r)
       (--each ,list (let ((,m ,form)) (when ,m (push ,m ,r))))
       (nreverse ,r))))

(defun -keep (fn list)
  "Return a new list of the non-nil results of applying FN to each item in LIST.
Like `-filter', but returns the non-nil results of FN instead of
the corresponding elements of LIST.

Its anaphoric counterpart is `--keep'."
  (--keep (funcall fn it) list))

(defun -non-nil (list)
  "Return a copy of LIST with all nil items removed."
  (declare (pure t) (side-effect-free t))
  (--filter it list))

(defmacro --map-indexed (form list)
  "Eval FORM for each item in LIST and return the list of results.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.  This is like
`--map', but additionally makes `it-index' available to FORM.

This is the anaphoric counterpart to `-map-indexed'."
  (declare (debug (form form)))
  (let ((r (make-symbol "result")))
    `(let (,r)
       (--each ,list
         (push ,form ,r))
       (nreverse ,r))))

(defun -map-indexed (fn list)
  "Apply FN to each index and item in LIST and return the list of results.
This is like `-map', but FN takes two arguments: the index of the
current element within LIST, and the element itself.

This function's anaphoric counterpart is `--map-indexed'.

For a side-effecting variant, see also `-each-indexed'."
  (--map-indexed (funcall fn it-index it) list))

(defmacro --map-when (pred rep list)
  "Anaphoric form of `-map-when'."
  (declare (debug (form form form)))
  (let ((r (make-symbol "result")))
    `(let (,r)
       (--each ,list (!cons (if ,pred ,rep it) ,r))
       (nreverse ,r))))

(defun -map-when (pred rep list)
  "Return a new list where the elements in LIST that do not match the PRED function
are unchanged, and where the elements in LIST that do match the PRED function are mapped
through the REP function.

Alias: `-replace-where'

See also: `-update-at'"
  (--map-when (funcall pred it) (funcall rep it) list))

(defalias '-replace-where '-map-when)
(defalias '--replace-where '--map-when)

(defun -map-first (pred rep list)
  "Replace first item in LIST satisfying PRED with result of REP called on this item.

See also: `-map-when', `-replace-first'"
  (let (front)
    (while (and list (not (funcall pred (car list))))
      (push (car list) front)
      (!cdr list))
    (if list
        (-concat (nreverse front) (cons (funcall rep (car list)) (cdr list)))
      (nreverse front))))

(defmacro --map-first (pred rep list)
  "Anaphoric form of `-map-first'."
  (declare (debug (def-form def-form form)))
  `(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))

(defun -map-last (pred rep list)
  "Replace last item in LIST satisfying PRED with result of REP called on this item.

See also: `-map-when', `-replace-last'"
  (nreverse (-map-first pred rep (reverse list))))

(defmacro --map-last (pred rep list)
  "Anaphoric form of `-map-last'."
  (declare (debug (def-form def-form form)))
  `(-map-last (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))

(defun -replace (old new list)
  "Replace all OLD items in LIST with NEW.

Elements are compared using `equal'.

See also: `-replace-at'"
  (declare (pure t) (side-effect-free t))
  (--map-when (equal it old) new list))

(defun -replace-first (old new list)
  "Replace the first occurrence of OLD with NEW in LIST.

Elements are compared using `equal'.

See also: `-map-first'"
  (declare (pure t) (side-effect-free t))
  (--map-first (equal old it) new list))

(defun -replace-last (old new list)
  "Replace the last occurrence of OLD with NEW in LIST.

Elements are compared using `equal'.

See also: `-map-last'"
  (declare (pure t) (side-effect-free t))
  (--map-last (equal old it) new list))

(defmacro --mapcat (form list)
  "Anaphoric form of `-mapcat'."
  (declare (debug (form form)))
  `(apply 'append (--map ,form ,list)))

(defun -mapcat (fn list)
  "Return the concatenation of the result of mapping FN over LIST.
Thus function FN should return a list."
  (--mapcat (funcall fn it) list))

(defmacro --iterate (form init n)
  "Anaphoric version of `-iterate'."
  (declare (debug (form form form)))
  (let ((res (make-symbol "result"))
        (len (make-symbol "n")))
    `(let ((,len ,n))
       (when (> ,len 0)
         (let* ((it ,init)
                (,res (list it)))
           (dotimes (_ (1- ,len))
             (push (setq it ,form) ,res))
           (nreverse ,res))))))

(defun -iterate (fun init n)
  "Return a list of iterated applications of FUN to INIT.

This means a list of the form:

  (INIT (FUN INIT) (FUN (FUN INIT)) ...)

N is the length of the returned list."
  (--iterate (funcall fun it) init n))

(defun -flatten (l)
  "Take a nested list L and return its contents as a single, flat list.

Note that because `nil' represents a list of zero elements (an
empty list), any mention of nil in L will disappear after
flattening.  If you need to preserve nils, consider `-flatten-n'
or map them to some unique symbol and then map them back.

Conses of two atoms are considered \"terminals\", that is, they
aren't flattened further.

See also: `-flatten-n'"
  (declare (pure t) (side-effect-free t))
  (if (and (listp l) (listp (cdr l)))
      (-mapcat '-flatten l)
    (list l)))

(defun -flatten-n (num list)
  "Flatten NUM levels of a nested LIST.

See also: `-flatten'"
  (declare (pure t) (side-effect-free t))
  (dotimes (_ num)
    (setq list (apply #'append (mapcar #'-list list))))
  list)

(defun -concat (&rest lists)
  "Return a new list with the concatenation of the elements in the supplied LISTS."
  (declare (pure t) (side-effect-free t))
  (apply 'append lists))

(defalias '-copy 'copy-sequence
  "Create a shallow copy of LIST.

\(fn LIST)")

(defun -splice (pred fun list)
  "Splice lists generated by FUN in place of elements matching PRED in LIST.

FUN takes the element matching PRED as input.

This function can be used as replacement for `,@' in case you
need to splice several lists at marked positions (for example
with keywords).

See also: `-splice-list', `-insert-at'"
  (let (r)
    (--each list
      (if (funcall pred it)
          (let ((new (funcall fun it)))
            (--each new (!cons it r)))
        (!cons it r)))
    (nreverse r)))

(defmacro --splice (pred form list)
  "Anaphoric form of `-splice'."
  (declare (debug (def-form def-form form)))
  `(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list))

(defun -splice-list (pred new-list list)
  "Splice NEW-LIST in place of elements matching PRED in LIST.

See also: `-splice', `-insert-at'"
  (-splice pred (lambda (_) new-list) list))

(defmacro --splice-list (pred new-list list)
  "Anaphoric form of `-splice-list'."
  (declare (debug (def-form form form)))
  `(-splice-list (lambda (it) ,pred) ,new-list ,list))

(defun -cons* (&rest args)
  "Make a new list from the elements of ARGS.
The last 2 elements of ARGS are used as the final cons of the
result, so if the final element of ARGS is not a list, the result
is a dotted list.  With no ARGS, return nil."
  (declare (pure t) (side-effect-free t))
  (let* ((len (length args))
         (tail (nthcdr (- len 2) args))
         (last (cdr tail)))
    (if (null last)
        (car args)
      (setcdr tail (car last))
      args)))

(defun -snoc (list elem &rest elements)
  "Append ELEM to the end of the list.

This is like `cons', but operates on the end of list.

If ELEMENTS is non nil, append these to the list as well."
  (-concat list (list elem) elements))

(defmacro --first (form list)
  "Return the first item in LIST for which FORM evals to non-nil.
Return nil if no such element is found.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.
This is the anaphoric counterpart to `-first'."
  (declare (debug (form form)))
  (let ((n (make-symbol "needle")))
    `(let (,n)
       (--each-while ,list (or (not ,form)
                               (ignore (setq ,n it))))
       ,n)))

(defun -first (pred list)
  "Return the first item in LIST for which PRED returns non-nil.
Return nil if no such element is found.
To get the first item in the list no questions asked, use `car'.

Alias: `-find'.

This function's anaphoric counterpart is `--first'."
  (--first (funcall pred it) list))

(defalias '-find '-first)
(defalias '--find '--first)

(defmacro --some (form list)
  "Return non-nil if FORM evals to non-nil for at least one item in LIST.
If so, return the first such result of FORM.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.
This is the anaphoric counterpart to `-some'."
  (declare (debug (form form)))
  (let ((n (make-symbol "needle")))
    `(let (,n)
       (--each-while ,list (not (setq ,n ,form)))
       ,n)))

(defun -some (pred list)
  "Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil.

Alias: `-any'.

This function's anaphoric counterpart is `--some'."
  (--some (funcall pred it) list))

(defalias '-any '-some)
(defalias '--any '--some)

(defmacro --every (form list)
  "Return non-nil if FORM evals to non-nil for all items in LIST.
If so, return the last such result of FORM.  Otherwise, once an
item is reached for which FORM yields nil, return nil without
evaluating FORM for any further LIST elements.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.

This macro is like `--every-p', but on success returns the last
non-nil result of FORM instead of just t.

This is the anaphoric counterpart to `-every'."
  (declare (debug (form form)))
  (let ((a (make-symbol "all")))
    `(let ((,a t))
       (--each-while ,list (setq ,a ,form))
       ,a)))

(defun -every (pred list)
  "Return non-nil if PRED returns non-nil for all items in LIST.
If so, return the last such result of PRED.  Otherwise, once an
item is reached for which PRED returns nil, return nil without
calling PRED on any further LIST elements.

This function is like `-every-p', but on success returns the last
non-nil result of PRED instead of just t.

This function's anaphoric counterpart is `--every'."
  (--every (funcall pred it) list))

(defmacro --last (form list)
  "Anaphoric form of `-last'."
  (declare (debug (form form)))
  (let ((n (make-symbol "needle")))
    `(let (,n)
       (--each ,list
         (when ,form (setq ,n it)))
       ,n)))

(defun -last (pred list)
  "Return the last x in LIST where (PRED x) is non-nil, else nil."
  (--last (funcall pred it) list))

(defalias '-first-item 'car
  "Return the first item of LIST, or nil on an empty list.

See also: `-second-item', `-last-item'.

\(fn LIST)")

;; Ensure that calls to `-first-item' are compiled to a single opcode,
;; just like `car'.
(put '-first-item 'byte-opcode 'byte-car)
(put '-first-item 'byte-compile 'byte-compile-one-arg)

(defalias '-second-item 'cadr
  "Return the second item of LIST, or nil if LIST is too short.

See also: `-third-item'.

\(fn LIST)")

(defalias '-third-item
  (if (fboundp 'caddr)
      #'caddr
    (lambda (list) (car (cddr list))))
  "Return the third item of LIST, or nil if LIST is too short.

See also: `-fourth-item'.

\(fn LIST)")

(defun -fourth-item (list)
  "Return the fourth item of LIST, or nil if LIST is too short.

See also: `-fifth-item'."
  (declare (pure t) (side-effect-free t))
  (car (cdr (cdr (cdr list)))))

(defun -fifth-item (list)
  "Return the fifth item of LIST, or nil if LIST is too short.

See also: `-last-item'."
  (declare (pure t) (side-effect-free t))
  (car (cdr (cdr (cdr (cdr list))))))

(defun -last-item (list)
  "Return the last item of LIST, or nil on an empty list."
  (declare (pure t) (side-effect-free t))
  (car (last list)))

;; Use `with-no-warnings' to suppress unbound `-last-item' or
;; undefined `gv--defsetter' warnings arising from both
;; `gv-define-setter' and `defsetf' in certain Emacs versions.
(with-no-warnings
  (if (fboundp 'gv-define-setter)
      (gv-define-setter -last-item (val x) `(setcar (last ,x) ,val))
    (defsetf -last-item (x) (val) `(setcar (last ,x) ,val))))

(defun -butlast (list)
  "Return a list of all items in list except for the last."
  ;; no alias as we don't want magic optional argument
  (declare (pure t) (side-effect-free t))
  (butlast list))

(defmacro --count (pred list)
  "Anaphoric form of `-count'."
  (declare (debug (form form)))
  (let ((r (make-symbol "result")))
    `(let ((,r 0))
       (--each ,list (when ,pred (setq ,r (1+ ,r))))
       ,r)))

(defun -count (pred list)
  "Counts the number of items in LIST where (PRED item) is non-nil."
  (--count (funcall pred it) list))

(defun ---truthy? (obj)
  "Return OBJ as a boolean value (t or nil)."
  (declare (pure t) (side-effect-free t))
  (and obj t))

(defmacro --any? (form list)
  "Anaphoric form of `-any?'."
  (declare (debug (form form)))
  `(and (--some ,form ,list) t))

(defun -any? (pred list)
  "Return t if (PRED x) is non-nil for any x in LIST, else nil.

Alias: `-any-p', `-some?', `-some-p'"
  (--any? (funcall pred it) list))

(defalias '-some? '-any?)
(defalias '--some? '--any?)
(defalias '-any-p '-any?)
(defalias '--any-p '--any?)
(defalias '-some-p '-any?)
(defalias '--some-p '--any?)

(defmacro --all? (form list)
  "Return t if FORM evals to non-nil for all items in LIST.
Otherwise, once an item is reached for which FORM yields nil,
return nil without evaluating FORM for any further LIST elements.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.

The similar macro `--every' is more widely useful, since it
returns the last non-nil result of FORM instead of just t on
success.

Alias: `--all-p', `--every-p', `--every?'.

This is the anaphoric counterpart to `-all?'."
  (declare (debug (form form)))
  `(and (--every ,form ,list) t))

(defun -all? (pred list)
  "Return t if (PRED X) is non-nil for all X in LIST, else nil.
In the latter case, stop after the first X for which (PRED X) is
nil, without calling PRED on any subsequent elements of LIST.

The similar function `-every' is more widely useful, since it
returns the last non-nil result of PRED instead of just t on
success.

Alias: `-all-p', `-every-p', `-every?'.

This function's anaphoric counterpart is `--all?'."
  (--all? (funcall pred it) list))

(defalias '-every? '-all?)
(defalias '--every? '--all?)
(defalias '-all-p '-all?)
(defalias '--all-p '--all?)
(defalias '-every-p '-all?)
(defalias '--every-p '--all?)

(defmacro --none? (form list)
  "Anaphoric form of `-none?'."
  (declare (debug (form form)))
  `(--all? (not ,form) ,list))

(defun -none? (pred list)
  "Return t if (PRED x) is nil for all x in LIST, else nil.

Alias: `-none-p'"
  (--none? (funcall pred it) list))

(defalias '-none-p '-none?)
(defalias '--none-p '--none?)

(defmacro --only-some? (form list)
  "Anaphoric form of `-only-some?'."
  (declare (debug (form form)))
  (let ((y (make-symbol "yes"))
        (n (make-symbol "no")))
    `(let (,y ,n)
       (--each-while ,list (not (and ,y ,n))
         (if ,form (setq ,y t) (setq ,n t)))
       (---truthy? (and ,y ,n)))))

(defun -only-some? (pred list)
  "Return `t` if at least one item of LIST matches PRED and at least one item of LIST does not match PRED.
Return `nil` both if all items match the predicate or if none of the items match the predicate.

Alias: `-only-some-p'"
  (--only-some? (funcall pred it) list))

(defalias '-only-some-p '-only-some?)
(defalias '--only-some-p '--only-some?)

(defun -slice (list from &optional to step)
  "Return copy of LIST, starting from index FROM to index TO.

FROM or TO may be negative.  These values are then interpreted
modulo the length of the list.

If STEP is a number, only each STEPth item in the resulting
section is returned.  Defaults to 1."
  (declare (pure t) (side-effect-free t))
  (let ((length (length list))
        (new-list nil))
    ;; to defaults to the end of the list
    (setq to (or to length))
    (setq step (or step 1))
    ;; handle negative indices
    (when (< from 0)
      (setq from (mod from length)))
    (when (< to 0)
      (setq to (mod to length)))

    ;; iterate through the list, keeping the elements we want
    (--each-while list (< it-index to)
      (when (and (>= it-index from)
                 (= (mod (- from it-index) step) 0))
        (push it new-list)))
    (nreverse new-list)))

(defmacro --take-while (form list)
  "Take successive items from LIST for which FORM evals to non-nil.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.  Return a new
list of the successive elements from the start of LIST for which
FORM evaluates to non-nil.
This is the anaphoric counterpart to `-take-while'."
  (declare (debug (form form)))
  (let ((r (make-symbol "result")))
    `(let (,r)
       (--each-while ,list ,form (push it ,r))
       (nreverse ,r))))

(defun -take-while (pred list)
  "Take successive items from LIST for which PRED returns non-nil.
PRED is a function of one argument.  Return a new list of the
successive elements from the start of LIST for which PRED returns
non-nil.

This function's anaphoric counterpart is `--take-while'.

For another variant, see also `-drop-while'."
  (--take-while (funcall pred it) list))

(defmacro --drop-while (form list)
  "Drop successive items from LIST for which FORM evals to non-nil.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.  Return the
tail (not a copy) of LIST starting from its first element for
which FORM evaluates to nil.
This is the anaphoric counterpart to `-drop-while'."
  (declare (debug (form form)))
  (let ((l (make-symbol "list")))
    `(let ((,l ,list))
       (--each-while ,l ,form (pop ,l))
       ,l)))

(defun -drop-while (pred list)
  "Drop successive items from LIST for which PRED returns non-nil.
PRED is a function of one argument.  Return the tail (not a copy)
of LIST starting from its first element for which PRED returns
nil.

This function's anaphoric counterpart is `--drop-while'.

For another variant, see also `-take-while'."
  (--drop-while (funcall pred it) list))

(defun -take (n list)
  "Return a copy of the first N items in LIST.
Return a copy of LIST if it contains N items or fewer.
Return nil if N is zero or less.

See also: `-take-last'."
  (declare (pure t) (side-effect-free t))
  (--take-while (< it-index n) list))

(defun -take-last (n list)
  "Return a copy of the last N items of LIST in order.
Return a copy of LIST if it contains N items or fewer.
Return nil if N is zero or less.

See also: `-take'."
  (declare (pure t) (side-effect-free t))
  (copy-sequence (last list n)))

(defalias '-drop #'nthcdr
  "Return the tail (not a copy) of LIST without the first N items.
Return nil if LIST contains N items or fewer.
Return LIST if N is zero or less.

For another variant, see also `-drop-last'.
\n(fn N LIST)")

(defun -drop-last (n list)
  "Return a copy of LIST without its last N items.
Return a copy of LIST if N is zero or less.
Return nil if LIST contains N items or fewer.

See also: `-drop'."
  (declare (pure t) (side-effect-free t))
  (nbutlast (copy-sequence list) n))

(defun -split-at (n list)
  "Split LIST into two sublists after the Nth element.
The result is a list of two elements (TAKE DROP) where TAKE is a
new list of the first N elements of LIST, and DROP is the
remaining elements of LIST (not a copy).  TAKE and DROP are like
the results of `-take' and `-drop', respectively, but the split
is done in a single list traversal."
  (declare (pure t) (side-effect-free t))
  (let (result)
    (--each-while list (< it-index n)
      (push (pop list) result))
    (list (nreverse result) list)))

(defun -rotate (n list)
  "Rotate LIST N places to the right (left if N is negative).
The time complexity is O(n)."
  (declare (pure t) (side-effect-free t))
  (cond ((null list) ())
        ((zerop n) (copy-sequence list))
        ((let* ((len (length list))
                (n-mod-len (mod n len))
                (new-tail-len (- len n-mod-len)))
           (append (nthcdr new-tail-len list) (-take new-tail-len list))))))

(defun -insert-at (n x list)
  "Return a list with X inserted into LIST at position N.

See also: `-splice', `-splice-list'"
  (declare (pure t) (side-effect-free t))
  (let ((split-list (-split-at n list)))
    (nconc (car split-list) (cons x (cadr split-list)))))

(defun -replace-at (n x list)
  "Return a list with element at Nth position in LIST replaced with X.

See also: `-replace'"
  (declare (pure t) (side-effect-free t))
  (let ((split-list (-split-at n list)))
    (nconc (car split-list) (cons x (cdr (cadr split-list))))))

(defun -update-at (n func list)
  "Return a list with element at Nth position in LIST replaced with `(func (nth n list))`.

See also: `-map-when'"
  (let ((split-list (-split-at n list)))
    (nconc (car split-list) (cons (funcall func (car (cadr split-list))) (cdr (cadr split-list))))))

(defmacro --update-at (n form list)
  "Anaphoric version of `-update-at'."
  (declare (debug (form def-form form)))
  `(-update-at ,n (lambda (it) ,form) ,list))

(defun -remove-at (n list)
  "Return a list with element at Nth position in LIST removed.

See also: `-remove-at-indices', `-remove'"
  (declare (pure t) (side-effect-free t))
  (-remove-at-indices (list n) list))

(defun -remove-at-indices (indices list)
  "Return a list whose elements are elements from LIST without
elements selected as `(nth i list)` for all i
from INDICES.

See also: `-remove-at', `-remove'"
  (declare (pure t) (side-effect-free t))
  (let* ((indices (-sort '< indices))
         (diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices))))
         r)
    (--each diffs
      (let ((split (-split-at it list)))
        (!cons (car split) r)
        (setq list (cdr (cadr split)))))
    (!cons list r)
    (apply '-concat (nreverse r))))

(defmacro --split-with (pred list)
  "Anaphoric form of `-split-with'."
  (declare (debug (form form)))
  (let ((l (make-symbol "list"))
        (r (make-symbol "result"))
        (c (make-symbol "continue")))
    `(let ((,l ,list)
           (,r nil)
           (,c t))
       (while (and ,l ,c)
         (let ((it (car ,l)))
           (if (not ,pred)
               (setq ,c nil)
             (!cons it ,r)
             (!cdr ,l))))
       (list (nreverse ,r) ,l))))

(defun -split-with (pred list)
  "Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list."
  (--split-with (funcall pred it) list))

(defmacro -split-on (item list)
  "Split the LIST each time ITEM is found.

Unlike `-partition-by', the ITEM is discarded from the results.
Empty lists are also removed from the result.

Comparison is done by `equal'.

See also `-split-when'"
  (declare (debug (def-form form)))
  `(-split-when (lambda (it) (equal it ,item)) ,list))

(defmacro --split-when (form list)
  "Anaphoric version of `-split-when'."
  (declare (debug (def-form form)))
  `(-split-when (lambda (it) ,form) ,list))

(defun -split-when (fn list)
  "Split the LIST on each element where FN returns non-nil.

Unlike `-partition-by', the \"matched\" element is discarded from
the results.  Empty lists are also removed from the result.

This function can be thought of as a generalization of
`split-string'."
  (let (r s)
    (while list
      (if (not (funcall fn (car list)))
          (push (car list) s)
        (when s (push (nreverse s) r))
        (setq s nil))
      (!cdr list))
    (when s (push (nreverse s) r))
    (nreverse r)))

(defmacro --separate (form list)
  "Anaphoric form of `-separate'."
  (declare (debug (form form)))
  (let ((y (make-symbol "yes"))
        (n (make-symbol "no")))
    `(let (,y ,n)
       (--each ,list (if ,form (!cons it ,y) (!cons it ,n)))
       (list (nreverse ,y) (nreverse ,n)))))

(defun -separate (pred list)
  "Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list."
  (--separate (funcall pred it) list))

(defun dash--partition-all-in-steps-reversed (n step list)
  "Used by `-partition-all-in-steps' and `-partition-in-steps'."
  (when (< step 1)
    (signal 'wrong-type-argument
            `("Step size < 1 results in juicy infinite loops" ,step)))
  (let (result)
    (while list
      (push (-take n list) result)
      (setq list (nthcdr step list)))
    result))

(defun -partition-all-in-steps (n step list)
  "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.
The last groups may contain less than N items."
  (declare (pure t) (side-effect-free t))
  (nreverse (dash--partition-all-in-steps-reversed n step list)))

(defun -partition-in-steps (n step list)
  "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.
If there are not enough items to make the last group N-sized,
those items are discarded."
  (declare (pure t) (side-effect-free t))
  (let ((result (dash--partition-all-in-steps-reversed n step list)))
    (while (and result (< (length (car result)) n))
      (!cdr result))
    (nreverse result)))

(defun -partition-all (n list)
  "Return a new list with the items in LIST grouped into N-sized sublists.
The last group may contain less than N items."
  (declare (pure t) (side-effect-free t))
  (-partition-all-in-steps n n list))

(defun -partition (n list)
  "Return a new list with the items in LIST grouped into N-sized sublists.
If there are not enough items to make the last group N-sized,
those items are discarded."
  (declare (pure t) (side-effect-free t))
  (-partition-in-steps n n list))

(defmacro --partition-by (form list)
  "Anaphoric form of `-partition-by'."
  (declare (debug (form form)))
  (let ((r (make-symbol "result"))
        (s (make-symbol "sublist"))
        (v (make-symbol "value"))
        (n (make-symbol "new-value"))
        (l (make-symbol "list")))
    `(let ((,l ,list))
       (when ,l
         (let* ((,r nil)
                (it (car ,l))
                (,s (list it))
                (,v ,form)
                (,l (cdr ,l)))
           (while ,l
             (let* ((it (car ,l))
                    (,n ,form))
               (unless (equal ,v ,n)
                 (!cons (nreverse ,s) ,r)
                 (setq ,s nil)
                 (setq ,v ,n))
               (!cons it ,s)
               (!cdr ,l)))
           (!cons (nreverse ,s) ,r)
           (nreverse ,r))))))

(defun -partition-by (fn list)
  "Apply FN to each item in LIST, splitting it each time FN returns a new value."
  (--partition-by (funcall fn it) list))

(defmacro --partition-by-header (form list)
  "Anaphoric form of `-partition-by-header'."
  (declare (debug (form form)))
  (let ((r (make-symbol "result"))
        (s (make-symbol "sublist"))
        (h (make-symbol "header-value"))
        (b (make-symbol "seen-body?"))
        (n (make-symbol "new-value"))
        (l (make-symbol "list")))
    `(let ((,l ,list))
       (when ,l
         (let* ((,r nil)
                (it (car ,l))
                (,s (list it))
                (,h ,form)
                (,b nil)
                (,l (cdr ,l)))
           (while ,l
             (let* ((it (car ,l))
                    (,n ,form))
               (if (equal ,h ,n)
                   (when ,b
                     (!cons (nreverse ,s) ,r)
                     (setq ,s nil)
                     (setq ,b nil))
                 (setq ,b t))
               (!cons it ,s)
               (!cdr ,l)))
           (!cons (nreverse ,s) ,r)
           (nreverse ,r))))))

(defun -partition-by-header (fn list)
  "Apply FN to the first item in LIST. That is the header
value. Apply FN to each item in LIST, splitting it each time FN
returns the header value, but only after seeing at least one
other value (the body)."
  (--partition-by-header (funcall fn it) list))

(defmacro --partition-after-pred (form list)
  "Partition LIST after each element for which FORM evaluates to non-nil.
Each element of LIST in turn is bound to `it' before evaluating
FORM.

This is the anaphoric counterpart to `-partition-after-pred'."
  (let ((l (make-symbol "list"))
        (r (make-symbol "result"))
        (s (make-symbol "sublist")))
    `(let ((,l ,list) ,r ,s)
       (when ,l
         (--each ,l
           (push it ,s)
           (when ,form
             (push (nreverse ,s) ,r)
             (setq ,s ())))
         (when ,s
           (push (nreverse ,s) ,r))
         (nreverse ,r)))))

(defun -partition-after-pred (pred list)
  "Partition LIST after each element for which PRED returns non-nil.

This function's anaphoric counterpart is `--partition-after-pred'."
  (--partition-after-pred (funcall pred it) list))

(defun -partition-before-pred (pred list)
  "Partition directly before each time PRED is true on an element of LIST."
  (nreverse (-map #'reverse
                  (-partition-after-pred pred (reverse list)))))

(defun -partition-after-item (item list)
  "Partition directly after each time ITEM appears in LIST."
  (-partition-after-pred (lambda (ele) (equal ele item))
                         list))

(defun -partition-before-item (item list)
  "Partition directly before each time ITEM appears in LIST."
  (-partition-before-pred (lambda (ele) (equal ele item))
                          list))

(defmacro --group-by (form list)
  "Anaphoric form of `-group-by'."
  (declare (debug t))
  (let ((n (make-symbol "n"))
        (k (make-symbol "k"))
        (grp (make-symbol "grp")))
    `(nreverse
      (-map
       (lambda (,n)
         (cons (car ,n)
               (nreverse (cdr ,n))))
       (--reduce-from
        (let* ((,k (,@form))
               (,grp (assoc ,k acc)))
          (if ,grp
              (setcdr ,grp (cons it (cdr ,grp)))
            (push
             (list ,k it)
             acc))
          acc)
        nil ,list)))))

(defun -group-by (fn list)
  "Separate LIST into an alist whose keys are FN applied to the
elements of LIST.  Keys are compared by `equal'."
  (--group-by (funcall fn it) list))

(defun -interpose (sep list)
  "Return a new list of all elements in LIST separated by SEP."
  (declare (pure t) (side-effect-free t))
  (let (result)
    (when list
      (!cons (car list) result)
      (!cdr list))
    (while list
      (setq result (cons (car list) (cons sep result)))
      (!cdr list))
    (nreverse result)))

(defun -interleave (&rest lists)
  "Return a new list of the first item in each list, then the second etc."
  (declare (pure t) (side-effect-free t))
  (when lists
    (let (result)
      (while (-none? 'null lists)
        (--each lists (!cons (car it) result))
        (setq lists (-map 'cdr lists)))
      (nreverse result))))

(defmacro --zip-with (form list1 list2)
  "Anaphoric form of `-zip-with'.

The elements in list1 are bound as symbol `it', the elements in list2 as symbol `other'."
  (declare (debug (form form form)))
  (let ((r (make-symbol "result"))
        (l1 (make-symbol "list1"))
        (l2 (make-symbol "list2")))
    `(let ((,r nil)
           (,l1 ,list1)
           (,l2 ,list2))
       (while (and ,l1 ,l2)
         (let ((it (car ,l1))
               (other (car ,l2)))
           (!cons ,form ,r)
           (!cdr ,l1)
           (!cdr ,l2)))
       (nreverse ,r))))

(defun -zip-with (fn list1 list2)
  "Zip the two lists LIST1 and LIST2 using a function FN.  This
function is applied pairwise taking as first argument element of
LIST1 and as second argument element of LIST2 at corresponding
position.

The anaphoric form `--zip-with' binds the elements from LIST1 as symbol `it',
and the elements from LIST2 as symbol `other'."
  (--zip-with (funcall fn it other) list1 list2))

(defun -zip-lists (&rest lists)
  "Zip LISTS together.  Group the head of each list, followed by the
second elements of each list, and so on. The lengths of the returned
groupings are equal to the length of the shortest input list.

The return value is always list of lists, which is a difference
from `-zip-pair' which returns a cons-cell in case two input
lists are provided.

See also: `-zip'"
  (declare (pure t) (side-effect-free t))
  (when lists
    (let (results)
      (while (-none? 'null lists)
        (setq results (cons (mapcar 'car lists) results))
        (setq lists (mapcar 'cdr lists)))
      (nreverse results))))

(defun -zip (&rest lists)
  "Zip LISTS together.  Group the head of each list, followed by the
second elements of each list, and so on. The lengths of the returned
groupings are equal to the length of the shortest input list.

If two lists are provided as arguments, return the groupings as a list
of cons cells. Otherwise, return the groupings as a list of lists.

Use `-zip-lists' if you need the return value to always be a list
of lists.

Alias: `-zip-pair'

See also: `-zip-lists'"
  (declare (pure t) (side-effect-free t))
  (when lists
    (let (results)
      (while (-none? 'null lists)
        (setq results (cons (mapcar 'car lists) results))
        (setq lists (mapcar 'cdr lists)))
      (setq results (nreverse results))
      (if (= (length lists) 2)
          ;; to support backward compatibility, return
          ;; a cons cell if two lists were provided
          (--map (cons (car it) (cadr it)) results)
        results))))

(defalias '-zip-pair '-zip)

(defun -zip-fill (fill-value &rest lists)
  "Zip LISTS, with FILL-VALUE padded onto the shorter lists. The
lengths of the returned groupings are equal to the length of the
longest input list."
  (declare (pure t) (side-effect-free t))
  (apply '-zip (apply '-pad (cons fill-value lists))))

(defun -unzip (lists)
  "Unzip LISTS.

This works just like `-zip' but takes a list of lists instead of
a variable number of arguments, such that

  (-unzip (-zip L1 L2 L3 ...))

is identity (given that the lists are the same length).

Note in particular that calling this on a list of two lists will
return a list of cons-cells such that the above identity works.

See also: `-zip'"
  (apply '-zip lists))

(defun -cycle (list)
  "Return an infinite circular copy of LIST.
The returned list cycles through the elements of LIST and repeats
from the beginning."
  (declare (pure t) (side-effect-free t))
  ;; Also works with sequences that aren't lists.
  (let ((newlist (append list ())))
    (nconc newlist newlist)))

(defun -pad (fill-value &rest lists)
  "Appends FILL-VALUE to the end of each list in LISTS such that they
will all have the same length."
  (let* ((annotations (-annotate 'length lists))
         (n (-max (-map 'car annotations))))
    (--map (append (cdr it) (-repeat (- n (car it)) fill-value)) annotations)))

(defun -annotate (fn list)
  "Return a list of cons cells where each cell is FN applied to each
element of LIST paired with the unmodified element of LIST."
  (-zip (-map fn list) list))

(defmacro --annotate (form list)
  "Anaphoric version of `-annotate'."
  (declare (debug (def-form form)))
  `(-annotate (lambda (it) ,form) ,list))

(defun dash--table-carry (lists restore-lists &optional re)
  "Helper for `-table' and `-table-flat'.

If a list overflows, carry to the right and reset the list."
  (while (not (or (car lists)
                  (equal lists '(nil))))
    (setcar lists (car restore-lists))
    (pop (cadr lists))
    (!cdr lists)
    (!cdr restore-lists)
    (when re
      (push (nreverse (car re)) (cadr re))
      (setcar re nil)
      (!cdr re))))

(defun -table (fn &rest lists)
  "Compute outer product of LISTS using function FN.

The function FN should have the same arity as the number of
supplied lists.

The outer product is computed by applying fn to all possible
combinations created by taking one element from each list in
order.  The dimension of the result is (length lists).

See also: `-table-flat'"
  (let ((restore-lists (copy-sequence lists))
        (last-list (last lists))
        (re (make-list (length lists) nil)))
    (while (car last-list)
      (let ((item (apply fn (-map 'car lists))))
        (push item (car re))
        (setcar lists (cdar lists)) ;; silence byte compiler
        (dash--table-carry lists restore-lists re)))
    (nreverse (car (last re)))))

(defun -table-flat (fn &rest lists)
  "Compute flat outer product of LISTS using function FN.

The function FN should have the same arity as the number of
supplied lists.

The outer product is computed by applying fn to all possible
combinations created by taking one element from each list in
order.  The results are flattened, ignoring the tensor structure
of the result.  This is equivalent to calling:

  (-flatten-n (1- (length lists)) (apply \\='-table fn lists))

but the implementation here is much more efficient.

See also: `-flatten-n', `-table'"
  (let ((restore-lists (copy-sequence lists))
        (last-list (last lists))
        re)
    (while (car last-list)
      (let ((item (apply fn (-map 'car lists))))
        (push item re)
        (setcar lists (cdar lists)) ;; silence byte compiler
        (dash--table-carry lists restore-lists)))
    (nreverse re)))

(defun -elem-index (elem list)
  "Return the index of the first element in the given LIST which
is equal to the query element ELEM, or nil if there is no
such element."
  (declare (pure t) (side-effect-free t))
  (car (-elem-indices elem list)))

(defun -elem-indices (elem list)
  "Return the indices of all elements in LIST equal to the query
element ELEM, in ascending order."
  (declare (pure t) (side-effect-free t))
  (-find-indices (-partial 'equal elem) list))

(defun -find-indices (pred list)
  "Return the indices of all elements in LIST satisfying the
predicate PRED, in ascending order."
  (apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list)))

(defmacro --find-indices (form list)
  "Anaphoric version of `-find-indices'."
  (declare (debug (def-form form)))
  `(-find-indices (lambda (it) ,form) ,list))

(defun -find-index (pred list)
  "Take a predicate PRED and a LIST and return the index of the
first element in the list satisfying the predicate, or nil if
there is no such element.

See also `-first'."
  (car (-find-indices pred list)))

(defmacro --find-index (form list)
  "Anaphoric version of `-find-index'."
  (declare (debug (def-form form)))
  `(-find-index (lambda (it) ,form) ,list))

(defun -find-last-index (pred list)
  "Take a predicate PRED and a LIST and return the index of the
last element in the list satisfying the predicate, or nil if
there is no such element.

See also `-last'."
  (-last-item (-find-indices pred list)))

(defmacro --find-last-index (form list)
  "Anaphoric version of `-find-last-index'."
  (declare (debug (def-form form)))
  `(-find-last-index (lambda (it) ,form) ,list))

(defun -select-by-indices (indices list)
  "Return a list whose elements are elements from LIST selected
as `(nth i list)` for all i from INDICES."
  (declare (pure t) (side-effect-free t))
  (let (r)
    (--each indices
      (!cons (nth it list) r))
    (nreverse r)))

(defun -select-columns (columns table)
  "Select COLUMNS from TABLE.

TABLE is a list of lists where each element represents one row.
It is assumed each row has the same length.

Each row is transformed such that only the specified COLUMNS are
selected.

See also: `-select-column', `-select-by-indices'"
  (declare (pure t) (side-effect-free t))
  (--map (-select-by-indices columns it) table))

(defun -select-column (column table)
  "Select COLUMN from TABLE.

TABLE is a list of lists where each element represents one row.
It is assumed each row has the same length.

The single selected column is returned as a list.

See also: `-select-columns', `-select-by-indices'"
  (declare (pure t) (side-effect-free t))
  (--mapcat (-select-by-indices (list column) it) table))

(defmacro -> (x &optional form &rest more)
  "Thread the expr through the forms. Insert X as the second item
in the first form, making a list of it if it is not a list
already. If there are more forms, insert the first form as the
second item in second form, etc."
  (declare (debug (form &rest [&or symbolp (sexp &rest form)])))
  (cond
   ((null form) x)
   ((null more) (if (listp form)
                    `(,(car form) ,x ,@(cdr form))
                  (list form x)))
   (:else `(-> (-> ,x ,form) ,@more))))

(defmacro ->> (x &optional form &rest more)
  "Thread the expr through the forms. Insert X as the last item
in the first form, making a list of it if it is not a list
already. If there are more forms, insert the first form as the
last item in second form, etc."
  (declare (debug ->))
  (cond
   ((null form) x)
   ((null more) (if (listp form)
                    `(,@form ,x)
                  (list form x)))
   (:else `(->> (->> ,x ,form) ,@more))))

(defmacro --> (x &rest forms)
  "Starting with the value of X, thread each expression through FORMS.

Insert X at the position signified by the symbol `it' in the first
form.  If there are more forms, insert the first form at the position
signified by `it' in in second form, etc."
  (declare (debug (form body)))
  `(-as-> ,x it ,@forms))

(defmacro -as-> (value variable &rest forms)
  "Starting with VALUE, thread VARIABLE through FORMS.

In the first form, bind VARIABLE to VALUE.  In the second form, bind
VARIABLE to the result of the first form, and so forth."
  (declare (debug (form symbolp body)))
  (if (null forms)
      `,value
    `(let ((,variable ,value))
       (-as-> ,(if (symbolp (car forms))
                   (list (car forms) variable)
                 (car forms))
              ,variable
              ,@(cdr forms)))))

(defmacro -some-> (x &optional form &rest more)
  "When expr is non-nil, thread it through the first form (via `->'),
and when that result is non-nil, through the next form, etc."
  (declare (debug ->)
           (indent 1))
  (if (null form) x
    (let ((result (make-symbol "result")))
      `(-some-> (-when-let (,result ,x)
                  (-> ,result ,form))
         ,@more))))

(defmacro -some->> (x &optional form &rest more)
  "When expr is non-nil, thread it through the first form (via `->>'),
and when that result is non-nil, through the next form, etc."
  (declare (debug ->)
           (indent 1))
  (if (null form) x
    (let ((result (make-symbol "result")))
      `(-some->> (-when-let (,result ,x)
                   (->> ,result ,form))
         ,@more))))

(defmacro -some--> (expr &rest forms)
  "Thread EXPR through FORMS via `-->', while the result is non-nil.
When EXPR evaluates to non-nil, thread the result through the
first of FORMS, and when that result is non-nil, thread it
through the next form, etc."
  (declare (debug (form &rest &or symbolp consp)) (indent 1))
  (if (null forms) expr
    (let ((result (make-symbol "result")))
      `(-some--> (-when-let (,result ,expr)
                   (--> ,result ,(car forms)))
         ,@(cdr forms)))))

(defmacro -doto (init &rest forms)
  "Evaluate INIT and pass it as argument to FORMS with `->'.
The RESULT of evaluating INIT is threaded through each of FORMS
individually using `->', which see.  The return value is RESULT,
which FORMS may have modified by side effect."
  (declare (debug (form &rest &or symbolp consp)) (indent 1))
  (let ((retval (make-symbol "result")))
    `(let ((,retval ,init))
       ,@(mapcar (lambda (form) `(-> ,retval ,form)) forms)
       ,retval)))

(defmacro --doto (init &rest forms)
  "Anaphoric form of `-doto'.
This just evaluates INIT, binds the result to `it', evaluates
FORMS, and returns the final value of `it'.
Note: `it' need not be used in each form."
  (declare (debug (form body)) (indent 1))
  `(let ((it ,init))
     ,@forms
     it))

(defun -grade-up (comparator list)
  "Grade elements of LIST using COMPARATOR relation.
This yields a permutation vector such that applying this
permutation to LIST sorts it in ascending order."
  (->> (--map-indexed (cons it it-index) list)
       (-sort (lambda (it other) (funcall comparator (car it) (car other))))
       (mapcar #'cdr)))

(defun -grade-down (comparator list)
  "Grade elements of LIST using COMPARATOR relation.
This yields a permutation vector such that applying this
permutation to LIST sorts it in descending order."
  (->> (--map-indexed (cons it it-index) list)
       (-sort (lambda (it other) (funcall comparator (car other) (car it))))
       (mapcar #'cdr)))

(defvar dash--source-counter 0
  "Monotonic counter for generated symbols.")

(defun dash--match-make-source-symbol ()
  "Generate a new dash-source symbol.

All returned symbols are guaranteed to be unique."
  (prog1 (make-symbol (format "--dash-source-%d--" dash--source-counter))
    (setq dash--source-counter (1+ dash--source-counter))))

(defun dash--match-ignore-place-p (symbol)
  "Return non-nil if SYMBOL is a symbol and starts with _."
  (and (symbolp symbol)
       (eq (aref (symbol-name symbol) 0) ?_)))

(defun dash--match-cons-skip-cdr (skip-cdr source)
  "Helper function generating idiomatic shifting code."
  (cond
   ((= skip-cdr 0)
    `(pop ,source))
   (t
    `(prog1 ,(dash--match-cons-get-car skip-cdr source)
       (setq ,source ,(dash--match-cons-get-cdr (1+ skip-cdr) source))))))

(defun dash--match-cons-get-car (skip-cdr source)
  "Helper function generating idiomatic code to get nth car."
  (cond
   ((= skip-cdr 0)
    `(car ,source))
   ((= skip-cdr 1)
    `(cadr ,source))
   (t
    `(nth ,skip-cdr ,source))))

(defun dash--match-cons-get-cdr (skip-cdr source)
  "Helper function generating idiomatic code to get nth cdr."
  (cond
   ((= skip-cdr 0)
    source)
   ((= skip-cdr 1)
    `(cdr ,source))
   (t
    `(nthcdr ,skip-cdr ,source))))

(defun dash--match-cons (match-form source)
  "Setup a cons matching environment and call the real matcher."
  (let ((s (dash--match-make-source-symbol))
        (n 0)
        (m match-form))
    (while (and (consp m)
                (dash--match-ignore-place-p (car m)))
      (setq n (1+ n)) (!cdr m))
    (cond
     ;; when we only have one pattern in the list, we don't have to
     ;; create a temporary binding (--dash-source--) for the source
     ;; and just use the input directly
     ((and (consp m)
           (not (cdr m)))
      (dash--match (car m) (dash--match-cons-get-car n source)))
     ;; handle other special types
     ((> n 0)
      (dash--match m (dash--match-cons-get-cdr n source)))
     ;; this is the only entry-point for dash--match-cons-1, that's
     ;; why we can't simply use the above branch, it would produce
     ;; infinite recursion
     (t
      (cons (list s source) (dash--match-cons-1 match-form s))))))

(defun dash--get-expand-function (type)
  "Get expand function name for TYPE."
  (intern-soft (format "dash-expand:%s" type)))

(defun dash--match-cons-1 (match-form source &optional props)
  "Match MATCH-FORM against SOURCE.

MATCH-FORM is a proper or improper list.  Each element of
MATCH-FORM is either a symbol, which gets bound to the respective
value in source or another match form which gets destructured
recursively.

If the cdr of last cons cell in the list is `nil', matching stops
there.

SOURCE is a proper or improper list."
  (let ((skip-cdr (or (plist-get props :skip-cdr) 0)))
    (cond
     ((consp match-form)
      (cond
       ((cdr match-form)
        (cond
         ((and (symbolp (car match-form))
               (functionp (dash--get-expand-function (car match-form))))
          (dash--match-kv (dash--match-kv-normalize-match-form match-form) (dash--match-cons-get-cdr skip-cdr source)))
         ((dash--match-ignore-place-p (car match-form))
          (dash--match-cons-1 (cdr match-form) source
                              (plist-put props :skip-cdr (1+ skip-cdr))))
         (t
          (-concat (dash--match (car match-form) (dash--match-cons-skip-cdr skip-cdr source))
                   (dash--match-cons-1 (cdr match-form) source)))))
       (t ;; Last matching place, no need for shift
        (dash--match (car match-form) (dash--match-cons-get-car skip-cdr source)))))
     ((eq match-form nil)
      nil)
     (t ;; Handle improper lists.  Last matching place, no need for shift
      (dash--match match-form (dash--match-cons-get-cdr skip-cdr source))))))

(defun dash--match-vector (match-form source)
  "Setup a vector matching environment and call the real matcher."
  (let ((s (dash--match-make-source-symbol)))
    (cond
     ;; don't bind `s' if we only have one sub-pattern
     ((= (length match-form) 1)
      (dash--match (aref match-form 0) `(aref ,source 0)))
     ;; if the source is a symbol, we don't need to re-bind it
     ((symbolp source)
      (dash--match-vector-1 match-form source))
     ;; don't bind `s' if we only have one sub-pattern which is not ignored
     ((let* ((ignored-places (mapcar 'dash--match-ignore-place-p match-form))
             (ignored-places-n (length (-remove 'null ignored-places))))
        (when (= ignored-places-n (1- (length match-form)))
          (let ((n (-find-index 'null ignored-places)))
            (dash--match (aref match-form n) `(aref ,source ,n))))))
     (t
      (cons (list s source) (dash--match-vector-1 match-form s))))))

(defun dash--match-vector-1 (match-form source)
  "Match MATCH-FORM against SOURCE.

MATCH-FORM is a vector.  Each element of MATCH-FORM is either a
symbol, which gets bound to the respective value in source or
another match form which gets destructured recursively.

If second-from-last place in MATCH-FORM is the symbol &rest, the
next element of the MATCH-FORM is matched against the tail of
SOURCE, starting at index of the &rest symbol.  This is
conceptually the same as the (head . tail) match for improper
lists, where dot plays the role of &rest.

SOURCE is a vector.

If the MATCH-FORM vector is shorter than SOURCE vector, only
the (length MATCH-FORM) places are bound, the rest of the SOURCE
is discarded."
  (let ((i 0)
        (l (length match-form))
        (re))
    (while (< i l)
      (let ((m (aref match-form i)))
        (push (cond
               ((and (symbolp m)
                     (eq m '&rest))
                (prog1 (dash--match
                        (aref match-form (1+ i))
                        `(substring ,source ,i))
                  (setq i l)))
               ((and (symbolp m)
                     ;; do not match symbols starting with _
                     (not (eq (aref (symbol-name m) 0) ?_)))
                (list (list m `(aref ,source ,i))))
               ((not (symbolp m))
                (dash--match m `(aref ,source ,i))))
              re)
        (setq i (1+ i))))
    (-flatten-n 1 (nreverse re))))

(defun dash--match-kv-normalize-match-form (pattern)
  "Normalize kv PATTERN.

This method normalizes PATTERN to the format expected by
`dash--match-kv'.  See `-let' for the specification."
  (let ((normalized (list (car pattern)))
        (skip nil)
        (fill-placeholder (make-symbol "--dash-fill-placeholder--")))
    (-each (apply '-zip (-pad fill-placeholder (cdr pattern) (cddr pattern)))
      (lambda (pair)
        (let ((current (car pair))
              (next (cdr pair)))
          (if skip
              (setq skip nil)
            (if (or (eq fill-placeholder next)
                    (not (or (and (symbolp next)
                                  (not (keywordp next))
                                  (not (eq next t))
                                  (not (eq next nil)))
                             (and (consp next)
                                  (not (eq (car next) 'quote)))
                             (vectorp next))))
                (progn
                  (cond
                   ((keywordp current)
                    (push current normalized)
                    (push (intern (substring (symbol-name current) 1)) normalized))
                   ((stringp current)
                    (push current normalized)
                    (push (intern current) normalized))
                   ((and (consp current)
                         (eq (car current) 'quote))
                    (push current normalized)
                    (push (cadr current) normalized))
                   (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)))
                  (setq skip nil))
              (push current normalized)
              (push next normalized)
              (setq skip t))))))
    (nreverse normalized)))

(defun dash--match-kv (match-form source)
  "Setup a kv matching environment and call the real matcher.

kv can be any key-value store, such as plist, alist or hash-table."
  (let ((s (dash--match-make-source-symbol)))
    (cond
     ;; don't bind `s' if we only have one sub-pattern (&type key val)
     ((= (length match-form) 3)
      (dash--match-kv-1 (cdr match-form) source (car match-form)))
     ;; if the source is a symbol, we don't need to re-bind it
     ((symbolp source)
      (dash--match-kv-1 (cdr match-form) source (car match-form)))
     (t
      (cons (list s source) (dash--match-kv-1 (cdr match-form) s (car match-form)))))))

(defun dash-expand:&hash (key source)
  "Generate extracting KEY from SOURCE for &hash destructuring."
  `(gethash ,key ,source))

(defun dash-expand:&plist (key source)
  "Generate extracting KEY from SOURCE for &plist destructuring."
  `(plist-get ,source ,key))

(defun dash-expand:&alist (key source)
  "Generate extracting KEY from SOURCE for &alist destructuring."
  `(cdr (assoc ,key ,source)))

(defun dash-expand:&hash? (key source)
  "Generate extracting KEY from SOURCE for &hash? destructuring.
Similar to &hash but check whether the map is not nil."
  (let ((src (make-symbol "src")))
    `(let ((,src ,source))
       (when ,src (gethash ,key ,src)))))

(defalias 'dash-expand:&keys 'dash-expand:&plist)

(defun dash--match-kv-1 (match-form source type)
  "Match MATCH-FORM against SOURCE of type TYPE.

MATCH-FORM is a proper list of the form (key1 place1 ... keyN
placeN).  Each placeK is either a symbol, which gets bound to the
value of keyK retrieved from the key-value store, or another
match form which gets destructured recursively.

SOURCE is a key-value store of type TYPE, which can be a plist,
an alist or a hash table.

TYPE is a token specifying the type of the key-value store.
Valid values are &plist, &alist and &hash."
  (-flatten-n 1 (-map
                 (lambda (kv)
                   (let* ((k (car kv))
                          (v (cadr kv))
                          (getter
                           (funcall (dash--get-expand-function type) k source)))
                     (cond
                      ((symbolp v)
                       (list (list v getter)))
                      (t (dash--match v getter)))))
                 (-partition 2 match-form))))

(defun dash--match-symbol (match-form source)
  "Bind a symbol.

This works just like `let', there is no destructuring."
  (list (list match-form source)))

(defun dash--match (match-form source)
  "Match MATCH-FORM against SOURCE.

This function tests the MATCH-FORM and dispatches to specific
matchers based on the type of the expression.

Key-value stores are disambiguated by placing a token &plist,
&alist or &hash as a first item in the MATCH-FORM."
  (cond
   ((symbolp match-form)
    (dash--match-symbol match-form source))
   ((consp match-form)
    (cond
     ;; Handle the "x &as" bindings first.
     ((and (consp (cdr match-form))
           (symbolp (car match-form))
           (eq '&as (cadr match-form)))
      (let ((s (car match-form)))
        (cons (list s source)
              (dash--match (cddr match-form) s))))
     ((functionp (dash--get-expand-function (car match-form)))
      (dash--match-kv (dash--match-kv-normalize-match-form match-form) source))
     (t (dash--match-cons match-form source))))
   ((vectorp match-form)
    ;; We support the &as binding in vectors too
    (cond
     ((and (> (length match-form) 2)
           (symbolp (aref match-form 0))
           (eq '&as (aref match-form 1)))
      (let ((s (aref match-form 0)))
        (cons (list s source)
              (dash--match (substring match-form 2) s))))
     (t (dash--match-vector match-form source))))))

(defun dash--normalize-let-varlist (varlist)
  "Normalize VARLIST so that every binding is a list.

`let' allows specifying a binding which is not a list but simply
the place which is then automatically bound to nil, such that all
three of the following are identical and evaluate to nil.

  (let (a) a)
  (let ((a)) a)
  (let ((a nil)) a)

This function normalizes all of these to the last form."
  (--map (if (consp it) it (list it nil)) varlist))

(defmacro -let* (varlist &rest body)
  "Bind variables according to VARLIST then eval BODY.

VARLIST is a list of lists of the form (PATTERN SOURCE).  Each
PATTERN is matched against the SOURCE structurally.  SOURCE is
only evaluated once for each PATTERN.

Each SOURCE can refer to the symbols already bound by this
VARLIST.  This is useful if you want to destructure SOURCE
recursively but also want to name the intermediate structures.

See `-let' for the list of all possible patterns."
  (declare (debug ((&rest [&or (sexp form) sexp]) body))
           (indent 1))
  (let* ((varlist (dash--normalize-let-varlist varlist))
         (bindings (--mapcat (dash--match (car it) (cadr it)) varlist)))
    `(let* ,bindings
       ,@body)))

(defmacro -let (varlist &rest body)
  "Bind variables according to VARLIST then eval BODY.

VARLIST is a list of lists of the form (PATTERN SOURCE).  Each
PATTERN is matched against the SOURCE \"structurally\".  SOURCE
is only evaluated once for each PATTERN.  Each PATTERN is matched
recursively, and can therefore contain sub-patterns which are
matched against corresponding sub-expressions of SOURCE.

All the SOURCEs are evalled before any symbols are
bound (i.e. \"in parallel\").

If VARLIST only contains one (PATTERN SOURCE) element, you can
optionally specify it using a vector and discarding the
outer-most parens.  Thus

  (-let ((PATTERN SOURCE)) ...)

becomes

  (-let [PATTERN SOURCE] ...).

`-let' uses a convention of not binding places (symbols) starting
with _ whenever it's possible.  You can use this to skip over
entries you don't care about.  However, this is not *always*
possible (as a result of implementation) and these symbols might
get bound to undefined values.

Following is the overview of supported patterns.  Remember that
patterns can be matched recursively, so every a, b, aK in the
following can be a matching construct and not necessarily a
symbol/variable.

Symbol:

  a - bind the SOURCE to A.  This is just like regular `let'.

Conses and lists:

  (a) - bind `car' of cons/list to A

  (a . b) - bind car of cons to A and `cdr' to B

  (a b) - bind car of list to A and `cadr' to B

  (a1 a2 a3 ...) - bind 0th car of list to A1, 1st to A2, 2nd to A3...

  (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST.

Vectors:

  [a] - bind 0th element of a non-list sequence to A (works with
        vectors, strings, bit arrays...)

  [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st to
                   A1, 2nd to A2, ...
                   If the PATTERN is shorter than SOURCE, the values at
                   places not in PATTERN are ignored.
                   If the PATTERN is longer than SOURCE, an `error' is
                   thrown.

  [a1 a2 a3 ... &rest rest] - as above, but bind the rest of
                              the sequence to REST.  This is
                              conceptually the same as improper list
                              matching (a1 a2 ... aN . rest)

Key/value stores:

  (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                 SOURCE plist to aK.  If the
                                 value is not found, aK is nil.
                                 Uses `plist-get' to fetch values.

  (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                 SOURCE alist to aK.  If the
                                 value is not found, aK is nil.
                                 Uses `assoc' to fetch values.

  (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the
                                SOURCE hash table to aK.  If the
                                value is not found, aK is nil.
                                Uses `gethash' to fetch values.

Further, special keyword &keys supports \"inline\" matching of
plist-like key-value pairs, similarly to &keys keyword of
`cl-defun'.

  (a1 a2 ... aN &keys key1 b1 ... keyN bK)

This binds N values from the list to a1 ... aN, then interprets
the cdr as a plist (see key/value matching above).

A shorthand notation for kv-destructuring exists which allows the
patterns be optionally left out and derived from the key name in
the following fashion:

- a key :foo is converted into `foo' pattern,
- a key 'bar is converted into `bar' pattern,
- a key \"baz\" is converted into `baz' pattern.

That is, the entire value under the key is bound to the derived
variable without any further destructuring.

This is possible only when the form following the key is not a
valid pattern (i.e. not a symbol, a cons cell or a vector).
Otherwise the matching proceeds as usual and in case of an
invalid spec fails with an error.

Thus the patterns are normalized as follows:

   ;; derive all the missing patterns
   (&plist :foo 'bar \"baz\") => (&plist :foo foo 'bar bar \"baz\" baz)

   ;; we can specify some but not others
   (&plist :foo 'bar explicit-bar) => (&plist :foo foo 'bar explicit-bar)

   ;; nothing happens, we store :foo in x
   (&plist :foo x) => (&plist :foo x)

   ;; nothing happens, we match recursively
   (&plist :foo (a b c)) => (&plist :foo (a b c))

You can name the source using the syntax SYMBOL &as PATTERN.
This syntax works with lists (proper or improper), vectors and
all types of maps.

  (list &as a b c) (list 1 2 3)

binds A to 1, B to 2, C to 3 and LIST to (1 2 3).

Similarly:

  (bounds &as beg . end) (cons 1 2)

binds BEG to 1, END to 2 and BOUNDS to (1 . 2).

  (items &as first . rest) (list 1 2 3)

binds FIRST to 1, REST to (2 3) and ITEMS to (1 2 3)

  [vect &as _ b c] [1 2 3]

binds B to 2, C to 3 and VECT to [1 2 3] (_ avoids binding as usual).

  (plist &as &plist :b b) (list :a 1 :b 2 :c 3)

binds B to 2 and PLIST to (:a 1 :b 2 :c 3).  Same for &alist and &hash.

This is especially useful when we want to capture the result of a
computation and destructure at the same time.  Consider the
form (function-returning-complex-structure) returning a list of
two vectors with two items each.  We want to capture this entire
result and pass it to another computation, but at the same time
we want to get the second item from each vector.  We can achieve
it with pattern

  (result &as [_ a] [_ b]) (function-returning-complex-structure)

Note: Clojure programmers may know this feature as the \":as
binding\".  The difference is that we put the &as at the front
because we need to support improper list binding."
  (declare (debug ([&or (&rest [&or (sexp form) sexp])
                        (vector [&rest [sexp form]])]
                   body))
           (indent 1))
  (if (vectorp varlist)
      `(let* ,(dash--match (aref varlist 0) (aref varlist 1))
         ,@body)
    (let* ((varlist (dash--normalize-let-varlist varlist))
           (inputs (--map-indexed (list (make-symbol (format "input%d" it-index)) (cadr it)) varlist))
           (new-varlist (--map (list (caar it) (cadr it)) (-zip varlist inputs))))
      `(let ,inputs
         (-let* ,new-varlist ,@body)))))

(defmacro -lambda (match-form &rest body)
  "Return a lambda which destructures its input as MATCH-FORM and executes BODY.

Note that you have to enclose the MATCH-FORM in a pair of parens,
such that:

  (-lambda (x) body)
  (-lambda (x y ...) body)

has the usual semantics of `lambda'.  Furthermore, these get
translated into normal `lambda', so there is no performance
penalty.

See `-let' for a description of the destructuring mechanism."
  (declare (doc-string 2) (indent defun)
           (debug (&define sexp
                           [&optional stringp]
                           [&optional ("interactive" interactive)]
                           def-body)))
  (cond
   ((nlistp match-form)
    (signal 'wrong-type-argument (list #'listp match-form)))
   ;; No destructuring, so just return regular `lambda' for speed.
   ((-all? #'symbolp match-form)
    `(lambda ,match-form ,@body))
   ((let ((inputs (--map-indexed
                   (list it (make-symbol (format "input%d" it-index)))
                   match-form)))
      ;; TODO: because inputs to the `lambda' are evaluated only once,
      ;; `-let*' need not create the extra bindings to ensure that.
      ;; We should find a way to optimize that.  Not critical however.
      `(lambda ,(mapcar #'cadr inputs)
         (-let* ,inputs ,@body))))))

(defmacro -setq (&rest forms)
  "Bind each MATCH-FORM to the value of its VAL.

MATCH-FORM destructuring is done according to the rules of `-let'.

This macro allows you to bind multiple variables by destructuring
the value, so for example:

  (-setq (a b) x
         (&plist :c c) plist)

expands roughly speaking to the following code

  (setq a (car x)
        b (cadr x)
        c (plist-get plist :c))

Care is taken to only evaluate each VAL once so that in case of
multiple assignments it does not cause unexpected side effects.

\(fn [MATCH-FORM VAL]...)"
  (declare (debug (&rest sexp form))
           (indent 1))
  (when (= (mod (length forms) 2) 1)
    (signal 'wrong-number-of-arguments (list '-setq (1+ (length forms)))))
  (let* ((forms-and-sources
          ;; First get all the necessary mappings with all the
          ;; intermediate bindings.
          (-map (lambda (x) (dash--match (car x) (cadr x)))
                (-partition 2 forms)))
         ;; To preserve the logic of dynamic scoping we must ensure
         ;; that we `setq' the variables outside of the `let*' form
         ;; which holds the destructured intermediate values.  For
         ;; this we generate for each variable a placeholder which is
         ;; bound to (lexically) the result of the destructuring.
         ;; Then outside of the helper `let*' form we bind all the
         ;; original variables to their respective placeholders.
         ;; TODO: There is a lot of room for possible optimization,
         ;; for start playing with `special-variable-p' to eliminate
         ;; unnecessary re-binding.
         (variables-to-placeholders
          (-mapcat
           (lambda (bindings)
             (-map
              (lambda (binding)
                (let ((var (car binding)))
                  (list var (make-symbol (concat "--dash-binding-" (symbol-name var) "--")))))
              (--filter (not (string-prefix-p "--" (symbol-name (car it)))) bindings)))
           forms-and-sources)))
    `(let ,(-map 'cadr variables-to-placeholders)
       (let* ,(-flatten-n 1 forms-and-sources)
         (setq ,@(-flatten (-map 'reverse variables-to-placeholders))))
       (setq ,@(-flatten variables-to-placeholders)))))

(defmacro -if-let* (vars-vals then &rest else)
  "If all VALS evaluate to true, bind them to their corresponding
VARS and do THEN, otherwise do ELSE. VARS-VALS should be a list
of (VAR VAL) pairs.

Note: binding is done according to `-let*'.  VALS are evaluated
sequentially, and evaluation stops after the first nil VAL is
encountered."
  (declare (debug ((&rest (sexp form)) form body))
           (indent 2))
  (->> vars-vals
       (--mapcat (dash--match (car it) (cadr it)))
       (--reduce-r-from
        (let ((var (car it))
              (val (cadr it)))
          `(let ((,var ,val))
             (if ,var ,acc ,@else)))
        then)))

(defmacro -if-let (var-val then &rest else)
  "If VAL evaluates to non-nil, bind it to VAR and do THEN,
otherwise do ELSE.

Note: binding is done according to `-let'.

\(fn (VAR VAL) THEN &rest ELSE)"
  (declare (debug ((sexp form) form body))
           (indent 2))
  `(-if-let* (,var-val) ,then ,@else))

(defmacro --if-let (val then &rest else)
  "If VAL evaluates to non-nil, bind it to symbol `it' and do THEN,
otherwise do ELSE."
  (declare (debug (form form body))
           (indent 2))
  `(-if-let (it ,val) ,then ,@else))

(defmacro -when-let* (vars-vals &rest body)
  "If all VALS evaluate to true, bind them to their corresponding
VARS and execute body. VARS-VALS should be a list of (VAR VAL)
pairs.

Note: binding is done according to `-let*'.  VALS are evaluated
sequentially, and evaluation stops after the first nil VAL is
encountered."
  (declare (debug ((&rest (sexp form)) body))
           (indent 1))
  `(-if-let* ,vars-vals (progn ,@body)))

(defmacro -when-let (var-val &rest body)
  "If VAL evaluates to non-nil, bind it to VAR and execute body.

Note: binding is done according to `-let'.

\(fn (VAR VAL) &rest BODY)"
  (declare (debug ((sexp form) body))
           (indent 1))
  `(-if-let ,var-val (progn ,@body)))

(defmacro --when-let (val &rest body)
  "If VAL evaluates to non-nil, bind it to symbol `it' and
execute body."
  (declare (debug (form body))
           (indent 1))
  `(--if-let ,val (progn ,@body)))

(defvar -compare-fn nil
  "Tests for equality use this function or `equal' if this is nil.
It should only be set using dynamic scope with a let, like:

  (let ((-compare-fn #\\='=)) (-union numbers1 numbers2 numbers3)")

(defun -distinct (list)
  "Return a new list with all duplicates removed.
The test for equality is done with `equal',
or with `-compare-fn' if that's non-nil.

Alias: `-uniq'"
  ;; Implementation note: The speedup gained from hash table lookup
  ;; starts to outweigh its overhead for lists of length greater than
  ;; 32.  See discussion in PR #305.
  (let* ((len (length list))
         (lut (and (> len 32)
                   ;; Check that `-compare-fn' is a valid hash-table
                   ;; lookup function or `nil'.
                   (memq -compare-fn '(nil equal eq eql))
                   (make-hash-table :test (or -compare-fn #'equal)
                                    :size len))))
    (if lut
        (--filter (unless (gethash it lut)
                    (puthash it t lut))
                  list)
      (--each list (unless (-contains? lut it) (!cons it lut)))
      (nreverse lut))))

(defalias '-uniq '-distinct)

(defun -union (list list2)
  "Return a new list containing the elements of LIST and elements of LIST2 that are not in LIST.
The test for equality is done with `equal',
or with `-compare-fn' if that's non-nil."
  ;; We fall back to iteration implementation if the comparison
  ;; function isn't one of `eq', `eql' or `equal'.
  (let* ((result (reverse list))
         ;; TODO: get rid of this dynamic variable, pass it as an
         ;; argument instead.
         (-compare-fn (if (bound-and-true-p -compare-fn)
                          -compare-fn
                        'equal)))
    (if (memq -compare-fn '(eq eql equal))
        (let ((ht (make-hash-table :test -compare-fn)))
          (--each list (puthash it t ht))
          (--each list2 (unless (gethash it ht) (!cons it result))))
      (--each list2 (unless (-contains? result it) (!cons it result))))
    (nreverse result)))

(defun -intersection (list list2)
  "Return a new list containing only the elements that are members of both LIST and LIST2.
The test for equality is done with `equal',
or with `-compare-fn' if that's non-nil."
  (--filter (-contains? list2 it) list))

(defun -difference (list list2)
  "Return a new list with only the members of LIST that are not in LIST2.
The test for equality is done with `equal',
or with `-compare-fn' if that's non-nil."
  (--filter (not (-contains? list2 it)) list))

(defun -powerset (list)
  "Return the power set of LIST."
  (if (null list) '(())
    (let ((last (-powerset (cdr list))))
      (append (mapcar (lambda (x) (cons (car list) x)) last)
              last))))

(defun -permutations (list)
  "Return the permutations of LIST."
  (if (null list) '(())
    (apply #'append
           (mapcar (lambda (x)
                     (mapcar (lambda (perm) (cons x perm))
                             (-permutations (remove x list))))
                   list))))

(defun -inits (list)
  "Return all prefixes of LIST."
  (let ((res (list list)))
    (setq list (reverse list))
    (while list
      (push (reverse (!cdr list)) res))
    res))

(defun -tails (list)
  "Return all suffixes of LIST"
  (-reductions-r-from 'cons nil list))

(defun -common-prefix (&rest lists)
  "Return the longest common prefix of LISTS."
  (declare (pure t) (side-effect-free t))
  (--reduce (--take-while (and acc (equal (pop acc) it)) it)
            lists))

(defun -common-suffix (&rest lists)
  "Return the longest common suffix of LISTS."
  (nreverse (apply #'-common-prefix (mapcar #'reverse lists))))

(defun -contains? (list element)
  "Return non-nil if LIST contains ELEMENT.

The test for equality is done with `equal', or with `-compare-fn'
if that's non-nil.

Alias: `-contains-p'"
  (not
   (null
    (cond
     ((null -compare-fn)    (member element list))
     ((eq -compare-fn 'eq)  (memq element list))
     ((eq -compare-fn 'eql) (memql element list))
     (t
      (let ((lst list))
        (while (and lst
                    (not (funcall -compare-fn element (car lst))))
          (setq lst (cdr lst)))
        lst))))))

(defalias '-contains-p '-contains?)

(defun -same-items? (list list2)
  "Return true if LIST and LIST2 has the same items.

The order of the elements in the lists does not matter.

Alias: `-same-items-p'"
  (let ((length-a (length list))
        (length-b (length list2)))
    (and
     (= length-a length-b)
     (= length-a (length (-intersection list list2))))))

(defalias '-same-items-p '-same-items?)

(defun -is-prefix? (prefix list)
  "Return non-nil if PREFIX is a prefix of LIST.

Alias: `-is-prefix-p'."
  (declare (pure t) (side-effect-free t))
  (--each-while list (and (equal (car prefix) it)
                          (!cdr prefix)))
  (null prefix))

(defun -is-suffix? (suffix list)
  "Return non-nil if SUFFIX is a suffix of LIST.

Alias: `-is-suffix-p'."
  (declare (pure t) (side-effect-free t))
  (equal suffix (last list (length suffix))))

(defun -is-infix? (infix list)
  "Return non-nil if INFIX is infix of LIST.

This operation runs in O(n^2) time

Alias: `-is-infix-p'"
  (declare (pure t) (side-effect-free t))
  (let (done)
    (while (and (not done) list)
      (setq done (-is-prefix? infix list))
      (!cdr list))
    done))

(defalias '-is-prefix-p '-is-prefix?)
(defalias '-is-suffix-p '-is-suffix?)
(defalias '-is-infix-p '-is-infix?)

(defun -sort (comparator list)
  "Sort LIST, stably, comparing elements using COMPARATOR.
Return the sorted list.  LIST is NOT modified by side effects.
COMPARATOR is called with two elements of LIST, and should return non-nil
if the first element should sort before the second."
  (sort (copy-sequence list) comparator))

(defmacro --sort (form list)
  "Anaphoric form of `-sort'."
  (declare (debug (def-form form)))
  `(-sort (lambda (it other) ,form) ,list))

(defun -list (&optional arg &rest args)
  "Ensure ARG is a list.
If ARG is already a list, return it as is (not a copy).
Otherwise, return a new list with ARG as its only element.

Another supported calling convention is (-list &rest ARGS).
In this case, if ARG is not a list, a new list with all of
ARGS as elements is returned.  This use is supported for
backward compatibility and is otherwise deprecated."
  (declare (advertised-calling-convention (arg) "2.18.0")
           (pure t) (side-effect-free t))
  (if (listp arg) arg (cons arg args)))

(defun -repeat (n x)
  "Return a new list of length N with each element being X.
Return nil if N is less than 1."
  (declare (pure t) (side-effect-free t))
  (and (natnump n) (make-list n x)))

(defun -sum (list)
  "Return the sum of LIST."
  (declare (pure t) (side-effect-free t))
  (apply '+ list))

(defun -running-sum (list)
  "Return a list with running sums of items in LIST.
LIST must be non-empty."
  (declare (pure t) (side-effect-free t))
  (or list (signal 'wrong-type-argument (list #'consp list)))
  (-reductions #'+ list))

(defun -product (list)
  "Return the product of LIST."
  (declare (pure t) (side-effect-free t))
  (apply '* list))

(defun -running-product (list)
  "Return a list with running products of items in LIST.
LIST must be non-empty."
  (declare (pure t) (side-effect-free t))
  (or list (signal 'wrong-type-argument (list #'consp list)))
  (-reductions #'* list))

(defun -max (list)
  "Return the largest value from LIST of numbers or markers."
  (declare (pure t) (side-effect-free t))
  (apply 'max list))

(defun -min (list)
  "Return the smallest value from LIST of numbers or markers."
  (declare (pure t) (side-effect-free t))
  (apply 'min list))

(defun -max-by (comparator list)
  "Take a comparison function COMPARATOR and a LIST and return
the greatest element of the list by the comparison function.

See also combinator `-on' which can transform the values before
comparing them."
  (--reduce (if (funcall comparator it acc) it acc) list))

(defun -min-by (comparator list)
  "Take a comparison function COMPARATOR and a LIST and return
the least element of the list by the comparison function.

See also combinator `-on' which can transform the values before
comparing them."
  (--reduce (if (funcall comparator it acc) acc it) list))

(defmacro --max-by (form list)
  "Anaphoric version of `-max-by'.

The items for the comparator form are exposed as \"it\" and \"other\"."
  (declare (debug (def-form form)))
  `(-max-by (lambda (it other) ,form) ,list))

(defmacro --min-by (form list)
  "Anaphoric version of `-min-by'.

The items for the comparator form are exposed as \"it\" and \"other\"."
  (declare (debug (def-form form)))
  `(-min-by (lambda (it other) ,form) ,list))

(defun -iota (count &optional start step)
  "Return a list containing COUNT numbers.
Starts from START and adds STEP each time.  The default START is
zero, the default STEP is 1.
This function takes its name from the corresponding primitive in
the APL language."
  (declare (pure t) (side-effect-free t))
  (unless (natnump count)
    (signal 'wrong-type-argument (list #'natnump count)))
  (or start (setq start 0))
  (or step (setq step 1))
  (if (zerop step)
      (make-list count start)
    (--iterate (+ it step) start count)))

(defun -fix (fn list)
  "Compute the (least) fixpoint of FN with initial input LIST.

FN is called at least once, results are compared with `equal'."
  (let ((re (funcall fn list)))
    (while (not (equal list re))
      (setq list re)
      (setq re (funcall fn re)))
    re))

(defmacro --fix (form list)
  "Anaphoric form of `-fix'."
  (declare (debug (def-form form)))
  `(-fix (lambda (it) ,form) ,list))

(defun -unfold (fun seed)
  "Build a list from SEED using FUN.

This is \"dual\" operation to `-reduce-r': while -reduce-r
consumes a list to produce a single value, `-unfold' takes a
seed value and builds a (potentially infinite!) list.

FUN should return `nil' to stop the generating process, or a
cons (A . B), where A will be prepended to the result and B is
the new seed."
  (let ((last (funcall fun seed)) r)
    (while last
      (push (car last) r)
      (setq last (funcall fun (cdr last))))
    (nreverse r)))

(defmacro --unfold (form seed)
  "Anaphoric version of `-unfold'."
  (declare (debug (def-form form)))
  `(-unfold (lambda (it) ,form) ,seed))

(defun -cons-pair? (obj)
  "Return non-nil if OBJ is a true cons pair.
That is, a cons (A . B) where B is not a list.

Alias: `-cons-pair-p'."
  (declare (pure t) (side-effect-free t))
  (nlistp (cdr-safe obj)))

(defalias '-cons-pair-p '-cons-pair?)

(defun -cons-to-list (con)
  "Convert a cons pair to a list with `car' and `cdr' of the pair respectively."
  (declare (pure t) (side-effect-free t))
  (list (car con) (cdr con)))

(defun -value-to-list (val)
  "Convert a value to a list.

If the value is a cons pair, make a list with two elements, `car'
and `cdr' of the pair respectively.

If the value is anything else, wrap it in a list."
  (declare (pure t) (side-effect-free t))
  (cond
   ((-cons-pair? val) (-cons-to-list val))
   (t (list val))))

(defun -tree-mapreduce-from (fn folder init-value tree)
  "Apply FN to each element of TREE, and make a list of the results.
If elements of TREE are lists themselves, apply FN recursively to
elements of these nested lists.

Then reduce the resulting lists using FOLDER and initial value
INIT-VALUE. See `-reduce-r-from'.

This is the same as calling `-tree-reduce-from' after `-tree-map'
but is twice as fast as it only traverse the structure once."
  (cond
   ((not tree) nil)
   ((-cons-pair? tree) (funcall fn tree))
   ((listp tree)
    (-reduce-r-from folder init-value (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree)))
   (t (funcall fn tree))))

(defmacro --tree-mapreduce-from (form folder init-value tree)
  "Anaphoric form of `-tree-mapreduce-from'."
  (declare (debug (def-form def-form form form)))
  `(-tree-mapreduce-from (lambda (it) ,form) (lambda (it acc) ,folder) ,init-value ,tree))

(defun -tree-mapreduce (fn folder tree)
  "Apply FN to each element of TREE, and make a list of the results.
If elements of TREE are lists themselves, apply FN recursively to
elements of these nested lists.

Then reduce the resulting lists using FOLDER and initial value
INIT-VALUE. See `-reduce-r-from'.

This is the same as calling `-tree-reduce' after `-tree-map'
but is twice as fast as it only traverse the structure once."
  (cond
   ((not tree) nil)
   ((-cons-pair? tree) (funcall fn tree))
   ((listp tree)
    (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree)))
   (t (funcall fn tree))))

(defmacro --tree-mapreduce (form folder tree)
  "Anaphoric form of `-tree-mapreduce'."
  (declare (debug (def-form def-form form)))
  `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree))

(defun -tree-map (fn tree)
  "Apply FN to each element of TREE while preserving the tree structure."
  (cond
   ((not tree) nil)
   ((-cons-pair? tree) (funcall fn tree))
   ((listp tree)
    (mapcar (lambda (x) (-tree-map fn x)) tree))
   (t (funcall fn tree))))

(defmacro --tree-map (form tree)
  "Anaphoric form of `-tree-map'."
  (declare (debug (def-form form)))
  `(-tree-map (lambda (it) ,form) ,tree))

(defun -tree-reduce-from (fn init-value tree)
  "Use FN to reduce elements of list TREE.
If elements of TREE are lists themselves, apply the reduction recursively.

FN is first applied to INIT-VALUE and first element of the list,
then on this result and second element from the list etc.

The initial value is ignored on cons pairs as they always contain
two elements."
  (cond
   ((not tree) nil)
   ((-cons-pair? tree) tree)
   ((listp tree)
    (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree)))
   (t tree)))

(defmacro --tree-reduce-from (form init-value tree)
  "Anaphoric form of `-tree-reduce-from'."
  (declare (debug (def-form form form)))
  `(-tree-reduce-from (lambda (it acc) ,form) ,init-value ,tree))

(defun -tree-reduce (fn tree)
  "Use FN to reduce elements of list TREE.
If elements of TREE are lists themselves, apply the reduction recursively.

FN is first applied to first element of the list and second
element, then on this result and third element from the list etc.

See `-reduce-r' for how exactly are lists of zero or one element handled."
  (cond
   ((not tree) nil)
   ((-cons-pair? tree) tree)
   ((listp tree)
    (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree)))
   (t tree)))

(defmacro --tree-reduce (form tree)
  "Anaphoric form of `-tree-reduce'."
  (declare (debug (def-form form)))
  `(-tree-reduce (lambda (it acc) ,form) ,tree))

(defun -tree-map-nodes (pred fun tree)
  "Call FUN on each node of TREE that satisfies PRED.

If PRED returns nil, continue descending down this node.  If PRED
returns non-nil, apply FUN to this node and do not descend
further."
  (if (funcall pred tree)
      (funcall fun tree)
    (if (and (listp tree)
             (not (-cons-pair? tree)))
        (-map (lambda (x) (-tree-map-nodes pred fun x)) tree)
      tree)))

(defmacro --tree-map-nodes (pred form tree)
  "Anaphoric form of `-tree-map-nodes'."
  (declare (debug (def-form def-form form)))
  `(-tree-map-nodes (lambda (it) ,pred) (lambda (it) ,form) ,tree))

(defun -tree-seq (branch children tree)
  "Return a sequence of the nodes in TREE, in depth-first search order.

BRANCH is a predicate of one argument that returns non-nil if the
passed argument is a branch, that is, a node that can have children.

CHILDREN is a function of one argument that returns the children
of the passed branch node.

Non-branch nodes are simply copied."
  (cons tree
        (when (funcall branch tree)
          (-mapcat (lambda (x) (-tree-seq branch children x))
                   (funcall children tree)))))

(defmacro --tree-seq (branch children tree)
  "Anaphoric form of `-tree-seq'."
  (declare (debug (def-form def-form form)))
  `(-tree-seq (lambda (it) ,branch) (lambda (it) ,children) ,tree))

(defun -clone (list)
  "Create a deep copy of LIST.
The new list has the same elements and structure but all cons are
replaced with new ones.  This is useful when you need to clone a
structure such as plist or alist."
  (declare (pure t) (side-effect-free t))
  (-tree-map 'identity list))

;;; Combinators

(defalias '-partial #'apply-partially)

(defun -rpartial (fn &rest args)
  "Return a function that is a partial application of FN to ARGS.
ARGS is a list of the last N arguments to pass to FN.  The result
is a new function which does the same as FN, except that the last
N arguments are fixed at the values with which this function was
called.  This is like `-partial', except the arguments are fixed
starting from the right rather than the left."
  (declare (pure t) (side-effect-free t))
  (lambda (&rest args-before) (apply fn (append args-before args))))

(defun -juxt (&rest fns)
  "Return a function that is the juxtaposition of FNS.
The returned function takes a variable number of ARGS, applies
each of FNS in turn to ARGS, and returns the list of results."
  (declare (pure t) (side-effect-free t))
  (lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns)))

(defun -compose (&rest fns)
  "Compose FNS into a single composite function.
Return a function that takes a variable number of ARGS, applies
the last function in FNS to ARGS, and returns the result of
calling each remaining function on the result of the previous
function, right-to-left.  If no FNS are given, return a variadic
`identity' function."
  (declare (pure t) (side-effect-free t))
  (let* ((fns (nreverse fns))
         (head (car fns))
         (tail (cdr fns)))
    (cond (tail
           (lambda (&rest args)
             (--reduce-from (funcall it acc) (apply head args) tail)))
          (fns head)
          ((lambda (&optional arg &rest _) arg)))))

(defun -applify (fn)
  "Return a function that applies FN to a single list of args.
This changes the arity of FN from taking N distinct arguments to
taking 1 argument which is a list of N arguments."
  (declare (pure t) (side-effect-free t))
  (lambda (args) (apply fn args)))

(defun -on (op trans)
  "Return a function that calls TRANS on each arg and OP on the results.
The returned function takes a variable number of arguments, calls
the function TRANS on each one in turn, and then passes those
results as the list of arguments to OP, in the same order.

For example, the following pairs of expressions are morally
equivalent:

  (funcall (-on #\\='+ #\\='1+) 1 2 3) = (+ (1+ 1) (1+ 2) (1+ 3))
  (funcall (-on #\\='+ #\\='1+))       = (+)"
  (declare (pure t) (side-effect-free t))
  (lambda (&rest args)
    ;; This unrolling seems to be a relatively cheap way to keep the
    ;; overhead of `mapcar' + `apply' in check.
    (cond ((cddr args)
           (apply op (mapcar trans args)))
          ((cdr args)
           (funcall op (funcall trans (car args)) (funcall trans (cadr args))))
          (args
           (funcall op (funcall trans (car args))))
          ((funcall op)))))

(defun -flip (fn)
  "Return a function that calls FN with its arguments reversed.
The returned function takes the same number of arguments as FN.

For example, the following two expressions are morally
equivalent:

  (funcall (-flip #\\='-) 1 2) = (- 2 1)

See also: `-rotate-args'."
  (declare (pure t) (side-effect-free t))
  (lambda (&rest args) ;; Open-code for speed.
    (cond ((cddr args) (apply fn (nreverse args)))
          ((cdr args) (funcall fn (cadr args) (car args)))
          (args (funcall fn (car args)))
          ((funcall fn)))))

(defun -rotate-args (n fn)
  "Return a function that calls FN with args rotated N places to the right.
The returned function takes the same number of arguments as FN,
rotates the list of arguments N places to the right (left if N is
negative) just like `-rotate', and applies FN to the result.

See also: `-flip'."
  (declare (pure t) (side-effect-free t))
  (if (zerop n)
      fn
    (let ((even (= (% n 2) 0)))
      (lambda (&rest args)
        (cond ((cddr args) ;; Open-code for speed.
               (apply fn (-rotate n args)))
              ((cdr args)
               (let ((fst (car args))
                     (snd (cadr args)))
                 (funcall fn (if even fst snd) (if even snd fst))))
              (args
               (funcall fn (car args)))
              ((funcall fn)))))))

(defun -const (c)
  "Return a function that returns C ignoring any additional arguments.

In types: a -> b -> a"
  (declare (pure t) (side-effect-free t))
  (lambda (&rest _) c))

(defmacro -cut (&rest params)
  "Take n-ary function and n arguments and specialize some of them.
Arguments denoted by <> will be left unspecialized.

See SRFI-26 for detailed description."
  (declare (debug (&optional sexp &rest &or "<>" form)))
  (let* ((i 0)
         (args (--keep (when (eq it '<>)
                         (setq i (1+ i))
                         (make-symbol (format "D%d" i)))
                       params)))
    `(lambda ,args
       ,(let ((body (--map (if (eq it '<>) (pop args) it) params)))
          (if (eq (car params) '<>)
              (cons #'funcall body)
            body)))))

(defun -not (pred)
  "Return a predicate that negates the result of PRED.
The returned predicate passes its arguments to PRED.  If PRED
returns nil, the result is non-nil; otherwise the result is nil.

See also: `-andfn' and `-orfn'."
  (declare (pure t) (side-effect-free t))
  (lambda (&rest args) (not (apply pred args))))

(defun -orfn (&rest preds)
  "Return a predicate that returns the first non-nil result of PREDS.
The returned predicate takes a variable number of arguments,
passes them to each predicate in PREDS in turn until one of them
returns non-nil, and returns that non-nil result without calling
the remaining PREDS.  If all PREDS return nil, or if no PREDS are
given, the returned predicate returns nil.

See also: `-andfn' and `-not'."
  (declare (pure t) (side-effect-free t))
  ;; Open-code for speed.
  (cond ((cdr preds) (lambda (&rest args) (--some (apply it args) preds)))
        (preds (car preds))
        (#'ignore)))

(defun -andfn (&rest preds)
  "Return a predicate that returns non-nil if all PREDS do so.
The returned predicate P takes a variable number of arguments and
passes them to each predicate in PREDS in turn.  If any one of
PREDS returns nil, P also returns nil without calling the
remaining PREDS.  If all PREDS return non-nil, P returns the last
such value.  If no PREDS are given, P always returns non-nil.

See also: `-orfn' and `-not'."
  (declare (pure t) (side-effect-free t))
  ;; Open-code for speed.
  (cond ((cdr preds) (lambda (&rest args) (--every (apply it args) preds)))
        (preds (car preds))
        ;; As a `pure' function, this runtime check may generate
        ;; backward-incompatible bytecode for `(-andfn)' at compile-time,
        ;; but I doubt that's a problem in practice (famous last words).
        ((fboundp 'always) #'always)
        ((lambda (&rest _) t))))

(defun -iteratefn (fn n)
  "Return a function FN composed N times with itself.

FN is a unary function.  If you need to use a function of higher
arity, use `-applify' first to turn it into a unary function.

With n = 0, this acts as identity function.

In types: (a -> a) -> Int -> a -> a.

This function satisfies the following law:

  (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))."
  (lambda (x) (--dotimes n (setq x (funcall fn x))) x))

(defun -counter (&optional beg end inc)
  "Return a closure that counts from BEG to END, with increment INC.

The closure will return the next value in the counting sequence
each time it is called, and nil after END is reached. BEG
defaults to 0, INC defaults to 1, and if END is nil, the counter
will increment indefinitely.

The closure accepts any number of arguments, which are discarded."
  (let ((inc (or inc 1))
        (n (or beg 0)))
    (lambda (&rest _)
      (when (or (not end) (< n end))
        (prog1 n
          (setq n (+ n inc)))))))

(defvar -fixfn-max-iterations 1000
  "The default maximum number of iterations performed by `-fixfn'
  unless otherwise specified.")

(defun -fixfn (fn &optional equal-test halt-test)
  "Return a function that computes the (least) fixpoint of FN.

FN must be a unary function. The returned lambda takes a single
argument, X, the initial value for the fixpoint iteration. The
iteration halts when either of the following conditions is satisfied:

 1. Iteration converges to the fixpoint, with equality being
    tested using EQUAL-TEST. If EQUAL-TEST is not specified,
    `equal' is used. For functions over the floating point
    numbers, it may be necessary to provide an appropriate
    approximate comparison test.

 2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a
    simple counter that returns t after `-fixfn-max-iterations',
    to guard against infinite iteration. Otherwise, HALT-TEST
    must be a function that accepts a single argument, the
    current value of X, and returns non-nil as long as iteration
    should continue. In this way, a more sophisticated
    convergence test may be supplied by the caller.

The return value of the lambda is either the fixpoint or, if
iteration halted before converging, a cons with car `halted' and
cdr the final output from HALT-TEST.

In types: (a -> a) -> a -> a."
  (let ((eqfn   (or equal-test 'equal))
        (haltfn (or halt-test
                    (-not
                     (-counter 0 -fixfn-max-iterations)))))
    (lambda (x)
      (let ((re (funcall fn x))
            (halt? (funcall haltfn x)))
        (while (and (not halt?) (not (funcall eqfn x re)))
          (setq x     re
                re    (funcall fn re)
                halt? (funcall haltfn re)))
        (if halt? (cons 'halted halt?)
          re)))))

(defun -prodfn (&rest fns)
  "Take a list of n functions and return a function that takes a
list of length n, applying i-th function to i-th element of the
input list.  Returns a list of length n.

In types (for n=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d)

This function satisfies the following laws:

  (-compose (-prodfn f g ...) (-prodfn f\\=' g\\=' ...)) = (-prodfn (-compose f f\\=') (-compose g g\\=') ...)
  (-prodfn f g ...) = (-juxt (-compose f (-partial \\='nth 0)) (-compose g (-partial \\='nth 1)) ...)
  (-compose (-prodfn f g ...) (-juxt f\\=' g\\=' ...)) = (-juxt (-compose f f\\=') (-compose g g\\=') ...)
  (-compose (-partial \\='nth n) (-prod f1 f2 ...)) = (-compose fn (-partial \\='nth n))"
  (lambda (x) (-zip-with 'funcall fns x)))

;;; Font lock

(defvar dash--keywords
  `(;; TODO: Do not fontify the following automatic variables
    ;; globally; detect and limit to their local anaphoric scope.
    (,(rx symbol-start (| "acc" "it" "it-index" "other") symbol-end)
     0 font-lock-variable-name-face)
    ;; Macros in dev/examples.el.  Based on `lisp-mode-symbol-regexp'.
    (,(rx ?\( (group (| "defexamples" "def-example-group")) symbol-end
          (+ (in "\t "))
          (group (* (| (syntax word) (syntax symbol) (: ?\\ nonl)))))
     (1 font-lock-keyword-face)
     (2 font-lock-function-name-face))
    ;; Symbols in dev/examples.el.
    ,(rx symbol-start (| "=>" "~>" "!!>") symbol-end)
    ;; Elisp macro fontification was static prior to Emacs 25.
    ,@(when (< emacs-major-version 25)
        (let ((macs '("!cdr"
                      "!cons"
                      "-->"
                      "--all?"
                      "--annotate"
                      "--any?"
                      "--count"
                      "--dotimes"
                      "--doto"
                      "--drop-while"
                      "--each"
                      "--each-r"
                      "--each-r-while"
                      "--each-while"
                      "--filter"
                      "--find-index"
                      "--find-indices"
                      "--find-last-index"
                      "--first"
                      "--fix"
                      "--group-by"
                      "--if-let"
                      "--iterate"
                      "--keep"
                      "--last"
                      "--map"
                      "--map-first"
                      "--map-indexed"
                      "--map-last"
                      "--map-when"
                      "--mapcat"
                      "--max-by"
                      "--min-by"
                      "--none?"
                      "--only-some?"
                      "--partition-by"
                      "--partition-by-header"
                      "--reduce"
                      "--reduce-from"
                      "--reduce-r"
                      "--reduce-r-from"
                      "--reductions"
                      "--reductions-from"
                      "--reductions-r"
                      "--reductions-r-from"
                      "--remove"
                      "--remove-first"
                      "--remove-last"
                      "--separate"
                      "--some"
                      "--sort"
                      "--splice"
                      "--splice-list"
                      "--split-when"
                      "--split-with"
                      "--take-while"
                      "--tree-map"
                      "--tree-map-nodes"
                      "--tree-mapreduce"
                      "--tree-mapreduce-from"
                      "--tree-reduce"
                      "--tree-reduce-from"
                      "--tree-seq"
                      "--unfold"
                      "--update-at"
                      "--when-let"
                      "--zip-with"
                      "->"
                      "->>"
                      "-as->"
                      "-doto"
                      "-if-let"
                      "-if-let*"
                      "-lambda"
                      "-let"
                      "-let*"
                      "-setq"
                      "-some-->"
                      "-some->"
                      "-some->>"
                      "-split-on"
                      "-when-let"
                      "-when-let*")))
          `((,(concat "(" (regexp-opt macs 'symbols)) . 1)))))
  "Font lock keywords for `dash-fontify-mode'.")

(defcustom dash-fontify-mode-lighter nil
  "Mode line lighter for `dash-fontify-mode'.
Either a string to display in the mode line when
`dash-fontify-mode' is on, or nil to display
nothing (the default)."
  :package-version '(dash . "2.18.0")
  :group 'dash
  :type '(choice (string :tag "Lighter" :value " Dash")
                 (const :tag "Nothing" nil)))

;;;###autoload
(define-minor-mode dash-fontify-mode
  "Toggle fontification of Dash special variables.

Dash-Fontify mode is a buffer-local minor mode intended for Emacs
Lisp buffers.  Enabling it causes the special variables bound in
anaphoric Dash macros to be fontified.  These anaphoras include
`it', `it-index', `acc', and `other'.  In older Emacs versions
which do not dynamically detect macros, Dash-Fontify mode
additionally fontifies Dash macro calls.

See also `dash-fontify-mode-lighter' and
`global-dash-fontify-mode'."
  :group 'dash :lighter dash-fontify-mode-lighter
  (if dash-fontify-mode
      (font-lock-add-keywords nil dash--keywords t)
    (font-lock-remove-keywords nil dash--keywords))
  (cond ((fboundp 'font-lock-flush) ;; Added in Emacs 25.
         (font-lock-flush))
        ;; `font-lock-fontify-buffer' unconditionally enables
        ;; `font-lock-mode' and is marked `interactive-only' in later
        ;; Emacs versions which have `font-lock-flush', so we guard
        ;; and pacify as needed, respectively.
        (font-lock-mode
         (with-no-warnings
           (font-lock-fontify-buffer)))))

(defun dash--turn-on-fontify-mode ()
  "Enable `dash-fontify-mode' if in an Emacs Lisp buffer."
  (when (derived-mode-p #'emacs-lisp-mode)
    (dash-fontify-mode)))

;;;###autoload
(define-globalized-minor-mode global-dash-fontify-mode
  dash-fontify-mode dash--turn-on-fontify-mode
  :group 'dash)

(defcustom dash-enable-fontlock nil
  "If non-nil, fontify Dash macro calls and special variables."
  :group 'dash
  :set (lambda (sym val)
         (set-default sym val)
         (global-dash-fontify-mode (if val 1 0)))
  :type 'boolean)

(make-obsolete-variable
 'dash-enable-fontlock #'global-dash-fontify-mode "2.18.0")

(define-obsolete-function-alias
  'dash-enable-font-lock #'global-dash-fontify-mode "2.18.0")

;;; Info

(defvar dash--info-doc-spec '("(dash) Index" nil "^ -+ .*: " "\\( \\|$\\)")
  "The Dash :doc-spec entry for `info-lookup-alist'.
It is based on that for `emacs-lisp-mode'.")

(defun dash--info-elisp-docs ()
  "Return the `emacs-lisp-mode' symbol docs from `info-lookup-alist'.
Specifically, return the cons containing their
`info-lookup->doc-spec' so that we can modify it."
  (defvar info-lookup-alist)
  (nthcdr 3 (assq #'emacs-lisp-mode (cdr (assq 'symbol info-lookup-alist)))))

;;;###autoload
(defun dash-register-info-lookup ()
  "Register the Dash Info manual with `info-lookup-symbol'.
This allows Dash symbols to be looked up with \\[info-lookup-symbol]."
  (interactive)
  (require 'info-look)
  (let ((docs (dash--info-elisp-docs)))
    (setcar docs (append (car docs) (list dash--info-doc-spec)))
    (info-lookup-reset)))

(defun dash-unload-function ()
  "Remove Dash from `info-lookup-alist'.
Used by `unload-feature', which see."
  (let ((docs (and (featurep 'info-look)
                   (dash--info-elisp-docs))))
    (when (member dash--info-doc-spec (car docs))
      (setcar docs (remove dash--info-doc-spec (car docs)))
      (info-lookup-reset)))
  nil)

(provide 'dash)
;;; dash.el ends here