Changes to I/O system for encodings
Daniel Ehrenberg
parent
7ae14a746f
commit
63ba6faee2
|
|
@ -1,13 +1,11 @@
|
|||
! Copyright (C) 2006, 2007 Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math kernel sequences sbufs vectors io.streams.lines io.streams.plain
|
||||
namespaces unicode growable strings io classes io.streams.c
|
||||
continuations ;
|
||||
USING: math kernel sequences sbufs vectors namespaces
|
||||
growable strings io classes io.streams.c continuations
|
||||
io.styles io.streams.nested ;
|
||||
IN: io.encodings
|
||||
|
||||
TUPLE: encode-error ;
|
||||
|
||||
: encode-error ( -- * ) \ encode-error construct-empty throw ;
|
||||
! Decoding
|
||||
|
||||
TUPLE: decode-error ;
|
||||
|
||||
|
|
@ -19,7 +17,8 @@ SYMBOL: begin
|
|||
over push 0 begin ;
|
||||
|
||||
: push-replacement ( buf -- buf ch state )
|
||||
CHAR: replacement-character decoded ;
|
||||
! This is the replacement character
|
||||
HEX: fffd decoded ;
|
||||
|
||||
: finish-decoding ( buf ch state -- str )
|
||||
begin eq? [ decode-error ] unless drop "" like ;
|
||||
|
|
@ -53,43 +52,89 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state )
|
|||
>r swap start-decoding r>
|
||||
decode-read-loop ;
|
||||
|
||||
: <decoding> ( stream decoding-class -- decoded-stream )
|
||||
construct-delegate <line-reader> ;
|
||||
TUPLE: decoded code cr ;
|
||||
: <decoded> ( stream decoding-class -- decoded-stream )
|
||||
construct-empty { set-delegate set-decoded-code } decoded construct ;
|
||||
|
||||
: <encoding> ( stream encoding-class -- encoded-stream )
|
||||
construct-delegate <plain-writer> ;
|
||||
: cr+ t swap set-line-reader-cr ; inline
|
||||
|
||||
GENERIC: encode-string ( string encoding -- byte-array )
|
||||
M: tuple-class encode-string construct-empty encode-string ;
|
||||
: cr- f swap set-line-reader-cr ; inline
|
||||
|
||||
MIXIN: encoding-stream
|
||||
: line-ends/eof ( stream str -- str ) f like swap cr- ; inline
|
||||
|
||||
M: encoding-stream stream-read1 1 swap stream-read ;
|
||||
: line-ends\r ( stream str -- str ) swap cr+ ; inline
|
||||
|
||||
M: encoding-stream stream-read
|
||||
[ delegate ] keep decode-read ;
|
||||
: line-ends\n ( stream str -- str )
|
||||
over line-reader-cr over empty? and
|
||||
[ drop dup cr- stream-readln ] [ swap cr- ] if ; inline
|
||||
|
||||
M: encoding-stream stream-read-partial stream-read ;
|
||||
: handle-readln ( stream str ch -- str )
|
||||
{
|
||||
{ f [ line-ends/eof ] }
|
||||
{ CHAR: \r [ line-ends\r ] }
|
||||
{ CHAR: \n [ line-ends\n ] }
|
||||
} case ;
|
||||
|
||||
M: encoding-stream stream-read-until
|
||||
: fix-read ( stream string -- string )
|
||||
over line-reader-cr [
|
||||
over cr-
|
||||
"\n" ?head [
|
||||
swap stream-read1 [ add ] when*
|
||||
] [ nip ] if
|
||||
] [ nip ] if ;
|
||||
|
||||
M: decoded stream-read
|
||||
tuck { delegate decoded-code } get-slots decode-read fix-read ;
|
||||
|
||||
M: decoded stream-read-partial tuck stream-read fix-read ;
|
||||
|
||||
M: decoded stream-read-until
|
||||
! Copied from { c-reader stream-read-until }!!!
|
||||
[ swap read-until-loop ] "" make
|
||||
swap over empty? over not and [ 2drop f f ] when ;
|
||||
|
||||
M: encoding-stream stream-write1
|
||||
: fix-read1 ( stream char -- char )
|
||||
over line-reader-cr [
|
||||
over cr-
|
||||
dup CHAR: \n = [
|
||||
drop stream-read1
|
||||
] [ nip ] if
|
||||
] [ nip ] if ;
|
||||
|
||||
M: decoded stream-read1 1 over stream-read ;
|
||||
|
||||
M: line-reader stream-readln ( stream -- str )
|
||||
"\r\n" over stream-read-until handle-readln ;
|
||||
|
||||
! Encoding
|
||||
|
||||
TUPLE: encode-error ;
|
||||
|
||||
: encode-error ( -- * ) \ encode-error construct-empty throw ;
|
||||
|
||||
TUPLE: encoded code ;
|
||||
: <encoded> ( stream encoding-class -- encoded-stream )
|
||||
construct-empty { set-delegate set-encoded-code } encoded construct ;
|
||||
|
||||
GENERIC: encode-string ( string encoding -- byte-array )
|
||||
M: tuple-class encode-string construct-empty encode-string ;
|
||||
|
||||
M: encoded stream-write1
|
||||
>r 1string r> stream-write ;
|
||||
|
||||
M: encoding-stream stream-write
|
||||
[ encode-string ] keep delegate stream-write ;
|
||||
M: encoded stream-write
|
||||
[ encoding-code encode-string ] keep delegate stream-write ;
|
||||
|
||||
M: encoding-stream dispose delegate dispose ;
|
||||
M: encoded dispose delegate dispose ;
|
||||
|
||||
GENERIC: underlying-stream ( encoded-stream -- delegate )
|
||||
M: encoding-stream underlying-stream delegate ;
|
||||
M: encoded stream-nl
|
||||
CHAR: \n swap stream-write1 ;
|
||||
|
||||
GENERIC: set-underlying-stream ( new-underlying stream -- )
|
||||
M: encoding-stream set-underlying-stream set-delegate ;
|
||||
M: encoded stream-format
|
||||
nip stream-write ;
|
||||
|
||||
: set-encoding ( encoding stream -- ) ! This doesn't work now
|
||||
[ underlying-stream swap construct-delegate ] keep
|
||||
set-underlying-stream ;
|
||||
M: encoded make-span-stream
|
||||
<style-stream> <ignore-close-stream> ;
|
||||
|
||||
M: encoded make-block-stream
|
||||
nip <ignore-close-stream> ;
|
||||
|
|
|
|||
|
|
@ -3,17 +3,17 @@
|
|||
IN: io.files
|
||||
USING: io.backend io.files.private io hashtables kernel math
|
||||
memory namespaces sequences strings assocs arrays definitions
|
||||
system combinators splitting sbufs continuations ;
|
||||
system combinators splitting sbufs continuations io.encodings ;
|
||||
|
||||
HOOK: cd io-backend ( path -- )
|
||||
|
||||
HOOK: cwd io-backend ( -- path )
|
||||
|
||||
HOOK: <file-reader> io-backend ( path -- stream )
|
||||
HOOK: file-reader* io-backend ( path -- stream )
|
||||
|
||||
HOOK: <file-writer> io-backend ( path -- stream )
|
||||
HOOK: file-writer* io-backend ( path -- stream )
|
||||
|
||||
HOOK: <file-appender> io-backend ( path -- stream )
|
||||
HOOK: file-appender* io-backend ( path -- stream )
|
||||
|
||||
HOOK: delete-file io-backend ( path -- )
|
||||
|
||||
|
|
@ -140,16 +140,25 @@ C: <pathname> pathname
|
|||
|
||||
M: pathname <=> [ pathname-string ] compare ;
|
||||
|
||||
: file-lines ( path -- seq ) <file-reader> lines ;
|
||||
: <file-reader> ( path encoding -- stream )
|
||||
swap file-reader* swap <decoding> ;
|
||||
|
||||
: file-contents ( path -- str )
|
||||
dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >string ;
|
||||
: <file-writer> ( path encoding -- stream )
|
||||
swap file-writer* swap <encoding> ;
|
||||
|
||||
: with-file-writer ( path quot -- )
|
||||
>r <file-reader> r> with-stream ; inline
|
||||
: <file-appender> ( path encoding -- stream )
|
||||
swap file-appender* swap <encoding> ;
|
||||
|
||||
: with-file-reader ( path quot -- )
|
||||
: file-lines ( path encoding -- seq ) <file-reader> lines ;
|
||||
|
||||
: file-contents ( path encoding -- str )
|
||||
dupd <file-reader> swap file-length <sbuf> [ stream-copy ] keep >string ;
|
||||
|
||||
: with-file-writer ( path encoding quot -- )
|
||||
>r <file-writer> r> with-stream ; inline
|
||||
|
||||
: with-file-appender ( path quot -- )
|
||||
: with-file-reader ( path encoding quot -- )
|
||||
>r <file-reader> r> with-stream ; inline
|
||||
|
||||
: with-file-appender ( path encoding quot -- )
|
||||
>r <file-appender> r> with-stream ; inline
|
||||
|
|
|
|||
|
|
@ -66,14 +66,14 @@ M: object init-stdio
|
|||
|
||||
M: object io-multiplex (sleep) ;
|
||||
|
||||
M: object <file-reader>
|
||||
"rb" fopen <c-reader> <line-reader> ;
|
||||
M: object file-reader*
|
||||
"rb" fopen <c-reader> ;
|
||||
|
||||
M: object <file-writer>
|
||||
"wb" fopen <c-writer> <plain-writer> ;
|
||||
M: object file-writer*
|
||||
"wb" fopen <c-writer> ;
|
||||
|
||||
M: object <file-appender>
|
||||
"ab" fopen <c-writer> <plain-writer> ;
|
||||
M: object file-appender*
|
||||
"ab" fopen <c-writer> ;
|
||||
|
||||
: show ( msg -- )
|
||||
#! A word which directly calls primitives. It is used to
|
||||
|
|
|
|||
|
|
@ -1,57 +1,9 @@
|
|||
! Copyright (C) 2004, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: io.streams.lines
|
||||
USING: arrays generic io kernel math namespaces sequences
|
||||
vectors combinators splitting ;
|
||||
USING: io.encodings.latin1 io.encodings ;
|
||||
|
||||
TUPLE: line-reader cr ;
|
||||
|
||||
: <line-reader> ( stream -- new-stream )
|
||||
line-reader construct-delegate ;
|
||||
|
||||
: cr+ t swap set-line-reader-cr ; inline
|
||||
|
||||
: cr- f swap set-line-reader-cr ; inline
|
||||
|
||||
: line-ends/eof ( stream str -- str ) f like swap cr- ; inline
|
||||
|
||||
: line-ends\r ( stream str -- str ) swap cr+ ; inline
|
||||
|
||||
: line-ends\n ( stream str -- str )
|
||||
over line-reader-cr over empty? and
|
||||
[ drop dup cr- stream-readln ] [ swap cr- ] if ; inline
|
||||
|
||||
: handle-readln ( stream str ch -- str )
|
||||
{
|
||||
{ f [ line-ends/eof ] }
|
||||
{ CHAR: \r [ line-ends\r ] }
|
||||
{ CHAR: \n [ line-ends\n ] }
|
||||
} case ;
|
||||
|
||||
M: line-reader stream-readln ( stream -- str )
|
||||
"\r\n" over delegate stream-read-until handle-readln ;
|
||||
|
||||
: fix-read ( stream string -- string )
|
||||
over line-reader-cr [
|
||||
over cr-
|
||||
"\n" ?head [
|
||||
swap stream-read1 [ add ] when*
|
||||
] [ nip ] if
|
||||
] [ nip ] if ;
|
||||
|
||||
M: line-reader stream-read
|
||||
tuck delegate stream-read fix-read ;
|
||||
|
||||
M: line-reader stream-read-partial
|
||||
tuck delegate stream-read-partial fix-read ;
|
||||
|
||||
: fix-read1 ( stream char -- char )
|
||||
over line-reader-cr [
|
||||
over cr-
|
||||
dup CHAR: \n = [
|
||||
drop stream-read1
|
||||
] [ nip ] if
|
||||
] [ nip ] if ;
|
||||
|
||||
M: line-reader stream-read1 ( stream -- char )
|
||||
dup delegate stream-read1 fix-read1 ;
|
||||
latin1 <decoded> ;
|
||||
|
|
|
|||
|
|
@ -1,22 +1,7 @@
|
|||
! Copyright (C) 2005, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: io.streams.plain
|
||||
USING: generic assocs kernel math namespaces sequences
|
||||
io.styles io io.streams.nested ;
|
||||
|
||||
TUPLE: plain-writer ;
|
||||
USING: io.encodings.latin1 io.encodings ;
|
||||
|
||||
: <plain-writer> ( stream -- new-stream )
|
||||
plain-writer construct-delegate ;
|
||||
|
||||
M: plain-writer stream-nl
|
||||
CHAR: \n swap stream-write1 ;
|
||||
|
||||
M: plain-writer stream-format
|
||||
nip stream-write ;
|
||||
|
||||
M: plain-writer make-span-stream
|
||||
<style-stream> <ignore-close-stream> ;
|
||||
|
||||
M: plain-writer make-block-stream
|
||||
nip <ignore-close-stream> ;
|
||||
latin1 <encoded> ;
|
||||
|
|
|
|||
|
|
@ -40,10 +40,10 @@ GENERIC: close-handle ( handle -- )
|
|||
default-buffer-size get <buffer> swap <port> ;
|
||||
|
||||
: <reader> ( handle -- stream )
|
||||
input-port <buffered-port> <line-reader> ;
|
||||
input-port <buffered-port> ;
|
||||
|
||||
: <writer> ( handle -- stream )
|
||||
output-port <buffered-port> <plain-writer> ;
|
||||
output-port <buffered-port> ;
|
||||
|
||||
: handle>duplex-stream ( in-handle out-handle -- stream )
|
||||
<writer>
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ M: unix-io cd
|
|||
: open-read ( path -- fd )
|
||||
O_RDONLY file-mode open dup io-error ;
|
||||
|
||||
M: unix-io <file-reader> ( path -- stream )
|
||||
M: unix-io file-reader* ( path -- stream )
|
||||
open-read <reader> ;
|
||||
|
||||
: write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline
|
||||
|
|
@ -25,7 +25,7 @@ M: unix-io <file-reader> ( path -- stream )
|
|||
: open-write ( path -- fd )
|
||||
write-flags file-mode open dup io-error ;
|
||||
|
||||
M: unix-io <file-writer> ( path -- stream )
|
||||
M: unix-io file-writer* ( path -- stream )
|
||||
open-write <writer> ;
|
||||
|
||||
: append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline
|
||||
|
|
@ -34,7 +34,7 @@ M: unix-io <file-writer> ( path -- stream )
|
|||
append-flags file-mode open dup io-error
|
||||
[ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ;
|
||||
|
||||
M: unix-io <file-appender> ( path -- stream )
|
||||
M: unix-io file-appender* ( path -- stream )
|
||||
open-append <writer> ;
|
||||
|
||||
M: unix-io rename-file ( from to -- )
|
||||
|
|
|
|||
|
|
@ -112,13 +112,13 @@ C: <FileArgs> FileArgs
|
|||
[ FileArgs-lpNumberOfBytesRet ] keep
|
||||
FileArgs-lpOverlapped ;
|
||||
|
||||
M: windows-io <file-reader> ( path -- stream )
|
||||
M: windows-io file-reader* ( path -- stream )
|
||||
open-read <win32-file> <reader> ;
|
||||
|
||||
M: windows-io <file-writer> ( path -- stream )
|
||||
M: windows-io file-writer* ( path -- stream )
|
||||
open-write <win32-file> <writer> ;
|
||||
|
||||
M: windows-io <file-appender> ( path -- stream )
|
||||
M: windows-io file-appender* ( path -- stream )
|
||||
open-append <win32-file> <writer> ;
|
||||
|
||||
M: windows-io rename-file ( from to -- )
|
||||
|
|
|
|||
Loading…
Reference in New Issue