string input streams

library/bootstrap/boot-stage1.factor

@@ -50,6 +50,8 @@ parser prettyprint sequences io vectors words ;
         "/library/continuations.factor"
 
         "/library/io/stream.factor"
+        "/library/io/duplex-stream.factor"
+        "/library/io/string-streams.factor"
         "/library/io/stdio.factor"
         "/library/io/lines.factor"
         "/library/io/c-streams.factor"

library/collections/strings-epilogue.factor

@@ -4,6 +4,9 @@ IN: strings
 USING: generic kernel kernel-internals lists math namespaces
 sequences strings ;
 
+: empty-sbuf ( len -- sbuf )
+    dup <sbuf> [ set-length ] keep ;
+
 : sbuf-append ( ch/str sbuf -- )
     over string? [ swap nappend ] [ push ] ifte ;
 

library/io/duplex-stream.factor

@@ -0,0 +1,32 @@
+! Combine an input and output stream into one, and flush the
+! stream more often.
+USING: io kernel ;
+
+TUPLE: duplex-stream in out flush? ;
+
+M: duplex-stream stream-flush
+    duplex-stream-out stream-flush ;
+
+M: duplex-stream stream-auto-flush
+    dup duplex-stream-flush?
+    [ duplex-stream-out stream-flush ] [ drop ] ifte ;
+
+M: duplex-stream stream-readln
+    duplex-stream-in stream-readln ;
+
+M: duplex-stream stream-read
+    duplex-stream-in stream-read ;
+
+M: duplex-stream stream-read1
+    duplex-stream-in stream-read1 ;
+
+M: duplex-stream stream-write-attr
+    duplex-stream-out stream-write-attr ;
+
+M: duplex-stream stream-close
+    duplex-stream-out stream-close ;
+
+M: duplex-stream set-timeout
+    2dup
+    duplex-stream-in set-timeout
+    duplex-stream-out set-timeout ;

library/io/files.factor

@@ -5,6 +5,7 @@ USING: kernel lists sequences strings ;
 
 ! Words for accessing filesystem meta-data.
 
+: path+ ( path path -- path ) "/" swap append3 ;
 : exists? ( file -- ? ) stat >boolean ;
 : directory? ( file -- ? ) stat car ;
 : directory ( dir -- list ) (directory) [ string> ] sort ;

library/io/lines.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-USING: generic kernel namespaces sequences io ;
+USING: errors generic io kernel namespaces sequences ;
 
 TUPLE: line-reader cr ;
 
@@ -36,3 +36,20 @@ M: line-reader stream-read ( count line -- string )
     ] [
         drop
     ] ifte ;
+
+! Reading lines and counting line numbers.
+SYMBOL: line-number
+SYMBOL: parser-stream
+
+: next-line ( -- str )
+    parser-stream get stream-readln
+    line-number [ 1 + ] change ;
+
+: read-lines ( stream quot -- )
+    #! Apply a quotation to each line as its read. Close the
+    #! stream.
+    swap [
+        parser-stream set 0 line-number set [ next-line ] while
+    ] [
+        parser-stream get stream-close rethrow
+    ] catch ;

library/io/stdio.factor

@@ -3,8 +3,6 @@
 IN: io
 USING: errors kernel lists namespaces generic strings ;
 
-SYMBOL: stdio
-
 : flush      ( -- )              stdio get stream-flush ;
 : read-line  ( -- string )       stdio get stream-readln ;
 : read1      ( -- char )         stdio get stream-read1 ;
@@ -32,11 +30,6 @@ SYMBOL: stdio
         [ [ close rethrow ] when* ] catch
     ] with-scope ;
 
-: with-string ( quot -- str )
-    #! Execute a quotation, and push a string containing all
-    #! text printed by the quotation.
-    1024 <sbuf> [ call stdio get >string ] with-stream ;
-
 TUPLE: stdio-stream ;
 C: stdio-stream ( stream -- stream ) [ set-delegate ] keep ;
 M: stdio-stream stream-auto-flush ( -- ) delegate stream-flush ;

library/io/stream.factor

@@ -4,12 +4,7 @@ IN: io
 USING: errors generic kernel lists math namespaces sequences
 strings ;
 
-! We need this early during bootstrap.
-: path+ ( path path -- path )
-    #! Combine two paths. This will be implemented later.
-    "/" swap append3 ;
-
-DEFER: stdio
+SYMBOL: stdio
 
 ! Stream protocol.
 GENERIC: stream-flush      ( stream -- )
@@ -29,6 +24,17 @@ GENERIC: set-timeout       ( timeout stream -- )
     [ "\n" swap stream-write ] keep
     stream-auto-flush ;
 
