diff options
-rw-r--r-- | srfi/srfi-1.scm | 28 |
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 |