mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +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))))))))
(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