bencode: adding bencoding vocabulary.

diff --git a/extra/bencode/authors.txt b/extra/bencode/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/bencode/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/bencode/bencode-docs.factor b/extra/bencode/bencode-docs.factor
new file mode 100644 (file)
index 0000000..5fad1e2
--- /dev/null
+++ b/extra/bencode/bencode-docs.factor
@@ -0,0 +1,10 @@
+USING: help.markup help.syntax kernel strings ;
+IN: bencode
+
+HELP: >bencode
+{ $values { "obj" object } { "bencode" string } }
+{ $description "Encodes an object using the bencode algorithm." } ;
+
+HELP: bencode>
+{ $values { "bencode" string } { "obj" object } }
+{ $description "Decodes an object using the bencode algorithm." } ;

diff --git a/extra/bencode/bencode-tests.factor b/extra/bencode/bencode-tests.factor
new file mode 100644 (file)
index 0000000..e97de29
--- /dev/null
+++ b/extra/bencode/bencode-tests.factor
@@ -0,0 +1,14 @@
+USING: tools.test ;
+IN: bencode
+
+{ "i42e" } [ 42 >bencode ] unit-test
+{ "i0e" } [ 0 >bencode ] unit-test
+{ "i-42e" } [ -42 >bencode ] unit-test
+
+{ "4:spam" } [ "spam" >bencode ] unit-test
+
+{ { "spam" 42 } } [ "l4:spami42ee" bencode> ] unit-test
+
+{ H{ { "bar" "spam" } { "foo" 42 } } } [
+    "d3:bar4:spam3:fooi42ee" bencode>
+] unit-test

diff --git a/extra/bencode/bencode.factor b/extra/bencode/bencode.factor
new file mode 100644 (file)
index 0000000..2347595
--- /dev/null
+++ b/extra/bencode/bencode.factor
@@ -0,0 +1,52 @@
+USING: arrays assocs combinators hashtables io
+io.encodings.ascii io.encodings.string io.streams.string kernel
+math math.parser sequences strings ;
+IN: bencode
+
+GENERIC: >bencode ( obj -- bencode )
+
+M: integer >bencode
+    number>string "i" "e" surround ;
+
+M: string >bencode
+    [ length number>string ":" ] keep 3append ;
+
+M: sequence >bencode
+    [ >bencode ] map concat "l" "e" surround ;
+
+M: assoc >bencode
+    [ [ >bencode ] bi@ append ] { } assoc>map concat
+    "d" "e" surround ;
+
+<PRIVATE
+
+DEFER: read-bencode
+
+: read-integer ( -- obj )
+    "e" read-until CHAR: e assert= string>number ;
+
+: read-list ( -- obj )
+    [ read-bencode dup ] [ ] produce nip ;
+
+: read-dictionary ( -- obj )
+    [
+        read-bencode [ read-bencode 2array ] [ f ] if* dup
+    ] [ ] produce nip >hashtable ;
+
+: read-string ( prefix -- obj )
+    ":" read-until CHAR: : assert= swap prefix
+    string>number read ascii decode ;
+
+: read-bencode ( -- obj )
+    read1 {
+        { CHAR: i [ read-integer ] }
+        { CHAR: l [ read-list ] }
+        { CHAR: d [ read-dictionary ] }
+        { CHAR: e [ f ] }
+        [ read-string ]
+    } case ;
+
+PRIVATE>
+
+: bencode> ( bencode -- obj )
+    [ read-bencode ] with-string-reader ;

diff --git a/extra/bencode/summary.txt b/extra/bencode/summary.txt
new file mode 100644 (file)
index 0000000..ad5b65c
--- /dev/null
+++ b/extra/bencode/summary.txt
@@ -0,0 +1 @@
+Support for bencoding.