/
dash.el
2601 lines (2152 loc) · 85.7 KB
/
dash.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: Magnar Sveen <magnars@gmail.com>
;; Version: 2.13.0
;; Keywords: lists
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A modern list api for Emacs.
;;
;; See documentation on https://github.com/magnars/dash.el#functions
;;
;; **Please note** The lexical binding in this file is not utilised at the
;; moment. We will take full advantage of lexical binding in an upcoming 3.0
;; release of Dash. In the meantime, we've added the pragma to avoid a bug that
;; you can read more about in https://github.com/magnars/dash.el/issues/130.
;;
;;; Code:
(defgroup dash ()
"Customize group for dash.el"
:group 'lisp
:prefix "dash-")
(defun dash--enable-fontlock (symbol value)
(when value
(dash-enable-font-lock))
(set-default symbol value))
(defcustom dash-enable-fontlock nil
"If non-nil, enable fontification of dash functions, macros and
special values."
:type 'boolean
:set 'dash--enable-fontlock
:group 'dash)
(defmacro !cons (car cdr)
"Destructive: Set CDR to the cons of CAR and CDR."
`(setq ,cdr (cons ,car ,cdr)))
(defmacro !cdr (list)
"Destructive: Set LIST to the cdr of LIST."
`(setq ,list (cdr ,list)))
(defmacro --each (list &rest body)
"Anaphoric form of `-each'."
(declare (debug (form body))
(indent 1))
(let ((l (make-symbol "list")))
`(let ((,l ,list)
(it-index 0))
(while ,l
(let ((it (car ,l)))
,@body)
(setq it-index (1+ it-index))
(!cdr ,l)))))
(defmacro -doto (eval-initial-value &rest forms)
"Eval a form, then insert that form as the 2nd argument to other forms.
The EVAL-INITIAL-VALUE form is evaluated once. Its result is
passed to FORMS, which are then evaluated sequentially. Returns
the target form."
(declare (indent 1))
(let ((retval (make-symbol "value")))
`(let ((,retval ,eval-initial-value))
,@(mapcar (lambda (form)
(if (sequencep form)
`(,(-first-item form) ,retval ,@(cdr form))
`(funcall form ,retval)))
forms)
,retval)))
(defun -each (list fn)
"Call FN with every item in LIST. Return nil, used for side-effects only."
(--each list (funcall fn it)))
(put '-each 'lisp-indent-function 1)
(defalias '--each-indexed '--each)
(defun -each-indexed (list fn)
"Call (FN index item) for each item in LIST.
In the anaphoric form `--each-indexed', the index is exposed as `it-index`.
See also: `-map-indexed'."
(--each list (funcall fn it-index it)))
(put '-each-indexed 'lisp-indent-function 1)
(defmacro --each-while (list pred &rest body)
"Anaphoric form of `-each-while'."
(declare (debug (form form body))
(indent 2))
(let ((l (make-symbol "list"))
(c (make-symbol "continue")))
`(let ((,l ,list)
(,c t)
(it-index 0))
(while (and ,l ,c)
(let ((it (car ,l)))
(if (not ,pred) (setq ,c nil) ,@body))
(setq it-index (1+ it-index))
(!cdr ,l)))))
(defun -each-while (list pred fn)
"Call FN with every item in LIST while (PRED item) is non-nil.
Return nil, used for side-effects only."
(--each-while list (funcall pred it) (funcall fn it)))
(put '-each-while 'lisp-indent-function 2)
(defmacro --dotimes (num &rest body)
"Repeatedly executes BODY (presumably for side-effects) with `it` bound to integers from 0 through NUM-1."
(declare (debug (form body))
(indent 1))
(let ((n (make-symbol "num")))
`(let ((,n ,num)
(it 0))
(while (< it ,n)
,@body
(setq it (1+ it))))))
(defun -dotimes (num fn)
"Repeatedly calls FN (presumably for side-effects) passing in integers from 0 through NUM-1."
(--dotimes num (funcall fn it)))
(put '-dotimes 'lisp-indent-function 1)
(defun -map (fn list)
"Return a new list consisting of the result of applying FN to the items in LIST."
(mapcar fn list))
(defmacro --map (form list)
"Anaphoric form of `-map'."
(declare (debug (form form)))
`(mapcar (lambda (it) ,form) ,list))
(defmacro --reduce-from (form initial-value list)
"Anaphoric form of `-reduce-from'."
(declare (debug (form form form)))
`(let ((acc ,initial-value))
(--each ,list (setq acc ,form))
acc))
(defun -reduce-from (fn initial-value list)
"Return the result of applying FN to INITIAL-VALUE and the
first item in LIST, then applying FN to that result and the 2nd
item, etc. If LIST contains no items, return INITIAL-VALUE and
FN is not called.
In the anaphoric form `--reduce-from', the accumulated value is
exposed as `acc`.
See also: `-reduce', `-reduce-r'"
(--reduce-from (funcall fn acc it) initial-value list))
(defmacro --reduce (form list)
"Anaphoric form of `-reduce'."
(declare (debug (form form)))
(let ((lv (make-symbol "list-value")))
`(let ((,lv ,list))
(if ,lv
(--reduce-from ,form (car ,lv) (cdr ,lv))
(let (acc it) ,form)))))
(defun -reduce (fn list)
"Return the result of applying FN to the first 2 items in LIST,
then applying FN to that result and the 3rd item, etc. If LIST
contains no items, FN must accept no arguments as well, and
reduce return the result of calling FN with no arguments. If
LIST has only 1 item, it is returned and FN is not called.
In the anaphoric form `--reduce', the accumulated value is
exposed as `acc`.
See also: `-reduce-from', `-reduce-r'"
(if list
(-reduce-from fn (car list) (cdr list))
(funcall fn)))
(defun -reduce-r-from (fn initial-value list)
"Replace conses with FN, nil with INITIAL-VALUE and evaluate
the resulting expression. If LIST is empty, INITIAL-VALUE is
returned and FN is not called.
Note: this function works the same as `-reduce-from' but the
operation associates from right instead of from left.
See also: `-reduce-r', `-reduce'"
(if (not list) initial-value
(funcall fn (car list) (-reduce-r-from fn initial-value (cdr list)))))
(defmacro --reduce-r-from (form initial-value list)
"Anaphoric version of `-reduce-r-from'."
(declare (debug (form form form)))
`(-reduce-r-from (lambda (&optional it acc) ,form) ,initial-value ,list))
(defun -reduce-r (fn list)
"Replace conses with FN and evaluate the resulting expression.
The final nil is ignored. If LIST contains no items, FN must
accept no arguments as well, and reduce return the result of
calling FN with no arguments. If LIST has only 1 item, it is
returned and FN is not called.
The first argument of FN is the new item, the second is the
accumulated value.
Note: this function works the same as `-reduce' but the operation
associates from right instead of from left.
See also: `-reduce-r-from', `-reduce'"
(cond
((not list) (funcall fn))
((not (cdr list)) (car list))
(t (funcall fn (car list) (-reduce-r fn (cdr list))))))
(defmacro --reduce-r (form list)
"Anaphoric version of `-reduce-r'."
(declare (debug (form form)))
`(-reduce-r (lambda (&optional it acc) ,form) ,list))
(defmacro --filter (form list)
"Anaphoric form of `-filter'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each ,list (when ,form (!cons it ,r)))
(nreverse ,r))))
(defun -filter (pred list)
"Return a new list of the items in LIST for which PRED returns a non-nil value.
Alias: `-select'
See also: `-keep'"
(--filter (funcall pred it) list))
(defalias '-select '-filter)
(defalias '--select '--filter)
(defmacro --remove (form list)
"Anaphoric form of `-remove'."
(declare (debug (form form)))
`(--filter (not ,form) ,list))
(defun -remove (pred list)
"Return a new list of the items in LIST for which PRED returns nil.
Alias: `-reject'"
(--remove (funcall pred it) list))
(defalias '-reject '-remove)
(defalias '--reject '--remove)
(defun -remove-first (pred list)
"Return a new list with the first item matching PRED removed.
Alias: `-reject-first'
See also: `-remove', `-map-first'"
(let (front)
(while (and list (not (funcall pred (car list))))
(push (car list) front)
(!cdr list))
(if list
(-concat (nreverse front) (cdr list))
(nreverse front))))
(defmacro --remove-first (form list)
"Anaphoric form of `-remove-first'."
(declare (debug (form form)))
`(-remove-first (lambda (it) ,form) ,list))
(defalias '-reject-first '-remove-first)
(defalias '--reject-first '--remove-first)
(defun -remove-last (pred list)
"Return a new list with the last item matching PRED removed.
Alias: `-reject-last'
See also: `-remove', `-map-last'"
(nreverse (-remove-first pred (reverse list))))
(defmacro --remove-last (form list)
"Anaphoric form of `-remove-last'."
(declare (debug (form form)))
`(-remove-last (lambda (it) ,form) ,list))
(defalias '-reject-last '-remove-last)
(defalias '--reject-last '--remove-last)
(defun -remove-item (item list)
"Remove all occurences of ITEM from LIST.
Comparison is done with `equal'."
(declare (pure t) (side-effect-free t))
(--remove (equal it item) list))
(defmacro --keep (form list)
"Anaphoric form of `-keep'."
(declare (debug (form form)))
(let ((r (make-symbol "result"))
(m (make-symbol "mapped")))
`(let (,r)
(--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r))))
(nreverse ,r))))
(defun -keep (fn list)
"Return a new list of the non-nil results of applying FN to the items in LIST.
If you want to select the original items satisfying a predicate use `-filter'."
(--keep (funcall fn it) list))
(defun -non-nil (list)
"Return all non-nil elements of LIST."
(declare (pure t) (side-effect-free t))
(-remove 'null list))
(defmacro --map-indexed (form list)
"Anaphoric form of `-map-indexed'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each ,list
(!cons ,form ,r))
(nreverse ,r))))
(defun -map-indexed (fn list)
"Return a new list consisting of the result of (FN index item) for each item in LIST.
In the anaphoric form `--map-indexed', the index is exposed as `it-index`.
See also: `-each-indexed'."
(--map-indexed (funcall fn it-index it) list))
(defmacro --map-when (pred rep list)
"Anaphoric form of `-map-when'."
(declare (debug (form form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each ,list (!cons (if ,pred ,rep it) ,r))
(nreverse ,r))))
(defun -map-when (pred rep list)
"Return a new list where the elements in LIST that do not match the PRED function
are unchanged, and where the elements in LIST that do match the PRED function are mapped
through the REP function.
Alias: `-replace-where'
See also: `-update-at'"
(--map-when (funcall pred it) (funcall rep it) list))
(defalias '-replace-where '-map-when)
(defalias '--replace-where '--map-when)
(defun -map-first (pred rep list)
"Replace first item in LIST satisfying PRED with result of REP called on this item.
See also: `-map-when', `-replace-first'"
(let (front)
(while (and list (not (funcall pred (car list))))
(push (car list) front)
(!cdr list))
(if list
(-concat (nreverse front) (cons (funcall rep (car list)) (cdr list)))
(nreverse front))))
(defmacro --map-first (pred rep list)
"Anaphoric form of `-map-first'."
`(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))
(defun -map-last (pred rep list)
"Replace first item in LIST satisfying PRED with result of REP called on this item.
See also: `-map-when', `-replace-last'"
(nreverse (-map-first pred rep (reverse list))))
(defmacro --map-last (pred rep list)
"Anaphoric form of `-map-last'."
`(-map-last (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))
(defun -replace (old new list)
"Replace all OLD items in LIST with NEW.
Elements are compared using `equal'.
See also: `-replace-at'"
(declare (pure t) (side-effect-free t))
(--map-when (equal it old) new list))
(defun -replace-first (old new list)
"Replace the first occurence of OLD with NEW in LIST.
Elements are compared using `equal'.
See also: `-map-first'"
(declare (pure t) (side-effect-free t))
(--map-first (equal old it) new list))
(defun -replace-last (old new list)
"Replace the last occurence of OLD with NEW in LIST.
Elements are compared using `equal'.
See also: `-map-last'"
(declare (pure t) (side-effect-free t))
(--map-last (equal old it) new list))
(defmacro --mapcat (form list)
"Anaphoric form of `-mapcat'."
(declare (debug (form form)))
`(apply 'append (--map ,form ,list)))
(defun -mapcat (fn list)
"Return the concatenation of the result of mapping FN over LIST.
Thus function FN should return a list."
(--mapcat (funcall fn it) list))
(defun -flatten (l)
"Take a nested list L and return its contents as a single, flat list.
Note that because `nil' represents a list of zero elements (an
empty list), any mention of nil in L will disappear after
flattening. If you need to preserve nils, consider `-flatten-n'
or map them to some unique symbol and then map them back.
Conses of two atoms are considered \"terminals\", that is, they
aren't flattened further.
See also: `-flatten-n'"
(declare (pure t) (side-effect-free t))
(if (and (listp l) (listp (cdr l)))
(-mapcat '-flatten l)
(list l)))
(defmacro --iterate (form init n)
"Anaphoric version of `-iterate'."
(declare (debug (form form form)))
`(-iterate (lambda (it) ,form) ,init ,n))
(defun -flatten-n (num list)
"Flatten NUM levels of a nested LIST.
See also: `-flatten'"
(declare (pure t) (side-effect-free t))
(-last-item (--iterate (--mapcat (-list it) it) list (1+ num))))
(defun -concat (&rest lists)
"Return a new list with the concatenation of the elements in the supplied LISTS."
(declare (pure t) (side-effect-free t))
(apply 'append lists))
(defalias '-copy 'copy-sequence
"Create a shallow copy of LIST.
\(fn LIST)")
(defun -splice (pred fun list)
"Splice lists generated by FUN in place of elements matching PRED in LIST.
FUN takes the element matching PRED as input.
This function can be used as replacement for `,@' in case you
need to splice several lists at marked positions (for example
with keywords).
See also: `-splice-list', `-insert-at'"
(let (r)
(--each list
(if (funcall pred it)
(let ((new (funcall fun it)))
(--each new (!cons it r)))
(!cons it r)))
(nreverse r)))
(defmacro --splice (pred form list)
"Anaphoric form of `-splice'."
`(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list))
(defun -splice-list (pred new-list list)
"Splice NEW-LIST in place of elements matching PRED in LIST.
See also: `-splice', `-insert-at'"
(-splice pred (lambda (_) new-list) list))
(defmacro --splice-list (pred new-list list)
"Anaphoric form of `-splice-list'."
`(-splice-list (lambda (it) ,pred) ,new-list ,list))
(defun -cons* (&rest args)
"Make a new list from the elements of ARGS.
The last 2 members of ARGS are used as the final cons of the
result so if the final member of ARGS is not a list the result is
a dotted list."
(declare (pure t) (side-effect-free t))
(-reduce-r 'cons args))
(defun -snoc (list elem &rest elements)
"Append ELEM to the end of the list.
This is like `cons', but operates on the end of list.
If ELEMENTS is non nil, append these to the list as well."
(-concat list (list elem) elements))
(defmacro --first (form list)
"Anaphoric form of `-first'."
(declare (debug (form form)))
(let ((n (make-symbol "needle")))
`(let (,n)
(--each-while ,list (not ,n)
(when ,form (setq ,n it)))
,n)))
(defun -first (pred list)
"Return the first x in LIST where (PRED x) is non-nil, else nil.
To get the first item in the list no questions asked, use `car'.
Alias: `-find'"
(--first (funcall pred it) list))
(defalias '-find '-first)
(defalias '--find '--first)
(defmacro --some (form list)
"Anaphoric form of `-some'."
(declare (debug (form form)))
(let ((n (make-symbol "needle")))
`(let (,n)
(--each-while ,list (not ,n)
(setq ,n ,form))
,n)))
(defun -some (pred list)
"Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil.
Alias: `-any'"
(--some (funcall pred it) list))
(defalias '-any '-some)
(defalias '--any '--some)
(defmacro --last (form list)
"Anaphoric form of `-last'."
(declare (debug (form form)))
(let ((n (make-symbol "needle")))
`(let (,n)
(--each ,list
(when ,form (setq ,n it)))
,n)))
(defun -last (pred list)
"Return the last x in LIST where (PRED x) is non-nil, else nil."
(--last (funcall pred it) list))
(defalias '-first-item 'car
"Return the first item of LIST, or nil on an empty list.
\(fn LIST)")
(gv-define-simple-setter -first-item setcar)
(defun -last-item (list)
"Return the last item of LIST, or nil on an empty list."
(declare (pure t) (side-effect-free t))
(car (last list)))
(gv-define-setter -last-item (val x) `(setcar (last ,x) ,val))
(defun -butlast (list)
"Return a list of all items in list except for the last."
;; no alias as we don't want magic optional argument
(declare (pure t) (side-effect-free t))
(butlast list))
(defmacro --count (pred list)
"Anaphoric form of `-count'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let ((,r 0))
(--each ,list (when ,pred (setq ,r (1+ ,r))))
,r)))
(defun -count (pred list)
"Counts the number of items in LIST where (PRED item) is non-nil."
(--count (funcall pred it) list))
(defun ---truthy? (val)
(declare (pure t) (side-effect-free t))
(not (null val)))
(defmacro --any? (form list)
"Anaphoric form of `-any?'."
(declare (debug (form form)))
`(---truthy? (--first ,form ,list)))
(defun -any? (pred list)
"Return t if (PRED x) is non-nil for any x in LIST, else nil.
Alias: `-any-p', `-some?', `-some-p'"
(--any? (funcall pred it) list))
(defalias '-some? '-any?)
(defalias '--some? '--any?)
(defalias '-any-p '-any?)
(defalias '--any-p '--any?)
(defalias '-some-p '-any?)
(defalias '--some-p '--any?)
(defmacro --all? (form list)
"Anaphoric form of `-all?'."
(declare (debug (form form)))
(let ((a (make-symbol "all")))
`(let ((,a t))
(--each-while ,list ,a (setq ,a ,form))
(---truthy? ,a))))
(defun -all? (pred list)
"Return t if (PRED x) is non-nil for all x in LIST, else nil.
Alias: `-all-p', `-every?', `-every-p'"
(--all? (funcall pred it) list))
(defalias '-every? '-all?)
(defalias '--every? '--all?)
(defalias '-all-p '-all?)
(defalias '--all-p '--all?)
(defalias '-every-p '-all?)
(defalias '--every-p '--all?)
(defmacro --none? (form list)
"Anaphoric form of `-none?'."
(declare (debug (form form)))
`(--all? (not ,form) ,list))
(defun -none? (pred list)
"Return t if (PRED x) is nil for all x in LIST, else nil.
Alias: `-none-p'"
(--none? (funcall pred it) list))
(defalias '-none-p '-none?)
(defalias '--none-p '--none?)
(defmacro --only-some? (form list)
"Anaphoric form of `-only-some?'."
(declare (debug (form form)))
(let ((y (make-symbol "yes"))
(n (make-symbol "no")))
`(let (,y ,n)
(--each-while ,list (not (and ,y ,n))
(if ,form (setq ,y t) (setq ,n t)))
(---truthy? (and ,y ,n)))))
(defun -only-some? (pred list)
"Return `t` if at least one item of LIST matches PRED and at least one item of LIST does not match PRED.
Return `nil` both if all items match the predicate or if none of the items match the predicate.
Alias: `-only-some-p'"
(--only-some? (funcall pred it) list))
(defalias '-only-some-p '-only-some?)
(defalias '--only-some-p '--only-some?)
(defun -slice (list from &optional to step)
"Return copy of LIST, starting from index FROM to index TO.
FROM or TO may be negative. These values are then interpreted
modulo the length of the list.
If STEP is a number, only each STEPth item in the resulting
section is returned. Defaults to 1."
(declare (pure t) (side-effect-free t))
(let ((length (length list))
(new-list nil))
;; to defaults to the end of the list
(setq to (or to length))
(setq step (or step 1))
;; handle negative indices
(when (< from 0)
(setq from (mod from length)))
(when (< to 0)
(setq to (mod to length)))
;; iterate through the list, keeping the elements we want
(--each-while list (< it-index to)
(when (and (>= it-index from)
(= (mod (- from it-index) step) 0))
(push it new-list)))
(nreverse new-list)))
(defun -take (n list)
"Return a new list of the first N items in LIST, or all items if there are fewer than N.
See also: `-take-last'"
(declare (pure t) (side-effect-free t))
(let (result)
(--dotimes n
(when list
(!cons (car list) result)
(!cdr list)))
(nreverse result)))
(defun -take-last (n list)
"Return the last N items of LIST in order.
See also: `-take'"
(declare (pure t) (side-effect-free t))
(copy-sequence (last list n)))
(defalias '-drop 'nthcdr
"Return the tail of LIST without the first N items.
See also: `-drop-last'
\(fn N LIST)")
(defun -drop-last (n list)
"Remove the last N items of LIST and return a copy.
See also: `-drop'"
;; No alias because we don't want magic optional argument
(declare (pure t) (side-effect-free t))
(butlast list n))
(defmacro --take-while (form list)
"Anaphoric form of `-take-while'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each-while ,list ,form (!cons it ,r))
(nreverse ,r))))
(defun -take-while (pred list)
"Return a new list of successive items from LIST while (PRED item) returns a non-nil value."
(--take-while (funcall pred it) list))
(defmacro --drop-while (form list)
"Anaphoric form of `-drop-while'."
(declare (debug (form form)))
(let ((l (make-symbol "list")))
`(let ((,l ,list))
(while (and ,l (let ((it (car ,l))) ,form))
(!cdr ,l))
,l)))
(defun -drop-while (pred list)
"Return the tail of LIST starting from the first item for which (PRED item) returns nil."
(--drop-while (funcall pred it) list))
(defun -split-at (n list)
"Return a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list."
(declare (pure t) (side-effect-free t))
(let (result)
(--dotimes n
(when list
(!cons (car list) result)
(!cdr list)))
(list (nreverse result) list)))
(defun -rotate (n list)
"Rotate LIST N places to the right. With N negative, rotate to the left.
The time complexity is O(n)."
(declare (pure t) (side-effect-free t))
(if (> n 0)
(append (last list n) (butlast list n))
(append (-drop (- n) list) (-take (- n) list))))
(defun -insert-at (n x list)
"Return a list with X inserted into LIST at position N.
See also: `-splice', `-splice-list'"
(declare (pure t) (side-effect-free t))
(let ((split-list (-split-at n list)))
(nconc (car split-list) (cons x (cadr split-list)))))
(defun -replace-at (n x list)
"Return a list with element at Nth position in LIST replaced with X.
See also: `-replace'"
(declare (pure t) (side-effect-free t))
(let ((split-list (-split-at n list)))
(nconc (car split-list) (cons x (cdr (cadr split-list))))))
(defun -update-at (n func list)
"Return a list with element at Nth position in LIST replaced with `(func (nth n list))`.
See also: `-map-when'"
(let ((split-list (-split-at n list)))
(nconc (car split-list) (cons (funcall func (car (cadr split-list))) (cdr (cadr split-list))))))
(defmacro --update-at (n form list)
"Anaphoric version of `-update-at'."
(declare (debug (form form form)))
`(-update-at ,n (lambda (it) ,form) ,list))
(defun -remove-at (n list)
"Return a list with element at Nth position in LIST removed.
See also: `-remove-at-indices', `-remove'"
(declare (pure t) (side-effect-free t))
(-remove-at-indices (list n) list))
(defun -remove-at-indices (indices list)
"Return a list whose elements are elements from LIST without
elements selected as `(nth i list)` for all i
from INDICES.
See also: `-remove-at', `-remove'"
(declare (pure t) (side-effect-free t))
(let* ((indices (-sort '< indices))
(diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices))))
r)
(--each diffs
(let ((split (-split-at it list)))
(!cons (car split) r)
(setq list (cdr (cadr split)))))
(!cons list r)
(apply '-concat (nreverse r))))
(defmacro --split-with (pred list)
"Anaphoric form of `-split-with'."
(declare (debug (form form)))
(let ((l (make-symbol "list"))
(r (make-symbol "result"))
(c (make-symbol "continue")))
`(let ((,l ,list)
(,r nil)
(,c t))
(while (and ,l ,c)
(let ((it (car ,l)))
(if (not ,pred)
(setq ,c nil)
(!cons it ,r)
(!cdr ,l))))
(list (nreverse ,r) ,l))))
(defun -split-with (pred list)
"Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list."
(--split-with (funcall pred it) list))
(defmacro -split-on (item list)
"Split the LIST each time ITEM is found.
Unlike `-partition-by', the ITEM is discarded from the results.
Empty lists are also removed from the result.
Comparison is done by `equal'.
See also `-split-when'"
(declare (debug (form form)))
`(-split-when (lambda (it) (equal it ,item)) ,list))
(defmacro --split-when (form list)
"Anaphoric version of `-split-when'."
(declare (debug (form form)))
`(-split-when (lambda (it) ,form) ,list))
(defun -split-when (fn list)
"Split the LIST on each element where FN returns non-nil.
Unlike `-partition-by', the \"matched\" element is discarded from
the results. Empty lists are also removed from the result.
This function can be thought of as a generalization of
`split-string'."
(let (r s)
(while list
(if (not (funcall fn (car list)))
(push (car list) s)
(when s (push (nreverse s) r))
(setq s nil))
(!cdr list))
(when s (push (nreverse s) r))
(nreverse r)))
(defmacro --separate (form list)
"Anaphoric form of `-separate'."
(declare (debug (form form)))
(let ((y (make-symbol "yes"))
(n (make-symbol "no")))
`(let (,y ,n)
(--each ,list (if ,form (!cons it ,y) (!cons it ,n)))
(list (nreverse ,y) (nreverse ,n)))))
(defun -separate (pred list)
"Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list."
(--separate (funcall pred it) list))
(defun ---partition-all-in-steps-reversed (n step list)
"Private: Used by -partition-all-in-steps and -partition-in-steps."
(when (< step 1)
(error "Step must be a positive number, or you're looking at some juicy infinite loops."))
(let ((result nil))
(while list
(!cons (-take n list) result)
(setq list (-drop step list)))
result))
(defun -partition-all-in-steps (n step list)
"Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.
The last groups may contain less than N items."
(declare (pure t) (side-effect-free t))
(nreverse (---partition-all-in-steps-reversed n step list)))
(defun -partition-in-steps (n step list)
"Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.
If there are not enough items to make the last group N-sized,
those items are discarded."
(declare (pure t) (side-effect-free t))
(let ((result (---partition-all-in-steps-reversed n step list)))
(while (and result (< (length (car result)) n))
(!cdr result))
(nreverse result)))
(defun -partition-all (n list)
"Return a new list with the items in LIST grouped into N-sized sublists.
The last group may contain less than N items."
(declare (pure t) (side-effect-free t))
(-partition-all-in-steps n n list))
(defun -partition (n list)
"Return a new list with the items in LIST grouped into N-sized sublists.
If there are not enough items to make the last group N-sized,
those items are discarded."
(declare (pure t) (side-effect-free t))
(-partition-in-steps n n list))
(defmacro --partition-by (form list)
"Anaphoric form of `-partition-by'."
(declare (debug (form form)))
(let ((r (make-symbol "result"))
(s (make-symbol "sublist"))
(v (make-symbol "value"))
(n (make-symbol "new-value"))
(l (make-symbol "list")))
`(let ((,l ,list))
(when ,l
(let* ((,r nil)
(it (car ,l))
(,s (list it))
(,v ,form)
(,l (cdr ,l)))
(while ,l
(let* ((it (car ,l))
(,n ,form))
(unless (equal ,v ,n)
(!cons (nreverse ,s) ,r)
(setq ,s nil)
(setq ,v ,n))
(!cons it ,s)
(!cdr ,l)))
(!cons (nreverse ,s) ,r)
(nreverse ,r))))))
(defun -partition-by (fn list)
"Apply FN to each item in LIST, splitting it each time FN returns a new value."
(--partition-by (funcall fn it) list))
(defmacro --partition-by-header (form list)
"Anaphoric form of `-partition-by-header'."
(declare (debug (form form)))
(let ((r (make-symbol "result"))
(s (make-symbol "sublist"))
(h (make-symbol "header-value"))
(b (make-symbol "seen-body?"))
(n (make-symbol "new-value"))
(l (make-symbol "list")))
`(let ((,l ,list))
(when ,l
(let* ((,r nil)
(it (car ,l))
(,s (list it))
(,h ,form)
(,b nil)
(,l (cdr ,l)))
(while ,l
(let* ((it (car ,l))
(,n ,form))
(if (equal ,h ,n)