remove math.vectors .specialization, .simd.functor, .simd.intrinsics
Joe Groff
parent
9cf3ab3da1
commit
73d2a75644
|
|
@ -1 +0,0 @@
|
||||||
Slava Pestov
|
|
||||||
|
|
@ -1,522 +0,0 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: accessors assocs byte-arrays classes classes.algebra effects fry
|
|
||||||
functors generalizations kernel literals locals math math.functions
|
|
||||||
math.vectors math.vectors.private math.vectors.simd.intrinsics
|
|
||||||
math.vectors.conversion.backend
|
|
||||||
math.vectors.specialization parser prettyprint.custom sequences
|
|
||||||
sequences.private strings words definitions macros cpu.architecture
|
|
||||||
namespaces arrays quotations combinators combinators.short-circuit sets
|
|
||||||
layouts ;
|
|
||||||
QUALIFIED-WITH: alien.c-types c
|
|
||||||
QUALIFIED: math.private
|
|
||||||
IN: math.vectors.simd.functor
|
|
||||||
|
|
||||||
ERROR: bad-length got expected ;
|
|
||||||
|
|
||||||
: vector-true-value ( class -- value )
|
|
||||||
{
|
|
||||||
{ [ dup integer class<= ] [ drop -1 ] }
|
|
||||||
{ [ dup float class<= ] [ drop -1 bits>double ] }
|
|
||||||
} cond ; foldable
|
|
||||||
|
|
||||||
: vector-false-value ( class -- value )
|
|
||||||
{
|
|
||||||
{ [ dup integer class<= ] [ drop 0 ] }
|
|
||||||
{ [ dup float class<= ] [ drop 0.0 ] }
|
|
||||||
} cond ; foldable
|
|
||||||
|
|
||||||
: boolean>element ( bool/elt class -- elt )
|
|
||||||
swap {
|
|
||||||
{ t [ vector-true-value ] }
|
|
||||||
{ f [ vector-false-value ] }
|
|
||||||
[ nip ]
|
|
||||||
} case ; inline
|
|
||||||
|
|
||||||
MACRO: simd-boa ( rep class -- simd-array )
|
|
||||||
[ rep-components ] [ new ] bi* '[ _ _ nsequence ] ;
|
|
||||||
|
|
||||||
: can-be-unboxed? ( type -- ? )
|
|
||||||
{
|
|
||||||
{ c:float [ \ math.private:float+ "intrinsic" word-prop ] }
|
|
||||||
{ c:double [ \ math.private:float+ "intrinsic" word-prop ] }
|
|
||||||
[ c:heap-size cell < ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
: simd-boa-fast? ( rep -- ? )
|
|
||||||
[ dup rep-gather-word supported-simd-op? ]
|
|
||||||
[ rep-component-type can-be-unboxed? ]
|
|
||||||
bi and ;
|
|
||||||
|
|
||||||
:: define-boa-custom-inlining ( word rep class -- )
|
|
||||||
word [
|
|
||||||
drop
|
|
||||||
rep simd-boa-fast? [
|
|
||||||
[ rep (simd-boa) class boa ]
|
|
||||||
] [ word def>> ] if
|
|
||||||
] "custom-inlining" set-word-prop ;
|
|
||||||
|
|
||||||
: simd-with ( rep class x -- simd-array )
|
|
||||||
[ rep-components ] [ new ] [ '[ _ ] ] tri* swap replicate-as ; inline
|
|
||||||
|
|
||||||
: simd-with/nth-fast? ( rep -- ? )
|
|
||||||
[ \ (simd-vshuffle-elements) supported-simd-op? ]
|
|
||||||
[ rep-component-type can-be-unboxed? ]
|
|
||||||
bi and ;
|
|
||||||
|
|
||||||
:: define-with-custom-inlining ( word rep class -- )
|
|
||||||
word [
|
|
||||||
drop
|
|
||||||
rep simd-with/nth-fast? [
|
|
||||||
[ rep rep-coerce rep (simd-with) class boa ]
|
|
||||||
] [ word def>> ] if
|
|
||||||
] "custom-inlining" set-word-prop ;
|
|
||||||
|
|
||||||
: simd-nth-fast ( rep -- quot )
|
|
||||||
[ rep-components ] keep
|
|
||||||
'[ swap _ '[ _ _ (simd-select) ] 2array ] map-index
|
|
||||||
'[ swap >fixnum _ case ] ;
|
|
||||||
|
|
||||||
: simd-nth-slow ( rep -- quot )
|
|
||||||
rep-component-type dup c:c-type-getter-boxer c:array-accessor ;
|
|
||||||
|
|
||||||
MACRO: simd-nth ( rep -- x )
|
|
||||||
dup simd-with/nth-fast? [ simd-nth-fast ] [ simd-nth-slow ] if ;
|
|
||||||
|
|
||||||
: boa-effect ( rep n -- effect )
|
|
||||||
[ rep-components ] dip *
|
|
||||||
[ CHAR: a + 1string ] map
|
|
||||||
{ "simd-vector" } <effect> ;
|
|
||||||
|
|
||||||
: supported-simd-ops ( assoc rep -- assoc' )
|
|
||||||
[ simd-ops get ] dip
|
|
||||||
'[ nip _ swap supported-simd-op? ] assoc-filter
|
|
||||||
'[ drop _ key? ] assoc-filter ;
|
|
||||||
|
|
||||||
ERROR: bad-schema op schema ;
|
|
||||||
|
|
||||||
:: op-wrapper ( op specials schemas -- wrapper )
|
|
||||||
op {
|
|
||||||
[ specials at ]
|
|
||||||
[ word-schema schemas at ]
|
|
||||||
[ dup word-schema bad-schema ]
|
|
||||||
} 1|| ;
|
|
||||||
|
|
||||||
: low-level-ops ( simd-ops specials schemas -- alist )
|
|
||||||
'[ 1quotation over _ _ op-wrapper [ ] 2sequence ] assoc-map ;
|
|
||||||
|
|
||||||
:: high-level-ops ( ctor elt-class -- assoc )
|
|
||||||
! Some SIMD operations are defined in terms of others.
|
|
||||||
{
|
|
||||||
{ vbroadcast [ swap nth ctor execute ] }
|
|
||||||
{ n+v [ [ ctor execute ] dip v+ ] }
|
|
||||||
{ v+n [ ctor execute v+ ] }
|
|
||||||
{ n-v [ [ ctor execute ] dip v- ] }
|
|
||||||
{ v-n [ ctor execute v- ] }
|
|
||||||
{ n*v [ [ ctor execute ] dip v* ] }
|
|
||||||
{ v*n [ ctor execute v* ] }
|
|
||||||
{ n/v [ [ ctor execute ] dip v/ ] }
|
|
||||||
{ v/n [ ctor execute v/ ] }
|
|
||||||
{ norm-sq [ dup v. assert-positive ] }
|
|
||||||
{ norm [ norm-sq sqrt ] }
|
|
||||||
{ normalize [ dup norm v/n ] }
|
|
||||||
}
|
|
||||||
! To compute dot product and distance with integer vectors, we
|
|
||||||
! have to do things less efficiently, with integer overflow checks,
|
|
||||||
! in the general case.
|
|
||||||
elt-class float = [ { distance [ v- norm ] } suffix ] when ;
|
|
||||||
|
|
||||||
TUPLE: simd class elt-class ops special-wrappers schema-wrappers ctor rep ;
|
|
||||||
|
|
||||||
: define-simd ( simd -- )
|
|
||||||
dup rep>> rep-component-type c:c-type-boxed-class >>elt-class
|
|
||||||
{
|
|
||||||
[ class>> ]
|
|
||||||
[ elt-class>> ]
|
|
||||||
[ [ ops>> ] [ special-wrappers>> ] [ schema-wrappers>> ] tri low-level-ops ]
|
|
||||||
[ rep>> supported-simd-ops ]
|
|
||||||
[ [ ctor>> ] [ elt-class>> ] bi high-level-ops assoc-union ]
|
|
||||||
} cleave
|
|
||||||
specialize-vector-words ;
|
|
||||||
|
|
||||||
:: define-simd-128-type ( class rep -- )
|
|
||||||
c:<c-type>
|
|
||||||
byte-array >>class
|
|
||||||
class >>boxed-class
|
|
||||||
[ rep alien-vector class boa ] >>getter
|
|
||||||
[ [ underlying>> ] 2dip rep set-alien-vector ] >>setter
|
|
||||||
16 >>size
|
|
||||||
8 >>align
|
|
||||||
rep >>rep
|
|
||||||
class c:typedef ;
|
|
||||||
|
|
||||||
: (define-simd-128) ( simd -- )
|
|
||||||
simd-ops get >>ops
|
|
||||||
[ define-simd ]
|
|
||||||
[ [ class>> ] [ rep>> ] bi define-simd-128-type ] bi ;
|
|
||||||
|
|
||||||
FUNCTOR: define-simd-128 ( T -- )
|
|
||||||
|
|
||||||
N [ 16 T c:heap-size /i ]
|
|
||||||
|
|
||||||
A DEFINES-CLASS ${T}-${N}
|
|
||||||
A-boa DEFINES ${A}-boa
|
|
||||||
A-with DEFINES ${A}-with
|
|
||||||
A-cast DEFINES ${A}-cast
|
|
||||||
>A DEFINES >${A}
|
|
||||||
A{ DEFINES ${A}{
|
|
||||||
|
|
||||||
SET-NTH [ T dup c:c-setter c:array-accessor ]
|
|
||||||
|
|
||||||
A-rep [ A name>> "-rep" append "cpu.architecture" lookup ]
|
|
||||||
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
|
|
||||||
A-vn->v-op DEFINES-PRIVATE ${A}-vn->v-op
|
|
||||||
A-vv->n-op DEFINES-PRIVATE ${A}-vv->n-op
|
|
||||||
A-v->v-op DEFINES-PRIVATE ${A}-v->v-op
|
|
||||||
A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
|
|
||||||
A-v-conversion-op DEFINES-PRIVATE ${A}-v-conversion-op
|
|
||||||
A-vv-conversion-op DEFINES-PRIVATE ${A}-vv-conversion-op
|
|
||||||
|
|
||||||
A-element-class [ A-rep rep-component-type c:c-type-boxed-class ]
|
|
||||||
|
|
||||||
WHERE
|
|
||||||
|
|
||||||
TUPLE: A
|
|
||||||
{ underlying byte-array read-only initial: $[ 16 <byte-array> ] } ;
|
|
||||||
|
|
||||||
INSTANCE: A simd-128
|
|
||||||
|
|
||||||
M: A clone underlying>> clone \ A boa ; inline
|
|
||||||
|
|
||||||
M: A length drop N ; inline
|
|
||||||
|
|
||||||
M: A equal?
|
|
||||||
over \ A instance? [ v= vall? ] [ 2drop f ] if ;
|
|
||||||
|
|
||||||
M: A nth-unsafe underlying>> A-rep simd-nth ; inline
|
|
||||||
|
|
||||||
M: A set-nth-unsafe
|
|
||||||
[ A-element-class boolean>element ] 2dip
|
|
||||||
underlying>> SET-NTH call ; inline
|
|
||||||
|
|
||||||
: >A ( seq -- simd-array ) \ A new clone-like ;
|
|
||||||
|
|
||||||
M: A like drop dup \ A instance? [ >A ] unless ; inline
|
|
||||||
|
|
||||||
M: A new-underlying drop \ A boa ; inline
|
|
||||||
|
|
||||||
M: A new-sequence
|
|
||||||
drop dup N =
|
|
||||||
[ drop 16 <byte-array> \ A boa ]
|
|
||||||
[ N bad-length ]
|
|
||||||
if ; inline
|
|
||||||
|
|
||||||
M: A c:byte-length underlying>> length ; inline
|
|
||||||
|
|
||||||
M: A element-type drop A-rep rep-component-type ;
|
|
||||||
|
|
||||||
M: A pprint-delims drop \ A{ \ } ;
|
|
||||||
|
|
||||||
M: A >pprint-sequence ;
|
|
||||||
|
|
||||||
M: A pprint* pprint-object ;
|
|
||||||
|
|
||||||
SYNTAX: A{ \ } [ >A ] parse-literal ;
|
|
||||||
|
|
||||||
: A-with ( x -- simd-array ) [ A-rep A ] dip simd-with ;
|
|
||||||
|
|
||||||
\ A-with \ A-rep \ A define-with-custom-inlining
|
|
||||||
|
|
||||||
\ A-boa [ \ A-rep \ A simd-boa ] \ A-rep 1 boa-effect define-declared
|
|
||||||
|
|
||||||
\ A-rep rep-gather-word [
|
|
||||||
\ A-boa \ A-rep \ A define-boa-custom-inlining
|
|
||||||
] when
|
|
||||||
|
|
||||||
: A-cast ( simd-array -- simd-array' )
|
|
||||||
underlying>> \ A boa ; inline
|
|
||||||
|
|
||||||
INSTANCE: A sequence
|
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: A-vv->v-op ( v1 v2 quot -- v3 )
|
|
||||||
[ [ underlying>> ] bi@ A-rep ] dip call \ A boa ; inline
|
|
||||||
|
|
||||||
: A-vn->v-op ( v1 v2 quot -- v3 )
|
|
||||||
[ [ underlying>> ] dip A-rep ] dip call \ A boa ; inline
|
|
||||||
|
|
||||||
: A-vv->n-op ( v1 v2 quot -- n )
|
|
||||||
[ [ underlying>> ] bi@ A-rep ] dip call ; inline
|
|
||||||
|
|
||||||
: A-v->v-op ( v1 quot -- v2 )
|
|
||||||
[ underlying>> A-rep ] dip call \ A boa ; inline
|
|
||||||
|
|
||||||
: A-v->n-op ( v quot -- n )
|
|
||||||
[ underlying>> A-rep ] dip call ; inline
|
|
||||||
|
|
||||||
: A-v-conversion-op ( v1 to-type quot -- v2 )
|
|
||||||
swap [ underlying>> A-rep ] [ call ] [ '[ _ boa ] call( u -- v ) ] tri* ; inline
|
|
||||||
|
|
||||||
: A-vv-conversion-op ( v1 v2 to-type quot -- v2 )
|
|
||||||
swap {
|
|
||||||
[ underlying>> ]
|
|
||||||
[ underlying>> A-rep ]
|
|
||||||
[ call ]
|
|
||||||
[ '[ _ boa ] call( u -- v ) ]
|
|
||||||
} spread ; inline
|
|
||||||
|
|
||||||
simd new
|
|
||||||
\ A >>class
|
|
||||||
\ A-with >>ctor
|
|
||||||
\ A-rep >>rep
|
|
||||||
{
|
|
||||||
{ (v>float) A-v-conversion-op }
|
|
||||||
{ (v>integer) A-v-conversion-op }
|
|
||||||
{ (vpack-signed) A-vv-conversion-op }
|
|
||||||
{ (vpack-unsigned) A-vv-conversion-op }
|
|
||||||
{ (vunpack-head) A-v-conversion-op }
|
|
||||||
{ (vunpack-tail) A-v-conversion-op }
|
|
||||||
} >>special-wrappers
|
|
||||||
{
|
|
||||||
{ { +vector+ +vector+ -> +vector+ } A-vv->v-op }
|
|
||||||
{ { +vector+ +any-vector+ -> +vector+ } A-vv->v-op }
|
|
||||||
{ { +vector+ +scalar+ -> +vector+ } A-vn->v-op }
|
|
||||||
{ { +vector+ +literal+ -> +vector+ } A-vn->v-op }
|
|
||||||
{ { +vector+ +vector+ -> +scalar+ } A-vv->n-op }
|
|
||||||
{ { +vector+ +vector+ -> +boolean+ } A-vv->n-op }
|
|
||||||
{ { +vector+ -> +vector+ } A-v->v-op }
|
|
||||||
{ { +vector+ -> +scalar+ } A-v->n-op }
|
|
||||||
{ { +vector+ -> +boolean+ } A-v->n-op }
|
|
||||||
{ { +vector+ -> +nonnegative+ } A-v->n-op }
|
|
||||||
} >>schema-wrappers
|
|
||||||
(define-simd-128)
|
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
;FUNCTOR
|
|
||||||
|
|
||||||
! Synthesize 256-bit vectors from a pair of 128-bit vectors
|
|
||||||
SLOT: underlying1
|
|
||||||
SLOT: underlying2
|
|
||||||
|
|
||||||
:: define-simd-256-type ( class rep -- )
|
|
||||||
c:<c-type>
|
|
||||||
class >>class
|
|
||||||
class >>boxed-class
|
|
||||||
[
|
|
||||||
[ rep alien-vector ]
|
|
||||||
[ 16 + >fixnum rep alien-vector ] 2bi
|
|
||||||
class boa
|
|
||||||
] >>getter
|
|
||||||
[
|
|
||||||
[ [ underlying1>> ] 2dip rep set-alien-vector ]
|
|
||||||
[ [ underlying2>> ] 2dip 16 + >fixnum rep set-alien-vector ]
|
|
||||||
3bi
|
|
||||||
] >>setter
|
|
||||||
32 >>size
|
|
||||||
8 >>align
|
|
||||||
rep >>rep
|
|
||||||
class c:typedef ;
|
|
||||||
|
|
||||||
: (define-simd-256) ( simd -- )
|
|
||||||
simd-ops get { vshuffle-elements vshuffle-bytes hlshift hrshift } unique assoc-diff >>ops
|
|
||||||
[ define-simd ]
|
|
||||||
[ [ class>> ] [ rep>> ] bi define-simd-256-type ] bi ;
|
|
||||||
|
|
||||||
FUNCTOR: define-simd-256 ( T -- )
|
|
||||||
|
|
||||||
N [ 32 T c:heap-size /i ]
|
|
||||||
|
|
||||||
N/2 [ N 2 /i ]
|
|
||||||
A/2 IS ${T}-${N/2}
|
|
||||||
A/2-boa IS ${A/2}-boa
|
|
||||||
A/2-with IS ${A/2}-with
|
|
||||||
|
|
||||||
A DEFINES-CLASS ${T}-${N}
|
|
||||||
A-boa DEFINES ${A}-boa
|
|
||||||
A-with DEFINES ${A}-with
|
|
||||||
A-cast DEFINES ${A}-cast
|
|
||||||
>A DEFINES >${A}
|
|
||||||
A{ DEFINES ${A}{
|
|
||||||
|
|
||||||
A-deref DEFINES-PRIVATE ${A}-deref
|
|
||||||
|
|
||||||
A-rep [ A/2 name>> "-rep" append "cpu.architecture" lookup ]
|
|
||||||
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
|
|
||||||
A-vn->v-op DEFINES-PRIVATE ${A}-vn->v-op
|
|
||||||
A-v->v-op DEFINES-PRIVATE ${A}-v->v-op
|
|
||||||
A-v.-op DEFINES-PRIVATE ${A}-v.-op
|
|
||||||
(A-v->n-op) DEFINES-PRIVATE (${A}-v->v-op)
|
|
||||||
A-sum-op DEFINES-PRIVATE ${A}-sum-op
|
|
||||||
A-vany-op DEFINES-PRIVATE ${A}-vany-op
|
|
||||||
A-vall-op DEFINES-PRIVATE ${A}-vall-op
|
|
||||||
A-vmerge-head-op DEFINES-PRIVATE ${A}-vmerge-head-op
|
|
||||||
A-vmerge-tail-op DEFINES-PRIVATE ${A}-vmerge-tail-op
|
|
||||||
A-v-conversion-op DEFINES-PRIVATE ${A}-v-conversion-op
|
|
||||||
A-vpack-op DEFINES-PRIVATE ${A}-vpack-op
|
|
||||||
A-vunpack-head-op DEFINES-PRIVATE ${A}-vunpack-head-op
|
|
||||||
A-vunpack-tail-op DEFINES-PRIVATE ${A}-vunpack-tail-op
|
|
||||||
|
|
||||||
WHERE
|
|
||||||
|
|
||||||
SLOT: underlying1
|
|
||||||
SLOT: underlying2
|
|
||||||
|
|
||||||
TUPLE: A
|
|
||||||
{ underlying1 byte-array initial: $[ 16 <byte-array> ] read-only }
|
|
||||||
{ underlying2 byte-array initial: $[ 16 <byte-array> ] read-only } ;
|
|
||||||
|
|
||||||
INSTANCE: A simd-256
|
|
||||||
|
|
||||||
M: A clone
|
|
||||||
[ underlying1>> clone ] [ underlying2>> clone ] bi
|
|
||||||
\ A boa ; inline
|
|
||||||
|
|
||||||
M: A length drop N ; inline
|
|
||||||
|
|
||||||
M: A equal?
|
|
||||||
over \ A instance? [ v= vall? ] [ 2drop f ] if ;
|
|
||||||
|
|
||||||
: A-deref ( n seq -- n' seq' )
|
|
||||||
over N/2 < [ underlying1>> ] [ [ N/2 - ] dip underlying2>> ] if \ A/2 boa ; inline
|
|
||||||
|
|
||||||
M: A nth-unsafe A-deref nth-unsafe ; inline
|
|
||||||
|
|
||||||
M: A set-nth-unsafe A-deref set-nth-unsafe ; inline
|
|
||||||
|
|
||||||
: >A ( seq -- simd-array ) \ A new clone-like ;
|
|
||||||
|
|
||||||
M: A like drop dup \ A instance? [ >A ] unless ; inline
|
|
||||||
|
|
||||||
M: A new-sequence
|
|
||||||
drop dup N =
|
|
||||||
[ drop 16 <byte-array> 16 <byte-array> \ A boa ]
|
|
||||||
[ N bad-length ]
|
|
||||||
if ; inline
|
|
||||||
|
|
||||||
M: A c:byte-length drop 32 ; inline
|
|
||||||
|
|
||||||
M: A element-type drop A-rep rep-component-type ;
|
|
||||||
|
|
||||||
SYNTAX: A{ \ } [ >A ] parse-literal ;
|
|
||||||
|
|
||||||
M: A pprint-delims drop \ A{ \ } ;
|
|
||||||
|
|
||||||
M: A >pprint-sequence ;
|
|
||||||
|
|
||||||
M: A pprint* pprint-object ;
|
|
||||||
|
|
||||||
: A-with ( x -- simd-array )
|
|
||||||
[ A/2-with ] [ A/2-with ] bi [ underlying>> ] bi@
|
|
||||||
\ A boa ; inline
|
|
||||||
|
|
||||||
: A-boa ( ... -- simd-array )
|
|
||||||
[ A/2-boa ] N/2 ndip A/2-boa [ underlying>> ] bi@
|
|
||||||
\ A boa ; inline
|
|
||||||
|
|
||||||
\ A-rep 2 boa-effect \ A-boa set-stack-effect
|
|
||||||
|
|
||||||
: A-cast ( simd-array -- simd-array' )
|
|
||||||
[ underlying1>> ] [ underlying2>> ] bi \ A boa ; inline
|
|
||||||
|
|
||||||
INSTANCE: A sequence
|
|
||||||
|
|
||||||
: A-vv->v-op ( v1 v2 quot -- v3 )
|
|
||||||
[ [ [ underlying1>> ] bi@ A-rep ] dip call ]
|
|
||||||
[ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
|
|
||||||
\ A boa ; inline
|
|
||||||
|
|
||||||
: A-vn->v-op ( v1 v2 quot -- v3 )
|
|
||||||
[ [ [ underlying1>> ] dip A-rep ] dip call ]
|
|
||||||
[ [ [ underlying2>> ] dip A-rep ] dip call ] 3bi
|
|
||||||
\ A boa ; inline
|
|
||||||
|
|
||||||
: A-v->v-op ( v1 combine-quot -- v2 )
|
|
||||||
[ [ underlying1>> A-rep ] dip call ]
|
|
||||||
[ [ underlying2>> A-rep ] dip call ] 2bi
|
|
||||||
\ A boa ; inline
|
|
||||||
|
|
||||||
: A-v.-op ( v1 v2 quot -- n )
|
|
||||||
[ [ [ underlying1>> ] bi@ A-rep ] dip call ]
|
|
||||||
[ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
|
|
||||||
+ ; inline
|
|
||||||
|
|
||||||
: (A-v->n-op) ( v1 quot reduce-quot -- n )
|
|
||||||
'[ [ underlying1>> ] [ underlying2>> ] bi A-rep @ A-rep ] dip call ; inline
|
|
||||||
|
|
||||||
: A-sum-op ( v1 quot -- n )
|
|
||||||
[ (simd-v+) ] (A-v->n-op) ; inline
|
|
||||||
|
|
||||||
: A-vany-op ( v1 quot -- n )
|
|
||||||
[ (simd-vbitor) ] (A-v->n-op) ; inline
|
|
||||||
: A-vall-op ( v1 quot -- n )
|
|
||||||
[ (simd-vbitand) ] (A-v->n-op) ; inline
|
|
||||||
|
|
||||||
: A-vmerge-head-op ( v1 v2 quot -- v )
|
|
||||||
drop
|
|
||||||
[ underlying1>> ] bi@
|
|
||||||
[ A-rep (simd-(vmerge-head)) ]
|
|
||||||
[ A-rep (simd-(vmerge-tail)) ] 2bi
|
|
||||||
\ A boa ; inline
|
|
||||||
|
|
||||||
: A-vmerge-tail-op ( v1 v2 quot -- v )
|
|
||||||
drop
|
|
||||||
[ underlying2>> ] bi@
|
|
||||||
[ A-rep (simd-(vmerge-head)) ]
|
|
||||||
[ A-rep (simd-(vmerge-tail)) ] 2bi
|
|
||||||
\ A boa ; inline
|
|
||||||
|
|
||||||
: A-v-conversion-op ( v1 to-type quot -- v )
|
|
||||||
swap [
|
|
||||||
[ [ underlying1>> A-rep ] dip call ]
|
|
||||||
[ [ underlying2>> A-rep ] dip call ] 2bi
|
|
||||||
] dip '[ _ boa ] call( u1 u2 -- v ) ; inline
|
|
||||||
|
|
||||||
: A-vpack-op ( v1 v2 to-type quot -- v )
|
|
||||||
swap [
|
|
||||||
'[ [ underlying1>> ] [ underlying2>> ] bi A-rep @ ] bi*
|
|
||||||
] dip '[ _ boa ] call( u1 u2 -- v ) ; inline
|
|
||||||
|
|
||||||
: A-vunpack-head-op ( v1 to-type quot -- v )
|
|
||||||
'[
|
|
||||||
underlying1>>
|
|
||||||
[ A-rep @ ]
|
|
||||||
[ A-rep (simd-(vunpack-tail)) ] bi
|
|
||||||
] dip '[ _ boa ] call( u1 u2 -- v ) ; inline
|
|
||||||
|
|
||||||
: A-vunpack-tail-op ( v1 to-type quot -- v )
|
|
||||||
'[
|
|
||||||
underlying2>>
|
|
||||||
[ A-rep (simd-(vunpack-head)) ]
|
|
||||||
[ A-rep @ ] bi
|
|
||||||
] dip '[ _ boa ] call( u1 u2 -- v ) ; inline
|
|
||||||
|
|
||||||
simd new
|
|
||||||
\ A >>class
|
|
||||||
\ A-with >>ctor
|
|
||||||
\ A-rep >>rep
|
|
||||||
{
|
|
||||||
{ v. A-v.-op }
|
|
||||||
{ sum A-sum-op }
|
|
||||||
{ vnone? A-vany-op }
|
|
||||||
{ vany? A-vany-op }
|
|
||||||
{ vall? A-vall-op }
|
|
||||||
{ (vmerge-head) A-vmerge-head-op }
|
|
||||||
{ (vmerge-tail) A-vmerge-tail-op }
|
|
||||||
{ (v>integer) A-v-conversion-op }
|
|
||||||
{ (v>float) A-v-conversion-op }
|
|
||||||
{ (vpack-signed) A-vpack-op }
|
|
||||||
{ (vpack-unsigned) A-vpack-op }
|
|
||||||
{ (vunpack-head) A-vunpack-head-op }
|
|
||||||
{ (vunpack-tail) A-vunpack-tail-op }
|
|
||||||
} >>special-wrappers
|
|
||||||
{
|
|
||||||
{ { +vector+ +vector+ -> +vector+ } A-vv->v-op }
|
|
||||||
{ { +vector+ +scalar+ -> +vector+ } A-vn->v-op }
|
|
||||||
{ { +vector+ +literal+ -> +vector+ } A-vn->v-op }
|
|
||||||
{ { +vector+ -> +vector+ } A-v->v-op }
|
|
||||||
} >>schema-wrappers
|
|
||||||
(define-simd-256)
|
|
||||||
|
|
||||||
;FUNCTOR
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Slava Pestov
|
|
||||||
|
|
@ -1,18 +0,0 @@
|
||||||
IN: math.vectors.simd.intrinsics.tests
|
|
||||||
USING: math.vectors.simd.intrinsics cpu.architecture tools.test ;
|
|
||||||
|
|
||||||
[ 16 ] [ uchar-16-rep rep-components ] unit-test
|
|
||||||
[ 16 ] [ char-16-rep rep-components ] unit-test
|
|
||||||
[ 8 ] [ ushort-8-rep rep-components ] unit-test
|
|
||||||
[ 8 ] [ short-8-rep rep-components ] unit-test
|
|
||||||
[ 4 ] [ uint-4-rep rep-components ] unit-test
|
|
||||||
[ 4 ] [ int-4-rep rep-components ] unit-test
|
|
||||||
[ 4 ] [ float-4-rep rep-components ] unit-test
|
|
||||||
[ 2 ] [ double-2-rep rep-components ] unit-test
|
|
||||||
|
|
||||||
{ 4 1 } [ uint-4-rep (simd-boa) ] must-infer-as
|
|
||||||
{ 4 1 } [ int-4-rep (simd-boa) ] must-infer-as
|
|
||||||
{ 4 1 } [ float-4-rep (simd-boa) ] must-infer-as
|
|
||||||
{ 2 1 } [ double-2-rep (simd-boa) ] must-infer-as
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,207 +0,0 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: alien alien.c-types alien.data assocs combinators
|
|
||||||
cpu.architecture compiler.cfg.comparisons fry generalizations
|
|
||||||
kernel libc macros math
|
|
||||||
math.vectors.conversion.backend
|
|
||||||
sequences sets effects accessors namespaces
|
|
||||||
lexer parser vocabs.parser words arrays math.vectors ;
|
|
||||||
IN: math.vectors.simd.intrinsics
|
|
||||||
|
|
||||||
ERROR: bad-simd-call word ;
|
|
||||||
|
|
||||||
<<
|
|
||||||
|
|
||||||
: simd-effect ( word -- effect )
|
|
||||||
stack-effect [ in>> "rep" suffix ] [ out>> ] bi <effect> ;
|
|
||||||
: simd-conversion-effect ( word -- effect )
|
|
||||||
stack-effect [ in>> but-last "rep" suffix ] [ out>> ] bi <effect> ;
|
|
||||||
|
|
||||||
SYMBOL: simd-ops
|
|
||||||
|
|
||||||
V{ } clone simd-ops set-global
|
|
||||||
|
|
||||||
: (SIMD-OP:) ( accum quot -- accum )
|
|
||||||
[
|
|
||||||
scan-word dup name>> "(simd-" ")" surround create-in
|
|
||||||
[ nip dup '[ _ bad-simd-call ] define ]
|
|
||||||
] dip
|
|
||||||
'[ _ dip set-stack-effect ]
|
|
||||||
[ 2array simd-ops get push ]
|
|
||||||
2tri ; inline
|
|
||||||
|
|
||||||
SYNTAX: SIMD-OP:
|
|
||||||
[ simd-effect ] (SIMD-OP:) ;
|
|
||||||
|
|
||||||
SYNTAX: SIMD-CONVERSION-OP:
|
|
||||||
[ simd-conversion-effect ] (SIMD-OP:) ;
|
|
||||||
|
|
||||||
>>
|
|
||||||
|
|
||||||
SIMD-OP: v+
|
|
||||||
SIMD-OP: v-
|
|
||||||
SIMD-OP: vneg
|
|
||||||
SIMD-OP: v+-
|
|
||||||
SIMD-OP: vs+
|
|
||||||
SIMD-OP: vs-
|
|
||||||
SIMD-OP: vs*
|
|
||||||
SIMD-OP: v*
|
|
||||||
SIMD-OP: v/
|
|
||||||
SIMD-OP: vmin
|
|
||||||
SIMD-OP: vmax
|
|
||||||
SIMD-OP: v.
|
|
||||||
SIMD-OP: vsqrt
|
|
||||||
SIMD-OP: sum
|
|
||||||
SIMD-OP: vabs
|
|
||||||
SIMD-OP: vbitand
|
|
||||||
SIMD-OP: vbitandn
|
|
||||||
SIMD-OP: vbitor
|
|
||||||
SIMD-OP: vbitxor
|
|
||||||
SIMD-OP: vbitnot
|
|
||||||
SIMD-OP: vand
|
|
||||||
SIMD-OP: vandn
|
|
||||||
SIMD-OP: vor
|
|
||||||
SIMD-OP: vxor
|
|
||||||
SIMD-OP: vnot
|
|
||||||
SIMD-OP: vlshift
|
|
||||||
SIMD-OP: vrshift
|
|
||||||
SIMD-OP: hlshift
|
|
||||||
SIMD-OP: hrshift
|
|
||||||
SIMD-OP: vshuffle-elements
|
|
||||||
SIMD-OP: vshuffle-bytes
|
|
||||||
SIMD-OP: (vmerge-head)
|
|
||||||
SIMD-OP: (vmerge-tail)
|
|
||||||
SIMD-OP: v<=
|
|
||||||
SIMD-OP: v<
|
|
||||||
SIMD-OP: v=
|
|
||||||
SIMD-OP: v>
|
|
||||||
SIMD-OP: v>=
|
|
||||||
SIMD-OP: vunordered?
|
|
||||||
SIMD-OP: vany?
|
|
||||||
SIMD-OP: vall?
|
|
||||||
SIMD-OP: vnone?
|
|
||||||
|
|
||||||
SIMD-CONVERSION-OP: (v>float)
|
|
||||||
SIMD-CONVERSION-OP: (v>integer)
|
|
||||||
SIMD-CONVERSION-OP: (vpack-signed)
|
|
||||||
SIMD-CONVERSION-OP: (vpack-unsigned)
|
|
||||||
SIMD-CONVERSION-OP: (vunpack-head)
|
|
||||||
SIMD-CONVERSION-OP: (vunpack-tail)
|
|
||||||
|
|
||||||
: (simd-with) ( x rep -- v ) bad-simd-call ;
|
|
||||||
: (simd-gather-2) ( a b rep -- v ) bad-simd-call ;
|
|
||||||
: (simd-gather-4) ( a b c d rep -- v ) bad-simd-call ;
|
|
||||||
: (simd-select) ( v n rep -- x ) bad-simd-call ;
|
|
||||||
|
|
||||||
: assert-positive ( x -- y ) ;
|
|
||||||
|
|
||||||
: alien-vector ( c-ptr n rep -- value )
|
|
||||||
! Inefficient version for when intrinsics are missing
|
|
||||||
[ swap <displaced-alien> ] dip rep-size memory>byte-array ;
|
|
||||||
|
|
||||||
: set-alien-vector ( value c-ptr n rep -- )
|
|
||||||
! Inefficient version for when intrinsics are missing
|
|
||||||
[ swap <displaced-alien> swap ] dip rep-size memcpy ;
|
|
||||||
|
|
||||||
<<
|
|
||||||
|
|
||||||
: rep-components ( rep -- n )
|
|
||||||
16 swap rep-component-type heap-size /i ; foldable
|
|
||||||
|
|
||||||
: rep-coercer ( rep -- quot )
|
|
||||||
{
|
|
||||||
{ [ dup int-vector-rep? ] [ [ >fixnum ] ] }
|
|
||||||
{ [ dup float-vector-rep? ] [ [ >float ] ] }
|
|
||||||
} cond nip ; foldable
|
|
||||||
|
|
||||||
: rep-coerce ( value rep -- value' )
|
|
||||||
rep-coercer call( value -- value' ) ; inline
|
|
||||||
|
|
||||||
CONSTANT: rep-gather-words
|
|
||||||
{
|
|
||||||
{ 2 (simd-gather-2) }
|
|
||||||
{ 4 (simd-gather-4) }
|
|
||||||
}
|
|
||||||
|
|
||||||
: rep-gather-word ( rep -- word )
|
|
||||||
rep-components rep-gather-words at ;
|
|
||||||
|
|
||||||
>>
|
|
||||||
|
|
||||||
MACRO: (simd-boa) ( rep -- quot )
|
|
||||||
{
|
|
||||||
[ rep-coercer ]
|
|
||||||
[ rep-components ]
|
|
||||||
[ ]
|
|
||||||
[ rep-gather-word ]
|
|
||||||
} cleave
|
|
||||||
'[ _ _ napply _ _ execute ] ;
|
|
||||||
|
|
||||||
GENERIC# supported-simd-op? 1 ( rep intrinsic -- ? )
|
|
||||||
|
|
||||||
: (%unpack-reps) ( -- reps )
|
|
||||||
%merge-vector-reps [ int-vector-rep? ] filter
|
|
||||||
%unpack-vector-head-reps union ;
|
|
||||||
|
|
||||||
: (%abs-reps) ( -- reps )
|
|
||||||
cc> %compare-vector-reps [ int-vector-rep? ] filter
|
|
||||||
%xor-vector-reps [ float-vector-rep? ] filter
|
|
||||||
union
|
|
||||||
[ { } ] [ { uchar-16-rep ushort-8-rep uint-4-rep ulonglong-2-rep } union ] if-empty ;
|
|
||||||
|
|
||||||
: (%shuffle-imm-reps) ( -- reps )
|
|
||||||
%shuffle-vector-reps %shuffle-vector-imm-reps union ;
|
|
||||||
|
|
||||||
M: vector-rep supported-simd-op?
|
|
||||||
{
|
|
||||||
{ \ (simd-v+) [ %add-vector-reps ] }
|
|
||||||
{ \ (simd-vs+) [ %saturated-add-vector-reps ] }
|
|
||||||
{ \ (simd-v+-) [ %add-sub-vector-reps ] }
|
|
||||||
{ \ (simd-v-) [ %sub-vector-reps ] }
|
|
||||||
{ \ (simd-vs-) [ %saturated-sub-vector-reps ] }
|
|
||||||
{ \ (simd-vneg) [ %sub-vector-reps ] }
|
|
||||||
{ \ (simd-v*) [ %mul-vector-reps ] }
|
|
||||||
{ \ (simd-vs*) [ %saturated-mul-vector-reps ] }
|
|
||||||
{ \ (simd-v/) [ %div-vector-reps ] }
|
|
||||||
{ \ (simd-vmin) [ %min-vector-reps cc< %compare-vector-reps union ] }
|
|
||||||
{ \ (simd-vmax) [ %max-vector-reps cc> %compare-vector-reps union ] }
|
|
||||||
{ \ (simd-v.) [ %dot-vector-reps ] }
|
|
||||||
{ \ (simd-vsqrt) [ %sqrt-vector-reps ] }
|
|
||||||
{ \ (simd-sum) [ %horizontal-add-vector-reps ] }
|
|
||||||
{ \ (simd-vabs) [ (%abs-reps) ] }
|
|
||||||
{ \ (simd-vbitand) [ %and-vector-reps ] }
|
|
||||||
{ \ (simd-vbitandn) [ %andn-vector-reps ] }
|
|
||||||
{ \ (simd-vbitor) [ %or-vector-reps ] }
|
|
||||||
{ \ (simd-vbitxor) [ %xor-vector-reps ] }
|
|
||||||
{ \ (simd-vbitnot) [ %xor-vector-reps ] }
|
|
||||||
{ \ (simd-vand) [ %and-vector-reps ] }
|
|
||||||
{ \ (simd-vandn) [ %andn-vector-reps ] }
|
|
||||||
{ \ (simd-vor) [ %or-vector-reps ] }
|
|
||||||
{ \ (simd-vxor) [ %xor-vector-reps ] }
|
|
||||||
{ \ (simd-vnot) [ %xor-vector-reps ] }
|
|
||||||
{ \ (simd-vlshift) [ %shl-vector-reps ] }
|
|
||||||
{ \ (simd-vrshift) [ %shr-vector-reps ] }
|
|
||||||
{ \ (simd-hlshift) [ %horizontal-shl-vector-imm-reps ] }
|
|
||||||
{ \ (simd-hrshift) [ %horizontal-shr-vector-imm-reps ] }
|
|
||||||
{ \ (simd-vshuffle-elements) [ (%shuffle-imm-reps) ] }
|
|
||||||
{ \ (simd-vshuffle-bytes) [ %shuffle-vector-reps ] }
|
|
||||||
{ \ (simd-(vmerge-head)) [ %merge-vector-reps ] }
|
|
||||||
{ \ (simd-(vmerge-tail)) [ %merge-vector-reps ] }
|
|
||||||
{ \ (simd-(v>float)) [ %integer>float-vector-reps ] }
|
|
||||||
{ \ (simd-(v>integer)) [ %float>integer-vector-reps ] }
|
|
||||||
{ \ (simd-(vpack-signed)) [ %signed-pack-vector-reps ] }
|
|
||||||
{ \ (simd-(vpack-unsigned)) [ %unsigned-pack-vector-reps ] }
|
|
||||||
{ \ (simd-(vunpack-head)) [ (%unpack-reps) ] }
|
|
||||||
{ \ (simd-(vunpack-tail)) [ (%unpack-reps) ] }
|
|
||||||
{ \ (simd-v<=) [ unsign-rep cc<= %compare-vector-reps ] }
|
|
||||||
{ \ (simd-v<) [ unsign-rep cc< %compare-vector-reps ] }
|
|
||||||
{ \ (simd-v=) [ unsign-rep cc= %compare-vector-reps ] }
|
|
||||||
{ \ (simd-v>) [ unsign-rep cc> %compare-vector-reps ] }
|
|
||||||
{ \ (simd-v>=) [ unsign-rep cc>= %compare-vector-reps ] }
|
|
||||||
{ \ (simd-vunordered?) [ unsign-rep cc/<>= %compare-vector-reps ] }
|
|
||||||
{ \ (simd-gather-2) [ %gather-vector-2-reps ] }
|
|
||||||
{ \ (simd-gather-4) [ %gather-vector-4-reps ] }
|
|
||||||
{ \ (simd-vany?) [ %test-vector-reps ] }
|
|
||||||
{ \ (simd-vall?) [ %test-vector-reps ] }
|
|
||||||
{ \ (simd-vnone?) [ %test-vector-reps ] }
|
|
||||||
} case member? ;
|
|
||||||
|
|
@ -1,28 +0,0 @@
|
||||||
IN: math.vectors.specialization.tests
|
|
||||||
USING: compiler.tree.debugger math.vectors tools.test kernel
|
|
||||||
kernel.private math specialized-arrays ;
|
|
||||||
QUALIFIED-WITH: alien.c-types c
|
|
||||||
QUALIFIED-WITH: alien.complex c
|
|
||||||
SPECIALIZED-ARRAY: c:double
|
|
||||||
SPECIALIZED-ARRAY: c:complex-float
|
|
||||||
SPECIALIZED-ARRAY: c:float
|
|
||||||
|
|
||||||
[ V{ t } ] [
|
|
||||||
[ { double-array double-array } declare distance 0.0 < not ] final-literals
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ V{ float } ] [
|
|
||||||
[ { float-array float } declare v*n norm ] final-classes
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ V{ complex } ] [
|
|
||||||
[ { complex-float-array complex-float-array } declare v. ] final-classes
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ V{ float } ] [
|
|
||||||
[ { float-array float } declare v*n norm ] final-classes
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ V{ float } ] [
|
|
||||||
[ { complex-float-array complex } declare v*n norm ] final-classes
|
|
||||||
] unit-test
|
|
||||||
|
|
@ -1,207 +0,0 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: words kernel make sequences effects sets kernel.private
|
|
||||||
accessors combinators math math.intervals math.vectors
|
|
||||||
math.vectors.conversion.backend namespaces assocs fry splitting
|
|
||||||
classes.algebra generalizations locals
|
|
||||||
compiler.tree.propagation.info ;
|
|
||||||
IN: math.vectors.specialization
|
|
||||||
|
|
||||||
SYMBOLS: -> +vector+ +any-vector+ +scalar+ +boolean+ +nonnegative+ +literal+ ;
|
|
||||||
|
|
||||||
: parent-vector-class ( type -- type' )
|
|
||||||
{
|
|
||||||
{ [ dup simd-128 class<= ] [ drop simd-128 ] }
|
|
||||||
{ [ dup simd-256 class<= ] [ drop simd-256 ] }
|
|
||||||
[ "Not a vector class" throw ]
|
|
||||||
} cond ;
|
|
||||||
|
|
||||||
: signature-for-schema ( array-type elt-type schema -- signature )
|
|
||||||
[
|
|
||||||
{
|
|
||||||
{ +vector+ [ drop ] }
|
|
||||||
{ +any-vector+ [ drop parent-vector-class ] }
|
|
||||||
{ +scalar+ [ nip ] }
|
|
||||||
{ +boolean+ [ 2drop boolean ] }
|
|
||||||
{ +nonnegative+ [ nip ] }
|
|
||||||
{ +literal+ [ 2drop f ] }
|
|
||||||
} case
|
|
||||||
] with with map ;
|
|
||||||
|
|
||||||
: (specialize-vector-word) ( word array-type elt-type schema -- word' )
|
|
||||||
signature-for-schema
|
|
||||||
[ [ name>> ] [ [ name>> ] map "," join ] bi* "=>" glue f <word> ]
|
|
||||||
[ [ , \ declare , def>> % ] [ ] make ]
|
|
||||||
[ drop stack-effect ]
|
|
||||||
2tri
|
|
||||||
[ define-declared ] [ 2drop ] 3bi ;
|
|
||||||
|
|
||||||
: output-infos ( array-type elt-type schema -- value-infos )
|
|
||||||
[
|
|
||||||
{
|
|
||||||
{ +vector+ [ drop <class-info> ] }
|
|
||||||
{ +any-vector+ [ drop parent-vector-class <class-info> ] }
|
|
||||||
{ +scalar+ [ nip <class-info> ] }
|
|
||||||
{ +boolean+ [ 2drop boolean <class-info> ] }
|
|
||||||
{
|
|
||||||
+nonnegative+
|
|
||||||
[
|
|
||||||
nip
|
|
||||||
dup complex class<= [ drop float ] when
|
|
||||||
[0,inf] <class/interval-info>
|
|
||||||
]
|
|
||||||
}
|
|
||||||
} case
|
|
||||||
] with with map ;
|
|
||||||
|
|
||||||
: record-output-signature ( word array-type elt-type schema -- word )
|
|
||||||
output-infos
|
|
||||||
[ drop ]
|
|
||||||
[ drop ]
|
|
||||||
[ [ stack-effect in>> length '[ _ ndrop ] ] dip append ] 2tri
|
|
||||||
"outputs" set-word-prop ;
|
|
||||||
|
|
||||||
CONSTANT: vector-words
|
|
||||||
H{
|
|
||||||
{ [v-] { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ distance { +vector+ +vector+ -> +nonnegative+ } }
|
|
||||||
{ n*v { +scalar+ +vector+ -> +vector+ } }
|
|
||||||
{ n+v { +scalar+ +vector+ -> +vector+ } }
|
|
||||||
{ n-v { +scalar+ +vector+ -> +vector+ } }
|
|
||||||
{ n/v { +scalar+ +vector+ -> +vector+ } }
|
|
||||||
{ norm { +vector+ -> +nonnegative+ } }
|
|
||||||
{ norm-sq { +vector+ -> +nonnegative+ } }
|
|
||||||
{ normalize { +vector+ -> +vector+ } }
|
|
||||||
{ v* { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vs* { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v*n { +vector+ +scalar+ -> +vector+ } }
|
|
||||||
{ v+ { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vs+ { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v+- { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v+n { +vector+ +scalar+ -> +vector+ } }
|
|
||||||
{ v- { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vneg { +vector+ -> +vector+ } }
|
|
||||||
{ vs- { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v-n { +vector+ +scalar+ -> +vector+ } }
|
|
||||||
{ v. { +vector+ +vector+ -> +scalar+ } }
|
|
||||||
{ v/ { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v/n { +vector+ +scalar+ -> +vector+ } }
|
|
||||||
{ vceiling { +vector+ -> +vector+ } }
|
|
||||||
{ vfloor { +vector+ -> +vector+ } }
|
|
||||||
{ vmax { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vmin { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vneg { +vector+ -> +vector+ } }
|
|
||||||
{ vtruncate { +vector+ -> +vector+ } }
|
|
||||||
{ sum { +vector+ -> +scalar+ } }
|
|
||||||
{ vabs { +vector+ -> +vector+ } }
|
|
||||||
{ vsqrt { +vector+ -> +vector+ } }
|
|
||||||
{ vbitand { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vbitandn { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vbitor { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vbitxor { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vbitnot { +vector+ -> +vector+ } }
|
|
||||||
{ vand { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vandn { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vor { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vxor { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vnot { +vector+ -> +vector+ } }
|
|
||||||
{ vlshift { +vector+ +scalar+ -> +vector+ } }
|
|
||||||
{ vrshift { +vector+ +scalar+ -> +vector+ } }
|
|
||||||
{ hlshift { +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ hrshift { +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ vshuffle-elements { +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ vshuffle-bytes { +vector+ +any-vector+ -> +vector+ } }
|
|
||||||
{ vbroadcast { +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ (vmerge-head) { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ (vmerge-tail) { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ (v>float) { +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ (v>integer) { +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ (vpack-signed) { +vector+ +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ (vpack-unsigned) { +vector+ +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ (vunpack-head) { +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ (vunpack-tail) { +vector+ +literal+ -> +vector+ } }
|
|
||||||
{ v<= { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v< { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v= { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v> { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ v>= { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vunordered? { +vector+ +vector+ -> +vector+ } }
|
|
||||||
{ vany? { +vector+ -> +boolean+ } }
|
|
||||||
{ vall? { +vector+ -> +boolean+ } }
|
|
||||||
{ vnone? { +vector+ -> +boolean+ } }
|
|
||||||
}
|
|
||||||
|
|
||||||
PREDICATE: vector-word < word vector-words key? ;
|
|
||||||
|
|
||||||
: specializations ( word -- assoc )
|
|
||||||
dup "specializations" word-prop
|
|
||||||
[ ] [ V{ } clone [ "specializations" set-word-prop ] keep ] ?if ;
|
|
||||||
|
|
||||||
M: vector-word subwords specializations values [ word? ] filter ;
|
|
||||||
|
|
||||||
: add-specialization ( new-word signature word -- )
|
|
||||||
specializations set-at ;
|
|
||||||
|
|
||||||
ERROR: bad-vector-word word ;
|
|
||||||
|
|
||||||
: word-schema ( word -- schema )
|
|
||||||
vector-words ?at [ bad-vector-word ] unless ;
|
|
||||||
|
|
||||||
: inputs ( schema -- seq ) { -> } split first ;
|
|
||||||
|
|
||||||
: outputs ( schema -- seq ) { -> } split second ;
|
|
||||||
|
|
||||||
: loop-vector-op ( word array-type elt-type -- word' )
|
|
||||||
pick word-schema
|
|
||||||
[ inputs (specialize-vector-word) ]
|
|
||||||
[ outputs record-output-signature ] 3bi ;
|
|
||||||
|
|
||||||
:: specialize-vector-word ( word array-type elt-type simd -- word/quot' )
|
|
||||||
word simd key? [ word simd at ] [ word array-type elt-type loop-vector-op ] if ;
|
|
||||||
|
|
||||||
:: input-signature ( word array-type elt-type -- signature )
|
|
||||||
array-type elt-type word word-schema inputs signature-for-schema ;
|
|
||||||
|
|
||||||
: vector-words-for-type ( elt-type -- words )
|
|
||||||
{
|
|
||||||
! Can't do shifts on floats
|
|
||||||
{ [ dup float class<= ] [ vector-words keys { vlshift vrshift } diff ] }
|
|
||||||
! Can't divide integers
|
|
||||||
{ [ dup integer class<= ] [ vector-words keys { vsqrt n/v v/n v/ normalize } diff ] }
|
|
||||||
! Can't compute square root of complex numbers (vsqrt uses fsqrt not sqrt)
|
|
||||||
{ [ dup complex class<= ] [ vector-words keys { vsqrt } diff ] }
|
|
||||||
[ { } ]
|
|
||||||
} cond
|
|
||||||
! Don't specialize horizontal shifts, shuffles, and conversions at all, they're only for SIMD
|
|
||||||
{
|
|
||||||
hlshift hrshift vshuffle-elements vshuffle-bytes vbroadcast
|
|
||||||
(v>integer) (v>float)
|
|
||||||
(vpack-signed) (vpack-unsigned)
|
|
||||||
(vunpack-head) (vunpack-tail)
|
|
||||||
} diff
|
|
||||||
nip ;
|
|
||||||
|
|
||||||
:: specialize-vector-words ( array-type elt-type simd -- )
|
|
||||||
elt-type vector-words-for-type simd keys union [
|
|
||||||
[ array-type elt-type simd specialize-vector-word ]
|
|
||||||
[ array-type elt-type input-signature ]
|
|
||||||
[ ]
|
|
||||||
tri add-specialization
|
|
||||||
] each ;
|
|
||||||
|
|
||||||
: specialization-matches? ( value-infos signature -- ? )
|
|
||||||
[ [ [ class>> ] dip class<= ] [ literal?>> ] if* ] 2all? ;
|
|
||||||
|
|
||||||
: find-specialization ( classes word -- word/f )
|
|
||||||
specializations
|
|
||||||
[ first specialization-matches? ] with find
|
|
||||||
swap [ second ] when ;
|
|
||||||
|
|
||||||
: vector-word-custom-inlining ( #call -- word/f )
|
|
||||||
[ in-d>> [ value-info ] map ] [ word>> ] bi
|
|
||||||
find-specialization ;
|
|
||||||
|
|
||||||
vector-words keys [
|
|
||||||
[ vector-word-custom-inlining ]
|
|
||||||
"custom-inlining" set-word-prop
|
|
||||||
] each
|
|
||||||
Loading…
Reference in New Issue