(count1, take-while): Rewrite to be tail-recursive.

Thanks to Panagiotis Vossos.

1 files changed, 17 insertions, 11 deletions

diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
index 21475e323..1d9dd678c 100644
--- a/srfi/srfi-1.scm
+++ b/srfi/srfi-1.scm
@@ -510,11 +510,12 @@
 		 (lp (map1 cdr lists))))))))
 
 (define (count1 pred clist)
-  (if (null? clist)
-    0
-    (if (pred (car clist))
-      (+ 1 (count1 pred (cdr clist)))
-      (count1 pred (cdr clist)))))
+  (let lp ((result 0) (rest clist))
+    (if (null? rest)
+	result
+	(if (pred (car rest))
+	    (lp (+ 1 result) (cdr rest))
+	    (lp result (cdr rest))))))
 
 ;;; Fold, unfold & map
 
@@ -771,12 +772,17 @@
       clist
       (find-tail pred (cdr clist)))))
 
-(define (take-while pred clist)
-  (if (null? clist)
-    '()
-    (if (pred (car clist))
-      (cons (car clist) (take-while pred (cdr clist)))
-      '())))
+(define (take-while pred ls)
+  (cond ((null? ls) '())
+        ((not (pred (car ls))) '())
+        (else
+         (let ((result (list (car ls))))
+           (let lp ((ls (cdr ls)) (p result))
+             (cond ((null? ls) result)
+                   ((not (pred (car ls))) result)
+                   (else
+                    (set-cdr! p (list (car ls)))
+                    (lp (cdr ls) (cdr p)))))))))
 
 (define (take-while! pred clist)
   (take-while pred clist))		; XXX:optimize