Some fixes and cleanups in math.vectors

- Tighten up type inference for operations on complex float arrays
- Fix v. to have correct behavior with complex numbers
- Rename v<< and v>> to vlshift and vrshift to avoid clashing with v>> accessor

diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor
index 1faa64be61a6fdf65a43dd1f0b7046f3bc1c7163..cb46f2d67a0c5a77da1ba5ef3eeb7609f5d97594 100644 (file)
--- a/basis/alien/complex/functor/functor.factor
+++ b/basis/alien/complex/functor/functor.factor
@@ -25,7 +25,7 @@ STRUCT: T-class { real N } { imaginary N } ;
 T-class c-type
 <T> 1quotation >>unboxer-quot
 *T 1quotation >>boxer-quot
-number >>boxed-class
+complex >>boxed-class
 drop
 
 ;FUNCTOR

diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor
index 98f5ed9a85b07079ddbf7dd9cbf4f603ed578350..056e2471ef23072934eb563e2041119d9d85b380 100644 (file)
--- a/basis/compiler/cfg/intrinsics/intrinsics.factor
+++ b/basis/compiler/cfg/intrinsics/intrinsics.factor
@@ -169,8 +169,8 @@ IN: compiler.cfg.intrinsics
         { math.vectors.simd.intrinsics:(simd-vbitand) [ [ ^^and-vector ] emit-binary-vector-op ] }
         { math.vectors.simd.intrinsics:(simd-vbitor) [ [ ^^or-vector ] emit-binary-vector-op ] }
         { math.vectors.simd.intrinsics:(simd-vbitxor) [ [ ^^xor-vector ] emit-binary-vector-op ] }
-        { math.vectors.simd.intrinsics:(simd-v<<) [ [ ^^shl-vector ] emit-binary-vector-op ] }
-        { math.vectors.simd.intrinsics:(simd-v>>) [ [ ^^shr-vector ] emit-binary-vector-op ] }
+        { math.vectors.simd.intrinsics:(simd-vlshift) [ [ ^^shl-vector ] emit-binary-vector-op ] }
+        { math.vectors.simd.intrinsics:(simd-vrshift) [ [ ^^shr-vector ] emit-binary-vector-op ] }
         { math.vectors.simd.intrinsics:(simd-broadcast) [ [ ^^broadcast-vector ] emit-unary-vector-op ] }
         { math.vectors.simd.intrinsics:(simd-gather-2) [ emit-gather-vector-2 ] }
         { math.vectors.simd.intrinsics:(simd-gather-4) [ emit-gather-vector-4 ] }

diff --git a/basis/compiler/tree/propagation/simd/simd.factor b/basis/compiler/tree/propagation/simd/simd.factor
index c0651d106b34d63c8bf496cd65cc5c595712e9c3..6a619b298ef22a53da3c3c8172946d272a48dfb8 100644 (file)
--- a/basis/compiler/tree/propagation/simd/simd.factor
+++ b/basis/compiler/tree/propagation/simd/simd.factor
@@ -19,8 +19,8 @@ IN: compiler.tree.propagation.simd
     (simd-vbitand)
     (simd-vbitor)
     (simd-vbitxor)
-    (simd-v<<)
-    (simd-v>>)
+    (simd-vlshift)
+    (simd-vrshift)
     (simd-broadcast)
     (simd-gather-2)
     (simd-gather-4)

diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor
index 2dc034551c685cf8838c3d3579ba44a3428aefc9..6989ac2bc2f539ef02d29bbbb1e821ca719451b8 100644 (file)
--- a/basis/math/vectors/simd/intrinsics/intrinsics.factor
+++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor
@@ -42,8 +42,8 @@ SIMD-OP: vabs
 SIMD-OP: vbitand
 SIMD-OP: vbitor
 SIMD-OP: vbitxor
-SIMD-OP: v<<
-SIMD-OP: v>>
+SIMD-OP: vlshift
+SIMD-OP: vrshift
 
 : (simd-broadcast) ( x rep -- v ) bad-simd-call ;
 : (simd-gather-2) ( a b rep -- v ) bad-simd-call ;
@@ -112,8 +112,8 @@ M: vector-rep supported-simd-op?
         { \ (simd-vbitand)   [ %and-vector-reps            ] }
         { \ (simd-vbitor)    [ %or-vector-reps             ] }
         { \ (simd-vbitxor)   [ %xor-vector-reps            ] }
