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 +35/−11
- cbits/simd.c +0/−112
- cbits/simd.h +38/−0
- cbits/simd_avx2.c +140/−0
- cbits/simd_debug.h +5/−0
- cbits/simd_sse2.c +30/−0
- hw-simd.cabal +14/−4
- src/HaskellWorks/Data/Simd/Comparison.hs +13/−7
- src/HaskellWorks/Data/Simd/Comparison/Avx2.hs +27/−19
- src/HaskellWorks/Data/Simd/Comparison/Stock.hs +52/−43
- src/HaskellWorks/Data/Simd/Internal/Foreign.chs +25/−0
- src/HaskellWorks/Data/Simd/Internal/Marshal.hs +20/−0
- src/HaskellWorks/Data/Simd/Logical.hs +63/−0
- src/HaskellWorks/Data/Simd/Logical/Avx2.hs +127/−0
- src/HaskellWorks/Data/Simd/Logical/Stock.hs +74/−0
- test/HaskellWorks/Data/Simd/BroadwordSpec.hs +0/−52
- test/HaskellWorks/Data/Simd/ComparisonSpec.hs +37/−0
- test/HaskellWorks/Data/Simd/Internal/BroadwordSpec.hs +52/−0
- test/HaskellWorks/Data/Simd/LogicalSpec.hs +83/−0
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