bootstrap fix, I/O code cleanup, stream-read1 generic

library/bootstrap/primitives.factor

@@ -204,6 +204,7 @@ vocabularies get [
     [ "flush-icache" "assembler"              f ]
     [ "fopen"  "io-internals"                 [ [ string string ] [ alien ] ] ]
     [ "fgets" "io-internals"                  [ [ alien ] [ string ] ] ]
+    [ "fgetc" "io-internals"                  [ [ alien ] [ object ] ] ]
     [ "fwrite" "io-internals"                 [ [ string alien ] [ ] ] ]
     [ "fflush" "io-internals"                 [ [ alien ] [ ] ] ]
     [ "fclose" "io-internals"                 [ [ alien ] [ ] ] ]

library/io/c-streams.factor

@@ -21,7 +21,10 @@ M: c-stream stream-write-attr ( str style stream -- )
     c-stream-out fwrite ;
 
 M: c-stream stream-readln ( stream -- str )
-    dup stream-flush  c-stream-in dup [ fgets ] when ;
+    c-stream-in dup [ fgets ] when ;
+
+M: c-stream stream-read1 ( stream -- str )
+    c-stream-in dup [ fgetc ] when ;
 
 M: c-stream stream-flush ( stream -- )
     c-stream-out [ fflush ] when* ;
@@ -52,17 +55,3 @@ TUPLE: client-stream host port ;
 : <client> c-stream-error ;
 : <server> c-stream-error ;
 : accept c-stream-error ;
-
-: (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/stream.factor

@@ -19,13 +19,11 @@ GENERIC: stream-flush      ( stream -- )
 GENERIC: stream-auto-flush ( stream -- )
 GENERIC: stream-readln     ( stream -- string )
 GENERIC: stream-read       ( count stream -- string )
+GENERIC: stream-read1      ( stream -- char/f )
 GENERIC: stream-write-attr ( string style stream -- )
 GENERIC: stream-close      ( stream -- )
 GENERIC: set-timeout       ( timeout stream -- )
 
-: stream-read1 ( stream -- char/f )
-    1 swap stream-read dup empty? [ drop f ] [ first ] ifte ;
-
 : stream-write ( string stream -- )
     f swap stream-write-attr ;
 
@@ -40,6 +38,7 @@ M: null-stream stream-flush drop ;
 M: null-stream stream-auto-flush drop ;
 M: null-stream stream-readln drop f ;
 M: null-stream stream-read 2drop f ;
+M: null-stream stream-read1 drop f ;
 M: null-stream stream-write-attr 3drop ;
 M: null-stream stream-close drop ;
 
@@ -82,6 +81,9 @@ M: duplex-stream 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 ;
 
@@ -125,3 +127,17 @@ 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/test/test.factor

@@ -5,6 +5,7 @@ USING: errors kernel lists math memory namespaces parser
 prettyprint sequences stdio strings unparser vectors words ;
 
 TUPLE: assert got expect ;
+
 M: assert error.
     "Assertion failed" print
     "Expected: " write dup assert-expect .

library/unix/io.factor

@@ -167,22 +167,15 @@ GENERIC: task-container ( task -- vector )
 
 ! The cr slot is set to true by read-line-loop if the last
 ! character read was \r.
-TUPLE: reader line ready? cr ;
+TUPLE: reader line cr ;
 
 C: reader ( handle -- reader )
     [ >r buffered-port r> set-delegate ] keep ;
 
-: pop-line ( reader -- str )
-    dup reader-line dup [ >string ] when >r
-    f over set-reader-line
-    f swap set-reader-ready? r> ;
+: pop-line ( reader -- sbuf/f )
+    dup pending-error [ reader-line f ] keep set-reader-line ;
 
-: read-fin ( reader -- str )
-    dup pending-error  dup reader-ready? [
-        pop-line
-    ] [
-        "reader not ready" throw
-    ] ifte ;
+: read-fin ( reader -- str ) pop-line dup [ >string ] when ;
 
 : reader-cr> ( reader -- ? )
     dup reader-cr >r f swap set-reader-cr r> ;
@@ -211,24 +204,17 @@ C: reader ( handle -- reader )
         ] ifte
     ] ifte ;
 
-: read-line-step ( reader -- ? )
-    [ read-line-loop dup ] keep set-reader-ready? ;
-
 : init-reader ( count reader -- ) >r <sbuf> r> set-reader-line ;
 
