Merge branch 'master' of git://factorcode.org/git/factor

basis/help/handbook/handbook.factor

@@ -162,7 +162,8 @@ ARTICLE: "encodings-introduction" "An introduction to encodings"
 { $code "\"file.txt\" utf16 file-contents" }
 "Encoding descriptors are also used by " { $link "io.streams.byte-array" } " and taken by combinators like " { $link with-file-writer } " and " { $link with-byte-reader } " which deal with streams. It is " { $emphasis "not" } " used with " { $link "io.streams.string" } " because these deal with abstract text."
 $nl
-"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text." ;
+"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text."
+{ $see-also "stream-elements" } ;
 
 ARTICLE: "io" "Input and output"
 { $heading "Streams" }

basis/help/help-docs.factor

@@ -36,6 +36,7 @@ ARTICLE: "block-elements" "Block elements"
 "Elements used in " { $link $values } " forms:"
 { $subsection $instance }
 { $subsection $maybe }
+{ $subsection $or }
 { $subsection $quotation }
 "Boilerplate paragraphs:"
 { $subsection $low-level-note }
@@ -88,6 +89,12 @@ $nl
     { "an array of markup elements," }
     { "or an array of the form " { $snippet "{ $directive content... }" } ", where " { $snippet "$directive" } " is a markup word whose name starts with " { $snippet "$" } ", and " { $snippet "content..." } " is a series of markup elements" }
 }
+"Here is a more formal schema for the help markup language:"
+{ $code
+"<element> ::== <string> | <simple-element> | <fancy-element>"
+"<simple-element> ::== { <element>* }"
+"<fancy-element> ::== { <type> <element> }"
+}
 { $subsection "element-types" }
 { $subsection "printing-elements" }
 "Related words can be cross-referenced:"
@@ -119,7 +126,7 @@ ARTICLE: "help" "Help system"
 "The help system maintains documentation written in a simple markup language, along with cross-referencing and search. Documentation can either exist as free-standing " { $emphasis "articles" } " or be associated with words."
 { $subsection "browsing-help" }
 { $subsection "writing-help" }
-{ $vocab-subsection "Help lint tool" "help.lint" }
+{ $subsection "help.lint" }
 { $subsection "help-impl" } ;
 
 IN: help

basis/help/markup/markup.factor

@@ -1,19 +1,12 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions generic io kernel assocs
 hashtables namespaces make parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots
-vocabs help.stylesheet help.topics vocabs.loader quotations ;
+vocabs help.stylesheet help.topics vocabs.loader quotations
+combinators ;
 IN: help.markup
 
-! Simple markup language.
-
-! <element> ::== <string> | <simple-element> | <fancy-element>
-! <simple-element> ::== { <element>* }
-! <fancy-element> ::== { <type> <element> }
-
-! Element types are words whose name begins with $.
-
 PREDICATE: simple-element < array
     [ t ] [ first word? not ] if-empty ;
 
@@ -250,8 +243,21 @@ M: f ($instance)
 
 : $instance ( element -- ) first ($instance) ;
 
+: $or ( element -- )
+    dup length {
+        { 1 [ first ($instance) ] }
+        { 2 [ first2 [ ($instance) " or " print-element ] [ ($instance) ] bi ] }
+        [
+            drop
+            unclip-last
+            [ [ ($instance) ", " print-element ] each ]
+            [ "or " print-element ($instance) ]
+            bi*
+        ]
+    } case ;
+
 : $maybe ( element -- )
-    $instance " or " print-element { f } $instance ;
+    f suffix $or ;
 
 : $quotation ( element -- )
     { "a " { $link quotation } " with stack effect " } print-element

basis/http/client/client.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs kernel math math.parser namespaces make
 sequences strings splitting calendar continuations accessors vectors
@@ -10,6 +10,12 @@ io.streams.duplex fry ascii urls urls.encoding present
 http http.parsers ;
 IN: http.client
 
