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

let data-map take factor sequences as inputs

db4
Joe Groff 2009-10-16 15:29:57 -05:00
parent 184b32cc51
commit a0c6af5603
2 changed files with 44 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/alien/data/map/map-tests.factor
View File

@ -1,6 +1,6 @@
! (c)Joe Groff bsd license
USING: alien.data.map fry generalizations kernel locals math.vectors
math.vectors.conversion math math.vectors.simd
math.vectors.conversion math math.vectors.simd sequences
specialized-arrays tools.test ;
FROM: alien.c-types => uchar short int float ;
SIMDS: float int short uchar ;
@ -13,6 +13,17 @@ IN: alien.data.map.tests
byte-array>float-array
] unit-test
[
float-4-array{
float-4{ 0.0 1.0 2.0 3.0 }
float-4{ 4.0 5.0 6.0 7.0 }
float-4{ 8.0 9.0 10.0 11.0 }
}
] [
12 iota [ float-4-boa ] data-map( object[4] -- float-4 )
byte-array>float-4-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 }

44
extra/alien/data/map/map.factor
View File

@ -1,6 +1,6 @@
! (c)Joe Groff bsd license
USING: accessors alien alien.c-types alien.data alien.parser arrays
byte-arrays combinators effects.parser fry generalizations kernel
byte-arrays combinators effects.parser fry generalizations grouping kernel
lexer locals macros make math math.ranges parser sequences sequences.private ;
FROM: alien.arrays => array-length ;
IN: alien.data.map
@ -19,8 +19,6 @@ TUPLE: data-map-param
{ iter-length fixnum read-only }
{ iter-count fixnum read-only } ;
ERROR: bad-data-map-param param remainder ;
M: data-map-param length
iter-count>> ; inline
@ -34,12 +32,14 @@ M: data-map-param nth-unsafe
INSTANCE: data-map-param immutable-sequence
: c-type-count ( in/out -- c-type count iter-length )
dup array? [ unclip swap array-length >fixnum ] [ 1 ] if
2dup swap heap-size * >fixnum ; inline
: c-type-count ( in/out -- c-type count )
dup array? [ unclip swap array-length >fixnum ] [ 1 ] if ; inline
MACRO: >param ( in -- quot: ( array -- param ) )
c-type-count '[
: c-type-iter-length ( c-type count -- iter-length )
swap heap-size * >fixnum ; inline
: [>c-type-param] ( c-type count -- quot )
2dup c-type-iter-length '[
[ _ _ ] dip
[ ]
[ >c-ptr ]
@ -49,8 +49,18 @@ MACRO: >param ( in -- quot: ( array -- param ) )
data-map-param boa
] ;
MACRO: alloc-param ( out -- quot: ( len -- param ) )
c-type-count dup '[
: [>object-param] ( class count -- quot )
nip '[ _ <sliced-groups> ] ;
: [>param] ( type -- quot )
c-type-count over c-type-name?
[ [>c-type-param] ] [ [>object-param] ] if ;
MACRO: >param ( in -- quot: ( array -- param ) )
[>param] ;
: [alloc-c-type-param] ( c-type count -- quot )
2dup c-type-iter-length dup '[
[ _ _ ] dip
[
_ * >fixnum [ (byte-array) dup ] keep
@ -59,11 +69,21 @@ MACRO: alloc-param ( out -- quot: ( len -- param ) )
data-map-param boa
] ;
: [alloc-object-param] ( type count -- quot )
"Factor sequences as data-map outputs not supported" throw ;
: [alloc-param] ( type -- quot )
c-type-count over c-type-name?
[ [alloc-c-type-param] ] [ [alloc-object-param] ] if ;
MACRO: alloc-param ( out -- quot: ( len -- param ) )
[alloc-param] ;
MACRO: unpack-params ( ins -- )
[ c-type-count drop nip '[ _ firstn-unsafe ] ] map '[ _ spread ] ;
[ c-type-count nip '[ _ firstn-unsafe ] ] map '[ _ spread ] ;
MACRO: pack-params ( outs -- )
[ ] [ c-type-count drop nip dup [ [ ndip _ ] dip set-firstn ] 3curry ] reduce
[ ] [ c-type-count nip dup [ [ ndip _ ] dip set-firstn ] 3curry ] reduce
fry [ call ] compose ;
:: [data-map] ( ins outs param-quot -- quot )