packages feed

hw-simd 0.0.0.3 → 0.1.0.0

raw patch · 19 files changed

+835/−248 lines, 19 filesdep +hw-hedgehogdep +lensPVP ok

version bump matches the API change (PVP)

Dependencies added: hw-hedgehog, lens

API changes (from Hackage documentation)

- HaskellWorks.Data.Simd.Comparison: cmpeq8s :: Word8 -> Vector Word64 -> Vector Word64
- HaskellWorks.Data.Simd.Comparison.Avx2: cmpeq8s :: Word8 -> Vector Word64 -> Vector Word64
- HaskellWorks.Data.Simd.Comparison.Stock: cmpeq8s :: Word8 -> Vector Word64 -> Vector Word64
+ HaskellWorks.Data.Simd.Comparison: class CmpEqWord8s a
+ HaskellWorks.Data.Simd.Comparison: cmpEqWord8s :: CmpEqWord8s a => Word8 -> a -> a
+ HaskellWorks.Data.Simd.Comparison: instance HaskellWorks.Data.Simd.Comparison.CmpEqWord8s (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Comparison.Avx2: class CmpEqWord8s a
+ HaskellWorks.Data.Simd.Comparison.Avx2: cmpEqWord8s :: CmpEqWord8s a => Word8 -> a -> a
+ HaskellWorks.Data.Simd.Comparison.Avx2: instance HaskellWorks.Data.Simd.Comparison.Avx2.CmpEqWord8s (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Comparison.Avx2: instance HaskellWorks.Data.Simd.Comparison.Avx2.CmpEqWord8s [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Comparison.Stock: class CmpEqWord8s a
+ HaskellWorks.Data.Simd.Comparison.Stock: cmpEqWord8s :: CmpEqWord8s a => Word8 -> a -> a
+ HaskellWorks.Data.Simd.Comparison.Stock: instance HaskellWorks.Data.Simd.Comparison.Stock.CmpEqWord8s (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Comparison.Stock: instance HaskellWorks.Data.Simd.Comparison.Stock.CmpEqWord8s [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Internal.Foreign: avx2AndBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO ()
+ HaskellWorks.Data.Simd.Internal.Foreign: avx2AndNotBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO ()
+ HaskellWorks.Data.Simd.Internal.Foreign: avx2NotBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> IO ()
+ HaskellWorks.Data.Simd.Internal.Foreign: avx2OrBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO ()
+ HaskellWorks.Data.Simd.Internal.Foreign: avx2XorBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO ()
+ HaskellWorks.Data.Simd.Internal.Foreign: c_avx2_and_bits :: ((Ptr CUChar) -> (CULong -> ((Ptr CUChar) -> ((Ptr CUChar) -> (IO ())))))
+ HaskellWorks.Data.Simd.Internal.Foreign: c_avx2_and_not_bits :: ((Ptr CUChar) -> (CULong -> ((Ptr CUChar) -> ((Ptr CUChar) -> (IO ())))))
+ HaskellWorks.Data.Simd.Internal.Foreign: c_avx2_not_bits :: ((Ptr CUChar) -> (CULong -> ((Ptr CUChar) -> (IO ()))))
+ HaskellWorks.Data.Simd.Internal.Foreign: c_avx2_or_bits :: ((Ptr CUChar) -> (CULong -> ((Ptr CUChar) -> ((Ptr CUChar) -> (IO ())))))
+ HaskellWorks.Data.Simd.Internal.Foreign: c_avx2_xor_bits :: ((Ptr CUChar) -> (CULong -> ((Ptr CUChar) -> ((Ptr CUChar) -> (IO ())))))
+ HaskellWorks.Data.Simd.Internal.Marshal: unsafeToElemSizedForeignPtr :: Int -> Vector Word64 -> (ForeignPtr Word8, Int, Int)
+ HaskellWorks.Data.Simd.Logical: andBits :: AndBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical: andNotBits :: AndNotBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical: class AndBits a
+ HaskellWorks.Data.Simd.Logical: class AndNotBits a
+ HaskellWorks.Data.Simd.Logical: class NotBits a
+ HaskellWorks.Data.Simd.Logical: class OrBits a
+ HaskellWorks.Data.Simd.Logical: class XorBits a
+ HaskellWorks.Data.Simd.Logical: instance HaskellWorks.Data.Simd.Logical.AndBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical: instance HaskellWorks.Data.Simd.Logical.AndNotBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical: instance HaskellWorks.Data.Simd.Logical.NotBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical: instance HaskellWorks.Data.Simd.Logical.OrBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical: instance HaskellWorks.Data.Simd.Logical.XorBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical: notBits :: NotBits a => a -> a
+ HaskellWorks.Data.Simd.Logical: orBits :: OrBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical: xorBits :: XorBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical.Avx2: andBits :: AndBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical.Avx2: andNotBits :: AndNotBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical.Avx2: class AndBits a
+ HaskellWorks.Data.Simd.Logical.Avx2: class AndNotBits a
+ HaskellWorks.Data.Simd.Logical.Avx2: class NotBits a
+ HaskellWorks.Data.Simd.Logical.Avx2: class OrBits a
+ HaskellWorks.Data.Simd.Logical.Avx2: class XorBits a
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.AndBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.AndBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.AndNotBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.AndNotBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.NotBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.NotBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.OrBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.OrBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.XorBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Avx2: instance HaskellWorks.Data.Simd.Logical.Avx2.XorBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Avx2: notBits :: NotBits a => a -> a
+ HaskellWorks.Data.Simd.Logical.Avx2: orBits :: OrBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical.Avx2: xorBits :: XorBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical.Stock: andBits :: AndBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical.Stock: andNotBits :: AndNotBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical.Stock: class AndBits a
+ HaskellWorks.Data.Simd.Logical.Stock: class AndNotBits a
+ HaskellWorks.Data.Simd.Logical.Stock: class NotBits a
+ HaskellWorks.Data.Simd.Logical.Stock: class OrBits a
+ HaskellWorks.Data.Simd.Logical.Stock: class XorBits a
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.AndBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.AndBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.AndNotBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.AndNotBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.NotBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.NotBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.OrBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.OrBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.XorBits (Data.Vector.Storable.Vector GHC.Word.Word64)
+ HaskellWorks.Data.Simd.Logical.Stock: instance HaskellWorks.Data.Simd.Logical.Stock.XorBits [Data.Vector.Storable.Vector GHC.Word.Word64]
+ HaskellWorks.Data.Simd.Logical.Stock: notBits :: NotBits a => a -> a
+ HaskellWorks.Data.Simd.Logical.Stock: orBits :: OrBits a => a -> a -> a
+ HaskellWorks.Data.Simd.Logical.Stock: xorBits :: XorBits a => a -> a -> a

Files

bench/Main.hs view
@@ -13,33 +13,57 @@ import qualified HaskellWorks.Data.Simd.Capabilities     as CAP import qualified HaskellWorks.Data.Simd.Comparison.Avx2  as AVX2 import qualified HaskellWorks.Data.Simd.Comparison.Stock as STOCK+import qualified HaskellWorks.Data.Simd.Logical.Avx2     as AVX2+import qualified HaskellWorks.Data.Simd.Logical.Stock    as STOCK import qualified System.Directory                        as IO -runCmpeq8Avx2 :: FilePath -> IO [DVS.Vector Word64]-runCmpeq8Avx2 filePath = do+runCmpEqWord8sAvx2 :: FilePath -> IO [DVS.Vector Word64]+runCmpEqWord8sAvx2 filePath = do   bs <- LBS.readFile filePath   let vs = asVector64s 64 bs   return $ if CAP.avx2Enabled-    then AVX2.cmpeq8s (fromIntegral (ord '8')) <$> vs+    then AVX2.cmpEqWord8s (fromIntegral (ord '8')) <$> vs     else [] -runCmpeq8Stock :: FilePath -> IO [DVS.Vector Word64]-runCmpeq8Stock filePath = do+runCmpEqWord8sStock :: FilePath -> IO [DVS.Vector Word64]+runCmpEqWord8sStock filePath = do   bs <- LBS.readFile filePath   let vs = asVector64s 64 bs-  return $ STOCK.cmpeq8s (fromIntegral (ord '8')) <$> vs+  return $ STOCK.cmpEqWord8s (fromIntegral (ord '8')) <$> vs -benchCmpeq8 :: IO [Benchmark]-benchCmpeq8 = do+runAndBitsAvx2 :: FilePath -> IO [DVS.Vector Word64]+runAndBitsAvx2 filePath = do+  bs <- LBS.readFile filePath+  let vs = asVector64s 64 bs+  return $ (\v -> AVX2.andBits v v) <$> vs++runAndBitsStock :: FilePath -> IO [DVS.Vector Word64]+runAndBitsStock filePath = do+  bs <- LBS.readFile filePath+  let vs = asVector64s 64 bs+  return $ (\v -> STOCK.andBits v v) <$> vs++benchcmpEqWord8s :: IO [Benchmark]+benchcmpEqWord8s = do   entries <- IO.listDirectory "data/bench"   let files = ("data/bench/" ++) <$> (".csv" `isSuffixOf`) `filter` entries   benchmarks <- forM files $ \file -> return $ mempty-    <> [bench ("hw-simd/cmpeq8/avx2/"  <> file) (nfIO (runCmpeq8Avx2  file))]-    <> [bench ("hw-simd/cmpeq8/stock/" <> file) (nfIO (runCmpeq8Stock file))]+    <> [bench ("hw-simd/cmpEqWord8s/avx2/"  <> file) (nfIO (runCmpEqWord8sAvx2  file))]+    <> [bench ("hw-simd/cmpEqWord8s/stock/" <> file) (nfIO (runCmpEqWord8sStock file))]   return (join benchmarks) +benchAndBits :: IO [Benchmark]+benchAndBits = do+  entries <- IO.listDirectory "data/bench"+  let files = ("data/bench/" ++) <$> (".csv" `isSuffixOf`) `filter` entries+  benchmarks <- forM files $ \file -> return $ mempty+    <> [bench ("hw-simd/andBits/avx2/"  <> file) (nfIO (runAndBitsAvx2  file))]+    <> [bench ("hw-simd/andBits/stock/" <> file) (nfIO (runAndBitsStock file))]+  return (join benchmarks)+ main :: IO () main = do   benchmarks <- (mconcat <$>) $ sequence $ mempty-    <> [benchCmpeq8]+    <> [benchcmpEqWord8s]+    <> [benchAndBits]   defaultMain benchmarks
− cbits/simd.c
@@ -1,112 +0,0 @@-#include "simd.h"--#include <immintrin.h>-#include <mmintrin.h>-#include <stdint.h>-#include <stdio.h>-#include <stdlib.h>-#include <string.h>-#include <unistd.h>-#include <ctype.h>--typedef uint8_t v32si __attribute__ ((vector_size (32)));-typedef uint8_t v16si __attribute__ ((vector_size (16)));--void print_bits_16(uint16_t word) {-  size_t i;--  putc('|', stdout);--  for (i = 0; i < 16; ++i) {-    putc((word & (1L << i)) ? '1' : '0', stdout);-  }-  printf("|\n");-}--void system_memcpy(-    char *target,-    char *source,-    size_t len) {-  memcpy(target, source, len);-}--void avx2_memcpy(-    uint8_t *target,-    uint8_t *source,-    size_t len) {-#if defined(AVX2_ENABLED)-  size_t aligned_len    = (len / 32) * 32;-  size_t remaining_len  = len - aligned_len;--  size_t i;--  for (i = 0; i < aligned_len; i += 32) {-    __m128i v0 = *(__m128i*)(source + i     );-    __m128i v1 = *(__m128i*)(source + i + 16);--    *(__m128i*)(target + i      ) = v0;-    *(__m128i*)(target + i + 16 ) = v1;-  }--  memcpy(target + aligned_len, source + aligned_len, remaining_len);-#endif-}---void sse_cmpeq8(-    uint8_t byte,-    uint64_t *target,-    size_t target_length,-    uint8_t *source) {-  uint16_t *target16 = (uint16_t *)target;--  __m128i v_comparand = _mm_set1_epi8(byte);--  uint16_t *out_mask = (uint16_t*)target;-  size_t i;--  for (i = 0; i < target_length * 4; ++i) {-    __m128i v_data_a = *(__m128i*)(source + (i * 16));-    __m128i v_results_a = _mm_cmpeq_epi8(v_data_a, v_comparand);-    uint16_t mask = (uint16_t)_mm_movemask_epi8(v_results_a);-    target16[i] = mask;-  }-}--void avx2_cmpeq8(-    uint8_t byte,-    uint64_t *target,-    size_t target_length,-    uint8_t *source) {-#if defined(AVX2_ENABLED)-  uint32_t *target32 = (uint32_t *)target;--  __m256 v_comparand = _mm256_set1_epi8(byte);--  uint32_t *out_mask = (uint32_t*)target;--  size_t i;--  for (i = 0; i < target_length * 2; ++i) {-    __m256 v_data_a = *(__m256*)(source + (i * 32));-    __m256 v_results_a = _mm256_cmpeq_epi8(v_data_a, v_comparand);-    uint32_t mask = (uint32_t)_mm256_movemask_epi8(v_results_a);-    target32[i] = mask;-  }-#endif-}--int example_main() {-  uint8_t source[32] = "01234567890123456789012345678901";-  uint8_t target[33];-  avx2_memcpy(target, source, 32);-  target[32] = 0;-  printf("%s\n", target);--  // uint8_t source2[64] = "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef";-  // uint64_t target2[1] = {0};-  // avx2_cmpeq8('0', target2, 1, source2);-  // printf("%llu\n", target2[0]);--  return 0;-}
cbits/simd.h view
@@ -1,6 +1,9 @@ #include <unistd.h> #include <stdint.h> +typedef uint8_t v32si __attribute__ ((vector_size (32)));+typedef uint8_t v16si __attribute__ ((vector_size (16)));+ void avx2_memcpy(     uint8_t *target,     uint8_t *source,@@ -11,3 +14,38 @@     uint64_t *target,     size_t target_length,     uint8_t *source);++void avx2_cmpeq8(+    uint8_t byte,+    uint64_t *target,+    size_t target_length,+    uint8_t *source);++void avx2_and_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source_a,+    uint8_t *source_b);++void avx2_and_not_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source_a,+    uint8_t *source_b);++void avx2_not_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source);++void avx2_or_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source_a,+    uint8_t *source_b);++void avx2_xor_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source_a,+    uint8_t *source_b);
+ cbits/simd_avx2.c view
@@ -0,0 +1,140 @@+#include "simd.h"++#include <immintrin.h>+#include <mmintrin.h>+#include <stdint.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <unistd.h>+#include <ctype.h>++void avx2_memcpy(+    uint8_t *target,+    uint8_t *source,+    size_t len) {+#if defined(AVX2_ENABLED)+  size_t aligned_len    = (len / 32) * 32;+  size_t remaining_len  = len - aligned_len;++  size_t i;++  for (i = 0; i < aligned_len; i += 32) {+    __m128i v0 = *(__m128i*)(source + i     );+    __m128i v1 = *(__m128i*)(source + i + 16);++    *(__m128i*)(target + i      ) = v0;+    *(__m128i*)(target + i + 16 ) = v1;+  }++  memcpy(target + aligned_len, source + aligned_len, remaining_len);+#endif+}++void avx2_cmpeq8(+    uint8_t byte,+    uint64_t *target,+    size_t target_length,+    uint8_t *source) {+#if defined(AVX2_ENABLED)+  uint32_t *target32 = (uint32_t *)target;++  __m256 v_comparand = _mm256_set1_epi8(byte);++  uint32_t *out_mask = (uint32_t*)target;++  size_t i;++  for (i = 0; i < target_length * 2; ++i) {+    __m256 v_data_a = *(__m256*)(source + (i * 32));+    __m256 v_results_a = _mm256_cmpeq_epi8(v_data_a, v_comparand);+    uint32_t mask = (uint32_t)_mm256_movemask_epi8(v_results_a);+    target32[i] = mask;+  }+#endif+}++void avx2_and_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source_a,+    uint8_t *source_b) {+#if defined(AVX2_ENABLED)+  size_t i;++  for (i = 0; i < target_length; i += 32) {+    __m256 v_data_a   = *(__m256*)(source_a + i);+    __m256 v_data_b   = *(__m256*)(source_b + i);+    __m256 v_results  = _mm256_and_si256(v_data_a, v_data_b);+    *(__m256*)(target + i) = v_results;+  }+#endif+}++void avx2_and_not_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source_a,+    uint8_t *source_b) {+#if defined(AVX2_ENABLED)+  size_t i;++  for (i = 0; i < target_length; i += 32) {+    __m256 v_data_a   = *(__m256*)(source_a + i);+    __m256 v_data_b   = *(__m256*)(source_b + i);+    __m256 v_results  = _mm256_andnot_si256(v_data_a, v_data_b);+    *(__m256*)(target + i) = v_results;+  }+#endif+}++void avx2_not_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source) {+#if defined(AVX2_ENABLED)+  __m256 ones = _mm256_set1_epi8(0xff);++  size_t i;++  for (i = 0; i < target_length; i += 32) {+    __m256 v_data     = *(__m256*)(source + i);+    __m256 v_results  = _mm256_xor_si256(v_data, ones);+    *(__m256*)(target + i) = v_results;+  }+#endif+}++void avx2_or_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source_a,+    uint8_t *source_b) {+#if defined(AVX2_ENABLED)+  size_t i;++  for (i = 0; i < target_length; i += 32) {+    __m256 v_data_a   = *(__m256*)(source_a + i);+    __m256 v_data_b   = *(__m256*)(source_b + i);+    __m256 v_results  = _mm256_or_si256(v_data_a, v_data_b);+    *(__m256*)(target + i) = v_results;+  }+#endif+}++void avx2_xor_bits(+    uint8_t *target,+    size_t target_length,+    uint8_t *source_a,+    uint8_t *source_b) {+#if defined(AVX2_ENABLED)+  size_t i;++  for (i = 0; i < target_length; i += 32) {+    __m256 v_data_a   = *(__m256*)(source_a + i);+    __m256 v_data_b   = *(__m256*)(source_b + i);+    __m256 v_results  = _mm256_xor_si256(v_data_a, v_data_b);+    *(__m256*)(target + i) = v_results;+  }+#endif+}
+ cbits/simd_debug.h view
@@ -0,0 +1,5 @@+typedef uint8_t v32si __attribute__ ((vector_size (32)));++void print_bits_16(uint16_t word);++void print_m256_hex(v32si number);
+ cbits/simd_sse2.c view
@@ -0,0 +1,30 @@+#include "simd.h"++#include <immintrin.h>+#include <mmintrin.h>+#include <stdint.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <unistd.h>+#include <ctype.h>++void sse_cmpeq8(+    uint8_t byte,+    uint64_t *target,+    size_t target_length,+    uint8_t *source) {+  uint16_t *target16 = (uint16_t *)target;++  __m128i v_comparand = _mm_set1_epi8(byte);++  uint16_t *out_mask = (uint16_t*)target;+  size_t i;++  for (i = 0; i < target_length * 4; ++i) {+    __m128i v_data_a = *(__m128i*)(source + (i * 16));+    __m128i v_results_a = _mm_cmpeq_epi8(v_data_a, v_comparand);+    uint16_t mask = (uint16_t)_mm_movemask_epi8(v_results_a);+    target16[i] = mask;+  }+}
hw-simd.cabal view
@@ -3,10 +3,10 @@ -- see: https://github.com/sol/hpack  name:           hw-simd-version:        0.0.0.3+version:        0.1.0.0 synopsis:       SIMD library description:    Please see the README on Github at <https://github.com/haskell-works/hw-simd#readme>-category:       Text, Web, CSV+category:       Data, Bit, SIMD homepage:       https://github.com/haskell-works/hw-simd#readme bug-reports:    https://github.com/haskell-works/hw-simd/issues author:         John Ky@@ -20,6 +20,7 @@  extra-source-files:     cbits/simd.h+    cbits/simd_debug.h     ChangeLog.md     README.md @@ -49,7 +50,8 @@   include-dirs:       cbits   c-sources:-      cbits/simd.c+      cbits/simd_avx2.c+      cbits/simd_sse2.c   build-depends:       base                  >= 4.7      && < 5     , bits-extra            >= 0.0.1.2  && < 0.1@@ -90,6 +92,10 @@       HaskellWorks.Data.Simd.Internal.ByteString       HaskellWorks.Data.Simd.Internal.ByteString.Lazy       HaskellWorks.Data.Simd.Internal.Foreign+      HaskellWorks.Data.Simd.Internal.Marshal+      HaskellWorks.Data.Simd.Logical+      HaskellWorks.Data.Simd.Logical.Avx2+      HaskellWorks.Data.Simd.Logical.Stock   other-modules:       Paths_hw_simd   default-language: Haskell2010@@ -111,10 +117,12 @@     , hw-prim               >= 0.6.2.0  && < 0.7     , vector                >= 0.12.0.1 && < 0.13     , directory               >= 1.2.2      && < 1.4+    , lens     , hw-simd     , hedgehog                >= 0.5        && < 0.7     , hspec                   >= 2.4        && < 3     , hw-hspec-hedgehog       >= 0.1.0.4    && < 0.2+    , hw-hedgehog             >= 0.1.0.1    && < 0.2     , text                    >= 1.2.2      && < 2.0   if flag(sse42)     ghc-options: -msse4.2@@ -135,7 +143,9 @@         transformers          >= 0.4        && < 0.6       , semigroups            >= 0.8.4      && < 0.19   other-modules:-      HaskellWorks.Data.Simd.BroadwordSpec+      HaskellWorks.Data.Simd.ComparisonSpec+      HaskellWorks.Data.Simd.Internal.BroadwordSpec+      HaskellWorks.Data.Simd.LogicalSpec   default-language: Haskell2010  benchmark bench
src/HaskellWorks/Data/Simd/Comparison.hs view
@@ -1,6 +1,9 @@-{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiWayIf        #-} -module HaskellWorks.Data.Simd.Comparison where+module HaskellWorks.Data.Simd.Comparison+  ( CmpEqWord8s(..)+  ) where  import Data.Word import HaskellWorks.Data.Simd.Capabilities@@ -9,8 +12,11 @@ import qualified HaskellWorks.Data.Simd.Comparison.Avx2  as AVX2 import qualified HaskellWorks.Data.Simd.Comparison.Stock as STOCK -cmpeq8s :: Word8 -> DVS.Vector Word64 -> DVS.Vector Word64-cmpeq8s w bs = if-  | avx2Enabled -> AVX2.cmpeq8s w bs-  | True        -> STOCK.cmpeq8s w bs-{-# INLINE cmpeq8s #-}+class CmpEqWord8s a where+  cmpEqWord8s :: Word8 -> a -> a++instance CmpEqWord8s (DVS.Vector Word64) where+  cmpEqWord8s w bs = if+    | avx2Enabled -> AVX2.cmpEqWord8s w bs+    | True        -> STOCK.cmpEqWord8s w bs+  {-# INLINE cmpEqWord8s #-}
src/HaskellWorks/Data/Simd/Comparison/Avx2.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleInstances #-}  module HaskellWorks.Data.Simd.Comparison.Avx2 where @@ -13,21 +14,28 @@  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} -cmpeq8s :: Word8 -> DVS.Vector Word64 -> DVS.Vector Word64-cmpeq8s w8 v = case DVS.unsafeCast v :: DVS.Vector Word8 of-  u -> case DVS.unsafeToForeignPtr u of-    (srcFptr, srcOffset, srcLength) -> if disalignment == 0-      then F.unsafeLocalState $ do-        targetFptr <- F.mallocForeignPtrBytes srcLength-        F.withForeignPtr srcFptr $ \srcPtr -> do-          F.withForeignPtr targetFptr $ \targetPtr -> do-            _ <- F.avx2Cmpeq8-              (fromIntegral w8)-              (F.castPtr targetPtr `F.plusPtr` srcOffset)-              (fromIntegral w64sLen)-              (F.castPtr srcPtr)-            return $ DVS.unsafeFromForeignPtr targetFptr 0 w64sLen-      else error $ "Unaligned byte string: " <> show disalignment-      where w64sLen       = srcLength `div` 64-            disalignment  = srcLength - w64sLen * 64-{-# INLINE cmpeq8s #-}+class CmpEqWord8s a where+  cmpEqWord8s :: Word8 -> a -> a++instance CmpEqWord8s (DVS.Vector Word64) where+  cmpEqWord8s w8 v = case DVS.unsafeCast v :: DVS.Vector Word8 of+    u -> case DVS.unsafeToForeignPtr u of+      (srcFptr, srcOffset, srcLength) -> if disalignment == 0+        then F.unsafeLocalState $ do+          targetFptr <- F.mallocForeignPtrBytes srcLength+          F.withForeignPtr srcFptr $ \srcPtr -> do+            F.withForeignPtr targetFptr $ \targetPtr -> do+              _ <- F.avx2Cmpeq8+                (fromIntegral w8)+                (F.castPtr targetPtr)+                (fromIntegral w64sLen)+                (F.castPtr srcPtr `F.plusPtr` srcOffset)+              return $ DVS.unsafeFromForeignPtr targetFptr 0 w64sLen+        else error $ "Unaligned byte string: " <> show disalignment+        where w64sLen       = srcLength `div` 64+              disalignment  = srcLength - w64sLen * 64+  {-# INLINE cmpEqWord8s #-}++instance CmpEqWord8s [DVS.Vector Word64] where+  cmpEqWord8s w8 vs = cmpEqWord8s w8 <$> vs+  {-# INLINE cmpEqWord8s #-}
src/HaskellWorks/Data/Simd/Comparison/Stock.hs view
@@ -1,5 +1,7 @@+{-# LANGUAGE FlexibleInstances #-}+ module HaskellWorks.Data.Simd.Comparison.Stock-  ( cmpeq8s+  ( CmpEqWord8s(..)   ) where  import Data.Word@@ -10,46 +12,53 @@  import qualified Data.Vector.Storable as DVS -cmpeq8s :: Word8 -> DVS.Vector Word64 -> DVS.Vector Word64-cmpeq8s w8 v = DVS.constructN ((DVS.length v + 7) `div` 8) go-  where iw = fillWord64 w8-        go :: DVS.Vector Word64 -> Word64-        go u = let ui = end u in-          if ui * 8 + 8 < end v-            then  let vi  = ui * 8-                      w0  = testWord8s ((v !!! (vi + 0)) .^. iw)-                      w1  = testWord8s ((v !!! (vi + 1)) .^. iw)-                      w2  = testWord8s ((v !!! (vi + 2)) .^. iw)-                      w3  = testWord8s ((v !!! (vi + 3)) .^. iw)-                      w4  = testWord8s ((v !!! (vi + 4)) .^. iw)-                      w5  = testWord8s ((v !!! (vi + 5)) .^. iw)-                      w6  = testWord8s ((v !!! (vi + 6)) .^. iw)-                      w7  = testWord8s ((v !!! (vi + 7)) .^. iw)-                      w   = (w7 .<. 56) .|.-                            (w6 .<. 48) .|.-                            (w5 .<. 40) .|.-                            (w4 .<. 32) .|.-                            (w3 .<. 24) .|.-                            (w2 .<. 16) .|.-                            (w1 .<.  8) .|.+class CmpEqWord8s a where+  cmpEqWord8s :: Word8 -> a -> a++instance CmpEqWord8s (DVS.Vector Word64) where+  cmpEqWord8s w8 v = DVS.constructN ((DVS.length v + 7) `div` 8) go+    where iw = fillWord64 w8+          go :: DVS.Vector Word64 -> Word64+          go u = let ui = end u in+            if ui * 8 + 8 < end v+              then  let vi  = ui * 8+                        w0  = testWord8s ((v !!! (vi + 0)) .^. iw)+                        w1  = testWord8s ((v !!! (vi + 1)) .^. iw)+                        w2  = testWord8s ((v !!! (vi + 2)) .^. iw)+                        w3  = testWord8s ((v !!! (vi + 3)) .^. iw)+                        w4  = testWord8s ((v !!! (vi + 4)) .^. iw)+                        w5  = testWord8s ((v !!! (vi + 5)) .^. iw)+                        w6  = testWord8s ((v !!! (vi + 6)) .^. iw)+                        w7  = testWord8s ((v !!! (vi + 7)) .^. iw)+                        w   = (w7 .<. 56) .|.+                              (w6 .<. 48) .|.+                              (w5 .<. 40) .|.+                              (w4 .<. 32) .|.+                              (w3 .<. 24) .|.+                              (w2 .<. 16) .|.+                              (w1 .<.  8) .|.+                                w0+                    in comp w+              else  let vi  = ui * 8+                        w0  = testWord8s (atIndexOr 0 v (vi + 0) .^. iw)+                        w1  = testWord8s (atIndexOr 0 v (vi + 1) .^. iw)+                        w2  = testWord8s (atIndexOr 0 v (vi + 2) .^. iw)+                        w3  = testWord8s (atIndexOr 0 v (vi + 3) .^. iw)+                        w4  = testWord8s (atIndexOr 0 v (vi + 4) .^. iw)+                        w5  = testWord8s (atIndexOr 0 v (vi + 5) .^. iw)+                        w6  = testWord8s (atIndexOr 0 v (vi + 6) .^. iw)+                        w7  = testWord8s (atIndexOr 0 v (vi + 7) .^. iw)+                        w   = (w7 .<. 56) .|.+                              (w6 .<. 48) .|.+                              (w5 .<. 40) .|.+                              (w4 .<. 32) .|.+                              (w3 .<. 24) .|.+                              (w2 .<. 16) .|.+                              (w1 .<.  8) .|.                               w0-                  in comp w-            else  let vi  = ui * 8-                      w0  = testWord8s (atIndexOr 0 v (vi + 0) .^. iw)-                      w1  = testWord8s (atIndexOr 0 v (vi + 1) .^. iw)-                      w2  = testWord8s (atIndexOr 0 v (vi + 2) .^. iw)-                      w3  = testWord8s (atIndexOr 0 v (vi + 3) .^. iw)-                      w4  = testWord8s (atIndexOr 0 v (vi + 4) .^. iw)-                      w5  = testWord8s (atIndexOr 0 v (vi + 5) .^. iw)-                      w6  = testWord8s (atIndexOr 0 v (vi + 6) .^. iw)-                      w7  = testWord8s (atIndexOr 0 v (vi + 7) .^. iw)-                      w   = (w7 .<. 56) .|.-                            (w6 .<. 48) .|.-                            (w5 .<. 40) .|.-                            (w4 .<. 32) .|.-                            (w3 .<. 24) .|.-                            (w2 .<. 16) .|.-                            (w1 .<.  8) .|.-                            w0-                  in comp w-{-# INLINE cmpeq8s #-}+                    in comp w+  {-# INLINE cmpEqWord8s #-}++instance CmpEqWord8s [DVS.Vector Word64] where+  cmpEqWord8s w8 vs = cmpEqWord8s w8 <$> vs+  {-# INLINE cmpEqWord8s #-}
src/HaskellWorks/Data/Simd/Internal/Foreign.chs view
@@ -20,3 +20,28 @@ avx2Cmpeq8 byte target targetLength source = requireAvx2 $ do   {#call unsafe avx2_cmpeq8 as c_cmpeq8#} byte target targetLength source {-# INLINE avx2Cmpeq8 #-}++avx2AndBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO ()+avx2AndBits target targetLength source_a source_b = requireAvx2 $ do+  {#call unsafe avx2_and_bits as c_avx2_and_bits#} target targetLength source_a source_b+{-# INLINE avx2AndBits #-}++avx2AndNotBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO ()+avx2AndNotBits target targetLength source_a source_b = requireAvx2 $ do+  {#call unsafe avx2_and_not_bits as c_avx2_and_not_bits#} target targetLength source_a source_b+{-# INLINE avx2AndNotBits #-}++avx2NotBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> IO ()+avx2NotBits target targetLength source = requireAvx2 $ do+  {#call unsafe avx2_not_bits as c_avx2_not_bits#} target targetLength source+{-# INLINE avx2NotBits #-}++avx2OrBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO ()+avx2OrBits target targetLength source_a source_b = requireAvx2 $ do+  {#call unsafe avx2_or_bits as c_avx2_or_bits#} target targetLength source_a source_b+{-# INLINE avx2OrBits #-}++avx2XorBits :: Ptr UInt8 -> Size -> Ptr UInt8 -> Ptr UInt8 -> IO ()+avx2XorBits target targetLength source_a source_b = requireAvx2 $ do+  {#call unsafe avx2_xor_bits as c_avx2_xor_bits#} target targetLength source_a source_b+{-# INLINE avx2XorBits #-}
+ src/HaskellWorks/Data/Simd/Internal/Marshal.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.Simd.Internal.Marshal where++import Data.Monoid ((<>))+import Data.Word++import qualified Data.Vector.Storable as DVS+import qualified Foreign.ForeignPtr   as F++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++unsafeToElemSizedForeignPtr :: Int -> DVS.Vector Word64 -> (F.ForeignPtr Word8, Int, Int)+unsafeToElemSizedForeignPtr elemSize v = case DVS.unsafeCast v :: DVS.Vector Word8 of+  au -> case DVS.unsafeToForeignPtr au of+    t@(_, _, srcALength) -> if sizeMismatch == 0+      then t+      else error $ "Byte string with mismatched element size: " <> show sizeMismatch+      where w64sLen       = srcALength `div` elemSize+            sizeMismatch  = srcALength - w64sLen * elemSize
+ src/HaskellWorks/Data/Simd/Logical.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiWayIf        #-}++module HaskellWorks.Data.Simd.Logical+  ( XorBits(..)+  , OrBits(..)+  , AndBits(..)+  , AndNotBits(..)+  , NotBits(..)+  ) where++import Data.Word+import HaskellWorks.Data.Simd.Capabilities++import qualified Data.Vector.Storable                 as DVS+import qualified HaskellWorks.Data.Simd.Logical.Avx2  as AVX2+import qualified HaskellWorks.Data.Simd.Logical.Stock as STOCK++class XorBits a where+  xorBits :: a -> a -> a++instance XorBits (DVS.Vector Word64) where+  xorBits a b = if+    | avx2Enabled -> AVX2.xorBits  a b+    | True        -> STOCK.xorBits a b+  {-# INLINE xorBits #-}++class OrBits a where+  orBits :: a -> a -> a++instance OrBits (DVS.Vector Word64) where+  orBits a b = if+    | avx2Enabled -> AVX2.orBits  a b+    | True        -> STOCK.orBits a b+  {-# INLINE orBits #-}++class AndBits a where+  andBits :: a -> a -> a++instance AndBits (DVS.Vector Word64) where+  andBits a b = if+    | avx2Enabled -> AVX2.andBits  a b+    | True        -> STOCK.andBits a b+  {-# INLINE andBits #-}++class AndNotBits a where+  andNotBits :: a -> a -> a++instance AndNotBits (DVS.Vector Word64) where+  andNotBits a b = if+    | avx2Enabled -> AVX2.andNotBits  a b+    | True        -> STOCK.andNotBits a b+  {-# INLINE andNotBits #-}++class NotBits a where+  notBits :: a -> a++instance NotBits (DVS.Vector Word64) where+  notBits a = if+    | avx2Enabled -> AVX2.notBits  a+    | True        -> STOCK.notBits a+  {-# INLINE notBits #-}+
+ src/HaskellWorks/Data/Simd/Logical/Avx2.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.Simd.Logical.Avx2 where++import Data.Word+import HaskellWorks.Data.Simd.Internal.Marshal++import qualified Data.Vector.Storable                    as DVS+import qualified Foreign.ForeignPtr                      as F+import qualified Foreign.Marshal.Unsafe                  as F+import qualified Foreign.Ptr                             as F+import qualified HaskellWorks.Data.Simd.Internal.Foreign as F++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class XorBits a where+  xorBits :: a -> a -> a++instance XorBits (DVS.Vector Word64) where+  xorBits a b = F.unsafeLocalState $ do+    let (srcAFptr, srcAOffset, srcALength) = unsafeToElemSizedForeignPtr 64 a+    let (srcBFptr, srcBOffset, srcBLength) = unsafeToElemSizedForeignPtr 64 b+    targetFptr <- F.mallocForeignPtrBytes srcALength+    F.withForeignPtr srcAFptr $ \srcAPtr -> do+      F.withForeignPtr srcBFptr $ \srcBPtr -> do+        F.withForeignPtr targetFptr $ \targetPtr -> do+          _ <- F.avx2XorBits+            (F.castPtr targetPtr)+            (fromIntegral (srcALength `min` srcBLength))+            (F.castPtr srcAPtr `F.plusPtr` srcAOffset)+            (F.castPtr srcBPtr `F.plusPtr` srcBOffset)+          return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcALength :: DVS.Vector Word8)+  {-# INLINE xorBits #-}++instance XorBits [DVS.Vector Word64] where+  xorBits = zipWith xorBits+  {-# INLINE xorBits #-}++class OrBits a where+  orBits :: a -> a -> a++instance OrBits (DVS.Vector Word64) where+  orBits a b = F.unsafeLocalState $ do+    let (srcAFptr, srcAOffset, srcALength) = unsafeToElemSizedForeignPtr 64 a+    let (srcBFptr, srcBOffset, srcBLength) = unsafeToElemSizedForeignPtr 64 b+    targetFptr <- F.mallocForeignPtrBytes srcALength+    F.withForeignPtr srcAFptr $ \srcAPtr -> do+      F.withForeignPtr srcBFptr $ \srcBPtr -> do+        F.withForeignPtr targetFptr $ \targetPtr -> do+          _ <- F.avx2OrBits+            (F.castPtr targetPtr)+            (fromIntegral (srcALength `min` srcBLength))+            (F.castPtr srcAPtr `F.plusPtr` srcAOffset)+            (F.castPtr srcBPtr `F.plusPtr` srcBOffset)+          return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcALength :: DVS.Vector Word8)+  {-# INLINE orBits #-}++instance OrBits [DVS.Vector Word64] where+  orBits = zipWith orBits+  {-# INLINE orBits #-}++class AndBits a where+  andBits :: a -> a -> a++instance AndBits (DVS.Vector Word64) where+  andBits a b = F.unsafeLocalState $ do+    let (srcAFptr, srcAOffset, srcALength) = unsafeToElemSizedForeignPtr 64 a+    let (srcBFptr, srcBOffset, srcBLength) = unsafeToElemSizedForeignPtr 64 b+    targetFptr <- F.mallocForeignPtrBytes srcALength+    F.withForeignPtr srcAFptr $ \srcAPtr -> do+      F.withForeignPtr srcBFptr $ \srcBPtr -> do+        F.withForeignPtr targetFptr $ \targetPtr -> do+          _ <- F.avx2AndBits+            (F.castPtr targetPtr)+            (fromIntegral (srcALength `min` srcBLength))+            (F.castPtr srcAPtr `F.plusPtr` srcAOffset)+            (F.castPtr srcBPtr `F.plusPtr` srcBOffset)+          return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcALength :: DVS.Vector Word8)+  {-# INLINE andBits #-}++instance AndBits [DVS.Vector Word64] where+  andBits = zipWith andBits+  {-# INLINE andBits #-}++class AndNotBits a where+  andNotBits :: a -> a -> a++instance AndNotBits (DVS.Vector Word64) where+  andNotBits a b = F.unsafeLocalState $ do+    let (srcAFptr, srcAOffset, srcALength) = unsafeToElemSizedForeignPtr 64 a+    let (srcBFptr, srcBOffset, srcBLength) = unsafeToElemSizedForeignPtr 64 b+    targetFptr <- F.mallocForeignPtrBytes srcALength+    F.withForeignPtr srcAFptr $ \srcAPtr -> do+      F.withForeignPtr srcBFptr $ \srcBPtr -> do+        F.withForeignPtr targetFptr $ \targetPtr -> do+          _ <- F.avx2AndNotBits+            (F.castPtr targetPtr)+            (fromIntegral (srcALength `min` srcBLength))+            (F.castPtr srcAPtr `F.plusPtr` srcAOffset)+            (F.castPtr srcBPtr `F.plusPtr` srcBOffset)+          return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcALength :: DVS.Vector Word8)+  {-# INLINE andNotBits #-}++instance AndNotBits [DVS.Vector Word64] where+  andNotBits = zipWith andBits+  {-# INLINE andNotBits #-}++class NotBits a where+  notBits :: a -> a++instance NotBits (DVS.Vector Word64) where+  notBits a = F.unsafeLocalState $ do+    let (srcFptr, srcOffset, srcLength) = unsafeToElemSizedForeignPtr 64 a+    targetFptr <- F.mallocForeignPtrBytes srcLength+    F.withForeignPtr srcFptr $ \srcPtr -> do+      F.withForeignPtr targetFptr $ \targetPtr -> do+        _ <- F.avx2NotBits+          (F.castPtr targetPtr)+          (fromIntegral srcLength)+          (F.castPtr srcPtr `F.plusPtr` srcOffset)+        return $ DVS.unsafeCast (DVS.unsafeFromForeignPtr targetFptr 0 srcLength :: DVS.Vector Word8)+  {-# INLINE notBits #-}++instance NotBits [DVS.Vector Word64] where+  notBits = fmap notBits+  {-# INLINE notBits #-}
+ src/HaskellWorks/Data/Simd/Logical/Stock.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.Simd.Logical.Stock where++import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitWise++import qualified Data.Vector.Storable as DVS++class XorBits a where+  xorBits :: a -> a -> a++instance XorBits (DVS.Vector Word64) where+  xorBits a b = DVS.constructN (DVS.length a `min` DVS.length b) go+    where go v = (a !!! i) .^. (b !!! i)+            where i = end v+  {-# INLINE xorBits #-}++instance XorBits [DVS.Vector Word64] where+  xorBits = zipWith xorBits+  {-# INLINE xorBits #-}++class OrBits a where+  orBits :: a -> a -> a++instance OrBits (DVS.Vector Word64) where+  orBits a b = DVS.constructN (DVS.length a `min` DVS.length b) go+    where go v = (a !!! i) .|. (b !!! i)+            where i = end v+  {-# INLINE orBits #-}++instance OrBits [DVS.Vector Word64] where+  orBits = zipWith orBits+  {-# INLINE orBits #-}++class AndBits a where+  andBits :: a -> a -> a++instance AndBits (DVS.Vector Word64) where+  andBits a b = DVS.constructN (DVS.length a `min` DVS.length b) go+    where go v = (a !!! i) .&. (b !!! i)+            where i = end v+  {-# INLINE andBits #-}++instance AndBits [DVS.Vector Word64] where+  andBits = zipWith andBits+  {-# INLINE andBits #-}++class AndNotBits a where+  andNotBits :: a -> a -> a++instance AndNotBits (DVS.Vector Word64) where+  andNotBits a b = DVS.constructN (DVS.length a `min` DVS.length b) go+    where go v = (a !!! i) .&. comp (b !!! i)+            where i = end v+  {-# INLINE andNotBits #-}++instance AndNotBits [DVS.Vector Word64] where+  andNotBits = zipWith andBits+  {-# INLINE andNotBits #-}++class NotBits a where+  notBits :: a -> a++instance NotBits (DVS.Vector Word64) where+  notBits a = DVS.constructN (DVS.length a) go+    where go v = comp (a !!! i)+            where i = end v+  {-# INLINE notBits #-}++instance NotBits [DVS.Vector Word64] where+  notBits = fmap notBits+  {-# INLINE notBits #-}
− test/HaskellWorks/Data/Simd/BroadwordSpec.hs
@@ -1,52 +0,0 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Simd.BroadwordSpec (spec) where--import Data.Maybe                                (fromJust)-import Data.Word-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Simd.Internal.Broadword-import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Test.Hspec--{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: redundant bracket"          :: String) #-}--spec :: Spec-spec = describe "HaskellWorks.Data.Simd.BroadwordSpec" $ do-  it "Case 0" $ requireProperty $ do-    let actual    = toggle64 0 $ fromJust $ bitRead "00100100 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: Word64-    let expected  =              fromJust $ bitRead "11000111 11111111 11111111 11111111 11111111 11111111 11111111 11111111" :: Word64-    bitShow actual === bitShow expected-  it "Case 1" $ requireProperty $ do-    let actual    = toggle64 0 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64-    let expected  =              fromJust $ bitRead "11000111 11111000 00000000 00000000 00000000 00000000 00000011 11110000" :: Word64-    bitShow actual === bitShow expected-  it "Case 1" $ requireProperty $ do-    let actual    = toggle64 1 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64-    let expected  =              fromJust $ bitRead "00111000 00000111 11111111 11111111 11111111 11111111 11111100 00001111" :: Word64-    bitShow actual === bitShow expected--{--    normal case-    ------------    00100100-    11011011--    00010000-    11011011 +--    11000111-    carry case-    ------------    00100100-    11011011-      |  |-    10000010-    11011011 +-    00111000--}
+ test/HaskellWorks/Data/Simd/ComparisonSpec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Simd.ComparisonSpec (spec) where++import Control.Lens+import Control.Monad+import Data.Word+import HaskellWorks.Data.Simd.Capabilities+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.Vector.Storable                    as DVS+import qualified HaskellWorks.Data.Simd.Comparison.Avx2  as AVX+import qualified HaskellWorks.Data.Simd.Comparison.Stock as STK+import qualified HaskellWorks.Hedgehog.Gen               as G+import qualified Hedgehog.Gen                            as G+import qualified Hedgehog.Range                          as R++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: redundant bracket"          :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Simd.ComparisonSpec" $ do+  when avx2Enabled $ do+    describe "cmpEqWord8s" $ do+      it "AVX2" $ requireProperty $ do+        w <- forAll $ G.word8 R.constantBounded+        vs :: [DVS.Vector Word64] <- forAll+          $ G.list (R.linear 0 5)+          $ (\g -> G.list (R.linear 0 4) g <&> join <&> DVS.fromList)+          $ G.list (R.linear 8 8)+          $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded])+        AVX.cmpEqWord8s w vs === STK.cmpEqWord8s w vs+        vs === vs
+ test/HaskellWorks/Data/Simd/Internal/BroadwordSpec.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Simd.Internal.BroadwordSpec (spec) where++import Data.Maybe                                (fromJust)+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Simd.Internal.Broadword+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: redundant bracket"          :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Simd.Internal.BroadwordSpec" $ do+  it "Case 0" $ requireProperty $ do+    let actual    = toggle64 0 $ fromJust $ bitRead "00100100 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: Word64+    let expected  =              fromJust $ bitRead "11000111 11111111 11111111 11111111 11111111 11111111 11111111 11111111" :: Word64+    bitShow actual === bitShow expected+  it "Case 1" $ requireProperty $ do+    let actual    = toggle64 0 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64+    let expected  =              fromJust $ bitRead "11000111 11111000 00000000 00000000 00000000 00000000 00000011 11110000" :: Word64+    bitShow actual === bitShow expected+  it "Case 1" $ requireProperty $ do+    let actual    = toggle64 1 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64+    let expected  =              fromJust $ bitRead "00111000 00000111 11111111 11111111 11111111 11111111 11111100 00001111" :: Word64+    bitShow actual === bitShow expected++{-+    normal case+    -----------+    00100100+    11011011++    00010000+    11011011 +++    11000111+    carry case+    -----------+    00100100+    11011011+      |  |+    10000010+    11011011 ++    00111000+-}
+ test/HaskellWorks/Data/Simd/LogicalSpec.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Simd.LogicalSpec (spec) where++import Control.Monad+import HaskellWorks.Data.Simd.Capabilities+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Data.Simd.Logical.Avx2  as AVX+import qualified HaskellWorks.Data.Simd.Logical.Stock as STK+import qualified HaskellWorks.Hedgehog.Gen            as G+import qualified Hedgehog.Gen                         as G+import qualified Hedgehog.Range                       as R++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}+{-# ANN module ("HLint: redundant bracket"          :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Simd.LogicalSpec" $ do+  when avx2Enabled $ do+    describe "xorBits" $ do+      it "AVX2" $ requireProperty $ do+        w <- forAll $ G.word8 R.constantBounded+        (us, vs) <- forAll $ do+          listLength  <- G.int (R.linear 0 5)+          blockCount  <- G.int (R.linear 0 4)+          blockSize   <- G.int (R.singleton 8)+          G.tuple2+            $ G.list (R.singleton listLength)+            $ G.storableVector (R.singleton (blockCount * blockSize))+            $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded])+        AVX.xorBits us vs === STK.xorBits us vs+    describe "orBits" $ do+      it "AVX2" $ requireProperty $ do+        w <- forAll $ G.word8 R.constantBounded+        (us, vs) <- forAll $ do+          listLength  <- G.int (R.linear 0 5)+          blockCount  <- G.int (R.linear 0 4)+          blockSize   <- G.int (R.singleton 8)+          G.tuple2+            $ G.list (R.singleton listLength)+            $ G.storableVector (R.singleton (blockCount * blockSize))+            $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded])+        AVX.orBits us vs === STK.orBits us vs+    describe "andBits" $ do+      it "AVX2" $ requireProperty $ do+        w <- forAll $ G.word8 R.constantBounded+        (us, vs) <- forAll $ do+          listLength  <- G.int (R.linear 0 5)+          blockCount  <- G.int (R.linear 0 4)+          blockSize   <- G.int (R.singleton 8)+          G.tuple2+            $ G.list (R.singleton listLength)+            $ G.storableVector (R.singleton (blockCount * blockSize))+            $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded])+        AVX.andBits us vs === STK.andBits us vs+    describe "andNotBits" $ do+      it "AVX2" $ requireProperty $ do+        w <- forAll $ G.word8 R.constantBounded+        (us, vs) <- forAll $ do+          listLength  <- G.int (R.linear 0 5)+          blockCount  <- G.int (R.linear 0 4)+          blockSize   <- G.int (R.singleton 8)+          G.tuple2+            $ G.list (R.singleton listLength)+            $ G.storableVector (R.singleton (blockCount * blockSize))+            $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded])+        AVX.andNotBits us vs === STK.andNotBits us vs+    describe "notBits" $ do+      it "AVX2" $ requireProperty $ do+        w <- forAll $ G.word8 R.constantBounded+        vs <- forAll $ do+          listLength  <- G.int (R.linear 0 5)+          blockCount  <- G.int (R.linear 0 4)+          blockSize   <- G.int (R.singleton 8)+          G.list (R.singleton listLength)+            $ G.storableVector (R.singleton (blockCount * blockSize))+            $ G.word8x8 (G.choice [pure w, G.word8 R.constantBounded])+        AVX.notBits vs === STK.notBits vs