1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types byte-arrays classes functors
4 kernel math parser prettyprint.custom sequences
5 sequences.private literals ;
6 IN: math.vectors.simd.functor
8 ERROR: bad-length got expected ;
10 FUNCTOR: define-simd-128 ( T -- )
14 N [ 16 T-TYPE heap-size /i ]
16 A DEFINES-CLASS ${T}-${N}
20 NTH [ T-TYPE dup c-type-getter-boxer array-accessor ]
21 SET-NTH [ T-TYPE dup c-setter array-accessor ]
24 A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
25 A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
30 { underlying byte-array read-only initial: $[ 16 <byte-array> ] } ;
32 M: A clone underlying>> clone \ A boa ; inline
34 M: A length drop N ; inline
36 M: A nth-unsafe underlying>> NTH call ; inline
38 M: A set-nth-unsafe underlying>> SET-NTH call ; inline
40 : >A ( seq -- simd-array ) \ A new clone-like ;
42 M: A like drop dup \ A instance? [ >A ] unless ; inline
46 [ drop 16 <byte-array> \ A boa ]
50 M: A equal? over \ A instance? [ sequence= ] [ 2drop f ] if ;
52 M: A byte-length underlying>> length ; inline
54 M: A pprint-delims drop \ A{ \ } ;
56 M: A >pprint-sequence ;
58 M: A pprint* pprint-object ;
60 SYNTAX: A{ \ } [ >A ] parse-literal ;
66 : A-vv->v-op ( v1 v2 quot -- v3 )
67 [ [ underlying>> ] bi@ A-rep ] dip call \ A boa ; inline
69 : A-v->n-op ( v quot -- n )
70 [ underlying>> A-rep ] dip call ; inline
76 ! Synthesize 256-bit vectors from a pair of 128-bit vectors
77 FUNCTOR: define-simd-256 ( T -- )
81 N [ 32 T-TYPE heap-size /i ]
86 A DEFINES-CLASS ${T}-${N}
90 A-deref DEFINES-PRIVATE ${A}-deref
93 A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
94 A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
102 { underlying1 byte-array initial: $[ 16 <byte-array> ] read-only }
103 { underlying2 byte-array initial: $[ 16 <byte-array> ] read-only } ;
106 [ underlying1>> clone ] [ underlying2>> clone ] bi
109 M: A length drop N ; inline
111 : A-deref ( n seq -- n' seq' )
112 over N/2 < [ underlying1>> ] [ [ N/2 - ] dip underlying2>> ] if \ A/2 boa ; inline
114 M: A nth-unsafe A-deref nth-unsafe ; inline
116 M: A set-nth-unsafe A-deref set-nth-unsafe ; inline
118 : >A ( seq -- simd-array ) \ A new clone-like ;
120 M: A like drop dup \ A instance? [ >A ] unless ; inline
124 [ drop 16 <byte-array> 16 <byte-array> \ A boa ]
128 M: A equal? over \ A instance? [ sequence= ] [ 2drop f ] if ;
130 M: A byte-length drop 32 ; inline
132 SYNTAX: A{ \ } [ >A ] parse-literal ;
134 M: A pprint-delims drop \ A{ \ } ;
136 M: A >pprint-sequence ;
138 M: A pprint* pprint-object ;
142 : A-vv->v-op ( v1 v2 quot -- v3 )
143 [ [ [ underlying1>> ] bi@ A-rep ] dip call ]
144 [ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
147 : A-v->n-op ( v1 combine-quot reduce-quot -- v2 )
148 [ [ [ underlying1>> ] [ underlying2>> ] bi A-rep ] dip call A-rep ]