diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor index 1faa64be61..cb46f2d67a 100644 --- 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 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 98f5ed9a85..056e2471ef 100644 --- 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 c0651d106b..6a619b298e 100644 --- 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 2dc034551c..6989ac2bc2 100644 --- 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 284aa3a9ae..535a671359 100644 --- 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 f9f241bb6f..649685b898 100644 --- 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 07099df23c..6c8ffd6f61 100644 --- a/basis/math/vectors/specialization/specialization.factor +++ b/basis/math/vectors/specialization/specialization.factor @@ -30,7 +30,14 @@ SYMBOLS: -> +vector+ +scalar+ +nonnegative+ ; { { +vector+ [ drop ] } { +scalar+ [ nip ] } - { +nonnegative+ [ nip real class-and [0,inf] ] } + { + +nonnegative+ + [ + nip + dup complex class<= [ drop float ] when + [0,inf] + ] + } } 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 13175ea8d1..252cc4216e 100644 --- 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 fc482815a9..5296831889 100644 --- 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 adaed6abdd..a40506f980 100644 --- 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 ;