steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

io.streams.sequence: support slices (fix io.streams.peek test failure).

db4
John Benediktsson 2014-03-10 19:56:42 -07:00
parent ee040a242c
commit 80f88318a6
1 changed files with 18 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
core/io/streams/sequence/sequence.factor
View File

@ -20,24 +20,29 @@ SLOT: i
: (sequence-read-length) ( n buf stream -- buf count ) : (sequence-read-length) ( n buf stream -- buf count )
[ underlying>> length ] [ i>> ] bi - rot min ; inline [ underlying>> length ] [ i>> ] bi - rot min ; inline
: <sequence-copy> ( dst n i src -- n copy ) : <sequence-copy> ( dst n src-i src dst-i -- n copy )
[ 0 ] 3curry dip <copy> ; inline [ ] curry 3curry dip <copy> ; inline
: ((sequence-read-unsafe)) ( n buf stream -- count ) : ((sequence-read-unsafe)) ( n buf stream offset -- count )
[
[ (sequence-read-length) ] [ (sequence-read-length) ]
[ [ dup pick + ] change-i underlying>> ] bi [ [ dup pick + ] change-i underlying>> ] bi
[ <sequence-copy> (copy) drop ] 2curry keep ; inline ] dip [ <sequence-copy> (copy) drop ] 3curry keep ; inline
: check-byte-array ( buf stream -- buf stream ) : check-byte-array ( buf stream offset -- buf stream offset )
over byte-array? [ "not a byte array" throw ] unless ; inline pick byte-array? [ "not a byte array" throw ] unless ; inline
: check-string ( buf stream -- buf stream ) : check-string ( buf stream offset -- buf stream offset )
over string? [ "not a string" throw ] unless ; inline pick string? [ "not a string" throw ] unless ; inline
: (sequence-read-unsafe) ( n buf stream -- count ) : (sequence-read-unsafe) ( n buf stream -- count )
[ integer>fixnum ] 2dip dup stream-element-type +byte+ eq? [ integer>fixnum ]
[ dup slice? [ [ seq>> ] [ from>> ] bi ] [ 0 ] if ]
[
swap over stream-element-type +byte+ eq?
[ check-byte-array ((sequence-read-unsafe)) ] [ check-byte-array ((sequence-read-unsafe)) ]
[ check-string ((sequence-read-unsafe)) ] if ; inline [ check-string ((sequence-read-unsafe)) ] if
] tri* ; inline
PRIVATE> PRIVATE>