GNU logs - #74696, boring messages

Message sent to bug-guile@HIDDEN:

Subject: bug#74696: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument.
Resent-From: Juliana Sims <juli@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-guile@HIDDEN
Resent-Date: Wed, 04 Dec 2024 19:23:01 +0000
Resent-Message-ID: <handler.74696.B.173334014710179 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 74696 <at> debbugs.gnu.org
Cc: Juliana Sims <juli@HIDDEN>
From: Juliana Sims <juli@HIDDEN>
Date: Wed,  4 Dec 2024 14:20:55 -0500
Message-ID: <20241204192055.30996-1-juli@HIDDEN>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
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-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

Message sent:

Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable
MIME-Version: 1.0
X-Mailer: MIME-tools 5.505 (Entity 5.505)
Content-Type: text/plain; charset=utf-8
X-Loop: help-debbugs@HIDDEN
From: help-debbugs@HIDDEN (GNU bug Tracking System)
To: Juliana Sims <juli@HIDDEN>
Subject: bug#74696: Acknowledgement ([PATCH 1/1] srfi-1: map!: Re-use cons
 cells of first argument.)
Message-ID: <handler.74696.B.173334014710179.ack <at> debbugs.gnu.org>
References: <20241204192055.30996-1-juli@HIDDEN>
X-Gnu-PR-Message: ack 74696
X-Gnu-PR-Package: guile
X-Gnu-PR-Keywords: patch
Reply-To: 74696 <at> debbugs.gnu.org
Date: Wed, 04 Dec 2024 19:23:02 +0000

Thank you for filing a new bug report with debbugs.gnu.org.

This is an automatically generated reply to let you know your message
has been received.

Your message is being forwarded to the package maintainers and other
interested parties for their attention; they will reply in due course.

Your message has been sent to the package maintainer(s):
 bug-guile@HIDDEN

If you wish to submit further information on this problem, please
send it to 74696 <at> debbugs.gnu.org.

Please do not send mail to help-debbugs@HIDDEN unless you wish
to report a problem with the Bug-tracking system.

--=20
74696: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D74696
GNU Bug Tracking System
Contact help-debbugs@HIDDEN with problems

Message sent to bug-guile@HIDDEN:

Subject: bug#74696: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-guile@HIDDEN
Resent-Date: Sun, 22 Dec 2024 21:46:02 +0000
Resent-Message-ID: <handler.74696.B74696.173490393512647 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: Juliana Sims <juli@HIDDEN>
Cc: 74696 <at> debbugs.gnu.org
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
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
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

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.

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.