diff --git a/extra/io/streams/peek/authors.txt b/extra/io/streams/peek/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/streams/peek/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/streams/peek/peek-tests.factor b/extra/io/streams/peek/peek-tests.factor new file mode 100644 index 0000000000..2a5a2dc36a --- /dev/null +++ b/extra/io/streams/peek/peek-tests.factor @@ -0,0 +1,97 @@ +! Copyright (C) 2011 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel io io.streams.peek io.streams.string tools.test ; +IN: io.streams.peek.tests + +[ CHAR: a ] +[ "abc" stream-read1 ] unit-test + +[ CHAR: a ] +[ "abc" stream-peek1 ] unit-test + +[ f ] +[ "" stream-peek1 ] unit-test + +[ CHAR: a ] +[ "abc" stream-peek1 ] unit-test + +[ "ab" 99 ] +[ "abc" "c" swap stream-read-until ] unit-test + +[ "ab" f ] +[ "ab" "c" swap stream-read-until ] unit-test + +[ CHAR: a ] +[ + "abc" + [ stream-peek1 drop ] + [ stream-peek1 ] bi +] unit-test + +[ "ab" ] +[ + "abc" + 2 swap stream-peek +] unit-test + +[ "ab" ] +[ + "abc" + 2 over stream-peek drop + 2 swap stream-peek +] unit-test + +[ + { + B{ 97 98 99 100 } + B{ 97 98 99 100 101 102 } + B{ 97 98 } + B{ 99 100 } + B{ 101 102 } + B{ 103 104 } + B{ 105 106 107 108 } + B{ 105 106 107 108 109 110 111 112 } + B{ 105 106 107 108 109 110 111 112 113 114 } + } +] [ + [ + "abcdefghijklmnopqrstuvwxyz" >byte-array binary + 4 over stream-peek , + 6 over stream-peek , + 2 over stream-read , + 2 over stream-read , + 2 over stream-read , + 2 over stream-read , + 4 over stream-peek , + 8 over stream-peek , + 10 swap stream-read , + ] { } make +] unit-test + +[ + { + "abcd" + "abcdef" + "ab" + "cd" + "ef" + "gh" + "ijkl" + "ijklmnop" + "ijklmnopqr" + } +] +[ + [ + "abcdefghijklmnopqrstuvwxyz" >byte-array ascii + 4 over stream-peek , + 6 over stream-peek , + 2 over stream-read , + 2 over stream-read , + 2 over stream-read , + 2 over stream-read , + 4 over stream-peek , + 8 over stream-peek , + 10 swap stream-read , + ] { } make +] unit-test diff --git a/extra/io/streams/peek/peek.factor b/extra/io/streams/peek/peek.factor new file mode 100644 index 0000000000..2b52d358ac --- /dev/null +++ b/extra/io/streams/peek/peek.factor @@ -0,0 +1,91 @@ +! Copyright (C) 2011 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators combinators.short-circuit +destructors io io.private kernel locals math sequences +vectors ; +IN: io.streams.peek + +TUPLE: peek-stream stream peeked ; + +M: peek-stream dispose stream>> dispose ; + +: stream-exemplar-growable ( stream -- exemplar ) + stream-element-type { + { +byte+ [ BV{ } ] } + { +character+ [ SBUF" " ] } + } case ; inline + +: stream-new-resizable ( n stream -- exemplar ) + stream-element-exemplar new-resizable ; inline + +: stream-like ( sequence stream -- sequence' ) + stream-element-exemplar like ; inline + +: stream-clone-resizable ( sequence stream -- sequence' ) + stream-exemplar-growable clone-like ; inline + +: ( stream -- stream ) + peek-stream new + swap >>stream + 64 over stream-new-resizable >>peeked ; inline + +M: peek-stream stream-element-type + stream>> stream-element-type ; + +M: peek-stream stream-read1 + dup peeked>> [ + stream>> stream-read1 + ] [ + pop nip + ] if-empty ; + +M:: peek-stream stream-read ( n stream -- sequence ) + stream peeked>> :> peeked + peeked length :> #peeked + #peeked 0 = [ + n stream stream>> stream-read + ] [ + ! Have we already peeked enough? + #peeked n > [ + peeked n cut [ stream stream-like ] + [ stream stream-clone-resizable stream peeked<< ] bi* + ] [ + peeked + n #peeked - stream stream>> stream-read + stream stream-element-exemplar append-as + + stream stream-exemplar-growable clone stream peeked<< + ] if + ] if ; + +: peek-stream-read-until ( stream seps buf -- stream seps buf sep/f ) + 3dup [ [ stream-read1 dup ] dip member-eq? ] dip swap + [ drop ] [ over [ push peek-stream-read-until ] [ drop ] if ] if ; + +M: peek-stream stream-read-until + swap 64 pick stream-new-resizable + peek-stream-read-until [ nip swap stream-like ] dip ; + +M: peek-stream stream-write stream>> stream-write ; +M: peek-stream stream-write1 stream>> stream-write1 ; +M: peek-stream stream-flush stream>> stream-flush ; + +: stream-peek1 ( stream -- ch ) + dup peeked>> [ + dup stream>> stream-read1 [ + [ 1vector over stream-clone-resizable >>peeked drop ] keep + ] [ + drop f + ] if* + ] [ + last nip + ] if-empty ; + +: stream-peek ( n stream -- seq ) + 2dup peeked>> { [ length <= ] [ length 0 > ] } 1&& [ + [ peeked>> swap head ] [ stream-element-exemplar like ] bi + ] [ + [ nip ] + [ stream-read ] 2bi + [ reverse swap peeked>> push-all ] keep + ] if ;