summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/srfi/srfi-1.scm17
-rw-r--r--test-suite/tests/srfi-1.test28
2 files changed, 41 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))
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index ca34e8fa8..8569a3db1 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -1266,6 +1266,34 @@
(equal? '((1 2) (3 4) (5 6)) lst))))))
;;
+;; unfold
+;;
+
+(with-test-prefix "unfold"
+
+ (pass-if "basic"
+ (equal? (iota 10)
+ (unfold (lambda (x) (>= x 10))
+ identity
+ 1+
+ 0)))
+
+ (pass-if "tail-gen"
+ (equal? (append (iota 10) '(tail 10))
+ (unfold (lambda (x) (>= x 10))
+ identity
+ 1+
+ 0
+ (lambda (seed) (list 'tail seed)))))
+
+ (pass-if "tail-recursive"
+ ;; Bug #30071.
+ (pair? (unfold (lambda (x) (>= x 1e6))
+ identity
+ 1+
+ 0))))
+
+;;
;; length+
;;