1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00

Spead tweaks to Scheme peek-char

* module/ice-9/ports.scm: Speed tweaks to %peek-char.  Ultimately
  somewhat fruitless; I can get 1.4s instead of 1.5s by only
  half-inlining the UTF-8 case though.
This commit is contained in:
Andy Wingo 2016-05-04 12:40:27 +02:00
parent f5b9a53bd0
commit d7a111b0ec

View file

@ -243,7 +243,7 @@ interpret its input and output."
(lp buffered) (lp buffered)
(values buf buffered))))))))))))))) (values buf buffered)))))))))))))))
(define (peek-byte port) (define-inlinable (peek-byte port)
(let* ((buf (port-read-buffer port)) (let* ((buf (port-read-buffer port))
(cur (port-buffer-cur buf))) (cur (port-buffer-cur buf)))
(if (< cur (port-buffer-end buf)) (if (< cur (port-buffer-end buf))
@ -261,15 +261,12 @@ interpret its input and output."
(define-syntax-rule (decoding-error subr port) (define-syntax-rule (decoding-error subr port)
(throw 'decoding-error subr "input decoding error" EILSEQ port)) (throw 'decoding-error subr "input decoding error" EILSEQ port))
(define-inlinable (peek-char-and-len/utf8 port) (define-inlinable (peek-char-and-len/utf8 port first-byte)
(define (bad-utf8 len) (define (bad-utf8 len)
(if (eq? (port-conversion-strategy port) 'substitute) (if (eq? (port-conversion-strategy port) 'substitute)
(values #\? len) (values #\? len)
(decoding-error "peek-char" port))) (decoding-error "peek-char" port)))
(let ((first-byte (peek-byte port)))
(cond (cond
((eq? first-byte the-eof-object)
(values first-byte 0))
((< first-byte #x80) ((< first-byte #x80)
(values (integer->char first-byte) 1)) (values (integer->char first-byte) 1))
((<= #xc2 first-byte #xdf) ((<= #xc2 first-byte #xdf)
@ -331,15 +328,12 @@ interpret its input and output."
(logand (ref 3) #x3f))) (logand (ref 3) #x3f)))
4))))) 4)))))
(else (else
(bad-utf8 1))))) (bad-utf8 1))))
(define-inlinable (peek-char-and-len/iso-8859-1 port) (define-inlinable (peek-char-and-len/iso-8859-1 port first-byte)
(let ((byte-or-eof (peek-byte port))) (values (integer->char first-byte) 1))
(if (eof-object? byte-or-eof)
(values byte-or-eof 0)
(values (integer->char byte-or-eof) 1))))
(define (peek-char-and-len/iconv port) (define (peek-char-and-len/iconv port first-byte)
(define (bad-input len) (define (bad-input len)
(if (eq? (port-conversion-strategy port) 'substitute) (if (eq? (port-conversion-strategy port) 'substitute)
(values #\? len) (values #\? len)
@ -362,17 +356,23 @@ interpret its input and output."
(lp input-size)))))) (lp input-size))))))
(define-inlinable (peek-char-and-len port) (define-inlinable (peek-char-and-len port)
(let ((enc (%port-encoding port))) (let ((first-byte (peek-byte port)))
(if (eq? first-byte the-eof-object)
(values first-byte 0)
(let ((first-byte (logand first-byte #xff)))
(call-with-values (call-with-values
(lambda () (lambda ()
(case enc (case (%port-encoding port)
((UTF-8) (peek-char-and-len/utf8 port)) ((UTF-8)
((ISO-8859-1) (peek-char-and-len/iso-8859-1 port)) (peek-char-and-len/utf8 port first-byte))
(else (peek-char-and-len/iconv port)))) ((ISO-8859-1)
(peek-char-and-len/iso-8859-1 port first-byte))
(else
(peek-char-and-len/iconv port first-byte))))
(lambda (char len) (lambda (char len)
(if (port-maybe-consume-initial-byte-order-mark port char len) (if (port-maybe-consume-initial-byte-order-mark port char len)
(peek-char-and-len port) (peek-char-and-len port)
(values char len)))))) (values char len))))))))
(define (%peek-char port) (define (%peek-char port)
(call-with-values (lambda () (peek-char-and-len port)) (call-with-values (lambda () (peek-char-and-len port))