From cd246d3d16df2b6cf0c5828ef132531ef8ee61cb Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 21 Jan 2002 21:34:19 +0000 Subject: [PATCH] (count1, take-while): Rewrite to be tail-recursive. Thanks to Panagiotis Vossos. --- srfi/srfi-1.scm | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm index 01dfbcc10..0e6aa0319 100644 --- a/srfi/srfi-1.scm +++ b/srfi/srfi-1.scm @@ -524,11 +524,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 @@ -785,12 +786,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