From e0c3f151eb50fe615af6600062e7ae5a0966cff6 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Thu, 12 Nov 2009 11:29:35 -0800 Subject: [PATCH] Cache PORT/OPERATION/READ-CHAR in INPUT-PORT/READ-LINE and INPUT-PORT/READ-STRING. --- src/runtime/input.scm | 57 +++++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 27 deletions(-) diff --git a/src/runtime/input.scm b/src/runtime/input.scm index d45689614..c7bc8e7cd 100644 --- a/src/runtime/input.scm +++ b/src/runtime/input.scm @@ -53,41 +53,44 @@ USA. (define (input-port/read-line port) (port/with-input-blocking-mode port 'BLOCKING (lambda () - (let loop ((a (make-accum 128))) - (let ((char (input-port/read-char port))) - (cond ((eof-object? char) - (if (fix:> (accum-count a) 0) - (accum->string a) - char)) - ((char=? char #\newline) (accum->string a)) - (else (loop (accum char a))))))))) + (let ((read-char (port/operation/read-char port))) + (let loop ((a (make-accum 128))) + (let ((char (read-char port))) + (cond ((eof-object? char) + (if (fix:> (accum-count a) 0) + (accum->string a) + char)) + ((char=? char #\newline) (accum->string a)) + (else (loop (accum char a)))))))))) (define (input-port/read-string port delimiters) (port/with-input-blocking-mode port 'BLOCKING (lambda () - (let loop ((a (make-accum 128))) - (let ((char (input-port/read-char port))) - (cond ((eof-object? char) - (if (fix:> (accum-count a) 0) - (accum->string a) - char)) - ((char-set-member? delimiters char) - (input-port/unread-char port char) - (accum->string a)) - (else - (loop (accum char a))))))))) + (let ((read-char (port/operation/read-char port))) + (let loop ((a (make-accum 128))) + (let ((char (read-char port))) + (cond ((eof-object? char) + (if (fix:> (accum-count a) 0) + (accum->string a) + char)) + ((char-set-member? delimiters char) + (input-port/unread-char port char) + (accum->string a)) + (else + (loop (accum char a)))))))))) (define (input-port/discard-chars port delimiters) (port/with-input-blocking-mode port 'BLOCKING (lambda () - (let loop () - (let ((char (input-port/read-char port))) - (cond ((eof-object? char) - unspecific) - ((char-set-member? delimiters char) - (input-port/unread-char port char)) - (else - (loop)))))))) + (let ((read-char (port/operation/read-char port))) + (let loop () + (let ((char (read-char port))) + (cond ((eof-object? char) + unspecific) + ((char-set-member? delimiters char) + (input-port/unread-char port char)) + (else + (loop))))))))) (define-integrable (make-accum n) (cons (make-string n) 0)) -- 2.25.1