suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

simplified fold code

Browse Source 
svn: r3190
This commit is contained in:
Eli Barzilay 2006-06-02 20:06:31 +00:00
parent 8f0f4aacf3
commit 124761f29a
1 changed files with 28 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
collects/mzlib/list.ss
View File

@ -217,51 +217,38 @@
;; beginning of the list. ;; beginning of the list.
(define (mapadd f l last) (define (mapadd f l last)
(letrec ((helper (let loop ([l l])
(lambda (l) (if (null? l)
(cond [(null? l) (list last)] (list last)
[else (cons (f (car l)) (helper (cdr l)))])))) (cons (f (car l)) (loop (cdr l))))))
(helper l)))
(define foldl (define foldl
(letrec ([fold-one (case-lambda
(lambda (f init l) [(f init l)
(letrec ((helper (let loop ([init init] [l l])
(lambda (init l) (if (null? l) init (loop (f (car l) init) (cdr l))))]
(cond [(null? l) init] [(f init l . ls)
[else (helper (f (car l) init) (cdr l))])))) (let loop ([init init] [ls (cons l ls)])
(helper init l)))] (cond [(andmap pair? ls)
[fold-n (loop (apply f (mapadd car ls init)) (map cdr ls))]
(lambda (f init l) [(ormap pair? ls)
(cond (error 'foldl "received non-equal length input lists")]
[(ormap null? l) [else init]))]))
(if (andmap null? l)
init
(error 'foldl "received non-equal length input lists"))]
[else (fold-n f (apply f (mapadd car l init)) (map cdr l))]))])
(case-lambda
[(f init l) (fold-one f init l)]
[(f init l . ls) (fold-n f init (cons l ls))])))
(define foldr (define foldr
(letrec ([fold-one (case-lambda
(lambda (f init l) [(f init l)
(letrec ((helper (let loop ([init init] [l l])
(lambda (init l) (if (null? l)
(cond [(null? l) init] init
[else (f (car l) (helper init (cdr l)))])))) (f (car l) (loop init (cdr l)))))]
(helper init l)))] [(f init l . ls)
[fold-n (let loop ([ls (cons l ls)])
(lambda (f init l) (cond [(andmap pair? ls)
(cond (apply f (mapadd car ls (loop (map cdr ls))))]
[(ormap null? l) [(ormap pair? ls)
(if (andmap null? l) (error 'foldr "received non-equal length input lists")]
init [else init]))]))
(error 'foldr "received non-equal length input lists"))]
[else (apply f (mapadd car l (fold-n f init (map cdr l))))]))])
(case-lambda
[(f init l) (fold-one f init l)]
[(f init l . ls) (fold-n f init (cons l ls))])))
(define (make-find name whole-list?) (define (make-find name whole-list?)
(lambda (f list) (lambda (f list)