2009-01-20 14:21:58 -05:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
|
|
|
! Copyright (C) 2009 Doug Coleman.
|
2008-06-12 04:50:20 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-06-17 01:10:09 -04:00
|
|
|
USING: kernel math io io.encodings destructors accessors
|
2009-01-20 13:02:54 -05:00
|
|
|
sequences namespaces byte-vectors fry combinators ;
|
2008-06-12 04:50:20 -04:00
|
|
|
IN: io.streams.limited
|
|
|
|
|
2009-01-20 13:02:54 -05:00
|
|
|
TUPLE: limited-stream stream count limit mode ;
|
|
|
|
|
|
|
|
SINGLETONS: stream-throws stream-eofs ;
|
2008-06-12 04:50:20 -04:00
|
|
|
|
2008-06-12 04:58:33 -04:00
|
|
|
: <limited-stream> ( stream limit -- stream' )
|
2008-06-12 04:50:20 -04:00
|
|
|
limited-stream new
|
|
|
|
swap >>limit
|
2008-06-12 04:58:33 -04:00
|
|
|
swap >>stream
|
2009-01-20 13:02:54 -05:00
|
|
|
0 >>count
|
|
|
|
stream-throws >>mode ;
|
2008-06-12 04:50:20 -04:00
|
|
|
|
2008-06-17 01:10:09 -04:00
|
|
|
GENERIC# limit 1 ( stream limit -- stream' )
|
|
|
|
|
|
|
|
M: decoder limit [ clone ] dip [ limit ] curry change-stream ;
|
|
|
|
|
|
|
|
M: object limit <limited-stream> ;
|
|
|
|
|
|
|
|
: limit-input ( limit -- ) input-stream [ swap limit ] change ;
|
2008-06-12 04:50:20 -04:00
|
|
|
|
|
|
|
ERROR: limit-exceeded ;
|
|
|
|
|
2009-01-20 13:02:54 -05:00
|
|
|
ERROR: bad-stream-mode mode ;
|
|
|
|
|
2009-01-20 14:21:58 -05:00
|
|
|
<PRIVATE
|
|
|
|
|
2009-01-19 19:52:09 -05:00
|
|
|
: adjust-limit ( n stream -- n' stream )
|
|
|
|
2dup [ + ] change-count
|
2009-01-19 19:19:12 -05:00
|
|
|
[ count>> ] [ limit>> ] bi >
|
2009-01-19 19:52:09 -05:00
|
|
|
[
|
2009-01-20 13:02:54 -05:00
|
|
|
dup mode>> {
|
|
|
|
{ stream-throws [ limit-exceeded ] }
|
|
|
|
{ stream-eofs [
|
|
|
|
dup [ count>> ] [ limit>> ] bi -
|
|
|
|
'[ _ - ] dip
|
|
|
|
] }
|
|
|
|
[ bad-stream-mode ]
|
|
|
|
} case
|
2009-01-19 19:52:09 -05:00
|
|
|
] when ; inline
|
|
|
|
|
|
|
|
: maybe-read ( n limited-stream quot: ( n stream -- seq/f ) -- seq/f )
|
2009-01-20 13:04:20 -05:00
|
|
|
[ adjust-limit ] dip
|
2009-01-19 19:52:09 -05:00
|
|
|
pick 0 <= [ 3drop f ] [ [ stream>> ] dip call ] if ; inline
|
2008-06-12 04:50:20 -04:00
|
|
|
|
2009-01-20 14:21:58 -05:00
|
|
|
PRIVATE>
|
|
|
|
|
2008-06-12 04:50:20 -04:00
|
|
|
M: limited-stream stream-read1
|
2009-01-20 13:04:20 -05:00
|
|
|
1 swap
|
2009-01-19 19:52:09 -05:00
|
|
|
[ nip stream-read1 ] maybe-read ;
|
2008-06-12 04:50:20 -04:00
|
|
|
|
|
|
|
M: limited-stream stream-read
|
2009-01-20 13:04:20 -05:00
|
|
|
[ stream-read ] maybe-read ;
|
2008-06-12 04:50:20 -04:00
|
|
|
|
|
|
|
M: limited-stream stream-read-partial
|
2009-01-20 13:04:20 -05:00
|
|
|
[ stream-read-partial ] maybe-read ;
|
2008-06-12 04:50:20 -04:00
|
|
|
|
2009-01-20 14:21:58 -05:00
|
|
|
<PRIVATE
|
|
|
|
|
2008-06-12 04:50:20 -04:00
|
|
|
: (read-until) ( stream seps buf -- stream seps buf sep/f )
|
|
|
|
3dup [ [ stream-read1 dup ] dip memq? ] dip
|
|
|
|
swap [ drop ] [ push (read-until) ] if ;
|
|
|
|
|
2009-01-20 14:21:58 -05:00
|
|
|
PRIVATE>
|
|
|
|
|
2008-06-12 04:50:20 -04:00
|
|
|
M: limited-stream stream-read-until
|
|
|
|
swap BV{ } clone (read-until) [ 2nip B{ } like ] dip ;
|
|
|
|
|
|
|
|
M: limited-stream dispose
|
|
|
|
stream>> dispose ;
|