summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/srfi/srfi-1.scm20
-rw-r--r--test-suite/tests/srfi-1.test22
2 files changed, 34 insertions, 8 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 1e006c753..d6cefcdbd 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -419,14 +419,18 @@ that result. See the manual for details."
(define (fold-right kons knil clist1 . rest)
(if (null? rest)
- (let f ((list1 clist1))
- (if (null? list1)
- knil
- (kons (car list1) (f (cdr list1)))))
- (let f ((lists (cons clist1 rest)))
- (if (any null? lists)
- knil
- (apply kons (append! (map1 car lists) (list (f (map1 cdr lists)))))))))
+ (let loop ((lst (reverse clist1))
+ (result knil))
+ (if (null? lst)
+ result
+ (loop (cdr lst)
+ (kons (car lst) result))))
+ (let loop ((lists (map1 reverse (cons clist1 rest)))
+ (result knil))
+ (if (any1 null? lists)
+ result
+ (loop (map1 cdr lists)
+ (apply kons (append! (map1 car lists) (list result))))))))
(define (pair-fold kons knil clist1 . rest)
(if (null? rest)
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index 8569a3db1..eaad8c961 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -1266,6 +1266,28 @@
(equal? '((1 2) (3 4) (5 6)) lst))))))
;;
+;; fold-right
+;;
+
+(with-test-prefix "fold-right"
+
+ (pass-if "one list"
+ (equal? (iota 10)
+ (fold-right cons '() (iota 10))))
+
+ (pass-if "two lists"
+ (equal? (zip (iota 10) (map integer->char (iota 10)))
+ (fold-right (lambda (x y z)
+ (cons (list x y) z))
+ '()
+ (iota 10)
+ (map integer->char (iota 10)))))
+
+ (pass-if "tail-recursive"
+ (= 1e6 (fold-right (lambda (x y) (+ 1 y))
+ 0
+ (iota 1e6)))))
+;;
;; unfold
;;