-        { \ (simd-v<<)       [ %shl-vector-reps            ] }
-        { \ (simd-v>>)       [ %shr-vector-reps            ] }
+        { \ (simd-vlshift)   [ %shl-vector-reps            ] }
+        { \ (simd-vrshift)   [ %shr-vector-reps            ] }
         { \ (simd-broadcast) [ %broadcast-vector-reps      ] }
         { \ (simd-gather-2)  [ %gather-vector-2-reps       ] }
         { \ (simd-gather-4)  [ %gather-vector-4-reps       ] }

diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor
index 284aa3a9aefd3987e28d65477c80042473bbe7cb..535a67135922ab795637528cca6f50b43f0b3fd6 100644 (file)
--- a/basis/math/vectors/simd/simd-tests.factor
+++ b/basis/math/vectors/simd/simd-tests.factor
@@ -142,7 +142,7 @@ CONSTANT: simd-classes
     [ drop { vsqrt n/v v/n v/ normalize } member? not ] assoc-filter ;
 
 : remove-integer-words ( alist -- alist' )
-    [ drop { v<< v>> } member? not ] assoc-filter ;
+    [ drop { vlshift vrshift } member? not ] assoc-filter ;
 
 : ops-to-check ( elt-class -- alist )
     [ vector-words >alist ] dip

diff --git a/basis/math/vectors/specialization/specialization-tests.factor b/basis/math/vectors/specialization/specialization-tests.factor
index f9f241bb6f05684978fc2dc21ffa6b04b863794f..649685b8985b012cde8208e022fadcea8500cc76 100644 (file)
--- a/basis/math/vectors/specialization/specialization-tests.factor
+++ b/basis/math/vectors/specialization/specialization-tests.factor
@@ -13,10 +13,14 @@ SPECIALIZED-ARRAY: float
     [ { float-array float } declare v*n norm ] final-classes
 ] unit-test
 
-[ V{ number } ] [
+[ V{ complex } ] [
     [ { complex-float-array complex-float-array } declare v. ] final-classes
 ] unit-test
 
-[ V{ real } ] [
+[ V{ float } ] [
+    [ { float-array float } declare v*n norm ] final-classes
+] unit-test
+
+[ V{ float } ] [
     [ { complex-float-array complex } declare v*n norm ] final-classes
 ] unit-test
\ No newline at end of file

diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor
index 07099df23c8050ce7536dc1e2e876be10b71da87..6c8ffd6f618330494d7de2a41032490fa3fe0192 100644 (file)
--- a/basis/math/vectors/specialization/specialization.factor
+++ b/basis/math/vectors/specialization/specialization.factor
@@ -30,7 +30,14 @@ SYMBOLS: -> +vector+ +scalar+ +nonnegative+ ;
         {
             { +vector+ [ drop <class-info> ] }
             { +scalar+ [ nip <class-info> ] }
-            { +nonnegative+ [ nip real class-and [0,inf] <class/interval-info> ] }
+            {
+                +nonnegative+
+                [
+                    nip
+                    dup complex class<= [ drop float ] when
+                    [0,inf] <class/interval-info>
+                ]
+            }
         } case
     ] with with map ;
 
@@ -77,8 +84,8 @@ H{
     { vbitand { +vector+ +vector+ -> +vector+ } }
     { vbitor { +vector+ +vector+ -> +vector+ } }
     { vbitxor { +vector+ +vector+ -> +vector+ } }
-    { v>> { +vector+ +scalar+ -> +vector+ } }
-    { v<< { +vector+ +scalar+ -> +vector+ } }
+    { vlshift { +vector+ +scalar+ -> +vector+ } }
+    { vrshift { +vector+ +scalar+ -> +vector+ } }
 }
 
 PREDICATE: vector-word < word vector-words key? ;
@@ -112,9 +119,11 @@ M: vector-word subwords specializations values [ word? ] filter ;
 : vector-words-for-type ( elt-type -- alist )
     {
         ! Can't do shifts on floats
-        { [ dup float class<= ] [ vector-words keys { v<< v>> } diff ] }
+        { [ dup float class<= ] [ vector-words keys { vlshift vrshift } diff ] }
         ! Can't divide integers
         { [ dup integer class<= ] [ vector-words keys { vsqrt n/v v/n v/ normalize } diff ] }
+        ! Can't compute square root of complex numbers (vsqrt uses fsqrt not sqrt)
+        { [ dup complex class<= ] [ vector-words keys { vsqrt } diff ] }
         [ { } ]
     } cond nip ;
 

diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor
index 13175ea8d1f6d1d5ea6e6e12c4899b91908dfa2c..252cc4216e70af547beafc579c70f255c0fe56c8 100644 (file)
--- a/basis/math/vectors/vectors-docs.factor
+++ b/basis/math/vectors/vectors-docs.factor
@@ -38,8 +38,8 @@ $nl
 { $subsection vbitand }
 { $subsection vbitor }
 { $subsection vbitxor }
-{ $subsection v<< }
-{ $subsection v>> }
+{ $subsection vlshift }
+{ $subsection vrshift }
 "Inner product and norm:"
 { $subsection v. }
 { $subsection norm }
@@ -162,11 +162,7 @@ HELP: vmin
 
 HELP: v.
 { $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "x" "a real number" } }
