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

diff --git a/basis/math/vectors/simd/cords/cords.factor b/basis/math/vectors/simd/cords/cords.factor
index df7fbe9ecdd4b554c101ac3187c166da987ea02b..4d98af538fd8229ae5281a150285168d59f8c2d2 100644 (file)
--- a/basis/math/vectors/simd/cords/cords.factor
+++ b/basis/math/vectors/simd/cords/cords.factor
@@ -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 ;
 

diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor
index f3d56ba8687ab7237e0f74319876a06fd36264b2..10eb24145eb0d243eba6bc9a6f8ad1073627b913 100644 (file)
--- a/basis/math/vectors/simd/simd-tests.factor
+++ b/basis/math/vectors/simd/simd-tests.factor
@@ -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