From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 22 Mar 2013 00:46:07 +0000 (-0700)
Subject: base64: faster encode and decode.
X-Git-Tag: 0.97~1837
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=5b9805fcfd73da78bbb6b3e5dcd4c4151410a537

base64: faster encode and decode.
---

diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor
index dd1af56def..c3847f5d51 100644
--- a/basis/base64/base64.factor
+++ b/basis/base64/base64.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators io io.binary io.encodings.binary
+USING: combinators fry io io.binary io.encodings.binary
 io.streams.byte-array kernel math namespaces
 sequences strings ;
 IN: base64
@@ -9,13 +9,14 @@ ERROR: malformed-base64 ;
 
 <PRIVATE
 
-: read1-ignoring ( ignoring -- ch )
-    read1 2dup swap member? [ drop read1-ignoring ] [ nip ] if ;
+: read1-ignoring ( ignoring stream -- ch )
+    dup stream-read1 pick dupd member?
+    [ drop read1-ignoring ] [ 2nip ] if ;
 
-: read-ignoring ( ignoring n -- str )
-    [ drop read1-ignoring ] with { } map-integers
-    [ { f 0 } member? not ] filter
-    [ f ] [ >string ] if-empty ;
+: read-ignoring ( n ignoring stream -- str )
+    '[ _ _ read1-ignoring ] replicate
+    [ { f 0 } member-eq? not ] "" filter-as
+    [ f ] when-empty ;
 
 : ch>base64 ( ch -- ch )
     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
@@ -32,20 +33,24 @@ ERROR: malformed-base64 ;
 
 SYMBOL: column
 
-: write1-lines ( ch -- )
-    write1
-    column get [
-        1 + [ 76 = [ B{ CHAR: \r CHAR: \n } write ] when ]
-        [ 76 mod column set ] bi
-    ] when* ;
+: write1-lines ( column/f ch stream -- column' )
+    [ stream-write1 ] keep swap [
+        1 + swap
+        '[ 76 = [ B{ CHAR: \r CHAR: \n } _ stream-write ] when ]
+        [ 76 mod ] bi
+    ] [ drop f ] if* ;
 
 : write-lines ( str -- )
-    [ write1-lines ] each ;
+    column output-stream get '[
+        swap [ _ write1-lines ] each
+    ] change ;
 
 : encode3 ( seq -- )
-    be> 4 iota <reversed> [
-        -6 * shift 0x3f bitand ch>base64 write1-lines
-    ] with each ; inline
+    column output-stream get '[
+        swap be> { 3 2 1 0 } [
+            -6 * shift 0x3f bitand ch>base64 _ write1-lines
+        ] with each
+    ] change ; inline
 
 : encode-pad ( seq n -- )
     [ 3 0 pad-tail binary [ encode3 ] with-byte-writer ]
@@ -54,27 +59,37 @@ SYMBOL: column
 : decode4 ( seq -- )
     [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
     [ [ CHAR: = = ] count ] bi head-slice*
-    [ write1 ] each ; inline
+    output-stream get '[ _ stream-write1 ] each ; inline
+
+: (encode-base64) ( stream -- )
+    3 over stream-read dup length {
+        { 0 [ 2drop ] }
+        { 3 [ encode3 (encode-base64) ] }
+        [ encode-pad (encode-base64) ]
+    } case ;
 
 PRIVATE>
 
 : encode-base64 ( -- )
-    3 read dup length {
-        { 0 [ drop ] }
-        { 3 [ encode3 encode-base64 ] }
-        [ encode-pad encode-base64 ]
-    } case ;
+    input-stream get (encode-base64) ;
 
 : encode-base64-lines ( -- )
     0 column [ encode-base64 ] with-variable ;
 
-: decode-base64 ( -- )
-    "\n\r" 4 read-ignoring dup length {
-        { 0 [ drop ] }
-        { 4 [ decode4 decode-base64 ] }
+<PRIVATE
+
+: (decode-base64) ( stream -- )
+    4 "\n\r" pick read-ignoring dup length {
+        { 0 [ 2drop ] }
+        { 4 [ decode4 (decode-base64) ] }
         [ malformed-base64 ]
     } case ;
 
+PRIVATE>
+
+: decode-base64 ( -- )
+    input-stream get (decode-base64) ;
+
 : >base64 ( seq -- base64 )
     binary [ binary [ encode-base64 ] with-byte-reader ] with-byte-writer ;