mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 76bbd07de7add0f9d13c6914f158d19630fe2f62
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