From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Date: Tue, 21 Feb 2017 17:04:54 +0900 Message-ID: <87d1ecyno9.fsf@calancha-pc> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1487664373 12059 195.159.176.226 (21 Feb 2017 08:06:13 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 21 Feb 2017 08:06:13 +0000 (UTC) Cc: tino.calancha@gmail.com To: 25826@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Feb 21 09:06:09 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cg5SZ-0002dL-Lc for geb-bug-gnu-emacs@m.gmane.org; Tue, 21 Feb 2017 09:06:07 +0100 Original-Received: from localhost ([::1]:42842 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cg5Sf-0003vO-AW for geb-bug-gnu-emacs@m.gmane.org; Tue, 21 Feb 2017 03:06:13 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39384) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cg5SY-0003v9-GG for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 03:06:07 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cg5SU-0004zr-ET for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 03:06:06 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:49952) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cg5SU-0004zl-Aa for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 03:06:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cg5ST-0008Po-RG for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 03:06:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 21 Feb 2017 08:06:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 25826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.148766432032289 (code B ref -1); Tue, 21 Feb 2017 08:06:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 21 Feb 2017 08:05:20 +0000 Original-Received: from localhost ([127.0.0.1]:48151 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cg5Rn-0008Oi-Rr for submit@debbugs.gnu.org; Tue, 21 Feb 2017 03:05:20 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:48264) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cg5Rm-0008OX-Ie for submit@debbugs.gnu.org; Tue, 21 Feb 2017 03:05:18 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cg5Rd-0004kR-Kl for submit@debbugs.gnu.org; Tue, 21 Feb 2017 03:05:13 -0500 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:33928) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cg5Rd-0004kK-IR for submit@debbugs.gnu.org; Tue, 21 Feb 2017 03:05:09 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39217) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cg5RX-0003pC-A9 for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 03:05:09 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cg5RT-0004cA-AU for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 03:05:03 -0500 Original-Received: from mail-pg0-x243.google.com ([2607:f8b0:400e:c05::243]:36316) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cg5RT-0004ag-3B for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 03:04:59 -0500 Original-Received: by mail-pg0-x243.google.com with SMTP id a123so14259626pgc.3 for ; Tue, 21 Feb 2017 00:04:58 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:mime-version; bh=AyC1Mh6ECebC5AethVcpzOxACvA6xBaCE4Fpt3gqis4=; b=k2c+A1cJgoSLZg6VBHwiNcBYYoJ2XBu/5tWtYWYhg8LiCPGd9ODWg1eO43DQ/4k+8A O/dDO22OjaKFVLX1dPI7AG5Xjpi/3TTdJmQJBwH9nHRoZbxKxq/guwiLQRHlMCeBYVua SIwlXp4/frywzFDvEt0FgOURtH+kWpWLV679admknU4BqKlpZZj/Bd9HptSCJ9S9h7FD iED0+ikDlZtGNPq1xTsF9O4rRUuVHg2LfQ2veR4NU7U3+ZIvs6EthTm4iHlXAAOs7T5M WFnpdSjrgRjs1TS1aHoNBu7oebyfJIBX66SoFhIpBLrLlruNI0H04t0KfFTGw+QMf1t7 tXgA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version; bh=AyC1Mh6ECebC5AethVcpzOxACvA6xBaCE4Fpt3gqis4=; b=eaVCdagTDrAnS3gPJBhiiPU6x6xPK1Q1ZzipiCkcq0eTtAl50mXYX9c8Mld1AJwBzM gleKsNaklr+kOyxzHMTTLkrT7c/T8FRHbS5XfcQ2/m8a8BSoOaV119krTqarr+FK5o7M pjFH44fblpUcw4es1et/eDHLpcO1q0SGvP+FGDJ7hUOuk8zjoCIfwR+ENG0ap5ubquGQ ddNgYvv6zdupSgcTfbFmLSbSlzfqZTTtj+OGW449wTyWVO6Z1WfvT4gDatiCjzCFUqnc cQ/4wsmbfJ9S/5bst9UcI2g+K34Guuxd2FX6rHDfD27I6+Xuy7gDeBlFid0RXMnON/T1 63Ig== X-Gm-Message-State: AMke39luFbrbbRj9WypY2QQnqNSknNKfssmmkvwcoOL2JBka1hpWsUhTak0bSZC99t+byA== X-Received: by 10.98.68.207 with SMTP id m76mr11379988pfi.162.1487664298129; Tue, 21 Feb 2017 00:04:58 -0800 (PST) Original-Received: from calancha-pc (104.81.147.124.dy.bbexcite.jp. [124.147.81.104]) by smtp.gmail.com with ESMTPSA id b8sm24524780pgn.6.2017.02.21.00.04.56 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 21 Feb 2017 00:04:57 -0800 (PST) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:129613 Archived-At: 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 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