Add stream-element-type generic word

basis/io/ports/ports.factor

@@ -27,6 +27,8 @@ TUPLE: buffered-port < port { buffer buffer } ;
 
 TUPLE: input-port < buffered-port ;
 
+M: input-port stream-element-type drop +byte+ ;
+
 : <input-port> ( handle -- input-port )
     input-port <buffered-port> ;
 
@@ -102,6 +104,8 @@ TUPLE: output-port < buffered-port ;
     [ nip ] [ buffer>> buffer-capacity <= ] 2bi
     [ drop ] [ stream-flush ] if ; inline
 
+M: output-port stream-element-type stream>> stream-element-type ;
+
 M: output-port stream-write1
     dup check-disposed
     1 over wait-to-write

basis/io/streams/byte-array/byte-array.factor

@@ -5,6 +5,8 @@ sequences io namespaces io.encodings.private accessors sequences.private
 io.streams.sequence destructors math combinators ;
 IN: io.streams.byte-array
 
+M: byte-vector stream-element-type drop +byte+ ;
+
 : <byte-writer> ( encoding -- stream )
     512 <byte-vector> swap <encoder> ;
 
@@ -14,6 +16,8 @@ IN: io.streams.byte-array
 
 TUPLE: byte-reader { underlying byte-array read-only } { i array-capacity } ;
 
+M: byte-reader stream-element-type drop +byte+ ;
+
 M: byte-reader stream-read-partial stream-read ;
 M: byte-reader stream-read sequence-read ;
 M: byte-reader stream-read1 sequence-read1 ;

basis/io/streams/duplex/duplex.factor

@@ -15,6 +15,11 @@ CONSULT: formatted-output-stream-protocol duplex-stream out>> ;
 
 : >duplex-stream< ( stream -- in out ) [ in>> ] [ out>> ] bi ; inline
 
+M: duplex-stream stream-element-type
+    [ in>> ] [ out>> ] bi
+    [ stream-element-type ] bi@
+    2dup eq? [ drop ] [ "Cannot determine element type" throw ] if ;
+
 M: duplex-stream set-timeout
     >duplex-stream< [ set-timeout ] bi-curry@ bi ;
 

basis/io/streams/memory/memory.factor

@@ -8,6 +8,8 @@ TUPLE: memory-stream alien index ;
 : <memory-stream> ( alien -- stream )
     0 memory-stream boa ;
 
+M: memory-stream stream-element-type drop +byte+ ;
+
 M: memory-stream stream-read1
     [ [ alien>> ] [ index>> ] bi alien-unsigned-1 ]
     [ [ 1+ ] change-index drop ] bi ;

basis/io/streams/string/string.factor

@@ -5,41 +5,33 @@ strings generic splitting continuations destructors sequences.private
 io.streams.plain io.encodings math.order growable io.streams.sequence ;
 IN: io.streams.string
 
-<PRIVATE
-
-SINGLETON: null-encoding
-
-M: null-encoding decode-char drop stream-read1 ;
-
-PRIVATE>
-
-M: growable dispose drop ;
-
-M: growable stream-write1 push ;
-M: growable stream-write push-all ;
-M: growable stream-flush drop ;
-
-: <string-writer> ( -- stream )
-    512 <sbuf> ;
-
-: with-string-writer ( quot -- str )
-    <string-writer> swap [ output-stream get ] compose with-output-stream*
-    >string ; inline
-
-! New implementation
-
+! Readers
 TUPLE: string-reader { underlying string read-only } { i array-capacity } ;
 
+M: string-reader stream-element-type drop +character+ ;
 M: string-reader stream-read-partial stream-read ;
 M: string-reader stream-read sequence-read ;
 M: string-reader stream-read1 sequence-read1 ;
 M: string-reader stream-read-until sequence-read-until ;
 M: string-reader dispose drop ;
 
+<PRIVATE
+SINGLETON: null-encoding
+M: null-encoding decode-char drop stream-read1 ;
+PRIVATE>
+
 : <string-reader> ( str -- stream )
     0 string-reader boa null-encoding <decoder> ;
 
 : with-string-reader ( str quot -- )
     [ <string-reader> ] dip with-input-stream ; inline
 
