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

minor fixes

Browse Source 
svn: r16473
This commit is contained in:
Eli Barzilay 2009-10-30 10:48:38 +00:00
parent 52ac79406b
commit c049ccca3a
1 changed files with 28 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -475,40 +475,36 @@
void)))) void))))
(define in-port (define in-port
(let ([mk (lambda (p r) (case-lambda
(make-do-sequence [() (in-port (current-input-port) read)]
(lambda () [(r) (in-port (current-input-port) r)]
(values r values p void [(r p)
(lambda (x) (not (eof-object? x))) (unless (and (procedure? r) (procedure-arity-includes? r 1))
void))))]) (raise-type-error 'in-port "procedure (arity 1)" r))
(case-lambda (unless (input-port? p) (raise-type-error 'in-port "input-port" p))
[() (mk (current-input-port) read)] (make-do-sequence
[(r) (mk (current-input-port) r)] (lambda ()
[(r p) (values r values p void
(unless (and (procedure? r) (procedure-arity-includes? r 1)) (lambda (x) (not (eof-object? x)))
(raise-type-error 'in->port "procedure (arity 1)" r)) void)))]))
(unless (input-port? p) (raise-type-error 'in-port "input-port" p))
(mk p r)])))
(define in-lines (define in-lines
(let ([mk (lambda (p m) (case-lambda
(make-do-sequence [() (in-lines (current-input-port) 'any)]
(lambda () [(p) (in-lines p 'any)]
(values (lambda (p) (read-line p m)) [(p mode)
values p 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
(case-lambda 'in-lines
[() (in-lines (current-input-port) 'any)] "'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
[(p) (in-lines p 'any)] mode))
[(p mode) (make-do-sequence
(unless (input-port? p) (raise-type-error 'in-lines "input-port" p)) (lambda ()
(unless (memq mode '(linefeed return return-linefeed any any-one)) (values (lambda (p) (read-line p m))
(raise-type-error values p void
'in-lines (lambda (x) (not (eof-object? x)))
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one" void)))]))
mode))
(mk p mode)])))
(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))