From 44f4aa4c69e44199a5bcad9c5ab3b5b9e8678061 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 24 Feb 2008 19:58:34 -0600 Subject: [PATCH] More updates for encodings --- core/io/backend/backend.factor | 8 ++++---- core/io/encodings/binary/binary-docs.factor | 2 +- core/io/encodings/encodings.factor | 10 +++++----- core/io/encodings/utf8/utf8-docs.factor | 19 ++++++------------- core/io/encodings/utf8/utf8-tests.factor | 6 +++--- core/io/files/files.factor | 8 ++++---- core/io/io-tests.factor | 4 ++-- core/io/streams/byte-array/byte-array.factor | 4 ++-- core/io/streams/string/string.factor | 2 +- extra/io/encodings/utf16/utf16-tests.factor | 8 ++++---- extra/io/launcher/launcher.factor | 2 +- extra/io/nonblocking/nonblocking.factor | 2 +- extra/io/sockets/sockets-docs.factor | 7 ++++--- extra/io/sockets/sockets.factor | 4 ++-- 14 files changed, 40 insertions(+), 46 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 2824b6a299..6f41814ce9 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -10,8 +10,8 @@ HOOK: init-io io-backend ( -- ) HOOK: (init-stdio) io-backend ( -- stdin stdout stderr ) : init-stdio ( -- ) - (init-stdio) utf8 stderr set-global - utf8 stdio set-global ; + (init-stdio) utf8 stderr set-global + utf8 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 diff --git a/core/io/encodings/binary/binary-docs.factor b/core/io/encodings/binary/binary-docs.factor index f8be5054df..823eea67be 100644 --- a/core/io/encodings/binary/binary-docs.factor +++ b/core/io/encodings/binary/binary-docs.factor @@ -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." } ; diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 670a235615..79079929bb 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -54,7 +54,7 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) decode-read-loop ; TUPLE: decoded code cr ; -: ( stream decoding-class -- decoded-stream ) +: ( 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 ; -: ( stream encoding-class -- encoded-stream ) +: ( 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 ; + over encoded? [ >r delegate r> ] when ; : redecode ( stream encoding -- newstream ) - over decoded? [ >r delegate r> ] when ; + over decoded? [ >r delegate r> ] when ; -: ( stream-in stream-out encoding -- duplex-stream ) +: ( stream-in stream-out encoding -- duplex-stream ) tuck reencode >r redecode r> ; ! The null encoding does nothing diff --git a/core/io/encodings/utf8/utf8-docs.factor b/core/io/encodings/utf8/utf8-docs.factor index 6e1923824f..734a7f7236 100755 --- a/core/io/encodings/utf8/utf8-docs.factor +++ b/core/io/encodings/utf8/utf8-docs.factor @@ -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 } " 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." } ; diff --git a/core/io/encodings/utf8/utf8-tests.factor b/core/io/encodings/utf8/utf8-tests.factor index a6a32041be..0671fe2129 100644 --- a/core/io/encodings/utf8/utf8-tests.factor +++ b/core/io/encodings/utf8/utf8-tests.factor @@ -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 contents ; + utf8 contents >array ; : encode-utf8-w/stream ( array -- newarray ) - SBUF" " clone tuck utf8 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 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index f41e04d72d..bff9d69129 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -17,13 +17,13 @@ HOOK: (file-writer) io-backend ( path -- stream ) HOOK: (file-appender) io-backend ( path -- stream ) : ( path encoding -- stream ) - swap (file-reader) swap ; + swap (file-reader) swap ; : ( path encoding -- stream ) - swap (file-writer) swap ; + swap (file-writer) swap ; : ( path encoding -- stream ) - swap (file-appender) swap ; + swap (file-appender) swap ; 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+ ; \ No newline at end of file +: temp-file ( name -- path ) temp-directory swap path+ ; diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 394deb0e5c..74b6b5034f 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -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 -- stream ) - resource-path latin1 ; + resource-path ascii ; [ "This is a line.\rThis is another line.\r" diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor index afbc94bf6a..d5ca8eac68 100644 --- a/core/io/streams/byte-array/byte-array.factor +++ b/core/io/streams/byte-array/byte-array.factor @@ -3,14 +3,14 @@ sequences io namespaces ; IN: io.streams.byte-array : ( encoding -- stream ) - 512 swap ; + 512 swap ; : with-byte-writer ( encoding quot -- byte-array ) >r r> [ stdio get ] compose with-stream* >byte-array ; inline : ( byte-array encoding -- stream ) - >r >byte-vector dup reverse-here r> ; + >r >byte-vector dup reverse-here r> ; : with-byte-reader ( byte-array encoding quot -- ) >r r> with-stream ; inline diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index e1c14e6ee3..15fc2b704e 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -50,7 +50,7 @@ M: growable stream-read-partial stream-read ; : ( str -- stream ) - >sbuf dup reverse-here null-encoding ; + >sbuf dup reverse-here null-encoding ; : with-string-reader ( str quot -- ) >r r> with-stream ; inline diff --git a/extra/io/encodings/utf16/utf16-tests.factor b/extra/io/encodings/utf16/utf16-tests.factor index 1677c2d38d..7ee5c9574e 100755 --- a/extra/io/encodings/utf16/utf16-tests.factor +++ b/extra/io/encodings/utf16/utf16-tests.factor @@ -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> contents >array ; + contents >array ; : encode-w/stream ( array encoding -- newarray ) - >r SBUF" " clone tuck r> 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 diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index 9236ec2ce9..b1990df654 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -127,7 +127,7 @@ TUPLE: process-stream process ; : ( desc encoding -- stream ) swap >descriptor - [ (process-stream) >r rot r> ] keep + [ (process-stream) >r rot r> ] keep +timeout+ swap at [ over set-timeout ] when* { set-delegate set-process-stream-process } process-stream construct ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index b8007192fe..b0ce1fcc12 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -45,7 +45,7 @@ GENERIC: close-handle ( handle -- ) output-port ; : ( read-handle write-handle -- input-port output-port ) - swap [ swap ] [ dispose ] cleanup ; + swap [ swap ] [ ] [ dispose drop ] cleanup ; : pending-error ( port -- ) dup port-error f rot set-port-error [ throw ] when* ; diff --git a/extra/io/sockets/sockets-docs.factor b/extra/io/sockets/sockets-docs.factor index 510d47ff2b..fa38ec90ee 100755 --- a/extra/io/sockets/sockets-docs.factor +++ b/extra/io/sockets/sockets-docs.factor @@ -100,12 +100,12 @@ HELP: } ; HELP: -{ $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: HELP: accept { $values { "server" "a handle" } { "client" "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." +{ $description "Waits for a connection to a server socket created by " { $link } ", 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: "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." } ; diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 07e4f0afca..8de43bfd20 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -33,7 +33,7 @@ M: array client* [ (client) ] attempt-all ; M: object client* (client) ; : ( addrspec encoding -- stream ) - [ >r client* r> ] keep ; + [ >r client* r> ] keep ; 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 ; + [ (accept) ] keep server-port-encoding ; HOOK: io-backend ( addrspec -- datagram )