-INSTANCE: growable plain-writer
+! Writers
+M: sbuf stream-element-type drop +character+ ;
+
+: <string-writer> ( -- stream )
+    512 <sbuf> ;
+
+: with-string-writer ( quot -- str )
+    <string-writer> swap [ output-stream get ] compose with-output-stream*
+    >string ; inline

basis/io/styles/styles.factor

@@ -48,6 +48,8 @@ CONSULT: output-stream-protocol filter-writer stream>> ;
 
 CONSULT: formatted-output-stream-protocol filter-writer stream>> ;
 
+M: filter-writer stream-element-type stream>> stream-element-type ;
+
 M: filter-writer dispose stream>> dispose ;
 
 TUPLE: ignore-close-stream < filter-writer ;

basis/ui/gadgets/panes/panes.factor

@@ -21,6 +21,8 @@ TUPLE: pane-stream pane ;
 
 C: <pane-stream> pane-stream
 
+M: pane-stream stream-element-type drop +character+ ;
+
 <PRIVATE
 
 : clear-selection ( pane -- pane )

basis/ui/tools/listener/listener.factor

@@ -84,6 +84,8 @@ M: interactor model-changed
         [ 2drop ] [ [ value>> ] dip show-summary ] if
     ] [ call-next-method ] if ;
 
+M: interactor stream-element-type drop +character+ ;
+
 GENERIC: (print-input) ( object -- )
 
 M: input (print-input)

core/io/encodings/encodings.factor

@@ -47,6 +47,9 @@ M: object <decoder> f decoder boa ;
         ] when
     ] when nip ; inline
 
+M: decoder stream-element-type
+    drop +character+ ;
+
 M: decoder stream-read1
     dup >decoder< decode-char fix-read1 ;
 
@@ -121,6 +124,9 @@ M: object <encoder> encoder boa ;
 : >encoder< ( encoder -- stream encoding )
     [ stream>> ] [ code>> ] bi ; inline
 
+M: encoder stream-element-type
+    drop +character+ ;
+
 M: encoder stream-write1
     >encoder< encode-char ;
 

core/io/io-docs.factor

@@ -2,6 +2,24 @@ USING: help.markup help.syntax quotations hashtables kernel
 classes strings continuations destructors math byte-arrays ;
 IN: io
 
+HELP: +byte+
+{ $description "A stream element type. See " { $link stream-element-type } " for explanation." } ;
+
+HELP: +character+
+{ $description "A stream element type. See " { $link stream-element-type } " for explanation." } ;
+
+HELP: stream-element-type
+{ $values { "stream" "a stream" } { "type" { $link +byte+ } " or " { $link +character+ } } }
+{ $description
+  "Outputs one of the following two values:"
+  { $list
+    { { $link +byte+ } " - indicates that stream elements are integers in the range " { $snippet "[0,255]" } "; they represent bytes. Reading a sequence of elements produces a " { $link byte-array } "." }
+    { { $link +character+ } " - indicates that stream elements are non-negative integers, representing Unicode code points. Reading a sequence of elements produces a " { $link string } "." }
+  }
+  "Most external streams are binary streams, and can be wrapped in string streams once a suitable encoding has been provided; see " { $link "io.encodings" } "."
+  
+} ;
+
 HELP: stream-readln
 { $values { "stream" "an input stream" } { "str/f" "a string or " { $link f } } }
 { $contract "Reads a line of input from the stream. Outputs " { $link f } " on stream exhaustion." }
@@ -68,7 +86,6 @@ HELP: stream-copy
 { $description "Copies the contents of one stream into another, closing both streams when done." } 
 $io-error ;
 
