io.encodings: speed up ascii and utf8 stream-read-until.

db4
John Benediktsson 2013-03-18 13:35:22 -07:00
parent f936a1dc65
commit 67a2b9dc9a
5 changed files with 31 additions and 19 deletions

View File

@ -117,9 +117,9 @@ set-specializer
\ split, { string string } set-specializer
{ member? member-eq? } [
{ array } set-specializer
] each
\ member? { { array } { string } } set-specializer
\ member-eq? { array } set-specializer
\ assoc-stack { vector } set-specializer

View File

@ -25,3 +25,5 @@ M: ascii decode-char
stream-read1 dup [
dup 127 <= [ >fixnum ] [ drop replacement-char ] if
] when ; inline
M: ascii decode-until (decode-until) ;

View File

@ -230,7 +230,7 @@ M: object underlying-handle underlying-port handle>> ;
! Fast-path optimization
HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;
HINTS: (decode-until) { string input-port object } ;
HINTS: M\ input-port stream-read-partial-unsafe
{ fixnum byte-array input-port }

View File

@ -15,6 +15,27 @@ M: object guess-encoded-length drop ; inline
GENERIC: decode-char ( stream encoding -- char/f )
GENERIC: decode-until ( seps stream encoding -- string/f sep/f )
<PRIVATE
! If the stop? branch is taken convert the sbuf to a string
! If sep is present, returns ``string sep'' (string can be "")
! If sep is f, returns ``string f'' or ``f f''
: read-until-loop ( buf quot: ( -- char stop? ) -- string/f sep/f )
dup call
[ nip [ "" like ] dip [ f like f ] unless* ]
[ pick push read-until-loop ] if ; inline recursive
PRIVATE>
: (decode-until) ( seps stream encoding -- string/f sep/f )
[ decode-char dup ] 2curry swap [ dupd member? ] curry
[ [ drop f t ] if ] curry compose
[ 100 <sbuf> ] dip read-until-loop ; inline
M: object decode-until (decode-until) ;
GENERIC: encode-char ( char stream encoding -- )
GENERIC: encode-string ( string stream encoding -- )
@ -111,23 +132,10 @@ M: decoder stream-contents*
{ CHAR: \n [ line-ends\n ] }
} case ; inline
! If the stop? branch is taken convert the sbuf to a string
! If sep is present, returns ``string sep'' (string can be "")
! If sep is f, returns ``string f'' or ``f f''
: read-until-loop ( buf quot: ( -- char stop? ) -- string/f sep/f )
dup call
[ nip [ "" like ] dip [ f like f ] unless* ]
[ pick push read-until-loop ] if ; inline recursive
: decoder-read-until ( seps stream encoding -- string/f sep/f )
[ decode-char dup ] 2curry swap [ dupd member? ] curry
[ [ drop f t ] if ] curry compose
[ 100 <sbuf> ] dip read-until-loop ; inline
M: decoder stream-read-until >decoder< decoder-read-until ;
M: decoder stream-read-until >decoder< decode-until ;
M: decoder stream-readln
"\r\n" over >decoder< decoder-read-until handle-readln ;
"\r\n" over >decoder< decode-until handle-readln ;
M: decoder dispose stream>> dispose ;

View File

@ -54,6 +54,8 @@ SINGLETON: utf8
M: utf8 decode-char
drop decode-utf8 ; inline
M: utf8 decode-until (decode-until) ;
! Encoding UTF-8
: encoded ( stream char -- )