+ERROR: too-many-redirects ;
+
+CONSTANT: max-redirects 10
+
+<PRIVATE
+
 : write-request-line ( request -- request )
     dup
     [ method>> write bl ]
@@ -21,17 +27,29 @@ IN: http.client
     [ host>> ] [ port>> ] bi dup "http" protocol-port =
     [ drop ] [ ":" swap number>string 3append ] if ;
 
+: set-post-data-headers ( header post-data -- header )
+    [
+        data>> dup sequence?
+        [ length "content-length" ]
+        [ drop "chunked" "transfer-encoding" ] if
+        pick set-at
+    ] [ content-type>> "content-type" pick set-at ] bi ;
+
+: set-host-header ( request header -- request header )
+    over url>> url-host "host" pick set-at ;
+
+: set-cookie-header ( header cookies -- header )
+    unparse-cookie "cookie" pick set-at ;
+
 : write-request-header ( request -- request )
     dup header>> >hashtable
-    over url>> host>> [ over url>> url-host "host" pick set-at ] when
+    over url>> host>> [ set-host-header ] when
-    over post-data>> [
+    over post-data>> [ set-post-data-headers ] when*
-        [ data>> length "content-length" pick set-at ]
+    over cookies>> [ set-cookie-header ] unless-empty
-        [ content-type>> "content-type" pick set-at ]
-        bi
-    ] when*
-    over cookies>> [ unparse-cookie "cookie" pick set-at ] unless-empty
     write-header ;
 
+PRIVATE>
+
 GENERIC: >post-data ( object -- post-data )
 
 M: f >post-data ;
@@ -51,6 +69,8 @@ M: object >post-data
     "application/octet-stream" <post-data>
         swap >>data ;
 
+<PRIVATE
+    
 : normalize-post-data ( request -- request )
     dup post-data>> [
         dup params>> [
@@ -62,10 +82,17 @@ M: object >post-data
     [ >post-data ] change-post-data
     normalize-post-data ;
 
+: write-chunk ( chunk -- )
+    [ length >hex ";\r\n" append ascii encode write ] [ write ] bi ;
+
+: write-chunked ( stream -- )
+    [ [ write-chunk ] each-block ] with-input-stream
+    "0;\r\n" ascii encode write ;
+
 : write-post-data ( request -- request )
     dup method>> { "POST" "PUT" } member?  [
         dup post-data>> data>> dup sequence?
-        [ write ] [ output-stream get stream-copy ] if
+        [ write ] [ write-chunked ] if
     ] when ;
 
 : write-request ( request -- )
@@ -95,12 +122,6 @@ M: object >post-data
     read-response-line
     read-response-header ;
 
-: max-redirects 10 ;
-
-ERROR: too-many-redirects ;
-
-<PRIVATE
-
 DEFER: (with-http-request)
 
 SYMBOL: redirects
@@ -130,15 +151,10 @@ SYMBOL: redirects
         read-crlf B{ } assert= read-chunked
     ] if ; inline recursive
 
-: read-unchunked ( quot: ( chunk -- ) -- )
-    8192 read-partial dup [
-        [ swap call ] [ drop read-unchunked ] 2bi
-    ] [ 2drop ] if ; inline recursive
-
 : read-response-body ( quot response -- )
     binary decode-input
     "transfer-encoding" header "chunked" =
-    [ read-chunked ] [ read-unchunked ] if ; inline
+    [ read-chunked ] [ each-block ] if ; inline
 
 : <request-socket> ( -- stream )
     request get url>> url-addr ascii <client> drop
@@ -166,6 +182,11 @@ SYMBOL: redirects
         [ do-redirect ] [ nip ] if
     ] with-variable ; inline recursive
 
+: <client-request> ( url method -- request )
+    <request>
+        swap >>method
+        swap >url ensure-port >>url ; inline
+
 PRIVATE>
 
 : success? ( code -- ? ) 200 299 between? ;
@@ -183,9 +204,7 @@ ERROR: download-failed response ;
     over content-charset>> decode ;
 
 : <get-request> ( url -- request )
-    <request>
+    "GET" <client-request> ;
-        "GET" >>method
-        swap >url ensure-port >>url ;
 
 : http-get ( url -- response data )
     <get-request> http-request ;
@@ -203,14 +222,19 @@ ERROR: download-failed response ;
     dup download-name download-to ;
 
 : <post-request> ( post-data url -- request )
-    <request>
+    "POST" <client-request>
-        "POST" >>method
-        swap >url ensure-port >>url
         swap >>post-data ;
 
 : http-post ( post-data url -- response data )
     <post-request> http-request ;
 
+: <put-request> ( post-data url -- request )
+    "PUT" <client-request>
+        swap >>post-data ;
+
+: http-put ( post-data url -- response data )
+    <put-request> http-request ;
+
 USING: vocabs vocabs.loader ;
 
 "debugger" vocab [ "http.client.debugger" require ] when

basis/http/http-tests.factor

@@ -1,4 +1,4 @@
-USING: http http.server http.client tools.test multiline
+USING: http http.server http.client http.client.private tools.test multiline
 io.streams.string io.encodings.utf8 io.encodings.8-bit
 io.encodings.binary io.encodings.string kernel arrays splitting
 sequences assocs io.sockets db db.sqlite continuations urls

basis/http/server/cgi/cgi.factor

@@ -55,7 +55,7 @@ IN: http.server.cgi
         binary encode-output
         _ output-stream get swap <cgi-process> binary <process-stream> [
             post-request? [ request get post-data>> data>> write flush ] when
-            input-stream get swap (stream-copy)
+            '[ _ write ] each-block
         ] with-stream
     ] >>body ;
 

basis/http/server/server.factor

@@ -26,8 +26,6 @@ html.elements
 html.streams ;
 IN: http.server
 
-\ parse-cookie DEBUG add-input-logging
-
 : check-absolute ( url -- url )
     dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
 

basis/io/directories/directories-docs.factor

@@ -166,6 +166,7 @@ ARTICLE: "io.directories" "Directory manipulation"
 { $subsection "current-directory" }
 { $subsection "io.directories.listing" }
 { $subsection "io.directories.create" }
-{ $subsection "delete-move-copy" } ;
+{ $subsection "delete-move-copy" }
+{ $subsection "io.directories.hierarchy" } ;
 
 ABOUT: "io.directories"

core/io/encodings/encodings-docs.factor

@@ -74,7 +74,7 @@ HELP: replacement-char
 { $description "A code point that replaces input that could not be decoded. The presence of this character in the decoded data usually signifies an error." } ;
 
 ARTICLE: "encodings-descriptors" "Encoding descriptors"
-"An encoding descriptor is something which can be used for input or output streams to encode or decode bytes stored in a certain representation. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
+"An encoding descriptor is something which can be used with binary input or output streams to encode or decode bytes stored in a certain representation. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
 { $subsection "io.encodings.binary" }
 { $subsection "io.encodings.utf8" }
 { $subsection "io.encodings.utf16" }
@@ -99,7 +99,13 @@ ARTICLE: "encodings-constructors" "Manually constructing an encoded stream"
 { $subsection <decoder> } ;
 
 ARTICLE: "io.encodings" "I/O encodings"
-"The " { $vocab-link "io.encodings" } " vocabulary provides utilities for encoding and decoding bytes that represent text. Both strings and streams may be encoded."
+"The " { $vocab-link "io.encodings" } " vocabulary provides utilities for encoding and decoding bytes that represent text. Encodings can be used in the following situations:"
+{ $list
+  "With binary input streams, to convert bytes to characters"
+  "With binary output streams, to convert characters to bytes"
+  "With byte arrays, to convert bytes to characters"
+  "With strings, to convert characters to bytes"
+}
 { $subsection "encodings-descriptors" }
 { $subsection "encodings-constructors" }
 { $subsection "io.encodings.string" }
