added error checking for the reader, some shuffling

svn: r16471
This commit is contained in:
Eli Barzilay 2009-10-30 08:24:57 +00:00
parent 55506e6ecf
commit 87a5092c82

View File

@ -33,7 +33,7 @@
(rename *in-bytes in-bytes) (rename *in-bytes in-bytes)
in-input-port-bytes in-input-port-bytes
in-input-port-chars in-input-port-chars
in-port in-port
in-lines in-lines
in-hash in-hash
in-hash-keys in-hash-keys
@ -486,32 +486,40 @@
void)))) void))))
(define in-lines (define in-lines
(case-lambda (let ([mk (lambda (p m)
[() (in-lines (current-input-port))] (make-do-sequence
[(v) (in-lines v 'any)] (lambda ()
[(v mode) (values (lambda (p) (read-line p m))
(unless (input-port? v) (raise-type-error 'in-lines "input-port" v)) values p void
(unless (memq mode '(linefeed return return-linefeed any any-one)) (lambda (x) (not (eof-object? x)))
(raise-type-error 'in-lines "('linefeed, 'return, 'return-linefeed, 'any, or 'any-one)" mode)) void))))])
(make-do-sequence (lambda () (case-lambda
(values (lambda (v) (read-line v mode)) [() (in-lines (current-input-port) 'any)]
values [(p) (in-lines p 'any)]
v [(p mode)
void (unless (input-port? p) (raise-type-error 'in-lines "input-port" p))
(lambda (x) (not (eof-object? x))) (unless (memq mode '(linefeed return return-linefeed any any-one))
void)))])) (raise-type-error
'in-lines
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
mode))
(mk p mode)])))
(define in-port (define in-port
(case-lambda (let ([mk (lambda (p r)
[() (in-port read (current-input-port))] (make-do-sequence
[(r) (in-port r (current-input-port))] (lambda ()
[(r p) (values r values p void
(unless (input-port? p) (raise-type-error 'in-port "input-port" p)) (lambda (x) (not (eof-object? x)))
(make-do-sequence void))))])
(lambda () (case-lambda
(values r values p void [() (mk (current-input-port) read)]
(lambda (x) (not (eof-object? x))) [(r) (mk (current-input-port) r)]
void)))])) [(r p)
(unless (and (procedure? r) (procedure-arity-includes? r 1))
(raise-type-error 'in->port "procedure (arity 1)" r))
(unless (input-port? p) (raise-type-error 'in-port "input-port" p))
(mk p r)])))
(define (in-hash ht) (define (in-hash ht)
(unless (hash? ht) (raise-type-error 'in-hash "hash" ht)) (unless (hash? ht) (raise-type-error 'in-hash "hash" ht))