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

base64: big speedup and cleanup.

db4
John Benediktsson 2015-07-15 22:34:15 -07:00
parent 3d55e79a2c
commit eea048dae2
2 changed files with 46 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
basis/base64/base64.factor
View File

@ -9,18 +9,6 @@ ERROR: malformed-base64 ;
<PRIVATE <PRIVATE
: read1-ignoring ( ignoring stream -- ch )
dup stream-read1 pick dupd member?
[ drop read1-ignoring ] [ 2nip ] if ; inline recursive
: push-ignoring ( accum ch -- accum )
dup { f 0 } member-eq? [ drop ] [ suffix! ] if ; inline
: read-ignoring ( n ignoring stream -- str/f )
[ [ <sbuf> ] keep ] 2dip
'[ _ _ read1-ignoring push-ignoring ] times
[ f ] [ "" like ] if-empty ; inline
<< <<
CONSTANT: alphabet CONSTANT: alphabet
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
@ -38,53 +26,58 @@ CONSTANT: alphabet
$[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth
[ malformed-base64 ] unless* ; inline [ malformed-base64 ] unless* ; inline
SYMBOL: column : (write-lines) ( column byte-array -- column' )
output-stream get dup '[
_ stream-write1 1 + dup 76 = [
drop B{ CHAR: \r CHAR: \n } _ stream-write 0
] when
] each ; inline
: write1-lines ( column/f ch stream -- column' ) : write-lines ( column byte-array -- column' )
[ stream-write1 ] keep swap [ over [ (write-lines) ] [ write ] if ; inline
1 + swap
'[ 76 = [ B{ CHAR: \r CHAR: \n } _ stream-write ] when ]
[ 76 mod ] bi
] [ drop f ] if* ;
: write-lines ( str -- ) : encode3 ( seq -- byte-array )
column output-stream get '[ be> { -18 -12 -6 0 } '[
swap [ _ write1-lines ] each shift 0x3f bitand ch>base64
] change ; ] with B{ } map-as ; inline
: encode3 ( seq -- ) : encode-pad ( seq n -- byte-array )
column output-stream get '[ [ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice
swap be> { -18 -12 -6 0 } [ 4 CHAR: = pad-tail ; inline
shift 0x3f bitand ch>base64 _ write1-lines
] with each
] change ; inline
: encode-pad ( seq n -- ) : (encode-base64) ( stream column -- column' )
[ 3 0 pad-tail binary [ encode3 ] with-byte-writer ] 3 pick stream-read dup length {
[ 1 + ] bi* head-slice 4 CHAR: = pad-tail write-lines ; inline
: decode4 ( seq -- )
[ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
[ [ CHAR: = = ] count ] bi head-slice*
output-stream get '[ _ stream-write1 ] each ; inline
: (encode-base64) ( stream -- )
3 over stream-read dup length {
{ 0 [ 2drop ] } { 0 [ 2drop ] }
{ 3 [ encode3 (encode-base64) ] } { 3 [ encode3 write-lines (encode-base64) ] }
[ encode-pad (encode-base64) ] [ encode-pad write-lines (encode-base64) ]
} case ; } case ;
PRIVATE> PRIVATE>
: encode-base64 ( -- ) : encode-base64 ( -- )
input-stream get (encode-base64) ; input-stream get f (encode-base64) drop ;
: encode-base64-lines ( -- ) : encode-base64-lines ( -- )
0 column [ encode-base64 ] with-variable ; input-stream get 0 (encode-base64) drop ;
<PRIVATE <PRIVATE
: read1-ignoring ( ignoring stream -- ch )
dup stream-read1 pick dupd member?
[ drop read1-ignoring ] [ 2nip ] if ; inline recursive
: push-ignoring ( accum ch -- accum )
dup { f 0 } member-eq? [ drop ] [ suffix! ] if ; inline
: read-ignoring ( n ignoring stream -- sbuf )
[ [ <sbuf> ] keep ] 2dip
'[ _ _ read1-ignoring push-ignoring ] times ; inline
: decode4 ( seq -- )
[ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
[ [ CHAR: = = ] count ] bi
[ write ] [ head-slice* write ] if-zero ; inline
: (decode-base64) ( stream -- ) : (decode-base64) ( stream -- )
4 "\n\r" pick read-ignoring dup length { 4 "\n\r" pick read-ignoring dup length {
{ 0 [ 2drop ] } { 0 [ 2drop ] }

22
extra/base85/base85.factor
View File

@ -20,33 +20,29 @@ CONSTANT: alphabet
$[ alphabet alphabet-inverse ] nth $[ alphabet alphabet-inverse ] nth
[ malformed-base85 ] unless* ; inline [ malformed-base85 ] unless* ; inline
: encode4 ( seq -- ) : encode4 ( seq -- seq' )
column output-stream get '[ be> 5 [ 85 /mod ch>base85 ] B{ } replicate-as reverse! nip ; inline
swap be> 5 [ 85 /mod ch>base85 ] replicate
reverse! nip [ _ write1-lines ] each
] change ; inline
: (encode-base85) ( stream -- ) : (encode-base85) ( stream column -- column' )
4 over stream-read dup length { 4 pick stream-read dup length {
{ 0 [ 2drop ] } { 0 [ 2drop ] }
{ 4 [ encode4 (encode-base85) ] } { 4 [ encode4 write-lines (encode-base85) ] }
[ drop 4 0 pad-tail encode4 (encode-base85) ] [ drop 4 0 pad-tail encode4 write-lines (encode-base85) ]
} case ; } case ;
PRIVATE> PRIVATE>
: encode-base85 ( -- ) : encode-base85 ( -- )
input-stream get (encode-base85) ; input-stream get f (encode-base85) drop ;
: encode-base85-lines ( -- ) : encode-base85-lines ( -- )
0 column [ encode-base85 ] with-variable ; input-stream get 0 (encode-base85) drop ;
<PRIVATE <PRIVATE
: decode5 ( seq -- ) : decode5 ( seq -- )
0 [ [ 85 * ] [ base85>ch ] bi* + ] reduce 4 >be 0 [ [ 85 * ] [ base85>ch ] bi* + ] reduce 4 >be
[ zero? ] trim-tail-slice output-stream get [ zero? ] trim-tail-slice write ; inline
'[ _ stream-write1 ] each ; inline
: (decode-base85) ( stream -- ) : (decode-base85) ( stream -- )
5 "\n\r" pick read-ignoring dup length { 5 "\n\r" pick read-ignoring dup length {