proquint: change the interface to have >quint take bits

diff --git a/extra/proquint/proquint-tests.factor b/extra/proquint/proquint-tests.factor
index 0a3f81e68606515973080b9a9cf9a0fb7dd17197..d396175be3654808ae671785149b1d01f7227982 100644 (file)
--- a/extra/proquint/proquint-tests.factor
+++ b/extra/proquint/proquint-tests.factor
@@ -1,4 +1,4 @@
-USING: assocs ip-parser kernel proquint tools.test ;
+USING: assocs kernel proquint tools.test ;
 
 { t } [
     {
@@ -15,8 +15,7 @@ USING: assocs ip-parser kernel proquint tools.test ;
         { "198.81.129.136"  "sinid-makam" }
         { "12.110.110.204"  "budov-kuras" }
     } [
-        [ ipv4-aton ] dip
-        [ quint> = ] [ swap >quint32 = ] 2bi and
+        [ quint>ipv4 = ] [ swap ipv4>quint = ] 2bi and
     ] assoc-all?
 ] unit-test
 

diff --git a/extra/proquint/proquint.factor b/extra/proquint/proquint.factor
index 66742d64abb0d98985199ebd7202e70b92fe51aa..3ed3d742024da1f03abeb73f82b1f066620b153b 100644 (file)
--- a/extra/proquint/proquint.factor
+++ b/extra/proquint/proquint.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2023 John Benediktsson
 ! See https://factorcode.org/license.txt for BSD license
 
-USING: base64.private ip-parser kernel literals math
+USING: base64.private ip-parser kernel literals make math
 math.bitwise random sequences ;
 
 IN: proquint
@@ -9,11 +9,12 @@ IN: proquint
 ! https://arxiv.org/html/0901.4016
 
 <PRIVATE
+
 <<
 CONSTANT: consonant "bdfghjklmnprstvz"
+
 CONSTANT: vowel "aiou"
 >>
-PRIVATE>
 
 : >quint16 ( m -- str )
     5 [
@@ -24,17 +25,14 @@ PRIVATE>
         ] if
     ] "" map-integers-as reverse nip ;
 
-: >quint32 ( m -- str )
-    [ -16 shift ] keep [ 16 bits >quint16 ] bi@ "-" glue ;
-
-: >quint48 ( m -- str )
-    { -32 -16 0 } [ 16 shift-mod >quint16 ] with map "-" join ;
-
-: >quint64 ( m -- str )
-    { -48 -32 -16 0 } [ 16 shift-mod >quint16 ] with map "-" join ;
+PRIVATE>
 
-: >quint128 ( m -- str )
-    { -112 -96 -80 -64 -48 -32 -16 0 } [ 16 shift-mod >quint16 ] with map "-" join ;
+: >quint ( m bits -- str )
+    [
+        [ dup 0 > ] [
+            [ [ 16 bits >quint16 , ] [ -16 shift ] bi ] dip 16 -
+        ] while 2drop
+    ] { } make reverse "-" join ;
 
 : quint> ( str -- m )
     0 [
@@ -49,17 +47,17 @@ PRIVATE>
         ] if*
     ] reduce ;
 
-: quint-password ( -- quint )
-    48 random-bits >quint48 ;
+: quint-password ( bits -- quint )
+    [ random-bits ] [ >quint ] bi ;
 
 : ipv4>quint ( ipv4 -- str )
-    ipv4-aton >quint32 ;
+    ipv4-aton 32 >quint ;
 
 : quint>ipv4 ( str -- ipv4 )
     quint> ipv4-ntoa ;
 
 : ipv6>quint ( ipv6 -- str )
-    ipv6-aton >quint128 ;
+    ipv6-aton 128 >quint ;
 
 : quint>ipv6 ( str -- ipv6 )
     quint> ipv6-ntoa ;