conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

made read-char just as efficient as get-char by copy&paste.

This commit is contained in:
Abdulaziz Ghuloum 2007-12-15 11:43:04 -05:00
parent 372c3e369b
commit 64c20409ce
2 changed files with 44 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
scheme/ikarus.io.ss
View File

@ -623,7 +623,7 @@
;(define-rrr set-port-position!) ;(define-rrr set-port-position!)
;;; ---------------------------------------------------------- ;;; ----------------------------------------------------------
(module (get-char lookahead-char) (module (read-char get-char lookahead-char)
(import UNSAFE) (import UNSAFE)
(define (refill-bv-start p who) (define (refill-bv-start p who)
(when ($port-closed? p) (die who "port is closed" p)) (when ($port-closed? p) (die who "port is closed" p))
@ -855,7 +855,7 @@
(do-error p who)] (do-error p who)]
[else (lookahead-char-utf8-mode p who)]))])] [else (lookahead-char-utf8-mode p who)]))])]
[else (do-error p who)]))]))) [else (do-error p who)]))])))
;;;
(define (advance-bom p who bom-seq) (define (advance-bom p who bom-seq)
;;; return eof if port is eof, ;;; return eof if port is eof,
;;; #t if a bom is present, updating the port index to ;;; #t if a bom is present, updating the port index to
@ -886,7 +886,7 @@
(if (fx= bytes 0) (if (fx= bytes 0)
(eof-object) (eof-object)
(advance-bom p who bom-seq)))])) (advance-bom p who bom-seq)))]))
;;;
(define (speedup-input-port p who) (define (speedup-input-port p who)
;;; returns #t if port is eof, #f otherwise ;;; returns #t if port is eof, #f otherwise
(unless (input-port? p) (unless (input-port? p)
@ -901,7 +901,7 @@
(fxior textual-input-port-bits fast-u7-text-tag)) (fxior textual-input-port-bits fast-u7-text-tag))
(eof-object? (advance-bom p who '(#xEF #xBB #xBF)))] (eof-object? (advance-bom p who '(#xEF #xBB #xBF)))]
[else (die 'slow-get-char "codec not handled")]))) [else (die 'slow-get-char "codec not handled")])))
;;;
(define (lookahead-char-char-mode p who) (define (lookahead-char-char-mode p who)
(let ([str ($port-buffer p)] (let ([str ($port-buffer p)]
[read! ($port-read! p)]) [read! ($port-read! p)])
@ -968,7 +968,45 @@
[else [else
($set-port-index! p 1) ($set-port-index! p 1)
(string-ref str 0)])))) (string-ref str 0)]))))
(define read-char
(case-lambda
[(p)
(define who 'read-char)
(let ([m ($port-fast-attrs p)])
(cond
[(eq? m fast-get-utf8-tag)
(let ([i ($port-index p)])
(cond
[(fx< i ($port-size p))
(let ([b (bytevector-u8-ref ($port-buffer p) i)])
(cond
[(fx< b 128)
($set-port-index! p (fx+ i 1))
(integer->char b)]
[else (get-char-utf8-mode p who)]))]
[else
(get-char-utf8-mode p who)]))]
[(eq? m fast-get-char-tag)
(let ([i ($port-index p)])
(cond
[(fx< i ($port-size p))
($set-port-index! p (fx+ i 1))
(string-ref ($port-buffer p) i)]
[else (get-char-char-mode p who)]))]
[(eq? m fast-get-latin-tag)
(let ([i ($port-index p)])
(cond
[(fx< i ($port-size p))
($set-port-index! p (fx+ i 1))
(integer->char
(bytevector-u8-ref ($port-buffer p) i))]
[else
(get-char-latin-mode p who 1)]))]
[else
(if (speedup-input-port p who)
(eof-object)
(get-char p))]))]
[() (read-char (current-input-port))]))
(define (get-char p) (define (get-char p)
(define who 'get-char) (define who 'get-char)
(let ([m ($port-fast-attrs p)]) (let ([m ($port-fast-attrs p)])
@ -1344,15 +1382,6 @@
(die 'call-with-port "not a procedure" proc)) (die 'call-with-port "not a procedure" proc))
(die 'call-with-port "not a port" p))) (die 'call-with-port "not a port" p)))
(define read-char
(case-lambda
[() (get-char (*the-input-port*))]
[(p)
(if (input-port? p)
(if (textual-port? p)
(get-char p)
(die 'read-char "not a textual port" p))
(die 'read-char "not an input-port" p))]))
;;; ;;;
(define peek-char (define peek-char
(case-lambda (case-lambda

2
scheme/last-revision
View File

@ -1 +1 @@
1250 1251