summaryrefslogtreecommitdiff
path: root/module/srfi
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-10-08 10:23:52 +0200
committerLudovic Courtès <ludo@gnu.org>2010-10-08 15:25:56 +0200
commit07076c1e61ab05b62979ee01a5220edb308b0750 (patch)
treef64541ed8e206a3fc02e5e919b1a53b78dfbbd96 /module/srfi
parentc00623281b8272388b673996d94f6e4b9146f909 (diff)
downloadguile-07076c1e61ab05b62979ee01a5220edb308b0750.tar.gz
SRFI-1: Make `unfold' tail-recursive (fix bug #30071).
* module/srfi/srfi-1.scm (unfold): Make tail-recursive, following a suggestion by Szavai Gyula. * test-suite/tests/srfi-1.test ("unfold"): New test prefix.
Diffstat (limited to 'module/srfi')
-rw-r--r--module/srfi/srfi-1.scm17
1 files changed, 13 insertions, 4 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index d7ef6bb0c..1e006c753 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -454,11 +454,20 @@ that result. See the manual for details."
(apply kons (append! lists (list (f (map1 cdr lists)))))))))
(define* (unfold p f g seed #:optional (tail-gen (lambda (x) '())))
- (let uf ((seed seed))
+ (define (reverse+tail lst seed)
+ (let loop ((lst lst)
+ (result (tail-gen seed)))
+ (if (null? lst)
+ result
+ (loop (cdr lst)
+ (cons (car lst) result)))))
+
+ (let loop ((seed seed)
+ (result '()))
(if (p seed)
- (tail-gen seed)
- (cons (f seed)
- (uf (g seed))))))
+ (reverse+tail result seed)
+ (loop (g seed)
+ (cons (f seed) result)))))
(define* (unfold-right p f g seed #:optional (tail '()))
(let uf ((seed seed) (lis tail))