io: default methods for extended stream protocols

Provide default implementations of all the input-stream methods in terms of stream-read1 and of all the output-stream methods in terms of stream-write1.

core/io/io-tests.factor

@@ -1,10 +1,64 @@
-USING: io parser tools.test words ;
+USING: accessors io kernel math parser tools.test words ;
 IN: io.tests
 
-[ f ] [
+{ f } [
     "vocab:io/test/no-trailing-eol.factor" run-file
     "foo" "io.tests" lookup
 ] unit-test
 
 ! Make sure we use correct to_c_string form when writing
-[ ] [ "\0" write ] unit-test
+{ } [ "\0" write ] unit-test
+
+! Test default input stream protocol methods
+
+TUPLE: up-to-13-reader { i fixnum initial: 0 } ;
+
+M: up-to-13-reader stream-element-type drop +byte+ ; inline
+M: up-to-13-reader stream-read1
+    [ dup 1 + ] change-i drop
+    dup 13 >= [ drop f ] when ; inline
+
+{ B{ 0 1 2 } } [ 3 up-to-13-reader new stream-read ] unit-test
+{ B{ 0 1 2 } } [ 3 up-to-13-reader new stream-read-partial ] unit-test
+
+{ B{ 0 1 2 3 4 5 6 7 8 9 10 11 12 } f }
+[ up-to-13-reader new [ 20 swap stream-read ] [ 20 swap stream-read ] bi ] unit-test
+
+
+{
+    B{ 0 1 2 3 4 5 6 7 8 } 9
+    B{ 10 11 12 } f
+    f f
+} [
+    up-to-13-reader new
+    [ "\t" swap stream-read-until ]
+    [ "\t" swap stream-read-until ]
+    [ "\t" swap stream-read-until ] tri
+] unit-test
+
+{ B{ 0 1 2 3 4 5 6 7 8 9 } B{ 11 12 } f } [
+    up-to-13-reader new
+    [ stream-readln ] [ stream-readln ] [ stream-readln ] tri
+] unit-test
+
+! Test default output stream protocol methods
+
+TUPLE: dumb-writer vector ;
+
+: <dumb-writer> ( -- x ) BV{ } clone dumb-writer boa ; inline
+
+M: dumb-writer stream-element-type drop +byte+ ; inline
+M: dumb-writer stream-write1 vector>> push ; inline
+
+{ BV{ 11 22 33 } } [
+    <dumb-writer> 
+    [ B{ 11 22 33 } swap stream-write ]
+    [ vector>> ] bi
+] unit-test
+
+{ BV{ 11 22 33 10 } } [
+    <dumb-writer> 
+    [ B{ 11 22 33 } swap stream-write ]
+    [ stream-nl ]
+    [ vector>> ] tri
+] unit-test

core/io/io.factor

@@ -152,3 +152,32 @@ PRIVATE>
 : stream-copy ( in out -- )
     [ [ [ write ] each-block ] with-output-stream ]
     curry with-input-stream ;
+
+! Default implementations of stream operations in terms of read1/write1
+
+<PRIVATE
+: read-loop ( buf stream n i -- count )
+     2dup = [ nip nip nip ] [
+        pick stream-read1 [
+            over [ pick set-nth-unsafe ] 2curry 3dip
+            1 + read-loop
+        ] [ nip nip nip ] if*
+     ] if ; inline recursive
+
+: finalize-read-until ( seq sep/f -- seq/f sep/f )
+    2dup [ empty? ] [ not ] bi* and [ 2drop f f ] when ; inline
+
+: read-until-loop ( seps stream -- seq sep/f )
+    [ [ stream-read1 dup [ rot member? not ] [ nip f ] if* ] 2curry [ ] ]
+    [ stream-exemplar ] bi produce-as swap finalize-read-until ; inline
+PRIVATE>
+
+M: object stream-read-unsafe rot 0 read-loop ;
+M: object stream-read-partial-unsafe stream-read-unsafe ; inline
+M: object stream-read-until read-until-loop ;
+M: object stream-readln
+    "\n" swap stream-read-until drop ; inline
+
+M: object stream-write [ stream-write1 ] curry each ; inline
+M: object stream-flush drop ; inline
+M: object stream-nl CHAR: \n swap stream-write1 ; inline