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

clearer definition for fold-files, pass

Browse Source 
svn: r3692
This commit is contained in:
Eli Barzilay 2006-07-12 21:48:32 +00:00
parent 36f7613855
commit 897fc0e26c
1 changed files with 16 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/mzlib/file.ss
View File

@ -475,31 +475,25 @@
;; fold-files : (pathname sym alpha -> alpha) alpha pathname/#f -> alpha ;; fold-files : (pathname sym alpha -> alpha) alpha pathname/#f -> alpha
(define fold-files (define fold-files
(opt-lambda (f init [path #f] [follow-links? #t]) (opt-lambda (f init [path #f] [follow-links? #t])
(define (do-path path acc)
(define (traverse-dir dir base acc) (cond [(and (not follow-links?) (link-exists? path)) (f path 'link acc)]
(let loop ([subs (directory-list dir)] [acc acc]) [(directory-exists? path)
(cond [(null? subs) acc] (do-paths (map (lambda (p) (build-path path p))
[else (loop (cdr subs) (directory-list path))
(let ([path (if base (f path 'dir acc))]
(build-path base (car subs)) [(file-exists? path) (f path 'file acc)]
(car subs))]) [(link-exists? path) (f path 'link acc)] ; dangling links
(traverse-file/dir path path acc)))]))) [else (error 'fold-files "path disappeared: ~e" path)]))
(define (do-paths paths acc)
(define (traverse-file/dir file/dir base acc) (cond [(null? paths) acc]
(cond [(and (not follow-links?) (link-exists? file/dir)) [else (do-paths (cdr paths) (do-path (car paths) acc))]))
(f file/dir 'link acc)] (if path (do-path path init) (do-paths (directory-list) init))))
[(directory-exists? file/dir)
(traverse-dir file/dir base (if base (f file/dir 'dir acc) acc))]
[else (f file/dir 'file acc)]))
(traverse-file/dir (or path (current-directory)) path init)))
(define find-files (define find-files
(opt-lambda (f [path #f]) (opt-lambda (f [path #f])
(reverse! (fold-files (lambda (path kind acc) (reverse!
(if (f path) (cons path acc) acc)) (fold-files (lambda (path kind acc) (if (f path) (cons path acc) acc))
null null path))))
path))))
(define (pathlist-closure paths) (define (pathlist-closure paths)
(let loop ([paths (map (lambda (p) (simplify-path (resolve-path p) #f)) (let loop ([paths (map (lambda (p) (simplify-path (resolve-path p) #f))