1 ! Copyright (C) 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien.c-types ascii assocs combinators combinators.smart
4 endian fry io kernel macros math math.vectors sequences strings ;
7 GENERIC: >n-byte-array ( obj n -- byte-array )
9 M: integer >n-byte-array ( m n -- byte-array ) >endian ;
11 ! for doing native, platform-dependent sized values
12 M: string >n-byte-array ( n string -- byte-array ) heap-size >n-byte-array ;
14 : s8>byte-array ( n -- byte-array ) 1 >n-byte-array ;
15 : u8>byte-array ( n -- byte-array ) 1 >n-byte-array ;
16 : s16>byte-array ( n -- byte-array ) 2 >n-byte-array ;
17 : u16>byte-array ( n -- byte-array ) 2 >n-byte-array ;
18 : s24>byte-array ( n -- byte-array ) 3 >n-byte-array ;
19 : u24>byte-array ( n -- byte-array ) 3 >n-byte-array ;
20 : s32>byte-array ( n -- byte-array ) 4 >n-byte-array ;
21 : u32>byte-array ( n -- byte-array ) 4 >n-byte-array ;
22 : s64>byte-array ( n -- byte-array ) 8 >n-byte-array ;
23 : u64>byte-array ( n -- byte-array ) 8 >n-byte-array ;
24 : s128>byte-array ( n -- byte-array ) 16 >n-byte-array ;
25 : u128>byte-array ( n -- byte-array ) 16 >n-byte-array ;
26 : write-float ( n -- byte-array ) float>bits 4 >n-byte-array ;
27 : write-double ( n -- byte-array ) double>bits 8 >n-byte-array ;
28 : write-c-string ( byte-array -- byte-array ) { 0 } B{ } append-as ;
32 : expand-pack-format ( str -- str' )
35 [ [ 0 or 10 * ] [ CHAR: 0 - ] bi* + f ]
36 [ [ 1 or ] [ <string> ] bi* f swap ] if
37 ] { } map-as "" concat-as nip ; foldable
41 { CHAR: c s8>byte-array }
42 { CHAR: C u8>byte-array }
43 { CHAR: s s16>byte-array }
44 { CHAR: S u16>byte-array }
45 { CHAR: t s24>byte-array }
46 { CHAR: T u24>byte-array }
47 { CHAR: i s32>byte-array }
48 { CHAR: I u32>byte-array }
49 { CHAR: q s64>byte-array }
50 { CHAR: Q u64>byte-array }
51 { CHAR: f write-float }
52 { CHAR: F write-float }
53 { CHAR: d write-double }
54 { CHAR: D write-double }
57 CONSTANT: unpack-table
59 { CHAR: c [ 8 signed-endian> ] }
60 { CHAR: C [ unsigned-endian> ] }
61 { CHAR: s [ 16 signed-endian> ] }
62 { CHAR: S [ unsigned-endian> ] }
63 { CHAR: t [ 24 signed-endian> ] }
64 { CHAR: T [ unsigned-endian> ] }
65 { CHAR: i [ 32 signed-endian> ] }
66 { CHAR: I [ unsigned-endian> ] }
67 { CHAR: q [ 64 signed-endian> ] }
68 { CHAR: Q [ unsigned-endian> ] }
69 { CHAR: f [ unsigned-endian> bits>float ] }
70 { CHAR: F [ unsigned-endian> bits>float ] }
71 { CHAR: d [ unsigned-endian> bits>double ] }
72 { CHAR: D [ unsigned-endian> bits>double ] }
75 CONSTANT: packed-length-table
95 MACRO: pack ( str -- quot )
97 [ pack-table at '[ _ execute ] ] { } map-as
98 '[ [ [ _ spread ] input<sequence ] B{ } append-outputs-as ] ;
100 : ch>packed-length ( ch -- n )
101 packed-length-table at ; inline
103 : packed-length ( str -- n )
104 [ ch>packed-length ] map-sum ;
106 : pack-native ( seq str -- seq )
107 '[ _ _ pack ] with-native-endian ; inline
109 : pack-be ( seq str -- seq )
110 '[ _ _ pack ] with-big-endian ; inline
112 : pack-le ( seq str -- seq )
113 '[ _ _ pack ] with-little-endian ; inline
117 : start/end ( seq -- seq1 seq2 )
118 [ 0 [ + ] accumulate nip dup ] keep v+ ; inline
122 MACRO: unpack ( str -- quot )
124 [ [ ch>packed-length ] { } map-as start/end ]
125 [ [ unpack-table at '[ @ ] ] { } map-as ] bi
126 [ '[ [ _ _ ] dip <slice> @ ] ] 3map
127 '[ [ _ cleave ] output>array ] ;
129 : unpack-native ( seq str -- seq )
130 '[ _ _ unpack ] with-native-endian ; inline
132 : unpack-be ( seq str -- seq )
133 '[ _ _ unpack ] with-big-endian ; inline
135 : unpack-le ( seq str -- seq )
136 '[ _ _ unpack ] with-little-endian ; inline
138 ERROR: packed-read-fail str bytes ;
142 : read-packed-bytes ( str -- bytes )
143 dup packed-length [ read dup length ] keep =
144 [ nip ] [ packed-read-fail ] if ; inline
148 : read-packed ( str quot -- seq )
149 [ read-packed-bytes ] swap bi ; inline
151 : read-packed-le ( str -- seq )
152 [ unpack-le ] read-packed ; inline
154 : read-packed-be ( str -- seq )
155 [ unpack-be ] read-packed ; inline
157 : read-packed-native ( str -- seq )
158 [ unpack-native ] read-packed ; inline