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* + + + + + ; ] bi* + + + + + ;
: should-inline? ( #call word -- ? ) : should-inline? ( #call word -- ? )
inlining-rank 5 >= ; dup "inline" word-prop [ 2drop t ] [ inlining-rank 5 >= ] if ;
SYMBOL: history SYMBOL: history

View File

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

View File

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

View File

@ -9,7 +9,7 @@ IN: io.encodings.ascii
: decode-if< ( stream encoding max -- character ) : decode-if< ( stream encoding max -- character )
nip swap stream-read1 dup 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> PRIVATE>
SINGLETON: ascii SINGLETON: ascii

View File

@ -100,7 +100,7 @@ TUPLE: output-port < buffered-port ;
: wait-to-write ( len port -- ) : wait-to-write ( len port -- )
tuck buffer>> buffer-capacity <= tuck buffer>> buffer-capacity <=
[ drop ] [ stream-flush ] if ; [ drop ] [ stream-flush ] if ; inline
M: output-port stream-write1 M: output-port stream-write1
dup check-disposed 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-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 M: encoder stream-write1
>encoder< encode-char ; >encoder< encode-char ;
: decoder-write ( string stream encoding -- ) : encoder-write ( string stream encoding -- )
[ encode-char ] 2curry each ; [ encode-char ] 2curry each ;
M: encoder stream-write M: encoder stream-write
>encoder< decoder-write ; >encoder< encoder-write ;
M: encoder dispose stream>> dispose ; M: encoder dispose stream>> dispose ;