GNU bug report logs -
#25826
26.0.50; cl-mapc and cl-mapl do needless consing
Previous Next
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.
Full log
View this message in rfc822 format
[Message part 1 (text/plain, inline)]
Your bug report
#25826: 26.0.50; cl-mapc and cl-mapl do needless consing
which was filed against the emacs package, has been closed.
The explanation is attached below, along with your original report.
If you require more details, please reply to 25826 <at> debbugs.gnu.org.
--
25826: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=25826
GNU Bug Tracking System
Contact help-debbugs <at> gnu.org with problems
[Message part 2 (message/rfc822, inline)]
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
[Message part 3 (message/rfc822, inline)]
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
This bug report was last modified 8 years and 90 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.