math.vectors, math.vectors.simd: add user-facing vshuffle2 word

basis/math/vectors/simd/simd-tests.factor

@@ -1,6 +1,6 @@
 USING: accessors arrays classes compiler.test compiler.tree.debugger
 effects fry io kernel kernel.private math math.functions
-math.private math.vectors math.vectors.simd
+math.private math.vectors math.vectors.simd math.ranges
 math.vectors.simd.private prettyprint random sequences system
 tools.test vocabs assocs compiler.cfg.debugger words
 locals combinators cpu.architecture namespaces byte-arrays alien
@@ -376,6 +376,38 @@ simd-classes&reps [
         [ dup '[ _ random ] replicate 1array ]
     } case ;
 
+: 2shuffles-for ( n -- shuffles )
+    {
+        { 2 [
+            {
+                { 0 1 }
+                { 0 3 }
+                { 2 3 }
+                { 2 0 }
+            }
+        ] }
+        { 4 [
+            {
+                { 0 1 2 3 }
+                { 4 1 2 3 }
+                { 0 5 2 3 }
+                { 0 1 6 3 }
+                { 0 1 2 7 }
+                { 4 5 2 3 }
+                { 0 1 6 7 }
+                { 4 5 6 7 }
+                { 0 5 2 7 }
+            }
+        ] }
+        { 8 [
+            4 2shuffles-for
+            4 2shuffles-for
+            [ [ 8 + ] map ] map
+            [ append ] 2map
+        ] }
+        [ dup 2 * '[ _ random ] replicate 1array ]
+    } case ;
+
 simd-classes [
     [ [ { } ] ] dip
     [ new length shuffles-for ] keep
@@ -385,6 +417,19 @@ simd-classes [
     ] unit-test
 ] each
 
+simd-classes [
+    [ [ { } ] ] dip
+    [ new length 2shuffles-for ] keep
+    '[
+        _ [ [
+            _ new
+            [ [ length iota ] keep like ]
+            [ [ length dup dup + [a,b) ] keep like ] bi [ ] 2sequence
+        ] dip '[ _ vshuffle2-elements ] ]
+        [ = ] check-optimizer
+    ] unit-test
+] each
+
 "== Checking variable shuffles" print
 
 : random-shift-vector ( class -- vec )

basis/math/vectors/simd/simd.factor

@@ -1,6 +1,6 @@
 USING: accessors alien arrays byte-arrays classes combinators
 cpu.architecture effects fry functors generalizations generic
-generic.parser kernel lexer literals macros math math.functions
+generic.parser kernel lexer literals locals macros math math.functions
 math.vectors math.vectors.private math.vectors.simd.intrinsics
 namespaces parser prettyprint.custom quotations sequences
 sequences.private vocabs vocabs.loader words ;
@@ -85,13 +85,19 @@ DEFER: simd-construct-op
 
 : (vv->v-op) ( a b rep quot: ( (a) (b) rep -- (c) ) -- c )
     [ [ simd-unbox ] [ underlying>> ] bi* ] 2dip 3curry make-underlying ; inline
-
 : (vv->n-op) ( a b rep quot: ( (a) (b) rep -- n ) -- n )
     [ [ underlying>> ] bi@ ] 2dip 3curry call ; inline
+: (vvn->v-op) ( a b n rep quot: ( (a) (b) n rep -- (c) ) -- c )
+    [ [ simd-unbox ] [ underlying>> ] bi* ] 3dip 2curry 2curry make-underlying ; inline
     
 : vv->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
     [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors-match ; inline
 
+:: vvn->v-op ( a b n rep quot: ( (a) (b) n rep -- (c) ) fallback-quot -- c )
+    a b rep
+    [ n swap quot (vvn->v-op) ]
+    [ drop n fallback-quot call ] if-both-vectors-match ; inline
+
 : vv'->v-op ( a b rep quot: ( (a) (b) rep -- (c) ) fallback-quot -- c )
     [ '[ _ (vv->v-op) ] ] [ '[ drop @ ] ] bi* if-both-vectors ; inline
 
@@ -185,6 +191,8 @@ M: simd-128 hrshift
     over simd-rep [ (simd-hrshift)           ] [ call-next-method ] vn->v-op ; inline
 M: simd-128 vshuffle-elements
     over simd-rep [ (simd-vshuffle-elements) ] [ call-next-method ] vn->v-op ; inline
+M: simd-128 vshuffle2-elements
+    over simd-rep [ (simd-vshuffle2-elements) ] [ call-next-method ] vvn->v-op ; inline
 M: simd-128 vshuffle-bytes
     dup simd-rep [ (simd-vshuffle-bytes)    ] [ call-next-method ] vv'->v-op ; inline
 M: simd-128 (vmerge-head)

basis/math/vectors/vectors.factor

@@ -116,6 +116,10 @@ M: object vshuffle-elements
     over length 0 pad-tail
     swap [ '[ _ nth ] ] keep map-as ; inline
 
+GENERIC# vshuffle2-elements 1 ( u v perm -- w )
+M: object vshuffle2-elements
+    [ append ] dip vshuffle-elements ; inline
+
 GENERIC# vshuffle-bytes 1 ( u perm -- v )
 
 GENERIC: vshuffle ( u perm -- v )