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

Previous Next

To reply to this bug, email your comments to 74696 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Juliana Sims <juli <at> incana.org>
To: bug-guile <at> gnu.org
Cc: Juliana Sims <juli <at> incana.org>
Subject: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument.
Date: Wed,  4 Dec 2024 14:20:55 -0500

* 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 #8 received at 74696 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Juliana Sims <juli <at> incana.org>
Cc: 74696 <at> debbugs.gnu.org
Subject: Re: bug#74696: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first
 argument.
Date: Sun, 22 Dec 2024 22:45:24 +0100

Hi Juliana,

Juliana Sims <juli <at> incana.org> skribis:

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

Could you add a couple of tests under ‘test-suite/tests/srfi-1.test’?

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

Ludo’.

Message #11 received at 74696 <at> debbugs.gnu.org (full text, mbox):

From: Juliana Sims <juli <at> incana.org>
To: 74696 <at> debbugs.gnu.org
Cc: ludo <at> gnu.org, Juliana Sims <juli <at> incana.org>
Subject: [PATCH] srfi-1: map!: Re-use cons cells of first argument.
Date: Fri, 31 Jan 2025 05:20:46 -0500

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

Hi Ludo,

Thanks for your patience in getting this together.  I've added some tests for
map!.  Let me know if you think there are more cases that should be tested.

As a sidenote, it looks like regular map isn't directly tested.  Maybe if I get
time I'll copy these tests for it :)

Thanks,
Juli

 module/srfi/srfi-1.scm       | 58 ++++++++++++++++++++++++++++++++++--
 test-suite/tests/srfi-1.test | 38 +++++++++++++++++++++++
 2 files changed, 94 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
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index 558934df4..4263b5ac1 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -1921,6 +1921,44 @@
 		  '(1) '(2))
       good)))
 
+;;
+;; map!
+;;
+
+(with-test-prefix "map!"
+
+  (pass-if-exception "no args" exception:wrong-num-args
+    (map!))
+
+  (pass-if-exception "one arg" exception:wrong-num-args
+    (map! (lambda _ #t)))
+
+  (pass-if-exception "non-procedure first arg" exception:wrong-type-arg
+    (map! 'not-a-proc '(1 2 3)))
+
+  (pass-if-exception "non-list second arg" exception:wrong-type-arg
+    (map! identity '(1 2 3)))
+
+  (pass-if "1+ (1 2 3)"
+    (let ((lst '(1 2 3)))
+      (and (eq? lst (map! 1+ lst))
+           (equal? '(2 3 4) lst))))
+
+  (pass-if "+ (1 2 3) (3 2 1)"
+    (let ((l1 '(1 2 3))
+          (l2 '(3 2 1)))
+      (and (eq? l1 (map! + l1 l2))
+           (not (eq? l1 l2))
+           (equal? '(4 4 4) l1))))
+
+  (pass-if "+ (1 1 1) (2 2 2) (3 3 3)"
+    (let ((l1 '(1 1 1))
+          (l2 '(2 2 2))
+          (l3 '(3 3 3)))
+      (and (eq? l1 (map! + l1 l2 l3))
+           (not (eq? l1 l2 l3))
+           (equal? '(6 6 6) l1)))))
+
 ;;
 ;; member
 ;;
-- 
2.48.1

Message #14 received at 74696 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Juliana Sims <juli <at> incana.org>
Cc: 74696 <at> debbugs.gnu.org
Subject: Re: bug#74696: [PATCH] srfi-1: map!: Re-use cons cells of first
 argument.
Date: Fri, 28 Feb 2025 21:59:44 +0100

Hello!

Juliana Sims <juli <at> incana.org> skribis:

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

This LGTM but it leads to a bunch of unrelated test failures.  Could you
check on your side?

Thanks,
Ludo’.

Previous Next

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