Peekable streams wrapper

diff --git a/extra/io/streams/peek/authors.txt b/extra/io/streams/peek/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /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 (file)
index 0000000..2a5a2dc
--- /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" <string-reader> <peek-stream> stream-read1 ] unit-test
+
+[ CHAR: a ]
+[ "abc" <string-reader> <peek-stream> stream-peek1 ] unit-test
+
+[ f ]
+[ "" <string-reader> <peek-stream> stream-peek1 ] unit-test
+
+[ CHAR: a ]
+[ "abc" <string-reader> <peek-stream> stream-peek1 ] unit-test
+
+[ "ab" 99 ]
+[ "abc" <string-reader> <peek-stream> "c" swap stream-read-until ] unit-test
+
+[ "ab" f ]
+[ "ab" <string-reader> <peek-stream> "c" swap stream-read-until ] unit-test
+
+[ CHAR: a ]
+[
+    "abc" <string-reader> <peek-stream>
+    [ stream-peek1 drop ]
+    [ stream-peek1 ] bi
+] unit-test
+
+[ "ab" ]
+[
+    "abc" <string-reader> <peek-stream>
+    2 swap stream-peek
+] unit-test
+
+[ "ab" ]
+[
+    "abc" <string-reader> <peek-stream>
+    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 <byte-reader> <peek-stream>
+        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 <byte-reader> <peek-stream>
+        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 (file)
index 0000000..2b52d35
--- /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
+
+: <peek-stream> ( 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 <reversed> n cut [ stream stream-like ]
+            [ <reversed> stream stream-clone-resizable stream peeked<< ] bi*
+        ] [
+            peeked <reversed>
+            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>> <reversed> swap head ] [ stream-element-exemplar like ] bi
+    ] [
+        [ nip ]
+        [ stream-read ] 2bi
+        [ reverse swap peeked>> push-all ] keep
+    ] if ;