base91: adding version of base91 encoding/decoding.

extra/base91/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

extra/base91/base91-tests.factor

@@ -0,0 +1,23 @@
+USING: base91 byte-arrays kernel sequences tools.test ;
+
+{ t } [ 256 <iota> >byte-array dup >base91 base91> = ] unit-test
+
+{ B{ } } [ f >base91 ] unit-test
+{ "AA" } [ B{ 0 } >base91 "" like ] unit-test
+{ "GB" } [ "a" >base91 "" like ] unit-test
+{ "#GD" } [ "ab" >base91 "" like ] unit-test
+{ "#G(I" } [ "abc" >base91 "" like ] unit-test
+{ "#G(IZ" } [ "abcd" >base91 "" like ] unit-test
+{ "#G(Ic,A" } [ "abcde" >base91 "" like ] unit-test
+{ "#G(Ic,WC" } [ "abcdef" >base91 "" like ] unit-test
+{ "#G(Ic,5pG" } [ "abcdefg" >base91 "" like ] unit-test
+
+{ B{ } } [ f base91> ] unit-test
+{ "\0" } [ "AA" base91> "" like ] unit-test
+{ "a" } [ "GB" base91> "" like ] unit-test
+{ "ab" } [ "#GD" base91> "" like ] unit-test
+{ "abc" } [ "#G(I" base91> "" like ] unit-test
+{ "abcd" } [ "#G(IZ" base91> "" like ] unit-test
+{ "abcde" } [ "#G(Ic,A" base91> "" like ] unit-test
+{ "abcdef" } [ "#G(Ic,WC" base91> "" like ] unit-test
+{ "abcdefg" } [ "#G(Ic,5pG" base91> "" like ] unit-test

extra/base91/base91.factor

@@ -0,0 +1,83 @@
+! Copyright (C) 2019 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license.
+USING: base64.private byte-arrays kernel literals locals math
+sequences ;
+IN: base91
+
+ERROR: malformed-base91 ;
+
+<PRIVATE
+
+<<
+CONSTANT: alphabet $[
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!#$%&()*+,./:;<=>?@[]^_`{|}~\""
+    >byte-array
+]
+>>
+
+: ch>base91 ( ch -- ch )
+    alphabet nth ; inline
+
+: base91>ch ( ch -- ch )
+    $[ alphabet alphabet-inverse ] nth
+    [ malformed-base91 ] unless* ; inline
+
+PRIVATE>
+
+:: >base91 ( seq -- base91 )
+    0 :> b!
+    0 :> n!
+    BV{ } clone :> accum
+
+    seq [
+        n shift b bitor b!
+        n 8 + n!
+        n 13 > [
+            b 0x1fff bitand dup 88 > [
+                b -13 shift b!
+                n 13 - n!
+            ] [
+                drop b 0x3fff bitand
+                b -14 shift b!
+                n 14 - n!
+            ] if 91 /mod swap [ ch>base91 accum push ] bi@
+        ] when
+    ] each
+
+    n 0 > [
+        b 91 mod ch>base91 accum push
+        n 7 > b 90 > or [
+            b 91 /i ch>base91 accum push
+        ] when
+    ] when
+
+    accum B{ } like ;
+
+:: base91> ( base91 -- seq )
+    f :> v!
+    0 :> b!
+    0 :> n!
+    BV{ } clone :> accum
+
+    base91 [
+        base91>ch
+        v [
+            91 * v + v!
+            v n shift b bitor b!
+            v 0x1fff bitand 88 > 13 14 ? n + n!
+            [ n 7 > ] [
+                b 0xff bitand accum push
+                b -8 shift b!
+                n 8 - n!
+            ] do while
+            f v!
+        ] [
+            v!
+        ] if
+    ] each
+
+    v [
+        b v n shift bitor 0xff bitand accum push
+    ] when
+
+    accum B{ } like ;

extra/base91/summary.txt

@@ -0,0 +1 @@
+Base91 encoding/decoding