diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor old mode 100644 new mode 100755 index d69d8e9e8e..827d478d06 --- a/core/alien/strings/strings.factor +++ b/core/alien/strings/strings.factor @@ -85,10 +85,10 @@ M: string-type c-type-getter M: string-type c-type-setter drop [ set-alien-cell ] ; -TUPLE: utf16n ; - ! Native-order UTF-16 +SINGLETON: utf16n + : utf16n ( -- descriptor ) little-endian? utf16le utf16be ? ; foldable diff --git a/core/io/encodings/binary/binary.factor b/core/io/encodings/binary/binary.factor old mode 100644 new mode 100755 index 5038628ed9..e54163f632 --- a/core/io/encodings/binary/binary.factor +++ b/core/io/encodings/binary/binary.factor @@ -3,6 +3,6 @@ USING: io.encodings kernel ; IN: io.encodings.binary -TUPLE: binary ; +SINGLETON: binary M: binary drop ; M: binary drop ; diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor index e6b180fde2..ea74490858 100755 --- a/core/io/encodings/encodings-tests.factor +++ b/core/io/encodings/encodings-tests.factor @@ -1,5 +1,6 @@ -USING: io.files io.streams.string io -tools.test kernel io.encodings.ascii ; +USING: io.files io.streams.string io io.streams.byte-array +tools.test kernel io.encodings.ascii io.encodings.utf8 +namespaces accessors io.encodings ; IN: io.streams.encodings.tests [ { } ] @@ -56,3 +57,19 @@ unit-test dup stream-readln drop stream-read1 ] unit-test + +[ utf8 ascii ] [ + "foo" utf8 [ + input-stream get code>> + ascii decode-input + input-stream get code>> + ] with-byte-reader +] unit-test + +[ utf8 ascii ] [ + utf8 [ + output-stream get code>> + ascii encode-output + output-stream get code>> + ] with-byte-writer drop +] unit-test diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 0f6e58bdc9..daaf1c129d 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -30,8 +30,7 @@ ERROR: encode-error ; new ; -M: tuple f decoder boa ; +M: object f decoder boa ; : >decoder< ( decoder -- stream encoding ) [ stream>> ] [ code>> ] bi ; @@ -104,8 +103,7 @@ M: decoder stream-readln ( stream -- str ) M: decoder dispose decoder-stream dispose ; ! Encoding -M: tuple-class new ; -M: tuple encoder boa ; +M: object encoder boa ; : >encoder< ( encoder -- stream encoding ) [ stream>> ] [ code>> ] bi ; @@ -121,13 +119,16 @@ M: encoder dispose encoder-stream dispose ; M: encoder stream-flush encoder-stream stream-flush ; INSTANCE: encoder plain-writer +PRIVATE> -! Rebinding duplex streams which have not read anything yet - -: reencode ( stream encoding -- newstream ) +: re-encode ( stream encoding -- newstream ) over encoder? [ >r encoder-stream r> ] when ; -: redecode ( stream encoding -- newstream ) +: encode-output ( encoding -- ) + output-stream [ swap re-encode ] change ; + +: re-decode ( stream encoding -- newstream ) over decoder? [ >r decoder-stream r> ] when ; -PRIVATE> +: decode-input ( encoding -- ) + input-stream [ swap re-decode ] change ; diff --git a/core/io/encodings/utf16/utf16-tests.factor b/core/io/encodings/utf16/utf16-tests.factor index 0d171ee9aa..ac5caba61c 100755 --- a/core/io/encodings/utf16/utf16-tests.factor +++ b/core/io/encodings/utf16/utf16-tests.factor @@ -24,7 +24,7 @@ IN: io.encodings.utf16.tests [ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test : correct-endian - code>> class little-endian? [ utf16le = ] [ utf16be = ] if ; + code>> little-endian? [ utf16le = ] [ utf16be = ] if ; [ t ] [ B{ } utf16n correct-endian ] unit-test [ t ] [ utf16n correct-endian ] unit-test diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor index 9093132e5f..c0aaadc947 100755 --- a/core/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -4,11 +4,11 @@ USING: math kernel sequences sbufs vectors namespaces io.binary io.encodings combinators splitting io byte-arrays inspector ; IN: io.encodings.utf16 -TUPLE: utf16be ; +SINGLETON: utf16be -TUPLE: utf16le ; +SINGLETON: utf16le -TUPLE: utf16 ; +SINGLETON: utf16 ( str -- stream ) diff --git a/extra/descriptive/authors.txt b/extra/descriptive/authors.txt new file mode 100755 index 0000000000..504363d316 --- /dev/null +++ b/extra/descriptive/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/descriptive/descriptive-docs.factor b/extra/descriptive/descriptive-docs.factor new file mode 100755 index 0000000000..dc02f8bd9d --- /dev/null +++ b/extra/descriptive/descriptive-docs.factor @@ -0,0 +1,22 @@ +USING: help.syntax help.markup ; +IN: descriptive + +HELP: DESCRIPTIVE: +{ $syntax "DESCRIPTIVE: word ( inputs -- outputs ) definition ;" } +{ $description "Defines a word such that, if an error is thrown from within it, that error is wrapped in a descriptive tag including the arguments to that word." } ; + +HELP: DESCRIPTIVE:: +{ $syntax "DESCRIPTIVE:: word ( inputs -- outputs ) definition ;" } +{ $description "Defines a word which uses locals such that, if an error is thrown from within it, that error is wrapped in a descriptive tag including the arguments to that word." } ; + +HELP: descriptive +{ $class-description "The class of errors wrapping another error (in the underlying slot) which were thrown in a word (in the word slot) with a given set of arguments (in the args slot)." } ; + +ARTICLE: "descriptive" "Descriptive errors" +"This vocabulary defines automatic descriptive errors. Using it, you can define a word which acts as normal, except when it throws an error, the error is wrapped in a special descriptor declaring that an error was thrown from inside that word, and including the arguments given to that word. The error is of the following class:" +{ $subsection descriptive } +"To define words which throw descriptive errors, use the following words:" +{ $subsection POSTPONE: DESCRIPTIVE: } +{ $subsection POSTPONE: DESCRIPTIVE:: } ; + +ABOUT: "descriptive" diff --git a/extra/descriptive/descriptive-tests.factor b/extra/descriptive/descriptive-tests.factor index 4aabbb9be0..c1e9654fc5 100755 --- a/extra/descriptive/descriptive-tests.factor +++ b/extra/descriptive/descriptive-tests.factor @@ -4,13 +4,13 @@ IN: descriptive.tests DESCRIPTIVE: divide ( num denom -- fraction ) / ; [ 3 ] [ 9 3 divide ] unit-test -[ T{ known f H{ { "num" 3 } { "denom" 0 } } "Division by zero" divide } ] [ [ 3 0 divide ] [ ] recover ] unit-test +[ T{ descriptive f { { "num" 3 } { "denom" 0 } } "Division by zero" divide } ] [ [ 3 0 divide ] [ ] recover ] unit-test [ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE: divide ( num denom -- fraction ) / ;\n" ] [ \ divide [ see ] with-string-writer ] unit-test DESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ; [ 3 ] [ 9 3 divide* ] unit-test -[ T{ known f H{ { "num" 3 } { "denom" 0 } } "Division by zero" divide* } ] [ [ 3 0 divide* ] [ ] recover ] unit-test +[ T{ descriptive f { { "num" 3 } { "denom" 0 } } "Division by zero" divide* } ] [ [ 3 0 divide* ] [ ] recover ] unit-test [ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;\n" ] [ \ divide* [ see ] with-string-writer ] unit-test diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index f5a71ab6e3..a98f379124 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -1,22 +1,23 @@ USING: words kernel sequences combinators.lib locals locals.private accessors parser namespaces continuations -inspector definitions ; +inspector definitions arrays.lib arrays ; IN: descriptive -ERROR: known args underlying word ; +ERROR: descriptive args underlying word ; -M: known summary +M: descriptive summary word>> "The " swap word-name " word encountered an error." 3append ; +r narray r> swap 2array flip ] 2curry + [ 2 ndip descriptive ] 2curry ; : [descriptive] ( word def -- newdef ) swap dup "declared-effect" word-prop in>> rethrower [ recover ] 2curry ; +PRIVATE> : define-descriptive ( word def -- ) [ "descriptive-definition" set-word-prop ] @@ -25,12 +26,12 @@ M: known summary : DESCRIPTIVE: (:) define-descriptive ; parsing -PREDICATE: descriptive-word < word +PREDICATE: descriptive-def < word "descriptive-definition" word-prop ; -M: descriptive-word definer drop \ DESCRIPTIVE: \ ; ; +M: descriptive-def definer drop \ DESCRIPTIVE: \ ; ; -M: descriptive-word definition +M: descriptive-def definition "descriptive-definition" word-prop ; : DESCRIPTIVE:: diff --git a/extra/descriptive/summary.txt b/extra/descriptive/summary.txt new file mode 100755 index 0000000000..635b448772 --- /dev/null +++ b/extra/descriptive/summary.txt @@ -0,0 +1 @@ +Descriptive errors generated automatically for specially defined words diff --git a/extra/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor old mode 100644 new mode 100755 index d3fe51f28d..9ff120c5fa --- a/extra/io/encodings/ascii/ascii.factor +++ b/extra/io/encodings/ascii/ascii.factor @@ -13,7 +13,7 @@ IN: io.encodings.ascii [ drop f ] if* ; PRIVATE> -TUPLE: ascii ; +SINGLETON: ascii M: ascii encode-char 128 encode-if< ; diff --git a/extra/io/streams/duplex/duplex.factor b/extra/io/streams/duplex/duplex.factor index cb96d8017a..6ac663f9f2 100755 --- a/extra/io/streams/duplex/duplex.factor +++ b/extra/io/streams/duplex/duplex.factor @@ -47,7 +47,7 @@ M: duplex-stream dispose ] unless drop ; : ( stream-in stream-out encoding -- duplex ) - tuck reencode >r redecode r> ; + tuck re-encode >r re-decode r> ; : with-stream* ( stream quot -- ) >r [ in>> ] [ out>> ] bi r> with-streams* ; inline