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

more cleanups. (pack) -> pack, use PRIVATE

db4
Doug Coleman 2009-01-15 19:10:40 -06:00
parent 75af02313c
commit 0aff3f2452
1 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
basis/pack/pack.factor
View File

@ -11,9 +11,13 @@ SYMBOL: big-endian
: big-endian? ( -- ? ) : big-endian? ( -- ? )
1 <int> *char zero? ; 1 <int> *char zero? ;
<PRIVATE
: set-big-endian ( -- ) : set-big-endian ( -- )
big-endian? big-endian set ; inline big-endian? big-endian set ; inline
PRIVATE>
: >endian ( obj n -- str ) : >endian ( obj n -- str )
big-endian get [ >be ] [ >le ] if ; inline big-endian get [ >be ] [ >le ] if ; inline
@ -44,6 +48,8 @@ M: string b, ( n string -- ) heap-size b, ;
: double, ( n -- ) double>bits 8 b, ; : double, ( n -- ) double>bits 8 b, ;
: c-string, ( str -- ) % 0 u8, ; : c-string, ( str -- ) % 0 u8, ;
<PRIVATE
: (>128-ber) ( n -- ) : (>128-ber) ( n -- )
dup 0 > [ dup 0 > [
[ HEX: 7f bitand HEX: 80 bitor , ] keep -7 shift [ HEX: 7f bitand HEX: 80 bitor , ] keep -7 shift
@ -52,6 +58,8 @@ M: string b, ( n string -- ) heap-size b, ;
drop drop
] if ; ] if ;
PRIVATE>
: >128-ber ( n -- str ) : >128-ber ( n -- str )
[ [
[ HEX: 7f bitand , ] keep -7 shift [ HEX: 7f bitand , ] keep -7 shift
@ -99,6 +107,8 @@ M: string b, ( n string -- ) heap-size b, ;
: read-128-ber ( -- n ) : read-128-ber ( -- n )
0 (read-128-ber) ; 0 (read-128-ber) ;
<PRIVATE
CONSTANT: pack-table CONSTANT: pack-table
H{ H{
{ CHAR: c s8, } { CHAR: c s8, }
@ -153,31 +163,37 @@ CONSTANT: packed-length-table
{ CHAR: D 8 } { CHAR: D 8 }
} }
MACRO: (pack) ( seq str -- quot ) MACRO: pack ( seq str -- quot )
[ pack-table at 1quotation '[ _ @ ] ] [ ] 2map-as concat [ pack-table at 1quotation '[ _ @ ] ] [ ] 2map-as concat
'[ _ B{ } make ] ; '[ _ B{ } make ] ;
PRIVATE>
: pack-native ( seq str -- seq ) : pack-native ( seq str -- seq )
[ set-big-endian (pack) ] with-scope ; inline [ set-big-endian pack ] with-scope ; inline
: pack-be ( seq str -- seq ) : pack-be ( seq str -- seq )
[ big-endian on (pack) ] with-scope ; inline [ big-endian on pack ] with-scope ; inline
: pack-le ( seq str -- seq ) : pack-le ( seq str -- seq )
[ big-endian off (pack) ] with-scope ; inline [ big-endian off pack ] with-scope ; inline
MACRO: (unpack) ( str -- quot ) <PRIVATE
MACRO: unpack ( str -- quot )
[ unpack-table at 1quotation '[ @ , ] ] { } map-as concat [ unpack-table at 1quotation '[ @ , ] ] { } map-as concat
'[ [ _ { } make ] with-string-reader ] ; '[ [ _ { } make ] with-string-reader ] ;
PRIVATE>
: unpack-native ( seq str -- seq ) : unpack-native ( seq str -- seq )
[ set-big-endian (unpack) ] with-scope ; inline [ set-big-endian unpack ] with-scope ; inline
: unpack-be ( seq str -- seq ) : unpack-be ( seq str -- seq )
[ big-endian on (unpack) ] with-scope ; inline [ big-endian on unpack ] with-scope ; inline
: unpack-le ( seq str -- seq ) : unpack-le ( seq str -- seq )
[ big-endian off (unpack) ] with-scope ; inline [ big-endian off unpack ] with-scope ; inline
: packed-length ( str -- n ) : packed-length ( str -- n )
[ packed-length-table at ] sigma ; [ packed-length-table at ] sigma ;