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