diff --git a/extra/alien/data/map/authors.txt b/extra/alien/data/map/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/alien/data/map/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/alien/data/map/map-tests.factor b/extra/alien/data/map/map-tests.factor new file mode 100644 index 0000000000..ea99c2b6ef --- /dev/null +++ b/extra/alien/data/map/map-tests.factor @@ -0,0 +1,54 @@ +! (c)Joe Groff bsd license +USING: alien.data.map generalizations kernel math.vectors +math.vectors.conversion math.vectors.simd +specialized-arrays tools.test ; +FROM: alien.c-types => uchar short int float ; +SIMDS: float int short uchar ; +SPECIALIZED-ARRAYS: int float float-4 uchar-16 ; +IN: alien.data.map.tests + +[ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 } ] +[ + int-array{ 1 3 5 } [ dup ] data-map( int -- float[2] ) + byte-array>float-array +] unit-test + +[ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 0.0 0.0 } ] +[ + int-array{ 1 3 5 } float-array{ 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 } + [ dup ] data-map!( int -- float[2] ) +] unit-test + +[ + B{ + 127 191 255 63 + 255 25 51 76 + 76 51 229 127 + 25 255 255 255 + } +] [ + float-array{ + 0.5 0.75 1.0 0.25 + 1.0 0.1 0.2 0.3 + 0.3 0.2 0.9 0.5 + 0.1 1.0 1.5 2.0 + } [ + [ 255.0 v*n float-4 int-4 vconvert ] 4 napply + [ int-4 short-8 vconvert ] 2bi@ + short-8 uchar-16 vconvert + ] data-map( float-4[4] -- uchar-16 ) +] unit-test + +[ + float-array{ + 0.5 0.75 1.0 0.25 + 1.0 0.1 0.2 0.3 + 0.3 0.2 0.9 0.5 + 0.1 1.0 1.5 2.0 + 5.0 + } [ + [ 255.0 v*n float-4 int-4 vconvert ] 4 napply + [ int-4 short-8 vconvert ] 2bi@ + short-8 uchar-16 vconvert + ] data-map( float-4[4] -- uchar-16 ) +] [ bad-data-map-input-length? ] must-fail-with diff --git a/extra/alien/data/map/map.factor b/extra/alien/data/map/map.factor new file mode 100644 index 0000000000..5789c376ce --- /dev/null +++ b/extra/alien/data/map/map.factor @@ -0,0 +1,69 @@ +! (c)Joe Groff bsd license +USING: alien alien.c-types alien.data alien.parser arrays +byte-arrays fry generalizations kernel lexer locals macros math +math.ranges parser sequences sequences.private ; +IN: alien.data.map + +ERROR: bad-data-map-input-length byte-length iter-size remainder ; + +fixnum ] bi@ /mod + [ 2nip ] + [ bad-data-map-input-length ] if-zero ; inline + +:: data-map-length ( array type count -- byte-length iter-size iter-count ) + array byte-length >fixnum + type heap-size count * + 2dup even-/i ; inline + +: ( byte-array displacement length type -- direct-array ) + [ swap ] 2dip ; inline + +:: data-map-loop ( input loop-quot out-bytes-quot in-type in-count out-type out-count -- out-bytes ) + input in-type in-count data-map-length + :> iter-count :> in-size :> in-byte-length + input >c-ptr :> in-bytes + + out-count out-type heap-size * :> out-size + out-size iter-count * :> out-byte-length + out-byte-length out-bytes-quot call :> out-bytes + + 0 in-byte-length 1 - >fixnum in-size >fixnum + 0 out-byte-length 1 - >fixnum out-size >fixnum + [| in-base out-base | + in-bytes in-base in-count in-type + in-count firstn-unsafe + loop-quot call + out-bytes out-base out-count out-type + out-count set-firstn-unsafe + ] 2each + out-bytes ; inline + +PRIVATE> + +MACRO: data-map ( in-type in-count out-type out-count -- ) + '[ [ (byte-array) ] _ _ _ _ data-map-loop ] ; + +MACRO: data-map! ( in-type in-count out-type out-count -- ) + '[ swap [ [ nip >c-ptr ] curry _ _ _ _ data-map-loop drop ] keep ] ; + + + +SYNTAX: data-map( + scan-c-type c-type-parsed + "--" expect scan-c-type c-type-parsed ")" expect + \ data-map parsed ; + +SYNTAX: data-map!( + scan-c-type c-type-parsed + "--" expect scan-c-type c-type-parsed ")" expect + \ data-map! parsed ; + diff --git a/extra/alien/data/map/summary.txt b/extra/alien/data/map/summary.txt new file mode 100644 index 0000000000..09afd0637e --- /dev/null +++ b/extra/alien/data/map/summary.txt @@ -0,0 +1 @@ +Combinators for mapping over packed binary data