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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-10-15 15:29:22 -05:00
parent baa3e74864 d413e14461
commit 2a893c9a2c
8 changed files with 224 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/generalizations/generalizations-tests.factor
View File

@ -30,7 +30,9 @@ IN: generalizations.tests
[ 1 5 4 3 2 ] [ 1 2 3 4 5 4 nspin ] unit-test
[ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
[ 1 2 3 4 5 2 '[ drop drop drop drop drop _ ] 5 nkeep ] must-infer
{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
{ 2 1 2 3 4 5 } [ 1 2 3 4 5 2 '[ drop drop drop drop drop _ ] 5 nkeep ] unit-test
[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test
[ "HELLO" ] [ "hello" [ >upper ] 1 napply ] unit-test

4
basis/generalizations/generalizations.factor
View File

@ -77,8 +77,8 @@ MACRO: ntuck ( n -- )
MACRO: ndip ( n -- )
[ [ dip ] curry ] n*quot [ call ] compose ;
MACRO: nkeep ( quot n -- )
tuck '[ _ ndup _ _ ndip ] ;
MACRO: nkeep ( n -- )
dup '[ [ _ ndup ] dip _ ndip ] ;
MACRO: ncurry ( n -- )
[ curry ] n*quot ;

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

@ -1,6 +1,6 @@
! (c)Joe Groff bsd license
USING: alien.data.map generalizations kernel math.vectors
math.vectors.conversion math.vectors.simd
USING: alien.data.map fry generalizations kernel math.vectors
math.vectors.conversion math math.vectors.simd
specialized-arrays tools.test ;
FROM: alien.c-types => uchar short int float ;
SIMDS: float int short uchar ;
@ -19,6 +19,16 @@ IN: alien.data.map.tests
[ dup ] data-map!( int -- float[2] )
] unit-test
: float-pixels>byte-pixels* ( floats scale bias -- bytes )
'[
[ _ 255.0 * v*n _ 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 ) ; inline
: float-pixels>byte-pixels ( floats -- bytes )
1.0 0.0 float-pixels>byte-pixels* ;
[
B{
127 191 255 63
@ -32,11 +42,7 @@ IN: alien.data.map.tests
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 )
} float-pixels>byte-pixels
] unit-test
[
@ -63,6 +69,10 @@ IN: alien.data.map.tests
: vmerge-transpose ( a b c d -- ac bd ac bd )
[ (vmerge) ] bi-curry@ bi* ; inline
: fold-rgba-planes ( r g b a -- rgba )
[ vmerge-transpose vmerge-transpose ]
data-map( uchar-16 uchar-16 uchar-16 uchar-16 -- uchar-16[4] ) ;
[
B{
1 10 11 15
@ -87,6 +97,5 @@ IN: alien.data.map.tests
B{ 10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 }
B{ 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 176 }
B{ 15 25 35 45 55 65 75 85 95 105 115 125 135 145 155 165 }
[ vmerge-transpose vmerge-transpose ]
data-map( uchar-16 uchar-16 uchar-16 uchar-16 -- uchar-16[4] )
fold-rgba-planes
] unit-test

1
extra/classes/struct/vectored/authors.txt Normal file
View File

@ -0,0 +1 @@
Joe Groff

1
extra/classes/struct/vectored/summary.txt Normal file
View File

@ -0,0 +1 @@
Derive a tuple of specialized arrays from a struct class

73
extra/classes/struct/vectored/vectored-tests.factor Normal file
View File

@ -0,0 +1,73 @@
! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types classes.struct classes.struct.vectored
kernel sequences specialized-arrays tools.test ;
SPECIALIZED-ARRAYS: int ushort float ;
IN: classes.struct.vectored.tests
STRUCT: foo
{ x int }
{ y float }
{ z ushort }
{ w ushort } ;
SPECIALIZED-ARRAY: foo
VECTORED-STRUCT: foo
[
T{ vectored-foo
{ x int-array{ 0 1 0 0 } }
{ y float-array{ 0.0 2.0 0.0 0.0 } }
{ z ushort-array{ 0 3 0 0 } }
{ w ushort-array{ 0 4 0 0 } }
}
] [ S{ foo f 1 2.0 3 4 } 4 <vectored-foo> [ set-second ] keep ] unit-test
[
T{ vectored-foo
{ x int-array{ 0 1 2 3 } }
{ y float-array{ 0.0 0.5 1.0 1.5 } }
{ z ushort-array{ 10 20 30 40 } }
{ w ushort-array{ 15 25 35 45 } }
}
] [
foo-array{
S{ foo { x 0 } { y 0.0 } { z 10 } { w 15 } }
S{ foo { x 1 } { y 0.5 } { z 20 } { w 25 } }
S{ foo { x 2 } { y 1.0 } { z 30 } { w 35 } }
S{ foo { x 3 } { y 1.5 } { z 40 } { w 45 } }
} struct-transpose
] unit-test
[
foo-array{
S{ foo { x 0 } { y 0.0 } { z 10 } { w 15 } }
S{ foo { x 1 } { y 0.5 } { z 20 } { w 25 } }
S{ foo { x 2 } { y 1.0 } { z 30 } { w 35 } }
S{ foo { x 3 } { y 1.5 } { z 40 } { w 45 } }
}
] [
T{ vectored-foo
{ x int-array{ 0 1 2 3 } }
{ y float-array{ 0.0 0.5 1.0 1.5 } }
{ z ushort-array{ 10 20 30 40 } }
{ w ushort-array{ 15 25 35 45 } }
} struct-transpose
] unit-test
[ 30 ] [
T{ vectored-foo
{ x int-array{ 0 1 2 3 } }
{ y float-array{ 0.0 0.5 1.0 1.5 } }
{ z ushort-array{ 10 20 30 40 } }
{ w ushort-array{ 15 25 35 45 } }
} third z>>
] unit-test
[ S{ foo { x 2 } { y 1.0 } { z 30 } { w 35 } } ] [
T{ vectored-foo
{ x int-array{ 0 1 2 3 } }
{ y float-array{ 0.0 0.5 1.0 1.5 } }
{ z ushort-array{ 10 20 30 40 } }
{ w ushort-array{ 15 25 35 45 } }
} third vectored-element>
] unit-test

117
extra/classes/struct/vectored/vectored.factor Normal file
View File

@ -0,0 +1,117 @@
! (c)2009 Joe Groff bsd license
USING: accessors classes.struct classes.tuple combinators fry
functors kernel locals macros math parser quotations sequences
sequences.private slots specialized-arrays words ;
IN: classes.struct.vectored
<PRIVATE
: array-class-of ( type -- array-type )
[ define-array-vocab ] [ name>> "-array" append swap lookup ] bi ;
: <array-class>-of ( type -- array-type )
[ define-array-vocab ] [ name>> "<" "-array>" surround swap lookup ] bi ;
: (array-class)-of ( type -- array-type )
[ define-array-vocab ] [ name>> "(" "-array)" surround swap lookup ] bi ;
: >vectored-slot ( struct-slot offset -- tuple-slot )
{
[ drop name>> ]
[ nip ]
[ drop type>> array-class-of dup initial-value ]
[ 2drop t ]
} 2cleave slot-spec boa ;
MACRO: first-slot ( struct-class -- quot: ( struct -- value ) )
struct-slots first name>> reader-word 1quotation ;
MACRO: set-vectored-nth ( struct-class -- quot: ( value i vector -- ) )
struct-slots [
name>> reader-word 1quotation dup
'[ _ [ ] _ tri* set-nth-unsafe ]
] map '[ _ 3cleave ] ;
MACRO: <vectored-slots> ( struct-class -- quot: ( n -- slots... ) )
struct-slots [ type>> <array-class>-of 1quotation ] map
'[ _ cleave ] ;
MACRO: (vectored-slots) ( struct-class -- quot: ( n -- slots... ) )
struct-slots [ type>> (array-class)-of 1quotation ] map
'[ _ cleave ] ;
MACRO: (vectored-element>) ( struct-class -- quot: ( elt -- struct ) )
[ struct-slots [ name>> reader-word 1quotation ] map ] keep
'[ _ cleave _ <struct-boa> ] ;
SLOT: (n)
SLOT: (vectored)
FUNCTOR: define-vectored-accessors ( S>> (>>S) T -- )
WHERE
M: T S>>
[ (n)>> ] [ (vectored)>> S>> ] bi nth-unsafe ; inline
M: T (>>S)
[ (n)>> ] [ (vectored)>> S>> ] bi set-nth-unsafe ; inline
;FUNCTOR
PRIVATE>
GENERIC: struct-transpose ( structstruct -- ssttrruucctt )
GENERIC: vectored-element> ( elt -- struct )
FUNCTOR: define-vectored-struct ( T -- )
T-array [ T array-class-of ]
vectored-T DEFINES-CLASS vectored-${T}
vectored-T-element DEFINES-CLASS vectored-${T}-element
<vectored-T> DEFINES <vectored-${T}>
(vectored-T) DEFINES (vectored-${T})
WHERE
vectored-T tuple T struct-slots [ >vectored-slot ] map-index define-tuple-class
TUPLE: vectored-T-element
{ (n) fixnum read-only }
{ (vectored) vectored-T read-only } ;
T struct-slots [
name>> [ reader-word ] [ writer-word ] bi
vectored-T-element define-vectored-accessors
] each
M: vectored-T-element vectored-element>
T (vectored-element>) ; inline
M: vectored-T nth-unsafe
vectored-T-element boa ; inline
M: vectored-T length
T first-slot length ; inline
M: vectored-T set-nth-unsafe
T set-vectored-nth ; inline
INSTANCE: vectored-T sequence
: <vectored-T> ( n -- vectored-T )
T <vectored-slots> vectored-T boa ; inline
: (vectored-T) ( n -- vectored-T )
T (vectored-slots) vectored-T boa ; inline
M: vectored-T struct-transpose
[ vectored-element> ] T-array new map-as ; inline
M: T-array struct-transpose
dup length [ nip iota ] [ drop ] [ nip (vectored-T) ] 2tri
[ [ [ nth ] [ set-nth ] bi-curry* bi ] 2curry each ] keep ; inline
;FUNCTOR
SYNTAX: VECTORED-STRUCT:
scan-word define-vectored-struct ;

10
extra/math/matrices/simd/simd-tests.factor
View File

@ -229,3 +229,13 @@ IN: math.matrices.simd.tests
float-4{ 2.0 2.0 0.0 0.0 } 1.0 5.0
frustum-matrix4
] unit-test
[ float-4{ 3.0 4.0 5.0 1.0 } ]
[ float-4{ 1.0 1.0 1.0 1.0 } translation-matrix4 float-4{ 2.0 3.0 4.0 1.0 } m4.v ] unit-test
[ float-4{ 2.0 2.5 3.0 1.0 } ]
[
float-4{ 1.0 1.0 1.0 1.0 } translation-matrix4
float-4{ 0.5 0.5 0.5 1.0 } scale-matrix4 m4.
float-4{ 2.0 3.0 4.0 1.0 } m4.v
] unit-test