1 ;;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*-
3 ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
5 ;; Author: Magnar Sveen <magnars@gmail.com>
7 ;; Package-Version: 20190424.1804
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.
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.
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/>.
25 ;; A modern list api for Emacs.
27 ;; See documentation on https://github.com/magnars/dash.el#functions
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.
38 "Customize group for dash.el"
42 (defun dash--enable-fontlock (symbol value)
44 (dash-enable-font-lock))
45 (set-default symbol value))
47 (defcustom dash-enable-fontlock nil
48 "If non-nil, enable fontification of dash functions, macros and
51 :set 'dash--enable-fontlock
54 (defmacro !cons (car cdr)
55 "Destructive: Set CDR to the cons of CAR and CDR."
56 `(setq ,cdr (cons ,car ,cdr)))
59 "Destructive: Set LIST to the cdr of LIST."
60 `(setq ,list (cdr ,list)))
62 (defmacro --each (list &rest body)
63 "Anaphoric form of `-each'."
64 (declare (debug (form body))
66 (let ((l (make-symbol "list")))
72 (setq it-index (1+ it-index))
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
81 (let ((retval (make-symbol "value")))
82 `(let ((,retval ,eval-initial-value))
83 ,@(mapcar (lambda (form)
85 `(,(-first-item form) ,retval ,@(cdr form))
86 `(funcall form ,retval)))
90 (defmacro --doto (eval-initial-value &rest forms)
91 "Anaphoric form of `-doto'.
92 Note: `it' is not required in each form."
94 `(let ((it ,eval-initial-value))
98 (defun -each (list fn)
99 "Call FN with every item in LIST. Return nil, used for side-effects only."
100 (--each list (funcall fn it)))
102 (put '-each 'lisp-indent-function 1)
104 (defalias '--each-indexed '--each)
106 (defun -each-indexed (list fn)
107 "Call (FN index item) for each item in LIST.
109 In the anaphoric form `--each-indexed', the index is exposed as symbol `it-index'.
111 See also: `-map-indexed'."
112 (--each list (funcall fn it-index it)))
113 (put '-each-indexed 'lisp-indent-function 1)
115 (defmacro --each-while (list pred &rest body)
116 "Anaphoric form of `-each-while'."
117 (declare (debug (form form body))
119 (let ((l (make-symbol "list"))
120 (c (make-symbol "continue")))
126 (if (not ,pred) (setq ,c nil) ,@body))
127 (setq it-index (1+ it-index))
130 (defun -each-while (list pred fn)
131 "Call FN with every item in LIST while (PRED item) is non-nil.
132 Return nil, used for side-effects only."
133 (--each-while list (funcall pred it) (funcall fn it)))
135 (put '-each-while 'lisp-indent-function 2)
137 (defmacro --each-r (list &rest body)
138 "Anaphoric form of `-each-r'."
139 (declare (debug (form body))
141 (let ((v (make-symbol "vector")))
142 ;; Implementation note: building vector is considerably faster
143 ;; than building a reversed list (vector takes less memory, so
144 ;; there is less GC), plus length comes naturally. In-place
145 ;; 'nreverse' would be faster still, but BODY would be able to see
146 ;; that, even if modification was reversed before we return.
147 `(let* ((,v (vconcat ,list))
148 (it-index (length ,v))
150 (while (> it-index 0)
151 (setq it-index (1- it-index))
152 (setq it (aref ,v it-index))
155 (defun -each-r (list fn)
156 "Call FN with every item in LIST in reversed order.
157 Return nil, used for side-effects only."
158 (--each-r list (funcall fn it)))
160 (defmacro --each-r-while (list pred &rest body)
161 "Anaphoric form of `-each-r-while'."
162 (declare (debug (form form body))
164 (let ((v (make-symbol "vector")))
165 `(let* ((,v (vconcat ,list))
166 (it-index (length ,v))
168 (while (> it-index 0)
169 (setq it-index (1- it-index))
170 (setq it (aref ,v it-index))
175 (defun -each-r-while (list pred fn)
176 "Call FN with every item in reversed LIST while (PRED item) is non-nil.
177 Return nil, used for side-effects only."
178 (--each-r-while list (funcall pred it) (funcall fn it)))
180 (defmacro --dotimes (num &rest body)
181 "Repeatedly executes BODY (presumably for side-effects) with symbol `it' bound to integers from 0 through NUM-1."
182 (declare (debug (form body))
184 (let ((n (make-symbol "num")))
189 (setq it (1+ it))))))
191 (defun -dotimes (num fn)
192 "Repeatedly calls FN (presumably for side-effects) passing in integers from 0 through NUM-1."
193 (--dotimes num (funcall fn it)))
195 (put '-dotimes 'lisp-indent-function 1)
197 (defun -map (fn list)
198 "Return a new list consisting of the result of applying FN to the items in LIST."
201 (defmacro --map (form list)
202 "Anaphoric form of `-map'."
203 (declare (debug (form form)))
204 `(mapcar (lambda (it) ,form) ,list))
206 (defmacro --reduce-from (form initial-value list)
207 "Anaphoric form of `-reduce-from'."
208 (declare (debug (form form form)))
209 `(let ((acc ,initial-value))
210 (--each ,list (setq acc ,form))
213 (defun -reduce-from (fn initial-value list)
214 "Return the result of applying FN to INITIAL-VALUE and the
215 first item in LIST, then applying FN to that result and the 2nd
216 item, etc. If LIST contains no items, return INITIAL-VALUE and
219 In the anaphoric form `--reduce-from', the accumulated value is
220 exposed as symbol `acc'.
222 See also: `-reduce', `-reduce-r'"
223 (--reduce-from (funcall fn acc it) initial-value list))
225 (defmacro --reduce (form list)
226 "Anaphoric form of `-reduce'."
227 (declare (debug (form form)))
228 (let ((lv (make-symbol "list-value")))
231 (--reduce-from ,form (car ,lv) (cdr ,lv))
232 (let (acc it) ,form)))))
234 (defun -reduce (fn list)
235 "Return the result of applying FN to the first 2 items in LIST,
236 then applying FN to that result and the 3rd item, etc. If LIST
237 contains no items, return the result of calling FN with no
238 arguments. If LIST contains a single item, return that item
241 In the anaphoric form `--reduce', the accumulated value is
242 exposed as symbol `acc'.
244 See also: `-reduce-from', `-reduce-r'"
246 (-reduce-from fn (car list) (cdr list))
249 (defmacro --reduce-r-from (form initial-value list)
250 "Anaphoric version of `-reduce-r-from'."
251 (declare (debug (form form form)))
252 `(--reduce-from ,form ,initial-value (reverse ,list)))
254 (defun -reduce-r-from (fn initial-value list)
255 "Replace conses with FN, nil with INITIAL-VALUE and evaluate
256 the resulting expression. If LIST is empty, INITIAL-VALUE is
257 returned and FN is not called.
259 Note: this function works the same as `-reduce-from' but the
260 operation associates from right instead of from left.
262 See also: `-reduce-r', `-reduce'"
263 (--reduce-r-from (funcall fn it acc) initial-value list))
265 (defmacro --reduce-r (form list)
266 "Anaphoric version of `-reduce-r'."
267 (declare (debug (form form)))
268 `(--reduce ,form (reverse ,list)))
270 (defun -reduce-r (fn list)
271 "Replace conses with FN and evaluate the resulting expression.
272 The final nil is ignored. If LIST contains no items, return the
273 result of calling FN with no arguments. If LIST contains a single
274 item, return that item and do not call FN.
276 The first argument of FN is the new item, the second is the
279 Note: this function works the same as `-reduce' but the operation
280 associates from right instead of from left.
282 See also: `-reduce-r-from', `-reduce'"
284 (--reduce-r (funcall fn it acc) list)
287 (defun -reductions-from (fn init list)
288 "Return a list of the intermediate values of the reduction.
290 See `-reduce-from' for explanation of the arguments.
292 See also: `-reductions', `-reductions-r', `-reduce-r'"
293 (nreverse (--reduce-from (cons (funcall fn (car acc) it) acc) (list init) list)))
295 (defun -reductions (fn list)
296 "Return a list of the intermediate values of the reduction.
298 See `-reduce' for explanation of the arguments.
300 See also: `-reductions-from', `-reductions-r', `-reduce-r'"
301 (and list (-reductions-from fn (car list) (cdr list))))
303 (defun -reductions-r-from (fn init list)
304 "Return a list of the intermediate values of the reduction.
306 See `-reduce-r-from' for explanation of the arguments.
308 See also: `-reductions-r', `-reductions', `-reduce'"
309 (--reduce-r-from (cons (funcall fn it (car acc)) acc) (list init) list))
311 (defun -reductions-r (fn list)
312 "Return a list of the intermediate values of the reduction.
314 See `-reduce-r' for explanation of the arguments.
316 See also: `-reductions-r-from', `-reductions', `-reduce'"
318 (let ((rev (reverse list)))
319 (--reduce-from (cons (funcall fn it (car acc)) acc)
323 (defmacro --filter (form list)
324 "Anaphoric form of `-filter'.
326 See also: `--remove'."
327 (declare (debug (form form)))
328 (let ((r (make-symbol "result")))
330 (--each ,list (when ,form (!cons it ,r)))
333 (defun -filter (pred list)
334 "Return a new list of the items in LIST for which PRED returns a non-nil value.
338 See also: `-keep', `-remove'."
339 (--filter (funcall pred it) list))
341 (defalias '-select '-filter)
342 (defalias '--select '--filter)
344 (defmacro --remove (form list)
345 "Anaphoric form of `-remove'.
347 See also `--filter'."
348 (declare (debug (form form)))
349 `(--filter (not ,form) ,list))
351 (defun -remove (pred list)
352 "Return a new list of the items in LIST for which PRED returns nil.
356 See also: `-filter'."
357 (--remove (funcall pred it) list))
359 (defalias '-reject '-remove)
360 (defalias '--reject '--remove)
362 (defun -remove-first (pred list)
363 "Return a new list with the first item matching PRED removed.
365 Alias: `-reject-first'
367 See also: `-remove', `-map-first'"
369 (while (and list (not (funcall pred (car list))))
370 (push (car list) front)
373 (-concat (nreverse front) (cdr list))
376 (defmacro --remove-first (form list)
377 "Anaphoric form of `-remove-first'."
378 (declare (debug (form form)))
379 `(-remove-first (lambda (it) ,form) ,list))
381 (defalias '-reject-first '-remove-first)
382 (defalias '--reject-first '--remove-first)
384 (defun -remove-last (pred list)
385 "Return a new list with the last item matching PRED removed.
387 Alias: `-reject-last'
389 See also: `-remove', `-map-last'"
390 (nreverse (-remove-first pred (reverse list))))
392 (defmacro --remove-last (form list)
393 "Anaphoric form of `-remove-last'."
394 (declare (debug (form form)))
395 `(-remove-last (lambda (it) ,form) ,list))
397 (defalias '-reject-last '-remove-last)
398 (defalias '--reject-last '--remove-last)
400 (defun -remove-item (item list)
401 "Remove all occurences of ITEM from LIST.
403 Comparison is done with `equal'."
404 (declare (pure t) (side-effect-free t))
405 (--remove (equal it item) list))
407 (defmacro --keep (form list)
408 "Anaphoric form of `-keep'."
409 (declare (debug (form form)))
410 (let ((r (make-symbol "result"))
411 (m (make-symbol "mapped")))
413 (--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r))))
416 (defun -keep (fn list)
417 "Return a new list of the non-nil results of applying FN to the items in LIST.
419 If you want to select the original items satisfying a predicate use `-filter'."
420 (--keep (funcall fn it) list))
422 (defun -non-nil (list)
423 "Return all non-nil elements of LIST."
424 (declare (pure t) (side-effect-free t))
425 (-remove 'null list))
427 (defmacro --map-indexed (form list)
428 "Anaphoric form of `-map-indexed'."
429 (declare (debug (form form)))
430 (let ((r (make-symbol "result")))
436 (defun -map-indexed (fn list)
437 "Return a new list consisting of the result of (FN index item) for each item in LIST.
439 In the anaphoric form `--map-indexed', the index is exposed as symbol `it-index'.
441 See also: `-each-indexed'."
442 (--map-indexed (funcall fn it-index it) list))
444 (defmacro --map-when (pred rep list)
445 "Anaphoric form of `-map-when'."
446 (declare (debug (form form form)))
447 (let ((r (make-symbol "result")))
449 (--each ,list (!cons (if ,pred ,rep it) ,r))
452 (defun -map-when (pred rep list)
453 "Return a new list where the elements in LIST that do not match the PRED function
454 are unchanged, and where the elements in LIST that do match the PRED function are mapped
455 through the REP function.
457 Alias: `-replace-where'
459 See also: `-update-at'"
460 (--map-when (funcall pred it) (funcall rep it) list))
462 (defalias '-replace-where '-map-when)
463 (defalias '--replace-where '--map-when)
465 (defun -map-first (pred rep list)
466 "Replace first item in LIST satisfying PRED with result of REP called on this item.
468 See also: `-map-when', `-replace-first'"
470 (while (and list (not (funcall pred (car list))))
471 (push (car list) front)
474 (-concat (nreverse front) (cons (funcall rep (car list)) (cdr list)))
477 (defmacro --map-first (pred rep list)
478 "Anaphoric form of `-map-first'."
479 `(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))
481 (defun -map-last (pred rep list)
482 "Replace last item in LIST satisfying PRED with result of REP called on this item.
484 See also: `-map-when', `-replace-last'"
485 (nreverse (-map-first pred rep (reverse list))))
487 (defmacro --map-last (pred rep list)
488 "Anaphoric form of `-map-last'."
489 `(-map-last (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))
491 (defun -replace (old new list)
492 "Replace all OLD items in LIST with NEW.
494 Elements are compared using `equal'.
496 See also: `-replace-at'"
497 (declare (pure t) (side-effect-free t))
498 (--map-when (equal it old) new list))
500 (defun -replace-first (old new list)
501 "Replace the first occurence of OLD with NEW in LIST.
503 Elements are compared using `equal'.
505 See also: `-map-first'"
506 (declare (pure t) (side-effect-free t))
507 (--map-first (equal old it) new list))
509 (defun -replace-last (old new list)
510 "Replace the last occurence of OLD with NEW in LIST.
512 Elements are compared using `equal'.
514 See also: `-map-last'"
515 (declare (pure t) (side-effect-free t))
516 (--map-last (equal old it) new list))
518 (defmacro --mapcat (form list)
519 "Anaphoric form of `-mapcat'."
520 (declare (debug (form form)))
521 `(apply 'append (--map ,form ,list)))
523 (defun -mapcat (fn list)
524 "Return the concatenation of the result of mapping FN over LIST.
525 Thus function FN should return a list."
526 (--mapcat (funcall fn it) list))
529 "Take a nested list L and return its contents as a single, flat list.
531 Note that because `nil' represents a list of zero elements (an
532 empty list), any mention of nil in L will disappear after
533 flattening. If you need to preserve nils, consider `-flatten-n'
534 or map them to some unique symbol and then map them back.
536 Conses of two atoms are considered \"terminals\", that is, they
537 aren't flattened further.
539 See also: `-flatten-n'"
540 (declare (pure t) (side-effect-free t))
541 (if (and (listp l) (listp (cdr l)))
542 (-mapcat '-flatten l)
545 (defmacro --iterate (form init n)
546 "Anaphoric version of `-iterate'."
547 (declare (debug (form form form)))
548 `(-iterate (lambda (it) ,form) ,init ,n))
550 (defun -flatten-n (num list)
551 "Flatten NUM levels of a nested LIST.
553 See also: `-flatten'"
554 (declare (pure t) (side-effect-free t))
555 (-last-item (--iterate (--mapcat (-list it) it) list (1+ num))))
557 (defun -concat (&rest lists)
558 "Return a new list with the concatenation of the elements in the supplied LISTS."
559 (declare (pure t) (side-effect-free t))
560 (apply 'append lists))
562 (defalias '-copy 'copy-sequence
563 "Create a shallow copy of LIST.
567 (defun -splice (pred fun list)
568 "Splice lists generated by FUN in place of elements matching PRED in LIST.
570 FUN takes the element matching PRED as input.
572 This function can be used as replacement for `,@' in case you
573 need to splice several lists at marked positions (for example
576 See also: `-splice-list', `-insert-at'"
579 (if (funcall pred it)
580 (let ((new (funcall fun it)))
581 (--each new (!cons it r)))
585 (defmacro --splice (pred form list)
586 "Anaphoric form of `-splice'."
587 `(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list))
589 (defun -splice-list (pred new-list list)
590 "Splice NEW-LIST in place of elements matching PRED in LIST.
592 See also: `-splice', `-insert-at'"
593 (-splice pred (lambda (_) new-list) list))
595 (defmacro --splice-list (pred new-list list)
596 "Anaphoric form of `-splice-list'."
597 `(-splice-list (lambda (it) ,pred) ,new-list ,list))
599 (defun -cons* (&rest args)
600 "Make a new list from the elements of ARGS.
602 The last 2 members of ARGS are used as the final cons of the
603 result so if the final member of ARGS is not a list the result is
605 (declare (pure t) (side-effect-free t))
606 (-reduce-r 'cons args))
608 (defun -snoc (list elem &rest elements)
609 "Append ELEM to the end of the list.
611 This is like `cons', but operates on the end of list.
613 If ELEMENTS is non nil, append these to the list as well."
614 (-concat list (list elem) elements))
616 (defmacro --first (form list)
617 "Anaphoric form of `-first'."
618 (declare (debug (form form)))
619 (let ((n (make-symbol "needle")))
621 (--each-while ,list (not ,n)
622 (when ,form (setq ,n it)))
625 (defun -first (pred list)
626 "Return the first x in LIST where (PRED x) is non-nil, else nil.
628 To get the first item in the list no questions asked, use `car'.
631 (--first (funcall pred it) list))
633 (defalias '-find '-first)
634 (defalias '--find '--first)
636 (defmacro --some (form list)
637 "Anaphoric form of `-some'."
638 (declare (debug (form form)))
639 (let ((n (make-symbol "needle")))
641 (--each-while ,list (not ,n)
645 (defun -some (pred list)
646 "Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil.
649 (--some (funcall pred it) list))
651 (defalias '-any '-some)
652 (defalias '--any '--some)
654 (defmacro --last (form list)
655 "Anaphoric form of `-last'."
656 (declare (debug (form form)))
657 (let ((n (make-symbol "needle")))
660 (when ,form (setq ,n it)))
663 (defun -last (pred list)
664 "Return the last x in LIST where (PRED x) is non-nil, else nil."
665 (--last (funcall pred it) list))
667 (defalias '-first-item 'car
668 "Return the first item of LIST, or nil on an empty list.
670 See also: `-second-item', `-last-item'.
674 ;; Ensure that calls to `-first-item' are compiled to a single opcode,
676 (put '-first-item 'byte-opcode 'byte-car)
677 (put '-first-item 'byte-compile 'byte-compile-one-arg)
679 (defalias '-second-item 'cadr
680 "Return the second item of LIST, or nil if LIST is too short.
682 See also: `-third-item'.
686 (defalias '-third-item 'caddr
687 "Return the third item of LIST, or nil if LIST is too short.
689 See also: `-fourth-item'.
693 (defun -fourth-item (list)
694 "Return the fourth item of LIST, or nil if LIST is too short.
696 See also: `-fifth-item'."
697 (declare (pure t) (side-effect-free t))
698 (car (cdr (cdr (cdr list)))))
700 (defun -fifth-item (list)
701 "Return the fifth item of LIST, or nil if LIST is too short.
703 See also: `-last-item'."
704 (declare (pure t) (side-effect-free t))
705 (car (cdr (cdr (cdr (cdr list))))))
707 ;; TODO: gv was introduced in 24.3, so we can remove the if statement
708 ;; when support for earlier versions is dropped
711 (if (fboundp 'gv-define-simple-setter)
712 (gv-define-simple-setter -first-item setcar)
715 (defsetf -first-item (x) (val) `(setcar ,x ,val)))))
717 (defun -last-item (list)
718 "Return the last item of LIST, or nil on an empty list."
719 (declare (pure t) (side-effect-free t))
722 ;; TODO: gv was introduced in 24.3, so we can remove the if statement
723 ;; when support for earlier versions is dropped
725 (if (fboundp 'gv-define-setter)
726 (gv-define-setter -last-item (val x) `(setcar (last ,x) ,val))
728 (defsetf -last-item (x) (val) `(setcar (last ,x) ,val)))))
730 (defun -butlast (list)
731 "Return a list of all items in list except for the last."
732 ;; no alias as we don't want magic optional argument
733 (declare (pure t) (side-effect-free t))
736 (defmacro --count (pred list)
737 "Anaphoric form of `-count'."
738 (declare (debug (form form)))
739 (let ((r (make-symbol "result")))
741 (--each ,list (when ,pred (setq ,r (1+ ,r))))
744 (defun -count (pred list)
745 "Counts the number of items in LIST where (PRED item) is non-nil."
746 (--count (funcall pred it) list))
748 (defun ---truthy? (val)
749 (declare (pure t) (side-effect-free t))
752 (defmacro --any? (form list)
753 "Anaphoric form of `-any?'."
754 (declare (debug (form form)))
755 `(---truthy? (--some ,form ,list)))
757 (defun -any? (pred list)
758 "Return t if (PRED x) is non-nil for any x in LIST, else nil.
760 Alias: `-any-p', `-some?', `-some-p'"
761 (--any? (funcall pred it) list))
763 (defalias '-some? '-any?)
764 (defalias '--some? '--any?)
765 (defalias '-any-p '-any?)
766 (defalias '--any-p '--any?)
767 (defalias '-some-p '-any?)
768 (defalias '--some-p '--any?)
770 (defmacro --all? (form list)
771 "Anaphoric form of `-all?'."
772 (declare (debug (form form)))
773 (let ((a (make-symbol "all")))
775 (--each-while ,list ,a (setq ,a ,form))
778 (defun -all? (pred list)
779 "Return t if (PRED x) is non-nil for all x in LIST, else nil.
781 Alias: `-all-p', `-every?', `-every-p'"
782 (--all? (funcall pred it) list))
784 (defalias '-every? '-all?)
785 (defalias '--every? '--all?)
786 (defalias '-all-p '-all?)
787 (defalias '--all-p '--all?)
788 (defalias '-every-p '-all?)
789 (defalias '--every-p '--all?)
791 (defmacro --none? (form list)
792 "Anaphoric form of `-none?'."
793 (declare (debug (form form)))
794 `(--all? (not ,form) ,list))
796 (defun -none? (pred list)
797 "Return t if (PRED x) is nil for all x in LIST, else nil.
800 (--none? (funcall pred it) list))
802 (defalias '-none-p '-none?)
803 (defalias '--none-p '--none?)
805 (defmacro --only-some? (form list)
806 "Anaphoric form of `-only-some?'."
807 (declare (debug (form form)))
808 (let ((y (make-symbol "yes"))
809 (n (make-symbol "no")))
811 (--each-while ,list (not (and ,y ,n))
812 (if ,form (setq ,y t) (setq ,n t)))
813 (---truthy? (and ,y ,n)))))
815 (defun -only-some? (pred list)
816 "Return `t` if at least one item of LIST matches PRED and at least one item of LIST does not match PRED.
817 Return `nil` both if all items match the predicate or if none of the items match the predicate.
819 Alias: `-only-some-p'"
820 (--only-some? (funcall pred it) list))
822 (defalias '-only-some-p '-only-some?)
823 (defalias '--only-some-p '--only-some?)
825 (defun -slice (list from &optional to step)
826 "Return copy of LIST, starting from index FROM to index TO.
828 FROM or TO may be negative. These values are then interpreted
829 modulo the length of the list.
831 If STEP is a number, only each STEPth item in the resulting
832 section is returned. Defaults to 1."
833 (declare (pure t) (side-effect-free t))
834 (let ((length (length list))
836 ;; to defaults to the end of the list
837 (setq to (or to length))
838 (setq step (or step 1))
839 ;; handle negative indices
841 (setq from (mod from length)))
843 (setq to (mod to length)))
845 ;; iterate through the list, keeping the elements we want
846 (--each-while list (< it-index to)
847 (when (and (>= it-index from)
848 (= (mod (- from it-index) step) 0))
850 (nreverse new-list)))
852 (defun -take (n list)
853 "Return a new list of the first N items in LIST, or all items if there are fewer than N.
855 See also: `-take-last'"
856 (declare (pure t) (side-effect-free t))
860 (!cons (car list) result)
864 (defun -take-last (n list)
865 "Return the last N items of LIST in order.
868 (declare (pure t) (side-effect-free t))
869 (copy-sequence (last list n)))
871 (defalias '-drop 'nthcdr
872 "Return the tail of LIST without the first N items.
874 See also: `-drop-last'
878 (defun -drop-last (n list)
879 "Remove the last N items of LIST and return a copy.
882 ;; No alias because we don't want magic optional argument
883 (declare (pure t) (side-effect-free t))
886 (defmacro --take-while (form list)
887 "Anaphoric form of `-take-while'."
888 (declare (debug (form form)))
889 (let ((r (make-symbol "result")))
891 (--each-while ,list ,form (!cons it ,r))
894 (defun -take-while (pred list)
895 "Return a new list of successive items from LIST while (PRED item) returns a non-nil value."
896 (--take-while (funcall pred it) list))
898 (defmacro --drop-while (form list)
899 "Anaphoric form of `-drop-while'."
900 (declare (debug (form form)))
901 (let ((l (make-symbol "list")))
903 (while (and ,l (let ((it (car ,l))) ,form))
907 (defun -drop-while (pred list)
908 "Return the tail of LIST starting from the first item for which (PRED item) returns nil."
909 (--drop-while (funcall pred it) list))
911 (defun -split-at (n list)
912 "Return a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list."
913 (declare (pure t) (side-effect-free t))
917 (!cons (car list) result)
919 (list (nreverse result) list)))
921 (defun -rotate (n list)
922 "Rotate LIST N places to the right. With N negative, rotate to the left.
923 The time complexity is O(n)."
924 (declare (pure t) (side-effect-free t))
926 (let* ((len (length list))
927 (n-mod-len (mod n len))
928 (new-tail-len (- len n-mod-len)))
929 (append (-drop new-tail-len list) (-take new-tail-len list)))))
931 (defun -insert-at (n x list)
932 "Return a list with X inserted into LIST at position N.
934 See also: `-splice', `-splice-list'"
935 (declare (pure t) (side-effect-free t))
936 (let ((split-list (-split-at n list)))
937 (nconc (car split-list) (cons x (cadr split-list)))))
939 (defun -replace-at (n x list)
940 "Return a list with element at Nth position in LIST replaced with X.
942 See also: `-replace'"
943 (declare (pure t) (side-effect-free t))
944 (let ((split-list (-split-at n list)))
945 (nconc (car split-list) (cons x (cdr (cadr split-list))))))
947 (defun -update-at (n func list)
948 "Return a list with element at Nth position in LIST replaced with `(func (nth n list))`.
950 See also: `-map-when'"
951 (let ((split-list (-split-at n list)))
952 (nconc (car split-list) (cons (funcall func (car (cadr split-list))) (cdr (cadr split-list))))))
954 (defmacro --update-at (n form list)
955 "Anaphoric version of `-update-at'."
956 (declare (debug (form form form)))
957 `(-update-at ,n (lambda (it) ,form) ,list))
959 (defun -remove-at (n list)
960 "Return a list with element at Nth position in LIST removed.
962 See also: `-remove-at-indices', `-remove'"
963 (declare (pure t) (side-effect-free t))
964 (-remove-at-indices (list n) list))
966 (defun -remove-at-indices (indices list)
967 "Return a list whose elements are elements from LIST without
968 elements selected as `(nth i list)` for all i
971 See also: `-remove-at', `-remove'"
972 (declare (pure t) (side-effect-free t))
973 (let* ((indices (-sort '< indices))
974 (diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices))))
977 (let ((split (-split-at it list)))
978 (!cons (car split) r)
979 (setq list (cdr (cadr split)))))
981 (apply '-concat (nreverse r))))
983 (defmacro --split-with (pred list)
984 "Anaphoric form of `-split-with'."
985 (declare (debug (form form)))
986 (let ((l (make-symbol "list"))
987 (r (make-symbol "result"))
988 (c (make-symbol "continue")))
998 (list (nreverse ,r) ,l))))
1000 (defun -split-with (pred list)
1001 "Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list."
1002 (--split-with (funcall pred it) list))
1004 (defmacro -split-on (item list)
1005 "Split the LIST each time ITEM is found.
1007 Unlike `-partition-by', the ITEM is discarded from the results.
1008 Empty lists are also removed from the result.
1010 Comparison is done by `equal'.
1012 See also `-split-when'"
1013 (declare (debug (form form)))
1014 `(-split-when (lambda (it) (equal it ,item)) ,list))
1016 (defmacro --split-when (form list)
1017 "Anaphoric version of `-split-when'."
1018 (declare (debug (form form)))
1019 `(-split-when (lambda (it) ,form) ,list))
1021 (defun -split-when (fn list)
1022 "Split the LIST on each element where FN returns non-nil.
1024 Unlike `-partition-by', the \"matched\" element is discarded from
1025 the results. Empty lists are also removed from the result.
1027 This function can be thought of as a generalization of
1031 (if (not (funcall fn (car list)))
1033 (when s (push (nreverse s) r))
1036 (when s (push (nreverse s) r))
1039 (defmacro --separate (form list)
1040 "Anaphoric form of `-separate'."
1041 (declare (debug (form form)))
1042 (let ((y (make-symbol "yes"))
1043 (n (make-symbol "no")))
1045 (--each ,list (if ,form (!cons it ,y) (!cons it ,n)))
1046 (list (nreverse ,y) (nreverse ,n)))))
1048 (defun -separate (pred list)
1049 "Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list."
1050 (--separate (funcall pred it) list))
1052 (defun ---partition-all-in-steps-reversed (n step list)
1053 "Private: Used by -partition-all-in-steps and -partition-in-steps."
1055 (error "Step must be a positive number, or you're looking at some juicy infinite loops."))
1058 (!cons (-take n list) result)
1059 (setq list (-drop step list)))
1062 (defun -partition-all-in-steps (n step list)
1063 "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.
1064 The last groups may contain less than N items."
1065 (declare (pure t) (side-effect-free t))
1066 (nreverse (---partition-all-in-steps-reversed n step list)))
1068 (defun -partition-in-steps (n step list)
1069 "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.
1070 If there are not enough items to make the last group N-sized,
1071 those items are discarded."
1072 (declare (pure t) (side-effect-free t))
1073 (let ((result (---partition-all-in-steps-reversed n step list)))
1074 (while (and result (< (length (car result)) n))
1078 (defun -partition-all (n list)
1079 "Return a new list with the items in LIST grouped into N-sized sublists.
1080 The last group may contain less than N items."
1081 (declare (pure t) (side-effect-free t))
1082 (-partition-all-in-steps n n list))
1084 (defun -partition (n list)
1085 "Return a new list with the items in LIST grouped into N-sized sublists.
1086 If there are not enough items to make the last group N-sized,
1087 those items are discarded."
1088 (declare (pure t) (side-effect-free t))
1089 (-partition-in-steps n n list))
1091 (defmacro --partition-by (form list)
1092 "Anaphoric form of `-partition-by'."
1093 (declare (debug (form form)))
1094 (let ((r (make-symbol "result"))
1095 (s (make-symbol "sublist"))
1096 (v (make-symbol "value"))
1097 (n (make-symbol "new-value"))
1098 (l (make-symbol "list")))
1107 (let* ((it (car ,l))
1109 (unless (equal ,v ,n)
1110 (!cons (nreverse ,s) ,r)
1115 (!cons (nreverse ,s) ,r)
1118 (defun -partition-by (fn list)
1119 "Apply FN to each item in LIST, splitting it each time FN returns a new value."
1120 (--partition-by (funcall fn it) list))
1122 (defmacro --partition-by-header (form list)
1123 "Anaphoric form of `-partition-by-header'."
1124 (declare (debug (form form)))
1125 (let ((r (make-symbol "result"))
1126 (s (make-symbol "sublist"))
1127 (h (make-symbol "header-value"))
1128 (b (make-symbol "seen-body?"))
1129 (n (make-symbol "new-value"))
1130 (l (make-symbol "list")))
1140 (let* ((it (car ,l))
1144 (!cons (nreverse ,s) ,r)
1150 (!cons (nreverse ,s) ,r)
1153 (defun -partition-by-header (fn list)
1154 "Apply FN to the first item in LIST. That is the header
1155 value. Apply FN to each item in LIST, splitting it each time FN
1156 returns the header value, but only after seeing at least one
1157 other value (the body)."
1158 (--partition-by-header (funcall fn it) list))
1160 (defun -partition-after-pred (pred list)
1161 "Partition directly after each time PRED is true on an element of LIST."
1163 (let ((rest (-partition-after-pred pred
1165 (if (funcall pred (car list))
1166 ;;split after (car list)
1167 (cons (list (car list))
1170 ;;don't split after (car list)
1171 (cons (cons (car list)
1175 (defun -partition-before-pred (pred list)
1176 "Partition directly before each time PRED is true on an element of LIST."
1177 (nreverse (-map #'reverse
1178 (-partition-after-pred pred (reverse list)))))
1180 (defun -partition-after-item (item list)
1181 "Partition directly after each time ITEM appears in LIST."
1182 (-partition-after-pred (lambda (ele) (equal ele item))
1185 (defun -partition-before-item (item list)
1186 "Partition directly before each time ITEM appears in LIST."
1187 (-partition-before-pred (lambda (ele) (equal ele item))
1190 (defmacro --group-by (form list)
1191 "Anaphoric form of `-group-by'."
1193 (let ((n (make-symbol "n"))
1194 (k (make-symbol "k"))
1195 (grp (make-symbol "grp")))
1200 (nreverse (cdr ,n))))
1202 (let* ((,k (,@form))
1203 (,grp (assoc ,k acc)))
1205 (setcdr ,grp (cons it (cdr ,grp)))
1212 (defun -group-by (fn list)
1213 "Separate LIST into an alist whose keys are FN applied to the
1214 elements of LIST. Keys are compared by `equal'."
1215 (--group-by (funcall fn it) list))
1217 (defun -interpose (sep list)
1218 "Return a new list of all elements in LIST separated by SEP."
1219 (declare (pure t) (side-effect-free t))
1222 (!cons (car list) result)
1225 (setq result (cons (car list) (cons sep result)))
1229 (defun -interleave (&rest lists)
1230 "Return a new list of the first item in each list, then the second etc."
1231 (declare (pure t) (side-effect-free t))
1234 (while (-none? 'null lists)
1235 (--each lists (!cons (car it) result))
1236 (setq lists (-map 'cdr lists)))
1237 (nreverse result))))
1239 (defmacro --zip-with (form list1 list2)
1240 "Anaphoric form of `-zip-with'.
1242 The elements in list1 are bound as symbol `it', the elements in list2 as symbol `other'."
1243 (declare (debug (form form form)))
1244 (let ((r (make-symbol "result"))
1245 (l1 (make-symbol "list1"))
1246 (l2 (make-symbol "list2")))
1250 (while (and ,l1 ,l2)
1251 (let ((it (car ,l1))
1258 (defun -zip-with (fn list1 list2)
1259 "Zip the two lists LIST1 and LIST2 using a function FN. This
1260 function is applied pairwise taking as first argument element of
1261 LIST1 and as second argument element of LIST2 at corresponding
1264 The anaphoric form `--zip-with' binds the elements from LIST1 as symbol `it',
1265 and the elements from LIST2 as symbol `other'."
1266 (--zip-with (funcall fn it other) list1 list2))
1268 (defun -zip (&rest lists)
1269 "Zip LISTS together. Group the head of each list, followed by the
1270 second elements of each list, and so on. The lengths of the returned
1271 groupings are equal to the length of the shortest input list.
1273 If two lists are provided as arguments, return the groupings as a list
1274 of cons cells. Otherwise, return the groupings as a list of lists.
1276 Please note! This distinction is being removed in an upcoming 3.0
1277 release of Dash. If you rely on this behavior, use -zip-pair instead."
1278 (declare (pure t) (side-effect-free t))
1281 (while (-none? 'null lists)
1282 (setq results (cons (mapcar 'car lists) results))
1283 (setq lists (mapcar 'cdr lists)))
1284 (setq results (nreverse results))
1285 (if (= (length lists) 2)
1286 ;; to support backward compatability, return
1287 ;; a cons cell if two lists were provided
1288 (--map (cons (car it) (cadr it)) results)
1291 (defalias '-zip-pair '-zip)
1293 (defun -zip-fill (fill-value &rest lists)
1294 "Zip LISTS, with FILL-VALUE padded onto the shorter lists. The
1295 lengths of the returned groupings are equal to the length of the
1296 longest input list."
1297 (declare (pure t) (side-effect-free t))
1298 (apply '-zip (apply '-pad (cons fill-value lists))))
1300 (defun -unzip (lists)
1303 This works just like `-zip' but takes a list of lists instead of
1304 a variable number of arguments, such that
1306 (-unzip (-zip L1 L2 L3 ...))
1308 is identity (given that the lists are the same length).
1311 (apply '-zip lists))
1313 (defun -cycle (list)
1314 "Return an infinite copy of LIST that will cycle through the
1315 elements and repeat from the beginning."
1316 (declare (pure t) (side-effect-free t))
1317 (let ((newlist (-map 'identity list)))
1318 (nconc newlist newlist)))
1320 (defun -pad (fill-value &rest lists)
1321 "Appends FILL-VALUE to the end of each list in LISTS such that they
1322 will all have the same length."
1323 (let* ((annotations (-annotate 'length lists))
1324 (n (-max (-map 'car annotations))))
1325 (--map (append (cdr it) (-repeat (- n (car it)) fill-value)) annotations)))
1327 (defun -annotate (fn list)
1328 "Return a list of cons cells where each cell is FN applied to each
1329 element of LIST paired with the unmodified element of LIST."
1330 (-zip (-map fn list) list))
1332 (defmacro --annotate (form list)
1333 "Anaphoric version of `-annotate'."
1334 (declare (debug (form form)))
1335 `(-annotate (lambda (it) ,form) ,list))
1337 (defun dash--table-carry (lists restore-lists &optional re)
1338 "Helper for `-table' and `-table-flat'.
1340 If a list overflows, carry to the right and reset the list."
1341 (while (not (or (car lists)
1342 (equal lists '(nil))))
1343 (setcar lists (car restore-lists))
1346 (!cdr restore-lists)
1348 (push (nreverse (car re)) (cadr re))
1352 (defun -table (fn &rest lists)
1353 "Compute outer product of LISTS using function FN.
1355 The function FN should have the same arity as the number of
1358 The outer product is computed by applying fn to all possible
1359 combinations created by taking one element from each list in
1360 order. The dimension of the result is (length lists).
1362 See also: `-table-flat'"
1363 (let ((restore-lists (copy-sequence lists))
1364 (last-list (last lists))
1365 (re (make-list (length lists) nil)))
1366 (while (car last-list)
1367 (let ((item (apply fn (-map 'car lists))))
1368 (push item (car re))
1369 (setcar lists (cdar lists)) ;; silence byte compiler
1370 (dash--table-carry lists restore-lists re)))
1371 (nreverse (car (last re)))))
1373 (defun -table-flat (fn &rest lists)
1374 "Compute flat outer product of LISTS using function FN.
1376 The function FN should have the same arity as the number of
1379 The outer product is computed by applying fn to all possible
1380 combinations created by taking one element from each list in
1381 order. The results are flattened, ignoring the tensor structure
1382 of the result. This is equivalent to calling:
1384 (-flatten-n (1- (length lists)) (apply \\='-table fn lists))
1386 but the implementation here is much more efficient.
1388 See also: `-flatten-n', `-table'"
1389 (let ((restore-lists (copy-sequence lists))
1390 (last-list (last lists))
1392 (while (car last-list)
1393 (let ((item (apply fn (-map 'car lists))))
1395 (setcar lists (cdar lists)) ;; silence byte compiler
1396 (dash--table-carry lists restore-lists)))
1399 (defun -partial (fn &rest args)
1400 "Take a function FN and fewer than the normal arguments to FN,
1401 and return a fn that takes a variable number of additional ARGS.
1402 When called, the returned function calls FN with ARGS first and
1403 then additional args."
1404 (apply 'apply-partially fn args))
1406 (defun -elem-index (elem list)
1407 "Return the index of the first element in the given LIST which
1408 is equal to the query element ELEM, or nil if there is no
1410 (declare (pure t) (side-effect-free t))
1411 (car (-elem-indices elem list)))
1413 (defun -elem-indices (elem list)
1414 "Return the indices of all elements in LIST equal to the query
1415 element ELEM, in ascending order."
1416 (declare (pure t) (side-effect-free t))
1417 (-find-indices (-partial 'equal elem) list))
1419 (defun -find-indices (pred list)
1420 "Return the indices of all elements in LIST satisfying the
1421 predicate PRED, in ascending order."
1422 (apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list)))
1424 (defmacro --find-indices (form list)
1425 "Anaphoric version of `-find-indices'."
1426 (declare (debug (form form)))
1427 `(-find-indices (lambda (it) ,form) ,list))
1429 (defun -find-index (pred list)
1430 "Take a predicate PRED and a LIST and return the index of the
1431 first element in the list satisfying the predicate, or nil if
1432 there is no such element.
1435 (car (-find-indices pred list)))
1437 (defmacro --find-index (form list)
1438 "Anaphoric version of `-find-index'."
1439 (declare (debug (form form)))
1440 `(-find-index (lambda (it) ,form) ,list))
1442 (defun -find-last-index (pred list)
1443 "Take a predicate PRED and a LIST and return the index of the
1444 last element in the list satisfying the predicate, or nil if
1445 there is no such element.
1448 (-last-item (-find-indices pred list)))
1450 (defmacro --find-last-index (form list)
1451 "Anaphoric version of `-find-last-index'."
1452 `(-find-last-index (lambda (it) ,form) ,list))
1454 (defun -select-by-indices (indices list)
1455 "Return a list whose elements are elements from LIST selected
1456 as `(nth i list)` for all i from INDICES."
1457 (declare (pure t) (side-effect-free t))
1460 (!cons (nth it list) r))
1463 (defun -select-columns (columns table)
1464 "Select COLUMNS from TABLE.
1466 TABLE is a list of lists where each element represents one row.
1467 It is assumed each row has the same length.
1469 Each row is transformed such that only the specified COLUMNS are
1472 See also: `-select-column', `-select-by-indices'"
1473 (declare (pure t) (side-effect-free t))
1474 (--map (-select-by-indices columns it) table))
1476 (defun -select-column (column table)
1477 "Select COLUMN from TABLE.
1479 TABLE is a list of lists where each element represents one row.
1480 It is assumed each row has the same length.
1482 The single selected column is returned as a list.
1484 See also: `-select-columns', `-select-by-indices'"
1485 (declare (pure t) (side-effect-free t))
1486 (--mapcat (-select-by-indices (list column) it) table))
1488 (defmacro -> (x &optional form &rest more)
1489 "Thread the expr through the forms. Insert X as the second item
1490 in the first form, making a list of it if it is not a list
1491 already. If there are more forms, insert the first form as the
1492 second item in second form, etc."
1493 (declare (debug (form &rest [&or symbolp (sexp &rest form)])))
1496 ((null more) (if (listp form)
1497 `(,(car form) ,x ,@(cdr form))
1499 (:else `(-> (-> ,x ,form) ,@more))))
1501 (defmacro ->> (x &optional form &rest more)
1502 "Thread the expr through the forms. Insert X as the last item
1503 in the first form, making a list of it if it is not a list
1504 already. If there are more forms, insert the first form as the
1505 last item in second form, etc."
1506 (declare (debug ->))
1509 ((null more) (if (listp form)
1512 (:else `(->> (->> ,x ,form) ,@more))))
1514 (defmacro --> (x &rest forms)
1515 "Starting with the value of X, thread each expression through FORMS.
1517 Insert X at the position signified by the symbol `it' in the first
1518 form. If there are more forms, insert the first form at the position
1519 signified by `it' in in second form, etc."
1520 (declare (debug (form body)))
1521 `(-as-> ,x it ,@forms))
1523 (defmacro -as-> (value variable &rest forms)
1524 "Starting with VALUE, thread VARIABLE through FORMS.
1526 In the first form, bind VARIABLE to VALUE. In the second form, bind
1527 VARIABLE to the result of the first form, and so forth."
1528 (declare (debug (form symbolp body)))
1531 `(let ((,variable ,value))
1532 (-as-> ,(if (symbolp (car forms))
1533 (list (car forms) variable)
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 ->))
1543 (let ((result (make-symbol "result")))
1544 `(-some-> (-when-let (,result ,x)
1548 (defmacro -some->> (x &optional form &rest more)
1549 "When expr is 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 ->))
1553 (let ((result (make-symbol "result")))
1554 `(-some->> (-when-let (,result ,x)
1555 (->> ,result ,form))
1558 (defmacro -some--> (x &optional form &rest more)
1559 "When expr in non-nil, thread it through the first form (via `-->'),
1560 and when that result is non-nil, through the next form, etc."
1561 (declare (debug ->))
1563 (let ((result (make-symbol "result")))
1564 `(-some--> (-when-let (,result ,x)
1565 (--> ,result ,form))
1568 (defun -grade-up (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 ascending order."
1572 ;; ugly hack to "fix" lack of lexical scope
1573 (let ((comp `(lambda (it other) (funcall ',comparator (car it) (car other)))))
1574 (->> (--map-indexed (cons it it-index) list)
1578 (defun -grade-down (comparator list)
1579 "Grade elements of LIST using COMPARATOR relation, yielding a
1580 permutation vector such that applying this permutation to LIST
1581 sorts it in descending order."
1582 ;; ugly hack to "fix" lack of lexical scope
1583 (let ((comp `(lambda (it other) (funcall ',comparator (car other) (car it)))))
1584 (->> (--map-indexed (cons it it-index) list)
1588 (defvar dash--source-counter 0
1589 "Monotonic counter for generated symbols.")
1591 (defun dash--match-make-source-symbol ()
1592 "Generate a new dash-source symbol.
1594 All returned symbols are guaranteed to be unique."
1595 (prog1 (make-symbol (format "--dash-source-%d--" dash--source-counter))
1596 (setq dash--source-counter (1+ dash--source-counter))))
1598 (defun dash--match-ignore-place-p (symbol)
1599 "Return non-nil if SYMBOL is a symbol and starts with _."
1600 (and (symbolp symbol)
1601 (eq (aref (symbol-name symbol) 0) ?_)))
1603 (defun dash--match-cons-skip-cdr (skip-cdr source)
1604 "Helper function generating idiomatic shifting code."
1609 `(prog1 ,(dash--match-cons-get-car skip-cdr source)
1610 (setq ,source ,(dash--match-cons-get-cdr (1+ skip-cdr) source))))))
1612 (defun dash--match-cons-get-car (skip-cdr source)
1613 "Helper function generating idiomatic code to get nth car."
1620 `(nth ,skip-cdr ,source))))
1622 (defun dash--match-cons-get-cdr (skip-cdr source)
1623 "Helper function generating idiomatic code to get nth cdr."
1630 `(nthcdr ,skip-cdr ,source))))
1632 (defun dash--match-cons (match-form source)
1633 "Setup a cons matching environment and call the real matcher."
1634 (let ((s (dash--match-make-source-symbol))
1637 (while (and (consp m)
1638 (dash--match-ignore-place-p (car m)))
1639 (setq n (1+ n)) (!cdr m))
1641 ;; when we only have one pattern in the list, we don't have to
1642 ;; create a temporary binding (--dash-source--) for the source
1643 ;; and just use the input directly
1646 (dash--match (car m) (dash--match-cons-get-car n source)))
1647 ;; handle other special types
1649 (dash--match m (dash--match-cons-get-cdr n source)))
1650 ;; this is the only entry-point for dash--match-cons-1, that's
1651 ;; why we can't simply use the above branch, it would produce
1652 ;; infinite recursion
1654 (cons (list s source) (dash--match-cons-1 match-form s))))))
1656 (defun dash--get-expand-function (type)
1657 "Get expand function name for TYPE."
1658 (intern (format "dash-expand:%s" type)))
1660 (defun dash--match-cons-1 (match-form source &optional props)
1661 "Match MATCH-FORM against SOURCE.
1663 MATCH-FORM is a proper or improper list. Each element of
1664 MATCH-FORM is either a symbol, which gets bound to the respective
1665 value in source or another match form which gets destructured
1668 If the cdr of last cons cell in the list is `nil', matching stops
1671 SOURCE is a proper or improper list."
1672 (let ((skip-cdr (or (plist-get props :skip-cdr) 0)))
1678 ((and (symbolp (car match-form))
1679 (functionp (dash--get-expand-function (car match-form))))
1680 (dash--match-kv (dash--match-kv-normalize-match-form match-form) (dash--match-cons-get-cdr skip-cdr source)))
1681 ((dash--match-ignore-place-p (car match-form))
1682 (dash--match-cons-1 (cdr match-form) source
1683 (plist-put props :skip-cdr (1+ skip-cdr))))
1685 (-concat (dash--match (car match-form) (dash--match-cons-skip-cdr skip-cdr source))
1686 (dash--match-cons-1 (cdr match-form) source)))))
1687 (t ;; Last matching place, no need for shift
1688 (dash--match (car match-form) (dash--match-cons-get-car skip-cdr source)))))
1689 ((eq match-form nil)
1691 (t ;; Handle improper lists. Last matching place, no need for shift
1692 (dash--match match-form (dash--match-cons-get-cdr skip-cdr source))))))
1694 (defun dash--vector-tail (seq start)
1695 "Return the tail of SEQ starting at START."
1698 (let* ((re-length (- (length seq) start))
1699 (re (make-vector re-length 0)))
1700 (--dotimes re-length (aset re it (aref seq (+ it start))))
1703 (substring seq start))))
1705 (defun dash--match-vector (match-form source)
1706 "Setup a vector matching environment and call the real matcher."
1707 (let ((s (dash--match-make-source-symbol)))
1709 ;; don't bind `s' if we only have one sub-pattern
1710 ((= (length match-form) 1)
1711 (dash--match (aref match-form 0) `(aref ,source 0)))
1712 ;; if the source is a symbol, we don't need to re-bind it
1714 (dash--match-vector-1 match-form source))
1715 ;; don't bind `s' if we only have one sub-pattern which is not ignored
1716 ((let* ((ignored-places (mapcar 'dash--match-ignore-place-p match-form))
1717 (ignored-places-n (length (-remove 'null ignored-places))))
1718 (when (= ignored-places-n (1- (length match-form)))
1719 (let ((n (-find-index 'null ignored-places)))
1720 (dash--match (aref match-form n) `(aref ,source ,n))))))
1722 (cons (list s source) (dash--match-vector-1 match-form s))))))
1724 (defun dash--match-vector-1 (match-form source)
1725 "Match MATCH-FORM against SOURCE.
1727 MATCH-FORM is a vector. Each element of MATCH-FORM is either a
1728 symbol, which gets bound to the respective value in source or
1729 another match form which gets destructured recursively.
1731 If second-from-last place in MATCH-FORM is the symbol &rest, the
1732 next element of the MATCH-FORM is matched against the tail of
1733 SOURCE, starting at index of the &rest symbol. This is
1734 conceptually the same as the (head . tail) match for improper
1735 lists, where dot plays the role of &rest.
1739 If the MATCH-FORM vector is shorter than SOURCE vector, only
1740 the (length MATCH-FORM) places are bound, the rest of the SOURCE
1743 (l (length match-form))
1746 (let ((m (aref match-form i)))
1751 (aref match-form (1+ i))
1752 `(dash--vector-tail ,source ,i))
1755 ;; do not match symbols starting with _
1756 (not (eq (aref (symbol-name m) 0) ?_)))
1757 (list (list m `(aref ,source ,i))))
1759 (dash--match m `(aref ,source ,i))))
1762 (-flatten-n 1 (nreverse re))))
1764 (defun dash--match-kv-normalize-match-form (pattern)
1765 "Normalize kv PATTERN.
1767 This method normalizes PATTERN to the format expected by
1768 `dash--match-kv'. See `-let' for the specification."
1769 (let ((normalized (list (car pattern)))
1771 (fill-placeholder (make-symbol "--dash-fill-placeholder--")))
1772 (-each (apply '-zip (-pad fill-placeholder (cdr pattern) (cddr pattern)))
1774 (let ((current (car pair))
1778 (if (or (eq fill-placeholder next)
1779 (not (or (and (symbolp next)
1780 (not (keywordp next))
1782 (not (eq next nil)))
1784 (not (eq (car next) 'quote)))
1789 (push current normalized)
1790 (push (intern (substring (symbol-name current) 1)) normalized))
1792 (push current normalized)
1793 (push (intern current) normalized))
1794 ((and (consp current)
1795 (eq (car current) 'quote))
1796 (push current normalized)
1797 (push (cadr current) normalized))
1798 (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)))
1800 (push current normalized)
1801 (push next normalized)
1803 (nreverse normalized)))
1805 (defun dash--match-kv (match-form source)
1806 "Setup a kv matching environment and call the real matcher.
1808 kv can be any key-value store, such as plist, alist or hash-table."
1809 (let ((s (dash--match-make-source-symbol)))
1811 ;; don't bind `s' if we only have one sub-pattern (&type key val)
1812 ((= (length match-form) 3)
1813 (dash--match-kv-1 (cdr match-form) source (car match-form)))
1814 ;; if the source is a symbol, we don't need to re-bind it
1816 (dash--match-kv-1 (cdr match-form) source (car match-form)))
1818 (cons (list s source) (dash--match-kv-1 (cdr match-form) s (car match-form)))))))
1820 (defun dash-expand:&hash (key source)
1821 "Generate extracting KEY from SOURCE for &hash destructuring."
1822 `(gethash ,key ,source))
1824 (defun dash-expand:&plist (key source)
1825 "Generate extracting KEY from SOURCE for &plist destructuring."
1826 `(plist-get ,source ,key))
1828 (defun dash-expand:&alist (key source)
1829 "Generate extracting KEY from SOURCE for &alist destructuring."
1830 `(cdr (assoc ,key ,source)))
1832 (defun dash-expand:&hash? (key source)
1833 "Generate extracting KEY from SOURCE for &hash? destructuring.
1834 Similar to &hash but check whether the map is not nil."
1835 (let ((src (make-symbol "src")))
1836 `(let ((,src ,source))
1837 (when ,src (gethash ,key ,src)))))
1839 (defalias 'dash-expand:&keys 'dash-expand:&plist)
1841 (defun dash--match-kv-1 (match-form source type)
1842 "Match MATCH-FORM against SOURCE of type TYPE.
1844 MATCH-FORM is a proper list of the form (key1 place1 ... keyN
1845 placeN). Each placeK is either a symbol, which gets bound to the
1846 value of keyK retrieved from the key-value store, or another
1847 match form which gets destructured recursively.
1849 SOURCE is a key-value store of type TYPE, which can be a plist,
1850 an alist or a hash table.
1852 TYPE is a token specifying the type of the key-value store.
1853 Valid values are &plist, &alist and &hash."
1859 (funcall (dash--get-expand-function type) k source)))
1862 (list (list v getter)))
1863 (t (dash--match v getter)))))
1864 (-partition 2 match-form))))
1866 (defun dash--match-symbol (match-form source)
1869 This works just like `let', there is no destructuring."
1870 (list (list match-form source)))
1872 (defun dash--match (match-form source)
1873 "Match MATCH-FORM against SOURCE.
1875 This function tests the MATCH-FORM and dispatches to specific
1876 matchers based on the type of the expression.
1878 Key-value stores are disambiguated by placing a token &plist,
1879 &alist or &hash as a first item in the MATCH-FORM."
1881 ((symbolp match-form)
1882 (dash--match-symbol match-form source))
1885 ;; Handle the "x &as" bindings first.
1886 ((and (consp (cdr match-form))
1887 (symbolp (car match-form))
1888 (eq '&as (cadr match-form)))
1889 (let ((s (car match-form)))
1890 (cons (list s source)
1891 (dash--match (cddr match-form) s))))
1892 ((functionp (dash--get-expand-function (car match-form)))
1893 (dash--match-kv (dash--match-kv-normalize-match-form match-form) source))
1894 (t (dash--match-cons match-form source))))
1895 ((vectorp match-form)
1896 ;; We support the &as binding in vectors too
1898 ((and (> (length match-form) 2)
1899 (symbolp (aref match-form 0))
1900 (eq '&as (aref match-form 1)))
1901 (let ((s (aref match-form 0)))
1902 (cons (list s source)
1903 (dash--match (dash--vector-tail match-form 2) s))))
1904 (t (dash--match-vector match-form source))))))
1906 (defun dash--normalize-let-varlist (varlist)
1907 "Normalize VARLIST so that every binding is a list.
1909 `let' allows specifying a binding which is not a list but simply
1910 the place which is then automatically bound to nil, such that all
1911 three of the following are identical and evaluate to nil.
1917 This function normalizes all of these to the last form."
1918 (--map (if (consp it) it (list it nil)) varlist))
1920 (defmacro -let* (varlist &rest body)
1921 "Bind variables according to VARLIST then eval BODY.
1923 VARLIST is a list of lists of the form (PATTERN SOURCE). Each
1924 PATTERN is matched against the SOURCE structurally. SOURCE is
1925 only evaluated once for each PATTERN.
1927 Each SOURCE can refer to the symbols already bound by this
1928 VARLIST. This is useful if you want to destructure SOURCE
1929 recursively but also want to name the intermediate structures.
1931 See `-let' for the list of all possible patterns."
1932 (declare (debug ((&rest [&or (sexp form) sexp]) body))
1934 (let* ((varlist (dash--normalize-let-varlist varlist))
1935 (bindings (--mapcat (dash--match (car it) (cadr it)) varlist)))
1939 (defmacro -let (varlist &rest body)
1940 "Bind variables according to VARLIST then eval BODY.
1942 VARLIST is a list of lists of the form (PATTERN SOURCE). Each
1943 PATTERN is matched against the SOURCE \"structurally\". SOURCE
1944 is only evaluated once for each PATTERN. Each PATTERN is matched
1945 recursively, and can therefore contain sub-patterns which are
1946 matched against corresponding sub-expressions of SOURCE.
1948 All the SOURCEs are evalled before any symbols are
1949 bound (i.e. \"in parallel\").
1951 If VARLIST only contains one (PATTERN SOURCE) element, you can
1952 optionally specify it using a vector and discarding the
1953 outer-most parens. Thus
1955 (-let ((PATTERN SOURCE)) ..)
1959 (-let [PATTERN SOURCE] ..).
1961 `-let' uses a convention of not binding places (symbols) starting
1962 with _ whenever it's possible. You can use this to skip over
1963 entries you don't care about. However, this is not *always*
1964 possible (as a result of implementation) and these symbols might
1965 get bound to undefined values.
1967 Following is the overview of supported patterns. Remember that
1968 patterns can be matched recursively, so every a, b, aK in the
1969 following can be a matching construct and not necessarily a
1974 a - bind the SOURCE to A. This is just like regular `let'.
1978 (a) - bind `car' of cons/list to A
1980 (a . b) - bind car of cons to A and `cdr' to B
1982 (a b) - bind car of list to A and `cadr' to B
1984 (a1 a2 a3 ...) - bind 0th car of list to A1, 1st to A2, 2nd to A3 ...
1986 (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST.
1990 [a] - bind 0th element of a non-list sequence to A (works with
1991 vectors, strings, bit arrays...)
1993 [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st to
1995 If the PATTERN is shorter than SOURCE, the values at
1996 places not in PATTERN are ignored.
1997 If the PATTERN is longer than SOURCE, an `error' is
2000 [a1 a2 a3 ... &rest rest] - as above, but bind the rest of
2001 the sequence to REST. This is
2002 conceptually the same as improper list
2003 matching (a1 a2 ... aN . rest)
2007 (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the
2008 SOURCE plist to aK. If the
2009 value is not found, aK is nil.
2010 Uses `plist-get' to fetch values.
2012 (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the
2013 SOURCE alist to aK. If the
2014 value is not found, aK is nil.
2015 Uses `assoc' to fetch values.
2017 (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the
2018 SOURCE hash table to aK. If the
2019 value is not found, aK is nil.
2020 Uses `gethash' to fetch values.
2022 Further, special keyword &keys supports \"inline\" matching of
2023 plist-like key-value pairs, similarly to &keys keyword of
2026 (a1 a2 ... aN &keys key1 b1 ... keyN bK)
2028 This binds N values from the list to a1 ... aN, then interprets
2029 the cdr as a plist (see key/value matching above).
2031 A shorthand notation for kv-destructuring exists which allows the
2032 patterns be optionally left out and derived from the key name in
2033 the following fashion:
2035 - a key :foo is converted into `foo' pattern,
2036 - a key 'bar is converted into `bar' pattern,
2037 - a key \"baz\" is converted into `baz' pattern.
2039 That is, the entire value under the key is bound to the derived
2040 variable without any further destructuring.
2042 This is possible only when the form following the key is not a
2043 valid pattern (i.e. not a symbol, a cons cell or a vector).
2044 Otherwise the matching proceeds as usual and in case of an
2045 invalid spec fails with an error.
2047 Thus the patterns are normalized as follows:
2049 ;; derive all the missing patterns
2050 (&plist :foo 'bar \"baz\") => (&plist :foo foo 'bar bar \"baz\" baz)
2052 ;; we can specify some but not others
2053 (&plist :foo 'bar explicit-bar) => (&plist :foo foo 'bar explicit-bar)
2055 ;; nothing happens, we store :foo in x
2056 (&plist :foo x) => (&plist :foo x)
2058 ;; nothing happens, we match recursively
2059 (&plist :foo (a b c)) => (&plist :foo (a b c))
2061 You can name the source using the syntax SYMBOL &as PATTERN.
2062 This syntax works with lists (proper or improper), vectors and
2065 (list &as a b c) (list 1 2 3)
2067 binds A to 1, B to 2, C to 3 and LIST to (1 2 3).
2071 (bounds &as beg . end) (cons 1 2)
2073 binds BEG to 1, END to 2 and BOUNDS to (1 . 2).
2075 (items &as first . rest) (list 1 2 3)
2077 binds FIRST to 1, REST to (2 3) and ITEMS to (1 2 3)
2079 [vect &as _ b c] [1 2 3]
2081 binds B to 2, C to 3 and VECT to [1 2 3] (_ avoids binding as usual).
2083 (plist &as &plist :b b) (list :a 1 :b 2 :c 3)
2085 binds B to 2 and PLIST to (:a 1 :b 2 :c 3). Same for &alist and &hash.
2087 This is especially useful when we want to capture the result of a
2088 computation and destructure at the same time. Consider the
2089 form (function-returning-complex-structure) returning a list of
2090 two vectors with two items each. We want to capture this entire
2091 result and pass it to another computation, but at the same time
2092 we want to get the second item from each vector. We can achieve
2095 (result &as [_ a] [_ b]) (function-returning-complex-structure)
2097 Note: Clojure programmers may know this feature as the \":as
2098 binding\". The difference is that we put the &as at the front
2099 because we need to support improper list binding."
2100 (declare (debug ([&or (&rest [&or (sexp form) sexp])
2101 (vector [&rest [sexp form]])]
2104 (if (vectorp varlist)
2105 `(let* ,(dash--match (aref varlist 0) (aref varlist 1))
2107 (let* ((varlist (dash--normalize-let-varlist varlist))
2108 (inputs (--map-indexed (list (make-symbol (format "input%d" it-index)) (cadr it)) varlist))
2109 (new-varlist (--map (list (caar it) (cadr it)) (-zip varlist inputs))))
2111 (-let* ,new-varlist ,@body)))))
2113 (defmacro -lambda (match-form &rest body)
2114 "Return a lambda which destructures its input as MATCH-FORM and executes BODY.
2116 Note that you have to enclose the MATCH-FORM in a pair of parens,
2120 (-lambda (x y ...) body)
2122 has the usual semantics of `lambda'. Furthermore, these get
2123 translated into normal lambda, so there is no performance
2126 See `-let' for the description of destructuring mechanism."
2127 (declare (doc-string 2) (indent defun)
2128 (debug (&define sexp
2130 [&optional ("interactive" interactive)]
2133 ((not (consp match-form))
2134 (signal 'wrong-type-argument "match-form must be a list"))
2135 ;; no destructuring, so just return regular lambda to make things faster
2136 ((-all? 'symbolp match-form)
2137 `(lambda ,match-form ,@body))
2139 (let* ((inputs (--map-indexed (list it (make-symbol (format "input%d" it-index))) match-form)))
2140 ;; TODO: because inputs to the lambda are evaluated only once,
2141 ;; -let* need not to create the extra bindings to ensure that.
2142 ;; We should find a way to optimize that. Not critical however.
2143 `(lambda ,(--map (cadr it) inputs)
2144 (-let* ,inputs ,@body))))))
2146 (defmacro -setq (&rest forms)
2147 "Bind each MATCH-FORM to the value of its VAL.
2149 MATCH-FORM destructuring is done according to the rules of `-let'.
2151 This macro allows you to bind multiple variables by destructuring
2152 the value, so for example:
2155 (&plist :c c) plist)
2157 expands roughly speaking to the following code
2161 c (plist-get plist :c))
2163 Care is taken to only evaluate each VAL once so that in case of
2164 multiple assignments it does not cause unexpected side effects.
2166 \(fn [MATCH-FORM VAL]...)"
2167 (declare (debug (&rest sexp form))
2169 (when (= (mod (length forms) 2) 1)
2170 (error "Odd number of arguments"))
2171 (let* ((forms-and-sources
2172 ;; First get all the necessary mappings with all the
2173 ;; intermediate bindings.
2174 (-map (lambda (x) (dash--match (car x) (cadr x)))
2175 (-partition 2 forms)))
2176 ;; To preserve the logic of dynamic scoping we must ensure
2177 ;; that we `setq' the variables outside of the `let*' form
2178 ;; which holds the destructured intermediate values. For
2179 ;; this we generate for each variable a placeholder which is
2180 ;; bound to (lexically) the result of the destructuring.
2181 ;; Then outside of the helper `let*' form we bind all the
2182 ;; original variables to their respective placeholders.
2183 ;; TODO: There is a lot of room for possible optimization,
2184 ;; for start playing with `special-variable-p' to eliminate
2185 ;; unnecessary re-binding.
2186 (variables-to-placeholders
2191 (let ((var (car binding)))
2192 (list var (make-symbol (concat "--dash-binding-" (symbol-name var) "--")))))
2193 (--filter (not (string-prefix-p "--" (symbol-name (car it)))) bindings)))
2194 forms-and-sources)))
2195 `(let ,(-map 'cadr variables-to-placeholders)
2196 (let* ,(-flatten-n 1 forms-and-sources)
2197 (setq ,@(-flatten (-map 'reverse variables-to-placeholders))))
2198 (setq ,@(-flatten variables-to-placeholders)))))
2200 (defmacro -if-let* (vars-vals then &rest else)
2201 "If all VALS evaluate to true, bind them to their corresponding
2202 VARS and do THEN, otherwise do ELSE. VARS-VALS should be a list
2205 Note: binding is done according to `-let*'. VALS are evaluated
2206 sequentially, and evaluation stops after the first nil VAL is
2208 (declare (debug ((&rest (sexp form)) form body))
2211 (--mapcat (dash--match (car it) (cadr it)))
2213 (let ((var (car it))
2216 (if ,var ,acc ,@else)))
2219 (defmacro -if-let (var-val then &rest else)
2220 "If VAL evaluates to non-nil, bind it to VAR and do THEN,
2223 Note: binding is done according to `-let'.
2225 \(fn (VAR VAL) THEN &rest ELSE)"
2226 (declare (debug ((sexp form) form body))
2228 `(-if-let* (,var-val) ,then ,@else))
2230 (defmacro --if-let (val then &rest else)
2231 "If VAL evaluates to non-nil, bind it to symbol `it' and do THEN,
2233 (declare (debug (form form body))
2235 `(-if-let (it ,val) ,then ,@else))
2237 (defmacro -when-let* (vars-vals &rest body)
2238 "If all VALS evaluate to true, bind them to their corresponding
2239 VARS and execute body. VARS-VALS should be a list of (VAR VAL)
2242 Note: binding is done according to `-let*'. VALS are evaluated
2243 sequentially, and evaluation stops after the first nil VAL is
2245 (declare (debug ((&rest (sexp form)) body))
2247 `(-if-let* ,vars-vals (progn ,@body)))
2249 (defmacro -when-let (var-val &rest body)
2250 "If VAL evaluates to non-nil, bind it to VAR and execute body.
2252 Note: binding is done according to `-let'.
2254 \(fn (VAR VAL) &rest BODY)"
2255 (declare (debug ((sexp form) body))
2257 `(-if-let ,var-val (progn ,@body)))
2259 (defmacro --when-let (val &rest body)
2260 "If VAL evaluates to non-nil, bind it to symbol `it' and
2262 (declare (debug (form body))
2264 `(--if-let ,val (progn ,@body)))
2266 (defvar -compare-fn nil
2267 "Tests for equality use this function or `equal' if this is nil.
2268 It should only be set using dynamic scope with a let, like:
2270 (let ((-compare-fn #\\='=)) (-union numbers1 numbers2 numbers3)")
2272 (defun -distinct (list)
2273 "Return a new list with all duplicates removed.
2274 The test for equality is done with `equal',
2275 or with `-compare-fn' if that's non-nil.
2279 (--each list (unless (-contains? result it) (!cons it result)))
2282 (defalias '-uniq '-distinct)
2284 (defun -union (list list2)
2285 "Return a new list containing the elements of LIST and elements of LIST2 that are not in LIST.
2286 The test for equality is done with `equal',
2287 or with `-compare-fn' if that's non-nil."
2288 ;; We fall back to iteration implementation if the comparison
2289 ;; function isn't one of `eq', `eql' or `equal'.
2290 (let* ((result (reverse list))
2291 ;; TODO: get rid of this dynamic variable, pass it as an
2292 ;; argument instead.
2293 (-compare-fn (if (bound-and-true-p -compare-fn)
2296 (if (memq -compare-fn '(eq eql equal))
2297 (let ((ht (make-hash-table :test -compare-fn)))
2298 (--each list (puthash it t ht))
2299 (--each list2 (unless (gethash it ht) (!cons it result))))
2300 (--each list2 (unless (-contains? result it) (!cons it result))))
2303 (defun -intersection (list list2)
2304 "Return a new list containing only the elements that are members of both LIST and LIST2.
2305 The test for equality is done with `equal',
2306 or with `-compare-fn' if that's non-nil."
2307 (--filter (-contains? list2 it) list))
2309 (defun -difference (list list2)
2310 "Return a new list with only the members of LIST that are not in LIST2.
2311 The test for equality is done with `equal',
2312 or with `-compare-fn' if that's non-nil."
2313 (--filter (not (-contains? list2 it)) list))
2315 (defun -powerset (list)
2316 "Return the power set of LIST."
2317 (if (null list) '(())
2318 (let ((last (-powerset (cdr list))))
2319 (append (mapcar (lambda (x) (cons (car list) x)) last)
2322 (defun -permutations (list)
2323 "Return the permutations of LIST."
2324 (if (null list) '(())
2327 (mapcar (lambda (perm) (cons x perm))
2328 (-permutations (remove x list))))
2331 (defun -inits (list)
2332 "Return all prefixes of LIST."
2333 (nreverse (-map 'reverse (-tails (nreverse list)))))
2335 (defun -tails (list)
2336 "Return all suffixes of LIST"
2337 (-reductions-r-from 'cons nil list))
2339 (defun -common-prefix (&rest lists)
2340 "Return the longest common prefix of LISTS."
2341 (declare (pure t) (side-effect-free t))
2342 (--reduce (--take-while (and acc (equal (pop acc) it)) it)
2345 (defun -common-suffix (&rest lists)
2346 "Return the longest common suffix of LISTS."
2347 (nreverse (apply #'-common-prefix (mapcar #'reverse lists))))
2349 (defun -contains? (list element)
2350 "Return non-nil if LIST contains ELEMENT.
2352 The test for equality is done with `equal', or with `-compare-fn'
2355 Alias: `-contains-p'"
2359 ((null -compare-fn) (member element list))
2360 ((eq -compare-fn 'eq) (memq element list))
2361 ((eq -compare-fn 'eql) (memql element list))
2365 (not (funcall -compare-fn element (car lst))))
2366 (setq lst (cdr lst)))
2369 (defalias '-contains-p '-contains?)
2371 (defun -same-items? (list list2)
2372 "Return true if LIST and LIST2 has the same items.
2374 The order of the elements in the lists does not matter.
2376 Alias: `-same-items-p'"
2377 (let ((length-a (length list))
2378 (length-b (length list2)))
2380 (= length-a length-b)
2381 (= length-a (length (-intersection list list2))))))
2383 (defalias '-same-items-p '-same-items?)
2385 (defun -is-prefix? (prefix list)
2386 "Return non-nil if PREFIX is prefix of LIST.
2388 Alias: `-is-prefix-p'"
2389 (declare (pure t) (side-effect-free t))
2390 (--each-while list (equal (car prefix) it)
2394 (defun -is-suffix? (suffix list)
2395 "Return non-nil if SUFFIX is suffix of LIST.
2397 Alias: `-is-suffix-p'"
2398 (declare (pure t) (side-effect-free t))
2399 (-is-prefix? (reverse suffix) (reverse list)))
2401 (defun -is-infix? (infix list)
2402 "Return non-nil if INFIX is infix of LIST.
2404 This operation runs in O(n^2) time
2406 Alias: `-is-infix-p'"
2407 (declare (pure t) (side-effect-free t))
2409 (while (and (not done) list)
2410 (setq done (-is-prefix? infix list))
2414 (defalias '-is-prefix-p '-is-prefix?)
2415 (defalias '-is-suffix-p '-is-suffix?)
2416 (defalias '-is-infix-p '-is-infix?)
2418 (defun -sort (comparator list)
2419 "Sort LIST, stably, comparing elements using COMPARATOR.
2420 Return the sorted list. LIST is NOT modified by side effects.
2421 COMPARATOR is called with two elements of LIST, and should return non-nil
2422 if the first element should sort before the second."
2423 (sort (copy-sequence list) comparator))
2425 (defmacro --sort (form list)
2426 "Anaphoric form of `-sort'."
2427 (declare (debug (form form)))
2428 `(-sort (lambda (it other) ,form) ,list))
2430 (defun -list (&rest args)
2431 "Return a list with ARGS.
2433 If first item of ARGS is already a list, simply return ARGS. If
2434 not, return a list with ARGS as elements."
2435 (declare (pure t) (side-effect-free t))
2436 (let ((arg (car args)))
2437 (if (listp arg) arg args)))
2439 (defun -repeat (n x)
2440 "Return a list with X repeated N times.
2441 Return nil if N is less than 1."
2442 (declare (pure t) (side-effect-free t))
2444 (--dotimes n (!cons x ret))
2448 "Return the sum of LIST."
2449 (declare (pure t) (side-effect-free t))
2452 (defun -running-sum (list)
2453 "Return a list with running sums of items in LIST.
2455 LIST must be non-empty."
2456 (declare (pure t) (side-effect-free t))
2457 (unless (consp list)
2458 (error "LIST must be non-empty"))
2459 (-reductions '+ list))
2461 (defun -product (list)
2462 "Return the product of LIST."
2463 (declare (pure t) (side-effect-free t))
2466 (defun -running-product (list)
2467 "Return a list with running products of items in LIST.
2469 LIST must be non-empty."
2470 (declare (pure t) (side-effect-free t))
2471 (unless (consp list)
2472 (error "LIST must be non-empty"))
2473 (-reductions '* list))
2476 "Return the largest value from LIST of numbers or markers."
2477 (declare (pure t) (side-effect-free t))
2481 "Return the smallest value from LIST of numbers or markers."
2482 (declare (pure t) (side-effect-free t))
2485 (defun -max-by (comparator list)
2486 "Take a comparison function COMPARATOR and a LIST and return
2487 the greatest element of the list by the comparison function.
2489 See also combinator `-on' which can transform the values before
2491 (--reduce (if (funcall comparator it acc) it acc) list))
2493 (defun -min-by (comparator list)
2494 "Take a comparison function COMPARATOR and a LIST and return
2495 the least element of the list by the comparison function.
2497 See also combinator `-on' which can transform the values before
2499 (--reduce (if (funcall comparator it acc) acc it) list))
2501 (defmacro --max-by (form list)
2502 "Anaphoric version of `-max-by'.
2504 The items for the comparator form are exposed as \"it\" and \"other\"."
2505 (declare (debug (form form)))
2506 `(-max-by (lambda (it other) ,form) ,list))
2508 (defmacro --min-by (form list)
2509 "Anaphoric version of `-min-by'.
2511 The items for the comparator form are exposed as \"it\" and \"other\"."
2512 (declare (debug (form form)))
2513 `(-min-by (lambda (it other) ,form) ,list))
2515 (defun -iterate (fun init n)
2516 "Return a list of iterated applications of FUN to INIT.
2518 This means a list of form:
2520 (init (fun init) (fun (fun init)) ...)
2522 N is the length of the returned list."
2524 (let ((r (list init)))
2526 (push (funcall fun (car r)) r))
2529 (defun -fix (fn list)
2530 "Compute the (least) fixpoint of FN with initial input LIST.
2532 FN is called at least once, results are compared with `equal'."
2533 (let ((re (funcall fn list)))
2534 (while (not (equal list re))
2536 (setq re (funcall fn re)))
2539 (defmacro --fix (form list)
2540 "Anaphoric form of `-fix'."
2541 `(-fix (lambda (it) ,form) ,list))
2543 (defun -unfold (fun seed)
2544 "Build a list from SEED using FUN.
2546 This is \"dual\" operation to `-reduce-r': while -reduce-r
2547 consumes a list to produce a single value, `-unfold' takes a
2548 seed value and builds a (potentially infinite!) list.
2550 FUN should return `nil' to stop the generating process, or a
2551 cons (A . B), where A will be prepended to the result and B is
2553 (let ((last (funcall fun seed)) r)
2556 (setq last (funcall fun (cdr last))))
2559 (defmacro --unfold (form seed)
2560 "Anaphoric version of `-unfold'."
2561 (declare (debug (form form)))
2562 `(-unfold (lambda (it) ,form) ,seed))
2564 (defun -cons-pair? (con)
2565 "Return non-nil if CON is true cons pair.
2566 That is (A . B) where B is not a list.
2568 Alias: `-cons-pair-p'"
2569 (declare (pure t) (side-effect-free t))
2571 (not (listp (cdr con)))))
2573 (defalias '-cons-pair-p '-cons-pair?)
2575 (defun -cons-to-list (con)
2576 "Convert a cons pair to a list with `car' and `cdr' of the pair respectively."
2577 (declare (pure t) (side-effect-free t))
2578 (list (car con) (cdr con)))
2580 (defun -value-to-list (val)
2581 "Convert a value to a list.
2583 If the value is a cons pair, make a list with two elements, `car'
2584 and `cdr' of the pair respectively.
2586 If the value is anything else, wrap it in a list."
2587 (declare (pure t) (side-effect-free t))
2589 ((-cons-pair? val) (-cons-to-list val))
2592 (defun -tree-mapreduce-from (fn folder init-value tree)
2593 "Apply FN to each element of TREE, and make a list of the results.
2594 If elements of TREE are lists themselves, apply FN recursively to
2595 elements of these nested lists.
2597 Then reduce the resulting lists using FOLDER and initial value
2598 INIT-VALUE. See `-reduce-r-from'.
2600 This is the same as calling `-tree-reduce-from' after `-tree-map'
2601 but is twice as fast as it only traverse the structure once."
2604 ((-cons-pair? tree) (funcall fn tree))
2606 (-reduce-r-from folder init-value (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree)))
2607 (t (funcall fn tree))))
2609 (defmacro --tree-mapreduce-from (form folder init-value tree)
2610 "Anaphoric form of `-tree-mapreduce-from'."
2611 (declare (debug (form form form form)))
2612 `(-tree-mapreduce-from (lambda (it) ,form) (lambda (it acc) ,folder) ,init-value ,tree))
2614 (defun -tree-mapreduce (fn folder tree)
2615 "Apply FN to each element of TREE, and make a list of the results.
2616 If elements of TREE are lists themselves, apply FN recursively to
2617 elements of these nested lists.
2619 Then reduce the resulting lists using FOLDER and initial value
2620 INIT-VALUE. See `-reduce-r-from'.
2622 This is the same as calling `-tree-reduce' after `-tree-map'
2623 but is twice as fast as it only traverse the structure once."
2626 ((-cons-pair? tree) (funcall fn tree))
2628 (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree)))
2629 (t (funcall fn tree))))
2631 (defmacro --tree-mapreduce (form folder tree)
2632 "Anaphoric form of `-tree-mapreduce'."
2633 (declare (debug (form form form)))
2634 `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree))
2636 (defun -tree-map (fn tree)
2637 "Apply FN to each element of TREE while preserving the tree structure."
2640 ((-cons-pair? tree) (funcall fn tree))
2642 (mapcar (lambda (x) (-tree-map fn x)) tree))
2643 (t (funcall fn tree))))
2645 (defmacro --tree-map (form tree)
2646 "Anaphoric form of `-tree-map'."
2647 (declare (debug (form form)))
2648 `(-tree-map (lambda (it) ,form) ,tree))
2650 (defun -tree-reduce-from (fn init-value tree)
2651 "Use FN to reduce elements of list TREE.
2652 If elements of TREE are lists themselves, apply the reduction recursively.
2654 FN is first applied to INIT-VALUE and first element of the list,
2655 then on this result and second element from the list etc.
2657 The initial value is ignored on cons pairs as they always contain
2661 ((-cons-pair? tree) tree)
2663 (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree)))
2666 (defmacro --tree-reduce-from (form init-value tree)
2667 "Anaphoric form of `-tree-reduce-from'."
2668 (declare (debug (form form form)))
2669 `(-tree-reduce-from (lambda (it acc) ,form) ,init-value ,tree))
2671 (defun -tree-reduce (fn tree)
2672 "Use FN to reduce elements of list TREE.
2673 If elements of TREE are lists themselves, apply the reduction recursively.
2675 FN is first applied to first element of the list and second
2676 element, then on this result and third element from the list etc.
2678 See `-reduce-r' for how exactly are lists of zero or one element handled."
2681 ((-cons-pair? tree) tree)
2683 (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree)))
2686 (defmacro --tree-reduce (form tree)
2687 "Anaphoric form of `-tree-reduce'."
2688 (declare (debug (form form)))
2689 `(-tree-reduce (lambda (it acc) ,form) ,tree))
2691 (defun -tree-map-nodes (pred fun tree)
2692 "Call FUN on each node of TREE that satisfies PRED.
2694 If PRED returns nil, continue descending down this node. If PRED
2695 returns non-nil, apply FUN to this node and do not descend
2697 (if (funcall pred tree)
2699 (if (and (listp tree)
2700 (not (-cons-pair? tree)))
2701 (-map (lambda (x) (-tree-map-nodes pred fun x)) tree)
2704 (defmacro --tree-map-nodes (pred form tree)
2705 "Anaphoric form of `-tree-map-nodes'."
2706 `(-tree-map-nodes (lambda (it) ,pred) (lambda (it) ,form) ,tree))
2708 (defun -tree-seq (branch children tree)
2709 "Return a sequence of the nodes in TREE, in depth-first search order.
2711 BRANCH is a predicate of one argument that returns non-nil if the
2712 passed argument is a branch, that is, a node that can have children.
2714 CHILDREN is a function of one argument that returns the children
2715 of the passed branch node.
2717 Non-branch nodes are simply copied."
2719 (when (funcall branch tree)
2720 (-mapcat (lambda (x) (-tree-seq branch children x))
2721 (funcall children tree)))))
2723 (defmacro --tree-seq (branch children tree)
2724 "Anaphoric form of `-tree-seq'."
2725 `(-tree-seq (lambda (it) ,branch) (lambda (it) ,children) ,tree))
2727 (defun -clone (list)
2728 "Create a deep copy of LIST.
2729 The new list has the same elements and structure but all cons are
2730 replaced with new ones. This is useful when you need to clone a
2731 structure such as plist or alist."
2732 (declare (pure t) (side-effect-free t))
2733 (-tree-map 'identity list))
2735 (defun dash-enable-font-lock ()
2736 "Add syntax highlighting to dash functions, macros and magic values."
2737 (eval-after-load 'lisp-mode
2739 (let ((new-keywords '(
2762 "-reductions-r-from"
2874 "-remove-at-indices"
2882 "-partition-all-in-steps"
2883 "-partition-in-steps"
2886 "-partition-after-item"
2887 "-partition-after-pred"
2888 "-partition-before-item"
2889 "-partition-before-pred"
2892 "-partition-by-header"
2893 "--partition-by-header"
2919 "-select-by-indices"
2982 "-tree-mapreduce-from"
2983 "--tree-mapreduce-from"
2989 "--tree-reduce-from"
3010 (special-variables '(
3016 (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\_<" (regexp-opt special-variables 'paren) "\\_>")
3017 1 font-lock-variable-name-face)) 'append)
3018 (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "(\\s-*" (regexp-opt new-keywords 'paren) "\\_>")
3019 1 font-lock-keyword-face)) 'append))
3020 (--each (buffer-list)
3021 (with-current-buffer it
3022 (when (and (eq major-mode 'emacs-lisp-mode)
3023 (boundp 'font-lock-mode)
3025 (font-lock-refresh-defaults)))))))
3028 ;;; dash.el ends here