emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/dash 759682332a: Byte-compile tests


From: ELPA Syncer
Subject: [elpa] externals/dash 759682332a: Byte-compile tests
Date: Mon, 16 May 2022 18:57:25 -0400 (EDT)

branch: externals/dash
commit 759682332a0ebd737802d9fa0a80ceedf05088b6
Author: Basil L. Contovounesios <contovob@tcd.ie>
Commit: Basil L. Contovounesios <contovob@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."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]