branch: externals/dash
commit 759682332a0ebd737802d9fa0a80ceedf05088b6
Author: Basil L. Contovounesios <conto...@tcd.ie>
Commit: Basil L. Contovounesios <conto...@tcd.ie>
Byte-compile tests
* Makefile (els): Add dev/examples.el so that it's byte-compiled.
(check): Prefer dev/examples.elc over dev/examples.el.
($(docs)): Remove redundant dependency.
(dev/dash-defs.elc, dev/examples.elc): Manually list dependencies.
* dash.el: Add pure and side-effect-free to defun-declarations-alist
as no-ops when needed, to avoid warnings in Emacsen that lack them.
(--reductions): Pacify uninitialized lexvar warnings in recent
Emacsen (issue #377).
(--splice, -splice): Reimplement the function in terms of the macro
for efficiency and to avoid unused lexvar warnings. Expand
docstrings.
(--map-first, --map-last, --splice-list, --update-at, --split-when)
(--annotate, --find-indices, --find-index, --find-last-index)
(--sort, --max-by, --min-by, --fix, --unfold, --tree-mapreduce-from)
(--tree-mapreduce, --tree-map, --tree-reduce-from, --tree-reduce)
(--tree-map-nodes, --tree-seq): Pacify unused lexvar warnings.
(-value-to-list, -tree-mapreduce-from, -tree-mapreduce, -tree-map)
(-tree-reduce-from, -tree-reduce, -tree-map-nodes, -tree-seq):
Simplify slightly.
* dev/dash-defs.el: Load ert for the benefit of generated tests.
(dash--example-to-test): Remove eval needed in old Emacsen; call it
on a case-by-case basis instead.
(defexamples): Ensure ert-deftest bodies are nonempty.
(dash--describe, dash--lisp-to-md): Move defvar declarations to
top-level or else old Emacsen will complain.
* dev/examples.el: Work around https://bugs.gnu.org/14883 by
enabling byte-compile-delete-errors as needed.
(dash-expand:&hash-or-plist): Wrap in eval-when-compile.
(-splice): Extend tests.
(-map-when, -flatten-n, -list, -some-->, -when-let, -let, -let*)
(-lambda, -setq): Pacify or work around byte-compiler warnings or
errors.
* README.md:
* dash.texi: Regenerate docs.
---
Makefile | 11 ++--
README.md | 23 ++++---
dash.el | 185 +++++++++++++++++++++++++++++++++----------------------
dash.texi | 27 ++++----
dev/dash-defs.el | 20 +++---
dev/examples.el | 137 ++++++++++++++++++++++++++++------------
6 files changed, 261 insertions(+), 142 deletions(-)
diff --git a/Makefile b/Makefile
index b5e82c7d34..2bdde18f93 100644
--- a/Makefile
+++ b/Makefile
@@ -19,7 +19,7 @@
EMACS ?= emacs
batch := $(EMACS) -Q -batch -L .
-els := dash.el dev/dash-defs.el
+els := dash.el dev/dash-defs.el dev/examples.el
elcs := $(addsuffix c,$(els))
docs := README.md dash.texi
tmpls := readme-template.md dash-template.texi $(wildcard doc/*.texi)
@@ -42,7 +42,7 @@ force-docs: maintainer-clean docs
check: ERT_SELECTOR ?= t
check: run := '(ert-run-tests-batch-and-exit (quote $(ERT_SELECTOR)))'
check: lisp
- EMACS_TEST_VERBOSE=1 $(batch) -l dev/examples.el -eval $(run)
+ EMACS_TEST_VERBOSE=1 $(batch) -l dev/examples -eval $(run)
.PHONY: check
all: lisp docs check
@@ -68,5 +68,8 @@ maintainer-clean: clean
%.elc: %.el
$(batch) -eval $(WERROR) -f batch-byte-compile $<
-$(docs) &: dev/examples.el $(elcs) $(tmpls)
- $(batch) -l $< -f dash-make-docs
+$(docs) &: $(elcs) $(tmpls)
+ $(batch) -l dev/examples -f dash-make-docs
+
+dev/dash-defs.elc: dash.elc
+dev/examples.elc: dash.elc dev/dash-defs.elc
diff --git a/README.md b/README.md
index bfb20ea3f9..0611975608 100644
--- a/README.md
+++ b/README.md
@@ -477,20 +477,25 @@ element of `list` paired with the unmodified element of
`list`.
#### -splice `(pred fun list)`
-Splice lists generated by `fun` in place of elements matching `pred` in `list`.
+Splice lists generated by `fun` in place of items satisfying `pred` in `list`.
-`fun` takes the element matching `pred` as input.
+Call `pred` on each element of `list`. Whenever the result of `pred`
+is `nil`, leave that `it` as-is. Otherwise, call `fun` on the same
+`it` that satisfied `pred`. The result should be a (possibly
+empty) list of items to splice in place of `it` in `list`.
-This function can be used as replacement for `,@` in case you
-need to splice several lists at marked positions (for example
-with keywords).
+This can be useful as an alternative to the `,@` construct in a
+``' structure, in case you need to splice several lists at
+marked positions (for example with keywords).
-See also: [`-splice-list`](#-splice-list-pred-new-list-list),
[`-insert-at`](#-insert-at-n-x-list)
+This function's anaphoric counterpart is `--splice`.
+
+See also: [`-splice-list`](#-splice-list-pred-new-list-list),
[`-insert-at`](#-insert-at-n-x-list).
```el
-(-splice 'even? (lambda (x) (list x x)) '(1 2 3 4)) ;; => (1 2 2 3 4 4)
-(--splice 't (list it it) '(1 2 3 4)) ;; => (1 1 2 2 3 3 4 4)
-(--splice (equal it :magic) '((list of) (magical) (code)) '((foo) (bar) :magic
(baz))) ;; => ((foo) (bar) (list of) (magical) (code) (baz))
+(-splice #'numberp (lambda (n) (list n n)) '(a 1 b 2)) ;; => (a 1 1 b 2 2)
+(--splice t (list it it) '(1 2 3 4)) ;; => (1 1 2 2 3 3 4 4)
+(--splice (eq it :magic) '((magical) (code)) '((foo) :magic (bar))) ;; =>
((foo) (magical) (code) (bar))
```
#### -splice-list `(pred new-list list)`
diff --git a/dash.el b/dash.el
index 927f9626de..eccba3a649 100644
--- a/dash.el
+++ b/dash.el
@@ -29,11 +29,19 @@
;;; Code:
-;; TODO: `gv' was introduced in Emacs 24.3, so remove this and all
-;; calls to `defsetf' when support for earlier versions is dropped.
(eval-when-compile
+ ;; TODO: Emacs 24.3 first introduced `gv', so remove this and all
+ ;; calls to `defsetf' when support for earlier versions is dropped.
(unless (fboundp 'gv-define-setter)
- (require 'cl)))
+ (require 'cl))
+
+ ;; TODO: Emacs versions 24.3..24.5 complain about unknown `declare'
+ ;; props, so remove this when support for those versions is dropped.
+ (and (< emacs-major-version 25)
+ (boundp 'defun-declarations-alist)
+ (dolist (prop '(pure side-effect-free))
+ (unless (assq prop defun-declarations-alist)
+ (push (list prop #'ignore) defun-declarations-alist)))))
(defgroup dash ()
"Customize group for Dash, a modern list library."
@@ -373,7 +381,9 @@ This is the anaphoric counterpart to `-reductions'."
`(let ((,lv ,list))
(if ,lv
(--reductions-from ,form (car ,lv) (cdr ,lv))
- (let (acc it)
+ ;; Explicit nil binding pacifies lexical "variable left uninitialized"
+ ;; warning. See issue #377 and upstream https://bugs.gnu.org/47080.
+ (let ((acc nil) (it nil))
(ignore acc it)
(list ,form))))))
@@ -642,7 +652,9 @@ See also: `-map-when', `-replace-first'"
(defmacro --map-first (pred rep list)
"Anaphoric form of `-map-first'."
(declare (debug (def-form def-form form)))
- `(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))
+ `(-map-first (lambda (it) (ignore it) ,pred)
+ (lambda (it) (ignore it) ,rep)
+ ,list))
(defun -map-last (pred rep list)
"Use PRED to determine the last item in LIST to call REP on.
@@ -655,7 +667,9 @@ See also: `-map-when', `-replace-last'"
(defmacro --map-last (pred rep list)
"Anaphoric form of `-map-last'."
(declare (debug (def-form def-form form)))
- `(-map-last (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))
+ `(-map-last (lambda (it) (ignore it) ,pred)
+ (lambda (it) (ignore it) ,rep)
+ ,list))
(defun -replace (old new list)
"Replace all OLD items in LIST with NEW.
@@ -750,28 +764,45 @@ See also: `-flatten'"
\(fn LIST)")
+(defmacro --splice (pred form list)
+ "Splice lists generated by FORM in place of items satisfying PRED in LIST.
+
+Evaluate PRED for each element of LIST in turn bound to `it'.
+Whenever the result of PRED is nil, leave that `it' is-is.
+Otherwise, evaluate FORM with the same `it' binding still in
+place. The result should be a (possibly empty) list of items to
+splice in place of `it' in LIST.
+
+This can be useful as an alternative to the `,@' construct in a
+`\\=`' structure, in case you need to splice several lists at
+marked positions (for example with keywords).
+
+This is the anaphoric counterpart to `-splice'."
+ (declare (debug (def-form def-form form)))
+ (let ((r (make-symbol "result")))
+ `(let (,r)
+ (--each ,list
+ (if ,pred
+ (--each ,form (push it ,r))
+ (push it ,r)))
+ (nreverse ,r))))
+
(defun -splice (pred fun list)
- "Splice lists generated by FUN in place of elements matching PRED in LIST.
+ "Splice lists generated by FUN in place of items satisfying PRED in LIST.
-FUN takes the element matching PRED as input.
+Call PRED on each element of LIST. Whenever the result of PRED
+is nil, leave that `it' as-is. Otherwise, call FUN on the same
+`it' that satisfied PRED. The result should be a (possibly
+empty) list of items to splice in place of `it' in LIST.
-This function can be used as replacement for `,@' in case you
-need to splice several lists at marked positions (for example
-with keywords).
+This can be useful as an alternative to the `,@' construct in a
+`\\=`' structure, 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)))
+This function's anaphoric counterpart is `--splice'.
-(defmacro --splice (pred form list)
- "Anaphoric form of `-splice'."
- (declare (debug (def-form def-form form)))
- `(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list))
+See also: `-splice-list', `-insert-at'."
+ (--splice (funcall pred it) (funcall fun it) list))
(defun -splice-list (pred new-list list)
"Splice NEW-LIST in place of elements matching PRED in LIST.
@@ -782,7 +813,7 @@ See also: `-splice', `-insert-at'"
(defmacro --splice-list (pred new-list list)
"Anaphoric form of `-splice-list'."
(declare (debug (def-form form form)))
- `(-splice-list (lambda (it) ,pred) ,new-list ,list))
+ `(-splice-list (lambda (it) (ignore it) ,pred) ,new-list ,list))
(defun -cons* (&rest args)
"Make a new list from the elements of ARGS.
@@ -1233,7 +1264,7 @@ See also: `-map-when'"
(defmacro --update-at (n form list)
"Anaphoric version of `-update-at'."
(declare (debug (form def-form form)))
- `(-update-at ,n (lambda (it) ,form) ,list))
+ `(-update-at ,n (lambda (it) (ignore it) ,form) ,list))
(defun -remove-at (n list)
"Return a list with element at Nth position in LIST removed.
@@ -1302,7 +1333,7 @@ See also `-split-when'"
(defmacro --split-when (form list)
"Anaphoric version of `-split-when'."
(declare (debug (def-form form)))
- `(-split-when (lambda (it) ,form) ,list))
+ `(-split-when (lambda (it) (ignore it) ,form) ,list))
(defun -split-when (fn list)
"Split the LIST on each element where FN returns non-nil.
@@ -1664,7 +1695,7 @@ element of LIST paired with the unmodified element of
LIST."
(defmacro --annotate (form list)
"Anaphoric version of `-annotate'."
(declare (debug (def-form form)))
- `(-annotate (lambda (it) ,form) ,list))
+ `(-annotate (lambda (it) (ignore it) ,form) ,list))
(defun dash--table-carry (lists restore-lists &optional re)
"Helper for `-table' and `-table-flat'.
@@ -1749,7 +1780,7 @@ predicate PRED, in ascending order."
(defmacro --find-indices (form list)
"Anaphoric version of `-find-indices'."
(declare (debug (def-form form)))
- `(-find-indices (lambda (it) ,form) ,list))
+ `(-find-indices (lambda (it) (ignore it) ,form) ,list))
(defun -find-index (pred list)
"Take a predicate PRED and a LIST and return the index of the
@@ -1762,7 +1793,7 @@ See also `-first'."
(defmacro --find-index (form list)
"Anaphoric version of `-find-index'."
(declare (debug (def-form form)))
- `(-find-index (lambda (it) ,form) ,list))
+ `(-find-index (lambda (it) (ignore it) ,form) ,list))
(defun -find-last-index (pred list)
"Take a predicate PRED and a LIST and return the index of the
@@ -1775,7 +1806,7 @@ See also `-last'."
(defmacro --find-last-index (form list)
"Anaphoric version of `-find-last-index'."
(declare (debug (def-form form)))
- `(-find-last-index (lambda (it) ,form) ,list))
+ `(-find-last-index (lambda (it) (ignore it) ,form) ,list))
(defun -select-by-indices (indices list)
"Return a list whose elements are elements from LIST selected
@@ -2781,7 +2812,7 @@ if the first element should sort before the second."
(defmacro --sort (form list)
"Anaphoric form of `-sort'."
(declare (debug (def-form form)))
- `(-sort (lambda (it other) ,form) ,list))
+ `(-sort (lambda (it other) (ignore it other) ,form) ,list))
(defun -list (&optional arg &rest args)
"Ensure ARG is a list.
@@ -2857,14 +2888,14 @@ comparing them."
The items for the comparator form are exposed as \"it\" and \"other\"."
(declare (debug (def-form form)))
- `(-max-by (lambda (it other) ,form) ,list))
+ `(-max-by (lambda (it other) (ignore it other) ,form) ,list))
(defmacro --min-by (form list)
"Anaphoric version of `-min-by'.
The items for the comparator form are exposed as \"it\" and \"other\"."
(declare (debug (def-form form)))
- `(-min-by (lambda (it other) ,form) ,list))
+ `(-min-by (lambda (it other) (ignore it other) ,form) ,list))
(defun -iota (count &optional start step)
"Return a list containing COUNT numbers.
@@ -2894,7 +2925,7 @@ FN is called at least once, results are compared with
`equal'."
(defmacro --fix (form list)
"Anaphoric form of `-fix'."
(declare (debug (def-form form)))
- `(-fix (lambda (it) ,form) ,list))
+ `(-fix (lambda (it) (ignore it) ,form) ,list))
(defun -unfold (fun seed)
"Build a list from SEED using FUN.
@@ -2915,7 +2946,7 @@ the new seed."
(defmacro --unfold (form seed)
"Anaphoric version of `-unfold'."
(declare (debug (def-form form)))
- `(-unfold (lambda (it) ,form) ,seed))
+ `(-unfold (lambda (it) (ignore it) ,form) ,seed))
(defun -cons-pair? (obj)
"Return non-nil if OBJ is a true cons pair.
@@ -2940,9 +2971,7 @@ and `cdr' of the pair respectively.
If the value is anything else, wrap it in a list."
(declare (pure t) (side-effect-free t))
- (cond
- ((-cons-pair? val) (-cons-to-list val))
- (t (list val))))
+ (if (-cons-pair? val) (-cons-to-list val) (list val)))
(defun -tree-mapreduce-from (fn folder init-value tree)
"Apply FN to each element of TREE, and make a list of the results.
@@ -2955,16 +2984,21 @@ INIT-VALUE. See `-reduce-r-from'.
This is the same as calling `-tree-reduce-from' after `-tree-map'
but is twice as fast as it only traverse the structure once."
(cond
- ((not tree) nil)
+ ((null tree) ())
((-cons-pair? tree) (funcall fn tree))
- ((listp tree)
- (-reduce-r-from folder init-value (mapcar (lambda (x)
(-tree-mapreduce-from fn folder init-value x)) tree)))
- (t (funcall fn tree))))
+ ((consp tree)
+ (-reduce-r-from
+ folder init-value
+ (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree)))
+ ((funcall fn tree))))
(defmacro --tree-mapreduce-from (form folder init-value tree)
"Anaphoric form of `-tree-mapreduce-from'."
(declare (debug (def-form def-form form form)))
- `(-tree-mapreduce-from (lambda (it) ,form) (lambda (it acc) ,folder)
,init-value ,tree))
+ `(-tree-mapreduce-from (lambda (it) (ignore it) ,form)
+ (lambda (it acc) (ignore it acc) ,folder)
+ ,init-value
+ ,tree))
(defun -tree-mapreduce (fn folder tree)
"Apply FN to each element of TREE, and make a list of the results.
@@ -2977,30 +3011,32 @@ INIT-VALUE. See `-reduce-r-from'.
This is the same as calling `-tree-reduce' after `-tree-map'
but is twice as fast as it only traverse the structure once."
(cond
- ((not tree) nil)
+ ((null tree) ())
((-cons-pair? tree) (funcall fn tree))
- ((listp tree)
+ ((consp tree)
(-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x))
tree)))
- (t (funcall fn tree))))
+ ((funcall fn tree))))
(defmacro --tree-mapreduce (form folder tree)
"Anaphoric form of `-tree-mapreduce'."
(declare (debug (def-form def-form form)))
- `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree))
+ `(-tree-mapreduce (lambda (it) (ignore it) ,form)
+ (lambda (it acc) (ignore it acc) ,folder)
+ ,tree))
(defun -tree-map (fn tree)
"Apply FN to each element of TREE while preserving the tree structure."
(cond
- ((not tree) nil)
+ ((null tree) ())
((-cons-pair? tree) (funcall fn tree))
- ((listp tree)
+ ((consp tree)
(mapcar (lambda (x) (-tree-map fn x)) tree))
- (t (funcall fn tree))))
+ ((funcall fn tree))))
(defmacro --tree-map (form tree)
"Anaphoric form of `-tree-map'."
(declare (debug (def-form form)))
- `(-tree-map (lambda (it) ,form) ,tree))
+ `(-tree-map (lambda (it) (ignore it) ,form) ,tree))
(defun -tree-reduce-from (fn init-value tree)
"Use FN to reduce elements of list TREE.
@@ -3012,16 +3048,19 @@ then on this result and second element from the list
etc.
The initial value is ignored on cons pairs as they always contain
two elements."
(cond
- ((not tree) nil)
+ ((null tree) ())
((-cons-pair? tree) tree)
- ((listp tree)
- (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn
init-value x)) tree)))
- (t tree)))
+ ((consp tree)
+ (-reduce-r-from
+ fn init-value
+ (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree)))
+ (tree)))
(defmacro --tree-reduce-from (form init-value tree)
"Anaphoric form of `-tree-reduce-from'."
(declare (debug (def-form form form)))
- `(-tree-reduce-from (lambda (it acc) ,form) ,init-value ,tree))
+ `(-tree-reduce-from (lambda (it acc) (ignore it acc) ,form)
+ ,init-value ,tree))
(defun -tree-reduce (fn tree)
"Use FN to reduce elements of list TREE.
@@ -3032,16 +3071,16 @@ element, then on this result and third element from the
list etc.
See `-reduce-r' for how exactly are lists of zero or one element handled."
(cond
- ((not tree) nil)
+ ((null tree) ())
((-cons-pair? tree) tree)
- ((listp tree)
+ ((consp tree)
(-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree)))
- (t tree)))
+ (tree)))
(defmacro --tree-reduce (form tree)
"Anaphoric form of `-tree-reduce'."
(declare (debug (def-form form)))
- `(-tree-reduce (lambda (it acc) ,form) ,tree))
+ `(-tree-reduce (lambda (it acc) (ignore it acc) ,form) ,tree))
(defun -tree-map-nodes (pred fun tree)
"Call FUN on each node of TREE that satisfies PRED.
@@ -3049,17 +3088,17 @@ See `-reduce-r' for how exactly are lists of zero or
one element handled."
If PRED returns nil, continue descending down this node. If PRED
returns non-nil, apply FUN to this node and do not descend
further."
- (if (funcall pred tree)
- (funcall fun tree)
- (if (and (listp tree)
- (not (-cons-pair? tree)))
- (-map (lambda (x) (-tree-map-nodes pred fun x)) tree)
- tree)))
+ (cond ((funcall pred tree) (funcall fun tree))
+ ((and (listp tree) (listp (cdr tree)))
+ (-map (lambda (x) (-tree-map-nodes pred fun x)) tree))
+ (tree)))
(defmacro --tree-map-nodes (pred form tree)
"Anaphoric form of `-tree-map-nodes'."
(declare (debug (def-form def-form form)))
- `(-tree-map-nodes (lambda (it) ,pred) (lambda (it) ,form) ,tree))
+ `(-tree-map-nodes (lambda (it) (ignore it) ,pred)
+ (lambda (it) (ignore it) ,form)
+ ,tree))
(defun -tree-seq (branch children tree)
"Return a sequence of the nodes in TREE, in depth-first search order.
@@ -3072,14 +3111,16 @@ of the passed branch node.
Non-branch nodes are simply copied."
(cons tree
- (when (funcall branch tree)
- (-mapcat (lambda (x) (-tree-seq branch children x))
- (funcall children tree)))))
+ (and (funcall branch tree)
+ (-mapcat (lambda (x) (-tree-seq branch children x))
+ (funcall children tree)))))
(defmacro --tree-seq (branch children tree)
"Anaphoric form of `-tree-seq'."
(declare (debug (def-form def-form form)))
- `(-tree-seq (lambda (it) ,branch) (lambda (it) ,children) ,tree))
+ `(-tree-seq (lambda (it) (ignore it) ,branch)
+ (lambda (it) (ignore it) ,children)
+ ,tree))
(defun -clone (list)
"Create a deep copy of LIST.
@@ -3087,7 +3128,7 @@ The new list has the same elements and structure but all
cons are
replaced with new ones. This is useful when you need to clone a
structure such as plist or alist."
(declare (pure t) (side-effect-free t))
- (-tree-map 'identity list))
+ (-tree-map #'identity list))
;;; Combinators
diff --git a/dash.texi b/dash.texi
index 5952cca34b..31e1896541 100644
--- a/dash.texi
+++ b/dash.texi
@@ -381,28 +381,33 @@ element of @var{list} paired with the unmodified element
of @var{list}.
@anchor{-splice}
@defun -splice (pred fun list)
-Splice lists generated by @var{fun} in place of elements matching @var{pred}
in @var{list}.
+Splice lists generated by @var{fun} in place of items satisfying @var{pred} in
@var{list}.
-@var{fun} takes the element matching @var{pred} as input.
+Call @var{pred} on each element of @var{list}. Whenever the result of
@var{pred}
+is @code{nil}, leave that @code{it} as-is. Otherwise, call @var{fun} on the
same
+@code{it} that satisfied @var{pred}. The result should be a (possibly
+empty) list of items to splice in place of @code{it} in @var{list}.
-This function can be used as replacement for @code{,@@} in case you
-need to splice several lists at marked positions (for example
-with keywords).
+This can be useful as an alternative to the @code{,@@} construct in a
+@code{`} structure, in case you need to splice several lists at
+marked positions (for example with keywords).
-See also: @code{-splice-list} (@pxref{-splice-list}), @code{-insert-at}
(@pxref{-insert-at})
+This function's anaphoric counterpart is @code{--splice}.
+
+See also: @code{-splice-list} (@pxref{-splice-list}), @code{-insert-at}
(@pxref{-insert-at}).
@example
@group
-(-splice 'even? (lambda (x) (list x x)) '(1 2 3 4))
- @result{} (1 2 2 3 4 4)
+(-splice #'numberp (lambda (n) (list n n)) '(a 1 b 2))
+ @result{} (a 1 1 b 2 2)
@end group
@group
-(--splice 't (list it it) '(1 2 3 4))
+(--splice t (list it it) '(1 2 3 4))
@result{} (1 1 2 2 3 3 4 4)
@end group
@group
-(--splice (equal it :magic) '((list of) (magical) (code)) '((foo) (bar) :magic
(baz)))
- @result{} ((foo) (bar) (list of) (magical) (code) (baz))
+(--splice (eq it :magic) '((magical) (code)) '((foo) :magic (bar)))
+ @result{} ((foo) (magical) (code) (bar))
@end group
@end example
@end defun
diff --git a/dev/dash-defs.el b/dev/dash-defs.el
index 1c3a6e65f5..a204bbe156 100644
--- a/dev/dash-defs.el
+++ b/dev/dash-defs.el
@@ -18,7 +18,7 @@
;;; Code:
(require 'dash)
-
+(require 'ert)
;; Added in Emacs 24.4; wrap in `eval-when-compile' when support is dropped.
(require 'subr-x nil t)
(declare-function string-remove-prefix "subr-x" (prefix string))
@@ -58,8 +58,7 @@ differences in implementation between systems. Used in place
of
(`(,actual => ,expected) `(should (equal ,actual ,expected)))
(`(,actual ~> ,expected) `(should (approx= ,actual ,expected)))
(`(,actual !!> ,(and (pred symbolp) expected))
- ;; FIXME: Tests fail on Emacs 24-25 without `eval' for some reason.
- `(should-error (eval ',actual ,lexical-binding) :type ',expected))
+ `(should-error ,actual :type ',expected))
(`(,actual !!> ,expected)
`(should (equal (should-error ,actual) ',expected)))
(_ (error "Invalid test case: %S" example))))
@@ -79,15 +78,19 @@ See `dash--groups'."
(setq examples (-partition 3 examples))
`(progn
(push (cons ',fn ',examples) dash--groups)
- (ert-deftest ,fn () ,@(mapcar #'dash--example-to-test examples))))
+ (ert-deftest ,fn ()
+ ;; Emacs 28.1 complains about an empty `let' body if the test
+ ;; body is empty.
+ ,@(or (mapcar #'dash--example-to-test examples) '(nil)))))
+
+;; Added in Emacs 25.1.
+(defvar text-quoting-style)
(autoload 'help-fns--analyze-function "help-fns")
(defun dash--describe (fn)
"Return the (ARGLIST . DOCSTRING) of FN symbol.
Based on `describe-function-1'."
- ;; Added in Emacs 25.1.
- (defvar text-quoting-style)
;; Gained last arg in Emacs 25.1.
(declare-function help-fns--signature "help-fns"
(function doc real-def real-function buffer))
@@ -215,10 +218,11 @@ Based on `describe-function-1'."
((replace-match "@dots{}" t t))))
(buffer-string)))
+;; Added in Emacs 26.1.
+(defvar print-escape-control-characters)
+
(defun dash--lisp-to-md (obj)
"Print Lisp OBJ suitably for Markdown."
- ;; Added in Emacs 26.1.
- (defvar print-escape-control-characters)
(let ((print-quoted t)
(print-escape-control-characters t))
(save-excursion (prin1 obj)))
diff --git a/dev/examples.el b/dev/examples.el
index fccda8bd6d..e94a334e52 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -28,22 +28,30 @@
(require 'dash)
(require 'dash-defs "dev/dash-defs")
-;; TODO: `setf' was introduced in Emacs 24.3, so remove this when
-;; support for earlier versions is dropped.
(eval-when-compile
+ ;; TODO: Emacs 24.3 first introduced `setf', so remove this when
+ ;; support for earlier versions is dropped.
(unless (fboundp 'setf)
- (require 'cl)))
+ (require 'cl))
+
+ ;; TODO: Emacs < 24.4 emitted a bogus warning when byte-compiling
+ ;; ERT tests, so remove this when support for those versions is
+ ;; dropped. See https://bugs.gnu.org/14883.
+ (and (< emacs-major-version 25)
+ (< emacs-minor-version 4)
+ (setq byte-compile-delete-errors t))
+
+ ;; Expander used in destructuring examples below.
+ (defun dash-expand:&hash-or-plist (key source)
+ "Sample destructuring which works with plists and hash tables."
+ `(if (hash-table-p ,source) (gethash ,key ,source)
+ (plist-get ,source ,key))))
;; FIXME: These definitions ought to be exported along with the
;; examples, if they are going to be used there.
(defun even? (num) (= 0 (% num 2)))
(defun square (num) (* num num))
-(defun dash-expand:&hash-or-plist (key source)
- "Sample destructoring which works with plists and hash-tables."
- `(if (hash-table-p ,source) (gethash ,key ,source)
- (plist-get ,source ,key)))
-
(def-example-group "Maps"
"Functions in this category take a transforming function, which
is then applied sequentially to each or selected elements of the
@@ -61,7 +69,7 @@ new list."
(-map-when 'even? 'square '(1 2 3 4)) => '(1 4 3 16)
(--map-when (> it 2) (* it it) '(1 2 3 4)) => '(1 2 9 16)
(--map-when (= it 2) 17 '(1 2 3 4)) => '(1 17 3 4)
- (-map-when (lambda (n) (= n 3)) (lambda (n) 0) '(1 2 3 4)) => '(1 2 0 4))
+ (-map-when (lambda (n) (= n 3)) (-const 0) '(1 2 3 4)) => '(1 2 0 4))
(defexamples -map-first
(-map-first 'even? 'square '(1 2 3 4)) => '(1 4 3 4)
@@ -97,9 +105,44 @@ new list."
(--annotate (< 1 it) '(0 1 2 3)) => '((nil . 0) (nil . 1) (t . 2) (t . 3)))
(defexamples -splice
- (-splice 'even? (lambda (x) (list x x)) '(1 2 3 4)) => '(1 2 2 3 4 4)
- (--splice 't (list it it) '(1 2 3 4)) => '(1 1 2 2 3 3 4 4)
- (--splice (equal it :magic) '((list of) (magical) (code)) '((foo) (bar)
:magic (baz))) => '((foo) (bar) (list of) (magical) (code) (baz)))
+ (-splice #'numberp (lambda (n) (list n n)) '(a 1 b 2)) => '(a 1 1 b 2 2)
+ (--splice t (list it it) '(1 2 3 4)) => '(1 1 2 2 3 3 4 4)
+ (--splice (eq it :magic) '((magical) (code)) '((foo) :magic (bar)))
+ => '((foo) (magical) (code) (bar))
+ (--splice nil (list (1+ it)) '()) => '()
+ (--splice nil (list (1+ it)) '(1)) => '(1)
+ (--splice t (list (1+ it)) '()) => '()
+ (--splice t (list (1+ it)) '(1)) => '(2)
+ (--splice nil '() '()) => '()
+ (--splice nil '() '(1)) => '(1)
+ (--splice t '() '()) => '()
+ (--splice t '() '(1)) => '()
+ (--splice t '() '(1 2)) => '()
+ (--splice (= it 1) '() '(1 2)) => '(2)
+ (--splice (= it 2) '() '(1 2)) => '(1)
+ (--splice (= it 1) '() '(1 2 3)) => '(2 3)
+ (--splice (= it 2) '() '(1 2 3)) => '(1 3)
+ (--splice (= it 3) '() '(1 2 3)) => '(1 2)
+ (-splice #'ignore (lambda (n) (list (1+ n))) '()) => '()
+ (-splice #'ignore (lambda (n) (list (1+ n))) '(1)) => '(1)
+ (-splice #'identity (lambda (n) (list (1+ n))) '()) => '()
+ (-splice #'identity (lambda (n) (list (1+ n))) '(1)) => '(2)
+ (-splice #'ignore #'ignore '()) => '()
+ (-splice #'ignore #'ignore '(1)) => '(1)
+ (-splice #'identity #'ignore '()) => '()
+ (-splice #'identity #'ignore '(1)) => '()
+ (-splice #'identity #'ignore '(1 2)) => '()
+ (-splice (-cut = 1 <>) #'ignore '(1 2)) => '(2)
+ (-splice (-cut = 2 <>) #'ignore '(1 2)) => '(1)
+ (-splice (-cut = 1 <>) #'ignore '(1 2 3)) => '(2 3)
+ (-splice (-cut = 2 <>) #'ignore '(1 2 3)) => '(1 3)
+ (-splice (-cut = 3 <>) #'ignore '(1 2 3)) => '(1 2)
+ ;; Test for destructive modification.
+ (let ((l1 (list 1 2 3))
+ (l2 (list 4 5 6)))
+ (--splice (= it 2) l2 l1)
+ (list l1 l2))
+ => '((1 2 3) (4 5 6)))
(defexamples -splice-list
(-splice-list 'keywordp '(a b c) '(1 :foo 2)) => '(1 a b c 2)
@@ -345,9 +388,10 @@ new list."
(-flatten-n 0 '((1 2) (3 4))) => '((1 2) (3 4))
(-flatten-n 0 '(((1 2) (3 4)))) => '(((1 2) (3 4)))
(-flatten-n 1 '(((1 . 2)) ((3 . 4)))) => '((1 . 2) (3 . 4))
- (let ((l (list 1 (list 2) 3))) (-flatten-n 0 l) l) => '(1 (2) 3)
- (let ((l (list 1 (list 2) 3))) (-flatten-n 1 l) l) => '(1 (2) 3)
- (let ((l (list 1 (list 2) 3))) (-flatten-n 2 l) l) => '(1 (2) 3))
+ ;; Test for destructive modification.
+ (let ((l (list 1 (list 2) 3))) (ignore (-flatten-n 0 l)) l) => '(1 (2) 3)
+ (let ((l (list 1 (list 2) 3))) (ignore (-flatten-n 1 l)) l) => '(1 (2) 3)
+ (let ((l (list 1 (list 2) 3))) (ignore (-flatten-n 2 l)) l) => '(1 (2) 3))
(defexamples -replace
(-replace 1 "1" '(1 2 3 4 3 2 1)) => '("1" 2 3 4 3 2 "1")
@@ -1226,15 +1270,16 @@ related predicates."
(-list 1) => '(1)
(-list '()) => '()
(-list '(1 2 3)) => '(1 2 3)
- (-list 1 2 3) => '(1 2 3)
+ (with-no-warnings (-list 1 2 3)) => '(1 2 3)
(let ((l (list 1 2))) (setcar (-list l) 3) l) => '(3 2)
- (let ((l (list 1 2))) (setcar (apply #'-list l) 3) l) => '(1 2)
+ (let ((l (list 1 2))) (setcar (apply #'-list l) 3) l)
+ => '(1 2)
(-list '((1) (2))) => '((1) (2))
- (-list) => ()
- (-list () 1) => ()
- (-list () ()) => ()
- (-list 1 ()) => '(1 ())
- (-list 1 '(2)) => '(1 (2))
+ (with-no-warnings (-list)) => ()
+ (with-no-warnings (-list () 1)) => ()
+ (with-no-warnings (-list () ())) => ()
+ (with-no-warnings (-list 1 ())) => '(1 ())
+ (with-no-warnings (-list 1 '(2))) => '(1 (2))
(-list '(())) => '(())
(-list '(() 1)) => '(() 1))
@@ -1384,7 +1429,8 @@ or readability."
=> '()
(-some--> '(0 1) (-filter #'natnump it) (append it it) (-map #'1+ it))
=> '(1 2 1 2)
- (-some--> 1 nil) !!> (void-function nil)
+ ;; FIXME: Is there a better way to have this compile without warnings?
+ (eval '(-some--> 1 nil) t) !!> (void-function nil)
(-some--> nil) => nil
(-some--> t) => t)
@@ -1402,7 +1448,9 @@ or readability."
(-when-let ((&plist :foo foo) (list :foo "foo")) foo) => "foo"
(-when-let ((&plist :foo foo) (list :bar "bar")) foo) => nil
(--when-let (member :b '(:a :b :c)) (cons :d it)) => '(:d :b :c)
- (--when-let (even? 3) (cat it :a)) => nil)
+ ;; Check negative condition irrespective of compiler optimizations.
+ (--when-let (stringp ()) (cons it :a)) => nil
+ (--when-let (stringp (list ())) (cons it :a)) => nil)
(defexamples -when-let*
(-when-let* ((x 5) (y 3) (z (+ y 4))) (+ x y z)) => 15
@@ -1462,7 +1510,7 @@ or readability."
(-let [[a b &rest [c d]] [1 2 3 4 5 6]] (list a b c d)) => '(1 2 3 4)
;; here we error, because "vectors" are rigid, immutable structures,
;; so we should know how many elements there are
- (-let [[a b c d] [1 2 3]] t) !!> args-out-of-range
+ (-let [[a b c d] [1 2 3]] (+ a b c d)) !!> args-out-of-range
(-let [(a . (b . c)) (cons 1 (cons 2 3))] (list a b c)) => '(1 2 3)
(-let [(_ _ . [a b]) (cons 1 (cons 2 (vector 3 4)))] (list a b)) => '(3 4)
(-let [(_ _ . (a b)) (cons 1 (cons 2 (list 3 4)))] (list a b)) => '(3 4)
@@ -1555,7 +1603,7 @@ or readability."
(puthash :foo 1 hash)
(puthash :bar 2 hash)
(-let (((&hash :foo :bar) hash)) (list foo bar))) => '(1 2)
- (-let (((&hash :foo (&hash? :bar)) (make-hash-table)))) => nil
+ (-let (((&hash :foo (&hash? :bar)) (make-hash-table))) bar) => nil
;; Ensure `hash?' expander evaluates its arg only once
(let* ((ht (make-hash-table :test #'equal))
(fn (lambda (ht) (push 3 (gethash 'a ht)) ht)))
@@ -1581,8 +1629,9 @@ or readability."
(-let (((&alist "c" 'b :a) (list (cons :a 1) (cons 'b 2) (cons "c" 3))))
(list a b c)) => '(1 2 3)
(-let (((&alist "c" :a 'b) (list (cons :a 1) (cons 'b 2) (cons "c" 3))))
(list a b c)) => '(1 2 3)
(-let (((&alist :a "c" 'b) (list (cons :a 1) (cons 'b 2) (cons "c" 3))))
(list a b c)) => '(1 2 3)
- (-let (((&plist 'foo 1) (list 'foo 'bar))) (list foo)) !!> error
- (-let (((&plist foo :bar) (list :foo :bar))) (list foo)) !!> error
+ ;; FIXME: Byte-compiler chokes on these in Emacs < 26.
+ (eval '(-let (((&plist 'foo 1) (list 'foo 'bar))) (list foo)) t) !!> error
+ (eval '(-let (((&plist foo :bar) (list :foo :bar))) (list foo)) t) !!>
error
;; test the &as form
(-let (((items &as first . rest) (list 1 2 3))) (list first rest items))
=> '(1 (2 3) (1 2 3))
(-let [(all &as [vect &as a b] bar) (list [1 2] 3)] (list a b bar vect
all)) => '(1 2 3 [1 2] ([1 2] 3))
@@ -1601,12 +1650,16 @@ or readability."
(-let [(list &as _ _ _ a _ _ _ b _ _ _ c) (list 1 2 3 4 5 6 7 8 9 10 11
12)] (list a b c list)) => '(4 8 12 (1 2 3 4 5 6 7 8 9 10 11 12))
(-let (((x &as a b) (list 1 2))
((y &as c d) (list 3 4)))
- (list a b c d x y)) => '(1 2 3 4 (1 2) (3 4))
- (-let (((&hash-or-plist :key) (--doto (make-hash-table)
- (puthash :key "value" it))))
- key) => "value"
+ (list a b c d x y))
+ => '(1 2 3 4 (1 2) (3 4))
+ (-let (((&hash-or-plist :key)
+ (--doto (make-hash-table)
+ (puthash :key "value" it))))
+ key)
+ => "value"
(-let (((&hash-or-plist :key) '(:key "value")))
- key) => "value")
+ key)
+ => "value")
(defexamples -let*
(-let* (((a . b) (cons 1 2))
@@ -1620,9 +1673,11 @@ or readability."
(list foo a b c bar)) => '(1 a b c (a b c))
(let ((a (list 1 2 3))
(b (list 'a 'b 'c)))
+ (ignore b)
(-let* (((a . b) a)
((c . d) b)) ;; b here comes from above binding
- (list a b c d))) => '(1 (2 3) 2 (3))
+ (list a b c d)))
+ => '(1 (2 3) 2 (3))
(-let* ((a "foo") (b a)) (list a b)) => '("foo" "foo")
;; test bindings with no explicit val
(-let* (a) a) => nil
@@ -1637,7 +1692,8 @@ or readability."
(-map (-lambda ((&plist :a a :b b)) (+ a b)) '((:a 1 :b 2) (:a 3 :b 4) (:a
5 :b 6))) => '(3 7 11)
(-map (-lambda (x) (let ((k (car x)) (v (cadr x))) (+ k v))) '((1 2) (3 4)
(5 6))) => '(3 7 11)
(funcall (-lambda ((a) (b)) (+ a b)) '(1 2 3) '(4 5 6)) => 5
- (-lambda a t) !!> wrong-type-argument
+ ;; FIXME: Byte-compiler chokes on this in Emacs < 26.
+ (eval '(-lambda a t) t) !!> wrong-type-argument
(funcall (-lambda (a b) (+ a b)) 1 2) => 3
(funcall (-lambda (a (b c)) (+ a b c)) 1 (list 2 3)) => 6
(funcall (-lambda () 1)) => 1
@@ -1649,9 +1705,14 @@ or readability."
(let (a b) (-setq (a b) (list 1 2)) (list a b)) => '(1 2)
(let (c) (-setq (&plist :c c) (list :c "c")) c) => "c"
(let (a b) (-setq a 1 b 2) (list a b)) => '(1 2)
- (let (a b) (-setq (&plist :a a) '(:a (:b 1)) (&plist :b b) a) b) => 1
- (let (a b) (-setq (a b (&plist 'x x 'y y)) '(1 2 (x 3 y 4)) z x)) => 3
- (let (a) (-setq a)) !!> wrong-number-of-arguments))
+ (let (a b) (-setq (&plist :a a) '(:a (:b 1)) (&plist :b b) a) (cons b a))
+ => '(1 :b 1)
+ (let (a b x y z)
+ (ignore a b x y z)
+ (-setq (a b (&plist 'x x 'y y)) '(1 2 (x 3 y 4)) z x))
+ => 3
+ ;; FIXME: Byte-compiler chokes on this in Emacs < 26.
+ (eval '(let (a) (-setq a)) t) !!> wrong-number-of-arguments))
(def-example-group "Side effects"
"Functions iterating over lists for side effect only."
