More updates for encodings

db4
Daniel Ehrenberg 2008-02-24 19:58:34 -06:00
parent 4ad96fc4ea
commit 44f4aa4c69
14 changed files with 40 additions and 46 deletions

View File

@ -10,8 +10,8 @@ HOOK: init-io io-backend ( -- )
HOOK: (init-stdio) io-backend ( -- stdin stdout stderr )
: init-stdio ( -- )
(init-stdio) utf8 <encoded> stderr set-global
utf8 <encoded-duplex> stdio set-global ;
(init-stdio) utf8 <encoder> stderr set-global
utf8 <encoder-duplex> stdio set-global ;
HOOK: io-multiplex io-backend ( ms -- )
@ -23,8 +23,8 @@ HOOK: normalize-pathname io-backend ( str -- newstr )
M: object normalize-pathname ;
: set-io-backend ( backend -- )
io-backend set-global init-io init-stdio ;
: set-io-backend ( io-backend -- )
io-backend set-global init-io init-stdio die ;
[ init-io embedded? [ init-stdio ] unless ]
"io.backend" add-init-hook

View File

@ -2,4 +2,4 @@ USING: help.syntax help.markup ;
IN: io.encodings.binary
HELP: binary
{ $class-description "This is the encoding descriptor for binary I/O." } ;
{ $class-description "This is the encoding descriptor for binary I/O. Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings." } ;

View File

