More changes for encodings

db4
Daniel Ehrenberg 2008-02-22 20:21:23 -06:00
parent 1b80c453fd
commit 72e15848bf
14 changed files with 42 additions and 29 deletions

View File

@ -416,8 +416,7 @@ M: curry '
"Writing image to " write
architecture get boot-image-name resource-path
dup write "..." print flush
! binary
<file-writer> [ (write-image) ] with-stream ;
binary <file-writer> [ (write-image) ] with-stream ;
PRIVATE>

View File

@ -3,7 +3,7 @@
USING: math kernel sequences sbufs vectors namespaces
growable strings io classes continuations combinators
io.styles io.streams.plain io.encodings.binary splitting
io.streams.string io.streams.duplex ;
io.streams.duplex ;
IN: io.encodings
! Decoding
@ -50,7 +50,7 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state )
] if ;
: decode-read ( length stream encoding -- string )
>r swap start-decoding r>
>r swap >fixnum start-decoding r>
decode-read-loop ;
TUPLE: decoded code cr ;
@ -114,7 +114,7 @@ M: decoded stream-read-until
] [ nip ] if ;
M: decoded stream-read1
1 swap stream-read [ first ] [ f ] if* ;
1 swap stream-read f like [ first ] [ f ] if* ;
M: decoded stream-readln ( stream -- str )
"\r\n" over stream-read-until handle-readln ;
@ -127,7 +127,10 @@ TUPLE: encode-error ;
TUPLE: encoded code ;
: <encoded> ( stream encoding-class -- encoded-stream )
construct-empty { set-delegate set-encoded-code } encoded construct ;
dup binary eq? [ drop ] [
construct-empty { set-delegate set-encoded-code }
encoded construct
] if ;
GENERIC: encode-string ( string encoding -- byte-array )
M: tuple-class encode-string construct-empty encode-string ;
@ -153,3 +156,11 @@ INSTANCE: encoded plain-writer
: <encoded-duplex> ( duplex-stream encoding -- duplex-stream )
swap { duplex-stream-in duplex-stream-out } get-slots
pick reencode >r swap redecode r> <duplex-stream> ;
! The null encoding does nothing
! (used to wrap things as line-reader/plain-writer)
! Later this will be replaced by inheritance
TUPLE: null-encoding ;
M: null-encoding encode-string drop ;
M: null-encoding decode-step 3drop over push f f ;

View File

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

View File

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

View File

@ -1,4 +1,4 @@
USING: tools.test io.files io io.streams.c ;
USING: tools.test io.files io io.streams.c io.encodings.ascii ;
IN: temporary
[ "hello world" ] [

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
IN: io.streams.string
USING: io kernel math namespaces sequences sbufs strings
generic splitting growable continuations io.streams.plain ;
generic splitting growable continuations io.streams.plain
io.encodings ;
M: growable dispose drop ;
@ -23,7 +24,7 @@ M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ;
underlying like ;
: growable-read-until ( growable n -- str )
dupd tail-slice swap harden-as dup reverse-here ;
>fixnum dupd tail-slice swap harden-as dup reverse-here ;
: find-last-sep swap [ memq? ] curry find-last drop ;
@ -49,7 +50,7 @@ M: growable stream-read-partial
stream-read ;
: <string-reader> ( str -- stream )
>sbuf dup reverse-here ;
>sbuf dup reverse-here null-encoding <decoded> ;
: with-string-reader ( str quot -- )
>r <string-reader> r> with-stream ; inline
@ -74,3 +75,6 @@ M: plain-writer stream-write-table
[ drop format-table [ print ] each ] with-stream* ;
M: plain-writer make-cell-stream 2drop <string-writer> ;
M: growable stream-readln ( stream -- str )
"\r\n" over stream-read-until handle-readln ;

View File

@ -3,13 +3,13 @@
USING: io io.encodings strings kernel math sequences byte-arrays io.encodings ;
IN: io.encodings.ascii
: encode-check>= ( string max -- byte-array )
dupd [ >= ] curry all? [ >byte-array ] [ encode-error ] if ;
: encode-check<= ( string max -- byte-array )
dupd [ <= ] curry all? [ >byte-array ] [ encode-error ] if ;
TUPLE: ascii ;
M: ascii encode-string
drop 127 encode-check>= ;
drop 127 encode-check<= ;
M: ascii decode-step
3drop dup 127 >= [ encode-error ] when over push f f ;

View File

@ -6,7 +6,7 @@ IN: io.encodings.latin1
TUPLE: latin1 ;
M: latin1 encode-string
drop 255 encode-check>= ;
drop 255 encode-check<= ;
M: latin1 decode-step
3drop over push f f ;

View File

@ -2,10 +2,10 @@ USING: kernel tools.test io.encodings.utf16 arrays sbufs sequences io.encodings
io unicode ;
: decode-w/stream ( array encoding -- newarray )
>r >sbuf dup reverse-here r> <decoding> contents >array ;
>r >sbuf dup reverse-here r> <decoded> contents >array ;
: encode-w/stream ( array encoding -- newarray )
>r SBUF" " clone tuck r> <encoding> stream-write >array ;
>r SBUF" " clone tuck r> <encoded> stream-write >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

@ -39,15 +39,14 @@ GENERIC: close-handle ( handle -- )
: <buffered-port> ( handle type -- port )
default-buffer-size get <buffer> swap <port> ;
: <reader> ( handle -- stream )
: <reader> ( handle -- input-port )
input-port <buffered-port> ;
: <writer> ( handle -- stream )
: <writer> ( handle -- output-port )
output-port <buffered-port> ;
: handle>duplex-stream ( in-handle out-handle encoding -- stream )
[ swap <writer> swap <encoded> ] keep
[ -rot >r <reader> swap <decoded> r> <duplex-stream> ]
: handle>duplex-stream ( in-handle out-handle -- stream )
[ swap <reader> swap <writer> <duplex-stream> ]
[ ] [ dispose ] cleanup ;
: pending-error ( port -- )

View File

@ -182,7 +182,7 @@ M: unix-io io-multiplex ( ms -- )
mx get-global wait-for-events ;
M: unix-io init-stdio ( -- )
0 1 utf8 handle>duplex-stream io:stdio set-global
0 1 handle>duplex-stream io:stdio utf8 <encoded-duplex> set-global
2 <writer> utf8 <encoded> io:stderr set-global ;
! mx io-task for embedding an fd-based mx inside another mx

View File

@ -99,7 +99,7 @@ M: unix-io kill-process* ( pid -- )
M: unix-io process-stream*
[
spawn-process-stream >r latin1 handle>duplex-stream r>
spawn-process-stream >r handle>duplex-stream r>
] with-descriptor ;
: find-process ( handle -- process )

View File

@ -48,7 +48,7 @@ M: unix-io (client) ( addrspec -- stream )
dup r> r> connect
zero? err_no EINPROGRESS = or [
dup init-client-socket
dup f handle>duplex-stream
dup handle>duplex-stream
dup duplex-stream-out
dup wait-to-connect
pending-init-error

View File

@ -49,5 +49,5 @@ TAGS>
}
] [
"extra/xmode/utilities/test.xml"
resource-path <file-reader> read-xml parse-company-tag
resource-path file>xml parse-company-tag
] unit-test