Encodings use singletons; descriptive error updates

diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor
old mode 100644 (file)
new mode 100755 (executable)
index d69d8e9..827d478
--- 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 (file)
new mode 100755 (executable)
index 5038628..e54163f
--- 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 <encoder> drop ;
 M: binary <decoder> drop ;

diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor
index e6b180fde2f249e566fce453a66753d6150b4989..ea74490858d6bbe61ed612c543127bdf0a0fd0a0 100755 (executable)
--- 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 0f6e58bdc9186262c16644d5fbb13becd89dfb2b..daaf1c129def1ba19762a7a9f9787f46956ed672 100755 (executable)
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -30,8 +30,7 @@ ERROR: encode-error ;
 
 <PRIVATE
 
-M: tuple-class <decoder> new <decoder> ;
-M: tuple <decoder> f decoder boa ;
+M: object <decoder> 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 <encoder> new <encoder> ;
-M: tuple <encoder> encoder boa ;
+M: object <encoder> 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 <encoder> ;
 
-: 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 <decoder> ;
 
-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 0d171ee9aa1c72809fb400b1e043c20d59639669..ac5caba61c6ba0f1ed2e63a58ec1337b4079089f 100755 (executable)
--- 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 <byte-reader> correct-endian ] unit-test
 [ t ] [ utf16n <byte-writer> correct-endian ] unit-test

diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor
index 9093132e5f2dd041b451cf5b9fffbe30294a51e6..c0aaadc9470a88f3912241d9f0a27fcae8532478 100755 (executable)
--- 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
 
 <PRIVATE
 

diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor
old mode 100644 (file)
new mode 100755 (executable)
index 7a22107..0952480
--- a/core/io/encodings/utf8/utf8.factor
+++ b/core/io/encodings/utf8/utf8.factor
@@ -6,7 +6,7 @@ IN: io.encodings.utf8
 
 ! Decoding UTF-8
 
-TUPLE: utf8 ;
+SINGLETON: utf8
 
 <PRIVATE 
 

diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor
index bcad667c60d5dfa822a64ab96f090b3b14803603..c0b37dbce7811c06d93f7204180cccc93773ae2e 100755 (executable)
--- a/core/io/streams/string/string.factor
+++ b/core/io/streams/string/string.factor
@@ -49,7 +49,7 @@ M: growable stream-read
 M: growable stream-read-partial
     stream-read ;
 
-TUPLE: null ;
+SINGLETON: null
 M: null decode-char drop stream-read1 ;
 
 : <string-reader> ( str -- stream )

diff --git a/extra/descriptive/authors.txt b/extra/descriptive/authors.txt
new file mode 100755 (executable)
index 0000000..504363d
--- /dev/null
+++ b/extra/descriptive/authors.txt
@@ -0,0 +1 @@
+Daniel Ehrenberg\r

