proquint: adding the Proquint encoding/decoding

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

diff --git a/extra/proquint/proquint-tests.factor b/extra/proquint/proquint-tests.factor
new file mode 100644 (file)
index 0000000..0a3f81e
--- /dev/null
+++ b/extra/proquint/proquint-tests.factor
@@ -0,0 +1,24 @@
+USING: assocs ip-parser kernel proquint tools.test ;
+
+{ t } [
+    {
+        { "127.0.0.1"       "lusab-babad" }
+        { "63.84.220.193"   "gutih-tugad" }
+        { "63.118.7.35"     "gutuk-bisog" }
+        { "140.98.193.141"  "mudof-sakat" }
+        { "64.255.6.200"    "haguz-biram" }
+        { "128.30.52.45"    "mabiv-gibot" }
+        { "147.67.119.2"    "natag-lisaf" }
+        { "212.58.253.68"   "tibup-zujah" }
+        { "216.35.68.215"   "tobog-higil" }
+        { "216.68.232.21"   "todah-vobij" }
+        { "198.81.129.136"  "sinid-makam" }
+        { "12.110.110.204"  "budov-kuras" }
+    } [
+        [ ipv4-aton ] dip
+        [ quint> = ] [ swap >quint32 = ] 2bi and
+    ] assoc-all?
+] unit-test
+
+{ "babab-babab-babab-babab-babab-babab-babab-babad" } [ "::1" ipv6>quint ] unit-test
+{ "::1" } [ "babab-babab-babab-babab-babab-babab-babab-babad" quint>ipv6 ] unit-test

diff --git a/extra/proquint/proquint.factor b/extra/proquint/proquint.factor
new file mode 100644 (file)
index 0000000..cf5a9f3
--- /dev/null
+++ b/extra/proquint/proquint.factor
@@ -0,0 +1,59 @@
+! Copyright (C) 2023 John Benediktsson
+! See https://factorcode.org/license.txt for BSD license
+
+USING: base64.private ip-parser kernel literals math
+math.bitwise sequences ;
+
+IN: proquint
+
+! https://arxiv.org/html/0901.4016
+
+<PRIVATE
+<<
+CONSTANT: consonant "bdfghjklmnprstvz"
+CONSTANT: vowel "aiou"
+>>
+PRIVATE>
+
+: >quint16 ( m -- str )
+    5 [
+        even? [
+            [ -4 shift ] [ 4 bits consonant nth ] bi
+        ] [
+            [ -2 shift ] [ 2 bits vowel nth ] bi
+        ] if
+    ] "" map-integers-as reverse nip ;
+
+: >quint32 ( m -- str )
+    [ -16 shift ] keep [ 16 bits >quint16 ] bi@ "-" glue ;
+
+: >quint64 ( m -- str )
+    { -48 -32 -16 0 } [ 16 shift-mod >quint16 ] with map "-" join ;
+
+: >quint128 ( m -- str )
+    { -112 -96 -80 -64 -48 -32 -16 0 } [ 16 shift-mod >quint16 ] with map "-" join ;
+
+: quint> ( str -- m )
+    0 [
+        dup $[ consonant alphabet-inverse ] nth [
+            nip [ 4 shift ] [ + ] bi*
+        ] [
+            dup $[ vowel alphabet-inverse ] nth [
+                nip [ 2 shift ] [ + ] bi*
+            ] [
+                CHAR: - assert=
+            ] if*
+        ] if*
+    ] reduce ;
+
+: ipv4>quint ( ipv4 -- str )
+    ipv4-aton >quint32 ;
+
+: quint>ipv4 ( str -- ipv4 )
+    quint> ipv4-ntoa ;
+
+: ipv6>quint ( ipv6 -- str )
+    ipv6-aton >quint128 ;
+
+: quint>ipv6 ( str -- ipv6 )
+    quint> ipv6-ntoa ;

diff --git a/extra/proquint/summary.txt b/extra/proquint/summary.txt
new file mode 100644 (file)
index 0000000..8bc807d
--- /dev/null
+++ b/extra/proquint/summary.txt
@@ -0,0 +1 @@
+Proquint encoding/decoding