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

io: reduce overhead on display and write-bytes

Browse Source
This commit is contained in:
Matthew Flatt 2019-02-13 16:18:22 -07:00
parent 17c46c9c36
commit ecf3766d96
3 changed files with 37 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
racket/src/io/port/bytes-output.rkt
View File

@ -16,7 +16,9 @@
write-bytes-avail*
write-bytes-avail/enable-break
write-bytes-avail-evt
port-writes-atomic?)
port-writes-atomic?
unsafe-write-bytes)
(module+ internal
(provide do-write-bytes))
@ -48,15 +50,29 @@
(define n (write-some-bytes who out bstr i end #:buffer-ok? #t))
(loop (fx+ n i))])))
(define/who (write-bytes bstr [out (current-output-port)] [start-pos 0] [end-pos (and (bytes? bstr)
(bytes-length bstr))])
(check who bytes? bstr)
(check who output-port? out)
(check who exact-nonnegative-integer? start-pos)
(check who exact-nonnegative-integer? end-pos)
(check-range who start-pos end-pos (bytes-length bstr) bstr)
(let ([out (->core-output-port out)])
(do-write-bytes who out bstr start-pos end-pos)))
(define/who write-bytes
(case-lambda
[(bstr)
(check who bytes? bstr)
(let ([out (->core-output-port (current-output-port))])
(do-write-bytes who out bstr 0 (bytes-length bstr)))]
[(bstr out)
(check who bytes? bstr)
(let ([out (->core-output-port out who)])
(do-write-bytes who out bstr 0 (bytes-length bstr)))]
[(bstr out start-pos)
(write-bytes bstr out start-pos (and (bytes? bstr) (bytes-length bstr)))]
[(bstr out start-pos end-pos)
(check who bytes? bstr)
(let ([out (->core-output-port out who)])
(check who exact-nonnegative-integer? start-pos)
(check who exact-nonnegative-integer? end-pos)
(check-range who start-pos end-pos (bytes-length bstr) bstr)
(do-write-bytes who out bstr start-pos end-pos))]))
;; `o` must be a core output port
(define (unsafe-write-bytes who bstr o)
(do-write-bytes who o bstr 0 (bytes-length bstr)))
(define (do-write-bytes-avail who bstr out start-pos end-pos
#:zero-ok? [zero-ok? #f]

3
racket/src/io/port/write.rkt
View File

@ -17,9 +17,9 @@
#:enable-break? [enable-break? #f])
(let try-again ([out out] [extra-count-outs null])
(start-atomic)
(check-not-closed who out)
(cond
[(fx= start end)
(check-not-closed who out)
(end-atomic)
0]
[else
@ -37,6 +37,7 @@
(end-atomic)
v]
[else
(check-not-closed who out)
(define write-out (method core-output-port out write-out))
(cond
[(procedure? write-out)

21
racket/src/io/print/main.rkt
View File

@ -52,8 +52,7 @@
install-do-global-print!))
(define/who (display v [o (current-output-port)])
(check who output-port? o)
(let ([co (->core-output-port o)])
(let ([co (->core-output-port o who)])
(define display-handler (core-output-port-display-handler co))
(if display-handler
(display-handler v o)
@ -63,7 +62,7 @@
(define (do-display who v o [max-length #f])
(cond
[(and (bytes? v) (not max-length))
(write-bytes v o)
(unsafe-write-bytes who v o)
(void)]
[(and (string? v) (not max-length))
(write-string v o)
@ -74,8 +73,7 @@
(void)]))
(define/who (write v [o (current-output-port)])
(check who output-port? o)
(let ([co (->core-output-port o)])
(let ([co (->core-output-port o who)])
(define write-handler (core-output-port-write-handler co))
(if write-handler
(write-handler v o)
@ -88,9 +86,8 @@
(void))
(define/who (print v [o (current-output-port)] [quote-depth PRINT-MODE/UNQUOTED])
(check who output-port? o)
(check who print-mode? #:contract "(or/c 0 1)" quote-depth)
(let ([co (->core-output-port o)])
(let ([co (->core-output-port o who)])
(check who print-mode? #:contract "(or/c 0 1)" quote-depth)
(define print-handler (core-output-port-print-handler co))
(if print-handler
(print-handler v o quote-depth)
@ -122,15 +119,15 @@
(global-print v o2 quote-depth)
(define bstr (get-output-bytes o2))
(if ((bytes-length bstr) . <= . max-length)
(write-bytes bstr o)
(unsafe-write-bytes who bstr o)
(begin
(write-bytes (subbytes bstr 0 (sub3 max-length)) o)
(write-bytes #"..." o)))])
(unsafe-write-bytes who (subbytes bstr 0 (sub3 max-length)) o)
(unsafe-write-bytes who #"..." o)))])
(void))))
(define/who (newline [o (current-output-port)])
(check who output-port? o)
(write-bytes #"\n" o)
(unsafe-write-bytes 'newline #"\n" o)
(void))
;; ----------------------------------------