Subject: bug#25826: closed (Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing)

From: [email-masked] (GNU bug Tracking System)
Date: Mon, 27 Feb 2017 07:37:02 +0000

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 [email-masked].

-- 
25826: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=25826
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing
From: Tino Calancha <[email-masked]>
To: [email-masked]
Date: Mon, 27 Feb 2017 16:36:49 +0900
List-Id: <debbugs-submit.debbugs.gnu.org>

Tino Calancha <[email-masked]> writes:

> On Wed, 22 Feb 2017, [email-masked] wrote:
>
>> Tino Calancha <[email-masked]> 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

Subject: 26.0.50; cl-mapc and cl-mapl do needless consing
From: Tino Calancha <[email-masked]>
To: [email-masked]
Cc: [email-masked]
Date: Tue, 21 Feb 2017 17:04:54 +0900
List-Id: <debbugs-submit.debbugs.gnu.org>

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 <[email-masked]>
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