dbo
/
.emacs.d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
My Emacs configuration.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1394 Commits
1 Branch
0 Tags
2.5 MiB
 
 
 
Tree: 1916eb6736
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '1916eb6736'
${ noResults }
.emacs.d/elpa/dash-20210116.1426/dash.el

3134 lines
107 KiB
Raw Blame History Escape

;;; 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.17.0
;; 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."
`(setq ,cdr (cons ,car ,cdr)))
(defmacro !cdr (list)
"Destructive: Set LIST to the cdr of LIST."
`(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
BODY.
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))
(let (acc it)
(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))
(let (acc it)
(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 `--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 `--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)
(defun -remove-last (pred list)
"Return a new list with the last item matching PRED removed.
Alias: `-reject-last'
See also: `-remove', `-map-last'"
(nreverse (-remove-first pred (reverse list))))
(defmacro --remove-last (form list)
"Anaphoric form of `-remove-last'."
(declare (debug (form form)))
`(-remove-last (lambda (it) ,form) ,list))
(defalias '-reject-last '-remove-last)
(defalias '--reject-last '--remove-last)
(defun -remove-item (item list)
"Remove all occurrences of ITEM from LIST.
Comparison is done with `equal'."
(declare (pure t) (side-effect-free t))
(--remove (equal it item) list))
(defmacro --keep (form list)
"Anaphoric form of `-keep'."
(declare (debug (form form)))
(let ((r (make-symbol "result"))
(m (make-symbol "mapped")))
`(let (,r)
(--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r))))
(nreverse ,r))))
(defun -keep (fn list)
"Return a new list of the non-nil results of applying FN to the items in LIST.
If you want to select the original items satisfying a predicate use `-filter'."
(--keep (funcall fn it) list))
(defun -non-nil (list)
"Return all non-nil elements of LIST."
(declare (pure t) (side-effect-free t))
(-remove 'null list))
(defmacro --map-indexed (form list)
"Anaphoric form of `-map-indexed'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each ,list
(!cons ,form ,r))
(nreverse ,r))))
(defun -map-indexed (fn list)
"Return a new list consisting of the result of (FN index item) for each item in LIST.
In the anaphoric form `--map-indexed', the index is exposed as symbol `it-index'.
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'."
`(-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'."
`(-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")))
`(let ((it ,init) ,res)
(dotimes (_ ,n)
(push it ,res)
(setq it ,form))
(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))
(-last-item (--iterate (--mapcat (-list it) it) list (1+ num))))
(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'."
`(-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'."
`(-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 --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)))
`(---truthy? (--some ,form ,list)))
(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)
"Anaphoric form of `-all?'."
(declare (debug (form form)))
(let ((a (make-symbol "all")))
`(let ((,a t))
(--each-while ,list ,a (setq ,a ,form))
(---truthy? ,a))))
(defun -all? (pred list)
"Return t if (PRED x) is non-nil for all x in LIST, else nil.
Alias: `-all-p', `-every?', `-every-p'"
(--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. With N negative, rotate to the left.
The time complexity is O(n)."
(declare (pure t) (side-effect-free t))
(when 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 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 (form form)))
`(-split-when (lambda (it) (equal it ,item)) ,list))
(defmacro --split-when (form list)
"Anaphoric version of `-split-when'."
(declare (debug (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))
(defun -partition-after-pred (pred list)
"Partition directly after each time PRED is true on an element of LIST."
(when list
(let ((rest (-partition-after-pred pred
(cdr list))))
(if (funcall pred (car list))
;;split after (car list)
(cons (list (car list))
rest)
;;don't split after (car list)
(cons (cons (car list)
(car rest))
(cdr rest))))))
(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 (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 -partial (fn &rest args)
"Take a function FN and fewer than the normal arguments to FN,
and return a fn that takes a variable number of additional ARGS.
When called, the returned function calls FN with ARGS first and
then additional args."
(apply 'apply-partially fn args))
(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 (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 (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'."
`(-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)) (indent 1))
`(-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--> (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 -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 body)) (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'.<