parent
db6706434d
commit
85620fc741
|
@ -1,4 +1,4 @@
|
||||||
USING: accessors alien alien.c-types arrays byte-arrays combinators
|
USING: accessors alien alien.c-types arrays ascii byte-arrays combinators
|
||||||
combinators.short-circuit fry kernel math math.blas.ffi
|
combinators.short-circuit fry kernel math math.blas.ffi
|
||||||
math.complex math.functions math.order sequences.complex
|
math.complex math.functions math.order sequences.complex
|
||||||
sequences.complex-components sequences sequences.private
|
sequences.complex-components sequences sequences.private
|
||||||
|
@ -141,7 +141,12 @@ VECTOR DEFINES-CLASS ${TYPE}-blas-vector
|
||||||
<VECTOR> DEFINES <${TYPE}-blas-vector>
|
<VECTOR> DEFINES <${TYPE}-blas-vector>
|
||||||
>VECTOR DEFINES >${TYPE}-blas-vector
|
>VECTOR DEFINES >${TYPE}-blas-vector
|
||||||
|
|
||||||
XVECTOR{ DEFINES ${T}vector{
|
t [ T >lower ]
|
||||||
|
|
||||||
|
XVECTOR{ DEFINES ${t}vector{
|
||||||
|
|
||||||
|
XAXPY IS ${T}AXPY
|
||||||
|
XSCAL IS ${T}SCAL
|
||||||
|
|
||||||
WHERE
|
WHERE
|
||||||
|
|
||||||
|
@ -170,6 +175,11 @@ M: VECTOR (blas-direct-array)
|
||||||
[ [ length>> ] [ inc>> ] bi * ] bi
|
[ [ length>> ] [ inc>> ] bi * ] bi
|
||||||
<DIRECT-ARRAY> ;
|
<DIRECT-ARRAY> ;
|
||||||
|
|
||||||
|
M: VECTOR n*V+V!
|
||||||
|
(prepare-axpy) [ XAXPY ] dip ;
|
||||||
|
M: VECTOR n*V!
|
||||||
|
(prepare-scal) [ XSCAL ] dip ;
|
||||||
|
|
||||||
: XVECTOR{ \ } [ >VECTOR ] parse-literal ; parsing
|
: XVECTOR{ \ } [ >VECTOR ] parse-literal ; parsing
|
||||||
|
|
||||||
M: VECTOR pprint-delims
|
M: VECTOR pprint-delims
|
||||||
|
@ -181,11 +191,9 @@ M: VECTOR pprint-delims
|
||||||
FUNCTOR: (define-real-blas-vector) ( TYPE T -- )
|
FUNCTOR: (define-real-blas-vector) ( TYPE T -- )
|
||||||
|
|
||||||
VECTOR IS ${TYPE}-blas-vector
|
VECTOR IS ${TYPE}-blas-vector
|
||||||
XDOT IS cblas_${T}dot
|
XDOT IS ${T}DOT
|
||||||
XNRM2 IS cblas_${T}nrm2
|
XNRM2 IS ${T}NRM2
|
||||||
XASUM IS cblas_${T}asum
|
XASUM IS ${T}ASUM
|
||||||
XAXPY IS cblas_${T}axpy
|
|
||||||
XSCAL IS cblas_${T}scal
|
|
||||||
|
|
||||||
WHERE
|
WHERE
|
||||||
|
|
||||||
|
@ -197,33 +205,6 @@ M: VECTOR Vnorm
|
||||||
(prepare-nrm2) XNRM2 ;
|
(prepare-nrm2) XNRM2 ;
|
||||||
M: VECTOR Vasum
|
M: VECTOR Vasum
|
||||||
(prepare-nrm2) XASUM ;
|
(prepare-nrm2) XASUM ;
|
||||||
M: VECTOR n*V+V!
|
|
||||||
(prepare-axpy) [ XAXPY ] dip ;
|
|
||||||
M: VECTOR n*V!
|
|
||||||
(prepare-scal) [ XSCAL ] dip ;
|
|
||||||
|
|
||||||
;FUNCTOR
|
|
||||||
|
|
||||||
|
|
||||||
FUNCTOR: (define-complex-helpers) ( TYPE -- )
|
|
||||||
|
|
||||||
<DIRECT-COMPLEX-ARRAY> DEFINES <direct-${TYPE}-complex-array>
|
|
||||||
>COMPLEX-ARRAY DEFINES >${TYPE}-complex-array
|
|
||||||
ARG>COMPLEX DEFINES arg>${TYPE}-complex
|
|
||||||
COMPLEX>ARG DEFINES ${TYPE}-complex>arg
|
|
||||||
<DIRECT-ARRAY> IS <direct-${TYPE}-array>
|
|
||||||
>ARRAY IS >${TYPE}-array
|
|
||||||
|
|
||||||
WHERE
|
|
||||||
|
|
||||||
: <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
|
|
||||||
1 shift <DIRECT-ARRAY> <complex-sequence> ;
|
|
||||||
: >COMPLEX-ARRAY ( sequence -- sequence )
|
|
||||||
<complex-components> >ARRAY ;
|
|
||||||
: COMPLEX>ARG ( complex -- alien )
|
|
||||||
>rect 2array >ARRAY underlying>> ;
|
|
||||||
: ARG>COMPLEX ( alien -- complex )
|
|
||||||
2 <DIRECT-ARRAY> first2 rect> ;
|
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
||||||
|
@ -231,35 +212,21 @@ WHERE
|
||||||
FUNCTOR: (define-complex-blas-vector) ( TYPE C S -- )
|
FUNCTOR: (define-complex-blas-vector) ( TYPE C S -- )
|
||||||
|
|
||||||
VECTOR IS ${TYPE}-blas-vector
|
VECTOR IS ${TYPE}-blas-vector
|
||||||
XDOTU_SUB IS cblas_${C}dotu_sub
|
XDOTU IS ${C}DOTU
|
||||||
XDOTC_SUB IS cblas_${C}dotc_sub
|
XDOTC IS ${C}DOTC
|
||||||
XXNRM2 IS cblas_${S}${C}nrm2
|
XXNRM2 IS ${S}${C}NRM2
|
||||||
XXASUM IS cblas_${S}${C}asum
|
XXASUM IS ${S}${C}ASUM
|
||||||
XAXPY IS cblas_${C}axpy
|
|
||||||
XSCAL IS cblas_${C}scal
|
|
||||||
TYPE>ARG IS ${TYPE}>arg
|
|
||||||
ARG>TYPE IS arg>${TYPE}
|
|
||||||
|
|
||||||
WHERE
|
WHERE
|
||||||
|
|
||||||
M: VECTOR V.
|
M: VECTOR V.
|
||||||
(prepare-dot) TYPE <c-object>
|
(prepare-dot) XDOTU ;
|
||||||
[ XDOTU_SUB ] keep
|
|
||||||
ARG>TYPE ;
|
|
||||||
M: VECTOR V.conj
|
M: VECTOR V.conj
|
||||||
(prepare-dot) TYPE <c-object>
|
(prepare-dot) XDOTC ;
|
||||||
[ XDOTC_SUB ] keep
|
|
||||||
ARG>TYPE ;
|
|
||||||
M: VECTOR Vnorm
|
M: VECTOR Vnorm
|
||||||
(prepare-nrm2) XXNRM2 ;
|
(prepare-nrm2) XXNRM2 ;
|
||||||
M: VECTOR Vasum
|
M: VECTOR Vasum
|
||||||
(prepare-nrm2) XXASUM ;
|
(prepare-nrm2) XXASUM ;
|
||||||
M: VECTOR n*V+V!
|
|
||||||
[ TYPE>ARG ] 2dip
|
|
||||||
(prepare-axpy) [ XAXPY ] dip ;
|
|
||||||
M: VECTOR n*V!
|
|
||||||
[ TYPE>ARG ] dip
|
|
||||||
(prepare-scal) [ XSCAL ] dip ;
|
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
||||||
|
@ -271,10 +238,10 @@ M: VECTOR n*V!
|
||||||
[ drop (define-blas-vector) ]
|
[ drop (define-blas-vector) ]
|
||||||
[ (define-complex-blas-vector) ] 3bi ;
|
[ (define-complex-blas-vector) ] 3bi ;
|
||||||
|
|
||||||
"float" "s" define-real-blas-vector
|
"float" "S" define-real-blas-vector
|
||||||
"double" "d" define-real-blas-vector
|
"double" "D" define-real-blas-vector
|
||||||
"complex-float" "c" "s" define-complex-blas-vector
|
"complex-float" "C" "S" define-complex-blas-vector
|
||||||
"complex-double" "z" "d" define-complex-blas-vector
|
"complex-double" "Z" "D" define-complex-blas-vector
|
||||||
|
|
||||||
>>
|
>>
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue