From unknown Mon Jun 23 07:53:03 2025 X-Loop: help-debbugs@gnu.org Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing 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: To: 25826@debbugs.gnu.org Cc: tino.calancha@gmail.com X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.148766432032289 (code B ref -1); Tue, 21 Feb 2017 08:06:01 +0000 Received: (at submit) by debbugs.gnu.org; 21 Feb 2017 08:05:20 +0000 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 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 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 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50,FREEMAIL_FROM, T_DKIM_INVALID autolearn=disabled version=3.3.2 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 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 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 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 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) 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) From: Tino Calancha Date: Tue, 21 Feb 2017 17:04:54 +0900 Message-ID: <87d1ecyno9.fsf@calancha-pc> MIME-Version: 1.0 Content-Type: text/plain 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-Received-From: 2001:4830:134:3::11 X-Spam-Score: -4.0 (----) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -4.0 (----) 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 From unknown Mon Jun 23 07:53:03 2025 X-Loop: help-debbugs@gnu.org Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 21 Feb 2017 13:40:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: Tino Calancha Cc: 25826@debbugs.gnu.org Received: via spool by 25826-submit@debbugs.gnu.org id=B25826.14876843543688 (code B ref 25826); Tue, 21 Feb 2017 13:40:01 +0000 Received: (at 25826) by debbugs.gnu.org; 21 Feb 2017 13:39:14 +0000 Received: from localhost ([127.0.0.1]:48392 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgAew-0000xP-1X for submit@debbugs.gnu.org; Tue, 21 Feb 2017 08:39:14 -0500 Received: from mail-it0-f43.google.com ([209.85.214.43]:38199) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgAeu-0000xE-Nd for 25826@debbugs.gnu.org; Tue, 21 Feb 2017 08:39:12 -0500 Received: by mail-it0-f43.google.com with SMTP id y135so49881072itc.1 for <25826@debbugs.gnu.org>; Tue, 21 Feb 2017 05:39:12 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=7vryKlefQmwcOK7ZUbz5EZMP6scTi9p+0xuSk8iwXgY=; b=NTPIdqT/3ZZ6PyY781Yon8mgl/INQ/ElG3MEqlD5v83qVcRcFYKf6ps2zLqgHSTYWH wmrQnNoP+yKI+qX2w5ccA9mkePq+wLNrbu+O99xCcKwUmdxHMvl00NXaN9OidJWL6G1H n95hadjMG1rVFjC1Z6R0nYYvTBJ3kPkvD11PHNRXGsPzx9/xVy6+ox/ZdymFtmClmOyB atlZkkBDAbIblr7cTFQSFQYFsG+9aNj0CrZOQWhn1tQL9JW6X9gOFKTKSGPpZBKcdXli TrXqF6TqRdFg+tmCo76+PnMiddDfePmo3HzZj6KMEo3kB5gKnz1VLiThWUALnl0nNpWS hHdw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=7vryKlefQmwcOK7ZUbz5EZMP6scTi9p+0xuSk8iwXgY=; b=lxaJ9SMEoWFD8GlrnjGlJVuGQxYNulWUusgMTb5WM4YH8TbOdOUw4ANg4yBpwfVBwu jbUpccXQSnABaGs2TH4LB2hBe1X+87zPGGuwzRlTEwfJ3fqKk09BFms2koPaW63rRAnK fdvJVw5k9XIlVkyUBsHWVWLP0r8NWU0YWxkQt4vKFN9M2k0Nw3qbVFd0pvd1GW2DCG1F 9en1/wGoSWTixxDgwTDe7a6ydUyfSK809PxjhLlytOkfJSLcqiuPRtQIWQ7Pi/nzvMCk Yz2J0AWfrvCG/GAXIDHdW7cqMZ/Dth+e/AaFYF/yIOnroe6/uyKe9rsfOOqKLPF3R84z En8Q== X-Gm-Message-State: AMke39nAfHxigKek4P9ASMWZCDs3xLfDnzzvNfMb+6UwNLncsaNVAymKTEDNAQMyECJc1A== X-Received: by 10.36.70.145 with SMTP id j139mr14601493itb.111.1487684347256; Tue, 21 Feb 2017 05:39:07 -0800 (PST) Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id 80sm10271151ioq.49.2017.02.21.05.39.06 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 21 Feb 2017 05:39:06 -0800 (PST) From: npostavs@users.sourceforge.net References: <87d1ecyno9.fsf@calancha-pc> Date: Tue, 21 Feb 2017 08:40:18 -0500 In-Reply-To: <87d1ecyno9.fsf@calancha-pc> (Tino Calancha's message of "Tue, 21 Feb 2017 17:04:54 +0900") Message-ID: <87shn7hdbx.fsf@users.sourceforge.net> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) Tino Calancha 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. From unknown Mon Jun 23 07:53:03 2025 X-Loop: help-debbugs@gnu.org Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 22 Feb 2017 03:09:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: npostavs@users.sourceforge.net Cc: 25826@debbugs.gnu.org, tino.calancha@gmail.com Received: via spool by 25826-submit@debbugs.gnu.org id=B25826.14877329275907 (code B ref 25826); Wed, 22 Feb 2017 03:09:02 +0000 Received: (at 25826) by debbugs.gnu.org; 22 Feb 2017 03:08:47 +0000 Received: from localhost ([127.0.0.1]:49475 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgNIN-0001X7-9b for submit@debbugs.gnu.org; Tue, 21 Feb 2017 22:08:47 -0500 Received: from mail-pg0-f65.google.com ([74.125.83.65]:36817) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgNIL-0001Wj-FG for 25826@debbugs.gnu.org; Tue, 21 Feb 2017 22:08:45 -0500 Received: by mail-pg0-f65.google.com with SMTP id z128so2591091pgb.3 for <25826@debbugs.gnu.org>; Tue, 21 Feb 2017 19:08:45 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=AxFFQvreDV/rIWdzRvgwZOtlSWzsNpJQ/yY1Oo2UHik=; b=Chg+MzWLZNPnWjzGHLDGwKA+p64LJQrtFs77m8wY5PSB7wHSOF2SplAfobXj07epw8 JQPhmx6tNEOmIWt/BrTvoLj9Y2B2590NXlU8wqUW8zl78/yQEvK1Z8FzPz3nhfZeFWbR KuVh/8XJmIGTu/gVSVbfWYiLKw1qLw9GHv1S617iSgC3BuBwNKaEVf3e6o+6nkyQdDjC x9Lz0fYvpSq/pvO8sp0QHPJjvo26BFOY2vkY8wAALmQ1s+sNF3XnAa1aJZaAsBPJEov6 fL2IclmmgYcnyXljAWvYDuQjIn5P58v987oFtlgF7dSfbn7mSTDvLLX/Hw16sPMESfNB I/bQ== 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:references:date:in-reply-to :message-id:user-agent:mime-version; bh=AxFFQvreDV/rIWdzRvgwZOtlSWzsNpJQ/yY1Oo2UHik=; b=pMaLt1Kw8BaxYC9p4N+zjoflLthIEhiS9cz4A+QvZ9ViZmoNj0fBqc5TozWOA7qCXh e96IPQguNPvX6UD4dLv677OR33DMMf9wNEaBQnGxLOZk6Vak6T4WsAmGcgb8cfMoP1zC XjVgmDX9xCb/Ia7B6UzMwWjSlv4ytu2kZp+Z40ODmRlQOZXUArrosfXNISYhwM+GihAN yI3AJB8Ddh5xrKUGtgHED4l/kRSE1FTRuoEPNZS2VeBtBl9n8bc4fmAExNiK/dd+NLHa n2kP53ib7ygj3h5d/m53+R19x2YSgFdW3B8zwXaouDD/LY+lXw2mbKDhJH2V8Di20uc9 Ez9w== X-Gm-Message-State: AMke39lAOaQWQhPd57bNM7InYwOKMwhnSm3+j4pZFfmifiTRtCGVGJBYzvitqW2v0h7QrQ== X-Received: by 10.98.65.148 with SMTP id g20mr37770928pfd.44.1487732919762; Tue, 21 Feb 2017 19:08:39 -0800 (PST) Received: from calancha-pc (104.81.147.124.dy.bbexcite.jp. [124.147.81.104]) by smtp.gmail.com with ESMTPSA id 64sm43300358pfq.112.2017.02.21.19.08.37 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 21 Feb 2017 19:08:39 -0800 (PST) From: Tino Calancha References: <87d1ecyno9.fsf@calancha-pc> <87shn7hdbx.fsf@users.sourceforge.net> Date: Wed, 22 Feb 2017 12:08:34 +0900 In-Reply-To: <87shn7hdbx.fsf@users.sourceforge.net> (npostavs's message of "Tue, 21 Feb 2017 08:40:18 -0500") Message-ID: <87lgsyncr1.fsf@calancha-pc> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.5 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.5 (/) npostavs@users.sourceforge.net writes: > Tino Calancha 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 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 From unknown Mon Jun 23 07:53:03 2025 X-Loop: help-debbugs@gnu.org Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 22 Feb 2017 03:33:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: Tino Calancha Cc: 25826@debbugs.gnu.org Received: via spool by 25826-submit@debbugs.gnu.org id=B25826.148773436514899 (code B ref 25826); Wed, 22 Feb 2017 03:33:02 +0000 Received: (at 25826) by debbugs.gnu.org; 22 Feb 2017 03:32:45 +0000 Received: from localhost ([127.0.0.1]:49493 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgNfY-0003sF-Ri for submit@debbugs.gnu.org; Tue, 21 Feb 2017 22:32:44 -0500 Received: from mail-it0-f49.google.com ([209.85.214.49]:32843) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgNfX-0003s2-5t for 25826@debbugs.gnu.org; Tue, 21 Feb 2017 22:32:43 -0500 Received: by mail-it0-f49.google.com with SMTP id d9so37605932itc.0 for <25826@debbugs.gnu.org>; Tue, 21 Feb 2017 19:32:43 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=46IjQKAyGpIChE42RgHRg8DfmGm8TUmgBOLnGFp3Ois=; b=pAnI538cHKKLnl3/XAITPQBDW3U8GDrBqCAi+tDTFJchClAq0ffQ5XiwhxQLRxAQ85 0ycev7iL5JQoBHjE0P0sfOhe8iE3BvbfPwN+W3MOk7RKSekZBHCLkT//p9ggCzxBEtqo cWY2jcuwlS6PQ81RcDS4tFDcjdr90k8gfrLfozfwWmMwG4ZtYY7nL7MvZLnOCBFXzQwm Tw6XdAuajwmYwk9W6yYUf6w+2MtyoAQ3rocG9fGmZMIe7QkKHuO8Ux2GklB8x68d8TvQ LcCIAGRHAG+thhaTN2g7gwuNUpzgZm1SAkWwaQTbQ4KDILSpGRHGMz1Q2ixVh4y0kfA1 yypA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=46IjQKAyGpIChE42RgHRg8DfmGm8TUmgBOLnGFp3Ois=; b=kvaOazgoYIbHL1q0Cxtx2bdHNZnSJlc/ee2Q/+4vMueZ5LnkJ8IJ9txp9do8Wv+X9O 92EG1d4aN+7H047RzDjvJbNWMAmypgBqMOg74ddFIIoc7MDypZmDWOHK07uNuDOlpuH8 Yq1y/ZUN3pXmRBdmUi08cBUjA1ekxtopYJewCm+cDxPeLDap7qpeNOzl8VtD8oCCrVQR rzPsb5tH/GIB/06H4M6nWLNCKTkPUANMfGDSyZiMCyGsn4WOOTo4Tu8jrErVpsC3dNal 74EmeQgqziUS/E9pcF2TAACe9pYfPP+Y9Auf9eMJirxTTiwSyAduR3bLBCjGG1d/Q2LJ nK0Q== X-Gm-Message-State: AMke39mV+HWIVKethGwLd9Kd/+2xbSgHYYHQko4knVGLj8y9cJgNOB6iEqLtaWpjEALWOA== X-Received: by 10.36.13.83 with SMTP id 80mr296191itx.49.1487734357723; Tue, 21 Feb 2017 19:32:37 -0800 (PST) Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id j201sm118276ita.3.2017.02.21.19.32.37 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 21 Feb 2017 19:32:37 -0800 (PST) From: npostavs@users.sourceforge.net References: <87d1ecyno9.fsf@calancha-pc> <87shn7hdbx.fsf@users.sourceforge.net> <87lgsyncr1.fsf@calancha-pc> Date: Tue, 21 Feb 2017 22:33:50 -0500 In-Reply-To: <87lgsyncr1.fsf@calancha-pc> (Tino Calancha's message of "Wed, 22 Feb 2017 12:08:34 +0900") Message-ID: <87efyqhpb5.fsf@users.sourceforge.net> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) Tino Calancha writes: > How about the following updated patch? Looks good. Perhaps some tests would be a good idea too? From unknown Mon Jun 23 07:53:03 2025 X-Loop: help-debbugs@gnu.org Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 22 Feb 2017 04:15:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: npostavs@users.sourceforge.net Cc: 25826@debbugs.gnu.org, Tino Calancha Received: via spool by 25826-submit@debbugs.gnu.org id=B25826.148773685518499 (code B ref 25826); Wed, 22 Feb 2017 04:15:01 +0000 Received: (at 25826) by debbugs.gnu.org; 22 Feb 2017 04:14:15 +0000 Received: from localhost ([127.0.0.1]:49510 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgOJj-0004oJ-CV for submit@debbugs.gnu.org; Tue, 21 Feb 2017 23:14:15 -0500 Received: from mail-pg0-f68.google.com ([74.125.83.68]:36685) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgOJh-0004o5-Et for 25826@debbugs.gnu.org; Tue, 21 Feb 2017 23:14:13 -0500 Received: by mail-pg0-f68.google.com with SMTP id z128so2891690pgb.3 for <25826@debbugs.gnu.org>; Tue, 21 Feb 2017 20:14:13 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:date:to:cc:subject:in-reply-to:message-id:references :user-agent:mime-version; bh=fw9ZHvywkzHnp+AMnEjBxbnupbPXA5sQoRk+PZuQsdM=; b=rxFP7XyN66raq8dhA0n4pqsivGM1R6jTTw2pJGIPg/88AiFjD2oibS5p4yoRGI+BjR O0BmJ4UnCix/Sft8CQDcWJOijDPg3Qf2vXbMNoj4QbqKdwmU/0R7VfYdq1dNILpn48+j pD0S4zj6LbCemh5M5HRcU5IT1DqfAO7gsqAnBBHh0Cm0SCZCktSX8Z7JjfUEbtnsxNU9 dRCDiWA0uUVOyiC73eyLdOWbv4DIelZtzsHv9p3wGQetS63K787o518rWQs3PJ+vXARm 8SMDfmPw/e/28Bn5kqEWewJ+R4S9qcRg7e1IAfzSHgrthRLQux2SvgRbXVWj9JSuWrgL yMcA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:date:to:cc:subject:in-reply-to:message-id :references:user-agent:mime-version; bh=fw9ZHvywkzHnp+AMnEjBxbnupbPXA5sQoRk+PZuQsdM=; b=WZtqYktm4XOHHHXU8hgJ3ULUP8YGmlqKY5uflhNyHPk6iiRTruE9siGC0VGnH6153W f7qW33lk+QApNEKkrd4B0gugtgCL8YekmUIhdUeta+4z1wIIdZFF/G2Bl4G0fvgYy5Up /UmOMsdn5J6+WsIxIWX8PBSzCRBZ+k20yttTlCS0K+upI0nNWMvNf4jRecBdVDg2FXox CQwpWrhDuz1qYTJDPr+nHQrMcNKTUZyM2tu4va9Q8MIrkIbYq25pUR/6nOVbXjvW8Gwt VF43OEieHITx2KnuHzBCIqF4YFne6sHPsOoc2R67+27YrBIeX3qiTmUeijDoQPDLCNaX y14w== X-Gm-Message-State: AMke39k2BWRZcLWDmB1lpGnJ7o48cdHRN4Oh8jot0Sr2PlNJmF1DNlwvNw7vShVJa3pK4w== X-Received: by 10.99.152.84 with SMTP id l20mr21371870pgo.28.1487736847777; Tue, 21 Feb 2017 20:14:07 -0800 (PST) Received: from calancha-pc (104.81.147.124.dy.bbexcite.jp. [124.147.81.104]) by smtp.gmail.com with ESMTPSA id n73sm87390pfa.9.2017.02.21.20.14.05 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 21 Feb 2017 20:14:07 -0800 (PST) From: Tino Calancha X-Google-Original-From: Tino Calancha Date: Wed, 22 Feb 2017 13:14:04 +0900 (JST) X-X-Sender: calancha@calancha-pc In-Reply-To: <87efyqhpb5.fsf@users.sourceforge.net> Message-ID: References: <87d1ecyno9.fsf@calancha-pc> <87shn7hdbx.fsf@users.sourceforge.net> <87lgsyncr1.fsf@calancha-pc> <87efyqhpb5.fsf@users.sourceforge.net> User-Agent: Alpine 2.20 (DEB 67 2015-01-07) MIME-Version: 1.0 Content-Type: text/plain; format=flowed; charset=US-ASCII X-Spam-Score: 0.5 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.5 (/) On Tue, 21 Feb 2017, npostavs@users.sourceforge.net wrote: > Tino Calancha 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. From unknown Mon Jun 23 07:53:03 2025 X-Loop: help-debbugs@gnu.org Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 22 Feb 2017 05:47:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: npostavs@users.sourceforge.net Cc: 25826@debbugs.gnu.org, tino.calancha@gmail.com Received: via spool by 25826-submit@debbugs.gnu.org id=B25826.14877424197953 (code B ref 25826); Wed, 22 Feb 2017 05:47:01 +0000 Received: (at 25826) by debbugs.gnu.org; 22 Feb 2017 05:46:59 +0000 Received: from localhost ([127.0.0.1]:49559 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgPlS-00024C-KI for submit@debbugs.gnu.org; Wed, 22 Feb 2017 00:46:58 -0500 Received: from mail-pg0-f66.google.com ([74.125.83.66]:34857) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgPlQ-00023z-A7 for 25826@debbugs.gnu.org; Wed, 22 Feb 2017 00:46:56 -0500 Received: by mail-pg0-f66.google.com with SMTP id 1so407293pgz.2 for <25826@debbugs.gnu.org>; Tue, 21 Feb 2017 21:46:56 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=TCXL5hR+UkbGB/aCv20maAaZ6r6KUJ6U3Ym6ypBM4cM=; b=OicSiS6TJr04WSMBnN/COLDLJXd91fhAhdhw+XBq7pavIRShY/ic4Pl7wiBYLhxoD1 dOtMvMFZZyiGHNEBwfslLadMqh6Y4q1SbjJGwPkBuh2ieyyWBfXJpg1LX9d13+z5ajdc k5z4hsa+Frw/51vDSjc1RM0Nr3JoyVJaNMzVn+GYfP5QkFOjf6NzD5U03WBBZ2JBeBWe CRzUYLR7bWhH10dRf9Q1FcEKj9MYmyE6Cm1XXN+OLsqqQsa3o5+6aZ0LTpBPq8wd+4bu KyKSSzeADZi5PHfvL2JUgCNoK7CahStINjWmxPx2TW7qw2L9T+rEzlB6V1tfZjeMvI1D mc9w== 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:references:date:in-reply-to :message-id:user-agent:mime-version; bh=TCXL5hR+UkbGB/aCv20maAaZ6r6KUJ6U3Ym6ypBM4cM=; b=qVmpz/GYP0DPyAae4odW4Y0Ea71hFovsM19usrthN5mCfDjOcWzE5kkeysUF9hlo79 tP0YiIZRFYiuPNdKHyrHcHK/qxcbvrVpCYj8TW3XpEr16IsSPpgUhY2JMt9ZauitzHvJ uIZRN+OzHBXiXBz+kqSDFCqrpb1e5wpkroaV7QDC52zia0Q91HTmz7nsqqmM7kOT2R9S TLMpJpztg0obweGOyzGAMWCF30GsDPLOvNqj99YECBoDbHST6kwQBwPdL4GGX82cLlVS ulrfl88Dx3Bio8c9Qe+b3ubQWcqa9j4aGKIRv8FdWNP5PGxciz0xbFxZH6v7W6m8j5lh t23g== X-Gm-Message-State: AMke39mgk3IvELi2eGaPsqPuWpFb+vPJj80a8I8XA7L1uUyFOtGNjfuKr5umBAm8lnT7Sg== X-Received: by 10.98.102.21 with SMTP id a21mr37624084pfc.29.1487742410326; Tue, 21 Feb 2017 21:46:50 -0800 (PST) Received: from calancha-pc (104.81.147.124.dy.bbexcite.jp. [124.147.81.104]) by smtp.gmail.com with ESMTPSA id q90sm619229pfk.73.2017.02.21.21.46.48 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 21 Feb 2017 21:46:49 -0800 (PST) From: Tino Calancha References: <87d1ecyno9.fsf@calancha-pc> <87shn7hdbx.fsf@users.sourceforge.net> <87lgsyncr1.fsf@calancha-pc> <87efyqhpb5.fsf@users.sourceforge.net> Date: Wed, 22 Feb 2017 14:46:45 +0900 In-Reply-To: (Tino Calancha's message of "Wed, 22 Feb 2017 13:14:04 +0900 (JST)") Message-ID: <87y3wyojzu.fsf@calancha-pc> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.5 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.5 (/) Tino Calancha writes: > On Tue, 21 Feb 2017, npostavs@users.sourceforge.net wrote: > >> Tino Calancha 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 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 From unknown Mon Jun 23 07:53:03 2025 X-Loop: help-debbugs@gnu.org Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 23 Feb 2017 01:55:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: Tino Calancha Cc: 25826@debbugs.gnu.org Received: via spool by 25826-submit@debbugs.gnu.org id=B25826.14878148944867 (code B ref 25826); Thu, 23 Feb 2017 01:55:02 +0000 Received: (at 25826) by debbugs.gnu.org; 23 Feb 2017 01:54:54 +0000 Received: from localhost ([127.0.0.1]:51732 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgicQ-0001GR-EV for submit@debbugs.gnu.org; Wed, 22 Feb 2017 20:54:54 -0500 Received: from mail-it0-f48.google.com ([209.85.214.48]:37440) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgicP-0001GC-45 for 25826@debbugs.gnu.org; Wed, 22 Feb 2017 20:54:53 -0500 Received: by mail-it0-f48.google.com with SMTP id 203so1463199ith.0 for <25826@debbugs.gnu.org>; Wed, 22 Feb 2017 17:54:53 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=6Qj0CdTw92Y+kzKF7Fj950+CxkaireaSP8307LgRPE8=; b=YOjlVW03iv7MncG2QN+zgM/cdnrLW6szhxvusFsgaJb+nVO+/MczuXEacEEjnu7mrb 4Rw186NRogbankEnAfsfrCcsSNIHy0J3vxsodenD2sP5jWXU4Pmqxuy1Ch0oLvJa9NEO a05ygODGI1vySG53IJZFiUkdJ6K+3/Xxbzeo8J6DTn24Vv1gT+ipGm6j5EmainS9ZLaw 2AprymAKAUnA4GLr0mQv0q11VziueplOijl+6Q7WFCVYqiKBsFk5BP5LUm/lh+76PRql OYlTRPHYFuC1SPokojRKclgAV4n465myHzVix6/Gv/Gspt9MlUx3W6+rNEjz8ToiPng6 fnig== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=6Qj0CdTw92Y+kzKF7Fj950+CxkaireaSP8307LgRPE8=; b=BxrtIqbv7IIz65J5uq9NBYBDeVrEgvFu6RS608tWiBxbedV2QHrzrDAoxTGzXDV32u OEttDgJNYt7VeM1v9g2JY4ic7pXF++bvlmTatSq4j36F58mPCbXyK6pGamaCmwa90N3F 9NI/0GVtIY/cKeJuKIPmBGCJpmQOrYhg71FbEsKrRpGAc6aaUELFowGfRqJSuFb4xUH2 i2SpavcyaAV7OZaQcigULQxCWawr/6WXFYQ3iLSNSlcwfCn6yZWDPINWAKS9jgWdlaLH UtdPfq0kxmUerJeVHBbMUsM1KK9OukCAu4xmqc3RrXBKzq6sSimzVdhyfn+iEPY4ZlnZ JQdA== X-Gm-Message-State: AMke39m1FkgpoL2hza3eZslyizXugPuV0ZVcP/LvwP8niIdE6PV4CV7eewQeG8c9bskFfg== X-Received: by 10.36.208.134 with SMTP id m128mr1123828itg.44.1487814887107; Wed, 22 Feb 2017 17:54:47 -0800 (PST) Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id t39sm1274635ioe.12.2017.02.22.17.54.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 22 Feb 2017 17:54:45 -0800 (PST) From: npostavs@users.sourceforge.net References: <87d1ecyno9.fsf@calancha-pc> <87shn7hdbx.fsf@users.sourceforge.net> <87lgsyncr1.fsf@calancha-pc> <87efyqhpb5.fsf@users.sourceforge.net> <87y3wyojzu.fsf@calancha-pc> Date: Wed, 22 Feb 2017 20:55:58 -0500 In-Reply-To: <87y3wyojzu.fsf@calancha-pc> (Tino Calancha's message of "Wed, 22 Feb 2017 14:46:45 +0900") Message-ID: <8737f5hdqp.fsf@users.sourceforge.net> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.7 (/) --=-=-= Content-Type: text/plain Tino Calancha 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: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-fixup-Prevent-for-consing-in-cl-mapc-and-cl-mapl.patch Content-Description: fixup patch >From aed9f2462f7825b1dddbdf20fa5aa9b74a51ca72 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-=-- From unknown Mon Jun 23 07:53:03 2025 X-Loop: help-debbugs@gnu.org Subject: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 23 Feb 2017 02:10:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25826 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: npostavs@users.sourceforge.net Cc: 25826@debbugs.gnu.org, Tino Calancha Received: via spool by 25826-submit@debbugs.gnu.org id=B25826.14878157986177 (code B ref 25826); Thu, 23 Feb 2017 02:10:01 +0000 Received: (at 25826) by debbugs.gnu.org; 23 Feb 2017 02:09:58 +0000 Received: from localhost ([127.0.0.1]:51738 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgiqz-0001bZ-Rw for submit@debbugs.gnu.org; Wed, 22 Feb 2017 21:09:57 -0500 Received: from mail-pg0-f65.google.com ([74.125.83.65]:33932) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgiqx-0001bM-Vv for 25826@debbugs.gnu.org; Wed, 22 Feb 2017 21:09:56 -0500 Received: by mail-pg0-f65.google.com with SMTP id s67so2714133pgb.1 for <25826@debbugs.gnu.org>; Wed, 22 Feb 2017 18:09:55 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:date:to:cc:subject:in-reply-to:message-id:references :user-agent:mime-version; bh=BR1NkUXzaU2THqC/bRrGRKdp3viH3mFvKqnjiaNdpyM=; b=Ri8wzMteKAKrFdlymBrFRRUB1oY4qhDATMIzLxSWPYVTzjJz6a4nCnDNMPTbT2Mb0p NH23CWABuF9h0+XbMaTNUvY63ps7BbJaj8m4B+HwN/Ju6+yUaEnVVTUoXSpjImLMiGSm 97AisooV90WfUNwuD60s8tcn3ZVfk9ddC8UwXvsFsIN/0Kz/A9h22QDFmONxDjZxKqOb EHCBSqiEvofKpGQOwGHmtyRtqD4X6ZDSdZpbhsOg+eBljel7MnjMq255WdBip2DC9xzh Wxbr5Odonwskh9WKQ2KEmJWSjyLgb1coTmIE7o7WnpNRXRzz9PbIafy9g1rfgo0/pPVe nNhw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:date:to:cc:subject:in-reply-to:message-id :references:user-agent:mime-version; bh=BR1NkUXzaU2THqC/bRrGRKdp3viH3mFvKqnjiaNdpyM=; b=Mcm38tNO2JCQXfMT10UxktoO8FkszbZVJ+Ykkd0CX0oCCV9jYKe3gb1FxEp+JQKKDh ycwn4mfiX/b4fVVJEDIAa2Bk0lADlsCJepUmV74YvQshTg/a/7ZP1eDLE5fQp6TcSq87 OwQRU4SfvrnZOdagZxwpqeL3HN4SHVbfOnnos6tyeXs8QsK3M4e72ZJdl3gJbLp5zlfh yDlhJCCQ6+Bbr8IP+M3PVOCCIXIKZYksQDB9HR12IJTetdIjfceO11tKm1xIB2MDQEWw +LX3acHRv15fYhoHyY15GBsfj1zkwcthVAjZf5Y3a9zSwQ2VogLUFFUuIOcZiDwTkLIK KhlA== X-Gm-Message-State: AMke39lbgEt9cGV4JqenI1uJ9PMZ9xFNFypbIV8tkGjFh+G/m3XeH0C5EHXKGZ/HcUvFGQ== X-Received: by 10.98.51.70 with SMTP id z67mr43007211pfz.68.1487815790318; Wed, 22 Feb 2017 18:09:50 -0800 (PST) Received: from calancha-pc (104.81.147.124.dy.bbexcite.jp. [124.147.81.104]) by smtp.gmail.com with ESMTPSA id r4sm5877278pgr.53.2017.02.22.18.09.44 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Wed, 22 Feb 2017 18:09:45 -0800 (PST) From: Tino Calancha X-Google-Original-From: Tino Calancha Date: Thu, 23 Feb 2017 11:09:42 +0900 (JST) X-X-Sender: calancha@calancha-pc In-Reply-To: <8737f5hdqp.fsf@users.sourceforge.net> Message-ID: References: <87d1ecyno9.fsf@calancha-pc> <87shn7hdbx.fsf@users.sourceforge.net> <87lgsyncr1.fsf@calancha-pc> <87efyqhpb5.fsf@users.sourceforge.net> <87y3wyojzu.fsf@calancha-pc> <8737f5hdqp.fsf@users.sourceforge.net> User-Agent: Alpine 2.20 (DEB 67 2015-01-07) MIME-Version: 1.0 Content-Type: text/plain; format=flowed; charset=US-ASCII X-Spam-Score: 0.5 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.5 (/) On Wed, 22 Feb 2017, npostavs@users.sourceforge.net wrote: > Tino Calancha 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. From unknown Mon Jun 23 07:53:03 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.505 (Entity 5.505) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Tino Calancha Subject: bug#25826: closed (Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing) Message-ID: References: <87o9xokru6.fsf@calancha-pc> <87d1ecyno9.fsf@calancha-pc> X-Gnu-PR-Message: they-closed 25826 X-Gnu-PR-Package: emacs Reply-To: 25826@debbugs.gnu.org Date: Mon, 27 Feb 2017 07:37:02 +0000 Content-Type: multipart/mixed; boundary="----------=_1488181022-31509-1" This is a multi-part message in MIME format... ------------=_1488181022-31509-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" 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@debbugs.gnu.org. --=20 25826: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D25826 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1488181022-31509-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at 25826-done) by debbugs.gnu.org; 27 Feb 2017 07:36:59 +0000 Received: from localhost ([127.0.0.1]:57464 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ciFrf-0008By-9W for submit@debbugs.gnu.org; Mon, 27 Feb 2017 02:36:59 -0500 Received: from mail-pg0-f53.google.com ([74.125.83.53]:34878) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ciFrd-0008Bm-RB for 25826-done@debbugs.gnu.org; Mon, 27 Feb 2017 02:36:58 -0500 Received: by mail-pg0-f53.google.com with SMTP id b129so40767891pgc.2 for <25826-done@debbugs.gnu.org>; Sun, 26 Feb 2017 23:36:57 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:subject:references:date:in-reply-to:message-id:user-agent :mime-version; bh=MDuaM8kh/ek9a+XBwpXU1Yv0gFC4NhHf56gwu1vffj4=; b=s4BFGExkcnVsA/V2YtLFlr1CXNs8DpsJG+OaQ6+EIVvy7tVLLPn2RCNG6iqE9KYH/O UmHnJ1LyirTbbHtpFgXml5kN5Gl/K6Z7weKxbIRFLBoWLVdjGykuYZF2zs61Z+/U9UD9 bZUda/0cD40qha44c25erHxzmcfbYQKulNIzbQbpeEMt8o3QO9bKcFreM5h/txaKh9dv 7WY0Hv+WoAlVJ8fH9e2kBEahGUT2yVdgNTi1R9HiwtkpFB/33HthtCdhVaCps4ryFiJ8 +JHn+I6EKwGE0pzMv26Go2IlJHe4Dw6+Ef/OdWGhd3QHBRB8VUKnVXUxRvtHq8TXd6Bd VluQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=MDuaM8kh/ek9a+XBwpXU1Yv0gFC4NhHf56gwu1vffj4=; b=AEujmHJgcsOkAGEJzHhnQ9XjU8R+6dRFvRO+y3bZZ/96yz+QqGLeJ3nR8eVX6OVwic VYGAlg36NnF4U6BFuonf3x+/ARor1mnWKHJyuNMn+rt5t2hhzbMqrETJDCdTSB7CDngb DFtT6MPn0eFEZhO+MHq0CwgVi6OxPyh36zWRl1bovC0Gangeq0TLKWn7rqQBOIyc4Xlv QWzOMMXS9do2714EdXGmyfru6ZV8Jq0kFhGauOjH/8g+w7p1BO0jxqDNZhw6z7XnAaPR CFYSD67kwjaorHR8+Oblgg2FihXkXCV2ZIw4WRJYmOOC14AW4p3blepBiRehKsh4r0aO NgMQ== X-Gm-Message-State: AMke39l23qwNsQso2rL5ujCgtMaG7itPd2b2WUEvRs0Bp3kApcNG4SuQxInJIy/Qo4RYgQ== X-Received: by 10.84.218.11 with SMTP id q11mr22553221pli.141.1488181012179; Sun, 26 Feb 2017 23:36:52 -0800 (PST) Received: from calancha-pc (104.81.147.124.dy.bbexcite.jp. [124.147.81.104]) by smtp.gmail.com with ESMTPSA id u24sm28478598pfi.25.2017.02.26.23.36.50 for <25826-done@debbugs.gnu.org> (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 26 Feb 2017 23:36:51 -0800 (PST) From: Tino Calancha To: 25826-done@debbugs.gnu.org Subject: Re: bug#25826: 26.0.50; cl-mapc and cl-mapl do needless consing References: <87d1ecyno9.fsf@calancha-pc> <87shn7hdbx.fsf@users.sourceforge.net> <87lgsyncr1.fsf@calancha-pc> <87efyqhpb5.fsf@users.sourceforge.net> <87y3wyojzu.fsf@calancha-pc> <8737f5hdqp.fsf@users.sourceforge.net> Date: Mon, 27 Feb 2017 16:36:49 +0900 In-Reply-To: (Tino Calancha's message of "Thu, 23 Feb 2017 11:09:42 +0900 (JST)") Message-ID: <87o9xokru6.fsf@calancha-pc> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 25826-done X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) Tino Calancha writes: > On Wed, 22 Feb 2017, npostavs@users.sourceforge.net wrote: > >> Tino Calancha 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 ------------=_1488181022-31509-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at submit) by debbugs.gnu.org; 21 Feb 2017 08:05:20 +0000 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 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 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 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50,FREEMAIL_FROM, T_DKIM_INVALID autolearn=disabled version=3.3.2 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 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 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 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 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) 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) From: Tino Calancha To: bug-gnu-emacs@gnu.org Subject: 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> MIME-Version: 1.0 Content-Type: text/plain 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-Received-From: 2001:4830:134:3::11 X-Spam-Score: -4.0 (----) X-Debbugs-Envelope-To: submit Cc: tino.calancha@gmail.com X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -4.0 (----) 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 ------------=_1488181022-31509-1--