+: (stream-copy) ( in out -- )
+    4096 pick stream-read [
+        over stream-write (stream-copy)
+    ] [
+        2drop
+    ] ifte* ;
+
+: stream-copy ( in out -- )
+    [ 2dup (stream-copy) ]
+    [ >r stream-close stream-close r> [ rethrow ] when* ] catch ;
+
 ! Think '/dev/null'.
 TUPLE: null-stream ;
 M: null-stream stream-flush drop ;
@@ -39,12 +45,6 @@ M: null-stream stream-read1 drop f ;
 M: null-stream stream-write-attr 3drop ;
 M: null-stream stream-close drop ;
 
-! String buffers support the stream output protocol.
-M: sbuf stream-write-attr nip sbuf-append ;
-M: sbuf stream-close drop ;
-M: sbuf stream-flush drop ;
-M: sbuf stream-auto-flush drop ;
-
 ! Sometimes, we want to have a delegating stream that uses stdio
 ! words.
 TUPLE: wrapper-stream scope ;
@@ -58,57 +58,6 @@ C: wrapper-stream ( stream -- stream )
 : with-wrapper ( stream quot -- )
     >r wrapper-stream-scope r> bind ;
 
-! Combine an input and output stream into one, and flush the
-! stream more often.
-TUPLE: duplex-stream in out flush? ;
-
-M: duplex-stream stream-flush
-    duplex-stream-out stream-flush ;
-
-M: duplex-stream stream-auto-flush
-    dup duplex-stream-flush? [
-        duplex-stream-out stream-flush
-    ] [
-        drop
-    ] ifte ;
-
-M: duplex-stream stream-readln
-    duplex-stream-in stream-readln ;
-
-M: duplex-stream stream-read
-    duplex-stream-in stream-read ;
-
-M: duplex-stream stream-read1
-    duplex-stream-in stream-read1 ;
-
-M: duplex-stream stream-write-attr
-    duplex-stream-out stream-write-attr ;
-
-M: duplex-stream stream-close
-    duplex-stream-out stream-close ;
-
-M: duplex-stream set-timeout
-    2dup
-    duplex-stream-in set-timeout
-    duplex-stream-out set-timeout ;
-
-! Reading lines and counting line numbers.
-SYMBOL: line-number
-SYMBOL: parser-stream
-
-: next-line ( -- str )
-    parser-stream get stream-readln
-    line-number [ 1 + ] change ;
-
-: read-lines ( stream quot -- )
-    #! Apply a quotation to each line as its read. Close the
-    #! stream.
-    swap [
-        parser-stream set 0 line-number set [ next-line ] while
-    ] [
-        parser-stream get stream-close rethrow
-    ] catch ;
-
 ! Standard actions protocol for presentations output to
 ! attributed streams.
 : <actions> ( path alist -- alist )
@@ -124,17 +73,3 @@ DEFER: <file-reader>
 : <resource-stream> ( path -- stream )
     #! Open a file path relative to the Factor source code root.
     resource-path swap path+ <file-reader> ;
-
-: (stream-copy) ( in out -- )
-    4096 pick stream-read [
-        over stream-write (stream-copy)
-    ] [
-        2drop
-    ] ifte* ;
-
-: stream-copy ( in out -- )
-    [
-        2dup (stream-copy)
-    ] [
-        >r stream-close stream-close r> [ rethrow ] when*
-    ] catch ;

library/io/string-streams.factor

@@ -0,0 +1,28 @@
+USING: io kernel math namespaces sequences strings ;
+
+! String buffers support the stream output protocol.
+M: sbuf stream-write-attr nip sbuf-append ;
+M: sbuf stream-close drop ;
+M: sbuf stream-flush drop ;
+M: sbuf stream-auto-flush drop ;
+
+: string-out ( quot -- str )
+    [ 512 <sbuf> stdio set call stdio get >string ] with-scope ;
+
+! Reversed string buffers support the stream input protocol.
+M: sbuf stream-read1 ( sbuf -- char/f )
+    dup empty? [ drop f ] [ pop ] ifte ;
+
+M: sbuf stream-read ( count sbuf -- string )
+    dup empty? [
+        2drop f
+    ] [
+        swap over length min empty-sbuf
+        [ [ drop dup pop ] nmap drop ] keep
+    ] ifte ;
+
+: <string-reader> ( string -- stream )
+    >sbuf dup nreverse <line-reader> ;
+
+: string-in ( str quot -- )
+    [ swap <string-reader> stdio set call ] with-scope ;