.emacs.d.git - Gitblit

Chizi123

2018-11-21 e75a20334813452c6912c090d70a0de2c805f94d

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