Package: emacs;
Reported by: Tino Calancha <tino.calancha <at> gmail.com>
Date: Tue, 21 Feb 2017 08:06:01 UTC
Severity: wishlist
Found in version 26.0.50
Done: Tino Calancha <tino.calancha <at> gmail.com>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 25826 in the body.
You can then email your comments to 25826 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
bug-gnu-emacs <at> gnu.org:bug#25826; Package emacs.
(Tue, 21 Feb 2017 08:06:01 GMT) Full text and rfc822 format available.Tino Calancha <tino.calancha <at> gmail.com>:bug-gnu-emacs <at> gnu.org.
(Tue, 21 Feb 2017 08:06:01 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: bug-gnu-emacs <at> gnu.org Cc: tino.calancha <at> gmail.com Subject: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Tue, 21 Feb 2017 17:04:54 +0900
Current implementation of cl-mapc (cl-mapl) uses `cl-mapcar'
(`cl-maplist') when input contains > 1 sequence. Thus,
they cons the values and just discard then at the end.
Following patch adds a defvar which acts as a flag for consing
the values. The flag is bind to nil in the case of `cl-mapc' and
`cl-mapl'.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 4ec295868fde6995e9044ee17b4a16829a1aa573 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha <at> gmail.com>
Date: Tue, 21 Feb 2017 12:21:13 +0900
Subject: [PATCH] Prevent for consing in cl-mapc and cl-mapl
* lisp/emacs-lisp/cl-extra.el (cl--accumulate): New defvar.
(cl--mapcar-many, cl-maplist): Accumulate values only if
cl--accumulate is non-nil (Bug#25826).
(cl-mapc, cl-mapl): Bind cl--accumulate to nil.
* lisp/emacs-lisp/cl-lib.el (mapcar): Add autoload cookie.
Accumulate values only if cl--accumulate is non-nil.
---
lisp/emacs-lisp/cl-extra.el | 38 +++++++++++++++++++++++++-------------
lisp/emacs-lisp/cl-lib.el | 7 +++++--
2 files changed, 30 insertions(+), 15 deletions(-)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index edd14b816f..60a454b897 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -88,6 +88,9 @@ cl-equalp
;;; Control structures.
+;; Bound to nil in `cl-mapc' and `cl-map-l'.
+(defvar cl--accumulate t)
+
;;;###autoload
(defun cl--mapcar-many (cl-func cl-seqs)
(if (cdr (cdr cl-seqs))
@@ -106,20 +109,23 @@ cl--mapcar-many
(setcar cl-p1 (cdr (car cl-p1))))
(aref (car cl-p1) cl-i)))
(setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))
- (push (apply cl-func cl-args) cl-res)
+ (if cl--accumulate
+ (push (apply cl-func cl-args) cl-res)
+ (apply cl-func cl-args))
(setq cl-i (1+ cl-i)))
- (nreverse cl-res))
+ (and cl--accumulate (nreverse cl-res)))
(let ((cl-res nil)
(cl-x (car cl-seqs))
(cl-y (nth 1 cl-seqs)))
(let ((cl-n (min (length cl-x) (length cl-y)))
(cl-i -1))
(while (< (setq cl-i (1+ cl-i)) cl-n)
- (push (funcall cl-func
+ (let ((val (funcall cl-func
(if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
- (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
- cl-res)))
- (nreverse cl-res))))
+ (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))))
+ (when cl--accumulate
+ (push val cl-res)))))
+ (and cl--accumulate (nreverse cl-res)))))
;;;###autoload
(defun cl-map (cl-type cl-func cl-seq &rest cl-rest)
@@ -140,23 +146,28 @@ cl-maplist
(cl-args (cons cl-list (copy-sequence cl-rest)))
cl-p)
(while (not (memq nil cl-args))
- (push (apply cl-func cl-args) cl-res)
+ (if cl--accumulate
+ (push (apply cl-func cl-args) cl-res)
+ (apply cl-func cl-args))
(setq cl-p cl-args)
(while cl-p (setcar cl-p (cdr (pop cl-p)) )))
- (nreverse cl-res))
+ (and cl--accumulate (nreverse cl-res)))
(let ((cl-res nil))
(while cl-list
- (push (funcall cl-func cl-list) cl-res)
+ (if cl--accumulate
+ (push (funcall cl-func cl-list) cl-res)
+ (funcall cl-func cl-list))
(setq cl-list (cdr cl-list)))
- (nreverse cl-res))))
+ (and cl--accumulate (nreverse cl-res)))))
;;;###autoload
(defun cl-mapc (cl-func cl-seq &rest cl-rest)
"Like `cl-mapcar', but does not accumulate values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(if cl-rest
- (progn (apply 'cl-map nil cl-func cl-seq cl-rest)
- cl-seq)
+ (let (cl--accumulate)
+ (apply 'cl-map nil cl-func cl-seq cl-rest)
+ cl-seq)
(mapc cl-func cl-seq)))
;;;###autoload
@@ -164,7 +175,8 @@ cl-mapl
"Like `cl-maplist', but does not accumulate values returned by the function.
\n(fn FUNCTION LIST...)"
(if cl-rest
- (apply 'cl-maplist cl-func cl-list cl-rest)
+ (let (cl--accumulate)
+ (apply 'cl-maplist cl-func cl-list cl-rest))
(let ((cl-p cl-list))
(while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
cl-list)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 5aa8f1bf65..b2d6d1cb1f 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -349,6 +349,7 @@ cl-float-negative-epsilon
(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs))
+;;;###autoload
(defun cl-mapcar (cl-func cl-x &rest cl-rest)
"Apply FUNCTION to each element of SEQ, and make a list of the results.
If there are several SEQs, FUNCTION is called with that many arguments,
@@ -361,8 +362,10 @@ cl-mapcar
(cl--mapcar-many cl-func (cons cl-x cl-rest))
(let ((cl-res nil) (cl-y (car cl-rest)))
(while (and cl-x cl-y)
- (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
- (nreverse cl-res)))
+ (if cl--accumulate
+ (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res)
+ (funcall cl-func (pop cl-x) (pop cl-y))))
+ (and cl--accumulate (nreverse cl-res))))
(mapcar cl-func cl-x)))
(cl--defalias 'cl-svref 'aref)
--
2.11.0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.7)
of 2017-02-21
Repository revision: 96cea19842b577eb4f2e057d702aea54d736233e
bug-gnu-emacs <at> gnu.org:bug#25826; Package emacs.
(Tue, 21 Feb 2017 13:40:01 GMT) Full text and rfc822 format available.Message #8 received at 25826 <at> debbugs.gnu.org (full text, mbox):
From: npostavs <at> users.sourceforge.net To: Tino Calancha <tino.calancha <at> gmail.com> Cc: 25826 <at> debbugs.gnu.org Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Tue, 21 Feb 2017 08:40:18 -0500
Tino Calancha <tino.calancha <at> gmail.com> writes: > Current implementation of cl-mapc (cl-mapl) uses `cl-mapcar' > (`cl-maplist') when input contains > 1 sequence. Thus, > they cons the values and just discard then at the end. > > Following patch adds a defvar which acts as a flag for consing > the values. The flag is bind to nil in the case of `cl-mapc' and > `cl-mapl'. Is it possible to do this via a parameter instead? Using a global variable seems like asking for trouble in case of nested calls or similar.
bug-gnu-emacs <at> gnu.org:bug#25826; Package emacs.
(Wed, 22 Feb 2017 03:09:02 GMT) Full text and rfc822 format available.Message #11 received at 25826 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: npostavs <at> users.sourceforge.net Cc: 25826 <at> debbugs.gnu.org, tino.calancha <at> gmail.com Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Wed, 22 Feb 2017 12:08:34 +0900
npostavs <at> users.sourceforge.net writes:
> Tino Calancha <tino.calancha <at> gmail.com> writes:
>
>> Current implementation of cl-mapc (cl-mapl) uses `cl-mapcar'
>> (`cl-maplist') when input contains > 1 sequence. Thus,
>> they cons the values and just discard then at the end.
>>
>> Following patch adds a defvar which acts as a flag for consing
>> the values. The flag is bind to nil in the case of `cl-mapc' and
>> `cl-mapl'.
>
> Is it possible to do this via a parameter instead? Using a global
> variable seems like asking for trouble in case of nested calls or
> similar.
How about the following updated patch?
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 917e290e9101426b492becd814f2f570d1fc9802 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha <at> gmail.com>
Date: Wed, 22 Feb 2017 12:06:04 +0900
Subject: [PATCH] Prevent for consing in cl-mapc and cl-mapl
* lisp/emacs-lisp/cl-extra.el (cl--mapcar-many): Add optional arg ACC;
If non-nil, accumulate values in the result (Bug#25826).
(cl-mapc): Do computations inside function instead of call cl-map.
(cl-mapl): Do computations inside function instead of call cl-maplist.
* lisp/emacs-lisp/cl-lib.el (mapcar): Add autoload cookie.
Call cl--mapcar-many with non-nil 3rd argument.
---
lisp/emacs-lisp/cl-extra.el | 38 ++++++++++++++++++++++++++------------
lisp/emacs-lisp/cl-lib.el | 5 +++--
2 files changed, 29 insertions(+), 14 deletions(-)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index edd14b816f..8cba913710 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -89,7 +89,7 @@ cl-equalp
;;; Control structures.
;;;###autoload
-(defun cl--mapcar-many (cl-func cl-seqs)
+(defun cl--mapcar-many (cl-func cl-seqs &optional acc)
(if (cdr (cdr cl-seqs))
(let* ((cl-res nil)
(cl-n (apply 'min (mapcar 'length cl-seqs)))
@@ -106,20 +106,23 @@ cl--mapcar-many
(setcar cl-p1 (cdr (car cl-p1))))
(aref (car cl-p1) cl-i)))
(setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))
- (push (apply cl-func cl-args) cl-res)
+ (if acc
+ (push (apply cl-func cl-args) cl-res)
+ (apply cl-func cl-args))
(setq cl-i (1+ cl-i)))
- (nreverse cl-res))
+ (and acc (nreverse cl-res)))
(let ((cl-res nil)
(cl-x (car cl-seqs))
(cl-y (nth 1 cl-seqs)))
(let ((cl-n (min (length cl-x) (length cl-y)))
(cl-i -1))
(while (< (setq cl-i (1+ cl-i)) cl-n)
- (push (funcall cl-func
- (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
- (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
- cl-res)))
- (nreverse cl-res))))
+ (let ((val (funcall cl-func
+ (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
+ (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))))
+ (when acc
+ (push val cl-res)))))
+ (and acc (nreverse cl-res)))))
;;;###autoload
(defun cl-map (cl-type cl-func cl-seq &rest cl-rest)
@@ -142,7 +145,7 @@ cl-maplist
(while (not (memq nil cl-args))
(push (apply cl-func cl-args) cl-res)
(setq cl-p cl-args)
- (while cl-p (setcar cl-p (cdr (pop cl-p)) )))
+ (while cl-p (setcar cl-p (cdr (pop cl-p)))))
(nreverse cl-res))
(let ((cl-res nil))
(while cl-list
@@ -155,8 +158,14 @@ cl-mapc
"Like `cl-mapcar', but does not accumulate values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(if cl-rest
- (progn (apply 'cl-map nil cl-func cl-seq cl-rest)
- cl-seq)
+ (if (or (cdr cl-rest) (nlistp cl-seq) (nlistp (car cl-rest)))
+ (progn
+ (cl--mapcar-many cl-func (cons cl-seq cl-rest))
+ cl-seq)
+ (let ((cl-x cl-seq) (cl-y (car cl-rest)))
+ (while (and cl-x cl-y)
+ (funcall cl-func (pop cl-x) (pop cl-y)))
+ cl-seq))
(mapc cl-func cl-seq)))
;;;###autoload
@@ -164,7 +173,12 @@ cl-mapl
"Like `cl-maplist', but does not accumulate values returned by the function.
\n(fn FUNCTION LIST...)"
(if cl-rest
- (apply 'cl-maplist cl-func cl-list cl-rest)
+ (let ((cl-args (cons cl-list (copy-sequence cl-rest)))
+ cl-p)
+ (while (not (memq nil cl-args))
+ (apply cl-func cl-args)
+ (setq cl-p cl-args)
+ (while cl-p (setcar cl-p (cdr (pop cl-p))))))
(let ((cl-p cl-list))
(while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
cl-list)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 5aa8f1bf65..8c4455a3da 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -347,8 +347,9 @@ cl-float-negative-epsilon
(cl--defalias 'cl-copy-seq 'copy-sequence)
-(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs))
+(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs &optional acc))
+;;;###autoload
(defun cl-mapcar (cl-func cl-x &rest cl-rest)
"Apply FUNCTION to each element of SEQ, and make a list of the results.
If there are several SEQs, FUNCTION is called with that many arguments,
@@ -358,7 +359,7 @@ cl-mapcar
\n(fn FUNCTION SEQ...)"
(if cl-rest
(if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
- (cl--mapcar-many cl-func (cons cl-x cl-rest))
+ (cl--mapcar-many cl-func (cons cl-x cl-rest) 'accumulate)
(let ((cl-res nil) (cl-y (car cl-rest)))
(while (and cl-x cl-y)
(push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
--
2.11.0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50 (build 2, x86_64-pc-linux-gnu, GTK+ Version 3.22.7)
of 2017-02-22
Repository revision: fb997d30af28da4712ca64876feddbd07db20e13
bug-gnu-emacs <at> gnu.org:bug#25826; Package emacs.
(Wed, 22 Feb 2017 03:33:02 GMT) Full text and rfc822 format available.Message #14 received at 25826 <at> debbugs.gnu.org (full text, mbox):
From: npostavs <at> users.sourceforge.net To: Tino Calancha <tino.calancha <at> gmail.com> Cc: 25826 <at> debbugs.gnu.org Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Tue, 21 Feb 2017 22:33:50 -0500
Tino Calancha <tino.calancha <at> gmail.com> writes: > How about the following updated patch? Looks good. Perhaps some tests would be a good idea too?
bug-gnu-emacs <at> gnu.org:bug#25826; Package emacs.
(Wed, 22 Feb 2017 04:15:01 GMT) Full text and rfc822 format available.Message #17 received at 25826 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: npostavs <at> users.sourceforge.net Cc: 25826 <at> debbugs.gnu.org, Tino Calancha <tino.calancha <at> gmail.com> Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Wed, 22 Feb 2017 13:14:04 +0900 (JST)
On Tue, 21 Feb 2017, npostavs <at> users.sourceforge.net wrote: > Tino Calancha <tino.calancha <at> gmail.com> writes: > >> How about the following updated patch? > > Looks good. Perhaps some tests would be a good idea too? I think so, i will prepare some and post them here. Thanks.
bug-gnu-emacs <at> gnu.org:bug#25826; Package emacs.
(Wed, 22 Feb 2017 05:47:01 GMT) Full text and rfc822 format available.Message #20 received at 25826 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: npostavs <at> users.sourceforge.net Cc: 25826 <at> debbugs.gnu.org, tino.calancha <at> gmail.com Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Wed, 22 Feb 2017 14:46:45 +0900
Tino Calancha <tino.calancha <at> gmail.com> writes:
> On Tue, 21 Feb 2017, npostavs <at> users.sourceforge.net wrote:
>
>> Tino Calancha <tino.calancha <at> gmail.com> writes:
>>
>>> How about the following updated patch?
>>
>> Looks good. Perhaps some tests would be a good idea too?
> I think so, i will prepare some and post them here. Thanks.
It's tricky to write a test to check if cl-mapc/cl-mapl over cons.
Thus, i have written tests that just ensure the return values
are as expected.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 2824777a3b1b5217fb1dd5cddc89f4f2b5679b7a Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha <at> gmail.com>
Date: Wed, 22 Feb 2017 14:38:17 +0900
Subject: [PATCH] Prevent for consing in cl-mapc and cl-mapl
* lisp/emacs-lisp/cl-extra.el (cl--mapcar-many): Add optional arg ACC;
If non-nil, accumulate values in the result (Bug#25826).
(cl-mapc): Do computations inside function instead of call cl-map.
(cl-mapl): Do computations inside function instead of call cl-maplist.
* lisp/emacs-lisp/cl-lib.el (mapcar): Add autoload cookie.
Call cl--mapcar-many with non-nil 3rd argument.
* test/lisp/emacs-lisp/cl-extra-tests.el (cl-extra-test-map)
(cl-extra-test-mapc, cl-extra-test-mapcar, cl-extra-test-mapl)
(cl-extra-test-maplist): New tests.
---
lisp/emacs-lisp/cl-extra.el | 38 +++++++++++++++-------
lisp/emacs-lisp/cl-lib.el | 5 +--
test/lisp/emacs-lisp/cl-extra-tests.el | 59 ++++++++++++++++++++++++++++++++++
3 files changed, 88 insertions(+), 14 deletions(-)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index edd14b816f..8cba913710 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -89,7 +89,7 @@ cl-equalp
;;; Control structures.
;;;###autoload
-(defun cl--mapcar-many (cl-func cl-seqs)
+(defun cl--mapcar-many (cl-func cl-seqs &optional acc)
(if (cdr (cdr cl-seqs))
(let* ((cl-res nil)
(cl-n (apply 'min (mapcar 'length cl-seqs)))
@@ -106,20 +106,23 @@ cl--mapcar-many
(setcar cl-p1 (cdr (car cl-p1))))
(aref (car cl-p1) cl-i)))
(setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))
- (push (apply cl-func cl-args) cl-res)
+ (if acc
+ (push (apply cl-func cl-args) cl-res)
+ (apply cl-func cl-args))
(setq cl-i (1+ cl-i)))
- (nreverse cl-res))
+ (and acc (nreverse cl-res)))
(let ((cl-res nil)
(cl-x (car cl-seqs))
(cl-y (nth 1 cl-seqs)))
(let ((cl-n (min (length cl-x) (length cl-y)))
(cl-i -1))
(while (< (setq cl-i (1+ cl-i)) cl-n)
- (push (funcall cl-func
- (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
- (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
- cl-res)))
- (nreverse cl-res))))
+ (let ((val (funcall cl-func
+ (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
+ (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))))
+ (when acc
+ (push val cl-res)))))
+ (and acc (nreverse cl-res)))))
;;;###autoload
(defun cl-map (cl-type cl-func cl-seq &rest cl-rest)
@@ -142,7 +145,7 @@ cl-maplist
(while (not (memq nil cl-args))
(push (apply cl-func cl-args) cl-res)
(setq cl-p cl-args)
- (while cl-p (setcar cl-p (cdr (pop cl-p)) )))
+ (while cl-p (setcar cl-p (cdr (pop cl-p)))))
(nreverse cl-res))
(let ((cl-res nil))
(while cl-list
@@ -155,8 +158,14 @@ cl-mapc
"Like `cl-mapcar', but does not accumulate values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(if cl-rest
- (progn (apply 'cl-map nil cl-func cl-seq cl-rest)
- cl-seq)
+ (if (or (cdr cl-rest) (nlistp cl-seq) (nlistp (car cl-rest)))
+ (progn
+ (cl--mapcar-many cl-func (cons cl-seq cl-rest))
+ cl-seq)
+ (let ((cl-x cl-seq) (cl-y (car cl-rest)))
+ (while (and cl-x cl-y)
+ (funcall cl-func (pop cl-x) (pop cl-y)))
+ cl-seq))
(mapc cl-func cl-seq)))
;;;###autoload
@@ -164,7 +173,12 @@ cl-mapl
"Like `cl-maplist', but does not accumulate values returned by the function.
\n(fn FUNCTION LIST...)"
(if cl-rest
- (apply 'cl-maplist cl-func cl-list cl-rest)
+ (let ((cl-args (cons cl-list (copy-sequence cl-rest)))
+ cl-p)
+ (while (not (memq nil cl-args))
+ (apply cl-func cl-args)
+ (setq cl-p cl-args)
+ (while cl-p (setcar cl-p (cdr (pop cl-p))))))
(let ((cl-p cl-list))
(while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
cl-list)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 5aa8f1bf65..8c4455a3da 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -347,8 +347,9 @@ cl-float-negative-epsilon
(cl--defalias 'cl-copy-seq 'copy-sequence)
-(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs))
+(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs &optional acc))
+;;;###autoload
(defun cl-mapcar (cl-func cl-x &rest cl-rest)
"Apply FUNCTION to each element of SEQ, and make a list of the results.
If there are several SEQs, FUNCTION is called with that many arguments,
@@ -358,7 +359,7 @@ cl-mapcar
\n(fn FUNCTION SEQ...)"
(if cl-rest
(if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
- (cl--mapcar-many cl-func (cons cl-x cl-rest))
+ (cl--mapcar-many cl-func (cons cl-x cl-rest) 'accumulate)
(let ((cl-res nil) (cl-y (car cl-rest)))
(while (and cl-x cl-y)
(push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el
index 3e2388acc6..82b2206a6c 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -35,4 +35,63 @@
(should (eq (cl-getf plist 'y :none) nil))
(should (eq (cl-getf plist 'z :none) :none))))
+(ert-deftest cl-extra-test-mapc ()
+ (let ((lst '(a b c))
+ (lst2 '(d e f))
+ (lst3 '(1 2 3))
+ (fn1 (lambda (x) nil))
+ (fn2 (lambda (x y) nil))
+ (fn3 (lambda (x y z) nil)))
+ (should (equal lst (cl-mapc fn1 lst)))
+ (should (equal lst (cl-mapc fn2 lst lst2)))
+ (should (equal lst (cl-mapc fn3 lst lst2 lst3)))))
+
+(ert-deftest cl-extra-test-mapl ()
+ (let ((lst '(a b c))
+ (lst2 '(d e f))
+ (lst3 '(1 2 3))
+ (fn1 (lambda (x) nil))
+ (fn2 (lambda (x y) nil))
+ (fn3 (lambda (x y z) nil)))
+ (should (equal lst (cl-mapl fn1 lst)))
+ (should (equal lst (cl-mapl fn2 lst lst2)))
+ (should (equal lst (cl-mapl fn3 lst lst2 lst3)))))
+
+(ert-deftest cl-extra-test-mapcar ()
+ (let ((lst '(a b c))
+ (lst2 '(d e f))
+ (lst3 '(1 2 3))
+ (fn1 (lambda (x) x))
+ (fn2 (lambda (x y) y))
+ (fn3 (lambda (x y z) z)))
+ (should (equal lst (cl-mapcar fn1 lst)))
+ (should (equal lst2 (cl-mapcar fn2 lst lst2)))
+ (should (equal lst3 (cl-mapcar fn3 lst lst2 lst3)))))
+
+(ert-deftest cl-extra-test-map ()
+ (let ((lst '(a b c))
+ (lst2 '(d e f))
+ (lst3 '(1 2 3))
+ (fn1 (lambda (x) x))
+ (fn2 (lambda (x y) y))
+ (fn3 (lambda (x y z) (string-to-char (format "%S" x)))))
+ (should (equal lst (cl-map 'list fn1 lst)))
+ (should (equal (vconcat lst2) (cl-map 'vector fn2 lst lst2)))
+ (should (equal (mapconcat (lambda (x) (format "%S" x)) lst "")
+ (cl-map 'string fn3 lst lst2 lst3)))))
+
+(ert-deftest cl-extra-test-maplist ()
+ (let ((lst '(a b c))
+ (lst2 '(d e f))
+ (lst3 '(1 2 3))
+ (fn1 (lambda (x) x))
+ (fn2 (lambda (x y) y))
+ (fn3 (lambda (x y z) z)))
+ (should (equal (list lst (cdr lst) (cddr lst))
+ (cl-maplist fn1 lst)))
+ (should (equal (list lst2 (cdr lst2) (cddr lst2))
+ (cl-maplist fn2 lst lst2)))
+ (should (equal (list lst3 (cdr lst3) (cddr lst3))
+ (cl-maplist fn3 lst lst2 lst3)))))
+
;;; cl-extra-tests.el ends here
--
2.11.0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50 (build 4, x86_64-pc-linux-gnu, GTK+ Version 3.22.7)
of 2017-02-22
Repository revision: fb997d30af28da4712ca64876feddbd07db20e13
bug-gnu-emacs <at> gnu.org:bug#25826; Package emacs.
(Thu, 23 Feb 2017 01:55:02 GMT) Full text and rfc822 format available.Message #23 received at 25826 <at> debbugs.gnu.org (full text, mbox):
From: npostavs <at> users.sourceforge.net To: Tino Calancha <tino.calancha <at> gmail.com> Cc: 25826 <at> debbugs.gnu.org Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Wed, 22 Feb 2017 20:55:58 -0500
[Message part 1 (text/plain, inline)]
Tino Calancha <tino.calancha <at> gmail.com> writes: > It's tricky to write a test to check if cl-mapc/cl-mapl over cons. > Thus, i have written tests that just ensure the return values > are as expected. We should check that the args are consp at least:
[0001-fixup-Prevent-for-consing-in-cl-mapc-and-cl-mapl.patch (text/x-diff, inline)]
From aed9f2462f7825b1dddbdf20fa5aa9b74a51ca72 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs <at> gmail.com>
Date: Wed, 22 Feb 2017 20:46:12 -0500
Subject: [PATCH] fixup! Prevent for consing in cl-mapc and cl-mapl
---
test/lisp/emacs-lisp/cl-extra-tests.el | 26 +++++++++++++-------------
1 file changed, 13 insertions(+), 13 deletions(-)
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el
index 82b2206a6c..5b2371e7b9 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -39,9 +39,9 @@
(let ((lst '(a b c))
(lst2 '(d e f))
(lst3 '(1 2 3))
- (fn1 (lambda (x) nil))
- (fn2 (lambda (x y) nil))
- (fn3 (lambda (x y z) nil)))
+ (fn1 (lambda (_x) nil))
+ (fn2 (lambda (_x _y) nil))
+ (fn3 (lambda (_x _y _z) nil)))
(should (equal lst (cl-mapc fn1 lst)))
(should (equal lst (cl-mapc fn2 lst lst2)))
(should (equal lst (cl-mapc fn3 lst lst2 lst3)))))
@@ -50,9 +50,9 @@
(let ((lst '(a b c))
(lst2 '(d e f))
(lst3 '(1 2 3))
- (fn1 (lambda (x) nil))
- (fn2 (lambda (x y) nil))
- (fn3 (lambda (x y z) nil)))
+ (fn1 (lambda (x) (should (consp x))))
+ (fn2 (lambda (x y) (should (and (consp x) (consp y)))))
+ (fn3 (lambda (x y z) (should (and (consp x) (consp y) (consp z))))))
(should (equal lst (cl-mapl fn1 lst)))
(should (equal lst (cl-mapl fn2 lst lst2)))
(should (equal lst (cl-mapl fn3 lst lst2 lst3)))))
@@ -62,8 +62,8 @@
(lst2 '(d e f))
(lst3 '(1 2 3))
(fn1 (lambda (x) x))
- (fn2 (lambda (x y) y))
- (fn3 (lambda (x y z) z)))
+ (fn2 (lambda (_x y) y))
+ (fn3 (lambda (_x _y z) z)))
(should (equal lst (cl-mapcar fn1 lst)))
(should (equal lst2 (cl-mapcar fn2 lst lst2)))
(should (equal lst3 (cl-mapcar fn3 lst lst2 lst3)))))
@@ -73,8 +73,8 @@
(lst2 '(d e f))
(lst3 '(1 2 3))
(fn1 (lambda (x) x))
- (fn2 (lambda (x y) y))
- (fn3 (lambda (x y z) (string-to-char (format "%S" x)))))
+ (fn2 (lambda (_x y) y))
+ (fn3 (lambda (x _y _z) (string-to-char (format "%S" x)))))
(should (equal lst (cl-map 'list fn1 lst)))
(should (equal (vconcat lst2) (cl-map 'vector fn2 lst lst2)))
(should (equal (mapconcat (lambda (x) (format "%S" x)) lst "")
@@ -84,9 +84,9 @@
(let ((lst '(a b c))
(lst2 '(d e f))
(lst3 '(1 2 3))
- (fn1 (lambda (x) x))
- (fn2 (lambda (x y) y))
- (fn3 (lambda (x y z) z)))
+ (fn1 (lambda (x) (should (consp x)) x))
+ (fn2 (lambda (x y) (should (and (consp x) (consp y))) y))
+ (fn3 (lambda (x y z) (should (and (consp x) (consp y) (consp z))) z)))
(should (equal (list lst (cdr lst) (cddr lst))
(cl-maplist fn1 lst)))
(should (equal (list lst2 (cdr lst2) (cddr lst2))
--
2.11.1
bug-gnu-emacs <at> gnu.org:bug#25826; Package emacs.
(Thu, 23 Feb 2017 02:10:01 GMT) Full text and rfc822 format available.Message #26 received at 25826 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: npostavs <at> users.sourceforge.net Cc: 25826 <at> debbugs.gnu.org, Tino Calancha <tino.calancha <at> gmail.com> Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Thu, 23 Feb 2017 11:09:42 +0900 (JST)
On Wed, 22 Feb 2017, npostavs <at> users.sourceforge.net wrote: > Tino Calancha <tino.calancha <at> gmail.com> writes: >> It's tricky to write a test to check if cl-mapc/cl-mapl over cons. >> Thus, i have written tests that just ensure the return values >> are as expected. > > We should check that the args are consp at least: That's right. Thanks for the patch! I will push it to master in a few days if we don't get additonal feedback.
Tino Calancha <tino.calancha <at> gmail.com>:Tino Calancha <tino.calancha <at> gmail.com>:Message #31 received at 25826-done <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: 25826-done <at> debbugs.gnu.org Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Mon, 27 Feb 2017 16:36:49 +0900
Tino Calancha <tino.calancha <at> gmail.com> writes: > On Wed, 22 Feb 2017, npostavs <at> users.sourceforge.net wrote: > >> Tino Calancha <tino.calancha <at> gmail.com> writes: >>> It's tricky to write a test to check if cl-mapc/cl-mapl over cons. >>> Thus, i have written tests that just ensure the return values >>> are as expected. >> >> We should check that the args are consp at least: > That's right. Thanks for the patch! > I will push it to master in a few days if we don't get additonal feedback. Pushed to master branch as commit 4daca38d5c673c5b6862e10cfade9559852cce12
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Mon, 27 Mar 2017 11:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.