mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-30 00:40:20 +02:00
Code Activity

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

Browse source 
Thanks to Panagiotis Vossos.
This commit is contained in:
Thien-Thi Nguyen 2002-01-21 21:34:19 +00:00
parent c2b8405784
commit cd246d3d16
1 changed files with 17 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

28
srfi/srfi-1.scm
View file

@ -524,11 +524,12 @@
(lp (map1 cdr lists)))))))) (lp (map1 cdr lists))))))))
(define (count1 pred clist) (define (count1 pred clist)
(if (null? clist) (let lp ((result 0) (rest clist))
0 (if (null? rest)
(if (pred (car clist)) result
(+ 1 (count1 pred (cdr clist))) (if (pred (car rest))
(count1 pred (cdr clist))))) (lp (+ 1 result) (cdr rest))
(lp result (cdr rest))))))
;;; Fold, unfold & map ;;; Fold, unfold & map
@ -785,12 +786,17 @@
clist clist
(find-tail pred (cdr clist))))) (find-tail pred (cdr clist)))))
(define (take-while pred clist) (define (take-while pred ls)
(if (null? clist) (cond ((null? ls) '())
'() ((not (pred (car ls))) '())
(if (pred (car clist)) (else
(cons (car clist) (take-while pred (cdr clist))) (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) (define (take-while! pred clist)
(take-while pred clist)) ; XXX:optimize (take-while pred clist)) ; XXX:optimize