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

move checking code out of macro expansion

Browse Source
This commit is contained in:
Matthew Flatt 2011-07-07 05:54:56 -06:00
parent 62a17da060
commit e783d84268
1 changed files with 29 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
collects/racket/private/for.rkt
View File

@ -570,40 +570,49 @@
(raise-type-error 'in-input-port-chars "input-port" p)) (raise-type-error 'in-input-port-chars "input-port" p))
(in-producer (lambda () (read-char p)) eof)) (in-producer (lambda () (read-char p)) eof))
(define (check-in-port 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)))
(define in-port (define in-port
(case-lambda (case-lambda
[() (in-port read (current-input-port))] [() (in-port read (current-input-port))]
[(r) (in-port r (current-input-port))] [(r) (in-port r (current-input-port))]
[(r p) [(r p)
(unless (and (procedure? r) (procedure-arity-includes? r 1)) (check-in-port r p)
(raise-type-error 'in-port "procedure (arity 1)" r))
(unless (input-port? p) (raise-type-error 'in-port "input-port" p))
(in-producer (lambda () (r p)) eof)])) (in-producer (lambda () (r p)) eof)]))
(define (check-in-lines p mode)
(unless (input-port? p) (raise-type-error 'in-lines "input-port" p))
(unless (memq mode '(linefeed return return-linefeed any any-one))
(raise-type-error
'in-lines
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
mode)))
(define in-lines (define in-lines
(case-lambda (case-lambda
[() (in-lines (current-input-port) 'any)] [() (in-lines (current-input-port) 'any)]
[(p) (in-lines p 'any)] [(p) (in-lines p 'any)]
[(p mode) [(p mode)
(unless (input-port? p) (raise-type-error 'in-lines "input-port" p)) (check-in-lines p mode)
(unless (memq mode '(linefeed return return-linefeed any any-one))
(raise-type-error
'in-lines
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
mode))
(in-producer (lambda () (read-line p mode)) eof)])) (in-producer (lambda () (read-line p mode)) eof)]))
(define (check-in-bytes-lines p mode)
(unless (input-port? p) (raise-type-error 'in-bytes-lines "input-port" p))
(unless (memq mode '(linefeed return return-linefeed any any-one))
(raise-type-error
'in-bytes-lines
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
mode)))
(define in-bytes-lines (define in-bytes-lines
(case-lambda (case-lambda
[() (in-bytes-lines (current-input-port) 'any)] [() (in-bytes-lines (current-input-port) 'any)]
[(p) (in-bytes-lines p 'any)] [(p) (in-bytes-lines p 'any)]
[(p mode) [(p mode)
(unless (input-port? p) (raise-type-error 'in-bytes-lines "input-port" p)) (check-in-bytes-lines p mode)
(unless (memq mode '(linefeed return return-linefeed any any-one))
(raise-type-error
'in-bytes-lines
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
mode))
(in-producer (lambda () (read-bytes-line p mode)) eof)])) (in-producer (lambda () (read-bytes-line p mode)) eof)]))
(define (in-hash ht) (define (in-hash ht)
@ -1715,11 +1724,7 @@
[[(id) (_ r p)] [[(id) (_ r p)]
#'[(id) (*in-producer #'[(id) (*in-producer
(let ([r* r] [p* p]) (let ([r* r] [p* p])
(unless (and (procedure? r*) (check-in-port r* p*)
(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*))
(lambda () (r* p*))) (lambda () (r* p*)))
eof)]]))) eof)]])))
@ -1732,14 +1737,7 @@
[[(id) (_ p mode)] [[(id) (_ p mode)]
#'[(id) (*in-producer #'[(id) (*in-producer
(let ([p* p] [mode* mode]) (let ([p* p] [mode* mode])
(unless (input-port? p*) (check-in-lines p* mode*)
(raise-type-error 'in-lines "input-port" p*))
(unless (memq mode* '(linefeed return return-linefeed any
any-one))
(raise-type-error
'in-lines
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
mode*))
(lambda () (read-line p* mode*))) (lambda () (read-line p* mode*)))
eof)]]))) eof)]])))
@ -1752,14 +1750,7 @@
[[(id) (_ p mode)] [[(id) (_ p mode)]
#'[(id) (*in-producer #'[(id) (*in-producer
(let ([p* p] [mode* mode]) (let ([p* p] [mode* mode])
(unless (input-port? p*) (check-in-bytes-lines p* mode*)
(raise-type-error 'in-bytes-lines "input-port" p*))
(unless (memq mode* '(linefeed return return-linefeed any
any-one))
(raise-type-error
'in-bytes-lines
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
mode*))
(lambda () (read-bytes-line p* mode*))) (lambda () (read-bytes-line p* mode*)))
eof)]]))) eof)]])))
@ -1770,8 +1761,7 @@
[[(id) (_ p)] [[(id) (_ p)]
#'[(id) (*in-producer #'[(id) (*in-producer
(let ([p* p]) (let ([p* p])
(unless (input-port? p*) (unless (input-port? p*) (in-input-port-bytes p*))
(raise-type-error 'in-input-port-bytes "input-port" p*))
(lambda () (read-byte p*))) (lambda () (read-byte p*)))
eof)]]))) eof)]])))
@ -1782,8 +1772,7 @@
[[(id) (_ p)] [[(id) (_ p)]
#'[(id) (*in-producer #'[(id) (*in-producer
(let ([p* p]) (let ([p* p])
(unless (input-port? p*) (unless (input-port? p*) (in-input-port-chars p*))
(raise-type-error 'in-input-port-chars "input-port" p*))
(lambda () (read-char p*))) (lambda () (read-char p*)))
eof)]]))) eof)]])))