win32-stream-writer is now a <plain-writer>, removed crap, refactored crap

library/io/windows/stream.factor

@@ -19,10 +19,6 @@ SYMBOL: file-size
 SYMBOL: timeout
 SYMBOL: cutoff
 
-
-
-GENERIC: do-write
-
 : pending-error ( len/status -- len/status )
     dup [ win32-throw-error ] unless ;
 
@@ -39,35 +35,9 @@ GENERIC: do-write
 : update-timeout ( -- )
     timeout get [ millis + cutoff set ] when* ;
 
-: flush-output ( -- ) 
-    update-timeout [
-        stream get alloc-io-callback init-overlapped >r
-        handle get out-buffer get [ buffer@ ] keep buffer-length
-        f r> WriteFile [ handle-io-error ] unless stop
-    ] callcc1 pending-error
 
-    dup update-file-pointer
+! Read
-    out-buffer get [ buffer-consume ] keep 
+: fill-input ( -- )
-    buffer-length 0 > [ flush-output ] when ;
-
-! : maybe-flush-output ( buffer -- )
-: maybe-flush-output ( -- )
-    out-buffer get buffer-length 0 > [ flush-output ] when ;
-
-M: integer do-write
-    out-buffer get [ buffer-capacity zero? [ flush-output ] when ] keep
-    >r ch>string r> >buffer ;
-
-M: string do-write
-    dup length out-buffer get buffer-capacity <= [
-        out-buffer get >buffer
-    ] [
-        dup length out-buffer get buffer-size > [
-            dup length out-buffer get extend-buffer do-write
-        ] [ flush-output do-write ] if
-    ] if ;
-
-: fill-input ( -- ) 
     update-timeout [
         stream get alloc-io-callback init-overlapped >r
         handle get in-buffer get [ buffer@ ] keep 
@@ -78,29 +48,65 @@ M: string do-write
 
     dup in-buffer get n>buffer update-file-pointer ;
 
-: consume-input ( count -- str ) 
+: consume-input ( count buffer -- str ) 
-    in-buffer get buffer-length zero? [ fill-input ] when
+    dup buffer-length zero? [ fill-input ] when
-    in-buffer get buffer-size min
+    [ buffer-size min ] keep
-    dup in-buffer get buffer-first-n
+    [ buffer-first-n ] 2keep
-    swap in-buffer get buffer-consume ;
+    buffer-consume ;
 
 : >string-or-f ( sbuf -- str-or-? )
-    dup length 0 > [ >string ] [ drop f ] if ;
+    dup length zero? [ drop f ] [ >string ] if ;
 
-: do-read-count ( sbuf count -- str )
+: do-read-count ( buffer sbuf count -- str )
+    #! Keep reading until count is reached or until stream end (f is returned)
     dup zero? [ 
-        drop >string 
+        drop >string nip
     ] [
-        dup consume-input
+        pick dupd consume-input
-        dup length dup zero? [
+        dup empty? [
-            3drop >string-or-f
+            2drop >string-or-f nip
         ] [
-            >r swap r> - >r swap [ swap nappend ] keep r> do-read-count
+            rot [ nappend ] 2keep
+            >r length - r> swap do-read-count
         ] if
     ] if ;
 
 
 
+! Write
+
+: flush-output ( -- ) 
+    update-timeout [
+        stream get alloc-io-callback init-overlapped >r
+        handle get out-buffer get [ buffer@ ] keep buffer-length
+        f r> WriteFile [ handle-io-error ] unless stop
+    ] callcc1 pending-error
+    dup update-file-pointer
+    out-buffer get [ buffer-consume ] keep 
+    buffer-length 0 > [ flush-output ] when ;
+
+! : maybe-flush-output ( buffer -- )
+: maybe-flush-output ( -- )
+    out-buffer get buffer-length 0 > [ flush-output ] when ;
+
+GENERIC: do-write
+M: integer do-write ( integer -- )
+    out-buffer get [ buffer-capacity zero? [ flush-output ] when ] keep
+    >r ch>string r> >buffer ;
+
+M: string do-write ( string -- )
+    dup length out-buffer get buffer-capacity <= [
+        out-buffer get >buffer
+    ] [
+        dup length out-buffer get buffer-size > [
+            dup length out-buffer get extend-buffer do-write
+        ] [ flush-output do-write ] if
+    ] if ;
+
+
+
+
+
 
 
 
@@ -111,47 +117,38 @@ M: string do-write
     ;
 
 
-
-
-
-
-
-M: win32-stream stream-write ( str stream -- )
-    win32-stream-this [ do-write ] bind
-    ;
-
-M: win32-stream stream-write1 ( ch stream -- )
-    win32-stream-this [ >fixnum do-write ] bind ;
-
-M: win32-stream stream-read ( n stream -- str/f )
-    win32-stream-this [ dup <sbuf> swap do-read-count ] bind ;
-
-M: win32-stream stream-read1 ( stream -- ch/f )
-    win32-stream-this [
-        1 consume-input dup length zero? [ drop f ] when first 
-    ] bind ;
-
-M: win32-stream stream-readln ( stream -- str )
-    win32-stream-this [ readln ] bind ;
-    ! win32-stream-in-buffer readln ;
-
-M: win32-stream stream-terpri ( stream -- )
-    win32-stream-this [ CHAR: \n do-write ] bind ;
-
-M: win32-stream stream-flush ( stream -- )
-    win32-stream-this [ maybe-flush-output ] bind ;
-
 M: win32-stream stream-close ( stream -- )
     win32-stream-this [
         maybe-flush-output
         handle get CloseHandle drop 
         in-buffer get buffer-free 
         out-buffer get buffer-free
-    ] bind
+    ] bind ;
-    ;
+
+M: win32-stream stream-read1 ( stream -- ch/f )
+    win32-stream-this [
+        1 in-buffer get consume-input >string-or-f first
+    ] bind ;
+
+M: win32-stream stream-read ( n stream -- str/f )
+    win32-stream-this [ dup <sbuf> swap in-buffer get do-read-count ] bind ;
+
+M: win32-stream stream-read ( n stream -- str/f )
+    win32-stream-this [ dup <sbuf> swap in-buffer get do-read-count ] bind ;
+
+
+M: win32-stream stream-flush ( stream -- )
+    win32-stream-this [ maybe-flush-output ] bind ;
+
+M: win32-stream stream-write1 ( ch stream -- )
+    win32-stream-this [ >fixnum do-write ] bind ;
+
+M: win32-stream stream-write ( str stream -- )
+    win32-stream-this [ do-write ] bind ;
+
+
+
 
-M: win32-stream stream-format ( str style stream -- )
-    win32-stream-this [ drop do-write ] bind ;
 
 M: win32-stream set-timeout ( n stream -- )
     win32-stream-this [ timeout set ] bind ;
@@ -161,9 +158,6 @@ M: win32-stream expire ! not a generic
         timeout get [ millis cutoff get > [ handle get CancelIo ] when ] when
     ] bind ;
 
-M: win32-stream with-nested-stream ( quot style stream -- )
-    win32-stream-this [ drop stream get swap with-stream* ] bind ;
-
 : make-win32-stream ( handle -- stream )
     [
         dup f GetFileSize dup -1 = not [
@@ -187,5 +181,5 @@ M: win32-stream with-nested-stream ( quot style stream -- )
     t f win32-open-file make-win32-stream <line-reader> ;
 
 : <win32-file-writer> ( path -- stream )
-    f t win32-open-file make-win32-stream ;
+    f t win32-open-file make-win32-stream <plain-writer> ;