Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
cb920b6186
|
|
@ -56,6 +56,7 @@ IN: bit-arrays.tests
|
|||
[ -10 ?{ } resize ] must-fail
|
||||
|
||||
[ -1 integer>bit-array ] must-fail
|
||||
[ ?{ } ] [ 0 integer>bit-array ] unit-test
|
||||
[ ?{ f t } ] [ 2 integer>bit-array ] unit-test
|
||||
[ ?{ t t t t t t t t t } ] [ 511 integer>bit-array ] unit-test
|
||||
[ ?{
|
||||
|
|
@ -68,6 +69,7 @@ IN: bit-arrays.tests
|
|||
] unit-test
|
||||
|
||||
[ 14 ] [ ?{ f t t t } bit-array>integer ] unit-test
|
||||
[ 0 ] [ ?{ } bit-array>integer ] unit-test
|
||||
[ HEX: ffffffffffffffffffffffffffffffff ] [ ?{
|
||||
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
|
||||
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
|
||||
|
|
|
|||
|
|
@ -73,12 +73,14 @@ M: bit-array byte-length length 7 + -3 shift ;
|
|||
\ } [ >bit-array ] parse-literal ; parsing
|
||||
|
||||
: integer>bit-array ( int -- bit-array )
|
||||
[ log2 1+ <bit-array> 0 ] keep
|
||||
[ dup zero? not ] [
|
||||
[ -8 shift ] [ 255 bitand ] bi
|
||||
-roll [ [ >r underlying>> r> set-alien-unsigned-1 ] 2keep 1+ ] dip
|
||||
] [ ] while
|
||||
2drop ;
|
||||
dup zero? [ drop 0 <bit-array> ] [
|
||||
[ log2 1+ <bit-array> 0 ] keep
|
||||
[ dup zero? not ] [
|
||||
[ -8 shift ] [ 255 bitand ] bi
|
||||
-roll [ [ set-alien-unsigned-1 ] 2keep 1+ ] dip
|
||||
] [ ] while
|
||||
2drop
|
||||
] if ;
|
||||
|
||||
: bit-array>integer ( bit-array -- int )
|
||||
0 swap underlying>> [ length ] keep [
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.parser models sequences
|
||||
ui ui.gadgets ui.gadgets.frames
|
||||
ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders ui.render
|
||||
;
|
||||
USING: kernel math math.functions math.parser models
|
||||
models.filter models.range models.compose sequences ui
|
||||
ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
|
||||
ui.gadgets.sliders ui.render ;
|
||||
IN: color-picker
|
||||
|
||||
! Simple example demonstrating the use of models.
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@ IN: combinators.short-circuit
|
|||
MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ;
|
||||
MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ;
|
||||
MACRO: 2&& ( quots -- quot ) 2 n&&-rewrite ;
|
||||
MACRO: 3&& ( quots -- quot ) 3 n&&-rewrite ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -29,5 +30,6 @@ MACRO: 2&& ( quots -- quot ) 2 n&&-rewrite ;
|
|||
MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ;
|
||||
MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ;
|
||||
MACRO: 2|| ( quots -- quot ) 2 n||-rewrite ;
|
||||
MACRO: 3|| ( quots -- quot ) 3 n||-rewrite ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences kernel math io calendar calendar.format
|
||||
calendar.model arrays models namespaces ui.gadgets
|
||||
ui.gadgets.labels
|
||||
ui.gadgets.theme ui ;
|
||||
calendar.model arrays models models.filter namespaces ui.gadgets
|
||||
ui.gadgets.labels ui.gadgets.theme ui ;
|
||||
IN: lcd
|
||||
|
||||
: lcd-digit ( row digit -- str )
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -0,0 +1,557 @@
|
|||
USING: alien alien.c-types alien.syntax kernel system combinators ;
|
||||
IN: math.blas.cblas
|
||||
|
||||
<< "cblas" {
|
||||
{ [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] }
|
||||
{ [ os windows? ] [ "blas.dll" "cdecl" add-library ] }
|
||||
[ "libblas.so" "cdecl" add-library ]
|
||||
} cond >>
|
||||
|
||||
LIBRARY: cblas
|
||||
|
||||
TYPEDEF: int CBLAS_ORDER
|
||||
: CblasRowMajor 101 ; inline
|
||||
: CblasColMajor 102 ; inline
|
||||
|
||||
TYPEDEF: int CBLAS_TRANSPOSE
|
||||
: CblasNoTrans 111 ; inline
|
||||
: CblasTrans 112 ; inline
|
||||
: CblasConjTrans 113 ; inline
|
||||
|
||||
TYPEDEF: int CBLAS_UPLO
|
||||
: CblasUpper 121 ; inline
|
||||
: CblasLower 122 ; inline
|
||||
|
||||
TYPEDEF: int CBLAS_DIAG
|
||||
: CblasNonUnit 131 ; inline
|
||||
: CblasUnit 132 ; inline
|
||||
|
||||
TYPEDEF: int CBLAS_SIDE
|
||||
: CblasLeft 141 ; inline
|
||||
: CblasRight 142 ; inline
|
||||
|
||||
TYPEDEF: int CBLAS_INDEX
|
||||
|
||||
C-STRUCT: CBLAS_C
|
||||
{ "float" "real" }
|
||||
{ "float" "imag" } ;
|
||||
C-STRUCT: CBLAS_Z
|
||||
{ "double" "real" }
|
||||
{ "double" "imag" } ;
|
||||
|
||||
! Level 1 BLAS (scalar-vector and vector-vector)
|
||||
|
||||
FUNCTION: float cblas_sdsdot
|
||||
( int N, float alpha, float* X, int incX, float* Y, int incY ) ;
|
||||
FUNCTION: double cblas_dsdot
|
||||
( int N, float* X, int incX, float* Y, int incY ) ;
|
||||
FUNCTION: float cblas_sdot
|
||||
( int N, float* X, int incX, float* Y, int incY ) ;
|
||||
FUNCTION: double cblas_ddot
|
||||
( int N, double* X, int incX, double* Y, int incY ) ;
|
||||
|
||||
FUNCTION: void cblas_cdotu_sub
|
||||
( int N, CBLAS_C* X, int incX, CBLAS_C* Y, int incY, CBLAS_C* dotu ) ;
|
||||
FUNCTION: void cblas_cdotc_sub
|
||||
( int N, CBLAS_C* X, int incX, CBLAS_C* Y, int incY, CBLAS_C* dotc ) ;
|
||||
|
||||
FUNCTION: void cblas_zdotu_sub
|
||||
( int N, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY, CBLAS_Z* dotu ) ;
|
||||
FUNCTION: void cblas_zdotc_sub
|
||||
( int N, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY, CBLAS_Z* dotc ) ;
|
||||
|
||||
FUNCTION: float cblas_snrm2
|
||||
( int N, float* X, int incX ) ;
|
||||
FUNCTION: float cblas_sasum
|
||||
( int N, float* X, int incX ) ;
|
||||
|
||||
FUNCTION: double cblas_dnrm2
|
||||
( int N, double* X, int incX ) ;
|
||||
FUNCTION: double cblas_dasum
|
||||
( int N, double* X, int incX ) ;
|
||||
|
||||
FUNCTION: float cblas_scnrm2
|
||||
( int N, CBLAS_C* X, int incX ) ;
|
||||
FUNCTION: float cblas_scasum
|
||||
( int N, CBLAS_C* X, int incX ) ;
|
||||
|
||||
FUNCTION: double cblas_dznrm2
|
||||
( int N, CBLAS_Z* X, int incX ) ;
|
||||
FUNCTION: double cblas_dzasum
|
||||
( int N, CBLAS_Z* X, int incX ) ;
|
||||
|
||||
FUNCTION: CBLAS_INDEX cblas_isamax
|
||||
( int N, float* X, int incX ) ;
|
||||
FUNCTION: CBLAS_INDEX cblas_idamax
|
||||
( int N, double* X, int incX ) ;
|
||||
FUNCTION: CBLAS_INDEX cblas_icamax
|
||||
( int N, CBLAS_C* X, int incX ) ;
|
||||
FUNCTION: CBLAS_INDEX cblas_izamax
|
||||
( int N, CBLAS_Z* X, int incX ) ;
|
||||
|
||||
FUNCTION: void cblas_sswap
|
||||
( int N, float* X, int incX, float* Y, int incY ) ;
|
||||
FUNCTION: void cblas_scopy
|
||||
( int N, float* X, int incX, float* Y, int incY ) ;
|
||||
FUNCTION: void cblas_saxpy
|
||||
( int N, float alpha, float* X, int incX, float* Y, int incY ) ;
|
||||
|
||||
FUNCTION: void cblas_dswap
|
||||
( int N, double* X, int incX, double* Y, int incY ) ;
|
||||
FUNCTION: void cblas_dcopy
|
||||
( int N, double* X, int incX, double* Y, int incY ) ;
|
||||
FUNCTION: void cblas_daxpy
|
||||
( int N, double alpha, double* X, int incX, double* Y, int incY ) ;
|
||||
|
||||
FUNCTION: void cblas_cswap
|
||||
( int N, CBLAS_C* X, int incX, CBLAS_C* Y, int incY ) ;
|
||||
FUNCTION: void cblas_ccopy
|
||||
( int N, CBLAS_C* X, int incX, CBLAS_C* Y, int incY ) ;
|
||||
FUNCTION: void cblas_caxpy
|
||||
( int N, CBLAS_C* alpha, CBLAS_C* X, int incX, CBLAS_C* Y, int incY ) ;
|
||||
|
||||
FUNCTION: void cblas_zswap
|
||||
( int N, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY ) ;
|
||||
FUNCTION: void cblas_zcopy
|
||||
( int N, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY ) ;
|
||||
FUNCTION: void cblas_zaxpy
|
||||
( int N, CBLAS_Z* alpha, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY ) ;
|
||||
|
||||
FUNCTION: void cblas_sscal
|
||||
( int N, float alpha, float* X, int incX ) ;
|
||||
FUNCTION: void cblas_dscal
|
||||
( int N, double alpha, double* X, int incX ) ;
|
||||
FUNCTION: void cblas_cscal
|
||||
( int N, CBLAS_C* alpha, CBLAS_C* X, int incX ) ;
|
||||
FUNCTION: void cblas_zscal
|
||||
( int N, CBLAS_Z* alpha, CBLAS_Z* X, int incX ) ;
|
||||
FUNCTION: void cblas_csscal
|
||||
( int N, float alpha, CBLAS_C* X, int incX ) ;
|
||||
FUNCTION: void cblas_zdscal
|
||||
( int N, double alpha, CBLAS_Z* X, int incX ) ;
|
||||
|
||||
FUNCTION: void cblas_srotg
|
||||
( float* a, float* b, float* c, float* s ) ;
|
||||
FUNCTION: void cblas_srotmg
|
||||
( float* d1, float* d2, float* b1, float b2, float* P ) ;
|
||||
FUNCTION: void cblas_srot
|
||||
( int N, float* X, int incX, float* Y, int incY, float c, float s ) ;
|
||||
FUNCTION: void cblas_srotm
|
||||
( int N, float* X, int incX, float* Y, int incY, float* P ) ;
|
||||
|
||||
FUNCTION: void cblas_drotg
|
||||
( double* a, double* b, double* c, double* s ) ;
|
||||
FUNCTION: void cblas_drotmg
|
||||
( double* d1, double* d2, double* b1, double b2, double* P ) ;
|
||||
FUNCTION: void cblas_drot
|
||||
( int N, double* X, int incX, double* Y, int incY, double c, double s ) ;
|
||||
FUNCTION: void cblas_drotm
|
||||
( int N, double* X, int incX, double* Y, int incY, double* P ) ;
|
||||
|
||||
! Level 2 BLAS (matrix-vector)
|
||||
|
||||
FUNCTION: void cblas_sgemv ( CBLAS_ORDER Order,
|
||||
CBLAS_TRANSPOSE TransA, int M, int N,
|
||||
float alpha, float* A, int lda,
|
||||
float* X, int incX, float beta,
|
||||
float* Y, int incY ) ;
|
||||
FUNCTION: void cblas_sgbmv ( CBLAS_ORDER Order,
|
||||
CBLAS_TRANSPOSE TransA, int M, int N,
|
||||
int KL, int KU, float alpha,
|
||||
float* A, int lda, float* X,
|
||||
int incX, float beta, float* Y, int incY ) ;
|
||||
FUNCTION: void cblas_strmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, float* A, int lda,
|
||||
float* X, int incX ) ;
|
||||
FUNCTION: void cblas_stbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, int K, float* A, int lda,
|
||||
float* X, int incX ) ;
|
||||
FUNCTION: void cblas_stpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, float* Ap, float* X, int incX ) ;
|
||||
FUNCTION: void cblas_strsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, float* A, int lda, float* X,
|
||||
int incX ) ;
|
||||
FUNCTION: void cblas_stbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, int K, float* A, int lda,
|
||||
float* X, int incX ) ;
|
||||
FUNCTION: void cblas_stpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, float* Ap, float* X, int incX ) ;
|
||||
|
||||
FUNCTION: void cblas_dgemv ( CBLAS_ORDER Order,
|
||||
CBLAS_TRANSPOSE TransA, int M, int N,
|
||||
double alpha, double* A, int lda,
|
||||
double* X, int incX, double beta,
|
||||
double* Y, int incY ) ;
|
||||
FUNCTION: void cblas_dgbmv ( CBLAS_ORDER Order,
|
||||
CBLAS_TRANSPOSE TransA, int M, int N,
|
||||
int KL, int KU, double alpha,
|
||||
double* A, int lda, double* X,
|
||||
int incX, double beta, double* Y, int incY ) ;
|
||||
FUNCTION: void cblas_dtrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, double* A, int lda,
|
||||
double* X, int incX ) ;
|
||||
FUNCTION: void cblas_dtbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, int K, double* A, int lda,
|
||||
double* X, int incX ) ;
|
||||
FUNCTION: void cblas_dtpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, double* Ap, double* X, int incX ) ;
|
||||
FUNCTION: void cblas_dtrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, double* A, int lda, double* X,
|
||||
int incX ) ;
|
||||
FUNCTION: void cblas_dtbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, int K, double* A, int lda,
|
||||
double* X, int incX ) ;
|
||||
FUNCTION: void cblas_dtpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, double* Ap, double* X, int incX ) ;
|
||||
|
||||
FUNCTION: void cblas_cgemv ( CBLAS_ORDER Order,
|
||||
CBLAS_TRANSPOSE TransA, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* X, int incX, void* beta,
|
||||
void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_cgbmv ( CBLAS_ORDER Order,
|
||||
CBLAS_TRANSPOSE TransA, int M, int N,
|
||||
int KL, int KU, void* alpha,
|
||||
void* A, int lda, void* X,
|
||||
int incX, void* beta, void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_ctrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, void* A, int lda,
|
||||
void* X, int incX ) ;
|
||||
FUNCTION: void cblas_ctbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, int K, void* A, int lda,
|
||||
void* X, int incX ) ;
|
||||
FUNCTION: void cblas_ctpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, void* Ap, void* X, int incX ) ;
|
||||
FUNCTION: void cblas_ctrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, void* A, int lda, void* X,
|
||||
int incX ) ;
|
||||
FUNCTION: void cblas_ctbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, int K, void* A, int lda,
|
||||
void* X, int incX ) ;
|
||||
FUNCTION: void cblas_ctpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, void* Ap, void* X, int incX ) ;
|
||||
|
||||
FUNCTION: void cblas_zgemv ( CBLAS_ORDER Order,
|
||||
CBLAS_TRANSPOSE TransA, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* X, int incX, void* beta,
|
||||
void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_zgbmv ( CBLAS_ORDER Order,
|
||||
CBLAS_TRANSPOSE TransA, int M, int N,
|
||||
int KL, int KU, void* alpha,
|
||||
void* A, int lda, void* X,
|
||||
int incX, void* beta, void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_ztrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, void* A, int lda,
|
||||
void* X, int incX ) ;
|
||||
FUNCTION: void cblas_ztbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, int K, void* A, int lda,
|
||||
void* X, int incX ) ;
|
||||
FUNCTION: void cblas_ztpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, void* Ap, void* X, int incX ) ;
|
||||
FUNCTION: void cblas_ztrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, void* A, int lda, void* X,
|
||||
int incX ) ;
|
||||
FUNCTION: void cblas_ztbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, int K, void* A, int lda,
|
||||
void* X, int incX ) ;
|
||||
FUNCTION: void cblas_ztpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
|
||||
int N, void* Ap, void* X, int incX ) ;
|
||||
|
||||
|
||||
FUNCTION: void cblas_ssymv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, float alpha, float* A,
|
||||
int lda, float* X, int incX,
|
||||
float beta, float* Y, int incY ) ;
|
||||
FUNCTION: void cblas_ssbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, int K, float alpha, float* A,
|
||||
int lda, float* X, int incX,
|
||||
float beta, float* Y, int incY ) ;
|
||||
FUNCTION: void cblas_sspmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, float alpha, float* Ap,
|
||||
float* X, int incX,
|
||||
float beta, float* Y, int incY ) ;
|
||||
FUNCTION: void cblas_sger ( CBLAS_ORDER Order, int M, int N,
|
||||
float alpha, float* X, int incX,
|
||||
float* Y, int incY, float* A, int lda ) ;
|
||||
FUNCTION: void cblas_ssyr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, float alpha, float* X,
|
||||
int incX, float* A, int lda ) ;
|
||||
FUNCTION: void cblas_sspr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, float alpha, float* X,
|
||||
int incX, float* Ap ) ;
|
||||
FUNCTION: void cblas_ssyr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, float alpha, float* X,
|
||||
int incX, float* Y, int incY, float* A,
|
||||
int lda ) ;
|
||||
FUNCTION: void cblas_sspr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, float alpha, float* X,
|
||||
int incX, float* Y, int incY, float* A ) ;
|
||||
|
||||
FUNCTION: void cblas_dsymv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, double alpha, double* A,
|
||||
int lda, double* X, int incX,
|
||||
double beta, double* Y, int incY ) ;
|
||||
FUNCTION: void cblas_dsbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, int K, double alpha, double* A,
|
||||
int lda, double* X, int incX,
|
||||
double beta, double* Y, int incY ) ;
|
||||
FUNCTION: void cblas_dspmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, double alpha, double* Ap,
|
||||
double* X, int incX,
|
||||
double beta, double* Y, int incY ) ;
|
||||
FUNCTION: void cblas_dger ( CBLAS_ORDER Order, int M, int N,
|
||||
double alpha, double* X, int incX,
|
||||
double* Y, int incY, double* A, int lda ) ;
|
||||
FUNCTION: void cblas_dsyr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, double alpha, double* X,
|
||||
int incX, double* A, int lda ) ;
|
||||
FUNCTION: void cblas_dspr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, double alpha, double* X,
|
||||
int incX, double* Ap ) ;
|
||||
FUNCTION: void cblas_dsyr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, double alpha, double* X,
|
||||
int incX, double* Y, int incY, double* A,
|
||||
int lda ) ;
|
||||
FUNCTION: void cblas_dspr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, double alpha, double* X,
|
||||
int incX, double* Y, int incY, double* A ) ;
|
||||
|
||||
|
||||
FUNCTION: void cblas_chemv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, void* alpha, void* A,
|
||||
int lda, void* X, int incX,
|
||||
void* beta, void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_chbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, int K, void* alpha, void* A,
|
||||
int lda, void* X, int incX,
|
||||
void* beta, void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_chpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, void* alpha, void* Ap,
|
||||
void* X, int incX,
|
||||
void* beta, void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_cgeru ( CBLAS_ORDER Order, int M, int N,
|
||||
void* alpha, void* X, int incX,
|
||||
void* Y, int incY, void* A, int lda ) ;
|
||||
FUNCTION: void cblas_cgerc ( CBLAS_ORDER Order, int M, int N,
|
||||
void* alpha, void* X, int incX,
|
||||
void* Y, int incY, void* A, int lda ) ;
|
||||
FUNCTION: void cblas_cher ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, float alpha, void* X, int incX,
|
||||
void* A, int lda ) ;
|
||||
FUNCTION: void cblas_chpr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, float alpha, void* X,
|
||||
int incX, void* A ) ;
|
||||
FUNCTION: void cblas_cher2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
|
||||
void* alpha, void* X, int incX,
|
||||
void* Y, int incY, void* A, int lda ) ;
|
||||
FUNCTION: void cblas_chpr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
|
||||
void* alpha, void* X, int incX,
|
||||
void* Y, int incY, void* Ap ) ;
|
||||
|
||||
FUNCTION: void cblas_zhemv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, void* alpha, void* A,
|
||||
int lda, void* X, int incX,
|
||||
void* beta, void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_zhbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, int K, void* alpha, void* A,
|
||||
int lda, void* X, int incX,
|
||||
void* beta, void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_zhpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, void* alpha, void* Ap,
|
||||
void* X, int incX,
|
||||
void* beta, void* Y, int incY ) ;
|
||||
FUNCTION: void cblas_zgeru ( CBLAS_ORDER Order, int M, int N,
|
||||
void* alpha, void* X, int incX,
|
||||
void* Y, int incY, void* A, int lda ) ;
|
||||
FUNCTION: void cblas_zgerc ( CBLAS_ORDER Order, int M, int N,
|
||||
void* alpha, void* X, int incX,
|
||||
void* Y, int incY, void* A, int lda ) ;
|
||||
FUNCTION: void cblas_zher ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, double alpha, void* X, int incX,
|
||||
void* A, int lda ) ;
|
||||
FUNCTION: void cblas_zhpr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
int N, double alpha, void* X,
|
||||
int incX, void* A ) ;
|
||||
FUNCTION: void cblas_zher2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
|
||||
void* alpha, void* X, int incX,
|
||||
void* Y, int incY, void* A, int lda ) ;
|
||||
FUNCTION: void cblas_zhpr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
|
||||
void* alpha, void* X, int incX,
|
||||
void* Y, int incY, void* Ap ) ;
|
||||
|
||||
! Level 3 BLAS (matrix-matrix)
|
||||
|
||||
FUNCTION: void cblas_sgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, int M, int N,
|
||||
int K, float alpha, float* A,
|
||||
int lda, float* B, int ldb,
|
||||
float beta, float* C, int ldc ) ;
|
||||
FUNCTION: void cblas_ssymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, int M, int N,
|
||||
float alpha, float* A, int lda,
|
||||
float* B, int ldb, float beta,
|
||||
float* C, int ldc ) ;
|
||||
FUNCTION: void cblas_ssyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
float alpha, float* A, int lda,
|
||||
float beta, float* C, int ldc ) ;
|
||||
FUNCTION: void cblas_ssyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
float alpha, float* A, int lda,
|
||||
float* B, int ldb, float beta,
|
||||
float* C, int ldc ) ;
|
||||
FUNCTION: void cblas_strmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_DIAG Diag, int M, int N,
|
||||
float alpha, float* A, int lda,
|
||||
float* B, int ldb ) ;
|
||||
FUNCTION: void cblas_strsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_DIAG Diag, int M, int N,
|
||||
float alpha, float* A, int lda,
|
||||
float* B, int ldb ) ;
|
||||
|
||||
FUNCTION: void cblas_dgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, int M, int N,
|
||||
int K, double alpha, double* A,
|
||||
int lda, double* B, int ldb,
|
||||
double beta, double* C, int ldc ) ;
|
||||
FUNCTION: void cblas_dsymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, int M, int N,
|
||||
double alpha, double* A, int lda,
|
||||
double* B, int ldb, double beta,
|
||||
double* C, int ldc ) ;
|
||||
FUNCTION: void cblas_dsyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
double alpha, double* A, int lda,
|
||||
double beta, double* C, int ldc ) ;
|
||||
FUNCTION: void cblas_dsyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
double alpha, double* A, int lda,
|
||||
double* B, int ldb, double beta,
|
||||
double* C, int ldc ) ;
|
||||
FUNCTION: void cblas_dtrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_DIAG Diag, int M, int N,
|
||||
double alpha, double* A, int lda,
|
||||
double* B, int ldb ) ;
|
||||
FUNCTION: void cblas_dtrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_DIAG Diag, int M, int N,
|
||||
double alpha, double* A, int lda,
|
||||
double* B, int ldb ) ;
|
||||
|
||||
FUNCTION: void cblas_cgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, int M, int N,
|
||||
int K, void* alpha, void* A,
|
||||
int lda, void* B, int ldb,
|
||||
void* beta, void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_csymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb, void* beta,
|
||||
void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_csyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
void* alpha, void* A, int lda,
|
||||
void* beta, void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_csyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb, void* beta,
|
||||
void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_ctrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_DIAG Diag, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb ) ;
|
||||
FUNCTION: void cblas_ctrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_DIAG Diag, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb ) ;
|
||||
|
||||
FUNCTION: void cblas_zgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, int M, int N,
|
||||
int K, void* alpha, void* A,
|
||||
int lda, void* B, int ldb,
|
||||
void* beta, void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_zsymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb, void* beta,
|
||||
void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_zsyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
void* alpha, void* A, int lda,
|
||||
void* beta, void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_zsyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb, void* beta,
|
||||
void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_ztrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_DIAG Diag, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb ) ;
|
||||
FUNCTION: void cblas_ztrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_DIAG Diag, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb ) ;
|
||||
|
||||
FUNCTION: void cblas_chemm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb, void* beta,
|
||||
void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_cherk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
float alpha, void* A, int lda,
|
||||
float beta, void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_cher2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb, float beta,
|
||||
void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_zhemm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, int M, int N,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb, void* beta,
|
||||
void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_zherk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
double alpha, void* A, int lda,
|
||||
double beta, void* C, int ldc ) ;
|
||||
FUNCTION: void cblas_zher2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
|
||||
CBLAS_TRANSPOSE Trans, int N, int K,
|
||||
void* alpha, void* A, int lda,
|
||||
void* B, int ldb, double beta,
|
||||
void* C, int ldc ) ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Low-level bindings to the C Basic Linear Algebra Subroutines (BLAS) library
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
math
|
||||
bindings
|
||||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -0,0 +1,235 @@
|
|||
USING: alien byte-arrays help.markup help.syntax math.blas.vectors sequences ;
|
||||
IN: math.blas.matrices
|
||||
|
||||
ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface"
|
||||
"Factor provides an interface to high-performance vector and matrix math routines available in the system's BLAS library. A set of specialized types are provided for handling packed, unboxed vector data:"
|
||||
{ $subsection "math.blas-types" }
|
||||
"Scalar-vector and vector-vector operations are available in the " { $vocab-link "math.blas.vectors" } " vocabulary:"
|
||||
{ $subsection "math.blas.vectors" }
|
||||
"Vector-matrix and matrix-matrix operations are available in the " { $vocab-link "math.blas.matrices" } " vocabulary:"
|
||||
{ $subsection "math.blas.matrices" }
|
||||
"The low-level BLAS C interface can be accessed directly through the " { $vocab-link "math.blas.cblas" } " vocabulary." ;
|
||||
|
||||
ARTICLE: "math.blas-types" "BLAS interface types"
|
||||
"BLAS vectors come in single- and double-precision, real and complex flavors:"
|
||||
{ $subsection float-blas-vector }
|
||||
{ $subsection double-blas-vector }
|
||||
{ $subsection float-complex-blas-vector }
|
||||
{ $subsection double-complex-blas-vector }
|
||||
"These vector types all follow the " { $link sequence } " protocol. In addition, there are corresponding types for matrix data:"
|
||||
{ $subsection float-blas-matrix }
|
||||
{ $subsection double-blas-matrix }
|
||||
{ $subsection float-complex-blas-matrix }
|
||||
{ $subsection double-complex-blas-matrix }
|
||||
"Syntax words are provided for constructing literal vectors and matrices in the " { $vocab-link "math.blas.syntax" } " vocabulary:"
|
||||
{ $subsection "math.blas.syntax" }
|
||||
"There are BOA constructors for all vector and matrix types, which provide the most flexibility in specifying memory layout:"
|
||||
{ $subsection <float-blas-vector> }
|
||||
{ $subsection <double-blas-vector> }
|
||||
{ $subsection <float-complex-blas-vector> }
|
||||
{ $subsection <double-complex-blas-vector> }
|
||||
{ $subsection <float-blas-matrix> }
|
||||
{ $subsection <double-blas-matrix> }
|
||||
{ $subsection <float-complex-blas-matrix> }
|
||||
{ $subsection <double-complex-blas-matrix> }
|
||||
"For the simple case of creating a dense, zero-filled vector or matrix, simple empty object constructors are provided:"
|
||||
{ $subsection <empty-vector> }
|
||||
{ $subsection <empty-matrix> } ;
|
||||
|
||||
ARTICLE: "math.blas.matrices" "BLAS interface matrix operations"
|
||||
"Transposing and slicing matrices:"
|
||||
{ $subsection Mtranspose }
|
||||
{ $subsection Mrows }
|
||||
{ $subsection Mcols }
|
||||
{ $subsection Msub }
|
||||
"Matrix-vector products:"
|
||||
{ $subsection n*M.V+n*V-in-place }
|
||||
{ $subsection n*M.V+n*V }
|
||||
{ $subsection n*M.V }
|
||||
{ $subsection M.V }
|
||||
"Vector outer products:"
|
||||
{ $subsection n*V(*)V+M-in-place }
|
||||
{ $subsection n*V(*)Vconj+M-in-place }
|
||||
{ $subsection n*V(*)V+M }
|
||||
{ $subsection n*V(*)Vconj+M }
|
||||
{ $subsection n*V(*)V }
|
||||
{ $subsection n*V(*)Vconj }
|
||||
{ $subsection V(*) }
|
||||
{ $subsection V(*)conj }
|
||||
"Matrix products:"
|
||||
{ $subsection n*M.M+n*M-in-place }
|
||||
{ $subsection n*M.M+n*M }
|
||||
{ $subsection n*M.M }
|
||||
{ $subsection M. }
|
||||
"Scalar-matrix products:"
|
||||
{ $subsection n*M-in-place }
|
||||
{ $subsection n*M }
|
||||
{ $subsection M*n }
|
||||
{ $subsection M/n } ;
|
||||
|
||||
ABOUT: "math.blas.matrices"
|
||||
|
||||
HELP: blas-matrix-base
|
||||
{ $class-description "The base class for all BLAS matrix types. Objects of this type should not be created directly; instead, instantiate one of the typed subclasses:"
|
||||
{ $list
|
||||
{ { $link float-blas-matrix } }
|
||||
{ { $link double-blas-matrix } }
|
||||
{ { $link float-complex-blas-matrix } }
|
||||
{ { $link double-complex-blas-matrix } }
|
||||
}
|
||||
"All of these subclasses share the same tuple layout:"
|
||||
{ $list
|
||||
{ { $snippet "data" } " contains an alien pointer referencing or byte-array containing a packed, column-major array of float, double, float complex, or double complex values;" }
|
||||
{ { $snippet "ld" } " indicates the distance, in elements, between matrix columns;" }
|
||||
{ { $snippet "rows" } " and " { $snippet "cols" } " indicate the number of significant rows and columns in the matrix;" }
|
||||
{ "and " { $snippet "transpose" } ", if set to a true value, indicates that the matrix should be treated as transposed relative to its in-memory representation." }
|
||||
} } ;
|
||||
|
||||
{ blas-vector-base blas-matrix-base } related-words
|
||||
|
||||
HELP: float-blas-matrix
|
||||
{ $class-description "A matrix of single-precision floating-point values. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
|
||||
HELP: double-blas-matrix
|
||||
{ $class-description "A matrix of double-precision floating-point values. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
|
||||
HELP: float-complex-blas-matrix
|
||||
{ $class-description "A matrix of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
|
||||
HELP: double-complex-blas-matrix
|
||||
{ $class-description "A matrix of double-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
|
||||
|
||||
{
|
||||
float-blas-matrix double-blas-matrix float-complex-blas-matrix double-complex-blas-matrix
|
||||
float-blas-vector double-blas-vector float-complex-blas-vector double-complex-blas-vector
|
||||
} related-words
|
||||
|
||||
HELP: Mwidth
|
||||
{ $values { "matrix" "a BLAS matrix inherited from " { $link blas-matrix-base } } { "width" "The number of columns" } }
|
||||
{ $description "Returns the number of columns in " { $snippet "matrix" } "." } ;
|
||||
|
||||
HELP: Mheight
|
||||
{ $values { "matrix" "a BLAS matrix inherited from " { $link blas-matrix-base } } { "width" "The number of columns" } }
|
||||
{ $description "Returns the number of rows in " { $snippet "matrix" } "." } ;
|
||||
|
||||
{ Mwidth Mheight } related-words
|
||||
|
||||
HELP: n*M.V+n*V-in-place
|
||||
{ $values { "alpha" "a number" } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "x" "an N-element BLAS vector inherited from " { $link blas-vector-base } } { "beta" "a number" } { "y" "an M-element BLAS vector inherited from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } ", and overwrite the current contents of " { $snippet "y" } " with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." }
|
||||
{ $side-effects "y" } ;
|
||||
|
||||
HELP: n*V(*)V+M-in-place
|
||||
{ $values { "alpha" "a number" } { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGER and xGERU routines in BLAS." }
|
||||
{ $side-effects "A" } ;
|
||||
|
||||
HELP: n*V(*)Vconj+M-in-place
|
||||
{ $values { "alpha" "a number" } { "x" "an M-element complex BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element complex BLAS vector inherited from " { $link blas-vector-base } } { "A" "an M-row, N-column complex BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGERC routines in BLAS." }
|
||||
{ $side-effects "A" } ;
|
||||
|
||||
HELP: n*M.M+n*M-in-place
|
||||
{ $values { "alpha" "a number" } { "A" "an M-row, K-column BLAS matrix inherited from " { $link blas-matrix-base } } { "B" "a K-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "beta" "a number" } { "C" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." } ;
|
||||
|
||||
HELP: <empty-matrix>
|
||||
{ $values { "rows" "the number of rows the new matrix will have" } { "cols" "the number of columns the new matrix will have" } { "exemplar" "A BLAS vector inherited from " { $link blas-vector-base } " or BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Create a matrix of all zeros with the given dimensions and the same element type as " { $snippet "exemplar" } "." } ;
|
||||
|
||||
{ <zero-vector> <empty-vector> <empty-matrix> } related-words
|
||||
|
||||
HELP: n*M.V+n*V
|
||||
{ $values { "alpha" "a number" } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "x" "an N-element BLAS vector inherited from " { $link blas-vector-base } } { "beta" "a number" } { "y" "an M-element BLAS vector inherited from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". The returned vector will have the same length as " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." } ;
|
||||
|
||||
HELP: n*V(*)V+M
|
||||
{ $values { "alpha" "a number" } { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
|
||||
|
||||
HELP: n*V(*)Vconj+M
|
||||
{ $values { "alpha" "a number" } { "x" "an M-element complex BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element complex BLAS vector inherited from " { $link blas-vector-base } } { "A" "an M-row, N-column complex BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGERC routines in BLAS." } ;
|
||||
|
||||
HELP: n*M.M+n*M
|
||||
{ $values { "alpha" "a number" } { "A" "an M-row, K-column BLAS matrix inherited from " { $link blas-matrix-base } } { "B" "a K-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "beta" "a number" } { "C" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." } ;
|
||||
|
||||
HELP: n*M.V
|
||||
{ $values { "alpha" "a number" } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "x" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the matrix-vector product " { $snippet "αAx" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ;
|
||||
|
||||
HELP: M.V
|
||||
{ $values { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "x" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the matrix-vector product " { $snippet "Ax" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ;
|
||||
|
||||
{ n*M.V+n*V-in-place n*M.V+n*V n*M.V M.V } related-words
|
||||
|
||||
HELP: n*V(*)V
|
||||
{ $values { "alpha" "a number" } { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the outer product " { $snippet "αx⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
|
||||
|
||||
HELP: n*V(*)Vconj
|
||||
{ $values { "alpha" "a number" } { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the outer product " { $snippet "αx⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ;
|
||||
|
||||
HELP: V(*)
|
||||
{ $values { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the outer product " { $snippet "x⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
|
||||
|
||||
HELP: V(*)conj
|
||||
{ $values { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the conjugate outer product " { $snippet "x⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ;
|
||||
|
||||
{ n*V(*)V+M-in-place n*V(*)Vconj+M-in-place n*V(*)V+M n*V(*)Vconj+M n*V(*)V n*V(*)Vconj V(*) V(*)conj V. V.conj } related-words
|
||||
|
||||
HELP: n*M.M
|
||||
{ $values { "alpha" "a number" } { "A" "an M-row, K-column BLAS matrix inherited from " { $link blas-matrix-base } } { "B" "a K-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the matrix product " { $snippet "αAB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ;
|
||||
|
||||
HELP: M.
|
||||
{ $values { "A" "an M-row, K-column BLAS matrix inherited from " { $link blas-matrix-base } } { "B" "a K-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the matrix product " { $snippet "AB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ;
|
||||
|
||||
{ n*M.M+n*M-in-place n*M.M+n*M n*M.M M. } related-words
|
||||
|
||||
HELP: Msub
|
||||
{ $values { "matrix" "A BLAS matrix inheriting from " { $link blas-matrix-base } } { "row" "The topmost row of the slice" } { "col" "The leftmost column of the slice" } { "height" "The height of the slice" } { "width" "The width of the slice" } }
|
||||
{ $description "Select a rectangular submatrix of " { $snippet "matrix" } " with the given dimensions. The returned submatrix will share the parent matrix's storage." } ;
|
||||
|
||||
HELP: Mrows
|
||||
{ $values { "matrix" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
|
||||
{ $description "Return a sequence of BLAS vectors representing the rows of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ;
|
||||
|
||||
HELP: Mcols
|
||||
{ $values { "matrix" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
|
||||
{ $description "Return a sequence of BLAS vectors representing the columns of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ;
|
||||
|
||||
HELP: n*M-in-place
|
||||
{ $values { "n" "a number" } { "A" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and overwrite the current contents of A with the result." }
|
||||
{ $side-effects "A" } ;
|
||||
|
||||
HELP: n*M
|
||||
{ $values { "n" "a number" } { "A" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
|
||||
{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
|
||||
|
||||
HELP: M*n
|
||||
{ $values { "A" "A BLAS matrix inheriting from " { $link blas-matrix-base } } { "n" "a number" } }
|
||||
{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
|
||||
|
||||
HELP: M/n
|
||||
{ $values { "A" "A BLAS matrix inheriting from " { $link blas-matrix-base } } { "n" "a number" } }
|
||||
{ $description "Calculate the scalar-matrix product " { $snippet "(1/n)A" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
|
||||
|
||||
{ n*M-in-place n*M M*n M/n } related-words
|
||||
|
||||
HELP: Mtranspose
|
||||
{ $values { "matrix" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
|
||||
{ $description "Returns the transpose of " { $snippet "matrix" } ". The returned matrix shares storage with the original matrix." } ;
|
||||
|
||||
HELP: element-type
|
||||
{ $values { "v" "a BLAS vector inheriting from " { $link blas-vector-base } ", or a BLAS matrix inheriting from " { $link blas-matrix-base } } }
|
||||
{ $description "Return the C type of the elements in the given BLAS vector or matrix." } ;
|
||||
|
||||
HELP: <empty-vector>
|
||||
{ $values { "length" "The length of the new vector" } { "exemplar" "a BLAS vector inheriting from " { $link blas-vector-base } ", or a BLAS matrix inheriting from " { $link blas-matrix-base } } }
|
||||
{ $description "Return a vector of zeros with the given length and the same element type as " { $snippet "v" } "." } ;
|
||||
|
||||
|
|
@ -0,0 +1,710 @@
|
|||
USING: kernel math.blas.matrices math.blas.vectors math.blas.syntax
|
||||
sequences tools.test ;
|
||||
IN: math.blas.matrices.tests
|
||||
|
||||
! clone
|
||||
|
||||
[ smatrix{
|
||||
{ 1.0 2.0 3.0 }
|
||||
{ 4.0 5.0 6.0 }
|
||||
{ 7.0 8.0 9.0 }
|
||||
} ] [
|
||||
smatrix{
|
||||
{ 1.0 2.0 3.0 }
|
||||
{ 4.0 5.0 6.0 }
|
||||
{ 7.0 8.0 9.0 }
|
||||
} clone
|
||||
] unit-test
|
||||
[ f ] [
|
||||
smatrix{
|
||||
{ 1.0 2.0 3.0 }
|
||||
{ 4.0 5.0 6.0 }
|
||||
{ 7.0 8.0 9.0 }
|
||||
} dup clone eq?
|
||||
] unit-test
|
||||
|
||||
[ dmatrix{
|
||||
{ 1.0 2.0 3.0 }
|
||||
{ 4.0 5.0 6.0 }
|
||||
{ 7.0 8.0 9.0 }
|
||||
} ] [
|
||||
dmatrix{
|
||||
{ 1.0 2.0 3.0 }
|
||||
{ 4.0 5.0 6.0 }
|
||||
{ 7.0 8.0 9.0 }
|
||||
} clone
|
||||
] unit-test
|
||||
[ f ] [
|
||||
dmatrix{
|
||||
{ 1.0 2.0 3.0 }
|
||||
{ 4.0 5.0 6.0 }
|
||||
{ 7.0 8.0 9.0 }
|
||||
} dup clone eq?
|
||||
] unit-test
|
||||
|
||||
[ cmatrix{
|
||||
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||
} ] [
|
||||
cmatrix{
|
||||
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||
} clone
|
||||
] unit-test
|
||||
[ f ] [
|
||||
cmatrix{
|
||||
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||
} dup clone eq?
|
||||
] unit-test
|
||||
|
||||
[ zmatrix{
|
||||
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||
} ] [
|
||||
zmatrix{
|
||||
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||
} clone
|
||||
] unit-test
|
||||
[ f ] [
|
||||
zmatrix{
|
||||
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||
} dup clone eq?
|
||||
] unit-test
|
||||
|
||||
! M.V
|
||||
|
||||
[ svector{ 3.0 1.0 6.0 } ] [
|
||||
smatrix{
|
||||
{ 0.0 1.0 0.0 1.0 }
|
||||
{ -1.0 0.0 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
}
|
||||
svector{ 1.0 2.0 3.0 1.0 }
|
||||
M.V
|
||||
] unit-test
|
||||
[ svector{ -2.0 1.0 3.0 14.0 } ] [
|
||||
smatrix{
|
||||
{ 0.0 1.0 0.0 1.0 }
|
||||
{ -1.0 0.0 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
} Mtranspose
|
||||
svector{ 1.0 2.0 3.0 }
|
||||
M.V
|
||||
] unit-test
|
||||
|
||||
[ dvector{ 3.0 1.0 6.0 } ] [
|
||||
dmatrix{
|
||||
{ 0.0 1.0 0.0 1.0 }
|
||||
{ -1.0 0.0 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
}
|
||||
dvector{ 1.0 2.0 3.0 1.0 }
|
||||
M.V
|
||||
] unit-test
|
||||
[ dvector{ -2.0 1.0 3.0 14.0 } ] [
|
||||
dmatrix{
|
||||
{ 0.0 1.0 0.0 1.0 }
|
||||
{ -1.0 0.0 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
} Mtranspose
|
||||
dvector{ 1.0 2.0 3.0 }
|
||||
M.V
|
||||
] unit-test
|
||||
|
||||
[ cvector{ 3.0 C{ 1.0 2.0 } 6.0 } ] [
|
||||
cmatrix{
|
||||
{ 0.0 1.0 0.0 1.0 }
|
||||
{ -1.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
}
|
||||
cvector{ 1.0 2.0 3.0 1.0 }
|
||||
M.V
|
||||
] unit-test
|
||||
[ cvector{ -2.0 C{ 1.0 2.0 } 3.0 14.0 } ] [
|
||||
cmatrix{
|
||||
{ 0.0 1.0 0.0 1.0 }
|
||||
{ -1.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
} Mtranspose
|
||||
cvector{ 1.0 2.0 3.0 }
|
||||
M.V
|
||||
] unit-test
|
||||
|
||||
[ zvector{ 3.0 C{ 1.0 2.0 } 6.0 } ] [
|
||||
zmatrix{
|
||||
{ 0.0 1.0 0.0 1.0 }
|
||||
{ -1.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
}
|
||||
zvector{ 1.0 2.0 3.0 1.0 }
|
||||
M.V
|
||||
] unit-test
|
||||
[ zvector{ -2.0 C{ 1.0 2.0 } 3.0 14.0 } ] [
|
||||
zmatrix{
|
||||
{ 0.0 1.0 0.0 1.0 }
|
||||
{ -1.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
} Mtranspose
|
||||
zvector{ 1.0 2.0 3.0 }
|
||||
M.V
|
||||
] unit-test
|
||||
|
||||
! V(*)
|
||||
|
||||
[ smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 4.0 6.0 8.0 }
|
||||
{ 3.0 6.0 9.0 12.0 }
|
||||
} ] [
|
||||
svector{ 1.0 2.0 3.0 } svector{ 1.0 2.0 3.0 4.0 } V(*)
|
||||
] unit-test
|
||||
|
||||
[ dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 4.0 6.0 8.0 }
|
||||
{ 3.0 6.0 9.0 12.0 }
|
||||
} ] [
|
||||
dvector{ 1.0 2.0 3.0 } dvector{ 1.0 2.0 3.0 4.0 } V(*)
|
||||
] unit-test
|
||||
|
||||
[ cmatrix{
|
||||
{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 }
|
||||
{ 2.0 4.0 C{ 6.0 -6.0 } 8.0 }
|
||||
{ C{ 3.0 3.0 } C{ 6.0 6.0 } 18.0 C{ 12.0 12.0 } }
|
||||
} ] [
|
||||
cvector{ 1.0 2.0 C{ 3.0 3.0 } } cvector{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 } V(*)
|
||||
] unit-test
|
||||
|
||||
[ zmatrix{
|
||||
{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 }
|
||||
{ 2.0 4.0 C{ 6.0 -6.0 } 8.0 }
|
||||
{ C{ 3.0 3.0 } C{ 6.0 6.0 } 18.0 C{ 12.0 12.0 } }
|
||||
} ] [
|
||||
zvector{ 1.0 2.0 C{ 3.0 3.0 } } zvector{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 } V(*)
|
||||
] unit-test
|
||||
|
||||
! M.
|
||||
|
||||
[ smatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 0.0 -3.0 0.0 0.0 }
|
||||
{ 0.0 4.0 0.0 0.0 10.0 }
|
||||
{ 0.0 0.0 0.0 0.0 0.0 }
|
||||
} ] [
|
||||
smatrix{
|
||||
{ 1.0 0.0 0.0 }
|
||||
{ 0.0 0.0 -1.0 }
|
||||
{ 0.0 2.0 0.0 }
|
||||
{ 0.0 0.0 0.0 }
|
||||
} smatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 2.0 0.0 0.0 5.0 }
|
||||
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||
} M.
|
||||
] unit-test
|
||||
|
||||
[ smatrix{
|
||||
{ 1.0 0.0 0.0 0.0 }
|
||||
{ 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 -3.0 0.0 0.0 }
|
||||
{ 4.0 0.0 0.0 0.0 }
|
||||
{ 0.0 0.0 10.0 0.0 }
|
||||
} ] [
|
||||
smatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 2.0 0.0 0.0 5.0 }
|
||||
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||
} Mtranspose smatrix{
|
||||
{ 1.0 0.0 0.0 }
|
||||
{ 0.0 0.0 -1.0 }
|
||||
{ 0.0 2.0 0.0 }
|
||||
{ 0.0 0.0 0.0 }
|
||||
} Mtranspose M.
|
||||
] unit-test
|
||||
|
||||
[ dmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 0.0 -3.0 0.0 0.0 }
|
||||
{ 0.0 4.0 0.0 0.0 10.0 }
|
||||
{ 0.0 0.0 0.0 0.0 0.0 }
|
||||
} ] [
|
||||
dmatrix{
|
||||
{ 1.0 0.0 0.0 }
|
||||
{ 0.0 0.0 -1.0 }
|
||||
{ 0.0 2.0 0.0 }
|
||||
{ 0.0 0.0 0.0 }
|
||||
} dmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 2.0 0.0 0.0 5.0 }
|
||||
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||
} M.
|
||||
] unit-test
|
||||
|
||||
[ dmatrix{
|
||||
{ 1.0 0.0 0.0 0.0 }
|
||||
{ 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 -3.0 0.0 0.0 }
|
||||
{ 4.0 0.0 0.0 0.0 }
|
||||
{ 0.0 0.0 10.0 0.0 }
|
||||
} ] [
|
||||
dmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 2.0 0.0 0.0 5.0 }
|
||||
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||
} Mtranspose dmatrix{
|
||||
{ 1.0 0.0 0.0 }
|
||||
{ 0.0 0.0 -1.0 }
|
||||
{ 0.0 2.0 0.0 }
|
||||
{ 0.0 0.0 0.0 }
|
||||
} Mtranspose M.
|
||||
] unit-test
|
||||
|
||||
[ cmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 0.0 -3.0 0.0 0.0 }
|
||||
{ 0.0 C{ 4.0 -4.0 } 0.0 0.0 10.0 }
|
||||
{ 0.0 0.0 0.0 0.0 0.0 }
|
||||
} ] [
|
||||
cmatrix{
|
||||
{ 1.0 0.0 0.0 }
|
||||
{ 0.0 0.0 -1.0 }
|
||||
{ 0.0 2.0 0.0 }
|
||||
{ 0.0 0.0 0.0 }
|
||||
} cmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 }
|
||||
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||
} M.
|
||||
] unit-test
|
||||
|
||||
[ cmatrix{
|
||||
{ 1.0 0.0 0.0 0.0 }
|
||||
{ 0.0 0.0 C{ 4.0 -4.0 } 0.0 }
|
||||
{ 0.0 -3.0 0.0 0.0 }
|
||||
{ 4.0 0.0 0.0 0.0 }
|
||||
{ 0.0 0.0 10.0 0.0 }
|
||||
} ] [
|
||||
cmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 }
|
||||
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||
} Mtranspose cmatrix{
|
||||
{ 1.0 0.0 0.0 }
|
||||
{ 0.0 0.0 -1.0 }
|
||||
{ 0.0 2.0 0.0 }
|
||||
{ 0.0 0.0 0.0 }
|
||||
} Mtranspose M.
|
||||
] unit-test
|
||||
|
||||
[ zmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 0.0 -3.0 0.0 0.0 }
|
||||
{ 0.0 C{ 4.0 -4.0 } 0.0 0.0 10.0 }
|
||||
{ 0.0 0.0 0.0 0.0 0.0 }
|
||||
} ] [
|
||||
zmatrix{
|
||||
{ 1.0 0.0 0.0 }
|
||||
{ 0.0 0.0 -1.0 }
|
||||
{ 0.0 2.0 0.0 }
|
||||
{ 0.0 0.0 0.0 }
|
||||
} zmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 }
|
||||
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||
} M.
|
||||
] unit-test
|
||||
|
||||
[ zmatrix{
|
||||
{ 1.0 0.0 0.0 0.0 }
|
||||
{ 0.0 0.0 C{ 4.0 -4.0 } 0.0 }
|
||||
{ 0.0 -3.0 0.0 0.0 }
|
||||
{ 4.0 0.0 0.0 0.0 }
|
||||
{ 0.0 0.0 10.0 0.0 }
|
||||
} ] [
|
||||
zmatrix{
|
||||
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||
{ 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 }
|
||||
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||
} Mtranspose zmatrix{
|
||||
{ 1.0 0.0 0.0 }
|
||||
{ 0.0 0.0 -1.0 }
|
||||
{ 0.0 2.0 0.0 }
|
||||
{ 0.0 0.0 0.0 }
|
||||
} Mtranspose M.
|
||||
] unit-test
|
||||
|
||||
! n*M
|
||||
|
||||
[ smatrix{
|
||||
{ 2.0 0.0 }
|
||||
{ 0.0 2.0 }
|
||||
} ] [
|
||||
2.0 smatrix{
|
||||
{ 1.0 0.0 }
|
||||
{ 0.0 1.0 }
|
||||
} n*M
|
||||
] unit-test
|
||||
|
||||
[ dmatrix{
|
||||
{ 2.0 0.0 }
|
||||
{ 0.0 2.0 }
|
||||
} ] [
|
||||
2.0 dmatrix{
|
||||
{ 1.0 0.0 }
|
||||
{ 0.0 1.0 }
|
||||
} n*M
|
||||
] unit-test
|
||||
|
||||
[ cmatrix{
|
||||
{ C{ 2.0 1.0 } 0.0 }
|
||||
{ 0.0 C{ -1.0 2.0 } }
|
||||
} ] [
|
||||
C{ 2.0 1.0 } cmatrix{
|
||||
{ 1.0 0.0 }
|
||||
{ 0.0 C{ 0.0 1.0 } }
|
||||
} n*M
|
||||
] unit-test
|
||||
|
||||
[ zmatrix{
|
||||
{ C{ 2.0 1.0 } 0.0 }
|
||||
{ 0.0 C{ -1.0 2.0 } }
|
||||
} ] [
|
||||
C{ 2.0 1.0 } zmatrix{
|
||||
{ 1.0 0.0 }
|
||||
{ 0.0 C{ 0.0 1.0 } }
|
||||
} n*M
|
||||
] unit-test
|
||||
|
||||
! Mrows, Mcols
|
||||
|
||||
[ svector{ 3.0 3.0 3.0 } ] [
|
||||
2 smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mcols nth
|
||||
] unit-test
|
||||
[ svector{ 3.0 2.0 3.0 4.0 } ] [
|
||||
2 smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mrows nth
|
||||
] unit-test
|
||||
[ 3 ] [
|
||||
smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mrows length
|
||||
] unit-test
|
||||
[ 4 ] [
|
||||
smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mcols length
|
||||
] unit-test
|
||||
[ svector{ 3.0 3.0 3.0 } ] [
|
||||
2 smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mtranspose Mrows nth
|
||||
] unit-test
|
||||
[ svector{ 3.0 2.0 3.0 4.0 } ] [
|
||||
2 smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mtranspose Mcols nth
|
||||
] unit-test
|
||||
[ 3 ] [
|
||||
smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mtranspose Mcols length
|
||||
] unit-test
|
||||
[ 4 ] [
|
||||
smatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mtranspose Mrows length
|
||||
] unit-test
|
||||
|
||||
[ dvector{ 3.0 3.0 3.0 } ] [
|
||||
2 dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mcols nth
|
||||
] unit-test
|
||||
[ dvector{ 3.0 2.0 3.0 4.0 } ] [
|
||||
2 dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mrows nth
|
||||
] unit-test
|
||||
[ 3 ] [
|
||||
dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mrows length
|
||||
] unit-test
|
||||
[ 4 ] [
|
||||
dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mcols length
|
||||
] unit-test
|
||||
[ dvector{ 3.0 3.0 3.0 } ] [
|
||||
2 dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mtranspose Mrows nth
|
||||
] unit-test
|
||||
[ dvector{ 3.0 2.0 3.0 4.0 } ] [
|
||||
2 dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mtranspose Mcols nth
|
||||
] unit-test
|
||||
[ 3 ] [
|
||||
dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mtranspose Mcols length
|
||||
] unit-test
|
||||
[ 4 ] [
|
||||
dmatrix{
|
||||
{ 1.0 2.0 3.0 4.0 }
|
||||
{ 2.0 2.0 3.0 4.0 }
|
||||
{ 3.0 2.0 3.0 4.0 }
|
||||
} Mtranspose Mrows length
|
||||
] unit-test
|
||||
|
||||
[ cvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [
|
||||
2 cmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mcols nth
|
||||
] unit-test
|
||||
[ cvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [
|
||||
2 cmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mrows nth
|
||||
] unit-test
|
||||
[ 3 ] [
|
||||
cmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mrows length
|
||||
] unit-test
|
||||
[ 4 ] [
|
||||
cmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mcols length
|
||||
] unit-test
|
||||
[ cvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [
|
||||
2 cmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mtranspose Mrows nth
|
||||
] unit-test
|
||||
[ cvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [
|
||||
2 cmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mtranspose Mcols nth
|
||||
] unit-test
|
||||
[ 3 ] [
|
||||
cmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mtranspose Mcols length
|
||||
] unit-test
|
||||
[ 4 ] [
|
||||
cmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mtranspose Mrows length
|
||||
] unit-test
|
||||
|
||||
[ zvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [
|
||||
2 zmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mcols nth
|
||||
] unit-test
|
||||
[ zvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [
|
||||
2 zmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mrows nth
|
||||
] unit-test
|
||||
[ 3 ] [
|
||||
zmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mrows length
|
||||
] unit-test
|
||||
[ 4 ] [
|
||||
zmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mcols length
|
||||
] unit-test
|
||||
[ zvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [
|
||||
2 zmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mtranspose Mrows nth
|
||||
] unit-test
|
||||
[ zvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [
|
||||
2 zmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mtranspose Mcols nth
|
||||
] unit-test
|
||||
[ 3 ] [
|
||||
zmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mtranspose Mcols length
|
||||
] unit-test
|
||||
[ 4 ] [
|
||||
zmatrix{
|
||||
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||
} Mtranspose Mrows length
|
||||
] unit-test
|
||||
|
||||
! Msub
|
||||
|
||||
[ smatrix{
|
||||
{ 3.0 2.0 1.0 }
|
||||
{ 0.0 1.0 0.0 }
|
||||
} ] [
|
||||
smatrix{
|
||||
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||
{ 1.0 0.0 3.0 2.0 1.0 }
|
||||
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||
} 1 2 2 3 Msub
|
||||
] unit-test
|
||||
|
||||
[ smatrix{
|
||||
{ 3.0 0.0 }
|
||||
{ 2.0 1.0 }
|
||||
{ 1.0 0.0 }
|
||||
} ] [
|
||||
smatrix{
|
||||
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||
{ 1.0 0.0 3.0 2.0 1.0 }
|
||||
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||
} Mtranspose 2 1 3 2 Msub
|
||||
] unit-test
|
||||
|
||||
[ dmatrix{
|
||||
{ 3.0 2.0 1.0 }
|
||||
{ 0.0 1.0 0.0 }
|
||||
} ] [
|
||||
dmatrix{
|
||||
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||
{ 1.0 0.0 3.0 2.0 1.0 }
|
||||
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||
} 1 2 2 3 Msub
|
||||
] unit-test
|
||||
|
||||
[ dmatrix{
|
||||
{ 3.0 0.0 }
|
||||
{ 2.0 1.0 }
|
||||
{ 1.0 0.0 }
|
||||
} ] [
|
||||
dmatrix{
|
||||
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||
{ 1.0 0.0 3.0 2.0 1.0 }
|
||||
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||
} Mtranspose 2 1 3 2 Msub
|
||||
] unit-test
|
||||
|
||||
[ cmatrix{
|
||||
{ C{ 3.0 3.0 } 2.0 1.0 }
|
||||
{ 0.0 1.0 0.0 }
|
||||
} ] [
|
||||
cmatrix{
|
||||
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||
{ 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 }
|
||||
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||
} 1 2 2 3 Msub
|
||||
] unit-test
|
||||
|
||||
[ cmatrix{
|
||||
{ C{ 3.0 3.0 } 0.0 }
|
||||
{ 2.0 1.0 }
|
||||
{ 1.0 0.0 }
|
||||
} ] [
|
||||
cmatrix{
|
||||
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||
{ 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 }
|
||||
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||
} Mtranspose 2 1 3 2 Msub
|
||||
] unit-test
|
||||
|
||||
[ zmatrix{
|
||||
{ C{ 3.0 3.0 } 2.0 1.0 }
|
||||
{ 0.0 1.0 0.0 }
|
||||
} ] [
|
||||
zmatrix{
|
||||
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||
{ 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 }
|
||||
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||
} 1 2 2 3 Msub
|
||||
] unit-test
|
||||
|
||||
[ zmatrix{
|
||||
{ C{ 3.0 3.0 } 0.0 }
|
||||
{ 2.0 1.0 }
|
||||
{ 1.0 0.0 }
|
||||
} ] [
|
||||
zmatrix{
|
||||
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||
{ 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 }
|
||||
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||
} Mtranspose 2 1 3 2 Msub
|
||||
] unit-test
|
||||
|
||||
|
|
@ -0,0 +1,305 @@
|
|||
USING: accessors alien alien.c-types arrays byte-arrays combinators
|
||||
combinators.lib combinators.short-circuit fry kernel locals macros
|
||||
math math.blas.cblas math.blas.vectors math.blas.vectors.private
|
||||
math.complex math.functions math.order multi-methods qualified
|
||||
sequences sequences.merged sequences.private shuffle symbols ;
|
||||
QUALIFIED: syntax
|
||||
IN: math.blas.matrices
|
||||
|
||||
TUPLE: blas-matrix-base data ld rows cols transpose ;
|
||||
TUPLE: float-blas-matrix < blas-matrix-base ;
|
||||
TUPLE: double-blas-matrix < blas-matrix-base ;
|
||||
TUPLE: float-complex-blas-matrix < blas-matrix-base ;
|
||||
TUPLE: double-complex-blas-matrix < blas-matrix-base ;
|
||||
|
||||
C: <float-blas-matrix> float-blas-matrix
|
||||
C: <double-blas-matrix> double-blas-matrix
|
||||
C: <float-complex-blas-matrix> float-complex-blas-matrix
|
||||
C: <double-complex-blas-matrix> double-complex-blas-matrix
|
||||
|
||||
METHOD: element-type { float-blas-matrix }
|
||||
drop "float" ;
|
||||
METHOD: element-type { double-blas-matrix }
|
||||
drop "double" ;
|
||||
METHOD: element-type { float-complex-blas-matrix }
|
||||
drop "CBLAS_C" ;
|
||||
METHOD: element-type { double-complex-blas-matrix }
|
||||
drop "CBLAS_Z" ;
|
||||
|
||||
: Mtransposed? ( matrix -- ? )
|
||||
transpose>> ; inline
|
||||
: Mwidth ( matrix -- width )
|
||||
dup Mtransposed? [ rows>> ] [ cols>> ] if ; inline
|
||||
: Mheight ( matrix -- height )
|
||||
dup Mtransposed? [ cols>> ] [ rows>> ] if ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (blas-transpose) ( matrix -- integer )
|
||||
transpose>> [ CblasTrans ] [ CblasNoTrans ] if ;
|
||||
|
||||
GENERIC: (blas-matrix-like) ( data ld rows cols transpose exemplar -- matrix )
|
||||
|
||||
METHOD: (blas-matrix-like) { object object object object object float-blas-matrix }
|
||||
drop <float-blas-matrix> ;
|
||||
METHOD: (blas-matrix-like) { object object object object object double-blas-matrix }
|
||||
drop <double-blas-matrix> ;
|
||||
METHOD: (blas-matrix-like) { object object object object object float-complex-blas-matrix }
|
||||
drop <float-complex-blas-matrix> ;
|
||||
METHOD: (blas-matrix-like) { object object object object object double-complex-blas-matrix }
|
||||
drop <double-complex-blas-matrix> ;
|
||||
|
||||
METHOD: (blas-matrix-like) { object object object object object float-blas-vector }
|
||||
drop <float-blas-matrix> ;
|
||||
METHOD: (blas-matrix-like) { object object object object object double-blas-vector }
|
||||
drop <double-blas-matrix> ;
|
||||
METHOD: (blas-matrix-like) { object object object object object float-complex-blas-vector }
|
||||
drop <float-complex-blas-matrix> ;
|
||||
METHOD: (blas-matrix-like) { object object object object object double-complex-blas-vector }
|
||||
drop <double-complex-blas-matrix> ;
|
||||
|
||||
METHOD: (blas-vector-like) { object object object float-blas-matrix }
|
||||
drop <float-blas-vector> ;
|
||||
METHOD: (blas-vector-like) { object object object double-blas-matrix }
|
||||
drop <double-blas-vector> ;
|
||||
METHOD: (blas-vector-like) { object object object float-complex-blas-matrix }
|
||||
drop <float-complex-blas-vector> ;
|
||||
METHOD: (blas-vector-like) { object object object double-complex-blas-matrix }
|
||||
drop <double-complex-blas-vector> ;
|
||||
|
||||
: (validate-gemv) ( A x y -- )
|
||||
{
|
||||
[ drop [ Mwidth ] [ length>> ] bi* = ]
|
||||
[ nip [ Mheight ] [ length>> ] bi* = ]
|
||||
} 3&&
|
||||
[ "Mismatched matrix and vectors in matrix-vector multiplication" throw ] unless ;
|
||||
|
||||
:: (prepare-gemv) ( alpha A x beta y >c-arg -- order A-trans m n alpha A-data A-ld x-data x-inc beta y-data y-inc y )
|
||||
A x y (validate-gemv)
|
||||
CblasColMajor
|
||||
A (blas-transpose)
|
||||
A rows>>
|
||||
A cols>>
|
||||
alpha >c-arg call
|
||||
A data>>
|
||||
A ld>>
|
||||
x data>>
|
||||
x inc>>
|
||||
beta >c-arg call
|
||||
y data>>
|
||||
y inc>>
|
||||
y ; inline
|
||||
|
||||
: (validate-ger) ( x y A -- )
|
||||
{
|
||||
[ nip [ length>> ] [ Mheight ] bi* = ]
|
||||
[ nipd [ length>> ] [ Mwidth ] bi* = ]
|
||||
} 3&&
|
||||
[ "Mismatched vertices and matrix in vector outer product" throw ] unless ;
|
||||
|
||||
:: (prepare-ger) ( alpha x y A >c-arg -- order m n alpha x-data x-inc y-data y-inc A-data A-ld A )
|
||||
x y A (validate-ger)
|
||||
CblasColMajor
|
||||
A rows>>
|
||||
A cols>>
|
||||
alpha >c-arg call
|
||||
x data>>
|
||||
x inc>>
|
||||
y data>>
|
||||
y inc>>
|
||||
A data>>
|
||||
A ld>>
|
||||
A f >>transpose ; inline
|
||||
|
||||
: (validate-gemm) ( A B C -- )
|
||||
{
|
||||
[ drop [ Mwidth ] [ Mheight ] bi* = ]
|
||||
[ nip [ Mheight ] bi@ = ]
|
||||
[ nipd [ Mwidth ] bi@ = ]
|
||||
} 3&& [ "Mismatched matrices in matrix multiplication" throw ] unless ;
|
||||
|
||||
:: (prepare-gemm) ( alpha A B beta C >c-arg -- order A-trans B-trans m n k alpha A-data A-ld B-data B-ld beta C-data C-ld C )
|
||||
A B C (validate-gemm)
|
||||
CblasColMajor
|
||||
A (blas-transpose)
|
||||
B (blas-transpose)
|
||||
C rows>>
|
||||
C cols>>
|
||||
A Mwidth
|
||||
alpha >c-arg call
|
||||
A data>>
|
||||
A ld>>
|
||||
B data>>
|
||||
B ld>>
|
||||
beta >c-arg call
|
||||
C data>>
|
||||
C ld>>
|
||||
C f >>transpose ; inline
|
||||
|
||||
: (>matrix) ( arrays >c-array -- c-array ld rows cols transpose )
|
||||
'[ <merged> @ ] [ length dup ] [ first length ] tri f ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: >float-blas-matrix ( arrays -- matrix )
|
||||
[ >c-float-array ] (>matrix) <float-blas-matrix> ;
|
||||
: >double-blas-matrix ( arrays -- matrix )
|
||||
[ >c-double-array ] (>matrix) <double-blas-matrix> ;
|
||||
: >float-complex-blas-matrix ( arrays -- matrix )
|
||||
[ (flatten-complex-sequence) >c-float-array ] (>matrix)
|
||||
<float-complex-blas-matrix> ;
|
||||
: >double-complex-blas-matrix ( arrays -- matrix )
|
||||
[ (flatten-complex-sequence) >c-double-array ] (>matrix)
|
||||
<double-complex-blas-matrix> ;
|
||||
|
||||
GENERIC: n*M.V+n*V-in-place ( alpha A x beta y -- y=alpha*A.x+b*y )
|
||||
GENERIC: n*V(*)V+M-in-place ( alpha x y A -- A=alpha*x(*)y+A )
|
||||
GENERIC: n*V(*)Vconj+M-in-place ( alpha x y A -- A=alpha*x(*)yconj+A )
|
||||
GENERIC: n*M.M+n*M-in-place ( alpha A B beta C -- C=alpha*A.B+beta*C )
|
||||
|
||||
METHOD: n*M.V+n*V-in-place { real float-blas-matrix float-blas-vector real float-blas-vector }
|
||||
[ ] (prepare-gemv) [ cblas_sgemv ] dip ;
|
||||
METHOD: n*M.V+n*V-in-place { real double-blas-matrix double-blas-vector real double-blas-vector }
|
||||
[ ] (prepare-gemv) [ cblas_dgemv ] dip ;
|
||||
METHOD: n*M.V+n*V-in-place { number float-complex-blas-matrix float-complex-blas-vector number float-complex-blas-vector }
|
||||
[ (>c-complex) ] (prepare-gemv) [ cblas_cgemv ] dip ;
|
||||
METHOD: n*M.V+n*V-in-place { number double-complex-blas-matrix double-complex-blas-vector number double-complex-blas-vector }
|
||||
[ (>z-complex) ] (prepare-gemv) [ cblas_zgemv ] dip ;
|
||||
|
||||
METHOD: n*V(*)V+M-in-place { real float-blas-vector float-blas-vector float-blas-matrix }
|
||||
[ ] (prepare-ger) [ cblas_sger ] dip ;
|
||||
METHOD: n*V(*)V+M-in-place { real double-blas-vector double-blas-vector double-blas-matrix }
|
||||
[ ] (prepare-ger) [ cblas_dger ] dip ;
|
||||
METHOD: n*V(*)V+M-in-place { number float-complex-blas-vector float-complex-blas-vector float-complex-blas-matrix }
|
||||
[ (>c-complex) ] (prepare-ger) [ cblas_cgeru ] dip ;
|
||||
METHOD: n*V(*)V+M-in-place { number double-complex-blas-vector double-complex-blas-vector double-complex-blas-matrix }
|
||||
[ (>z-complex) ] (prepare-ger) [ cblas_zgeru ] dip ;
|
||||
|
||||
METHOD: n*V(*)Vconj+M-in-place { number float-complex-blas-vector float-complex-blas-vector float-complex-blas-matrix }
|
||||
[ (>c-complex) ] (prepare-ger) [ cblas_cgerc ] dip ;
|
||||
METHOD: n*V(*)Vconj+M-in-place { number double-complex-blas-vector double-complex-blas-vector double-complex-blas-matrix }
|
||||
[ (>z-complex) ] (prepare-ger) [ cblas_zgerc ] dip ;
|
||||
|
||||
METHOD: n*M.M+n*M-in-place { real float-blas-matrix float-blas-matrix real float-blas-matrix }
|
||||
[ ] (prepare-gemm) [ cblas_sgemm ] dip ;
|
||||
METHOD: n*M.M+n*M-in-place { real double-blas-matrix double-blas-matrix real double-blas-matrix }
|
||||
[ ] (prepare-gemm) [ cblas_dgemm ] dip ;
|
||||
METHOD: n*M.M+n*M-in-place { number float-complex-blas-matrix float-complex-blas-matrix number float-complex-blas-matrix }
|
||||
[ (>c-complex) ] (prepare-gemm) [ cblas_cgemm ] dip ;
|
||||
METHOD: n*M.M+n*M-in-place { number double-complex-blas-matrix double-complex-blas-matrix number double-complex-blas-matrix }
|
||||
[ (>z-complex) ] (prepare-gemm) [ cblas_zgemm ] dip ;
|
||||
|
||||
! XXX should do a dense clone
|
||||
syntax:M: blas-matrix-base clone
|
||||
[
|
||||
[
|
||||
{ data>> ld>> cols>> element-type } get-slots
|
||||
heap-size * * memory>byte-array
|
||||
] [ { ld>> rows>> cols>> transpose>> } get-slots ] bi
|
||||
] keep (blas-matrix-like) ;
|
||||
|
||||
! XXX try rounding stride to next 128 bit bound for better vectorizin'
|
||||
: <empty-matrix> ( rows cols exemplar -- matrix )
|
||||
[ element-type [ * ] dip <c-array> ]
|
||||
[ 2drop ]
|
||||
[ f swap (blas-matrix-like) ] 3tri ;
|
||||
|
||||
: n*M.V+n*V ( alpha A x beta y -- alpha*A.x+b*y )
|
||||
clone n*M.V+n*V-in-place ;
|
||||
: n*V(*)V+M ( alpha x y A -- alpha*x(*)y+A )
|
||||
clone n*V(*)V+M-in-place ;
|
||||
: n*V(*)Vconj+M ( alpha x y A -- alpha*x(*)yconj+A )
|
||||
clone n*V(*)Vconj+M-in-place ;
|
||||
: n*M.M+n*M ( alpha A B beta C -- alpha*A.B+beta*C )
|
||||
clone n*M.M+n*M-in-place ;
|
||||
|
||||
: n*M.V ( alpha A x -- alpha*A.x )
|
||||
1.0 2over [ Mheight ] dip <empty-vector>
|
||||
n*M.V+n*V-in-place ; inline
|
||||
|
||||
: M.V ( A x -- A.x )
|
||||
1.0 -rot n*M.V ; inline
|
||||
|
||||
: n*V(*)V ( n x y -- n*x(*)y )
|
||||
2dup [ length>> ] bi@ pick <empty-matrix>
|
||||
n*V(*)V+M-in-place ;
|
||||
: n*V(*)Vconj ( n x y -- n*x(*)yconj )
|
||||
2dup [ length>> ] bi@ pick <empty-matrix>
|
||||
n*V(*)Vconj+M-in-place ;
|
||||
|
||||
: V(*) ( x y -- x(*)y )
|
||||
1.0 -rot n*V(*)V ; inline
|
||||
: V(*)conj ( x y -- x(*)yconj )
|
||||
1.0 -rot n*V(*)Vconj ; inline
|
||||
|
||||
: n*M.M ( n A B -- n*A.B )
|
||||
2dup [ Mheight ] [ Mwidth ] bi* pick <empty-matrix>
|
||||
1.0 swap n*M.M+n*M-in-place ;
|
||||
|
||||
: M. ( A B -- A.B )
|
||||
1.0 -rot n*M.M ; inline
|
||||
|
||||
:: (Msub) ( matrix row col height width -- data ld rows cols )
|
||||
matrix ld>> col * row + matrix element-type heap-size *
|
||||
matrix data>> <displaced-alien>
|
||||
matrix ld>>
|
||||
height
|
||||
width ;
|
||||
|
||||
: Msub ( matrix row col height width -- submatrix )
|
||||
5 npick dup transpose>>
|
||||
[ nip [ [ swap ] 2dip swap ] when (Msub) ] 2keep
|
||||
swap (blas-matrix-like) ;
|
||||
|
||||
TUPLE: blas-matrix-rowcol-sequence parent inc rowcol-length rowcol-jump length ;
|
||||
C: <blas-matrix-rowcol-sequence> blas-matrix-rowcol-sequence
|
||||
|
||||
INSTANCE: blas-matrix-rowcol-sequence sequence
|
||||
|
||||
syntax:M: blas-matrix-rowcol-sequence length
|
||||
length>> ;
|
||||
syntax:M: blas-matrix-rowcol-sequence nth-unsafe
|
||||
{
|
||||
[
|
||||
[ rowcol-jump>> ]
|
||||
[ parent>> element-type heap-size ]
|
||||
[ parent>> data>> ] tri
|
||||
[ * * ] dip <displaced-alien>
|
||||
]
|
||||
[ rowcol-length>> ]
|
||||
[ inc>> ]
|
||||
[ parent>> ]
|
||||
} cleave (blas-vector-like) ;
|
||||
|
||||
: (Mcols) ( A -- columns )
|
||||
{ [ ] [ drop 1 ] [ rows>> ] [ ld>> ] [ cols>> ] } cleave
|
||||
<blas-matrix-rowcol-sequence> ;
|
||||
: (Mrows) ( A -- rows )
|
||||
{ [ ] [ ld>> ] [ cols>> ] [ drop 1 ] [ rows>> ] } cleave
|
||||
<blas-matrix-rowcol-sequence> ;
|
||||
|
||||
: Mrows ( A -- rows )
|
||||
dup transpose>> [ (Mcols) ] [ (Mrows) ] if ;
|
||||
: Mcols ( A -- rows )
|
||||
dup transpose>> [ (Mrows) ] [ (Mcols) ] if ;
|
||||
|
||||
: n*M-in-place ( n A -- A=n*A )
|
||||
[ (Mcols) [ n*V-in-place drop ] with each ] keep ;
|
||||
|
||||
: n*M ( n A -- n*A )
|
||||
clone n*M-in-place ; inline
|
||||
|
||||
: M*n ( A n -- A*n )
|
||||
swap n*M ; inline
|
||||
: M/n ( A n -- A/n )
|
||||
recip swap n*M ; inline
|
||||
|
||||
: Mtranspose ( matrix -- matrix^T )
|
||||
[ { data>> ld>> rows>> cols>> transpose>> } get-slots not ] keep (blas-matrix-like) ;
|
||||
|
||||
syntax:M: blas-matrix-base equal?
|
||||
{
|
||||
[ [ Mwidth ] bi@ = ]
|
||||
[ [ Mcols ] bi@ [ = ] 2all? ]
|
||||
} 2&& ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
BLAS level 2 and 3 matrix-vector and matrix-matrix operations
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
math
|
||||
bindings
|
||||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -0,0 +1 @@
|
|||
Literal syntax for BLAS vectors and matrices
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
USING: help.markup help.syntax math.blas.matrices math.blas.vectors multiline ;
|
||||
IN: math.blas.syntax
|
||||
|
||||
ARTICLE: "math.blas.syntax" "BLAS interface literal syntax"
|
||||
"Vectors:"
|
||||
{ $subsection POSTPONE: svector{ }
|
||||
{ $subsection POSTPONE: dvector{ }
|
||||
{ $subsection POSTPONE: cvector{ }
|
||||
{ $subsection POSTPONE: zvector{ }
|
||||
"Matrices:"
|
||||
{ $subsection POSTPONE: smatrix{ }
|
||||
{ $subsection POSTPONE: dmatrix{ }
|
||||
{ $subsection POSTPONE: cmatrix{ }
|
||||
{ $subsection POSTPONE: zmatrix{ } ;
|
||||
|
||||
ABOUT: "math.blas.syntax"
|
||||
|
||||
HELP: svector{
|
||||
{ $syntax "svector{ 1.0 -2.0 3.0 }" }
|
||||
{ $description "Construct a literal " { $link float-blas-vector } "." } ;
|
||||
|
||||
HELP: dvector{
|
||||
{ $syntax "dvector{ 1.0 -2.0 3.0 }" }
|
||||
{ $description "Construct a literal " { $link double-blas-vector } "." } ;
|
||||
|
||||
HELP: cvector{
|
||||
{ $syntax "cvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
|
||||
{ $description "Construct a literal " { $link float-complex-blas-vector } "." } ;
|
||||
|
||||
HELP: zvector{
|
||||
{ $syntax "dvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
|
||||
{ $description "Construct a literal " { $link double-complex-blas-vector } "." } ;
|
||||
|
||||
{
|
||||
POSTPONE: svector{ POSTPONE: dvector{
|
||||
POSTPONE: cvector{ POSTPONE: zvector{
|
||||
} related-words
|
||||
|
||||
HELP: smatrix{
|
||||
{ $syntax <" smatrix{
|
||||
{ 1.0 0.0 0.0 1.0 }
|
||||
{ 0.0 1.0 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
{ 0.0 0.0 0.0 1.0 }
|
||||
} "> }
|
||||
{ $description "Construct a literal " { $link float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
||||
|
||||
HELP: dmatrix{
|
||||
{ $syntax <" dmatrix{
|
||||
{ 1.0 0.0 0.0 1.0 }
|
||||
{ 0.0 1.0 0.0 2.0 }
|
||||
{ 0.0 0.0 1.0 3.0 }
|
||||
{ 0.0 0.0 0.0 1.0 }
|
||||
} "> }
|
||||
{ $description "Construct a literal " { $link double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
||||
|
||||
HELP: cmatrix{
|
||||
{ $syntax <" cmatrix{
|
||||
{ 1.0 0.0 0.0 1.0 }
|
||||
{ 0.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||
{ 0.0 0.0 -1.0 3.0 }
|
||||
{ 0.0 0.0 0.0 C{ 0.0 -1.0 } }
|
||||
} "> }
|
||||
{ $description "Construct a literal " { $link float-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
||||
|
||||
HELP: zmatrix{
|
||||
{ $syntax <" zmatrix{
|
||||
{ 1.0 0.0 0.0 1.0 }
|
||||
{ 0.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||
{ 0.0 0.0 -1.0 3.0 }
|
||||
{ 0.0 0.0 0.0 C{ 0.0 -1.0 } }
|
||||
} "> }
|
||||
{ $description "Construct a literal " { $link double-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
|
||||
|
||||
{
|
||||
POSTPONE: smatrix{ POSTPONE: dmatrix{
|
||||
POSTPONE: cmatrix{ POSTPONE: zmatrix{
|
||||
} related-words
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
USING: kernel math.blas.matrices math.blas.vectors parser ;
|
||||
IN: math.blas.syntax
|
||||
|
||||
: svector{ ( accum -- accum )
|
||||
\ } [ >float-blas-vector ] parse-literal ; parsing
|
||||
: dvector{ ( accum -- accum )
|
||||
\ } [ >double-blas-vector ] parse-literal ; parsing
|
||||
: cvector{ ( accum -- accum )
|
||||
\ } [ >float-complex-blas-vector ] parse-literal ; parsing
|
||||
: zvector{ ( accum -- accum )
|
||||
\ } [ >double-complex-blas-vector ] parse-literal ; parsing
|
||||
|
||||
: smatrix{ ( accum -- accum )
|
||||
\ } [ >float-blas-matrix ] parse-literal ; parsing
|
||||
: dmatrix{ ( accum -- accum )
|
||||
\ } [ >double-blas-matrix ] parse-literal ; parsing
|
||||
: cmatrix{ ( accum -- accum )
|
||||
\ } [ >float-complex-blas-matrix ] parse-literal ; parsing
|
||||
: zmatrix{ ( accum -- accum )
|
||||
\ } [ >double-complex-blas-matrix ] parse-literal ; parsing
|
||||
|
|
@ -0,0 +1 @@
|
|||
math
|
||||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -0,0 +1 @@
|
|||
BLAS level 1 vector operations
|
||||
|
|
@ -0,0 +1 @@
|
|||
math
|
||||
|
|
@ -0,0 +1,131 @@
|
|||
USING: alien byte-arrays help.markup help.syntax sequences ;
|
||||
IN: math.blas.vectors
|
||||
|
||||
ARTICLE: "math.blas.vectors" "BLAS interface vector operations"
|
||||
"Slicing vectors:"
|
||||
{ $subsection Vsub }
|
||||
"Taking the norm (magnitude) of a vector:"
|
||||
{ $subsection Vnorm }
|
||||
"Summing and taking the maximum of elements:"
|
||||
{ $subsection Vasum }
|
||||
{ $subsection Viamax }
|
||||
{ $subsection Vamax }
|
||||
"Scalar-vector products:"
|
||||
{ $subsection n*V-in-place }
|
||||
{ $subsection n*V }
|
||||
{ $subsection V*n }
|
||||
{ $subsection V/n }
|
||||
{ $subsection Vneg }
|
||||
"Vector addition:"
|
||||
{ $subsection n*V+V-in-place }
|
||||
{ $subsection n*V+V }
|
||||
{ $subsection V+ }
|
||||
{ $subsection V- }
|
||||
"Vector inner products:"
|
||||
{ $subsection V. }
|
||||
{ $subsection V.conj } ;
|
||||
|
||||
ABOUT: "math.blas.vectors"
|
||||
|
||||
HELP: blas-vector-base
|
||||
{ $class-description "The base class for all BLAS vector types. Objects of this type should not be created directly; instead, instantiate one of the typed subclasses:"
|
||||
{ $list
|
||||
{ { $link float-blas-vector } }
|
||||
{ { $link double-blas-vector } }
|
||||
{ { $link float-complex-blas-vector } }
|
||||
{ { $link double-complex-blas-vector } }
|
||||
}
|
||||
"All of these subclasses share the same tuple layout:"
|
||||
{ $list
|
||||
{ { $snippet "data" } " contains an alien pointer referencing or byte-array containing a packed array of float, double, float complex, or double complex values;" }
|
||||
{ { $snippet "length" } " indicates the length of the vector;" }
|
||||
{ "and " { $snippet "inc" } " indicates the distance, in elements, between elements." }
|
||||
} } ;
|
||||
|
||||
HELP: float-blas-vector
|
||||
{ $class-description "A vector of single-precision floating-point values. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
|
||||
HELP: double-blas-vector
|
||||
{ $class-description "A vector of double-precision floating-point values. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
|
||||
HELP: float-complex-blas-vector
|
||||
{ $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
|
||||
HELP: double-complex-blas-vector
|
||||
{ $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
|
||||
|
||||
HELP: n*V+V-in-place
|
||||
{ $values { "alpha" "a number" } { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the vector sum " { $snippet "αx + y" } " and replace the existing contents of y with the result. Corresponds to the xAXPY routines in BLAS." }
|
||||
{ $side-effects "y" } ;
|
||||
|
||||
HELP: n*V-in-place
|
||||
{ $values { "alpha" "a number" } { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and replace the existing contents of x with the result. Corresponds to the xSCAL routines in BLAS." }
|
||||
{ $side-effects "x" } ;
|
||||
|
||||
HELP: V.
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the inner product " { $snippet "x⋅y" } ". Corresponds to the xDOT and xDOTU routines in BLAS." } ;
|
||||
|
||||
HELP: V.conj
|
||||
{ $values { "x" "a complex BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a complex BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the conjugate inner product " { $snippet "x̅⋅y" } ". Corresponds to the xDOTC routines in BLAS." } ;
|
||||
|
||||
HELP: Vnorm
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the norm-2, i.e., the magnitude or absolute value, of " { $snippet "x" } " (" { $snippet "‖x‖₂" } "). Corresponds to the xNRM2 routines in BLAS." } ;
|
||||
|
||||
HELP: Vasum
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the sum of the norm-1s of the elements of " { $snippet "x" } " (" { $snippet "Σ ‖xᵢ‖₁" } "). Corresponds to the xASUM routines in BLAS." } ;
|
||||
|
||||
HELP: Vswap
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Swap the contents of " { $snippet "x" } " and " { $snippet "y" } " in place. Corresponds to the xSWAP routines in BLAS." }
|
||||
{ $side-effects "x" "y" } ;
|
||||
|
||||
HELP: Viamax
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Return the index of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the smallest index. Corresponds to the IxAMAX routines in BLAS." } ;
|
||||
|
||||
HELP: Vamax
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Return the value of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the first element. Corresponds to the IxAMAX routines in BLAS." } ;
|
||||
|
||||
{ Viamax Vamax } related-words
|
||||
|
||||
HELP: <zero-vector>
|
||||
{ $values { "exemplar" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Return a vector of zeros with the same length and element type as " { $snippet "v" } ". The vector is constructed with an " { $snippet "inc" } " of zero, so it is not suitable for receiving results from BLAS functions; it is intended to be used as a term in other vector calculations. To construct an empty vector that can be used to receive results, see " { $link <empty-vector> } "." } ;
|
||||
|
||||
HELP: n*V+V
|
||||
{ $values { "alpha" "a number" } { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the vector sum " { $snippet "αx + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
|
||||
|
||||
HELP: n*V
|
||||
{ $values { "alpha" "a number" } { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
|
||||
|
||||
HELP: V+
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the vector sum " { $snippet "x + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
|
||||
|
||||
HELP: V-
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Calculate the vector difference " { $snippet "x – y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
|
||||
|
||||
HELP: Vneg
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
|
||||
{ $description "Negate the elements of " { $snippet "x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result." } ;
|
||||
|
||||
HELP: V*n
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "alpha" "a number" } }
|
||||
{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
|
||||
|
||||
HELP: V/n
|
||||
{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "alpha" "a number" } }
|
||||
{ $description "Calculate the scalar-vector product " { $snippet "(1/α)x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
|
||||
|
||||
{ n*V+V-in-place n*V-in-place n*V+V n*V V+ V- Vneg V*n V/n } related-words
|
||||
|
||||
HELP: Vsub
|
||||
{ $values { "v" "a BLAS vector inheriting from " { $link blas-vector-base } } { "start" "The index of the first element of the slice" } { "length" "The length of the slice" } }
|
||||
{ $description "Slice a subvector out of " { $snippet "v" } " with the given length. The subvector will share storage with the parent vector." } ;
|
||||
|
|
@ -0,0 +1,180 @@
|
|||
USING: kernel math.blas.vectors math.blas.syntax sequences tools.test ;
|
||||
IN: math.blas.vectors.tests
|
||||
|
||||
! clone
|
||||
|
||||
[ svector{ 1.0 2.0 3.0 } ] [ svector{ 1.0 2.0 3.0 } clone ] unit-test
|
||||
[ f ] [ svector{ 1.0 2.0 3.0 } dup clone eq? ] unit-test
|
||||
[ dvector{ 1.0 2.0 3.0 } ] [ dvector{ 1.0 2.0 3.0 } clone ] unit-test
|
||||
[ f ] [ dvector{ 1.0 2.0 3.0 } dup clone eq? ] unit-test
|
||||
[ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } ] [ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } clone ] unit-test
|
||||
[ f ] [ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } dup clone eq? ] unit-test
|
||||
[ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } ] [ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } clone ] unit-test
|
||||
[ f ] [ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } dup clone eq? ] unit-test
|
||||
|
||||
! nth
|
||||
|
||||
[ 1.0 ] [ 2 svector{ 3.0 2.0 1.0 } nth ] unit-test
|
||||
[ 1.0 ] [ 2 dvector{ 3.0 2.0 1.0 } nth ] unit-test
|
||||
|
||||
[ C{ 1.0 2.0 } ]
|
||||
[ 2 cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } nth ] unit-test
|
||||
|
||||
[ C{ 1.0 2.0 } ]
|
||||
[ 2 zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } nth ] unit-test
|
||||
|
||||
! set-nth
|
||||
|
||||
[ svector{ 3.0 2.0 0.0 } ] [ 0.0 2 svector{ 3.0 2.0 1.0 } [ set-nth ] keep ] unit-test
|
||||
[ dvector{ 3.0 2.0 0.0 } ] [ 0.0 2 dvector{ 3.0 2.0 1.0 } [ set-nth ] keep ] unit-test
|
||||
|
||||
[ cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 3.0 4.0 } } ] [
|
||||
C{ 3.0 4.0 } 2
|
||||
cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } }
|
||||
[ set-nth ] keep
|
||||
] unit-test
|
||||
[ zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 3.0 4.0 } } ] [
|
||||
C{ 3.0 4.0 } 2
|
||||
zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } }
|
||||
[ set-nth ] keep
|
||||
] unit-test
|
||||
|
||||
! V+
|
||||
|
||||
[ svector{ 11.0 22.0 } ] [ svector{ 1.0 2.0 } svector{ 10.0 20.0 } V+ ] unit-test
|
||||
[ dvector{ 11.0 22.0 } ] [ dvector{ 1.0 2.0 } dvector{ 10.0 20.0 } V+ ] unit-test
|
||||
|
||||
[ cvector{ 11.0 C{ 22.0 33.0 } } ]
|
||||
[ cvector{ 1.0 C{ 2.0 3.0 } } cvector{ 10.0 C{ 20.0 30.0 } } V+ ]
|
||||
unit-test
|
||||
|
||||
[ zvector{ 11.0 C{ 22.0 33.0 } } ]
|
||||
[ zvector{ 1.0 C{ 2.0 3.0 } } zvector{ 10.0 C{ 20.0 30.0 } } V+ ]
|
||||
unit-test
|
||||
|
||||
! V-
|
||||
|
||||
[ svector{ 9.0 18.0 } ] [ svector{ 10.0 20.0 } svector{ 1.0 2.0 } V- ] unit-test
|
||||
[ dvector{ 9.0 18.0 } ] [ dvector{ 10.0 20.0 } dvector{ 1.0 2.0 } V- ] unit-test
|
||||
|
||||
[ cvector{ 9.0 C{ 18.0 27.0 } } ]
|
||||
[ cvector{ 10.0 C{ 20.0 30.0 } } cvector{ 1.0 C{ 2.0 3.0 } } V- ]
|
||||
unit-test
|
||||
|
||||
[ zvector{ 9.0 C{ 18.0 27.0 } } ]
|
||||
[ zvector{ 10.0 C{ 20.0 30.0 } } zvector{ 1.0 C{ 2.0 3.0 } } V- ]
|
||||
unit-test
|
||||
|
||||
! Vneg
|
||||
|
||||
[ svector{ 1.0 -2.0 } ] [ svector{ -1.0 2.0 } Vneg ] unit-test
|
||||
[ dvector{ 1.0 -2.0 } ] [ dvector{ -1.0 2.0 } Vneg ] unit-test
|
||||
|
||||
[ cvector{ 1.0 C{ -2.0 3.0 } } ] [ cvector{ -1.0 C{ 2.0 -3.0 } } Vneg ] unit-test
|
||||
[ zvector{ 1.0 C{ -2.0 3.0 } } ] [ zvector{ -1.0 C{ 2.0 -3.0 } } Vneg ] unit-test
|
||||
|
||||
! n*V
|
||||
|
||||
[ svector{ 100.0 200.0 } ] [ 10.0 svector{ 10.0 20.0 } n*V ] unit-test
|
||||
[ dvector{ 100.0 200.0 } ] [ 10.0 dvector{ 10.0 20.0 } n*V ] unit-test
|
||||
|
||||
[ cvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } ]
|
||||
[ C{ 10.0 2.0 } cvector{ 2.0 C{ 1.0 1.0 } } n*V ]
|
||||
unit-test
|
||||
|
||||
[ zvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } ]
|
||||
[ C{ 10.0 2.0 } zvector{ 2.0 C{ 1.0 1.0 } } n*V ]
|
||||
unit-test
|
||||
|
||||
! V*n
|
||||
|
||||
[ svector{ 100.0 200.0 } ] [ svector{ 10.0 20.0 } 10.0 V*n ] unit-test
|
||||
[ dvector{ 100.0 200.0 } ] [ dvector{ 10.0 20.0 } 10.0 V*n ] unit-test
|
||||
|
||||
[ cvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } ]
|
||||
[ cvector{ 2.0 C{ 1.0 1.0 } } C{ 10.0 2.0 } V*n ]
|
||||
unit-test
|
||||
|
||||
[ zvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } ]
|
||||
[ zvector{ 2.0 C{ 1.0 1.0 } } C{ 10.0 2.0 } V*n ]
|
||||
unit-test
|
||||
|
||||
! V/n
|
||||
|
||||
[ svector{ 1.0 2.0 } ] [ svector{ 4.0 8.0 } 4.0 V/n ] unit-test
|
||||
[ dvector{ 1.0 2.0 } ] [ dvector{ 4.0 8.0 } 4.0 V/n ] unit-test
|
||||
|
||||
[ cvector{ 2.0 1.0 } ]
|
||||
[ cvector{ C{ 16.0 4.0 } C{ 8.0 2.0 } } C{ 8.0 2.0 } V/n ]
|
||||
unit-test
|
||||
|
||||
[ cvector{ 2.0 1.0 } ]
|
||||
[ cvector{ C{ 16.0 4.0 } C{ 8.0 2.0 } } C{ 8.0 2.0 } V/n ]
|
||||
unit-test
|
||||
|
||||
! V.
|
||||
|
||||
[ 7.0 ] [ svector{ 1.0 2.5 } svector{ 2.0 2.0 } V. ] unit-test
|
||||
[ 7.0 ] [ dvector{ 1.0 2.5 } dvector{ 2.0 2.0 } V. ] unit-test
|
||||
[ C{ 7.0 7.0 } ] [ cvector{ C{ 1.0 1.0 } 2.5 } cvector{ 2.0 C{ 2.0 2.0 } } V. ] unit-test
|
||||
[ C{ 7.0 7.0 } ] [ zvector{ C{ 1.0 1.0 } 2.5 } zvector{ 2.0 C{ 2.0 2.0 } } V. ] unit-test
|
||||
|
||||
! V.conj
|
||||
|
||||
[ C{ 7.0 3.0 } ] [ cvector{ C{ 1.0 1.0 } 2.5 } cvector{ 2.0 C{ 2.0 2.0 } } V.conj ] unit-test
|
||||
[ C{ 7.0 3.0 } ] [ zvector{ C{ 1.0 1.0 } 2.5 } zvector{ 2.0 C{ 2.0 2.0 } } V.conj ] unit-test
|
||||
|
||||
! Vnorm
|
||||
|
||||
[ 5.0 ] [ svector{ 3.0 4.0 } Vnorm ] unit-test
|
||||
[ 5.0 ] [ dvector{ 3.0 4.0 } Vnorm ] unit-test
|
||||
|
||||
[ 13.0 ] [ cvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test
|
||||
[ 13.0 ] [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test
|
||||
|
||||
! Vasum
|
||||
|
||||
[ 6.0 ] [ svector{ 1.0 2.0 -3.0 } Vasum ] unit-test
|
||||
[ 6.0 ] [ dvector{ 1.0 2.0 -3.0 } Vasum ] unit-test
|
||||
|
||||
[ 15.0 ] [ cvector{ 1.0 C{ -2.0 3.0 } C{ 4.0 -5.0 } } Vasum ] unit-test
|
||||
[ 15.0 ] [ zvector{ 1.0 C{ -2.0 3.0 } C{ 4.0 -5.0 } } Vasum ] unit-test
|
||||
|
||||
! Vswap
|
||||
|
||||
[ svector{ 2.0 2.0 } svector{ 1.0 1.0 } ]
|
||||
[ svector{ 1.0 1.0 } svector{ 2.0 2.0 } Vswap ]
|
||||
unit-test
|
||||
|
||||
[ dvector{ 2.0 2.0 } dvector{ 1.0 1.0 } ]
|
||||
[ dvector{ 1.0 1.0 } dvector{ 2.0 2.0 } Vswap ]
|
||||
unit-test
|
||||
|
||||
[ cvector{ 2.0 C{ 2.0 2.0 } } cvector{ C{ 1.0 1.0 } 1.0 } ]
|
||||
[ cvector{ C{ 1.0 1.0 } 1.0 } cvector{ 2.0 C{ 2.0 2.0 } } Vswap ]
|
||||
unit-test
|
||||
|
||||
[ zvector{ 2.0 C{ 2.0 2.0 } } zvector{ C{ 1.0 1.0 } 1.0 } ]
|
||||
[ zvector{ C{ 1.0 1.0 } 1.0 } zvector{ 2.0 C{ 2.0 2.0 } } Vswap ]
|
||||
unit-test
|
||||
|
||||
! Viamax
|
||||
|
||||
[ 3 ] [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } Viamax ] unit-test
|
||||
[ 3 ] [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } Viamax ] unit-test
|
||||
[ 0 ] [ cvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Viamax ] unit-test
|
||||
[ 0 ] [ zvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Viamax ] unit-test
|
||||
|
||||
! Vamax
|
||||
|
||||
[ -6.0 ] [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } Vamax ] unit-test
|
||||
[ -6.0 ] [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } Vamax ] unit-test
|
||||
[ C{ 2.0 -5.0 } ] [ cvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Vamax ] unit-test
|
||||
[ C{ 2.0 -5.0 } ] [ zvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Vamax ] unit-test
|
||||
|
||||
! Vsub
|
||||
|
||||
[ svector{ -5.0 4.0 -6.0 } ] [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } 1 3 Vsub ] unit-test
|
||||
[ dvector{ -5.0 4.0 -6.0 } ] [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } 1 3 Vsub ] unit-test
|
||||
[ cvector{ -5.0 C{ 4.0 3.0 } -6.0 } ] [ cvector{ 1.0 -5.0 C{ 4.0 3.0 } -6.0 -1.0 } 1 3 Vsub ] unit-test
|
||||
[ zvector{ -5.0 C{ 4.0 3.0 } -6.0 } ] [ zvector{ 1.0 -5.0 C{ 4.0 3.0 } -6.0 -1.0 } 1 3 Vsub ] unit-test
|
||||
|
|
@ -0,0 +1,297 @@
|
|||
USING: accessors alien alien.c-types arrays byte-arrays combinators
|
||||
combinators.short-circuit fry kernel macros math math.blas.cblas
|
||||
math.complex math.functions math.order multi-methods qualified
|
||||
sequences sequences.private shuffle ;
|
||||
QUALIFIED: syntax
|
||||
IN: math.blas.vectors
|
||||
|
||||
TUPLE: blas-vector-base data length inc ;
|
||||
TUPLE: float-blas-vector < blas-vector-base ;
|
||||
TUPLE: double-blas-vector < blas-vector-base ;
|
||||
TUPLE: float-complex-blas-vector < blas-vector-base ;
|
||||
TUPLE: double-complex-blas-vector < blas-vector-base ;
|
||||
|
||||
INSTANCE: float-blas-vector sequence
|
||||
INSTANCE: double-blas-vector sequence
|
||||
INSTANCE: float-complex-blas-vector sequence
|
||||
INSTANCE: double-complex-blas-vector sequence
|
||||
|
||||
C: <float-blas-vector> float-blas-vector
|
||||
C: <double-blas-vector> double-blas-vector
|
||||
C: <float-complex-blas-vector> float-complex-blas-vector
|
||||
C: <double-complex-blas-vector> double-complex-blas-vector
|
||||
|
||||
GENERIC: n*V+V-in-place ( alpha x y -- y=alpha*x+y )
|
||||
GENERIC: n*V-in-place ( alpha x -- x=alpha*x )
|
||||
|
||||
GENERIC: V. ( x y -- x.y )
|
||||
GENERIC: V.conj ( x y -- xconj.y )
|
||||
GENERIC: Vnorm ( x -- norm )
|
||||
GENERIC: Vasum ( x -- sum )
|
||||
GENERIC: Vswap ( x y -- x=y y=x )
|
||||
|
||||
GENERIC: Viamax ( x -- max-i )
|
||||
|
||||
GENERIC: element-type ( v -- type )
|
||||
|
||||
METHOD: element-type { float-blas-vector }
|
||||
drop "float" ;
|
||||
METHOD: element-type { double-blas-vector }
|
||||
drop "double" ;
|
||||
METHOD: element-type { float-complex-blas-vector }
|
||||
drop "CBLAS_C" ;
|
||||
METHOD: element-type { double-complex-blas-vector }
|
||||
drop "CBLAS_Z" ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: (blas-vector-like) ( data length inc exemplar -- vector )
|
||||
|
||||
METHOD: (blas-vector-like) { object object object float-blas-vector }
|
||||
drop <float-blas-vector> ;
|
||||
METHOD: (blas-vector-like) { object object object double-blas-vector }
|
||||
drop <double-blas-vector> ;
|
||||
METHOD: (blas-vector-like) { object object object float-complex-blas-vector }
|
||||
drop <float-complex-blas-vector> ;
|
||||
METHOD: (blas-vector-like) { object object object double-complex-blas-vector }
|
||||
drop <double-complex-blas-vector> ;
|
||||
|
||||
: (prepare-copy) ( v element-size -- length v-data v-inc v-dest-data v-dest-inc )
|
||||
[ [ length>> ] [ data>> ] [ inc>> ] tri ] dip
|
||||
4 npick * <byte-array>
|
||||
1 ;
|
||||
|
||||
MACRO: (do-copy) ( copy make-vector -- )
|
||||
'[ over 6 npick , 2dip 1 @ ] ;
|
||||
|
||||
: (prepare-swap) ( v1 v2 -- length v1-data v1-inc v2-data v2-inc v1 v2 )
|
||||
[
|
||||
[ [ length>> ] bi@ min ]
|
||||
[ [ [ data>> ] [ inc>> ] bi ] bi@ ] 2bi
|
||||
] 2keep ;
|
||||
|
||||
: (prepare-axpy) ( n v1 v2 -- length n v1-data v1-inc v2-data v2-inc v2 )
|
||||
[
|
||||
[ [ length>> ] bi@ min swap ]
|
||||
[ [ [ data>> ] [ inc>> ] bi ] bi@ ] 2bi
|
||||
] keep ;
|
||||
|
||||
: (prepare-scal) ( n v -- length n v-data v-inc v )
|
||||
[ [ length>> swap ] [ data>> ] [ inc>> ] tri ] keep ;
|
||||
|
||||
: (prepare-dot) ( v1 v2 -- length v1-data v1-inc v2-data v2-inc )
|
||||
[ [ length>> ] bi@ min ]
|
||||
[ [ [ data>> ] [ inc>> ] bi ] bi@ ] 2bi ;
|
||||
|
||||
: (prepare-nrm2) ( v -- length v1-data v1-inc )
|
||||
[ length>> ] [ data>> ] [ inc>> ] tri ;
|
||||
|
||||
: (flatten-complex-sequence) ( seq -- seq' )
|
||||
[ [ real-part ] [ imaginary-part ] bi 2array ] map concat ;
|
||||
|
||||
: (>c-complex) ( complex -- alien )
|
||||
[ real-part ] [ imaginary-part ] bi 2array >c-float-array ;
|
||||
: (>z-complex) ( complex -- alien )
|
||||
[ real-part ] [ imaginary-part ] bi 2array >c-double-array ;
|
||||
|
||||
: (c-complex>) ( alien -- complex )
|
||||
2 c-float-array> first2 rect> ;
|
||||
: (z-complex>) ( alien -- complex )
|
||||
2 c-double-array> first2 rect> ;
|
||||
|
||||
: (prepare-nth) ( n v -- n*inc v-data )
|
||||
[ inc>> ] [ data>> ] bi [ * ] dip ;
|
||||
|
||||
MACRO: (complex-nth) ( nth-quot -- )
|
||||
'[
|
||||
[ 2 * dup 1+ ] dip
|
||||
, curry bi@ rect>
|
||||
] ;
|
||||
|
||||
: (c-complex-nth) ( n alien -- complex )
|
||||
[ float-nth ] (complex-nth) ;
|
||||
: (z-complex-nth) ( n alien -- complex )
|
||||
[ double-nth ] (complex-nth) ;
|
||||
|
||||
MACRO: (set-complex-nth) ( set-nth-quot -- )
|
||||
'[
|
||||
[
|
||||
[ [ real-part ] [ imaginary-part ] bi ]
|
||||
[ 2 * dup 1+ ] bi*
|
||||
swapd
|
||||
] dip
|
||||
, curry 2bi@
|
||||
] ;
|
||||
|
||||
: (set-c-complex-nth) ( complex n alien -- )
|
||||
[ set-float-nth ] (set-complex-nth) ;
|
||||
: (set-z-complex-nth) ( complex n alien -- )
|
||||
[ set-double-nth ] (set-complex-nth) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: <zero-vector> ( exemplar -- zero )
|
||||
[ element-type <c-object> ]
|
||||
[ length>> 0 ]
|
||||
[ (blas-vector-like) ] tri ;
|
||||
|
||||
: <empty-vector> ( length exemplar -- vector )
|
||||
[ element-type <c-array> ]
|
||||
[ 1 swap ] 2bi
|
||||
(blas-vector-like) ;
|
||||
|
||||
syntax:M: blas-vector-base length
|
||||
length>> ;
|
||||
|
||||
syntax:M: float-blas-vector nth-unsafe
|
||||
(prepare-nth) float-nth ;
|
||||
syntax:M: float-blas-vector set-nth-unsafe
|
||||
(prepare-nth) set-float-nth ;
|
||||
|
||||
syntax:M: double-blas-vector nth-unsafe
|
||||
(prepare-nth) double-nth ;
|
||||
syntax:M: double-blas-vector set-nth-unsafe
|
||||
(prepare-nth) set-double-nth ;
|
||||
|
||||
syntax:M: float-complex-blas-vector nth-unsafe
|
||||
(prepare-nth) (c-complex-nth) ;
|
||||
syntax:M: float-complex-blas-vector set-nth-unsafe
|
||||
(prepare-nth) (set-c-complex-nth) ;
|
||||
|
||||
syntax:M: double-complex-blas-vector nth-unsafe
|
||||
(prepare-nth) (z-complex-nth) ;
|
||||
syntax:M: double-complex-blas-vector set-nth-unsafe
|
||||
(prepare-nth) (set-z-complex-nth) ;
|
||||
|
||||
syntax:M: blas-vector-base equal?
|
||||
{
|
||||
[ [ length ] bi@ = ]
|
||||
[ [ = ] 2all? ]
|
||||
} 2&& ;
|
||||
|
||||
: >float-blas-vector ( seq -- v )
|
||||
[ >c-float-array ] [ length ] bi 1 <float-blas-vector> ;
|
||||
: >double-blas-vector ( seq -- v )
|
||||
[ >c-double-array ] [ length ] bi 1 <double-blas-vector> ;
|
||||
: >float-complex-blas-vector ( seq -- v )
|
||||
[ (flatten-complex-sequence) >c-float-array ] [ length ] bi
|
||||
1 <float-complex-blas-vector> ;
|
||||
: >double-complex-blas-vector ( seq -- v )
|
||||
[ (flatten-complex-sequence) >c-double-array ] [ length ] bi
|
||||
1 <double-complex-blas-vector> ;
|
||||
|
||||
syntax:M: float-blas-vector clone
|
||||
"float" heap-size (prepare-copy)
|
||||
[ cblas_scopy ] [ <float-blas-vector> ] (do-copy) ;
|
||||
syntax:M: double-blas-vector clone
|
||||
"double" heap-size (prepare-copy)
|
||||
[ cblas_dcopy ] [ <double-blas-vector> ] (do-copy) ;
|
||||
syntax:M: float-complex-blas-vector clone
|
||||
"CBLAS_C" heap-size (prepare-copy)
|
||||
[ cblas_ccopy ] [ <float-complex-blas-vector> ] (do-copy) ;
|
||||
syntax:M: double-complex-blas-vector clone
|
||||
"CBLAS_Z" heap-size (prepare-copy)
|
||||
[ cblas_zcopy ] [ <double-complex-blas-vector> ] (do-copy) ;
|
||||
|
||||
METHOD: Vswap { float-blas-vector float-blas-vector }
|
||||
(prepare-swap) [ cblas_sswap ] 2dip ;
|
||||
METHOD: Vswap { double-blas-vector double-blas-vector }
|
||||
(prepare-swap) [ cblas_dswap ] 2dip ;
|
||||
METHOD: Vswap { float-complex-blas-vector float-complex-blas-vector }
|
||||
(prepare-swap) [ cblas_cswap ] 2dip ;
|
||||
METHOD: Vswap { double-complex-blas-vector double-complex-blas-vector }
|
||||
(prepare-swap) [ cblas_zswap ] 2dip ;
|
||||
|
||||
METHOD: n*V+V-in-place { real float-blas-vector float-blas-vector }
|
||||
(prepare-axpy) [ cblas_saxpy ] dip ;
|
||||
METHOD: n*V+V-in-place { real double-blas-vector double-blas-vector }
|
||||
(prepare-axpy) [ cblas_daxpy ] dip ;
|
||||
METHOD: n*V+V-in-place { number float-complex-blas-vector float-complex-blas-vector }
|
||||
[ (>c-complex) ] 2dip
|
||||
(prepare-axpy) [ cblas_caxpy ] dip ;
|
||||
METHOD: n*V+V-in-place { number double-complex-blas-vector double-complex-blas-vector }
|
||||
[ (>z-complex) ] 2dip
|
||||
(prepare-axpy) [ cblas_zaxpy ] dip ;
|
||||
|
||||
METHOD: n*V-in-place { real float-blas-vector }
|
||||
(prepare-scal) [ cblas_sscal ] dip ;
|
||||
METHOD: n*V-in-place { real double-blas-vector }
|
||||
(prepare-scal) [ cblas_dscal ] dip ;
|
||||
METHOD: n*V-in-place { number float-complex-blas-vector }
|
||||
[ (>c-complex) ] dip
|
||||
(prepare-scal) [ cblas_cscal ] dip ;
|
||||
METHOD: n*V-in-place { number double-complex-blas-vector }
|
||||
[ (>z-complex) ] dip
|
||||
(prepare-scal) [ cblas_zscal ] dip ;
|
||||
|
||||
: n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V-in-place ; inline
|
||||
: n*V ( alpha x -- alpha*x ) clone n*V-in-place ; inline
|
||||
|
||||
: V+ ( x y -- x+y )
|
||||
1.0 -rot n*V+V ; inline
|
||||
: V- ( x y -- x-y )
|
||||
-1.0 spin n*V+V ; inline
|
||||
|
||||
: Vneg ( x -- -x )
|
||||
-1.0 swap n*V ; inline
|
||||
|
||||
: V*n ( x alpha -- x*alpha )
|
||||
swap n*V ; inline
|
||||
: V/n ( x alpha -- x/alpha )
|
||||
recip swap n*V ; inline
|
||||
|
||||
METHOD: V. { float-blas-vector float-blas-vector }
|
||||
(prepare-dot) cblas_sdot ;
|
||||
METHOD: V. { double-blas-vector double-blas-vector }
|
||||
(prepare-dot) cblas_ddot ;
|
||||
METHOD: V. { float-complex-blas-vector float-complex-blas-vector }
|
||||
(prepare-dot)
|
||||
"CBLAS_C" <c-object> [ cblas_cdotu_sub ] keep (c-complex>) ;
|
||||
METHOD: V. { double-complex-blas-vector double-complex-blas-vector }
|
||||
(prepare-dot)
|
||||
"CBLAS_Z" <c-object> [ cblas_zdotu_sub ] keep (z-complex>) ;
|
||||
|
||||
METHOD: V.conj { float-complex-blas-vector float-complex-blas-vector }
|
||||
(prepare-dot)
|
||||
"CBLAS_C" <c-object> [ cblas_cdotc_sub ] keep (c-complex>) ;
|
||||
METHOD: V.conj { double-complex-blas-vector double-complex-blas-vector }
|
||||
(prepare-dot)
|
||||
"CBLAS_Z" <c-object> [ cblas_zdotc_sub ] keep (z-complex>) ;
|
||||
|
||||
METHOD: Vnorm { float-blas-vector }
|
||||
(prepare-nrm2) cblas_snrm2 ;
|
||||
METHOD: Vnorm { double-blas-vector }
|
||||
(prepare-nrm2) cblas_dnrm2 ;
|
||||
METHOD: Vnorm { float-complex-blas-vector }
|
||||
(prepare-nrm2) cblas_scnrm2 ;
|
||||
METHOD: Vnorm { double-complex-blas-vector }
|
||||
(prepare-nrm2) cblas_dznrm2 ;
|
||||
|
||||
METHOD: Vasum { float-blas-vector }
|
||||
(prepare-nrm2) cblas_sasum ;
|
||||
METHOD: Vasum { double-blas-vector }
|
||||
(prepare-nrm2) cblas_dasum ;
|
||||
METHOD: Vasum { float-complex-blas-vector }
|
||||
(prepare-nrm2) cblas_scasum ;
|
||||
METHOD: Vasum { double-complex-blas-vector }
|
||||
(prepare-nrm2) cblas_dzasum ;
|
||||
|
||||
METHOD: Viamax { float-blas-vector }
|
||||
(prepare-nrm2) cblas_isamax ;
|
||||
METHOD: Viamax { double-blas-vector }
|
||||
(prepare-nrm2) cblas_idamax ;
|
||||
METHOD: Viamax { float-complex-blas-vector }
|
||||
(prepare-nrm2) cblas_icamax ;
|
||||
METHOD: Viamax { double-complex-blas-vector }
|
||||
(prepare-nrm2) cblas_izamax ;
|
||||
|
||||
: Vamax ( x -- max )
|
||||
[ Viamax ] keep nth ; inline
|
||||
|
||||
: Vsub ( v start length -- vsub )
|
||||
rot [
|
||||
[
|
||||
nip [ inc>> ] [ element-type heap-size ] [ data>> ] tri
|
||||
[ * * ] dip <displaced-alien>
|
||||
] [ swap 2nip ] [ 2nip inc>> ] 3tri
|
||||
] keep (blas-vector-like) ;
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
IN: tools.profiler.tests
|
||||
USING: accessors tools.profiler tools.test kernel memory math
|
||||
threads alien tools.profiler.private sequences ;
|
||||
threads alien tools.profiler.private sequences compiler.units ;
|
||||
|
||||
[ t ] [
|
||||
\ length counter>>
|
||||
|
|
@ -42,3 +42,15 @@ threads alien tools.profiler.private sequences ;
|
|||
[ 1 ] [ \ foobaz counter>> ] unit-test
|
||||
|
||||
[ 2 ] [ \ fooblah counter>> ] unit-test
|
||||
|
||||
: recompile-while-profiling-test ( -- ) ;
|
||||
|
||||
[ ] [
|
||||
[
|
||||
333 [ recompile-while-profiling-test ] times
|
||||
{ recompile-while-profiling-test } compile
|
||||
333 [ recompile-while-profiling-test ] times
|
||||
] profile
|
||||
] unit-test
|
||||
|
||||
[ 666 ] [ \ recompile-while-profiling-test counter>> ] unit-test
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ IN: windows.com.wrapper
|
|||
|
||||
HELP: <com-wrapper>
|
||||
{ $values { "implementations" "an assoc relating COM interface names to arrays of quotations implementing that interface" } { "wrapper" "a " { $link com-wrapper } " tuple" } }
|
||||
{ $description "Constructs a " { $link com-wrapper } " tuple. Each key in the " { $snippet "implementations" } " assoc must be the name of an interface defined with " { $link POSTPONE: COM-INTERFACE: } ". The corresponding value must be an array of quotations implementing the methods of that interface in order, including those of its parent interfaces. The " { $snippet "IUnknown" } " methods (" { $link IUnknown::QueryInterface } ", " { $link IUnknown::AddRef } ", and " { $link IUnknown::Release } ") will be defined automatically and must not be specified in the array. These quotations should have stack effects mirroring those of the interface methods being implemented; for example, a method " { $snippet "void foobar ( int foo, int bar )" } " should be implemented with a quotation of effect " { $snippet "( this foo bar -- )" } ". The " { $snippet "this" } " parameter (that is, the leftmost parameter of any COM method) will be automatically converted from an alien pointer to the underlying Factor object before the quotation is invoked.\n\nThe resulting wrapper can be applied to a Factor object using the " { $link com-wrap } " word. The COM interface pointer returned by " { $snippet "com-wrap" } " can then be passed to C functions requiring a COM object as a parameter. The vtables constructed by " { $snippet "<com-wrapper>" } " are stored on the non-GC heap in order to be accessible to C functions; when the wrapper objects and its vtables are no longer needed, the object's resources must be freed using " { $link dispose } ".\n\nExample:" }
|
||||
{ $description "Constructs a " { $link com-wrapper } " tuple. Each key in the " { $snippet "implementations" } " assoc must be the name of an interface defined with " { $link POSTPONE: COM-INTERFACE: } ". The corresponding value must be an array of quotations implementing the methods of that interface in order, including those of its parent interfaces. The " { $snippet "IUnknown" } " methods (" { $link IUnknown::QueryInterface } ", " { $link IUnknown::AddRef } ", and " { $link IUnknown::Release } ") will be defined automatically and must not be specified in the array. These quotations should have stack effects mirroring those of the interface methods being implemented; for example, a method " { $snippet "void foobar ( int foo, int bar )" } " should be implemented with a quotation of effect " { $snippet "( this foo bar -- )" } ". The " { $snippet "this" } " parameter (that is, the leftmost parameter of any COM method) will be automatically converted from an alien pointer to the underlying Factor object before the quotation is invoked.\n\nThe resulting wrapper can be applied to a Factor object using the " { $link com-wrap } " word. The COM interface pointer returned by " { $snippet "com-wrap" } " can then be passed to C functions requiring a COM object as a parameter. The vtables constructed by " { $snippet "<com-wrapper>" } " are stored on the non-GC heap in order to be accessible to C functions; when the wrapper object and its vtables are no longer needed, the object's resources must be freed using " { $link dispose } ".\n\nExample:" }
|
||||
{ $code <"
|
||||
COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}
|
||||
HRESULT returnOK ( )
|
||||
|
|
@ -38,4 +38,4 @@ HELP: com-wrap
|
|||
{ $description "Allocates a COM object using the implementations in the " { $snippet "wrapper" } " object for the vtables and " { $snippet "object" } " for the \"this\" parameter. The COM object is allocated on the heap with an initial reference count of 1. The object will automatically deallocate itself when its reference count reaches 0 as a result of calling " { $link IUnknown::Release } " or " { $link com-release } " on it.\n\nNote that if " { $snippet "wrapper" } " implements multiple interfaces, you cannot count on the returned COM object pointer implementing any particular interface beyond " { $snippet "IUnknown" } ". You will need to use " { $link com-query-interface } " or " { $link IUnknown::QueryInterface } " to ask the object for the particular interface you need." } ;
|
||||
|
||||
HELP: com-wrapper
|
||||
{ $class-description "The tuple class used to store COM wrapper information. Objects of this class should be treated as opaque by user code. A com-wrapper can be constructed using the " { $link <com-wrapper> } " constructor and applied to a Factor object using " { $link com-wrap } "." } ;
|
||||
{ $class-description "The tuple class used to store COM wrapper information. Objects of this class should be treated as opaque by user code. A com-wrapper can be constructed using the " { $link <com-wrapper> } " constructor and applied to a Factor object using " { $link com-wrap } ". When no longer needed, release the com-wrapper's internally allocated data with " { $link dispose } "." } ;
|
||||
|
|
|
|||
|
|
@ -35,8 +35,6 @@ void update_word_xt(F_WORD *word)
|
|||
/* If we just enabled the profiler, reset call count */
|
||||
if(profiling_p)
|
||||
{
|
||||
word->counter = tag_fixnum(0);
|
||||
|
||||
if(!word->profiling)
|
||||
{
|
||||
REGISTER_UNTAGGED(word);
|
||||
|
|
@ -71,6 +69,8 @@ void set_profiling(bool profiling)
|
|||
for(i = 0; i < length; i++)
|
||||
{
|
||||
F_WORD *word = untag_word(array_nth(untag_array(words),i));
|
||||
if(profiling)
|
||||
word->counter = tag_fixnum(0);
|
||||
update_word_xt(word);
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue