GNU bug report logs - #74696
[PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument.

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guile; Reported by: Juliana Sims <juli@HIDDEN>; Keywords: patch; dated Wed, 4 Dec 2024 19:23:01 UTC; Maintainer for guile is bug-guile@HIDDEN.

Message received at 74696 <at> debbugs.gnu.org:


Received: (at 74696) by debbugs.gnu.org; 22 Dec 2024 21:45:35 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Dec 22 16:45:35 2024
Received: from localhost ([127.0.0.1]:52237 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tPTlW-0003Hu-UC
	for submit <at> debbugs.gnu.org; Sun, 22 Dec 2024 16:45:35 -0500
Received: from eggs.gnu.org ([209.51.188.92]:47568)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@HIDDEN>) id 1tPTlU-0003Hd-Nd
 for 74696 <at> debbugs.gnu.org; Sun, 22 Dec 2024 16:45:33 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@HIDDEN>)
 id 1tPTlO-0001xI-PK; Sun, 22 Dec 2024 16:45:26 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To:
 From; bh=Hyn7fs448Oqu2MLzhIuk8JZu41fzhzv9iXDmz7nhy/s=; b=f4FJLjGRqg+z+59kNf5u
 zCFE/ygotBvL30p0AdifB/g+IkyJTqgmaSDK5SWV5PQbm9D5ZESOz1ojonRStCQY9B29K0HFT5Qww
 X9t0hqU/jSu6rbwFYRQiP1VcI00EWQsp4tRlnNQOrXXXI7tRsYsDhwUO+8woBOAR0taysAOB3er2O
 1O4P+Ri5tcEUQIUWyCBmG6BEEKIfPt9MNhId6/PvIfOcrguEuVlAcbslLAGh78X+FIo6M3flgpnYp
 7fo8sL1xlat5mYAWUk5haBRmd1eEy+/be3pRKCNIIMrmjFE94do5U8THeOj1ZXESiDtI+W/JWWaE/
 1qEjuzskkV0p9w==;
From: =?utf-8?Q?Ludovic_Court=C3=A8s?= <ludo@HIDDEN>
To: Juliana Sims <juli@HIDDEN>
Subject: Re: bug#74696: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first
 argument.
In-Reply-To: <20241204192055.30996-1-juli@HIDDEN> (Juliana Sims's message
 of "Wed, 4 Dec 2024 14:20:55 -0500")
References: <20241204192055.30996-1-juli@HIDDEN>
Date: Sun, 22 Dec 2024 22:45:24 +0100
Message-ID: <877c7rfl3f.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 74696
Cc: 74696 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

Hi Juliana,

Juliana Sims <juli@HIDDEN> skribis:

> * module/srfi/srfi-1.scm (map!): Re-use cons cells of first argument.

Could you add a couple of tests under =E2=80=98test-suite/tests/srfi-1.test=
=E2=80=99?

Apart from that it looks good to me.  Thank you!

Ludo=E2=80=99.




Information forwarded to bug-guile@HIDDEN:
bug#74696; Package guile. Full text available.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 4 Dec 2024 19:22:27 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Wed Dec 04 14:22:27 2024
Received: from localhost ([127.0.0.1]:36916 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tIux8-0002e6-Im
	for submit <at> debbugs.gnu.org; Wed, 04 Dec 2024 14:22:26 -0500
Received: from lists.gnu.org ([209.51.188.17]:59688)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <juli@HIDDEN>) id 1tIux6-0002dy-75
 for submit <at> debbugs.gnu.org; Wed, 04 Dec 2024 14:22:24 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <juli@HIDDEN>) id 1tIux5-0000KO-Pi
 for bug-guile@HIDDEN; Wed, 04 Dec 2024 14:22:23 -0500
Received: from out-172.mta0.migadu.com ([2001:41d0:1004:224b::ac])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <juli@HIDDEN>) id 1tIuwu-0000Qe-OV
 for bug-guile@HIDDEN; Wed, 04 Dec 2024 14:22:15 -0500
X-Report-Abuse: Please report any abuse attempt to abuse@HIDDEN and
 include these headers.
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=incana.org; s=key1;
 t=1733340124;
 h=from:from:reply-to:subject:subject:date:date:message-id:message-id:
 to:to:cc:cc:mime-version:mime-version:
 content-transfer-encoding:content-transfer-encoding;
 bh=S5V/zMlt9Cfza74leMutuOAeOBU58GMCEophjf9hqmM=;
 b=w9g67Q8jivdacYak4Ja2MD+p815AFUInbZ686mSUrmHVUV8HdvlkXx60g28A9BMjambxK6
 H0DKBcJDlJHgpkaokPZxbaMEdhdA+p6tiXnU9IpluINT9D6TsZP69QjMg+liSTbM2XcGop
 t7/ZSYq0lNE6aR/QR6UB8NQ5BZPf509HTLrj4gL/p5+aBq3asgMYZ8BkLyjJPwtoei1qTF
 qOFVC2C7vmPSI6eB18wu3hyJH801wCEtsiIlXEabn/RNwauovICEly6hkztlY0gbkVTOBb
 zV3O2upgEOPKTDzA/esLA1KN7IkPV+2fqPIvHjSleHsZgjJH5/D/Nshwcyk3Nw==
From: Juliana Sims <juli@HIDDEN>
To: bug-guile@HIDDEN
Subject: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument.
Date: Wed,  4 Dec 2024 14:20:55 -0500
Message-ID: <20241204192055.30996-1-juli@HIDDEN>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
X-Migadu-Flow: FLOW_OUT
Received-SPF: pass client-ip=2001:41d0:1004:224b::ac;
 envelope-from=juli@HIDDEN; helo=out-172.mta0.migadu.com
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
 DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001,
 SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.4 (-)
X-Debbugs-Envelope-To: submit
Cc: Juliana Sims <juli@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.4 (--)

* module/srfi/srfi-1.scm (map!): Re-use cons cells of first argument.
---
Hello,

This patch rewrites map! to update its first argument in-place.  I based the
implementation on the description in the Guile manual.  Most of the code is
copied from regular map with different argument checking logic.  I wasn't
entirely sure of the conventions around scm-error so let me know if that's not
the appropriate key.

Best,
Juli

 module/srfi/srfi-1.scm | 58 ++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 56 insertions(+), 2 deletions(-)

diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index b46f7be5f..c0018b188 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -791,8 +791,62 @@ has just one element then that's the return value."
 (define (append-map! f clist1 . rest)
   (concatenate! (apply map f clist1 rest)))
 
-;; OPTIMIZE-ME: Re-use cons cells of list1
-(define map! map)
+(define map!
+  (case-lambda
+    ((f lst)
+     (check-arg procedure? f map!)
+     (check-arg list? lst map!)
+     (let map1 ((l lst))
+       (if (pair? l)
+           (begin
+             (set-car! l (f (car l)))
+             (map1 (cdr l)))
+           lst)))
+
+    ((f lst1 lst2)
+     (check-arg procedure? f map!)
+     (check-arg list? lst1 map!)
+     (let* ((len1 (length lst1))
+            (len2 (length+ lst2))
+            ;; Ensure either that all lists after the first are circular or that
+            ;; they are at least as long as the first
+            (len (and (or (not len2)
+                          (<= len1 len2))
+                      len1)))
+       (unless len
+         (scm-error 'misc-error "map!"
+                    "All argument lists must be at least as long as first: ~S"
+                    (list (list lst1 lst2)) #f))
+       (let map2 ((l1 lst1) (l2 lst2) (len len))
+         (if (zero? len)
+             lst1
+             (begin
+               (set-car! l1 (f (car l1) (car l2)))
+               (map2 (cdr l1) (cdr l2) (1- len)))))))
+
+    ((f lst1 . rest)
+     (check-arg procedure? f map!)
+     (check-arg list? lst1 map!)
+     ;; Ensure either that all lists after the first are circular or that
+     ;; they are at least as long as the first
+     (let ((len (fold (lambda (ls len)
+                        (let ((ls-len (length+ ls)))
+                          (and len
+                               (or (not ls-len)
+                                   (<= len ls-len))
+                               len)))
+                      (length lst1)
+                      rest)))
+       (unless len
+         (scm-error 'misc-error "map!"
+                    "All argument lists must be at least as long as first: ~S"
+                    (list (cons lst1 rest)) #f))
+       (let mapn ((l1 lst1) (rest rest) (len len))
+         (if (zero? len)
+             lst1
+             (begin
+               (set-car! l1 (apply f (car l1) (map car rest)))
+               (mapn (cdr l1) (map cdr rest) (1- len)))))))))
 
 (define (filter-map proc list1 . rest)
   "Apply PROC to the elements of LIST1... and return a list of the
-- 
2.46.0





Acknowledgement sent to Juliana Sims <juli@HIDDEN>:
New bug report received and forwarded. Copy sent to bug-guile@HIDDEN. Full text available.
Report forwarded to bug-guile@HIDDEN:
bug#74696; Package guile. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Sun, 12 Jan 2025 05:45:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.