/[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.8.2.2 by ttn, Mon Jan 21 21:01:23 2002 UTC revision 1.8.2.3 by ttn, Mon Jan 21 21:34:19 2002 UTC
# Line 524  Line 524 
524                   (lp (map1 cdr lists))))))))                   (lp (map1 cdr lists))))))))
525    
526  (define (count1 pred clist)  (define (count1 pred clist)
527    (if (null? clist)    (let lp ((result 0) (rest clist))
528      0      (if (null? rest)
529      (if (pred (car clist))          result
530        (+ 1 (count1 pred (cdr clist)))          (if (pred (car rest))
531        (count1 pred (cdr clist)))))              (lp (+ 1 result) (cdr rest))
532                (lp result (cdr rest))))))
533    
534  ;;; Fold, unfold & map  ;;; Fold, unfold & map
535    
# Line 785  Line 786 
786        clist        clist
787        (find-tail pred (cdr clist)))))        (find-tail pred (cdr clist)))))
788    
789  (define (take-while pred clist)  (define (take-while pred ls)
790    (if (null? clist)    (cond ((null? ls) '())
791      '()          ((not (pred (car ls))) '())
792      (if (pred (car clist))          (else
793        (cons (car clist) (take-while pred (cdr clist)))           (let ((result (list (car ls))))
794        '())))             (let lp ((ls (cdr ls)) (p result))
795                 (cond ((null? ls) result)
796                       ((not (pred (car ls))) result)
797                       (else
798                        (set-cdr! p (list (car ls)))
799                        (lp (cdr ls) (cdr p)))))))))
800    
801  (define (take-while! pred clist)  (define (take-while! pred clist)
802    (take-while pred clist))              ; XXX:optimize    (take-while pred clist))              ; XXX:optimize

Legend:
Removed from v.1.8.2.2  
changed lines
  Added in v.1.8.2.3

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