+++ /dev/null
-! Copyright (C) 2008 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-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 ;
-
-TUPLE: ascii ;
-
-M: ascii encode-string
- drop 127 encode-check>= ;
-
-M: ascii decode-step
- 3drop dup 127 >= [ encode-error ] when over push f f ;
+++ /dev/null
-Daniel Ehrenberg
+++ /dev/null
-Daniel Ehrenberg
+++ /dev/null
-USING: help.syntax help.markup ;
-IN: io.encodings.latin1
-
-HELP: latin1
-{ $class-description "This class is used for Latin 1 (ISO 8859-1) encoding and decoding" } ;
+++ /dev/null
-! Copyright (C) 2008 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: io io.encodings strings kernel io.encodings.ascii sequences ;
-IN: io.encodings.latin1
-
-TUPLE: latin1 ;
-
-M: latin1 encode-string
- drop 255 encode-check>= ;
-
-M: latin1 decode-step
- 3drop over push f f ;
+++ /dev/null
-ISO 8859-1 encoding/decoding
+++ /dev/null
-Daniel Ehrenberg
+++ /dev/null
-UTF16 encoding/decoding
+++ /dev/null
-USING: help.markup help.syntax io.encodings strings ;
-IN: io.encodings.utf16
-
-ARTICLE: "io.utf16" "Working with UTF16-encoded data"
-"The UTF16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences."
-{ $subsection encode-utf16le }
-{ $subsection encode-utf16be }
-{ $subsection decode-utf16le }
-{ $subsection decode-utf16be }
-"Support for UTF16 data with a byte order mark:"
-{ $subsection encode-utf16 }
-{ $subsection decode-utf16 } ;
-
-ABOUT: "io.utf16"
-
-HELP: decode-utf16
-{ $values { "seq" "a sequence of bytes" } { "str" string } }
-{ $description "Decodes a sequence of bytes representing a Unicode string in UTF16 format. The bytes must begin with a UTF16 byte order mark, which determines if the input is in little or big endian. To decode data without a byte order mark, use " { $link decode-utf16le } " or " { $link decode-utf16be } "." }
-{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
-
-HELP: decode-utf16be
-{ $values { "seq" "a sequence of bytes" } { "str" string } }
-{ $description "Decodes a sequence of bytes representing a Unicode string in big endian UTF16 format. The bytes must not begin with a UTF16 byte order mark. To decode data with a byte order mark, use " { $link decode-utf16 } "." }
-{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
-
-HELP: decode-utf16le
-{ $values { "seq" "a sequence of bytes" } { "str" string } }
-{ $description "Decodes a sequence of bytes representing a Unicode string in little endian UTF16 format. The bytes must not begin with a UTF16 byte order mark. To decode data with a byte order mark, use " { $link decode-utf16 } "." }
-{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
-
-{ decode-utf16 decode-utf16le decode-utf16be } related-words
-
-HELP: encode-utf16be
-{ $values { "str" string } { "seq" "a sequence of bytes" } }
-{ $description "Encodes a Unicode string as a sequence of bytes in big endian UTF16 format." } ;
-
-HELP: encode-utf16le
-{ $values { "str" string } { "seq" "a sequence of bytes" } }
-{ $description "Encodes a Unicode string as a sequence of bytes in little endian UTF16 format." } ;
-
-HELP: encode-utf16
-{ $values { "str" string } { "seq" "a sequence of bytes" } }
-{ $description "Encodes a Unicode string as a sequence of bytes in UTF16 format with a byte order mark." } ;
-
-{ encode-utf16 encode-utf16be encode-utf16le } related-words
+++ /dev/null
-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 ;
-
-: encode-w/stream ( array encoding -- newarray )
- >r SBUF" " clone tuck r> <encoding> 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
-[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode-w/stream ] unit-test
-
-[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode-w/stream ] unit-test
-
-[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode-w/stream ] unit-test
-[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode-w/stream ] unit-test
-[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test
-
-[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode-w/stream ] unit-test
-
-[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode-w/stream ] unit-test
-[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode-w/stream ] unit-test
-
-[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode-w/stream ] unit-test
+++ /dev/null
-! Copyright (C) 2006, 2008 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: math kernel sequences sbufs vectors namespaces io.binary
-io.encodings combinators splitting io byte-arrays ;
-IN: io.encodings.utf16
-
-SYMBOL: double
-SYMBOL: quad1
-SYMBOL: quad2
-SYMBOL: quad3
-SYMBOL: ignore
-
-: do-ignore ( -- ch state ) 0 ignore ;
-
-: append-nums ( byte ch -- ch )
- 8 shift bitor ;
-
-: end-multibyte ( buf byte ch -- buf ch state )
- append-nums push-decoded ;
-
-: begin-utf16be ( buf byte -- buf ch state )
- dup -3 shift BIN: 11011 number= [
- dup BIN: 00000100 bitand zero?
- [ BIN: 11 bitand quad1 ]
- [ drop do-ignore ] if
- ] [ double ] if ;
-
-: handle-quad2be ( byte ch -- ch state )
- swap dup -2 shift BIN: 110111 number= [
- >r 2 shift r> BIN: 11 bitand bitor quad3
- ] [ 2drop do-ignore ] if ;
-
-: decode-utf16be-step ( buf byte ch state -- buf ch state )
- {
- { begin [ drop begin-utf16be ] }
- { double [ end-multibyte ] }
- { quad1 [ append-nums quad2 ] }
- { quad2 [ handle-quad2be ] }
- { quad3 [ append-nums HEX: 10000 + push-decoded ] }
- { ignore [ 2drop push-replacement ] }
- } case ;
-
-: decode-utf16be ( seq -- str )
- [ decode-utf16be-step ] decode ;
-
-: handle-double ( buf byte ch -- buf ch state )
- swap dup -3 shift BIN: 11011 = [
- dup BIN: 100 bitand 0 number=
- [ BIN: 11 bitand 8 shift bitor quad2 ]
- [ 2drop push-replacement ] if
- ] [ end-multibyte ] if ;
-
-: handle-quad3le ( buf byte ch -- buf ch state )
- swap dup -2 shift BIN: 110111 = [
- BIN: 11 bitand append-nums HEX: 10000 + push-decoded
- ] [ 2drop push-replacement ] if ;
-
-: decode-utf16le-step ( buf byte ch state -- buf ch state )
- {
- { begin [ drop double ] }
- { double [ handle-double ] }
- { quad1 [ append-nums quad2 ] }
- { quad2 [ 10 shift bitor quad3 ] }
- { quad3 [ handle-quad3le ] }
- } case ;
-
-: decode-utf16le ( seq -- str )
- [ decode-utf16le-step ] decode ;
-
-: encode-first
- -10 shift
- dup -8 shift BIN: 11011000 bitor
- swap HEX: FF bitand ;
-
-: encode-second
- BIN: 1111111111 bitand
- dup -8 shift BIN: 11011100 bitor
- swap BIN: 11111111 bitand ;
-
-: char>utf16be ( char -- )
- dup HEX: FFFF > [
- HEX: 10000 -
- dup encode-first swap , ,
- encode-second swap , ,
- ] [ h>b/b , , ] if ;
-
-: encode-utf16be ( str -- seq )
- [ [ char>utf16be ] each ] B{ } make ;
-
-: char>utf16le ( char -- )
- dup HEX: FFFF > [
- HEX: 10000 -
- dup encode-first , ,
- encode-second , ,
- ] [ h>b/b swap , , ] if ;
-
-: encode-utf16le ( str -- seq )
- [ [ char>utf16le ] each ] B{ } make ;
-
-: bom-le B{ HEX: ff HEX: fe } ; inline
-
-: bom-be B{ HEX: fe HEX: ff } ; inline
-
-: encode-utf16 ( str -- seq )
- encode-utf16le bom-le swap append ;
-
-: start-utf16le? ( seq1 -- seq2 ? ) bom-le ?head ;
-
-: start-utf16be? ( seq1 -- seq2 ? ) bom-be ?head ;
-
-: decode-utf16 ( seq -- str )
- {
- { [ start-utf16le? ] [ decode-utf16le ] }
- { [ start-utf16be? ] [ decode-utf16be ] }
- { [ t ] [ decode-error ] }
- } cond ;
-
-TUPLE: utf16le ;
-
-M: utf16le encode-string drop encode-utf16le ;
-M: utf16le decode-step drop decode-utf16le-step ;
-
-TUPLE: utf16be ;
-
-M: utf16be encode-string drop encode-utf16be ;
-M: utf16be decode-step drop decode-utf16be-step ;
-
-TUPLE: utf16 encoding ;
-M: utf16 underlying-stream delegate dup delegate [ ] [ ] ?if ; ! necessary?
-M: utf16 set-underlying-stream delegate set-delegate ; ! necessary?
-
-M: utf16 encode-string
- >r encode-utf16le r>
- dup utf16-encoding [ drop ]
- [ t swap set-utf16-encoding bom-le swap append ] if ;
-
-: bom>le/be ( bom -- le/be )
- dup bom-le sequence= [ drop utf16le ] [
- bom-be sequence= [ utf16be ] [ decode-error ] if
- ] if ;
-
-: read-bom ( utf16 -- encoding )
- 2 over delegate stream-read bom>le/be construct-empty
- [ swap set-utf16-encoding ] keep ;
-
-M: utf16 decode-step
- ! inefficient: checks if bom is done many times
- ! This should transform itself into utf16be or utf16le after reading BOM
- dup utf16-encoding [ ] [ read-bom ] ?if decode-step ;
--- /dev/null
+! Copyright (C) 2008 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+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 ;
+
+TUPLE: ascii ;
+
+M: ascii encode-string
+ drop 127 encode-check>= ;
+
+M: ascii decode-step
+ 3drop dup 127 >= [ encode-error ] when over push f f ;
--- /dev/null
+Daniel Ehrenberg
--- /dev/null
+ASCII encoding for streams
--- /dev/null
+Daniel Ehrenberg
--- /dev/null
+USING: help.syntax help.markup ;
+IN: io.encodings.latin1
+
+HELP: latin1
+{ $class-description "This class is used for Latin 1 (ISO 8859-1) encoding and decoding" } ;
--- /dev/null
+! Copyright (C) 2008 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io io.encodings strings kernel io.encodings.ascii sequences ;
+IN: io.encodings.latin1
+
+TUPLE: latin1 ;
+
+M: latin1 encode-string
+ drop 255 encode-check>= ;
+
+M: latin1 decode-step
+ 3drop over push f f ;
--- /dev/null
+ISO 8859-1 encoding/decoding
--- /dev/null
+Daniel Ehrenberg
--- /dev/null
+UTF16 encoding/decoding
--- /dev/null
+USING: help.markup help.syntax io.encodings strings ;
+IN: io.encodings.utf16
+
+ARTICLE: "io.utf16" "Working with UTF16-encoded data"
+"The UTF16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences."
+{ $subsection encode-utf16le }
+{ $subsection encode-utf16be }
+{ $subsection decode-utf16le }
+{ $subsection decode-utf16be }
+"Support for UTF16 data with a byte order mark:"
+{ $subsection encode-utf16 }
+{ $subsection decode-utf16 } ;
+
+ABOUT: "io.utf16"
+
+HELP: decode-utf16
+{ $values { "seq" "a sequence of bytes" } { "str" string } }
+{ $description "Decodes a sequence of bytes representing a Unicode string in UTF16 format. The bytes must begin with a UTF16 byte order mark, which determines if the input is in little or big endian. To decode data without a byte order mark, use " { $link decode-utf16le } " or " { $link decode-utf16be } "." }
+{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
+
+HELP: decode-utf16be
+{ $values { "seq" "a sequence of bytes" } { "str" string } }
+{ $description "Decodes a sequence of bytes representing a Unicode string in big endian UTF16 format. The bytes must not begin with a UTF16 byte order mark. To decode data with a byte order mark, use " { $link decode-utf16 } "." }
+{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
+
+HELP: decode-utf16le
+{ $values { "seq" "a sequence of bytes" } { "str" string } }
+{ $description "Decodes a sequence of bytes representing a Unicode string in little endian UTF16 format. The bytes must not begin with a UTF16 byte order mark. To decode data with a byte order mark, use " { $link decode-utf16 } "." }
+{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
+
+{ decode-utf16 decode-utf16le decode-utf16be } related-words
+
+HELP: encode-utf16be
+{ $values { "str" string } { "seq" "a sequence of bytes" } }
+{ $description "Encodes a Unicode string as a sequence of bytes in big endian UTF16 format." } ;
+
+HELP: encode-utf16le
+{ $values { "str" string } { "seq" "a sequence of bytes" } }
+{ $description "Encodes a Unicode string as a sequence of bytes in little endian UTF16 format." } ;
+
+HELP: encode-utf16
+{ $values { "str" string } { "seq" "a sequence of bytes" } }
+{ $description "Encodes a Unicode string as a sequence of bytes in UTF16 format with a byte order mark." } ;
+
+{ encode-utf16 encode-utf16be encode-utf16le } related-words
--- /dev/null
+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 ;
+
+: encode-w/stream ( array encoding -- newarray )
+ >r SBUF" " clone tuck r> <encoding> 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
+[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode-w/stream ] unit-test
+[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode-w/stream ] unit-test
+
+[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode-w/stream ] unit-test
+
+[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode-w/stream ] unit-test
+[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test
+[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode-w/stream ] unit-test
+[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode-w/stream ] unit-test
+[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test
+
+[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode-w/stream ] unit-test
+
+[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode-w/stream ] unit-test
+[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode-w/stream ] unit-test
+
+[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode-w/stream ] unit-test
--- /dev/null
+! Copyright (C) 2006, 2008 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: math kernel sequences sbufs vectors namespaces io.binary
+io.encodings combinators splitting io byte-arrays ;
+IN: io.encodings.utf16
+
+SYMBOL: double
+SYMBOL: quad1
+SYMBOL: quad2
+SYMBOL: quad3
+SYMBOL: ignore
+
+: do-ignore ( -- ch state ) 0 ignore ;
+
+: append-nums ( byte ch -- ch )
+ 8 shift bitor ;
+
+: end-multibyte ( buf byte ch -- buf ch state )
+ append-nums push-decoded ;
+
+: begin-utf16be ( buf byte -- buf ch state )
+ dup -3 shift BIN: 11011 number= [
+ dup BIN: 00000100 bitand zero?
+ [ BIN: 11 bitand quad1 ]
+ [ drop do-ignore ] if
+ ] [ double ] if ;
+
+: handle-quad2be ( byte ch -- ch state )
+ swap dup -2 shift BIN: 110111 number= [
+ >r 2 shift r> BIN: 11 bitand bitor quad3
+ ] [ 2drop do-ignore ] if ;
+
+: decode-utf16be-step ( buf byte ch state -- buf ch state )
+ {
+ { begin [ drop begin-utf16be ] }
+ { double [ end-multibyte ] }
+ { quad1 [ append-nums quad2 ] }
+ { quad2 [ handle-quad2be ] }
+ { quad3 [ append-nums HEX: 10000 + push-decoded ] }
+ { ignore [ 2drop push-replacement ] }
+ } case ;
+
+: decode-utf16be ( seq -- str )
+ [ decode-utf16be-step ] decode ;
+
+: handle-double ( buf byte ch -- buf ch state )
+ swap dup -3 shift BIN: 11011 = [
+ dup BIN: 100 bitand 0 number=
+ [ BIN: 11 bitand 8 shift bitor quad2 ]
+ [ 2drop push-replacement ] if
+ ] [ end-multibyte ] if ;
+
+: handle-quad3le ( buf byte ch -- buf ch state )
+ swap dup -2 shift BIN: 110111 = [
+ BIN: 11 bitand append-nums HEX: 10000 + push-decoded
+ ] [ 2drop push-replacement ] if ;
+
+: decode-utf16le-step ( buf byte ch state -- buf ch state )
+ {
+ { begin [ drop double ] }
+ { double [ handle-double ] }
+ { quad1 [ append-nums quad2 ] }
+ { quad2 [ 10 shift bitor quad3 ] }
+ { quad3 [ handle-quad3le ] }
+ } case ;
+
+: decode-utf16le ( seq -- str )
+ [ decode-utf16le-step ] decode ;
+
+: encode-first
+ -10 shift
+ dup -8 shift BIN: 11011000 bitor
+ swap HEX: FF bitand ;
+
+: encode-second
+ BIN: 1111111111 bitand
+ dup -8 shift BIN: 11011100 bitor
+ swap BIN: 11111111 bitand ;
+
+: char>utf16be ( char -- )
+ dup HEX: FFFF > [
+ HEX: 10000 -
+ dup encode-first swap , ,
+ encode-second swap , ,
+ ] [ h>b/b , , ] if ;
+
+: encode-utf16be ( str -- seq )
+ [ [ char>utf16be ] each ] B{ } make ;
+
+: char>utf16le ( char -- )
+ dup HEX: FFFF > [
+ HEX: 10000 -
+ dup encode-first , ,
+ encode-second , ,
+ ] [ h>b/b swap , , ] if ;
+
+: encode-utf16le ( str -- seq )
+ [ [ char>utf16le ] each ] B{ } make ;
+
+: bom-le B{ HEX: ff HEX: fe } ; inline
+
+: bom-be B{ HEX: fe HEX: ff } ; inline
+
+: encode-utf16 ( str -- seq )
+ encode-utf16le bom-le swap append ;
+
+: start-utf16le? ( seq1 -- seq2 ? ) bom-le ?head ;
+
+: start-utf16be? ( seq1 -- seq2 ? ) bom-be ?head ;
+
+: decode-utf16 ( seq -- str )
+ {
+ { [ start-utf16le? ] [ decode-utf16le ] }
+ { [ start-utf16be? ] [ decode-utf16be ] }
+ { [ t ] [ decode-error ] }
+ } cond ;
+
+TUPLE: utf16le ;
+
+M: utf16le encode-string drop encode-utf16le ;
+M: utf16le decode-step drop decode-utf16le-step ;
+
+TUPLE: utf16be ;
+
+M: utf16be encode-string drop encode-utf16be ;
+M: utf16be decode-step drop decode-utf16be-step ;
+
+TUPLE: utf16 encoding ;
+M: utf16 underlying-stream delegate dup delegate [ ] [ ] ?if ; ! necessary?
+M: utf16 set-underlying-stream delegate set-delegate ; ! necessary?
+
+M: utf16 encode-string
+ >r encode-utf16le r>
+ dup utf16-encoding [ drop ]
+ [ t swap set-utf16-encoding bom-le swap append ] if ;
+
+: bom>le/be ( bom -- le/be )
+ dup bom-le sequence= [ drop utf16le ] [
+ bom-be sequence= [ utf16be ] [ decode-error ] if
+ ] if ;
+
+: read-bom ( utf16 -- encoding )
+ 2 over delegate stream-read bom>le/be construct-empty
+ [ swap set-utf16-encoding ] keep ;
+
+M: utf16 decode-step
+ ! inefficient: checks if bom is done many times
+ ! This should transform itself into utf16be or utf16le after reading BOM
+ dup utf16-encoding [ ] [ read-bom ] ?if decode-step ;
projects / factor.git / commitdiff