perf(encoding): bulk bytevector/string ops for whitespace strip and lossy decode
ober
214391daf765d2f6f3647a9c87ae729ce397116d
--- a/jerboa-mail/encoding.ss +++ b/jerboa-mail/encoding.ss @@ -40,23 +40,43 @@ (char=? ch #\return) (char=? ch #\newline))) + (define (ascii-whitespace-byte? b) + (or (= b 32) (= b 9) (= b 13) (= b 10))) + + ;; Strip ASCII whitespace at the byte level. The four whitespace code points + ;; are single-byte UTF-8 and never occur inside a multi-byte sequence, so + ;; filtering them leaves valid UTF-8 and utf8->string cannot raise. Bulk + ;; bytevector scans avoid per-char output-port cost at the 25 MB transfer cap. (define (strip-ascii-whitespace s) - (let ([out (open-output-string)]) - (let loop ([i 0]) - (when (< i (string-length s)) - (let ([ch (string-ref s i)]) - (unless (ascii-whitespace? ch) - (write-char ch out)) - (loop (+ i 1))))) - (get-output-string out))) + (let* ([bv (string->utf8 s)] + [n (bytevector-length bv)]) + (let count ([i 0] [j 0]) + (cond + [(>= i n) + (if (= j n) + s + (let ([out (make-bytevector j)]) + (let fill ([i 0] [k 0]) + (cond + [(>= k j) (utf8->string out)] + [else + (let ([b (bytevector-u8-ref bv i)]) + (if (ascii-whitespace-byte? b) + (fill (+ i 1) k) + (begin (bytevector-u8-set! out k b) + (fill (+ i 1) (+ k 1)))))]))))] + [else + (let ([b (bytevector-u8-ref bv i)]) + (count (+ i 1) (if (ascii-whitespace-byte? b) j (+ j 1))))])))) (define (u8vector->lossy-string bv) - (let ([out (open-output-string)]) + (let* ([n (bytevector-length bv)] + [out (make-string n)]) (let loop ([i 0]) (cond - [(>= i (bytevector-length bv)) (get-output-string out)] + [(>= i n) out] [else - (write-char (integer->char (bytevector-u8-ref bv i)) out) + (string-set! out i (integer->char (bytevector-u8-ref bv i))) (loop (+ i 1))])))) (define (u8vector->utf8-string bv)