-: prepare-line ( reader -- ? )
-    80 over init-reader read-line-step ;
-
 : can-read-line? ( reader -- ? )
-    dup pending-error
-    dup reader-ready? [ drop t ] [ prepare-line ] ifte ;
+    dup pending-error 80 over init-reader read-line-loop ;
 
 : reader-eof ( reader -- )
-    dup reader-line dup [
-        length 0 = [ f over set-reader-line ] when
+    dup reader-line empty? [
+        f swap set-reader-line
     ] [
         drop
-    ] ifte  t swap set-reader-ready? ;
+    ] ifte ;
 
 : (refill) ( port -- n )
     >port< dup buffer-end swap buffer-capacity read ;
@@ -255,7 +241,7 @@ M: read-line-task do-io-task ( task -- ? )
         dup eof? [
             reader-eof t
         ] [
-            read-line-step
+            read-line-loop
         ] ifte
     ] [
         drop f
@@ -291,7 +277,7 @@ M: reader stream-readln ( stream -- line )
     ] ifte ;
 
 ! Reading character counts
-: read-loop ( count reader -- ? )
+: read-step ( count reader -- ? )
     dup trailing-cr
     dup reader-line -rot >r over length - ( remaining) r>
     2dup buffer-length <= [
@@ -300,17 +286,8 @@ M: reader stream-readln ( stream -- line )
         buffer>> nip nappend f
     ] ifte ;
 
-: read-step ( count reader -- ? )
-    [ read-loop dup ] keep set-reader-ready? ;
-
 : can-read-count? ( count reader -- ? )
-    dup pending-error
-    2dup init-reader
-    2dup reader-line length <= [
-        t swap set-reader-ready? drop t
-    ] [
-        read-step
-    ] ifte ;
+    dup pending-error 2dup init-reader read-step ;
 
 TUPLE: read-task count ;
 
@@ -323,7 +300,7 @@ C: read-task ( count port -- task )
 M: read-task do-io-task ( task -- ? )
     >read-task< dup refill [
         dup eof? [
-            nip reader-eof t
+            reader-eof drop t
         ] [
             read-step
         ] ifte
@@ -341,6 +318,9 @@ M: read-task task-container drop read-tasks get ;
 M: reader stream-read ( count stream -- string )
     [ wait-to-read ] keep read-fin ;
 
+M: reader stream-read1 ( stream -- string )
+    1 over wait-to-read reader-line first ;
+
 ! Writers
 
 : open-write ( path -- fd )

library/unix/sockets.factor

@@ -7,6 +7,9 @@ IN: io-internals
 USING: errors namespaces streams threads unparser alien generic
 kernel math unix-internals ;
 
+: <socket-stream> ( fd -- stream )
+    dup f <fd-stream> ;
+
 : init-sockaddr ( port -- sockaddr )
     <sockaddr-in>
     [ AF_INET swap set-sockaddr-in-family ] keep
@@ -105,9 +108,6 @@ M: accept-task task-container drop read-tasks get ;
 : wait-to-accept ( server -- )
     [ swap <accept-task> add-io-task stop ] callcc0 drop ;
 
-: <socket-stream> ( fd -- stream )
-    dup f <fd-stream> ;
-
 : timeout-opt ( fd level opt value -- )
     "timeval" c-size setsockopt io-error ;
 

native/io.c

@@ -64,6 +64,16 @@ void primitive_fgets(void)
 		dpush(tag_object(from_c_string(line)));
 }
 
+void primitive_fgetc(void)
+{
+	FILE* file = (FILE*)unbox_alien();
+	int c = fgetc(file);
+	if(c == EOF)
+		dpush(F);
+	else
+		dpush(tag_fixnum(c));
+}
+
 void primitive_fwrite(void)
 {
 	FILE* file;

native/io.h

@@ -6,3 +6,4 @@ void primitive_fwrite(void);
 void primitive_fflush(void);
 void primitive_fclose(void);
 void primitive_fgets(void);
+void primitive_fgetc(void);

native/primitives.c

@@ -170,6 +170,7 @@ void* primitives[] = {
 	primitive_flush_icache,
 	primitive_fopen,
 	primitive_fgets,
+	primitive_fgetc,
 	primitive_fwrite,
 	primitive_fflush,
 	primitive_fclose