@ -54,7 +54,7 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state )
decode-read-loop ;
TUPLE: decoded code cr ;
: <decoded> ( stream decoding-class -- decoded-stream )
: <decoder> ( stream decoding-class -- decoded-stream )
dup binary eq? [ drop ] [
construct-empty { set-delegate set-decoded-code }
decoded construct
@ -126,7 +126,7 @@ TUPLE: encode-error ;
: encode-error ( -- * ) \ encode-error construct-empty throw ;
TUPLE: encoded code ;
: <encoded> ( stream encoding-class -- encoded-stream )
: <encoder> ( stream encoding-class -- encoded-stream )
dup binary eq? [ drop ] [
construct-empty { set-delegate set-encoded-code }
encoded construct
@ -148,12 +148,12 @@ INSTANCE: encoded plain-writer
! Rebinding duplex streams which have not read anything yet
: reencode ( stream encoding -- newstream )
over encoded? [ >r delegate r> ] when <encoded> ;
over encoded? [ >r delegate r> ] when <encoder> ;
: redecode ( stream encoding -- newstream )
over decoded? [ >r delegate r> ] when <decoded> ;
over decoded? [ >r delegate r> ] when <decoder> ;
: <encoded-duplex> ( stream-in stream-out encoding -- duplex-stream )
: <encoder-duplex> ( stream-in stream-out encoding -- duplex-stream )
tuck reencode >r redecode r> <duplex-stream> ;
! The null encoding does nothing

View File

@ -1,18 +1,11 @@
USING: help.markup help.syntax io.encodings strings ;
USING: help.markup help.syntax io.encodings strings io.files ;
IN: io.encodings.utf8
ARTICLE: "io.encodings.utf8" "Working with UTF8-encoded data"
"The UTF8 encoding is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences."
{ $subsection encode-utf8 }
{ $subsection decode-utf8 } ;
"The UTF8 encoding is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences. The encoding descriptor for UTF-8:"
{ $subsection utf8 } ;
HELP: utf8
{ $class-description "This is the class of encoding tuples which denote a UTF-8 encoding. You can pass this class symbol as an encoding descriptor to words like " { $link <file-reader> } " and " { $link encode-string } "." } ;
ABOUT: "io.encodings.utf8"
HELP: decode-utf8
{ $values { "seq" "a sequence of bytes" } { "str" string } }
{ $description "Decodes a sequence of bytes representing a Unicode string in UTF8 format." }
{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
HELP: encode-utf8
{ $values { "str" string } { "seq" "a sequence of bytes" } }
{ $description "Encodes a Unicode string as a sequence of bytes in UTF8 format." } ;

View File

@ -1,11 +1,11 @@
USING: io.encodings.utf8 tools.test sbufs kernel io io.encodings
sequences strings arrays unicode ;
sequences strings arrays unicode io.streams.byte-array ;
: decode-utf8-w/stream ( array -- newarray )
>sbuf dup reverse-here utf8 <decoded> contents ;
utf8 <byte-reader> contents >array ;
: encode-utf8-w/stream ( array -- newarray )
SBUF" " clone tuck utf8 <encoded> stream-write >array ;
utf8 [ write ] with-byte-writer >array ;
[ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream >array ] unit-test

View File

@ -17,13 +17,13 @@ HOOK: (file-writer) io-backend ( path -- stream )
HOOK: (file-appender) io-backend ( path -- stream )
: <file-reader> ( path encoding -- stream )
swap (file-reader) swap <decoded> ;
swap (file-reader) swap <decoder> ;
: <file-writer> ( path encoding -- stream )
swap (file-writer) swap <encoded> ;
swap (file-writer) swap <encoder> ;
: <file-appender> ( path encoding -- stream )
swap (file-appender) swap <encoded> ;
swap (file-appender) swap <encoder> ;
HOOK: delete-file io-backend ( path -- )
@ -171,4 +171,4 @@ M: pathname <=> [ pathname-string ] compare ;
[ dup make-directory ]
when ;
: temp-file ( name -- path ) temp-directory swap path+ ;
: temp-file ( name -- path ) temp-directory swap path+ ;

View File

@ -1,5 +1,5 @@
USING: arrays io io.files kernel math parser strings system
tools.test words namespaces io.encodings.latin1 io.encodings.binary ;
tools.test words namespaces io.encodings.ascii io.encodings.binary ;
IN: temporary
[ f ] [
@ -8,7 +8,7 @@ IN: temporary
] unit-test
: <resource-reader> ( resource -- stream )
resource-path latin1 <file-reader> ;
resource-path ascii <file-reader> ;
[
"This is a line.\rThis is another line.\r"

View File

@ -3,14 +3,14 @@ sequences io namespaces ;
IN: io.streams.byte-array
: <byte-writer> ( encoding -- stream )
512 <byte-vector> swap <encoded> ;
512 <byte-vector> swap <encoder> ;
: with-byte-writer ( encoding quot -- byte-array )
>r <byte-writer> r> [ stdio get ] compose with-stream*
>byte-array ; inline
: <byte-reader> ( byte-array encoding -- stream )
>r >byte-vector dup reverse-here r> <decoded> ;
>r >byte-vector dup reverse-here r> <decoder> ;
: with-byte-reader ( byte-array encoding quot -- )
>r <byte-reader> r> with-stream ; inline

View File

@ -50,7 +50,7 @@ M: growable stream-read-partial
stream-read ;
: <string-reader> ( str -- stream )
>sbuf dup reverse-here null-encoding <decoded> ;
>sbuf dup reverse-here null-encoding <decoder> ;
: with-string-reader ( str quot -- )
>r <string-reader> r> with-stream ; inline

View File

@ -1,11 +1,11 @@
USING: kernel tools.test io.encodings.utf16 arrays sbufs sequences io.encodings
io unicode ;
USING: kernel tools.test io.encodings.utf16 arrays sbufs
sequences io.encodings io unicode io.streams.byte-array ;
: decode-w/stream ( array encoding -- newarray )
>r >sbuf dup reverse-here r> <decoded> contents >array ;
<byte-reader> contents >array ;
: encode-w/stream ( array encoding -- newarray )
>r SBUF" " clone tuck r> <encoded> stream-write >array ;
[ write ] with-byte-writer >array ;
[ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode-w/stream ] unit-test
[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode-w/stream ] unit-test

View File

@ -127,7 +127,7 @@ TUPLE: process-stream process ;
: <process-stream> ( desc encoding -- stream )
swap >descriptor
[ (process-stream) >r rot <encoded-duplex> r> ] keep
[ (process-stream) >r rot <encoder-duplex> r> ] keep
+timeout+ swap at [ over set-timeout ] when*
{ set-delegate set-process-stream-process }
process-stream construct ;

View File

@ -45,7 +45,7 @@ GENERIC: close-handle ( handle -- )
output-port <buffered-port> ;
: <reader&writer> ( read-handle write-handle -- input-port output-port )
swap <reader> [ swap <writer> ] [ dispose ] cleanup ;
swap <reader> [ swap <writer> ] [ ] [ dispose drop ] cleanup ;
: pending-error ( port -- )
dup port-error f rot set-port-error [ throw ] when* ;

View File

@ -100,12 +100,12 @@ HELP: <client>
} ;
HELP: <server>
{ $values { "addrspec" "an address specifier" } { "server" "a handle" } }
{ $values { "addrspec" "an address specifier" } { "encoding" "an encoding descriptor" } { "server" "a handle" } }
{ $description
"Begins listening for network connections to a local address. Server objects responds to two words:"
{ $list
{ { $link dispose } " - stops listening on the port and frees all associated resources" }
{ { $link accept } " - blocks until there is a connection" }
{ { $link accept } " - blocks until there is a connection, and returns a stream of the encoding passed to the constructor" }
}
}
{ $notes
@ -119,7 +119,7 @@ HELP: <server>
HELP: accept
{ $values { "server" "a handle" } { "client" "a bidirectional stream" } }
{ $description "Waits for a connection to a server socket created by " { $link <server> } ", and outputs a bidirectional stream when the connection has been established."
{ $description "Waits for a connection to a server socket created by " { $link <server> } ", and outputs a bidirectional stream when the connection has been established. The encoding of this stream is the one that was passed to the server constructor."
$nl
"The returned client stream responds to the " { $link client-stream-addr } " word with the address of the incoming connection." }
{ $errors "Throws an error if the server socket is closed or otherwise is unavailable." } ;
@ -139,6 +139,7 @@ HELP: <datagram>
"To accept UDP/IP packets from the loopback interface only, use an address specifier returned by the following code, where 1234 is the desired port number:"
{ $code "\"localhost\" 1234 t resolve-host" }
"Since " { $link resolve-host } " can return multiple address specifiers, your code must create a datagram socket for each one and co-ordinate packet sending accordingly."
"Datagrams are low-level binary ports that don't map onto streams, so the constructor does not use an encoding"
}
{ $errors "Throws an error if the port is already in use, or if the OS forbids access." } ;

View File

@ -33,7 +33,7 @@ M: array client* [ (client) ] attempt-all ;
M: object client* (client) ;
: <client> ( addrspec encoding -- stream )
[ >r client* r> <encoded-duplex> ] keep <client-stream> ;
[ >r client* r> <encoder-duplex> ] keep <client-stream> ;
HOOK: (server) io-backend ( addrspec -- handle )
@ -43,7 +43,7 @@ HOOK: (server) io-backend ( addrspec -- handle )
HOOK: (accept) io-backend ( server -- stream-in stream-out )
: accept ( server -- client )
[ (accept) ] keep server-port-encoding <encoded-duplex> ;
[ (accept) ] keep server-port-encoding <encoder-duplex> ;
HOOK: <datagram> io-backend ( addrspec -- datagram )