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

65
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
(lambda (f init l)
(letrec ((helper
(lambda (init l)
(cond [(null? l) init]
[else (helper (f (car l) init) (cdr l))]))))
(helper init l)))]
[fold-n
(lambda (f init l)
(cond
[(ormap null? l)
(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 (case-lambda
[(f init l) (fold-one f init l)] [(f init l)
[(f init l . ls) (fold-n f init (cons l ls))]))) (let loop ([init init] [l l])
(if (null? l) init (loop (f (car l) init) (cdr l))))]
[(f init l . ls)
(let loop ([init init] [ls (cons l ls)])
(cond [(andmap pair? ls)
(loop (apply f (mapadd car ls init)) (map cdr ls))]
[(ormap pair? ls)
(error 'foldl "received non-equal length input lists")]
[else init]))]))
(define foldr (define foldr
(letrec ([fold-one
(lambda (f init l)
(letrec ((helper
(lambda (init l)
(cond [(null? l) init]
[else (f (car l) (helper init (cdr l)))]))))
(helper init l)))]
[fold-n
(lambda (f init l)
(cond
[(ormap null? l)
(if (andmap null? l)
init
(error 'foldr "received non-equal length input lists"))]
[else (apply f (mapadd car l (fold-n f init (map cdr l))))]))])
(case-lambda (case-lambda
[(f init l) (fold-one f init l)] [(f init l)
[(f init l . ls) (fold-n f init (cons l ls))]))) (let loop ([init init] [l l])
(if (null? l)
init
(f (car l) (loop init (cdr l)))))]
[(f init l . ls)
(let loop ([ls (cons l ls)])
(cond [(andmap pair? ls)
(apply f (mapadd car ls (loop (map cdr ls))))]
[(ormap pair? ls)
(error 'foldr "received non-equal length input lists")]
[else init]))]))
(define (make-find name whole-list?) (define (make-find name whole-list?)
(lambda (f list) (lambda (f list)