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