/[guile]/guile/guile-core/srfi/srfi-1.scm
ViewVC logotype

Diff of /guile/guile-core/srfi/srfi-1.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by ttn, Mon Jan 21 01:11:35 2002 UTC revision 1.14 by ttn, Mon Jan 21 21:31:34 2002 UTC
# Line 510  Line 510 
510                   (lp (map1 cdr lists))))))))                   (lp (map1 cdr lists))))))))
511    
512  (define (count1 pred clist)  (define (count1 pred clist)
513    (if (null? clist)    (let lp ((result 0) (rest clist))
514      0      (if (null? rest)
515      (if (pred (car clist))          result
516        (+ 1 (count1 pred (cdr clist)))          (if (pred (car rest))
517        (count1 pred (cdr clist)))))              (lp (+ 1 result) (cdr rest))
518                (lp result (cdr rest))))))
519    
520  ;;; Fold, unfold & map  ;;; Fold, unfold & map
521    
# Line 771  Line 772 
772        clist        clist
773        (find-tail pred (cdr clist)))))        (find-tail pred (cdr clist)))))
774    
775  (define (take-while pred clist)  (define (take-while pred ls)
776    (if (null? clist)    (cond ((null? ls) '())
777      '()          ((not (pred (car ls))) '())
778      (if (pred (car clist))          (else
779        (cons (car clist) (take-while pred (cdr clist)))           (let ((result (list (car ls))))
780        '())))             (let lp ((ls (cdr ls)) (p result))
781                 (cond ((null? ls) result)
782                       ((not (pred (car ls))) result)
783                       (else
784                        (set-cdr! p (list (car ls)))
785                        (lp (cdr ls) (cdr p)))))))))
786    
787  (define (take-while! pred clist)  (define (take-while! pred clist)
788    (take-while pred clist))              ; XXX:optimize    (take-while pred clist))              ; XXX:optimize

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26