cs: faster write-char on ASCII

This commit is contained in:
Matthew Flatt 2020-05-19 09:08:05 -06:00
parent 1655b6e2bb
commit b6c5515efa
2 changed files with 40 additions and 31 deletions

View File

@ -21,12 +21,15 @@
unsafe-write-bytes) unsafe-write-bytes)
(module+ internal (module+ internal
(provide do-write-bytes)) (provide do-write-byte
do-write-bytes))
(define/who (write-byte b [out (current-output-port)]) (define/who (write-byte b [out (current-output-port)])
(check who byte? b) (check who byte? b)
(check who output-port? out) (do-write-byte b (->core-output-port out who)))
(let ([out (->core-output-port out)])
;; `out` must be a core output port
(define (do-write-byte b out)
(start-atomic) (start-atomic)
(define buffer (core-port-buffer out)) (define buffer (core-port-buffer out))
(define pos (direct-pos buffer)) (define pos (direct-pos buffer))
@ -39,7 +42,7 @@
(end-atomic)] (end-atomic)]
[else [else
(end-atomic) (end-atomic)
(write-some-bytes 'write-byte out (bytes b) 0 1 #:buffer-ok? #t #:copy-bstr? #f)])) (write-some-bytes 'write-byte out (bytes b) 0 1 #:buffer-ok? #t #:copy-bstr? #f)])
(void)) (void))
(define (do-write-bytes who out bstr start end) (define (do-write-bytes who out bstr start end)

View File

@ -10,18 +10,24 @@
(define/who (write-char ch [out (current-output-port)]) (define/who (write-char ch [out (current-output-port)])
(check who char? ch) (check who char? ch)
(check who output-port? out) (let ([out (->core-output-port out who)])
(write-string (string ch) out 0 1) (define v (char->integer ch))
(if (v . < . 128)
(do-write-byte v out)
(do-write-string who (string ch) out 0 1)))
(void)) (void))
(define/who (write-string str [out (current-output-port)] [start 0] [end (and (string? str) (define/who (write-string str [out (current-output-port)] [start 0] [end (and (string? str)
(string-length str))]) (string-length str))])
(check who string? str) (check who string? str)
(check who output-port? out) (let ([out (->core-output-port out who)])
(check who exact-nonnegative-integer? start) (check who exact-nonnegative-integer? start)
(check who exact-nonnegative-integer? end) (check who exact-nonnegative-integer? end)
(check-range who start end (string-length str) str) (check-range who start end (string-length str) str)
(let ([out (->core-output-port out)]) (do-write-string who str out start end)))
;; `out` must be a core output port
(define (do-write-string who str out start end)
(let loop ([i start]) (let loop ([i start])
(cond (cond
[(= i end) (- i start)] [(= i end) (- i start)]
@ -29,4 +35,4 @@
(define next-i (min end (+ i 4096))) (define next-i (min end (+ i 4096)))
(define bstr (string->bytes/utf-8 str 0 i next-i)) (define bstr (string->bytes/utf-8 str 0 i next-i))
(do-write-bytes who out bstr 0 (bytes-length bstr)) (do-write-bytes who out bstr 0 (bytes-length bstr))
(loop next-i)])))) (loop next-i)])))