-{ $description "Computes the real-valued dot product." }
-{ $notes
-    "This word can also take complex number sequences as input, however mathematically it will compute the wrong result. The complex-valued dot product is defined differently:"
-    { $code "0 [ conjugate * + ] 2reduce" }
-} ;
+{ $description "Computes the dot product of two vectors." } ;
 
 HELP: vs+
 { $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
@@ -211,11 +207,11 @@ HELP: vbitxor
 { $description "Takes the bitwise exclusive or of " { $snippet "u" } " and " { $snippet "v" } " component-wise." }
 { $notes "Unlike " { $link bitxor } ", this word may be used on a specialized array of floats or doubles, in which case the bitwise representation of the floating point numbers is operated upon." } ;
 
-HELP: v<<
+HELP: vlshift
 { $values { "u" "a sequence of integers" } { "n" "a non-negative integer" } { "w" "a sequence of integers" } }
 { $description "Shifts each element of " { $snippet "u" } " to the left by " { $snippet "n" } " bits." } ;
 
-HELP: v>>
+HELP: vrshift
 { $values { "u" "a sequence of integers" } { "n" "a non-negative integer" } { "w" "a sequence of integers" } }
 { $description "Shifts each element of " { $snippet "u" } " to the right by " { $snippet "n" } " bits." } ;
 

diff --git a/basis/math/vectors/vectors-tests.factor b/basis/math/vectors/vectors-tests.factor
index fc482815a985def9fb62a94d519ff7f0df85f902..529683188972a6727c6dd024f08e632119f40fff 100644 (file)
--- a/basis/math/vectors/vectors-tests.factor
+++ b/basis/math/vectors/vectors-tests.factor
@@ -1,5 +1,5 @@
 IN: math.vectors.tests
-USING: math.vectors tools.test ;
+USING: math.vectors tools.test kernel ;
 
 [ { 1 2 3 } ] [ 1/2 { 2 4 6 } n*v ] unit-test
 [ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test
@@ -19,4 +19,6 @@ USING: math.vectors tools.test ;
 
 [ 17 ] [ 0 1 2 3 4 5 6 7 { 1 2 3 } trilerp ] unit-test
 
-[ { 0 3 2 5 4 } ] [ { 1 2 3 4 5 } { 1 1 1 1 1 } v+- ] unit-test
\ No newline at end of file
+[ { 0 3 2 5 4 } ] [ { 1 2 3 4 5 } { 1 1 1 1 1 } v+- ] unit-test
+
+[ 1 ] [ { C{ 0 1 } } dup v. ] unit-test
\ No newline at end of file

diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
index adaed6abdd322259dfe587c88ee4337f81d71201..a40506f98014f82cc9f99e9b45710a9dc346aec8 100644 (file)
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@@ -61,8 +61,8 @@ PRIVATE>
 : vbitor ( u v -- w ) over '[ _ [ bitor ] fp-bitwise-op ] 2map ;
 : vbitxor ( u v -- w ) over '[ _ [ bitxor ] fp-bitwise-op ] 2map ;
 
-: v<< ( u n -- w ) '[ _ shift ] map ;
-: v>> ( u n -- w ) neg '[ _ shift ] map ;
+: vlshift ( u n -- w ) '[ _ shift ] map ;
+: vrshift ( u n -- w ) neg '[ _ shift ] map ;
 
 : vfloor    ( u -- v ) [ floor ] map ;
 : vceiling  ( u -- v ) [ ceiling ] map ;
@@ -71,7 +71,7 @@ PRIVATE>
 : vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ; 
 : vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ; 
 
-: v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
+: v. ( u v -- x ) [ conjugate * ] [ + ] 2map-reduce ;
 : norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
 : norm ( v -- x ) norm-sq sqrt ;
 : normalize ( u -- v ) dup norm v/n ;