diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-10-08 10:23:52 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-10-08 15:25:56 +0200 |
commit | 07076c1e61ab05b62979ee01a5220edb308b0750 (patch) | |
tree | f64541ed8e206a3fc02e5e919b1a53b78dfbbd96 /module/srfi | |
parent | c00623281b8272388b673996d94f6e4b9146f909 (diff) | |
download | guile-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.scm | 17 |
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)) |