@@ -113,6 +119,7 @@ ARTICLE: "io.encodings" "I/O encodings"
 { $subsection re-decode }
 "Combinators to change the encoding:"
 { $subsection with-encoded-output }
-{ $subsection with-decoded-input } ;
+{ $subsection with-decoded-input }
+{ $see-also "encodings-introduction" "stream-elements" } ;
 
 ABOUT: "io.encodings"

core/io/io-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax quotations hashtables kernel
-classes strings continuations destructors math ;
+classes strings continuations destructors math byte-arrays ;
 IN: io
 
 HELP: stream-readln
@@ -9,38 +9,38 @@ HELP: stream-readln
 $io-error ;
 
 HELP: stream-read1
-{ $values { "stream" "an input stream" } { "ch/f" "a character or " { $link f } } }
+{ $values { "stream" "an input stream" } { "elt" "an element or " { $link f } } }
-{ $contract "Reads a character of input from the stream. Outputs " { $link f } " on stream exhaustion." }
+{ $contract "Reads an element from the stream. Outputs " { $link f } " on stream exhaustion." }
 { $notes "Most code only works on one stream at a time and should instead use " { $link read1 } "; see " { $link "stdio" } "." }
 $io-error ;
 
 HELP: stream-read
-{ $values { "n" "a non-negative integer" } { "stream" "an input stream" } { "str/f" "a string or " { $link f } } }
+{ $values { "n" "a non-negative integer" } { "stream" "an input stream" } { "seq" { $or byte-array string f } } }
-{ $contract "Reads " { $snippet "n" } " characters of input from the stream. Outputs a truncated string or " { $link f } " on stream exhaustion." }
+{ $contract "Reads " { $snippet "n" } " elements from the stream. Outputs a truncated string or " { $link f } " on stream exhaustion." }
 { $notes "Most code only works on one stream at a time and should instead use " { $link read } "; see " { $link "stdio" } "." }
 $io-error ;
 
 HELP: stream-read-until
-{ $values { "seps" string } { "stream" "an input stream" } { "str/f" "a string or " { $link f } } { "sep/f" "a character or " { $link f } } }
+{ $values { "seps" string } { "stream" "an input stream" } { "seq" { $or byte-array string f } } { "sep/f" "a character or " { $link f } } }
-{ $contract "Reads characters from the stream, until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." }
+{ $contract "Reads elements from the stream, until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." }
 { $notes "Most code only works on one stream at a time and should instead use " { $link read-until } "; see " { $link "stdio" } "." }
 $io-error ;
 
 HELP: stream-read-partial
 { $values
-     { "n" integer } { "stream" "an input stream" }
+     { "n" "a non-negative integer" } { "stream" "an input stream" }
-     { "str/f" "a string or " { $link f } } }
+     { "seq" { $or byte-array string f } } }
-{ $description "Reads at most " { $snippet "n" } " characters from a stream and returns up to that many characters without blocking. If no characters are available, blocks until some are and returns them." } ;
+{ $description "Reads at most " { $snippet "n" } " elements from a stream and returns up to that many characters without blocking. If no characters are available, blocks until some are and returns them." } ;
 
 HELP: stream-write1
