math.vectors.simd.cords: implement new-sequence and like methods on cords to make cross product work

db4
Slava Pestov 2010-05-13 21:55:19 -04:00
parent 4a98278720
commit fe30355ec7
2 changed files with 24 additions and 2 deletions

View File

@ -1,7 +1,8 @@
USING: accessors alien.c-types arrays byte-arrays
cpu.architecture effects functors generalizations kernel lexer
math math.vectors.simd math.vectors.simd.intrinsics parser
prettyprint.custom quotations sequences sequences.cords words ;
prettyprint.custom quotations sequences sequences.cords words
classes ;
IN: math.vectors.simd.cords
<<
@ -40,6 +41,15 @@ BOA-EFFECT define-inline
: A-cast ( v -- v' )
[ A/2-cast ] cord-map ; inline
M: A new-sequence
2drop
N A/2 new new-sequence
N A/2 new new-sequence
\ A boa ;
M: A like
over \ A instance? [ drop ] [ call-next-method ] if ;
M: A >pprint-sequence ;
M: A pprint* pprint-object ;

View File

@ -5,7 +5,8 @@ math.vectors.simd.private prettyprint random sequences system
tools.test vocabs assocs compiler.cfg.debugger words
locals combinators cpu.architecture namespaces byte-arrays alien
specialized-arrays classes.struct eval classes.algebra sets
quotations math.constants compiler.units splitting ;
quotations math.constants compiler.units splitting math.matrices
math.vectors.simd.cords ;
FROM: math.vectors.simd.intrinsics => alien-vector set-alien-vector ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:float
@ -603,3 +604,14 @@ STRUCT: simd-struct
[ float-4{ 0 0 0 0 } ]
[ 5.0 float-4{ 1 2 3 4 } float-4{ 4 5 6 7 } 0.0 simd-spill-test-2 ] unit-test
! Test some sequence protocol stuff
[ t ] [ 4 double-4{ 1 2 3 4 } new-sequence double-4? ] unit-test
[ double-4{ 2 3 4 5 } ] [ double-4{ 1 2 3 4 } [ 1 + ] map ] unit-test
! Test cross product
[ float-4{ 0.0 0.0 1.0 0.0 } ] [ float-4{ 1.0 0.0 0.0 0.0 } float-4{ 0.0 1.0 0.0 0.0 } cross ] unit-test
[ float-4{ 0.0 -1.0 0.0 0.0 } ] [ float-4{ 1.0 0.0 0.0 0.0 } float-4{ 0.0 0.0 1.0 0.0 } cross ] unit-test
[ double-4{ 0.0 0.0 1.0 0.0 } ] [ double-4{ 1.0 0.0 0.0 0.0 } double-4{ 0.0 1.0 0.0 0.0 } cross ] unit-test
[ double-4{ 0.0 -1.0 0.0 0.0 } ] [ double-4{ 1.0 0.0 0.0 0.0 } double-4{ 0.0 0.0 1.0 0.0 } cross ] unit-test