factor: trim using lists

[factor.git] / extra / base32 / base32.factor

diff --git a/extra/base32/base32.factor b/extra/base32/base32.factor
index ae9bf3e43bbc85489efebbd794cdd28d1036f2f9..24b46f9236303ab10525f8068992ab759b6312d6 100644 (file)
--- a/extra/base32/base32.factor
+++ b/extra/base32/base32.factor
@@ -1,42 +1,77 @@
 ! Copyright (C) 2019 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
+USING: base64.private byte-arrays combinators endian io
+io.encodings.binary io.streams.byte-array kernel kernel.private
+literals math namespaces sequences ;
+IN: base32
 
-USING: ascii assocs byte-arrays kernel literals math sequences ;
+ERROR: malformed-base32 ;
 
-IN: base32
+! XXX: Optional map 0 as O
+! XXX: Optional map 1 as L or I
+! XXX: Optional handle lower-case input
 
 <PRIVATE
 
 <<
-CONSTANT: ALPHABET $[ "0123456789ABCDEFGHJKMNPQRSTVWXYZ" >byte-array ]
+CONSTANT: alphabet $[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" >byte-array ]
 >>
-CONSTANT: INVERSE $[ 256 [ ALPHABET index 0xff or ] B{ } map-integers ]
-CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ]
 
-: normalize-base32 ( seq -- seq' )
-    CHAR: - swap remove >upper H{
-        { CHAR: I CHAR: 1 }
-        { CHAR: L CHAR: 1 }
-        { CHAR: O CHAR: 0 }
-    } substitute ;
+: ch>base32 ( ch -- ch )
+    alphabet nth ; inline
+
+: base32>ch ( ch -- ch )
+    $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
+    [ malformed-base32 ] unless* { fixnum } declare ; inline
+
+: encode5 ( seq -- byte-array )
+    be> { -35 -30 -25 -20 -15 -10 -5 0 } '[
+        shift 0x1f bitand ch>base32
+    ] with B{ } map-as ; inline
 
-: parse-base32 ( seq -- base32 )
-    0 swap [ [ 32 * ] [ INVERSE nth + ] bi* ] each ;
+: encode-pad ( seq n -- byte-array )
+    [ 5 0 pad-tail encode5 ] [ B{ 0 2 4 5 7 } nth ] bi* head-slice
+    8 CHAR: = pad-tail ; inline
+
+: (encode-base32) ( stream column -- )
+    5 pick stream-read dup length {
+        { 0 [ 3drop ] }
+        { 5 [ encode5 write-lines (encode-base32) ] }
+        [ encode-pad write-lines (encode-base32) ]
+    } case ;
 
 PRIVATE>
 
+: encode-base32 ( -- )
+    input-stream get f (encode-base32) ;
+
+: encode-base32-lines ( -- )
+    input-stream get 0 (encode-base32) ;
+
+<PRIVATE
+
+: decode8 ( seq -- )
+    [ 0 [ base32>ch swap 5 shift bitor ] reduce 5 >be ]
+    [ [ CHAR: = = ] count ] bi
+    [ write ] [ B{ 0 4 0 3 2 0 1 } nth head-slice write ] if-zero ; inline
+
+: (decode-base32) ( stream -- )
+    8 "\n\r" pick read-ignoring dup length {
+        { 0 [ 2drop ] }
+        { 8 [ decode8 (decode-base32) ] }
+        [ drop 8 CHAR: = pad-tail decode8 (decode-base32) ]
+    } case ;
+
+PRIVATE>
+
+: decode-base32 ( -- )
+    input-stream get (decode-base32) ;
+
 : >base32 ( seq -- base32 )
-    normalize-base32 parse-base32 ;
+    binary [ binary [ encode-base32 ] with-byte-reader ] with-byte-writer ;
 
 : base32> ( base32 -- seq )
-    dup 0 < [ non-negative-integer-expected ] when
-    [ dup 0 > ] [
-        32 /mod ALPHABET nth
-    ] "" produce-as nip [ "0" ] when-empty reverse! ;
-
-: >base32-checksum ( seq -- base32 )
-    normalize-base32 unclip-last [ parse-base32 ] dip
-    CHECKSUM index over 37 mod assert= ;
+    binary [ binary [ decode-base32 ] with-byte-reader ] with-byte-writer ;
 
-: base32-checksum> ( base32 -- seq )
-    [ base32> ] keep 37 mod CHECKSUM nth suffix ;
+: >base32-lines ( seq -- base32 )
+    binary [ binary [ encode-base32-lines ] with-byte-reader ] with-byte-writer ;