hw-simd (empty) → 0.0.0.2
raw patch · 19 files changed
+702/−0 lines, 19 filesdep +basedep +bits-extradep +bytestringsetup-changed
Dependencies added: base, bits-extra, bytestring, cassava, containers, criterion, deepseq, directory, hedgehog, hspec, hw-bits, hw-hspec-hedgehog, hw-prim, hw-rankselect, hw-rankselect-base, hw-simd, mmap, semigroups, text, transformers, vector
Files
- ChangeLog.md +1/−0
- LICENSE +30/−0
- README.md +3/−0
- Setup.hs +2/−0
- bench/Main.hs +45/−0
- cbits/simd.c +112/−0
- cbits/simd.h +13/−0
- hw-simd.cabal +186/−0
- src/HaskellWorks/Data/Simd/Capabilities.hs +15/−0
- src/HaskellWorks/Data/Simd/Comparison.hs +16/−0
- src/HaskellWorks/Data/Simd/Comparison/Avx2.hs +33/−0
- src/HaskellWorks/Data/Simd/Comparison/Stock.hs +39/−0
- src/HaskellWorks/Data/Simd/Internal/Bits.hs +49/−0
- src/HaskellWorks/Data/Simd/Internal/Broadword.hs +19/−0
- src/HaskellWorks/Data/Simd/Internal/ByteString.hs +53/−0
- src/HaskellWorks/Data/Simd/Internal/ByteString/Lazy.hs +11/−0
- src/HaskellWorks/Data/Simd/Internal/Foreign.chs +22/−0
- test/HaskellWorks/Data/Simd/BroadwordSpec.hs +52/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,1 @@+# Changelog for hw-simd
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of John Ky nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,3 @@+# hw-simd+[](https://circleci.com/gh/haskell-works/hw-simd)+[](https://travis-ci.org/haskell-works/hw-simd)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,45 @@+module Main where++import Control.Monad+import Criterion.Main+import Data.Char+import Data.List+import Data.Semigroup ((<>))+import Data.Word+import HaskellWorks.Data.Vector.AsVector64s++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector.Storable as DVS+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 System.Directory as IO++runCmpeq8Avx2 :: FilePath -> IO [DVS.Vector Word64]+runCmpeq8Avx2 filePath = do+ bs <- LBS.readFile filePath+ let vs = asVector64s 64 bs+ return $ if CAP.avx2Enabled+ then AVX2.cmpeq8s (fromIntegral (ord '8')) <$> vs+ else []++runCmpeq8Stock :: FilePath -> IO [DVS.Vector Word64]+runCmpeq8Stock filePath = do+ bs <- LBS.readFile filePath+ let vs = asVector64s 64 bs+ return $ STOCK.cmpeq8s (fromIntegral (ord '8')) <$> vs++benchCmpeq8 :: IO [Benchmark]+benchCmpeq8 = 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))]+ return (join benchmarks)++main :: IO ()+main = do+ benchmarks <- (mconcat <$>) $ sequence $ mempty+ <> [benchCmpeq8]+ defaultMain benchmarks
+ cbits/simd.c view
@@ -0,0 +1,112 @@+#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
@@ -0,0 +1,13 @@+#include <unistd.h>+#include <stdint.h>++void avx2_memcpy(+ uint8_t *target,+ uint8_t *source,+ size_t len);++void avx2_cmpeq8(+ uint8_t byte,+ uint64_t *target,+ size_t target_length,+ uint8_t *source);
+ hw-simd.cabal view
@@ -0,0 +1,186 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: d4e6b647bff1de25a793f93a5adb597bbbc16d00285948adf0c1aa4f8e3c542f++name: hw-simd+version: 0.0.0.2+synopsis: SIMD library+description: Please see the README on Github at <https://github.com/haskell-works/hw-simd#readme>+category: Text, Web, CSV+homepage: https://github.com/haskell-works/hw-simd#readme+bug-reports: https://github.com/haskell-works/hw-simd/issues+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2018 John Ky+license: BSD3+license-file: LICENSE+tested-with: GHC == 8.4.3, GHC == 8.2.2, GHC == 8.0.2, GHC == 7.10.3+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ cbits/simd.h+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-simd++flag avx2+ description: Enable avx2 instruction set+ manual: False+ default: False++flag bmi2+ description: Enable bmi2 instruction set+ manual: False+ default: False++flag sse42+ description: Enable SSE 4.2 optimisations.+ manual: False+ default: True++library+ hs-source-dirs:+ src+ ghc-options: -O2 -Wall+ include-dirs:+ cbits+ c-sources:+ cbits/simd.c+ build-depends:+ base >=4.7 && <5+ , bits-extra >=0.0.1.2 && <0.1+ , bytestring >=0.10 && <0.11+ , deepseq >=1.4 && <1.5+ , hw-bits >=0.7.0.2 && <0.8+ , hw-prim >=0.6.2.0 && <0.7+ , hw-rankselect >=0.12.0.2 && <0.13+ , hw-rankselect-base >=0.3.2.0 && <0.4+ , vector >=0.12.0.1 && <0.13+ build-tools:+ c2hs+ if flag(sse42)+ ghc-options: -msse4.2+ cc-options: -msse4.2+ if flag(bmi2)+ cc-options: -mbmi2 -DBMI2_ENABLED+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ if flag(avx2)+ cc-options: -mavx2 -DAVX2_ENABLED+ if (flag(avx2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED+ if (impl(ghc >=8.0.1))+ ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ if (!impl(ghc >=8.0.1))+ build-depends:+ semigroups >=0.8.4 && <0.19+ , transformers >=0.4 && <0.6+ exposed-modules:+ HaskellWorks.Data.Simd.Capabilities+ HaskellWorks.Data.Simd.Comparison+ HaskellWorks.Data.Simd.Comparison.Avx2+ HaskellWorks.Data.Simd.Comparison.Stock+ HaskellWorks.Data.Simd.Internal.Bits+ HaskellWorks.Data.Simd.Internal.Broadword+ HaskellWorks.Data.Simd.Internal.ByteString+ HaskellWorks.Data.Simd.Internal.ByteString.Lazy+ HaskellWorks.Data.Simd.Internal.Foreign+ other-modules:+ Paths_hw_simd+ default-language: Haskell2010++test-suite hw-simd-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , bits-extra >=0.0.1.2 && <0.1+ , bytestring >=0.10 && <0.11+ , deepseq >=1.4 && <1.5+ , directory >=1.2.2 && <1.4+ , hedgehog >=0.5 && <0.7+ , hspec >=2.4 && <3+ , hw-bits >=0.7.0.2 && <0.8+ , hw-hspec-hedgehog >=0.1.0.4 && <0.2+ , hw-prim >=0.6.2.0 && <0.7+ , hw-rankselect >=0.12.0.2 && <0.13+ , hw-rankselect-base >=0.3.2.0 && <0.4+ , hw-simd+ , text >=1.2.2 && <2.0+ , vector >=0.12.0.1 && <0.13+ if flag(sse42)+ ghc-options: -msse4.2+ cc-options: -msse4.2+ if flag(bmi2)+ cc-options: -mbmi2 -DBMI2_ENABLED+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ if flag(avx2)+ cc-options: -mavx2 -DAVX2_ENABLED+ if (flag(avx2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED+ if (impl(ghc >=8.0.1))+ ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ if (!impl(ghc >=8.0.1))+ build-depends:+ semigroups >=0.8.4 && <0.19+ , transformers >=0.4 && <0.6+ other-modules:+ HaskellWorks.Data.Simd.BroadwordSpec+ Paths_hw_simd+ default-language: Haskell2010++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ bench+ ghc-options: -O2 -Wall -msse4.2+ build-depends:+ base >=4.7 && <5+ , bits-extra >=0.0.1.2 && <0.1+ , bytestring >=0.10 && <0.11+ , cassava >=0.5.1.0 && <0.6+ , containers+ , criterion >=1.4.1.0 && <1.5+ , deepseq >=1.4 && <1.5+ , directory >=1.3.1.5 && <1.4+ , hw-bits >=0.7.0.2 && <0.8+ , hw-prim >=0.6.2.0 && <0.7+ , hw-rankselect >=0.12.0.2 && <0.13+ , hw-rankselect-base >=0.3.2.0 && <0.4+ , hw-simd+ , mmap >=0.5.9 && <0.6+ , vector >=0.12.0.1 && <0.13+ if flag(sse42)+ ghc-options: -msse4.2+ cc-options: -msse4.2+ if flag(bmi2)+ cc-options: -mbmi2 -DBMI2_ENABLED+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ if flag(avx2)+ cc-options: -mavx2 -DAVX2_ENABLED+ if (flag(avx2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED+ if (impl(ghc >=8.0.1))+ ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ if (!impl(ghc >=8.0.1))+ build-depends:+ semigroups >=0.8.4 && <0.19+ , transformers >=0.4 && <0.6+ other-modules:+ Paths_hw_simd+ default-language: Haskell2010
+ src/HaskellWorks/Data/Simd/Capabilities.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++module HaskellWorks.Data.Simd.Capabilities where++requireAvx2 :: a -> a+requireAvx2 a = if avx2Enabled then a else error "AVX2 not enabled"+{-# INLINE requireAvx2 #-}++avx2Enabled :: Bool+#if defined(AVX2_ENABLED)+avx2Enabled = True+#else+avx2Enabled = False+#endif+{-# INLINE avx2Enabled #-}
+ src/HaskellWorks/Data/Simd/Comparison.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE MultiWayIf #-}++module HaskellWorks.Data.Simd.Comparison where++import Data.Word+import HaskellWorks.Data.Simd.Capabilities++import qualified Data.Vector.Storable as DVS+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 #-}
+ src/HaskellWorks/Data/Simd/Comparison/Avx2.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}++module HaskellWorks.Data.Simd.Comparison.Avx2 where++import Data.Monoid ((<>))+import Data.Word++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) #-}++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 #-}
+ src/HaskellWorks/Data/Simd/Comparison/Stock.hs view
@@ -0,0 +1,39 @@+module HaskellWorks.Data.Simd.Comparison.Stock+ ( cmpeq8s+ ) where++import Data.Monoid ((<>))+import Data.Word+import HaskellWorks.Data.AtIndex+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Simd.Internal.Bits++import qualified Data.Vector.Storable as DVS++cmpeq8s :: Word8 -> DVS.Vector Word64 -> DVS.Vector Word64+cmpeq8s w8 v = if disalignment == 0+ then DVS.constructN (DVS.length v) go+ else error $ "Unaligned byte string: " <> show disalignment <> ", vLen: " <> show vLen+ where vLen = DVS.length v+ disalignment = vLen - (vLen `div` 8) * 8+ w64 = fromIntegral w8 * 0x0101010101010101 :: Word64+ go :: DVS.Vector Word64 -> Word64+ go u = comp w+ where ui = fromIntegral $ DVS.length u+ w0 = testWord8s ((u !!! (ui + 0)) .^. w64)+ w1 = testWord8s ((u !!! (ui + 1)) .^. w64)+ w2 = testWord8s ((u !!! (ui + 2)) .^. w64)+ w3 = testWord8s ((u !!! (ui + 3)) .^. w64)+ w4 = testWord8s ((u !!! (ui + 4)) .^. w64)+ w5 = testWord8s ((u !!! (ui + 5)) .^. w64)+ w6 = testWord8s ((u !!! (ui + 6)) .^. w64)+ w7 = testWord8s ((u !!! (ui + 7)) .^. w64)+ w = (w7 .<. 56) .|.+ (w6 .<. 48) .|.+ (w5 .<. 40) .|.+ (w4 .<. 32) .|.+ (w3 .<. 24) .|.+ (w2 .<. 16) .|.+ (w1 .<. 8) .|.+ w0+{-# INLINE cmpeq8s #-}
+ src/HaskellWorks/Data/Simd/Internal/Bits.hs view
@@ -0,0 +1,49 @@+module HaskellWorks.Data.Simd.Internal.Bits where++import Data.Bits.Pext+import Data.Word+import HaskellWorks.Data.Bits.BitWise++import qualified Data.Vector.Storable as DVS++testWord8s :: Word64 -> Word64+testWord8s w = let w8s = w+ w4s = w8s .|. (w8s .>. 4)+ w2s = w4s .|. (w4s .>. 2)+ w1s = w2s .|. (w2s .>. 1)+ in pext w1s 0x0101010101010101+{-# INLINE testWord8s #-}++zipOr :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+zipOr as bs = DVS.constructN (DVS.length as `max` DVS.length bs) go+ where go :: DVS.Vector Word64 -> Word64+ go u =+ let ui = DVS.length u+ in if ui < DVS.length as && ui < DVS.length bs+ then DVS.unsafeIndex as ui .|. DVS.unsafeIndex bs ui+ else error "Different sized vectors"+{-# INLINE zipOr #-}++zip2Or :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64]+zip2Or (a:as) (b:bs) = zipOr a b:zip2Or as bs+zip2Or (a:as) [] = a:zip2Or as []+zip2Or [] (b:bs) = b:zip2Or [] bs+zip2Or [] [] = []+{-# INLINE zip2Or #-}++zipAnd :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64+zipAnd as bs = DVS.constructN (DVS.length as `max` DVS.length bs) go+ where go :: DVS.Vector Word64 -> Word64+ go u =+ let ui = DVS.length u+ in if ui < DVS.length as && ui < DVS.length bs+ then DVS.unsafeIndex as ui .&. DVS.unsafeIndex bs ui+ else error "Different sized vectors"+{-# INLINE zipAnd #-}++zip2And :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64]+zip2And (a:as) (b:bs) = zipAnd a b:zip2And as bs+zip2And (a:as) [] = a:zip2And as []+zip2And [] (b:bs) = b:zip2And [] bs+zip2And [] [] = []+{-# INLINE zip2And #-}
+ src/HaskellWorks/Data/Simd/Internal/Broadword.hs view
@@ -0,0 +1,19 @@+module HaskellWorks.Data.Simd.Internal.Broadword where++import Data.Bits.Pdep+import Data.Word+import HaskellWorks.Data.Bits.BitWise++class FillWord64 a where+ fillWord64 :: a -> Word64++instance FillWord64 Word8 where+ fillWord64 w = 0x0101010101010101 * fromIntegral w+ {-# INLINE fillWord64 #-}++toggle64 :: Word64 -> Word64 -> Word64+toggle64 carry w =+ let c = carry .&. 0x1+ in let addend = pdep (0x5555555555555555 .<. c) w+ in ((addend .<. 1) .|. c) + comp w+{-# INLINE toggle64 #-}
+ src/HaskellWorks/Data/Simd/Internal/ByteString.hs view
@@ -0,0 +1,53 @@+module HaskellWorks.Data.Simd.Internal.ByteString+ ( toByteString+ , rechunkAlignedAt+ , rechunkPaddedAlignedAt+ ) where++import Data.Monoid ((<>))+import Data.Word++import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import qualified Data.Vector.Storable as DVS++toByteString :: DVS.Vector Word64 -> BS.ByteString+toByteString v = case DVS.unsafeToForeignPtr (DVS.unsafeCast v) of+ (fptr, vOffset, vLength) -> BS.fromForeignPtr fptr vOffset vLength+{-# INLINE toByteString #-}++rechunkAlignedAt :: Int -> [BS.ByteString] -> [BS.ByteString]+rechunkAlignedAt alignment = go+ where go (bs:bss) = case BS.length bs of+ bsLen -> if bsLen < alignment+ then case alignment - bsLen of+ bsNeed -> case bss of+ (cs:css) -> case BS.length cs of+ csLen | csLen > bsNeed -> (bs <> BS.take bsNeed cs ):go (BS.drop bsNeed cs:css)+ csLen | csLen == bsNeed -> (bs <> cs ):go css+ _ | otherwise -> go ((bs <> cs) :css)+ [] -> [bs]+ else case (bsLen `div` alignment) * alignment of+ bsCroppedLen -> if bsCroppedLen == bsLen+ then bs:go bss+ else BS.take bsCroppedLen bs:go (BS.drop bsCroppedLen bs:bss)+ go [] = []+{-# INLINE rechunkAlignedAt #-}++rechunkPaddedAlignedAt :: Int -> [BS.ByteString] -> [BS.ByteString]+rechunkPaddedAlignedAt alignment = go+ where go (bs:bss) = case BS.length bs of+ bsLen -> if bsLen < alignment+ then case alignment - bsLen of+ bsNeed -> case bss of+ (cs:css) -> case BS.length cs of+ csLen | csLen > bsNeed -> (bs <> BS.take bsNeed cs ):go (BS.drop bsNeed cs:css)+ csLen | csLen == bsNeed -> (bs <> cs ):go css+ _ | otherwise -> go ((bs <> cs) :css)+ [] -> [bs <> BS.replicate bsNeed 0]+ else case (bsLen `div` alignment) * alignment of+ bsCroppedLen -> if bsCroppedLen == bsLen+ then bs:go bss+ else BS.take bsCroppedLen bs:go (BS.drop bsCroppedLen bs:bss)+ go [] = []+{-# INLINE rechunkPaddedAlignedAt #-}
+ src/HaskellWorks/Data/Simd/Internal/ByteString/Lazy.hs view
@@ -0,0 +1,11 @@+module HaskellWorks.Data.Simd.Internal.ByteString.Lazy where++import Data.Word++import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.Simd.Internal.ByteString as BS++toByteString :: [DVS.Vector Word64] -> LBS.ByteString+toByteString vs = LBS.fromChunks $ BS.toByteString <$> vs+{-# INLINE toByteString #-}
+ src/HaskellWorks/Data/Simd/Internal/Foreign.chs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++module HaskellWorks.Data.Simd.Internal.Foreign where++import Foreign+import HaskellWorks.Data.Simd.Capabilities++#include "../cbits/simd.h"++type UInt8 = {#type uint8_t#}+type UInt64 = {#type uint64_t#}+type Size = {#type size_t#}++avx2Memcpy :: Ptr UInt8 -> Ptr UInt8 -> Size -> IO ()+avx2Memcpy target source len = requireAvx2 $ do+ {#call unsafe avx2_memcpy as c_build_ibs#} target source len+{-# INLINE avx2Memcpy #-}++avx2Cmpeq8 :: UInt8 -> Ptr UInt64 -> Size -> Ptr UInt8 -> IO ()+avx2Cmpeq8 byte target targetLength source = requireAvx2 $ do+ {#call unsafe avx2_cmpeq8 as c_cmpeq8#} byte target targetLength source+{-# INLINE avx2Cmpeq8 #-}
+ test/HaskellWorks/Data/Simd/BroadwordSpec.hs view
@@ -0,0 +1,52 @@+{-# 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/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}