GNU bug report logs - #9883
R6RS fold-left

Previous Next

Package: guile;

Reported by: Ian Price <ianprice90 <at> googlemail.com>

Date: Wed, 26 Oct 2011 20:48:02 UTC

Severity: normal

Done: ludo <at> gnu.org (Ludovic Courtès)

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 9883 in the body.
You can then email your comments to 9883 AT debbugs.gnu.org in the normal way.

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

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to bug-guile <at> gnu.org:
bug#9883; Package guile. (Wed, 26 Oct 2011 20:48:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to Ian Price <ianprice90 <at> googlemail.com>:
New bug report received and forwarded. Copy sent to bug-guile <at> gnu.org. (Wed, 26 Oct 2011 20:48:03 GMT) Full text and rfc822 format available.

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

From: Ian Price <ianprice90 <at> googlemail.com>
To: bug-guile <at> gnu.org
Subject: R6RS fold-left
Date: Wed, 26 Oct 2011 21:43:16 +0100
[Message part 1 (text/plain, inline)]
Hi guilers,

According to the R6RS the accumulator should be the first argument of
the combiner[0], not the last as in SRFI 1[1].

I've attached a patch to fix this, and the use of fold-left in
define-record-type.

Currently, it terminates on the first null (as in SRFI 1). If you would
prefer, I can change it to check the lengths of the lists before-hand,
and do the same for fold-right.

Cheers.

0. http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-4.html#node_idx_212
1. http://srfi.schemers.org/srfi-1/srfi-1.html#fold
-- 
Ian Price

"Programming is like pinball. The reward for doing it well is
the opportunity to do it again" - from "The Wizardy Compiled"
[0001-Fix-R6RS-fold-left.patch (text/x-patch, inline)]
From 31b964c85ba45d72e4ec047e7d0420146a12941c Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90 <at> googlemail.com>
Date: Wed, 26 Oct 2011 20:24:05 +0100
Subject: [PATCH] Fix R6RS `fold-left'

* module/rnrs/lists.scm (fold-left) : Wrote R6RS compliant
  version with accumulator as first argument to the combiner.

* module/rnrs/records/syntactic.scm (define-record-type): Fix to use
  corrected fold-left.

* test-suite/tests/r6rs-lists.test: Add tests.
---
 module/rnrs/lists.scm             |   12 +++++++++---
 module/rnrs/records/syntactic.scm |    4 ++--
 test-suite/tests/r6rs-lists.test  |   26 ++++++++++++++++++++++++++
 3 files changed, 37 insertions(+), 5 deletions(-)

diff --git a/module/rnrs/lists.scm b/module/rnrs/lists.scm
index 812ce5f..0671e77 100644
--- a/module/rnrs/lists.scm
+++ b/module/rnrs/lists.scm
@@ -22,8 +22,7 @@
 	  remv remq memp member memv memq assp assoc assv assq cons*)
   (import (rnrs base (6))
           (only (guile) filter member memv memq assoc assv assq cons*)
-	  (rename (only (srfi srfi-1) fold 
-			              any 
+	  (rename (only (srfi srfi-1) any 
 				      every 
 				      remove 
 				      member 
@@ -32,7 +31,6 @@
 				      partition
 				      fold-right 
 				      filter-map)
-		  (fold fold-left) 
 		  (any exists) 
 		  (every for-all)
 		  (remove remp)
@@ -40,6 +38,14 @@
 		  (member memp-internal)
 		  (assoc assp-internal)))
 
+  (define (fold-left combine nil list . lists)
+    (define (fold nil lists)
+      (if (exists null? lists)
+          nil
+          (fold (apply combine nil (map car lists))
+                (map cdr lists))))
+    (fold nil (cons list lists)))
+
   (define (remove obj list) (remp (lambda (elt) (equal? obj elt)) list))
   (define (remv obj list) (remp (lambda (elt) (eqv? obj elt)) list))
   (define (remq obj list) (remp (lambda (elt) (eq? obj elt)) list))
diff --git a/module/rnrs/records/syntactic.scm b/module/rnrs/records/syntactic.scm
index a497b90..bde6f93 100644
--- a/module/rnrs/records/syntactic.scm
+++ b/module/rnrs/records/syntactic.scm
@@ -134,13 +134,13 @@
               (let* ((fields (if (unspecified? _fields) '() _fields))
                      (field-names (list->vector (map car fields)))
                      (field-accessors
-                      (fold-left (lambda (x c lst)
+                      (fold-left (lambda (lst x c)
                                    (cons #`(define #,(cadr x)
                                              (record-accessor record-name #,c))
                                          lst))
                                  '() fields (sequence (length fields))))
                      (field-mutators
-                      (fold-left (lambda (x c lst)
+                      (fold-left (lambda (lst x c)
                                    (if (caddr x)
                                        (cons #`(define #,(caddr x)
                                                  (record-mutator record-name
diff --git a/test-suite/tests/r6rs-lists.test b/test-suite/tests/r6rs-lists.test
index ba645ed..030091f 100644
--- a/test-suite/tests/r6rs-lists.test
+++ b/test-suite/tests/r6rs-lists.test
@@ -30,3 +30,29 @@
     (let ((d '((3 a) (1 b) (4 c))))
       (equal? (assp even? d) '(4 c)))))
 
+(with-test-prefix "fold-left"
+  (pass-if "fold-left sum"
+    (equal? (fold-left + 0 '(1 2 3 4 5))
+            15))
+  (pass-if "fold-left reverse"
+    (equal? (fold-left (lambda (a e) (cons e a)) '() '(1 2 3 4 5))
+            '(5 4 3 2 1)))
+  (pass-if "fold-left max-length"
+    (equal? (fold-left (lambda (max-len s)
+                         (max max-len (string-length s)))
+                       0
+                       '("longest" "long" "longer"))
+            7))
+  (pass-if "fold-left with-cons"
+    (equal? (fold-left cons '(q) '(a b c))
+            '((((q) . a) . b) . c)))
+  (pass-if "fold-left sum-multiple"
+    (equal? (fold-left + 0 '(1 2 3) '(4 5 6))
+            21))
+  (pass-if "fold-left pairlis"
+    (equal? (fold-left (lambda (accum e1 e2)
+                         (cons (cons e1 e2) accum))
+                       '((d . 4))
+                       '(a b c)
+                       '(1 2 3))
+            '((c . 3) (b . 2) (a . 1) (d  . 4)))))
-- 
1.7.6.4


Reply sent to ludo <at> gnu.org (Ludovic Courtès):
You have taken responsibility. (Tue, 01 Nov 2011 00:16:01 GMT) Full text and rfc822 format available.

Notification sent to Ian Price <ianprice90 <at> googlemail.com>:
bug acknowledged by developer. (Tue, 01 Nov 2011 00:16:02 GMT) Full text and rfc822 format available.

Message #10 received at 9883-done <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: Ian Price <ianprice90 <at> googlemail.com>
Cc: 9883-done <at> debbugs.gnu.org
Subject: Re: bug#9883: R6RS fold-left
Date: Tue, 01 Nov 2011 01:13:38 +0100
Hi Ian,

Ian Price <ianprice90 <at> googlemail.com> skribis:

> According to the R6RS the accumulator should be the first argument of
> the combiner[0], not the last as in SRFI 1[1].
>
> I've attached a patch to fix this, and the use of fold-left in
> define-record-type.

Applied with minor changes in the commit log.  Thanks!

Ludo’.




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Tue, 29 Nov 2011 12:24:03 GMT) Full text and rfc822 format available.

This bug report was last modified 13 years and 262 days ago.

Previous Next


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