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

more minorities

Browse Source 
svn: r16466
This commit is contained in:
Eli Barzilay 2009-10-30 07:47:15 +00:00
parent f0f9e995d6
commit 6d2756c562
1 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/scheme/file.ss
View File

@ -290,20 +290,21 @@
;; fold-files : (pathname sym alpha -> alpha) alpha pathname/#f -> alpha
(define (fold-files f init [path #f] [follow-links? #t])
(define-syntax-rule (discard-second-val e)
(call-with-values (λ () e) (λ (acc [extra #f]) acc)))
(define-syntax-rule (keep-fst e)
(call-with-values (lambda () e) (case-lambda [(v) v] [(v _) v])))
(define (do-path path acc)
(cond [(and (not follow-links?) (link-exists? path)) (discard-second-val (f path 'link acc))]
(cond [(and (not follow-links?) (link-exists? path))
(keep-fst (f path 'link acc))]
[(directory-exists? path)
(call-with-values (lambda () (f path 'dir acc))
(lambda (acc [descend? #t])
(if descend?
(do-paths (map (lambda (p) (build-path path p))
(sorted-dirlist path))
acc)
acc)))]
[(file-exists? path) (discard-second-val (f path 'file acc))]
[(link-exists? path) (discard-second-val (f path 'link acc))] ; dangling links
(lambda (acc [descend? #t])
(if descend?
(do-paths (map (lambda (p) (build-path path p))
(sorted-dirlist path))
acc)
acc)))]
[(file-exists? path) (keep-fst (f path 'file acc))]
[(link-exists? path) (keep-fst (f path 'link acc))] ; dangling links
[else (error 'fold-files "path disappeared: ~e" path)]))
(define (do-paths paths acc)
(cond [(null? paths) acc]