steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

base64: faster encode and decode.

db4
John Benediktsson 2013-03-21 17:46:07 -07:00
parent a2c241baea
commit 5b9805fcfd
1 changed files with 42 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
basis/base64/base64.factor
View File

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