diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index d8f34b4164..635f322f44 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -171,6 +171,10 @@ IN: compiler.cfg.intrinsics { math.vectors.simd.intrinsics:(simd-vbitandn) [ [ ^^andn-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-vand) [ [ ^^and-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vandn) [ [ ^^andn-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vor) [ [ ^^or-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vxor) [ [ ^^xor-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-v=) [ [ cc= ^^compare-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vany?) [ [ vcc-any ^^test-vector ] emit-unary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vall?) [ [ vcc-all ^^test-vector ] emit-unary-vector-op ] } diff --git a/basis/compiler/tree/propagation/simd/simd.factor b/basis/compiler/tree/propagation/simd/simd.factor index c8be614886..6f90c46377 100644 --- a/basis/compiler/tree/propagation/simd/simd.factor +++ b/basis/compiler/tree/propagation/simd/simd.factor @@ -20,6 +20,10 @@ IN: compiler.tree.propagation.simd (simd-vbitandn) (simd-vbitor) (simd-vbitxor) + (simd-vand) + (simd-vandn) + (simd-vor) + (simd-vxor) (simd-vlshift) (simd-vrshift) (simd-hlshift) diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index cbdbade222..02b472f73e 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -44,6 +44,10 @@ SIMD-OP: vbitand SIMD-OP: vbitandn SIMD-OP: vbitor SIMD-OP: vbitxor +SIMD-OP: vand +SIMD-OP: vandn +SIMD-OP: vor +SIMD-OP: vxor SIMD-OP: vlshift SIMD-OP: vrshift SIMD-OP: hlshift @@ -125,6 +129,10 @@ M: vector-rep supported-simd-op? { \ (simd-vbitandn) [ %andn-vector-reps ] } { \ (simd-vbitor) [ %or-vector-reps ] } { \ (simd-vbitxor) [ %xor-vector-reps ] } + { \ (simd-vand) [ %and-vector-reps ] } + { \ (simd-vandn) [ %andn-vector-reps ] } + { \ (simd-vor) [ %or-vector-reps ] } + { \ (simd-vxor) [ %xor-vector-reps ] } { \ (simd-vlshift) [ %shl-vector-reps ] } { \ (simd-vrshift) [ %shr-vector-reps ] } { \ (simd-hlshift) [ %horizontal-shl-vector-reps ] } diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index 7f43124d59..3d2fed5082 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -159,6 +159,12 @@ CONSTANT: simd-classes : remove-integer-words ( alist -- alist' ) { vlshift vrshift } unique assoc-diff ; +: boolean-ops ( -- words ) + { vand vandn vor vxor } ; + +: remove-boolean-words ( alist -- alist' ) + boolean-ops unique assoc-diff ; + : remove-special-words ( alist -- alist' ) ! These have their own tests later { @@ -169,6 +175,7 @@ CONSTANT: simd-classes : ops-to-check ( elt-class -- alist ) [ vector-words >alist ] dip float = [ remove-integer-words ] [ remove-float-words ] if + remove-boolean-words remove-special-words ; : check-vector-ops ( class elt-class compare-quot -- ) @@ -211,6 +218,30 @@ simd-classes&reps [ [ [ { } ] ] dip first3 '[ _ _ _ check-vector-ops ] unit-test ] each +"== Checking boolean operations" print + +: random-boolean-vector ( class -- vec ) + new [ drop 2 random zero? ] map ; + +:: check-boolean-op ( word inputs class elt-class -- inputs quot ) + inputs [ + { + { +vector+ [ class random-boolean-vector ] } + { +scalar+ [ 1000 random elt-class float = [ >float ] when ] } + } case + ] [ ] map-as + word '[ _ execute ] ; + +: check-boolean-ops ( class elt-class compare-quot -- ) + [ + [ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip + '[ first2 inputs _ _ check-boolean-op ] + ] dip check-optimizer ; inline + +simd-classes&reps [ + [ [ { } ] ] dip first3 '[ _ _ _ check-boolean-ops ] unit-test +] each + "== Checking shifts and permutations" print [ int-4{ 256 512 1024 2048 } ] diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor index ffb148f55d..07fc93336c 100644 --- a/basis/math/vectors/specialization/specialization.factor +++ b/basis/math/vectors/specialization/specialization.factor @@ -86,6 +86,10 @@ H{ { vbitandn { +vector+ +vector+ -> +vector+ } } { vbitor { +vector+ +vector+ -> +vector+ } } { vbitxor { +vector+ +vector+ -> +vector+ } } + { vand { +vector+ +vector+ -> +vector+ } } + { vandn { +vector+ +vector+ -> +vector+ } } + { vor { +vector+ +vector+ -> +vector+ } } + { vxor { +vector+ +vector+ -> +vector+ } } { vlshift { +vector+ +scalar+ -> +vector+ } } { vrshift { +vector+ +scalar+ -> +vector+ } } { hlshift { +vector+ +literal+ -> +vector+ } } diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index 547021afdb..4d944ac56d 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -329,6 +329,10 @@ HELP: vand { $values { "u" "a sequence of booleans" } { "v" "a sequence of booleans" } { "w" "a sequence of booleans" } } { $description "Takes the logical AND of each corresponding element of " { $snippet "u" } " and " { $snippet "v" } "." } ; +HELP: vandn +{ $values { "u" "a sequence of booleans" } { "v" "a sequence of booleans" } { "w" "a sequence of booleans" } } +{ $description "Takes the logical AND-NOT of each corresponding element of " { $snippet "u" } " and " { $snippet "v" } ", where " { $snippet "x AND-NOT y" } " is defined as " { $snippet "NOT(x) AND y" } "." } ; + HELP: vor { $values { "u" "a sequence of booleans" } { "v" "a sequence of booleans" } { "w" "a sequence of booleans" } } { $description "Takes the logical OR of each corresponding element of " { $snippet "u" } " and " { $snippet "v" } "." } ; diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 302380cd09..f485e2bbf2 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -7,6 +7,7 @@ QUALIFIED-WITH: alien.c-types c IN: math.vectors GENERIC: element-type ( obj -- c-type ) +M: object element-type drop f ; inline : vneg ( u -- v ) [ neg ] map ; @@ -52,7 +53,7 @@ PRIVATE> : fp-bitwise-op ( x y seq quot -- z ) swap element-type { { c:double [ [ [ double>bits ] bi@ ] dip call bits>double ] } - { c:float [ [ [ float>bits ] bi@ ] dip call bits>float ] } + { c:float [ [ [ float>bits ] bi@ ] dip call bits>float ] } [ drop call ] } case ; inline @@ -63,6 +64,9 @@ PRIVATE> [ drop call ] } case ; inline +: element>bool ( x seq -- ? ) + element-type [ zero? not ] when ; inline + : bitandn ( x y -- z ) [ bitnot ] dip bitand ; inline GENERIC: new-underlying ( underlying seq -- seq' ) @@ -87,10 +91,11 @@ PRIVATE> : hlshift ( u n -- w ) '[ _ prepend 16 head ] change-underlying ; : hrshift ( u n -- w ) '[ _ append 16 tail* ] change-underlying ; -: vand ( u v -- w ) [ and ] 2map ; -: vor ( u v -- w ) [ or ] 2map ; -: vxor ( u v -- w ) [ xor ] 2map ; -: vnot ( u -- w ) [ not ] map ; +: vand ( u v -- w ) over '[ [ _ element>bool ] bi@ and ] 2map ; +: vandn ( u v -- w ) over '[ [ _ element>bool ] bi@ [ not ] dip and ] 2map ; +: vor ( u v -- w ) over '[ [ _ element>bool ] bi@ or ] 2map ; +: vxor ( u v -- w ) over '[ [ _ element>bool ] bi@ xor ] 2map ; +: vnot ( u -- w ) dup '[ _ element>bool not ] map ; : vall? ( v -- ? ) [ ] all? ; : vany? ( v -- ? ) [ ] any? ; @@ -104,7 +109,7 @@ PRIVATE> : v= ( u v -- w ) [ = ] 2map ; : v? ( mask true false -- w ) - [ vbitand ] [ vbitandn ] bi-curry* bi vbitor ; inline + [ vand ] [ vandn ] bi-curry* bi vor ; inline : vfloor ( u -- v ) [ floor ] map ; : vceiling ( u -- v ) [ ceiling ] map ;