summaryrefslogtreecommitdiff
path: root/module/rnrs/lists.scm
diff options
context:
space:
mode:
authorIan Price <ianprice90@googlemail.com>2011-10-26 20:24:05 +0100
committerLudovic Courtès <ludo@gnu.org>2011-11-01 01:11:46 +0100
commitd825841db0eb920150d6734b8928b6a3decbca0e (patch)
treeb60f3a56a7697481d99ab77a612cc30a660f8cdd /module/rnrs/lists.scm
parent2be3feb17e5456bba71749e0e97adf45c32c4e0e (diff)
downloadguile-d825841db0eb920150d6734b8928b6a3decbca0e.tar.gz
Fix R6RS `fold-left' so the accumulator is the first argument.
* module/rnrs/lists.scm (fold-left): New procedure. * module/rnrs/records/syntactic.scm (define-record-type): Fix to use corrected `fold-left'. * test-suite/tests/r6rs-lists.test: Add tests. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'module/rnrs/lists.scm')
-rw-r--r--module/rnrs/lists.scm12
1 files changed, 9 insertions, 3 deletions
diff --git a/module/rnrs/lists.scm b/module/rnrs/lists.scm
index 812ce5f98..0671e7753 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))