I/O ricing: various hints added so that UTF8 and ASCII fastpaths compile with less dispatch. 25% improvement on reverse-complement

db4
Slava Pestov 2008-11-06 00:02:44 -06:00
parent aac256324f
commit bfd119e3b5
6 changed files with 14 additions and 15 deletions

View File

@ -131,7 +131,7 @@ DEFER: (flat-length)
] bi* + + + + + ;
: should-inline? ( #call word -- ? )
inlining-rank 5 >= ;
dup "inline" word-prop [ 2drop t ] [ inlining-rank 5 >= ] if ;
SYMBOL: history

View File

@ -64,10 +64,12 @@ IN: hints
{ first first2 first3 first4 }
[ { array } "specializer" set-word-prop ] each
{ peek pop* pop push } [
{ peek pop* pop } [
{ vector } "specializer" set-word-prop
] each
\ push { { vector } { sbuf } } "specializer" set-word-prop
\ push-all
{ { string sbuf } { array vector } { byte-array byte-vector } }
"specializer" set-word-prop

View File

@ -36,9 +36,7 @@ M: buffer dispose* ptr>> free ;
[ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
: buffer-pop ( buffer -- byte )
[ buffer-peek ] [ 1 swap buffer-consume ] bi ;
HINTS: buffer-pop buffer ;
[ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
: buffer-length ( buffer -- n )
[ fill>> ] [ pos>> ] bi - ; inline
@ -69,14 +67,13 @@ HINTS: n>buffer fixnum buffer ;
HINTS: >buffer byte-array buffer ;
: byte>buffer ( byte buffer -- )
[ >fixnum ] dip
[ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
[ 1 swap n>buffer ]
bi ;
HINTS: byte>buffer fixnum buffer ;
bi ; inline
: search-buffer-until ( pos fill ptr separators -- n )
[ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ;
[ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ; inline
: finish-buffer-until ( buffer n -- byte-array separator )
[
@ -86,7 +83,7 @@ HINTS: byte>buffer fixnum buffer ;
] [
[ buffer-length ] keep
buffer-read f
] if* ;
] if* ; inline
: buffer-until ( separators buffer -- byte-array separator )
swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip

View File

@ -9,7 +9,7 @@ IN: io.encodings.ascii
: decode-if< ( stream encoding max -- character )
nip swap stream-read1 dup
[ tuck > [ drop replacement-char ] unless ] [ 2drop f ] if ; inline
[ tuck > [ >fixnum ] [ drop replacement-char ] if ] [ 2drop f ] if ; inline
PRIVATE>
SINGLETON: ascii

View File

@ -100,7 +100,7 @@ TUPLE: output-port < buffered-port ;
: wait-to-write ( len port -- )
tuck buffer>> buffer-capacity <=
[ drop ] [ stream-flush ] if ;
[ drop ] [ stream-flush ] if ; inline
M: output-port stream-write1
dup check-disposed
@ -161,4 +161,4 @@ HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii }
HINTS: decoder-readln { input-port utf8 } { input-port ascii } ;
HINTS: decoder-write { string output-port utf8 } { string output-port ascii } ;
HINTS: encoder-write { string output-port utf8 } { string output-port ascii } ;

View File

@ -124,11 +124,11 @@ M: object <encoder> encoder boa ;
M: encoder stream-write1
>encoder< encode-char ;
: decoder-write ( string stream encoding -- )
: encoder-write ( string stream encoding -- )
[ encode-char ] 2curry each ;
M: encoder stream-write
>encoder< decoder-write ;
>encoder< encoder-write ;
M: encoder dispose stream>> dispose ;