-{ $values { "ch" "a character" } { "stream" "an output stream" } }
+{ $values { "elt" "an element" } { "stream" "an output stream" } }
-{ $contract "Writes a character of output to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
+{ $contract "Writes an element to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
 { $notes "Most code only works on one stream at a time and should instead use " { $link write1 } "; see " { $link "stdio" } "." }
 $io-error ;
 
 HELP: stream-write
-{ $values { "str" string } { "stream" "an output stream" } }
+{ $values { "seq" "a byte array or string" } { "stream" "an output stream" } }
-{ $contract "Writes a string of output to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
+{ $contract "Writes a sequence of elements to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
 { $notes "Most code only works on one stream at a time and should instead use " { $link write } "; see " { $link "stdio" } "." }
 $io-error ;
 
@@ -57,7 +57,6 @@ HELP: stream-nl
 { $notes "Most code only works on one stream at a time and should instead use " { $link nl } "; see " { $link "stdio" } "." }
 $io-error ;
 
-
 HELP: stream-print
 { $values { "str" string } { "stream" "an output stream" } }
 { $description "Writes a newline-terminated string." }
@@ -84,34 +83,32 @@ HELP: readln
 $io-error ;
 
 HELP: read1
-{ $values { "ch/f" "a character or " { $link f } } }
+{ $values { "elt" "an element or " { $link f } } }
-{ $description "Reads a character of input from " { $link input-stream } ". Outputs " { $link f } " on stream exhaustion." }
+{ $description "Reads an element from " { $link input-stream } ". Outputs " { $link f } " on stream exhaustion." }
 $io-error ;
 
 HELP: read
-{ $values { "n" "a non-negative integer" } { "str/f" "a string or " { $link f } } }
+{ $values { "n" "a non-negative integer" } { "seq" { $or byte-array string f } } }
-{ $description "Reads " { $snippet "n" } " characters of input from " { $link input-stream } ". Outputs a truncated string or " { $link f } " on stream exhaustion." }
+{ $description "Reads " { $snippet "n" } " elements from " { $link input-stream } ". If there is no input available, outputs " { $link f } ". If there are less than " { $snippet "n" } " elements available, outputs a sequence shorter than " { $snippet "n" } " in length." }
 $io-error ;
 
 HELP: read-until
-{ $values { "seps" string } { "str/f" "a string or " { $link f } } { "sep/f" "a character or " { $link f } } }
+{ $values { "seps" string } { "seq" { $or byte-array string f } } { "sep/f" "a character or " { $link f } } }
-{ $contract "Reads characters from " { $link input-stream } ". until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." }
+{ $contract "Reads elements from " { $link input-stream } ". until the first occurrence of a separator, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output. In the latter case, the entire stream contents are output, along with " { $link f } "." }
 $io-error ;
 
 HELP: read-partial
-{ $values
+{ $values { "n" integer } { "seq" { $or byte-array string f } } }
-     { "n" null }
+{ $description "Reads at most " { $snippet "n" } " elements from " { $link input-stream } " and returns them in a sequence. This word should be used instead of " { $link read } " when processing the entire element a chunk at a time, since on some stream implementations it may be slightly faster." } ;
-     { "str/f" null } }
-{ $description "Reads at most " { $snippet "n" } " characters from " { $link input-stream } " and returns up to that many characters without blocking. If no characters are available, blocks until some are and returns them." } ;
 
 HELP: write1
-{ $values { "ch" "a character" } }
+{ $values { "elt" "an element" } }
-{ $contract "Writes a character of output to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $contract "Writes an element to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 $io-error ;
 
 HELP: write
-{ $values { "str" string } }
+{ $values { "seq" { $or byte-array string f } } }
-{ $description "Writes a string of output to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes a sequence of elements to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 $io-error ;
 
 HELP: flush
@@ -123,7 +120,7 @@ HELP: nl
 $io-error ;
 
 HELP: print
-{ $values { "string" string } }
+{ $values { "str" string } }
 { $description "Writes a newline-terminated string to " { $link output-stream } "." }
 $io-error ;
 
@@ -170,9 +167,13 @@ HELP: each-line
 { $values { "quot" { $quotation "( str -- )" } } }
 { $description "Calls the quotation with successive lines of text, until the current " { $link input-stream } " is exhausted." } ;
 
+HELP: each-block
+{ $values { "quot" { $quotation "( block -- )" } } }
+{ $description "Calls the quotation with successive blocks of data, until the current " { $link input-stream } " is exhausted." } ;
+
 HELP: contents
-{ $values { "stream" "an input stream" } { "str" string } }
+{ $values { "stream" "an input stream" } { "seq" "a string, byte array or " { $link f } } }
-{ $description "Reads the entire contents of a stream into a string." }
+{ $description "Reads the entire contents of a stream. If the stream is empty, outputs"  { $link f } "." }
 $io-error ;
 
 ARTICLE: "stream-protocol" "Stream protocol"
@@ -182,20 +183,23 @@ $nl
 $nl
 "All streams must implement the " { $link dispose } " word in addition to the stream protocol."
 $nl
-"These words are required for input streams:"
+"These words are required for binary and string input streams:"
 { $subsection stream-read1 }
 { $subsection stream-read }
 { $subsection stream-read-until }
-{ $subsection stream-readln }
 { $subsection stream-read-partial }
-"These words are required for output streams:"
+"This word is only required for string input streams:"
+{ $subsection stream-readln }
+"These words are required for binary and string output streams:"
 { $subsection stream-flush }
 { $subsection stream-write1 }
 { $subsection stream-write }
+"This word is only required for string output streams:"
 { $subsection stream-nl }
+"For a discussion of the distinction between binary and string streams, see " { $link "stream-elements" } "."
 { $see-also "io.timeouts" } ;
 
-ARTICLE: "stdio" "Default input and output streams"
+ARTICLE: "stdio-motivation" "Motivation for default streams"
 "Most I/O code only operates on one stream at a time. The " { $link input-stream } " and " { $link output-stream } " variables are implicit parameters used by many I/O words. Using this idiom improves code in three ways:"
 { $list
     { "Code becomes simpler because there is no need to keep a stream around on the stack." }
@@ -230,7 +234,10 @@ ARTICLE: "stdio" "Default input and output streams"
     "\"data.txt\" utf8 ["
     "    readln number>string read 16 group"
     "] with-file-reader"
-}
+} ;
+
+ARTICLE: "stdio" "Default input and output streams"
+{ $subsection "stdio-motivation" }
 "The default input stream is stored in a dynamically-scoped variable:"
 { $subsection input-stream }
 "Unless rebound in a child namespace, this variable will be set to a console stream for reading input from the user."
@@ -239,8 +246,9 @@ $nl
 { $subsection read1 }
 { $subsection read }
 { $subsection read-until }
-{ $subsection readln }
 { $subsection read-partial }
+"If the default input stream is a string stream (" { $link "stream-elements" } "), lines of text can be read:"
+{ $subsection readln }
 "A pair of combinators for rebinding the " { $link input-stream } " variable:"
 { $subsection with-input-stream }
 { $subsection with-input-stream* }
@@ -252,6 +260,8 @@ $nl
 { $subsection flush }
 { $subsection write1 }
 { $subsection write }
+"If the default output stream is a string stream (" { $link "stream-elements" } "), lines of text can be written:"
+{ $subsection readln }
 { $subsection print }
 { $subsection nl }
 { $subsection bl }
@@ -268,17 +278,26 @@ $nl
 "First, a simple composition of " { $link stream-write } " and " { $link stream-nl } ":"
 { $subsection stream-print }
 "Processing lines one by one:"
-{ $subsection each-line }
-"Sluring an entire stream into memory all at once:"
 { $subsection lines }
+{ $subsection each-line }
+"Processing blocks of data:"
 { $subsection contents }
+{ $subsection each-block }
 "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 characters. Streams also support formatted output, which may be used to present styled text in a manner independent of output medium."
+"Input and output centers on the concept of a " { $emphasis "stream" } ", which is a source or sink of elements."
-$nl
+{ $subsection "stream-elements" }
-"A stream can either be passed around on the stack or bound to a dynamic variable and used as an implicit " { $emphasis "default stream" } "."
+"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" }
 { $subsection "stream-utils" }

core/io/io.factor

@@ -4,26 +4,18 @@ USING: hashtables generic kernel math namespaces make sequences
 continuations destructors assocs ;
 IN: io
 
+GENERIC: stream-read1 ( stream -- elt )
+GENERIC: stream-read ( n stream -- seq )
+GENERIC: stream-read-until ( seps stream -- seq sep/f )
+GENERIC: stream-read-partial ( n stream -- seq )
 GENERIC: stream-readln ( stream -- str/f )
-GENERIC: stream-read1 ( stream -- ch/f )
+
-GENERIC: stream-read ( n stream -- str/f )
+GENERIC: stream-write1 ( elt stream -- )
-GENERIC: stream-read-until ( seps stream -- str/f sep/f )
+GENERIC: stream-write ( seq stream -- )
-GENERIC: stream-read-partial ( n stream -- str/f )
-GENERIC: stream-write1 ( ch stream -- )
-GENERIC: stream-write ( str stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
-: stream-print ( str stream -- )
+: stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
-    [ stream-write ] keep stream-nl ;
-
-: (stream-copy) ( in out -- )
-    64 1024 * pick stream-read-partial
-    [ over stream-write (stream-copy) ] [ 2drop ] if* ;
-
-: stream-copy ( in out -- )
-    [ 2dup (stream-copy) ] [ dispose dispose ] [ ]
-    cleanup ;
 
 ! Default streams
 SYMBOL: input-stream
@@ -31,13 +23,13 @@ SYMBOL: output-stream
 SYMBOL: error-stream
 
 : readln ( -- str/f ) input-stream get stream-readln ;
-: read1 ( -- ch/f ) input-stream get stream-read1 ;
+: read1 ( -- elt ) input-stream get stream-read1 ;
-: read ( n -- str/f ) input-stream get stream-read ;
+: read ( n -- seq ) input-stream get stream-read ;
-: read-until ( seps -- str/f sep/f ) input-stream get stream-read-until ;
+: read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
-: read-partial ( n -- str/f ) input-stream get stream-read-partial ;
+: read-partial ( n -- seq ) input-stream get stream-read-partial ;
 
-: write1 ( ch -- ) output-stream get stream-write1 ;
+: write1 ( elt -- ) output-stream get stream-write1 ;
-: write ( str -- ) output-stream get stream-write ;
+: write ( seq -- ) output-stream get stream-write ;
 : flush ( -- ) output-stream get stream-flush ;
 
 : nl ( -- ) output-stream get stream-nl ;
@@ -62,17 +54,32 @@ SYMBOL: error-stream
     [ [ drop dispose dispose ] 3curry ] 3bi
     [ ] cleanup ; inline
 
-: print ( string -- ) output-stream get stream-print ;
+: print ( str -- ) output-stream get stream-print ;
 
 : bl ( -- ) " " write ;
 
 : lines ( stream -- seq )
     [ [ readln dup ] [ ] [ drop ] produce ] with-input-stream ;
 
-: each-line ( quot -- )
+<PRIVATE
-    [ [ readln dup ] ] dip [ drop ] while ; inline
 
-: contents ( stream -- str )
+: each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
+    [ dup ] compose swap [ drop ] while ; inline
+
+PRIVATE>
+
+: each-line ( quot -- )
+    [ readln ] each-morsel ; inline
+
+: contents ( stream -- seq )
     [
-        [ 65536 read dup ] [ ] [ drop ] produce concat f like
+        [ 65536 read-partial dup ]
+        [ ] [ drop ] produce concat f like
     ] with-input-stream ;
+
+: each-block ( quot: ( block -- ) -- )
+    [ 8192 read-partial ] each-morsel ; inline
+
+: stream-copy ( in out -- )
+    [ [ [ write ] each-block ] with-output-stream ]
+    curry with-input-stream ;