Redo in-port' and in-lines' using `in-producer', since this gives us a

faster macro version for the loops.

svn: r16474
This commit is contained in:
Eli Barzilay 2009-10-30 11:10:05 +00:00
parent c049ccca3a
commit 4f002bb7bb

View File

@ -33,8 +33,8 @@
(rename *in-bytes in-bytes)
in-input-port-bytes
in-input-port-chars
in-port
in-lines
(rename *in-port in-port)
(rename *in-lines in-lines)
in-hash
in-hash-keys
in-hash-values
@ -482,11 +482,7 @@
(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))
(make-do-sequence
(lambda ()
(values r values p void
(lambda (x) (not (eof-object? x)))
void)))]))
(in-producer (lambda () (r p)) eof)]))
(define in-lines
(case-lambda
@ -499,12 +495,7 @@
'in-lines
"'linefeed, 'return, 'return-linefeed, 'any, or 'any-one"
mode))
(make-do-sequence
(lambda ()
(values (lambda (p) (read-line p m))
values p void
(lambda (x) (not (eof-object? x)))
void)))]))
(in-producer (lambda () (read-line p mode)) eof)]))
(define (in-hash ht)
(unless (hash? ht) (raise-type-error 'in-hash "hash" ht))
@ -1231,4 +1222,44 @@
;; loop args
())])])))
;; Some iterators that are implemented using `*in-producer' (note: do not use
;; `in-producer', since in this module it is the procedure version).
(define-sequence-syntax *in-port
(lambda () #'in-port)
(lambda (stx)
(syntax-case stx ()
[[(id) (_)] #'[(id) (*in-port read (current-input-port))]]
[[(id) (_ r)] #'[(id) (*in-port r (current-input-port))]]
[[(id) (_ r p)]
#'[(id) (*in-producer
(let ([r* r] [p* 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*))
(lambda () (r* p*)))
eof)]])))
(define-sequence-syntax *in-lines
(lambda () #'in-lines)
(lambda (stx)
(syntax-case stx ()
[[(id) (_)] #'[(id) (*in-lines (current-input-port) 'any)]]
[[(id) (_ p)] #'[(id) (*in-lines p 'any)]]
[[(id) (_ p mode)]
#'[(id) (*in-producer
(let ([p* p] [mode* 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*))
(lambda () (read-line p* mode*)))
eof)]])))
)