finish stream-write-attr/stream-write1 split

TODO.FACTOR.txt

@@ -65,7 +65,6 @@ Investigate:
 - nappend: instead of using push, enlarge the sequence with set-length
   then add set the elements with set-nth
 - specialized arrays
-- phase out sbuf-append
 
 + kernel:
 
@@ -89,7 +88,6 @@ Investigate:
 - reading and writing byte arrays
 - clean up line reading code in win32-io
 - unix io: handle \n\r and \n\0
-- separate words for writing characters and strings
 - stream server can hang because of exception handler limitations
 - better i/o scheduler
 - unify unparse and prettyprint

library/collections/namespaces.factor

@@ -109,13 +109,7 @@ SYMBOL: building
 
 : , ( obj -- )
     #! Add to the sequence being built with make-seq.
-    ! The behavior where a string can be passed is deprecated;
+    building get push ;
-    ! use % instead!
-    building get dup sbuf? [
-        over string? [ swap nappend ] [ push ] ifte
-    ] [
-        push
-    ] ifte ;
 
 : unique, ( obj -- )
     #! Add the object to the sequence being built with make-seq

library/io/buffer.factor

@@ -37,6 +37,8 @@ C: buffer ( size -- buffer )
 
 : buffer@ ( buffer -- int ) dup buffer-ptr swap buffer-pos + ;
 
+: buffer-end ( buffer -- int ) dup buffer-ptr swap buffer-fill + ;
+
 : buffer-first-n ( count buffer -- string )
     [ dup buffer-fill swap buffer-pos - min ] keep
     buffer@ swap memory>string ;
@@ -62,10 +64,10 @@ C: buffer ( size -- buffer )
     2dup buffer-ptr swap realloc check-ptr
     over set-buffer-ptr set-buffer-size ;
 
-: check-overflow ( string buffer -- )
+: check-overflow ( length buffer -- )
-    over length over buffer-capacity > [
+    2dup buffer-capacity > [
         dup eof? [
-            >r length r> buffer-extend
+            buffer-extend
         ] [
             "Buffer overflow" throw
         ] ifte
@@ -74,30 +76,21 @@ C: buffer ( size -- buffer )
     ] ifte ;
 
 : >buffer ( string buffer -- )
-    2dup check-overflow
+    over length over check-overflow
-    [ dup buffer-ptr swap buffer-fill + string>memory ] 2keep
+    [ buffer-end string>memory ] 2keep
     [ buffer-fill swap length + ] keep set-buffer-fill ;
 
+: ch>buffer ( char buffer -- )
+    1 over check-overflow
+    [ buffer-end <alien> 0 set-alien-unsigned-1 ] keep
+    [ buffer-fill 1 + ] keep set-buffer-fill ;
+
 : n>buffer ( count buffer -- )
     #! Increases the fill pointer by count.
     [ buffer-fill + ] keep set-buffer-fill ;
 
-: buffer-end ( buffer -- int ) dup buffer-ptr swap buffer-fill + ;
-
 : buffer-peek ( buffer -- char )
     buffer@ <alien> 0 alien-unsigned-1 ;
 
 : buffer-pop ( buffer -- char )
     [ buffer-peek  1 ] keep buffer-consume ;
-
-: buffer-append ( buffer buffer -- )
-    #! Append first buffer to second buffer.
-    2dup buffer-end over buffer-ptr rot buffer-fill memcpy
-    >r buffer-fill r> n>buffer ;
-
-: buffer-set ( string buffer -- )
-    2dup buffer-ptr string>memory
-    >r length r> buffer-reset ;
-
-: string>buffer ( string -- buffer )
-    dup length <buffer> tuck buffer-set ;

library/io/c-streams.factor

@@ -16,8 +16,7 @@ M: c-stream stream-write1 ( char stream -- )
     >r ch>string r> c-stream-out fwrite ;
 
 M: c-stream stream-write-attr ( str style stream -- )
-    nip >r dup string? [ ch>string ] unless r>
+    nip c-stream-out fwrite ;
-    c-stream-out fwrite ;
 
 M: c-stream stream-read1 ( stream -- str )
     c-stream-in dup [ fgetc ] when ;

library/io/string-streams.factor

@@ -2,10 +2,7 @@ USING: io kernel math namespaces sequences strings ;
 
 ! String buffers support the stream output protocol.
 M: sbuf stream-write1 push ;
-
+M: sbuf stream-write-attr rot nappend drop ;
-M: sbuf stream-write-attr
-    nip over string? [ swap nappend ] [ push ] ifte ;
-
 M: sbuf stream-close drop ;
 M: sbuf stream-flush drop ;
 M: sbuf stream-auto-flush drop ;

library/test/io/buffer.factor

@@ -1,5 +1,17 @@
 IN: temporary
-USING: kernel io-internals test ;
+USING: io-internals kernel kernel-internals sequences test ;
+
+: buffer-append ( buffer buffer -- )
+    #! Append first buffer to second buffer.
+    2dup buffer-end over buffer-ptr rot buffer-fill memcpy
+    >r buffer-fill r> n>buffer ;
+
+: buffer-set ( string buffer -- )
+    2dup buffer-ptr string>memory
+    >r length r> buffer-reset ;
+
+: string>buffer ( string -- buffer )
+    dup length <buffer> tuck buffer-set ;
 
 [ "" 65536 ] [
     65536 <buffer>

library/tools/jedit-wire.factor

@@ -38,20 +38,20 @@ prettyprint sequences io strings words styles ;
 ! 4 bytes -- length. -1 means EOF
 ! remaining -- input
 : jedit-write-attr ( str style -- )
-    CHAR: w write
+    CHAR: w write1
     [ drop . f . ] string-out
     dup write-len write ;
 
 TUPLE: jedit-stream ;
 
 M: jedit-stream stream-readln ( stream -- str )
-    [ CHAR: r write flush 4 read be> read ] with-wrapper ;
+    [ CHAR: r write1 flush 4 read be> read ] with-wrapper ;
 
 M: jedit-stream stream-write-attr ( str style stream -- )
     [ jedit-write-attr ] with-wrapper ;
 
 M: jedit-stream stream-flush ( stream -- )
-    [ CHAR: f write flush ] with-wrapper ;
+    [ CHAR: f write1 flush ] with-wrapper ;
 
 C: jedit-stream ( stream -- stream )
     [ >r <wrapper-stream> r> set-delegate ] keep ;

library/unix/io.factor

@@ -293,17 +293,11 @@ M: port stream-auto-flush ( stream -- ) drop ;
 : wait-to-write ( len port -- )
     tuck can-write? [ dup stream-flush ] unless pending-error ;
 
-: blocking-write1 ( str writer -- )
-    1 over wait-to-write >buffer ;
-
 M: port stream-write1 ( char writer -- )
-    nip >r dup string? [ ch>string ] unless r> blocking-write ;
+    1 over wait-to-write ch>buffer ;
-
-: blocking-write ( str writer -- )
-    over length over wait-to-write >buffer ;
 
 M: port stream-write-attr ( string style writer -- )
-    nip >r dup string? [ ch>string ] unless r> blocking-write ;
+    nip over length over wait-to-write >buffer ;
 
 M: port stream-close ( stream -- )
     dup stream-flush