io: stream-contents, -seekable?, -length generics
stream-contents is extremely slow on decoder streams when implemented with each-block, and it can be implemented very quickly for streams of known length using stream-read-unsafe. Make it generic and provide some off-the-shelf implementations using each-block, a read1 loop, or length + read-unsafe. Provide new stream-seekable? and stream-length generics that can be implemented by stream implementations that know their size.db4
parent
bd50acf424
commit
225d10b4dd
|
@ -13,6 +13,7 @@ GENERIC: stream-read-unsafe ( n buf stream -- count )
|
||||||
GENERIC: stream-read-until ( seps stream -- seq sep/f )
|
GENERIC: stream-read-until ( seps stream -- seq sep/f )
|
||||||
GENERIC: stream-read-partial-unsafe ( n buf stream -- count )
|
GENERIC: stream-read-partial-unsafe ( n buf stream -- count )
|
||||||
GENERIC: stream-readln ( stream -- str/f )
|
GENERIC: stream-readln ( stream -- str/f )
|
||||||
|
GENERIC: stream-contents ( stream -- seq )
|
||||||
|
|
||||||
GENERIC: stream-write1 ( elt stream -- )
|
GENERIC: stream-write1 ( elt stream -- )
|
||||||
GENERIC: stream-write ( data stream -- )
|
GENERIC: stream-write ( data stream -- )
|
||||||
|
@ -25,6 +26,8 @@ SINGLETONS: seek-absolute seek-relative seek-end ;
|
||||||
|
|
||||||
GENERIC: stream-tell ( stream -- n )
|
GENERIC: stream-tell ( stream -- n )
|
||||||
GENERIC: stream-seek ( n seek-type stream -- )
|
GENERIC: stream-seek ( n seek-type stream -- )
|
||||||
|
GENERIC: stream-seekable? ( stream -- ? )
|
||||||
|
GENERIC: stream-length ( stream -- n/f )
|
||||||
|
|
||||||
: stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ;
|
: stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ;
|
||||||
|
|
||||||
|
@ -128,27 +131,29 @@ PRIVATE>
|
||||||
: each-block ( ... quot: ( ... block -- ... ) -- ... )
|
: each-block ( ... quot: ( ... block -- ... ) -- ... )
|
||||||
input-stream get swap each-stream-block ; inline
|
input-stream get swap each-stream-block ; inline
|
||||||
|
|
||||||
: stream-contents ( stream -- seq )
|
: (stream-contents-by-length) ( stream len -- seq )
|
||||||
|
dup rot [
|
||||||
|
[ (new-sequence-for-stream) ]
|
||||||
|
[ [ stream-read-unsafe ] curry keep resize ] bi
|
||||||
|
] with-disposal ;
|
||||||
|
: (stream-contents-by-block) ( stream -- seq )
|
||||||
[
|
[
|
||||||
[ [ ] collector [ each-stream-block ] dip { } like ]
|
[ [ ] collector [ each-stream-block ] dip { } like ]
|
||||||
[ stream-exemplar concat-as ] bi
|
[ stream-exemplar concat-as ] bi
|
||||||
] with-disposal ;
|
] with-disposal ;
|
||||||
|
: (stream-contents-by-length-or-block) ( stream -- seq )
|
||||||
: stream-contents-length ( stream -- n )
|
dup stream-length
|
||||||
[ stream-tell ]
|
[ (stream-contents-by-length) ]
|
||||||
[ [ 0 seek-end ] dip [ stream-seek ] [ stream-tell ] bi ]
|
[ (stream-contents-by-block) ] if* ; inline
|
||||||
[ [ swap seek-absolute ] dip stream-seek ] tri ;
|
: (stream-contents-by-element) ( stream -- seq )
|
||||||
|
[
|
||||||
: stream-contents* ( stream -- seq )
|
[ [ stream-read1 dup ] curry [ ] ]
|
||||||
[ stream-contents-length dup (byte-array) ]
|
[ stream-exemplar produce-as nip ] bi
|
||||||
[ [ stream-read-unsafe drop ] curry keep ] bi ;
|
] with-disposal ;
|
||||||
|
|
||||||
: contents ( -- seq )
|
: contents ( -- seq )
|
||||||
input-stream get stream-contents ; inline
|
input-stream get stream-contents ; inline
|
||||||
|
|
||||||
: contents* ( -- seq )
|
|
||||||
input-stream get stream-contents* ; inline
|
|
||||||
|
|
||||||
: stream-copy* ( in out -- )
|
: stream-copy* ( in out -- )
|
||||||
[ stream-write ] curry each-stream-block ; inline
|
[ stream-write ] curry each-stream-block ; inline
|
||||||
|
|
||||||
|
@ -179,7 +184,11 @@ M: object stream-read-partial-unsafe stream-read-unsafe ; inline
|
||||||
M: object stream-read-until read-until-loop ;
|
M: object stream-read-until read-until-loop ;
|
||||||
M: object stream-readln
|
M: object stream-readln
|
||||||
"\n" swap stream-read-until drop ; inline
|
"\n" swap stream-read-until drop ; inline
|
||||||
|
M: object stream-contents (stream-contents-by-length-or-block) ; inline
|
||||||
|
M: object stream-seekable? drop f ; inline
|
||||||
|
M: object stream-length drop f ; inline
|
||||||
|
|
||||||
M: object stream-write [ stream-write1 ] curry each ; inline
|
M: object stream-write [ stream-write1 ] curry each ; inline
|
||||||
M: object stream-flush drop ; inline
|
M: object stream-flush drop ; inline
|
||||||
M: object stream-nl CHAR: \n swap stream-write1 ; inline
|
M: object stream-nl CHAR: \n swap stream-write1 ; inline
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue