From b411f1701a8b529919e73710af48c83e916f21b0 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 19 Oct 2009 12:25:55 -0500
Subject: [PATCH] make vshuffle-bytes intrinsic for any shuffle mask type

---
 basis/math/vectors/simd/functor/functor.factor      |  1 +
 .../vectors/specialization/specialization.factor    | 13 +++++++++++--
 basis/math/vectors/vectors.factor                   |  2 +-
 basis/random/sfmt/sfmt.factor                       |  2 +-
 4 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor
index fdb742a721..480981d165 100644
--- a/basis/math/vectors/simd/functor/functor.factor
+++ b/basis/math/vectors/simd/functor/functor.factor
@@ -280,6 +280,7 @@ simd new
     } >>special-wrappers
     {
         { { +vector+ +vector+ -> +vector+ } A-vv->v-op }
+        { { +vector+ +any-vector+ -> +vector+ } A-vv->v-op }
         { { +vector+ +scalar+ -> +vector+ } A-vn->v-op }
         { { +vector+ +literal+ -> +vector+ } A-vn->v-op }
         { { +vector+ +vector+ -> +scalar+ } A-vv->n-op }
diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor
index 62ebecff36..3ff286d508 100644
--- a/basis/math/vectors/specialization/specialization.factor
+++ b/basis/math/vectors/specialization/specialization.factor
@@ -7,12 +7,20 @@ namespaces assocs fry splitting classes.algebra generalizations
 locals compiler.tree.propagation.info ;
 IN: math.vectors.specialization
 
-SYMBOLS: -> +vector+ +scalar+ +boolean+ +nonnegative+ +literal+ ;
+SYMBOLS: -> +vector+ +any-vector+ +scalar+ +boolean+ +nonnegative+ +literal+ ;
+
+: parent-vector-class ( type -- type' )
+    {
+        { [ dup simd-128 class<= ] [ drop simd-128 ] }
+        { [ dup simd-256 class<= ] [ drop simd-256 ] }
+        [ "Not a vector class" throw ]
+    } cond ;
 
 : signature-for-schema ( array-type elt-type schema -- signature )
     [
         {
             { +vector+ [ drop ] }
+            { +any-vector+ [ drop parent-vector-class ] }
             { +scalar+ [ nip ] }
             { +boolean+ [ 2drop boolean ] }
             { +nonnegative+ [ nip ] }
@@ -32,6 +40,7 @@ SYMBOLS: -> +vector+ +scalar+ +boolean+ +nonnegative+ +literal+ ;
     [
         {
             { +vector+ [ drop <class-info> ] }
+            { +any-vector+ [ drop parent-vector-class <class-info> ] }
             { +scalar+ [ nip <class-info> ] }
             { +boolean+ [ 2drop boolean <class-info> ] }
             {
@@ -101,7 +110,7 @@ H{
     { hlshift { +vector+ +literal+ -> +vector+ } }
     { hrshift { +vector+ +literal+ -> +vector+ } }
     { vshuffle-elements { +vector+ +literal+ -> +vector+ } }
-    { vshuffle-bytes    { +vector+ +vector+  -> +vector+ } }
+    { vshuffle-bytes    { +vector+ +any-vector+  -> +vector+ } }
     { vbroadcast { +vector+ +literal+ -> +vector+ } }
     { (vmerge-head) { +vector+ +vector+ -> +vector+ } }
     { (vmerge-tail) { +vector+ +vector+ -> +vector+ } }
diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
index 0a984ba2e7..2426e4814b 100644
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@@ -92,7 +92,7 @@ PRIVATE>
 
 : vshuffle-bytes ( u perm -- v )
     underlying>> [
-        swap [ '[ _ nth ] ] keep map-as
+        swap [ '[ 15 bitand _ nth ] ] keep map-as
     ] curry change-underlying ;
 
 GENERIC: vshuffle ( u perm -- v )
diff --git a/basis/random/sfmt/sfmt.factor b/basis/random/sfmt/sfmt.factor
index eb78d7e812..55606217c9 100644
--- a/basis/random/sfmt/sfmt.factor
+++ b/basis/random/sfmt/sfmt.factor
@@ -30,7 +30,7 @@ TUPLE: sfmt
 
 : endian-shuffle ( v -- w )
     little-endian? [
-        B{ 3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12 } uint-4 boa vshuffle
+        uchar-16{ 3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12 } vshuffle
     ] unless ; inline
 
 : hlshift* ( v n -- w )