diff --git a/extra/descriptive/descriptive-docs.factor b/extra/descriptive/descriptive-docs.factor
new file mode 100755 (executable)
index 0000000..dc02f8b
--- /dev/null
+++ b/extra/descriptive/descriptive-docs.factor
@@ -0,0 +1,22 @@
+USING: help.syntax help.markup ;\r
+IN: descriptive\r
+\r
+HELP: DESCRIPTIVE:\r
+{ $syntax "DESCRIPTIVE: word ( inputs -- outputs ) definition ;" }\r
+{ $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." } ;\r
+\r
+HELP: DESCRIPTIVE::\r
+{ $syntax "DESCRIPTIVE:: word ( inputs -- outputs ) definition ;" }\r
+{ $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." } ;\r
+\r
+HELP: descriptive\r
+{ $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)." } ;\r
+\r
+ARTICLE: "descriptive" "Descriptive errors"\r
+"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:"\r
+{ $subsection descriptive }\r
+"To define words which throw descriptive errors, use the following words:"\r
+{ $subsection POSTPONE: DESCRIPTIVE: }\r
+{ $subsection POSTPONE: DESCRIPTIVE:: } ;\r
+\r
+ABOUT: "descriptive"\r

diff --git a/extra/descriptive/descriptive-tests.factor b/extra/descriptive/descriptive-tests.factor
index 4aabbb9be0bba50a97fad99592574f1ae12a083e..c1e9654fc5d49f39006b25a15abfcabe7f5dba11 100755 (executable)
--- a/extra/descriptive/descriptive-tests.factor
+++ b/extra/descriptive/descriptive-tests.factor
@@ -4,13 +4,13 @@ IN: descriptive.tests
 DESCRIPTIVE: divide ( num denom -- fraction ) / ;\r
 \r
 [ 3 ] [ 9 3 divide ] unit-test\r
-[ T{ known f H{ { "num" 3 } { "denom" 0 } } "Division by zero" divide } ] [ [ 3 0 divide ] [ ] recover ] unit-test\r
+[ T{ descriptive f { { "num" 3 } { "denom" 0 } } "Division by zero" divide } ] [ [ 3 0 divide ] [ ] recover ] unit-test\r
 \r
 [ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE: divide ( num denom -- fraction ) / ;\n" ] [ \ divide [ see ] with-string-writer ] unit-test\r
 \r
 DESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;\r
 \r
 [ 3 ] [ 9 3 divide* ] unit-test\r
-[ T{ known f H{ { "num" 3 } { "denom" 0 } } "Division by zero" divide* } ] [ [ 3 0 divide* ] [ ] recover ] unit-test\r
+[ T{ descriptive f { { "num" 3 } { "denom" 0 } } "Division by zero" divide* } ] [ [ 3 0 divide* ] [ ] recover ] unit-test\r
 \r
 [ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;\n" ] [ \ divide* [ see ] with-string-writer ] unit-test\r

diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor
index f5a71ab6e3c3e8be5668c795352a2e8c48e2af81..a98f379124b945aeb7a9e9452f43eb79978c1ebc 100755 (executable)
--- a/extra/descriptive/descriptive.factor
+++ b/extra/descriptive/descriptive.factor
@@ -1,22 +1,23 @@
 USING: words kernel sequences combinators.lib locals\r
 locals.private accessors parser namespaces continuations\r
-inspector definitions ;\r
+inspector definitions arrays.lib arrays ;\r
 IN: descriptive\r
 \r
-ERROR: known args underlying word ;\r
+ERROR: descriptive args underlying word ;\r
 \r
-M: known summary\r
+M: descriptive summary\r
     word>> "The " swap word-name " word encountered an error."\r
     3append ;\r
 \r
+<PRIVATE\r
 : rethrower ( word inputs -- quot )\r
-    reverse [ [ set ] curry ] map concat [ ] like\r
-    [ H{ } make-assoc ] curry\r
-    [ 2 ndip known ] 2curry ;\r
+    [ length ] keep [ >r narray r> swap 2array flip ] 2curry\r
+    [ 2 ndip descriptive ] 2curry ;\r
 \r
 : [descriptive] ( word def -- newdef )\r
     swap dup "declared-effect" word-prop in>> rethrower\r
     [ recover ] 2curry ;\r
+PRIVATE>\r
 \r
 : define-descriptive ( word def -- )\r
     [ "descriptive-definition" set-word-prop ]\r
@@ -25,12 +26,12 @@ M: known summary
 : DESCRIPTIVE:\r
     (:) define-descriptive ; parsing\r
 \r
-PREDICATE: descriptive-word < word\r
+PREDICATE: descriptive-def < word\r
     "descriptive-definition" word-prop ;\r
 \r
-M: descriptive-word definer drop \ DESCRIPTIVE: \ ; ;\r
+M: descriptive-def definer drop \ DESCRIPTIVE: \ ; ;\r
 \r
-M: descriptive-word definition\r
+M: descriptive-def definition\r
     "descriptive-definition" word-prop ;\r
 \r
 : DESCRIPTIVE::\r

diff --git a/extra/descriptive/summary.txt b/extra/descriptive/summary.txt
new file mode 100755 (executable)
index 0000000..635b448
--- /dev/null
+++ b/extra/descriptive/summary.txt
@@ -0,0 +1 @@
+Descriptive errors generated automatically for specially defined words\r

diff --git a/extra/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor
old mode 100644 (file)
new mode 100755 (executable)
index d3fe51f..9ff120c
--- 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 cb96d8017a296f3bbf2c6385dfb28dd184a783b7..6ac663f9f2029a58b7973f0f69810340a91f60a3 100755 (executable)
--- a/extra/io/streams/duplex/duplex.factor
+++ b/extra/io/streams/duplex/duplex.factor
@@ -47,7 +47,7 @@ M: duplex-stream dispose
     ] unless drop ;
 
 : <encoder-duplex> ( stream-in stream-out encoding -- duplex )
-    tuck reencode >r redecode r> <duplex-stream> ;
+    tuck re-encode >r re-decode r> <duplex-stream> ;
 
 : with-stream* ( stream quot -- )
     >r [ in>> ] [ out>> ] bi r> with-streams* ; inline