From 653d0ccd66028cf5a855d089d11305891a157577 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 29 Oct 2009 18:49:34 +0000 Subject: [PATCH] Add `in-port', `port->list', `file->list'. Add documentation, tests for above. Allow procedure argument to `fold-files' to return 2 values in all cases. Document, test. svn: r16453 --- collects/scheme/file.ss | 35 ++++++++++++------- collects/scheme/port.ss | 9 +++++ collects/scheme/private/for.ss | 15 +++++++- .../scribblings/reference/filesystem.scrbl | 11 +++--- collects/scribblings/reference/port-lib.scrbl | 5 +++ .../scribblings/reference/sequences.scrbl | 20 +++++++---- collects/tests/mzscheme/filelib.ss | 18 ++++++++++ collects/tests/mzscheme/for.ss | 4 +++ collects/tests/mzscheme/portlib.ss | 3 ++ 9 files changed, 94 insertions(+), 26 deletions(-) diff --git a/collects/scheme/file.ss b/collects/scheme/file.ss index e91d036715..5a8a2d94d9 100644 --- a/collects/scheme/file.ss +++ b/collects/scheme/file.ss @@ -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) diff --git a/collects/scheme/port.ss b/collects/scheme/port.ss index 016bb03529..7e5e9b4276 100644 --- a/collects/scheme/port.ss +++ b/collects/scheme/port.ss @@ -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)) diff --git a/collects/scheme/private/for.ss b/collects/scheme/private/for.ss index 7052024de4..2759149aac 100644 --- a/collects/scheme/private/for.ss +++ b/collects/scheme/private/for.ss @@ -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)))) diff --git a/collects/scribblings/reference/filesystem.scrbl b/collects/scribblings/reference/filesystem.scrbl index 329eb609de..240ece9b6d 100644 --- a/collects/scribblings/reference/filesystem.scrbl +++ b/collects/scribblings/reference/filesystem.scrbl @@ -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.} diff --git a/collects/scribblings/reference/port-lib.scrbl b/collects/scribblings/reference/port-lib.scrbl index 88f3eb64f5..76113cafb2 100644 --- a/collects/scribblings/reference/port-lib.scrbl +++ b/collects/scribblings/reference/port-lib.scrbl @@ -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.} diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index befc9269cc..6117644025 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -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]. diff --git a/collects/tests/mzscheme/filelib.ss b/collects/tests/mzscheme/filelib.ss index f1f66cdb2d..c266201cc9 100644 --- a/collects/tests/mzscheme/filelib.ss +++ b/collects/tests/mzscheme/filelib.ss @@ -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)) diff --git a/collects/tests/mzscheme/for.ss b/collects/tests/mzscheme/for.ss index dbb5b4973f..76de87feb0 100644 --- a/collects/tests/mzscheme/for.ss +++ b/collects/tests/mzscheme/for.ss @@ -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) '())) diff --git a/collects/tests/mzscheme/portlib.ss b/collects/tests/mzscheme/portlib.ss index 312d725a7d..75f1066022 100644 --- a/collects/tests/mzscheme/portlib.ss +++ b/collects/tests/mzscheme/portlib.ss @@ -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))