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

Add in-port', port->list', `file->list'.

Browse Source 
Add documentation, tests for above.
Allow procedure argument to `fold-files' to return 2 values in all cases.
Document, test.

svn: r16453
This commit is contained in:
Sam Tobin-Hochstadt 2009-10-29 18:49:34 +00:00
parent 4bad2f34c1
commit 653d0ccd66
9 changed files with 94 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/scheme/file.ss
View File

@ -12,6 +12,7 @@
find-files
pathlist-closure
file->list
file->string
file->bytes
file->value
@ -21,7 +22,7 @@
write-to-file
display-lines-to-file)
(require "private/portlines.ss")
(require "private/portlines.ss" "port.ss")
;; utility: sorted dirlist so functions are deterministic
(define (sorted-dirlist [dir (current-directory)])
@ -289,21 +290,20 @@
;; 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 (do-path path acc)
(cond [(and (not follow-links?) (link-exists? path)) (f path 'link acc)]
(cond [(and (not follow-links?) (link-exists? path)) (discard-second-val (f path 'link acc))]
[(directory-exists? path)
(call-with-values (lambda () (f path 'dir acc))
(letrec ([descend
(case-lambda
[(acc)
(do-paths (map (lambda (p) (build-path path p))
(sorted-dirlist path))
acc)]
[(acc descend?)
(if descend? (descend acc) acc)])])
descend))]
[(file-exists? path) (f path 'file acc)]
[(link-exists? path) (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) (discard-second-val (f path 'file acc))]
[(link-exists? path) (discard-second-val (f path 'link acc))] ; dangling links
[else (error 'fold-files "path disappeared: ~e" path)]))
(define (do-paths paths acc)
(cond [(null? paths) acc]
@ -388,6 +388,15 @@
#:mode file-mode
read)))
(define (file->list f [r read] #:mode [file-mode 'binary])
(check-path 'file->list f)
(check-file-mode 'file->list file-mode)
(let ([sz (file-size f)])
(call-with-input-file*
f
#:mode file-mode
(lambda (p) (port->list r p)))))
(define (file->x-lines who f line-mode file-mode read-line)
(check-path who f)
(check-mode who line-mode)

9
collects/scheme/port.ss
View File

@ -8,6 +8,7 @@
port->bytes
port->lines
port->bytes-lines
port->list
display-lines
with-output-to-string
@ -39,6 +40,14 @@
(define (port->bytes-lines [p (current-input-port)] #:line-mode [mode 'any])
(port->x-lines 'port->bytes-lines p mode read-bytes-line))
(define (port->list [r read] [p (current-input-port)])
(unless (input-port? p)
(raise-type-error 'port->list "input-port" p))
(unless (and (procedure? r)
(procedure-arity-includes? r 1))
(raise-type-error 'port->list "procedure (arity 1)" r))
(for/list ([v (in-port r p)]) v))
(define (display-lines l [p (current-output-port)] #:separator [newline #"\n"])
(unless (list? l)
(raise-type-error 'display-lines "list" l))

15
collects/scheme/private/for.ss
View File

@ -33,6 +33,7 @@
(rename *in-bytes in-bytes)
in-input-port-bytes
in-input-port-chars
in-port
in-lines
in-hash
in-hash-keys
@ -491,7 +492,7 @@
[(v mode)
(unless (input-port? v) (raise-type-error 'in-lines "input-port" v))
(unless (memq mode '(linefeed return return-linefeed any any-one))
(raise-type-error 'in-lines "'linefeed, 'return, 'return-linefeed, 'any, or 'any-one)" mode))
(raise-type-error 'in-lines "('linefeed, 'return, 'return-linefeed, 'any, or 'any-one)" mode))
(make-do-sequence (lambda ()
(values (lambda (v) (read-line v mode))
values
@ -500,6 +501,18 @@
(lambda (x) (not (eof-object? x)))
void)))]))
(define in-port
(case-lambda
[() (in-port read (current-input-port))]
[(r) (in-port r (current-input-port))]
[(r p)
(unless (input-port? p) (raise-type-error 'in-port "input-port" p))
(make-do-sequence
(lambda ()
(values r values p void
(lambda (x) (not (eof-object? x)))
void)))]))
(define (in-hash ht)
(unless (hash? ht) (raise-type-error 'in-hash "hash" ht))
(make-do-sequence (lambda () (:hash-key+val-gen ht))))

11
collects/scribblings/reference/filesystem.scrbl
View File

@ -724,11 +724,10 @@ directory, returns a list such that
]}
@defproc[(fold-files [proc (and/c (path? (or/c 'file 'dir 'link) any/c
@defproc[(fold-files [proc (or/c (path? (or/c 'file 'dir 'link) any/c
. -> . any/c)
(or/c procedure?
((path? 'dir any/c)
. -> . (values any/c any/c))))]
(path? (or/c 'file 'dir 'link) any/c
. -> . (values any/c any/c)))]
[init-val any/c]
[start-path (or/c path-string? #f) #f]
[follow-links? any/c #t])
@ -777,7 +776,9 @@ new accumulated result. There is an exception for the case of a
directory (when the second argument is @scheme['dir]): in this case
the procedure may return two values, the second indicating whether the
recursive scan should include the given directory or not. If it
returns a single value, the directory is scanned.
returns a single value, the directory is scanned. In the cases of
files or links (when the second argument is @scheme['file] or
@scheme['link]), a second value is permitted but ignored.
If the @scheme[start-path] is provided but no such path exists, or if
paths disappear during the scan, then an exception is raised.}

5
collects/scribblings/reference/port-lib.scrbl
View File

@ -10,6 +10,11 @@
@section{Port String and List Conversions}
@defproc[(port->list [r (input-port? . -> . any/c) read] [in input-port? (current-input-port)])
(listof any/c)]{
Returns a list whose elements are produced by calling @scheme[r]
on @scheme[in] until it produces @scheme[eof].}
@defproc[(port->string [in input-port? (current-input-port)]) string?]{
Reads all characters from @scheme[in] and returns them as a string.}

20
collects/scribblings/reference/sequences.scrbl
View File

@ -152,21 +152,27 @@ The optional arguments @scheme[start], @scheme[stop], and
@speed[in-bytes "byte string"]}
@defproc[(in-port [r (input-port? . -> . any/c) read]
[in input-port? (current-input-port)])
sequence?]{
Returns a sequence whose elements are produced by calling @scheme[r]
on @scheme[in] until it produces @scheme[eof].}
@defproc[(in-input-port-bytes [in input-port?]) sequence?]{
Returns a sequence equivalent to @scheme[in].}
Returns a sequence equivalent to @scheme[(in-port read-byte in)].}
@defproc[(in-input-port-chars [in input-port?]) sequence?]{ Returns a
sequence whose elements are read as characters form @scheme[in] (as
opposed to using @scheme[in] directly as a sequence to get bytes).}
sequence whose elements are read as characters form @scheme[in]
(equivalent to @scheme[(in-port read-char in)]).}
@defproc[(in-lines [in input-port? (current-input-port)]
[mode (or/c 'linefeed 'return 'return-linefeed 'any 'any-one) 'any])
sequence?]{
Returns a sequence whose elements are the result of @scheme[(read-line
in mode)] until an end-of-file is encountered. Note that the default
mode is @scheme['any], whereas the default mode of @scheme[read-line]
is @scheme['linefeed].}
Returns a sequence equivalent to @scheme[(in-port (lambda (p)
(read-line p mode)) in)]. Note that the default mode is @scheme['any],
whereas the default mode of @scheme[read-line] is
@scheme['linefeed]. }
@defproc[(in-hash [hash hash?]) sequence?]{
Returns a sequence equivalent to @scheme[hash].

18
collects/tests/mzscheme/filelib.ss
View File

@ -10,6 +10,9 @@
(define tmp-name "tmp0-filelib")
(when (file-exists? tmp-name) (delete-file tmp-name))
(display-lines-to-file '("a" "b" "c") tmp-name #:separator #"\r\n" #:mode 'binary)
(test '(a b c) file->list tmp-name)
(test '("a\r" "b\r" "c\r") file->list tmp-name read-line)
(test '("a" "b" "c") file->list tmp-name (lambda (p) (read-line p 'any)))
(test "a\r\nb\r\nc\r\n" file->string tmp-name #:mode 'binary)
(test #"a\r\nb\r\nc\r\n" file->bytes tmp-name)
(test '("a" "b" "c") file->lines tmp-name)
@ -96,6 +99,21 @@
#f
#f)
(test (+ 2 (length rel2))
fold-files
(lambda (name kind accum)
(test kind values (cond
[(link-exists? name) 'link]
[(file-exists? name) 'file]
[(directory-exists? name) 'dir]
[else '???]))
(when (member name '("filelib-link.ss" "loop-link"))
(test kind name 'link))
(values (add1 accum) #t))
0
#f
#f)
(system "rm loop-link")
(test (+ 1 (length rel2))

4
collects/tests/mzscheme/for.ss
View File

@ -131,6 +131,10 @@
(test-generator [(65 66 67)] (open-input-bytes #"ABC"))
(test-generator [(65 66 67)] (in-input-port-bytes (open-input-bytes #"ABC")))
(test-generator [(1 2 3)] (in-port read (open-input-string "1 2 3")))
(test-generator [(123)] (in-port read (open-input-string "123")))
(test-generator [(65 66 67)] (in-port read-bytes (open-input-bytes "ABC")))
(test-generator [(0 1 2 3 4 5)] (in-sequences (in-range 6)))
(test-generator [(0 1 2 3 4 5)] (in-sequences (in-range 4) '(4 5)))
(test-generator [(0 1 2 3 4 5)] (in-sequences (in-range 6) '()))

3
collects/tests/mzscheme/portlib.ss
View File

@ -10,6 +10,9 @@
;; ----------------------------------------
(let* ([p (lambda () (open-input-string "hello\r\nthere"))])
(test '(hello there) port->list read (p))
(test '(#\h #\e #\l #\l #\o #\return #\newline #\t #\h #\e #\r #\e)
port->list read-char (p))
(test "hello\r\nthere" port->string (p))
(test #"hello\r\nthere" port->bytes (p))
(test '("hello" "there") port->lines (p))