diff --git a/contrib/httpd/responder.factor b/contrib/httpd/responder.factor index a665703571..7041f113a9 100644 --- a/contrib/httpd/responder.factor +++ b/contrib/httpd/responder.factor @@ -19,7 +19,7 @@ SYMBOL: responders : error-head ( error -- ) dup log-error - [ [[ "Content-Type" "text/html" ]] ] over response ; + H{ { "Content-Type" "text/html" } } over response ; : httpd-error ( error -- ) #! This must be run from handle-request diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 4969004907..1818551093 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -229,6 +229,15 @@ vectors words ; "/library/generic/slots.facts" "/library/generic/standard-combination.facts" "/library/generic/tuple.facts" + "/library/io/binary.facts" + "/library/io/buffer.facts" + "/library/io/c-streams.facts" + "/library/io/duplex-stream.facts" + "/library/io/files.facts" + "/library/io/lines.facts" + "/library/io/plain-stream.facts" + "/library/io/server.facts" + "/library/io/stdio.facts" "/library/math/arc-trig-hyp.facts" "/library/math/complex.facts" "/library/math/constants.facts" diff --git a/library/help/markup.factor b/library/help/markup.factor index 21f87be6ea..83f0cad2ea 100644 --- a/library/help/markup.factor +++ b/library/help/markup.factor @@ -193,3 +193,6 @@ DEFER: help : $values-x/y drop { { "x" "a complex number" } { "y" "a complex number" } } $values ; + +: $io-error + "Throws an error if the I/O operation fails." $errors ; diff --git a/library/io/binary.facts b/library/io/binary.facts new file mode 100644 index 0000000000..5c41aa19d5 --- /dev/null +++ b/library/io/binary.facts @@ -0,0 +1,21 @@ +USING: help io ; + +HELP: be> "( seq -- x )" +{ $values { "seq" "a sequence of bytes" } { "x" "a non-negative integer" } } +{ $description "Converts a sequence of bytes in big endian order into an unsigned integer." } ; + +HELP: le> "( seq -- x )" +{ $values { "seq" "a sequence of bytes" } { "x" "a non-negative integer" } } +{ $description "Converts a sequence of bytes in little endian order into an unsigned integer." } ; + +HELP: nth-byte "( x n -- b )" +{ $values { "x" "an integer" } { "n" "a non-negative integer" } { "b" "a byte" } } +{ $description "Outputs the " { $snippet "n" } "th least significant byte of the sign-extended 2's complement representation of " { $snippet "x" } "." } ; + +HELP: >le "( x n -- str )" +{ $values { "x" "an integer" } { "n" "a non-negative integer" } { "str" "a string" } } +{ $description "Converts an integer " { $snippet "x" } " into a string of " { $snippet "n" } " bytes in little endian order. Truncation will occur if the integer is not in the range " { $snippet "[-2^(8n),2^(8n))" } "." } ; + +HELP: >be "( x n -- str )" +{ $values { "x" "an integer" } { "n" "a non-negative integer" } { "str" "a string" } } +{ $description "Converts an integer " { $snippet "x" } " into a string of " { $snippet "n" } " bytes in big endian order. Truncation will occur if the integer is not in the range " { $snippet "[-2^(8n),2^(8n))" } "." } ; diff --git a/library/io/buffer.factor b/library/io/buffer.factor index ecd3e088dc..909229a78e 100644 --- a/library/io/buffer.factor +++ b/library/io/buffer.factor @@ -13,24 +13,20 @@ C: buffer ( size -- buffer ) 0 over set-buffer-pos ; : buffer-free ( buffer -- ) - #! Frees the C memory associated with the buffer. dup buffer-ptr free 0 swap set-buffer-ptr ; : buffer-contents ( buffer -- string ) - #! Returns the current contents of the buffer. dup buffer-ptr over buffer-pos + over buffer-fill rot buffer-pos - memory>string ; : buffer-reset ( count buffer -- ) - #! Reset the position to 0 and the fill pointer to count. [ set-buffer-fill ] keep 0 swap set-buffer-pos ; : buffer-consume ( count buffer -- ) - #! Consume count characters from the beginning of the buffer. [ buffer-pos + ] keep [ buffer-fill min ] keep [ set-buffer-pos ] keep - dup buffer-pos over buffer-fill = [ + dup buffer-pos over buffer-fill >= [ 0 over set-buffer-pos 0 over set-buffer-fill ] when drop ; @@ -50,7 +46,6 @@ C: buffer ( size -- buffer ) [ buffer-contents ] keep 0 swap buffer-reset ; : buffer-length ( buffer -- length ) - #! Returns the amount of unconsumed input in the buffer. dup buffer-fill swap buffer-pos - ; : buffer-capacity ( buffer -- int ) @@ -64,13 +59,12 @@ C: buffer ( size -- buffer ) 2dup buffer-ptr swap realloc check-ptr over set-buffer-ptr set-buffer-size ; +: buffer-overflow ( ? quot -- ) + [ "Buffer overflow" throw ] if ; inline + : check-overflow ( length buffer -- ) 2dup buffer-capacity > [ - dup buffer-empty? [ - buffer-extend - ] [ - "Buffer overflow" throw - ] if + dup buffer-empty? [ buffer-extend ] buffer-overflow ] [ 2drop ] if ; @@ -85,9 +79,13 @@ C: buffer ( size -- buffer ) [ buffer-end f swap set-alien-unsigned-1 ] keep [ buffer-fill 1+ ] keep set-buffer-fill ; +: buffer-bound ( buffer -- n ) + dup buffer-ptr swap buffer-size + ; + : n>buffer ( count buffer -- ) - #! Increases the fill pointer by count. - [ buffer-fill + ] keep set-buffer-fill ; + [ buffer-fill + ] keep + [ buffer-bound <= [ ] buffer-overflow ] keep + set-buffer-fill ; : buffer-peek ( buffer -- char ) buffer@ f swap alien-unsigned-1 ; diff --git a/library/io/buffer.facts b/library/io/buffer.facts new file mode 100644 index 0000000000..16d54bafd6 --- /dev/null +++ b/library/io/buffer.facts @@ -0,0 +1,96 @@ +USING: help io-internals ; + +HELP: buffer f +{ $description "The class of I/O buffers, which are allocated in the system malloc arena, and thus have a fixed address, unlike garbage-collected heap objects which are moved around. Buffers must be de-allocated manually." +$terpri +"Buffers have two internal pointers:" +{ $list + { "the fill pointer -- a write index where new data is added; accessor: " { $link buffer-fill } } + { "the position -- a read index where data is consumed; accessor: " { $link buffer-pos } } +} } ; + +HELP: "( n -- buffer )" +{ $values { "n" "a non-negative integer" } { "buffer" "a buffer" } } +{ $description "Creates a buffer with an initial capacity of " { $snippet "n" } " bytes." } ; + +HELP: buffer-free "( buffer -- )" +{ $values { "buffer" "a buffer" } } +{ $description "De-allocates a buffer's underlying storage. The buffer may not be used after being freed." } +{ $warning "You " { $emphasis "must" } " free a buffer using this word, before letting the GC collect the buffer tuple instance." } ; + +HELP: buffer-contents "( buffer -- string )" +{ $values { "buffer" "a buffer" } { "string" "a string" } } +{ $description "Collects the entire contents of the buffer into a string." } ; + +HELP: buffer-reset "( n buffer -- )" +{ $values { "n" "a non-negative integer" } { "buffer" "a buffer" } } +{ $description "Resets the fill pointer to 0 and the position to " { $snippet "count" } "." } ; + +HELP: buffer-consume "( n buffer -- )" +{ $values { "n" "a non-negative integer" } { "buffer" "a buffer" } } +{ $description "Moves the position forward by " { $snippet "n" } " bytes. If it exceeds the fill pointer, both are reset to 0." } ; + +HELP: buffer@ "( buffer -- n )" +{ $values { "buffer" "a buffer" } { "n" "a non-negative integer" } } +{ $description "Outputs the memory address of the current buffer position." } ; + +HELP: buffer-end "( buffer -- n )" +{ $values { "buffer" "a buffer" } { "n" "a non-negative integer" } } +{ $description "Outputs the memory address of the current fill-pointer." } ; + +HELP: buffer-first-n "( n buffer -- string )" +{ $values { "n" "a non-negative integer" } { "buffer" "a buffer" } } +{ $description "Outputs a string of the first " { $snippet "n" } " characters at the buffer's current position. If there are less than " { $snippet "n" } " characters available, the output is truncated." } +{ $see-also buffer> } ; + +HELP: buffer> "( n buffer -- string )" +{ $values { "n" "a non-negative integer" } { "buffer" "a buffer" } { "string" "a string" } } +{ $description "Collects a string of " { $snippet "n" } " characters starting from the buffer's current position, and advances the position accordingly. If there are less than " { $snippet "n" } " characters available, the output is truncated." } ; + +HELP: buffer>> "( buffer -- string )" +{ $values { "buffer" "a buffer" } { "string" "a string" } } +{ $description "Collects the contents of the buffer into a string, and resets the position and fill pointer to 0." } ; + +HELP: buffer-length "( buffer -- n )" +{ $values { "buffer" "a buffer" } { "n" "a non-negative integer" } } +{ $description "Outputs the number of unconsumed bytes in the buffer." } ; + +HELP: buffer-capacity "( buffer -- n )" +{ $values { "buffer" "a buffer" } { "n" "a non-negative integer" } } +{ $description "Outputs the buffer's maximum capacity before growing." } ; + +HELP: buffer-empty? "( buffer -- ? )" +{ $values { "buffer" "a buffer" } { "?" "a boolean" } } +{ $description "Tests if the buffer contains no more data to be read." } ; + +HELP: buffer-extend "( n buffer -- )" +{ $values { "n" "a non-negative integer" } { "buffer" "a buffer" } } +{ $description "Grows a buffer to fit " { $snippet "n" } " bytes of data." } ; + +HELP: check-overflow "( n buffer -- )" +{ $values { "n" "a non-negative integer" } { "buffer" "a buffer" } } +{ $description "Grows the buffer, if possible, so it can accomodate " { $snippet "n" } " bytes." } +{ $warning "I/O system implementations should call this word or one of the other words that calls this word, at the beginning of an I/O transaction, when the buffer is empty. Buffers cannot be resized if they contain data; one of the requirements of a buffer is to remain fixed in memory while I/O operations are in progress." } +{ $errors "Throws an error if the buffer contains unread data, and the new data does not fit." } ; + +HELP: >buffer "( string buffer -- )" +{ $values { "string" "a string" } { "buffer" "a buffer" } } +{ $description "Copies a string to the buffer's fill pointer, and advances it accordingly." } ; + +HELP: ch>buffer "( ch buffer -- )" +{ $values { "ch" "a character" } { "buffer" "a buffer" } } +{ $description "Appends a single byte to a buffer." } ; + +HELP: n>buffer "( n buffer -- )" +{ $values { "n" "a non-negative integer" } { "buffer" "a buffer" } } +{ $description "Advances the fill pointer by " { $snippet "n" } " bytes." } +{ $errors "Throws an error if the buffer does not contain " { $snippet "n" } " bytes of data." } ; + +HELP: buffer-peek "( buffer -- ch )" +{ $values { "buffer" "a buffer" } { "ch" "a character" } } +{ $description "Outputs the byte at the buffer position." } +{ $see-also buffer-pop } ; + +HELP: buffer-pop "( buffer -- ch )" +{ $values { "buffer" "a buffer" } { "ch" "a character" } } +{ $description "Outputs the byte at the buffer position and advances the position." } ; diff --git a/library/io/c-streams.factor b/library/io/c-streams.factor index b9696eed1b..5e51132b0d 100644 --- a/library/io/c-streams.factor +++ b/library/io/c-streams.factor @@ -1,5 +1,5 @@ ! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! See http://factorcode.org/license.txt for BSD license. IN: io-internals USING: errors kernel kernel-internals namespaces io strings ; diff --git a/library/io/c-streams.facts b/library/io/c-streams.facts new file mode 100644 index 0000000000..1b0eeaf483 --- /dev/null +++ b/library/io/c-streams.facts @@ -0,0 +1,40 @@ +USING: help io io-internals threads ; + +HELP: io-multiplex "( ms -- )" +{ $values { "ms" "a non-negative integer" } } +{ $description "Waits up to " { $snippet "ms" } " milliseconds for pending I/O requests to complete." } +{ $warning "If an I/O request completes during the time period, its continuation is resumed and the current one is not saved. If you need to delay execution for a period of time, use the higher-level " { $link sleep } " word instead." } ; + +HELP: "( path -- stream )" +{ $values { "path" "a string" } { "stream" "an input stream" } } +{ $description "Outputs an input stream for reading from the specified path name." } +{ $errors "Throws an error if the file is unreadable." } ; + +HELP: "( path -- stream )" +{ $values { "path" "a string" } { "stream" "an output stream" } } +{ $description "Outputs an input stream for writing to the specified path name." } +{ $errors "Throws an error if the file is unreadable." } ; + +HELP: "( host port -- stream )" +{ $values { "host" "a string" } { "port" "an integer between 0 and 65535" } { "stream" "a bidirectional stream" } } +{ $description "Connects to TCP/IP port number \texttt{port} on the host named by \texttt{host}, and outputs a bidirectional stream." } +{ $errors "Throws an error if domain name lookup fails, or if there is a connection cannot be established." } ; + +HELP: "( port -- server )" +{ $values { "port" "an integer between 0 and 65535" } { "server" "a handle" } } +{ $description + "Begins listening for connections to " { $snippet "port" } " on all network interfaces. The returned object responds to two generic words:" + { $list + { { $link stream-close } " - stops listening on the port and frees all associated resources" } + { { $link accept } " - blocks until there is a connection" } + } +} +{ $errors "Throws an error if the port is already in use, or if the OS forbits access." } ; + +HELP: accept "( server -- stream )" +{ $values { "server" "a handle" } { "stream" "a bidirectional stream" } } +{ $description "Waits for a connection to a server socket created by " { $link } ", and outputs a bidirectional stream when the connection has been established." +$terpri +"The client socket supports two accessor words to get the host name and port number of the incoming connection:" +{ $list { $link client-stream-host } { $link client-stream-port } } } +{ $errors "Throws an error if the server socket is closed or otherwise is unavailable." } ; diff --git a/library/io/duplex-stream.factor b/library/io/duplex-stream.factor index 6e344b13e7..0d25450d73 100644 --- a/library/io/duplex-stream.factor +++ b/library/io/duplex-stream.factor @@ -1,5 +1,5 @@ -! Combine an input and output stream into one, and flush the -! stream more often. +! Copyright (C) 2005 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. IN: io USING: kernel ; diff --git a/library/io/duplex-stream.facts b/library/io/duplex-stream.facts new file mode 100644 index 0000000000..25c1a9b860 --- /dev/null +++ b/library/io/duplex-stream.facts @@ -0,0 +1,8 @@ +USING: help io ; + +HELP: duplex-stream f +{ $description "A bidirectional stream delegating to a pair of streams, sending input to one delegate and output to another." } ; + +HELP: "( in out -- stream )" +{ $values { "in" "an input stream" } { "out" "an output stream" } { "stream" " a bidirectional stream" } } +{ $description "Creates a duplex stream. Writing to a duplex stream will write to " { $snippet "out" } ", and reading from a duplex stream will read from " { $snippet "in" } ". Closing a duplex stream closes both the input and output streams." } ; diff --git a/library/io/files.facts b/library/io/files.facts new file mode 100644 index 0000000000..b25ecb0c71 --- /dev/null +++ b/library/io/files.facts @@ -0,0 +1,33 @@ +USING: help io ; + +HELP: path+ "( str1 str2 -- str )" +{ $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } } +{ $description "Concatenates two path names." } ; + +HELP: exists? "( path -- ? )" +{ $values { "path" "a string" } { "?" "a boolean" } } +{ $description "Tests if the file named by " { $snippet "path" } " exists." } ; + +HELP: directory? "( path -- ? )" +{ $values { "path" "a string" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "path" } " names a directory." } ; + +HELP: directory "( path -- seq )" +{ $values { "path" "a string" } { "seq" "a sequence of file name strings" } } +{ $description "Outputs a sorted sequence of file names stored in the directory named by " { $snippet "path" } "." } ; + +HELP: file-length "( path -- n )" +{ $values { "path" "a string" } { "n" "a non-negative integer or " { $link f } } } +{ $description "Outputs the length of the file in bytes, or " { $link f } " if it does not exist." } ; + +HELP: resource-path "( resource -- path )" +{ $values { "resource" "a string" } { "path" "a string" } } +{ $description "Resolve a path relative to the Factor source code location." } ; + +HELP: "( resource -- stream )" +{ $values { "resource" "a string" } { "stream" "an input stream" } } +{ $description "Opens a file relative to the Factor source code location." } ; + +HELP: directory. "( path -- )" +{ $values { "path" "a string" } } +{ $description "Prints a directory listing to the " { $link stdio } " stream. If the stream supports it, subdirectories are shown as expandable outliners." } ; diff --git a/library/io/lines.factor b/library/io/lines.factor index 43d5357747..8eff28266f 100644 --- a/library/io/lines.factor +++ b/library/io/lines.factor @@ -1,5 +1,5 @@ ! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! See http://factorcode.org/license.txt for BSD license. IN: io USING: errors generic io kernel math namespaces sequences vectors ; @@ -41,9 +41,6 @@ M: line-reader stream-read ( count line -- string ) drop ] if ; -: (lines) ( seq -- seq ) - readln [ over push (lines) ] when* ; +: (lines) ( seq -- seq ) readln [ , (lines) ] when* ; -: lines ( stream -- seq ) - #! Read all lines from the stream into a sequence. - [ V{ } clone (lines) ] with-stream ; +: lines ( stream -- seq ) [ [ (lines) ] { } make ] with-stream ; diff --git a/library/io/lines.facts b/library/io/lines.facts new file mode 100644 index 0000000000..8392fff178 --- /dev/null +++ b/library/io/lines.facts @@ -0,0 +1,10 @@ +USING: help io ; + +HELP: "( stream -- new-stream )" +{ $values { "stream" "an input stream" } { "new-stream" "an input stream" } } +{ $description "Wraps an input stream in a stream supporting the " { $link stream-readln } " generic word." } +{ $notes "Stream constructors should call this word to wrap streams that do not natively support reading lines. Unix (" { $snippet "\\n" } "), Windows (" { $snippet "\\r\\n" } ") and MacOS (" { $snippet "\\r" } ") line endings are supported." } ; + +HELP: lines "( stream -- seq )" +{ $values { "stream" "an input stream" } { "seq" "a sequence of strings" } } +{ $description "Reads lines of text until the stream is exhausted, collecting them in a sequence of strings." } ; diff --git a/library/io/plain-stream.factor b/library/io/plain-stream.factor index 63b2e2e6fd..85d47ed7a8 100644 --- a/library/io/plain-stream.factor +++ b/library/io/plain-stream.factor @@ -1,8 +1,6 @@ IN: io -USING: generic kernel ; +USING: generic kernel namespaces ; -! Wrap your stream in this to avoid implementing the extended -! protocol. TUPLE: plain-writer ; C: plain-writer ( stream -- stream ) [ set-delegate ] keep ; @@ -11,4 +9,4 @@ M: plain-writer stream-terpri CHAR: \n swap stream-write1 ; M: plain-writer stream-terpri* stream-terpri ; M: plain-writer stream-format nip stream-write ; M: plain-writer with-nested-stream ( quot style stream -- ) - nip swap with-stream* ; + [ stdio set drop call ] with-scope ; diff --git a/library/io/plain-stream.facts b/library/io/plain-stream.facts new file mode 100644 index 0000000000..04e1d97958 --- /dev/null +++ b/library/io/plain-stream.facts @@ -0,0 +1,6 @@ +USING: help io ; + +HELP: "( stream -- new-stream )" +{ $values { "stream" "an input stream" } { "new-stream" "an input stream" } } +{ $description "Wraps an input stream in a stream supporting the extended stream output protocol in a trivial way." } +{ $notes "Stream constructors should call this word to wrap streams that do not natively support the extended stream output protocol." } ; diff --git a/library/io/server.factor b/library/io/server.factor index c04165cf90..87b7291647 100644 --- a/library/io/server.factor +++ b/library/io/server.factor @@ -1,14 +1,12 @@ ! Copyright (C) 2003, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! See http://factorcode.org/license.txt for BSD license. IN: io USING: errors io kernel math namespaces parser sequences strings threads ; -! A simple logging framework. SYMBOL: log-stream : log-message ( msg -- ) - #! Log a message to the log stream, either stdio or a file. log-stream get [ stdio get ] unless* [ stream-print ] keep stream-flush ; @@ -23,29 +21,22 @@ SYMBOL: log-stream ] "" make log-message ; : with-log-file ( file quot -- ) - #! Calls to log inside quot will output to a file. [ swap log-stream set call ] with-scope ; : with-logging ( quot -- ) - #! Calls to log inside quot will output to stdio. [ stdio get log-stream set call ] with-scope ; : with-client ( quot client -- ) - #! Spawn a new thread to handle a client connection. dup log-client [ swap with-stream ] in-thread 2drop ; inline SYMBOL: server-stream : server-loop ( quot -- ) - #! Keep waiting for connections. server-stream get accept over >r with-client r> server-loop ; inline : with-server ( port ident quot -- ) - #! Start a TCP/IP server on the given port number. Store - #! the port's server socket in the ident variable so that - #! the server can be stopped by the user. >r >r dup r> set r> swap [ server-stream set [ server-loop ] diff --git a/library/io/server.facts b/library/io/server.facts new file mode 100644 index 0000000000..ce083b3cbb --- /dev/null +++ b/library/io/server.facts @@ -0,0 +1,39 @@ +HELP: log-stream f +{ $description "Variable. Holds an output stream for logging messages." } +{ $see-also log-error log-client with-log-file with-logging } ; + +HELP: log-message "( str -- )" +{ $values { "str" "a string" } } +{ $description "Logs a message to the log stream. If " { $link log-stream } " is not set, logs to the " { $link stdio } " stream." } +{ $see-also log-error log-client } ; + +HELP: log-error "( str -- )" +{ $values { "str" "a string" } } +{ $description "Logs an error message." } +{ $see-also log-message log-client } ; + +HELP: log-client "( client -- )" +{ $values { "client" "a client socket stream" } } +{ $description "Logs an incoming client connection." } +{ $see-also log-message log-error } ; + +HELP: with-log-file "( path quot -- )" +{ $values { "path" "a string" } { "quot" "a quotation" } } +{ $description "Calls the quotation in a new dynamic scope where the " { $link log-stream } " is set to a file output stream writing to " { $snippet "path" } "." } ; + +HELP: with-logging "( quot -- )" +{ $values { "quot" "a quotation" } } +{ $description "Calls the quotation in a new dynamic scope where the " { $link log-stream } " is set to the " { $link stdio } " stream " { $emphasis "at this point in time" } "." } ; + +HELP: with-client "( quot client -- )" +{ $values { "quot" "a quotation" } { "client" "a client socket stream" } } +{ $description "Logs a client connection and spawns a new thread that calls the quotation, with the " { $link stdio } " stream set to the client stream. If the quotation throws an error, the client connection is closed, and the error is printed to the " { $link stdio } " stream at the time the thread was spawned." } ; + +HELP: server-stream f +{ $description "Variable. Current server socket, set by " { $link with-server } "." } ; + +HELP: with-server "( port ident quot -- )" +{ $values { "port" "an integer from 0 to 65535" } { "ident" "a symbol" } { "quot" "a quotation" } } +{ $description "Starts a TCP/IP server. The quotation is called in a new thread for each client connection, with the client connection being the " { $link stdio } " stream. Client connections are logged to the " { $link stdio } " stream at the time the server was started." +$terpri +"The socket server is stored in the " { $snippet "ident" } " variable. If " { $link with-server } " was called inside a new thread, this allows other threads to stop the server by passing the variable value to " { $link stream-close } "." } ; diff --git a/library/io/stdio.factor b/library/io/stdio.factor index 4611070236..164001b71f 100644 --- a/library/io/stdio.factor +++ b/library/io/stdio.factor @@ -54,7 +54,7 @@ SYMBOL: style-stack : format* ( string -- ) current-style format ; -: bl ( -- ) " " current-style t word-break pick set-hash format ; +: bl ( -- ) H{ { word-break t } } [ " " format* ] with-style ; : with-nesting* ( quot -- ) current-style swap with-nesting ; inline diff --git a/library/io/stdio.facts b/library/io/stdio.facts new file mode 100644 index 0000000000..d93b78dcee --- /dev/null +++ b/library/io/stdio.facts @@ -0,0 +1,65 @@ +HELP: stdio f +{ $description "Variable. Holds a stream, used for various implicit stream operations. Rebound using " { $link with-stream } " and " { $link with-stream* } "." } ; + +HELP: close "( -- )" +{ $contract "Closes the " { $link stdio } " stream." } +$io-error ; + +HELP: readln "( -- str/f )" +{ $values { "str/f" "a string or " { $link f } } } +{ $contract "Reads a line of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." } +$io-error ; + +HELP: read1 "( -- ch/f )" +{ $values { "ch/f" "a character or " { $link f } } } +{ $contract "Reads a character of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." } +$io-error ; + +HELP: read "( n -- str/f )" +{ $values { "str/f" "a string or " { $link f } } } +{ $contract "Reads " { $snippet "n" } " characters of input from the " { $link stdio } " stream. Outputs a truncated string or " { $link f } " on stream exhaustion." } +$io-error ; + +HELP: write1 "( ch -- )" +{ $values { "ch" "a character" } } +{ $contract "Writes a character of output to the " { $link stdio } " stream." } +$io-error ; + +HELP: write1 "( ch -- )" +{ $values { "ch" "a character" } } +{ $contract "Writes a character of output to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." } +$io-error ; + +HELP: write "( str -- )" +{ $values { "str" "a string" } } +{ $contract "Writes a string of output to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." } +$io-error ; + +HELP: flush "( -- )" +{ $contract "Waits for any pending output to the " { $link stdio } " stream to complete." } +$io-error ; + +HELP: terpri "( -- )" +{ $contract "Writes a line terminator to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." } +$io-error ; + +HELP: terpri* "( -- )" +{ $contract "Writes a line terminator to the " { $link stdio } " stream, unless the stream is already positioned at the start of a line, in which case this word does nothing. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." } +$io-error ; + +HELP: format "( str style -- )" +{ $values { "str" "a string" } { "style" "a hashtable" } } +{ $contract "Writes formatted text to the " { $link stdio } " stream." } +{ $notes "Details are in the documentation for " { $link stream-format } "." } +$io-error ; + +HELP: with-nesting "( style quot -- )" +{ $values { "style" "a hashtable" } { "quot" "a quotation" } } +{ $contract "Calls the quotation in a new dynamic scope, where the " { $link stdio } " stream is rebound to a nested stream of the current " { $link stdio } " stream, with formatting information applied." } +{ $notes "Details are in the documentation for " { $link stream-format } "." } +$io-error ; + +HELP: print "( style quot -- )" +{ $values { "style" "a hashtable" } { "quot" "a quotation" } } +{ $description "Outputs a newline-terminated string to the " { $link stdio } " stream." } +$io-error ;