Changes to I/O system for encodings

core/io/encodings/encodings.factor

@@ -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
+USING: math kernel sequences sbufs vectors namespaces
-namespaces unicode growable strings io classes io.streams.c
+growable strings io classes io.streams.c continuations
-continuations ;
+io.styles io.streams.nested ;
 IN: io.encodings
 
-TUPLE: encode-error ;
+! Decoding
-
-: encode-error ( -- * ) \ encode-error construct-empty throw ;
 
 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 )
+TUPLE: decoded code cr ;
-    construct-delegate <line-reader> ;
+: <decoded> ( stream decoding-class -- decoded-stream )
+    construct-empty { set-delegate set-decoded-code } decoded construct ;
 
-: <encoding> ( stream encoding-class -- encoded-stream )
+: cr+ t swap set-line-reader-cr ; inline
-    construct-delegate <plain-writer> ;
 
-GENERIC: encode-string ( string encoding -- byte-array )
+: cr- f swap set-line-reader-cr ; inline
-M: tuple-class encode-string construct-empty encode-string ;
 
-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
+: line-ends\n ( stream str -- str )
-    [ delegate ] keep decode-read ;
+    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
+M: encoded stream-write
-    [ encode-string ] keep delegate 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: encoded stream-nl
-M: encoding-stream underlying-stream delegate ;
+    CHAR: \n swap stream-write1 ;
 
-GENERIC: set-underlying-stream ( new-underlying stream -- )
+M: encoded stream-format
-M: encoding-stream set-underlying-stream set-delegate ;
+    nip stream-write ;
 
-: set-encoding ( encoding stream -- ) ! This doesn't work now
+M: encoded make-span-stream
-    [ underlying-stream swap construct-delegate ] keep
+    <style-stream> <ignore-close-stream> ;
-    set-underlying-stream ;
+
+M: encoded make-block-stream
+    nip <ignore-close-stream> ;

core/io/files/files.factor

@@ -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 )
+: <file-writer> ( path encoding -- stream )
-    dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >string ;
+    swap file-writer* swap <encoding> ;
 
-: with-file-writer ( path quot -- )
+: <file-appender> ( path encoding -- stream )
-    >r <file-reader> r> with-stream ; inline
+    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

core/io/streams/c/c.factor

@@ -66,14 +66,14 @@ M: object init-stdio
 
 M: object io-multiplex (sleep) ;
 
-M: object <file-reader>
+M: object file-reader*
-    "rb" fopen <c-reader> <line-reader> ;
+    "rb" fopen <c-reader> ;
 
-M: object <file-writer>
+M: object file-writer*
-    "wb" fopen <c-writer> <plain-writer> ;
+    "wb" fopen <c-writer> ;
 
-M: object <file-appender>
+M: object file-appender*
-    "ab" fopen <c-writer> <plain-writer> ;
+    "ab" fopen <c-writer> ;
 
 : show ( msg -- )
     #! A word which directly calls primitives. It is used to

core/io/streams/lines/lines.factor

@@ -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
+USING: io.encodings.latin1 io.encodings ;
-vectors combinators splitting ;
 
 TUPLE: line-reader cr ;
 
 : <line-reader> ( stream -- new-stream )
-    line-reader construct-delegate ;
+    latin1 <decoded> ;
-
-: 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 ;

core/io/streams/plain/plain.factor

@@ -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
+USING: io.encodings.latin1 io.encodings ;
-io.styles io io.streams.nested ;
-
-TUPLE: plain-writer ;
 
 : <plain-writer> ( stream -- new-stream )
-    plain-writer construct-delegate ;
+    latin1 <encoded> ; 
-
-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> ;

extra/io/nonblocking/nonblocking.factor

@@ -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>

extra/io/unix/files/files.factor

@@ -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 -- )

extra/io/windows/windows.factor

@@ -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 -- )