io: reduce overhead on display and write-bytes

racket/src/io/port/bytes-output.rkt

@@ -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)
+(define/who write-bytes
-                                                                                      (bytes-length bstr))])
+  (case-lambda
-  (check who bytes? bstr)
+    [(bstr)
-  (check who output-port? out)
+     (check who bytes? bstr)
-  (check who exact-nonnegative-integer? start-pos)
+     (let ([out (->core-output-port (current-output-port))])
-  (check who exact-nonnegative-integer? end-pos)
+       (do-write-bytes who out bstr 0 (bytes-length bstr)))]
-  (check-range who start-pos end-pos (bytes-length bstr) bstr)
+    [(bstr out)
-  (let ([out (->core-output-port out)])
+     (check who bytes? bstr)
-    (do-write-bytes who out bstr start-pos end-pos)))
+     (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]

racket/src/io/port/write.rkt

@@ -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)

racket/src/io/print/main.rkt

@@ -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 who)])
-  (let ([co (->core-output-port o)])
     (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 who)])
-  (let ([co (->core-output-port o)])
     (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)
+  (let ([co (->core-output-port o who)])
-  (check who print-mode? #:contract "(or/c 0 1)" quote-depth)
+    (check who print-mode? #:contract "(or/c 0 1)" quote-depth)
-  (let ([co (->core-output-port o)])
     (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)
+                   (unsafe-write-bytes who (subbytes bstr 0 (sub3 max-length)) o)
-                   (write-bytes #"..." 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))
 
 ;; ----------------------------------------