-
 HELP: stream-seek
 { $values
      { "n" integer } { "seek-type" "a seek singleton" } { "stream" "a stream" }
@@ -228,6 +245,8 @@ $nl
 $nl
 "All streams must implement the " { $link dispose } " word in addition to the stream protocol."
 $nl
+"The following word is required for all input and output streams:"
+{ $subsection stream-element-type }
 "These words are required for binary and string input streams:"
 { $subsection stream-read1 }
 { $subsection stream-read }
@@ -337,17 +356,9 @@ $nl
 "Copying the contents of one stream to another:"
 { $subsection stream-copy } ;
 
-ARTICLE: "stream-elements" "Stream elements"
-"There are two types of streams:"
-{ $list
-  { { $strong "Binary streams" } " - the elements are integers between 0 and 255, inclusive; they represent bytes. Reading a sequence of elements produces a " { $link byte-array } "." }
-  { { $strong "String streams" } " - the elements are non-negative integers, representing Unicode code points. Reading a sequence of elements produces a " { $link string } "." }
-}
-"Most external streams are binary streams, and can be wrapped in string streams once a suitable encoding has been provided; see " { $link "io.encodings" } "." ;
-
 ARTICLE: "streams" "Streams"
-"Input and output centers on the concept of a " { $emphasis "stream" } ", which is a source or sink of elements."
-{ $subsection "stream-elements" }
+"Input and output centers on the concept of a " { $emphasis "stream" } ", which is a source or sink of " { $emphasis "elements" } "."
+$nl
 "A stream can either be passed around on the stack or bound to a dynamic variable and used as one of the two implicit " { $emphasis "default streams" } "."
 { $subsection "stream-protocol" }
 { $subsection "stdio" }

core/io/io.factor

@@ -4,6 +4,10 @@ USING: hashtables generic kernel math namespaces make sequences
 continuations destructors assocs ;
 IN: io
 
+SYMBOLS: +byte+ +character+ ;
+
+GENERIC: stream-element-type ( stream -- type )
+
 GENERIC: stream-read1 ( stream -- elt )
 GENERIC: stream-read ( n stream -- seq )
 GENERIC: stream-read-until ( seps stream -- seq sep/f )

core/io/streams/c/c.factor

@@ -9,35 +9,27 @@ TUPLE: c-writer handle disposed ;
 
 : <c-writer> ( handle -- stream ) f c-writer boa ;
 
-M: c-writer stream-write1
-    dup check-disposed
-    handle>> fputc ;
+M: c-writer stream-element-type drop +byte+ ;
 
-M: c-writer stream-write
-    dup check-disposed
-    handle>> fwrite ;
+M: c-writer stream-write1 dup check-disposed handle>> fputc ;
 
-M: c-writer stream-flush
-    dup check-disposed
-    handle>> fflush ;
+M: c-writer stream-write dup check-disposed handle>> fwrite ;
 
-M: c-writer dispose*
-    handle>> fclose ;
+M: c-writer stream-flush dup check-disposed handle>> fflush ;
+
+M: c-writer dispose* handle>> fclose ;
 
 TUPLE: c-reader handle disposed ;
 
 : <c-reader> ( handle -- stream ) f c-reader boa ;
 
-M: c-reader stream-read
-    dup check-disposed
-    handle>> fread ;
+M: c-reader stream-element-type drop +byte+ ;
 
-M: c-reader stream-read-partial
-    stream-read ;
+M: c-reader stream-read dup check-disposed handle>> fread ;
 
-M: c-reader stream-read1
-    dup check-disposed
-    handle>> fgetc ;
+M: c-reader stream-read-partial stream-read ;
+
+M: c-reader stream-read1 dup check-disposed handle>> fgetc ;
 
 : read-until-loop ( stream delim -- ch )
     over stream-read1 dup [

core/io/streams/null/null.factor

@@ -9,11 +9,13 @@ INSTANCE: null-writer plain-writer
 
 M: null-stream dispose drop ;
 
+M: null-reader stream-element-type drop +byte+ ;
 M: null-reader stream-readln drop f ;
 M: null-reader stream-read1 drop f ;
 M: null-reader stream-read-until 2drop f f ;
 M: null-reader stream-read 2drop f ;
 
+M: null-writer stream-element-type drop +byte+ ;
 M: null-writer stream-write1 2drop ;
 M: null-writer stream-write 2drop ;
 M: null-writer stream-flush drop ;

core/io/streams/sequence/sequence.factor

@@ -1,8 +1,10 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences io kernel accessors math math.order ;
+USING: sequences io io.streams.plain kernel accessors math math.order
+growable destructors ;
 IN: io.streams.sequence
 
+! Readers
 SLOT: underlying
 SLOT: i
 
@@ -36,3 +38,12 @@ SLOT: i
 : sequence-read-until ( separators stream -- seq sep/f )
     [ find-sep ] keep
     [ sequence-read ] [ next ] bi swap ; inline
+
+! Writers
+M: growable dispose drop ;
+
+M: growable stream-write1 push ;
+M: growable stream-write push-all ;
+M: growable stream-flush drop ;
+
+INSTANCE: growable plain-writer