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

io: reduce overhead on read-byte and read-char

Browse Source
This commit is contained in:
Matthew Flatt 2019-02-03 13:24:09 -07:00
parent 5ffb96e62d
commit 9823cbba4d
6 changed files with 52 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
racket/src/io/port/bytes-input.rkt
View File

@ -49,8 +49,7 @@
;; ----------------------------------------
(define/who (read-byte [orig-in (current-input-port)])
(check who input-port? orig-in)
(let ([in (->core-input-port orig-in)])
(let ([in (->core-input-port orig-in who)])
(do-read-byte/core-port who in)))
(define (do-read-byte/core-port who in)

16
racket/src/io/port/input-port.rkt
View File

@ -34,22 +34,18 @@
;; This function should not be called in atomic mode,
;; since it can invoke an artitrary function
(define (->core-input-port v)
(define (->core-input-port v [who #f])
(cond
[(core-input-port? v) (if (impersonator? v)
;; If there's an impersonator, it's only
;; an evt impersonator
(unsafe-strip-impersonator v)
v)]
[(input-port? v)
(let ([p (input-port-ref v)])
[(core-input-port? v) v]
[(input-port-ref v #f)
=> (lambda (p)
(cond
[(struct-accessor-procedure? p)
(->core-input-port (p v))]
[else
(->core-input-port p)]))]
[else
empty-input-port]))
[who (raise-argument-error who "input-port?" v)]
[else empty-input-port]))
(struct core-input-port core-port
(

16
racket/src/io/port/output-port.rkt
View File

@ -34,22 +34,18 @@
;; This function should not be called in atomic mode,
;; since it can invoke an arbitrary function
(define (->core-output-port v)
(define (->core-output-port v [who #f])
(cond
[(core-output-port? v) (if (impersonator? v)
;; If there's an impersonator, it's only
;; an evt impersonator
(unsafe-strip-impersonator v)
v)]
[(output-port? v)
(let ([p (output-port-ref v)])
[(core-output-port? v) v]
[(output-port-ref v #f)
=> (lambda (p)
(cond
[(struct-accessor-procedure? p)
(->core-output-port (p v))]
[else
(->core-output-port p)]))]
[else
empty-output-port]))
[who (raise-argument-error who "output-port?" v)]
[else empty-output-port]))
(struct core-output-port core-port
(

6
racket/src/io/port/special-input.rkt
View File

@ -52,11 +52,11 @@
(define/who (read-char-or-special [in (current-input-port)]
[special-wrap #f]
[source-name #f])
(check who input-port? in)
(let ([in (->core-input-port in who)])
(check who #:or-false (procedure-arity-includes/c 1) special-wrap)
(extract-special-value (do-read-char who in #:special-ok? #t)
(extract-special-value (do-read-char/core-port who in #:special-ok? #t)
in source-name -1
special-wrap))
special-wrap)))
(define/who (peek-char-or-special [in (current-input-port)]
[skip-k 0]

29
racket/src/io/port/string-input.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require "../common/check.rkt"
(require racket/fixnum
"../common/check.rkt"
"../host/thread.rkt"
"parameter.rkt"
"read-and-peek.rkt"
@ -20,7 +21,6 @@
peek-string
peek-string!
do-read-char
do-read-char/core-port
do-peek-char)
@ -219,7 +219,7 @@
[(eof-object? b) b]
[else
(cond
[(b . < . 128) (integer->char b)]
[(b . fx< . 128) (integer->char b)]
[else
;; UTF-8 decoding... May need to peek bytes to discover
;; whether the decoding will work (in which case this wasn't
@ -251,24 +251,23 @@
#:error-char #\uFFFD
#:abort-mode 'state))
(cond
[(= got-chars 1)
(define actually-used-bytes (+ skip-k used-bytes))
(unless (zero? actually-used-bytes)
(define finish-bstr (if (actually-used-bytes . <= . (bytes-length bstr))
[(fx= got-chars 1)
(define actually-used-bytes (fx+ skip-k used-bytes))
(cond
[(fx= actually-used-bytes 0) (void)]
[(fx= actually-used-bytes 1) (do-read-byte who read-byte in)]
[else
(define finish-bstr (if (actually-used-bytes . fx<= . (bytes-length bstr))
bstr
(make-bytes actually-used-bytes)))
(do-read-bytes! who in finish-bstr 0 actually-used-bytes))
(do-read-bytes! who in finish-bstr 0 actually-used-bytes)])
(string-ref str 0)]
[else
(loop (add1 skip-k) new-state)])]))])])]))
(loop (fx+ skip-k 1) new-state)])]))])])]))
;; ----------------------------------------
;; If `special-ok?`, can return a special-value procedure
(define (do-read-char who in #:special-ok? [special-ok? #f])
(let ([in (->core-input-port in)])
(do-read-char/core-port who in #:special-ok? special-ok?)))
(define (do-read-char/core-port who in #:special-ok? [special-ok? #f])
(define read-byte (core-input-port-read-byte in))
(cond
@ -283,8 +282,8 @@
(read-char-via-read-byte who in read-byte #:special-ok? special-ok?)]))
(define/who (read-char [in (current-input-port)])
(check who input-port? in)
(do-read-char who in))
(let ([in (->core-input-port in who)])
(do-read-char/core-port who in)))
(define/who (read-string amt [in (current-input-port)])
(check who exact-nonnegative-integer? amt)

16
racket/src/io/string/utf-8-decode.rkt
View File

@ -138,26 +138,26 @@
(encoding-failure)]
[else
(define next (fxand b #b00111111))
(define next-accum (bitwise-ior (arithmetic-shift accum 6) next))
(define next-accum (fxior (fxlshift accum 6) next))
(cond
[(= 1 remaining)
[(fx= 1 remaining)
(cond
[(and (next-accum . > . 127)
(next-accum . <= . #x10FFFF)
(not (and (next-accum . >= . #xD800)
(next-accum . <= . #xDFFF))))
[(and (next-accum . fx> . 127)
(next-accum . fx<= . #x10FFFF)
(not (and (next-accum . fx>= . #xD800)
(next-accum . fx<= . #xDFFF))))
(when out-str (string-set! out-str j (integer->char next-accum)))
(continue)]
[else
;; Not a valid character
(encoding-failure)])]
[(and (fx= 2 remaining)
(next-accum . <= . #b11111))
(next-accum . fx<= . #b11111))
;; A shorter byte sequence would work, so this is an
;; encoding mistae.
(encoding-failure)]
[(and (fx= 3 remaining)
(next-accum . <= . #b1111))
(next-accum . fx<= . #b1111))
;; A shorter byte sequence would work
(encoding-failure)]
[else