bits-extra (empty) → 0.0.0.1
raw patch · 13 files changed
+733/−0 lines, 13 filesdep +basedep +bits-extradep +criterionsetup-changed
Dependencies added: base, bits-extra, criterion, ghc-prim, hedgehog, hspec, hw-hedgehog, hw-hspec-hedgehog, vector
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +257/−0
- Setup.hs +2/−0
- bench/Main.hs +80/−0
- bits-extra.cabal +90/−0
- src/Data/Bits/Pdep.hs +54/−0
- src/Data/Bits/Pdep/Slow.hs +40/−0
- src/Data/Bits/Pext.hs +54/−0
- src/Data/Bits/Pext/Slow.hs +39/−0
- test/Data/Bits/PdepSpec.hs +42/−0
- test/Data/Bits/PextSpec.hs +41/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for bits-extra++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (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 Author name here 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,257 @@+# bits-extra++Useful bitwise operations.++This library exposes support for some BMI2 CPU instructions on some x86 based+CPUs.++Currently support operations include:++* `pdep` - Parallel Deposit+* `pext` - Parallel Extract++These operations are useful for high performance bit manipulation for+applications such as succinct data structures.++In the case where the target CPU architectures do not support these+instruction set, a very slow emulated version of these operations is+provided instead.++## Compilation++It is sufficient to build, test and benchmark the library as follows+for emulated behaviour:++```text+stack build+stack test+stack bench+```++To target the BMI2 instruction set, add the `bmi2` flag:++```text+stack build --flag bits-extra:bmi2+stack test --flag bits-extra:bmi2+stack bench --flag bits-extra:bmi2+```++## Benchmark results++Benchmarks with `bmi2` flag defined on `ghc-8.4.1` on `Intel Core i7 2.9 GHz`++```text+Benchmark bench: RUNNING...+Fast pdep enabled: True+Fast pext enabled: True+benchmarking popCount-single/popCount64+time 6.698 ns (6.634 ns .. 6.766 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 6.750 ns (6.692 ns .. 6.841 ns)+std dev 243.5 ps (195.3 ps .. 347.1 ps)+variance introduced by outliers: 60% (severely inflated)++benchmarking popCount-single/popCount32+time 5.543 ns (5.511 ns .. 5.574 ns)+ 1.000 R² (0.999 R² .. 1.000 R²)+mean 5.596 ns (5.546 ns .. 5.650 ns)+std dev 177.0 ps (144.8 ps .. 215.8 ps)+variance introduced by outliers: 54% (severely inflated)++benchmarking pdep-vector/popCount64+time 1.083 μs (1.074 μs .. 1.097 μs)+ 0.998 R² (0.997 R² .. 1.000 R²)+mean 1.089 μs (1.075 μs .. 1.104 μs)+std dev 50.20 ns (37.87 ns .. 70.22 ns)+variance introduced by outliers: 62% (severely inflated)++benchmarking pdep-vector/popCount32+time 1.074 μs (1.065 μs .. 1.083 μs)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 1.079 μs (1.071 μs .. 1.090 μs)+std dev 31.57 ns (23.09 ns .. 49.88 ns)+variance introduced by outliers: 40% (moderately inflated)++benchmarking pdep-single/pdep64+time 4.920 ns (4.856 ns .. 5.007 ns)+ 0.996 R² (0.990 R² .. 1.000 R²)+mean 4.945 ns (4.874 ns .. 5.125 ns)+std dev 361.5 ps (150.9 ps .. 703.7 ps)+variance introduced by outliers: 86% (severely inflated)++benchmarking pdep-single/pdep32+time 5.203 ns (5.163 ns .. 5.244 ns)+ 1.000 R² (0.999 R² .. 1.000 R²)+mean 5.229 ns (5.193 ns .. 5.268 ns)+std dev 126.2 ps (109.9 ps .. 148.6 ps)+variance introduced by outliers: 41% (moderately inflated)++benchmarking pdep-vector/pdep64+time 1.627 μs (1.617 μs .. 1.641 μs)+ 0.999 R² (0.998 R² .. 0.999 R²)+mean 1.679 μs (1.652 μs .. 1.723 μs)+std dev 107.2 ns (74.61 ns .. 155.4 ns)+variance introduced by outliers: 75% (severely inflated)++benchmarking pdep-vector/pdep32+time 1.626 μs (1.621 μs .. 1.634 μs)+ 1.000 R² (0.999 R² .. 1.000 R²)+mean 1.637 μs (1.624 μs .. 1.651 μs)+std dev 44.27 ns (35.00 ns .. 58.61 ns)+variance introduced by outliers: 35% (moderately inflated)++benchmarking pext-single/pext64+time 5.182 ns (5.133 ns .. 5.239 ns)+ 0.999 R² (0.998 R² .. 0.999 R²)+mean 5.255 ns (5.181 ns .. 5.371 ns)+std dev 314.1 ps (211.7 ps .. 441.7 ps)+variance introduced by outliers: 81% (severely inflated)++benchmarking pext-single/pext32+time 5.269 ns (5.222 ns .. 5.340 ns)+ 0.997 R² (0.993 R² .. 1.000 R²)+mean 5.315 ns (5.248 ns .. 5.513 ns)+std dev 388.9 ps (145.5 ps .. 713.4 ps)+variance introduced by outliers: 86% (severely inflated)++benchmarking pext-vector/pext64+time 1.647 μs (1.632 μs .. 1.667 μs)+ 0.998 R² (0.996 R² .. 0.999 R²)+mean 1.673 μs (1.649 μs .. 1.719 μs)+std dev 107.5 ns (67.19 ns .. 171.9 ns)+variance introduced by outliers: 76% (severely inflated)++benchmarking pext-vector/pext32+time 1.626 μs (1.616 μs .. 1.637 μs)+ 1.000 R² (0.999 R² .. 1.000 R²)+mean 1.630 μs (1.617 μs .. 1.649 μs)+std dev 53.18 ns (33.93 ns .. 80.86 ns)+variance introduced by outliers: 44% (moderately inflated)++benchmarking plus-vector/plus64+time 1.641 μs (1.628 μs .. 1.657 μs)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 1.647 μs (1.635 μs .. 1.666 μs)+std dev 50.67 ns (38.54 ns .. 76.92 ns)+variance introduced by outliers: 41% (moderately inflated)++benchmarking plus-vector/plus32+time 1.943 μs (1.932 μs .. 1.953 μs)+ 1.000 R² (0.999 R² .. 1.000 R²)+mean 1.948 μs (1.934 μs .. 1.961 μs)+std dev 45.86 ns (37.10 ns .. 59.21 ns)+variance introduced by outliers: 29% (moderately inflated)++Benchmark bench: FINISH+```++Benchmarks with `bmi2` flag NOT defined on `ghc-8.4.1` on `Intel Core i7 2.9 GHz`++```+Benchmark bench: RUNNING...+Fast pdep enabled: False+Fast pext enabled: False+benchmarking popCount-single/popCount64+time 6.572 ns (6.433 ns .. 6.765 ns)+ 0.996 R² (0.992 R² .. 0.999 R²)+mean 6.637 ns (6.551 ns .. 6.758 ns)+std dev 346.9 ps (252.8 ps .. 542.9 ps)+variance introduced by outliers: 76% (severely inflated)++benchmarking popCount-single/popCount32+time 5.196 ns (5.152 ns .. 5.253 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 5.232 ns (5.186 ns .. 5.293 ns)+std dev 186.6 ps (152.8 ps .. 237.0 ps)+variance introduced by outliers: 60% (severely inflated)++benchmarking pdep-vector/popCount64+time 5.409 μs (5.344 μs .. 5.476 μs)+ 0.998 R² (0.997 R² .. 0.999 R²)+mean 5.458 μs (5.391 μs .. 5.549 μs)+std dev 258.1 ns (193.1 ns .. 374.6 ns)+variance introduced by outliers: 60% (severely inflated)++benchmarking pdep-vector/popCount32+time 3.849 μs (3.814 μs .. 3.885 μs)+ 0.999 R² (0.999 R² .. 0.999 R²)+mean 3.860 μs (3.818 μs .. 3.919 μs)+std dev 166.6 ns (131.0 ns .. 236.7 ns)+variance introduced by outliers: 56% (severely inflated)++benchmarking pdep-single/pdep64+time 10.46 ns (10.35 ns .. 10.58 ns)+ 0.999 R² (0.999 R² .. 0.999 R²)+mean 10.53 ns (10.42 ns .. 10.65 ns)+std dev 385.2 ps (321.8 ps .. 480.9 ps)+variance introduced by outliers: 60% (severely inflated)++benchmarking pdep-single/pdep32+time 10.57 ns (10.49 ns .. 10.68 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 10.69 ns (10.57 ns .. 10.80 ns)+std dev 404.1 ps (341.0 ps .. 501.8 ps)+variance introduced by outliers: 62% (severely inflated)++benchmarking pdep-vector/pdep64+time 3.113 μs (3.091 μs .. 3.140 μs)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 3.130 μs (3.106 μs .. 3.158 μs)+std dev 82.60 ns (65.72 ns .. 103.1 ns)+variance introduced by outliers: 32% (moderately inflated)++benchmarking pdep-vector/pdep32+time 3.096 μs (3.070 μs .. 3.125 μs)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 3.086 μs (3.059 μs .. 3.114 μs)+std dev 91.30 ns (77.41 ns .. 110.3 ns)+variance introduced by outliers: 37% (moderately inflated)++benchmarking pext-single/pext64+time 73.06 ns (72.35 ns .. 73.84 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 73.65 ns (73.02 ns .. 74.35 ns)+std dev 2.368 ns (1.974 ns .. 2.918 ns)+variance introduced by outliers: 50% (severely inflated)++benchmarking pext-single/pext32+time 74.07 ns (73.46 ns .. 74.62 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 74.18 ns (73.41 ns .. 74.83 ns)+std dev 2.550 ns (2.161 ns .. 3.134 ns)+variance introduced by outliers: 54% (severely inflated)++benchmarking pext-vector/pext64+time 72.78 μs (71.21 μs .. 74.87 μs)+ 0.996 R² (0.993 R² .. 0.999 R²)+mean 72.17 μs (71.38 μs .. 73.41 μs)+std dev 3.105 μs (2.302 μs .. 4.741 μs)+variance introduced by outliers: 46% (moderately inflated)++benchmarking pext-vector/pext32+time 72.69 μs (72.04 μs .. 73.28 μs)+ 0.999 R² (0.999 R² .. 0.999 R²)+mean 73.00 μs (72.25 μs .. 73.85 μs)+std dev 2.634 μs (2.237 μs .. 3.137 μs)+variance introduced by outliers: 37% (moderately inflated)++benchmarking plus-vector/plus64+time 1.856 μs (1.833 μs .. 1.876 μs)+ 0.999 R² (0.999 R² .. 0.999 R²)+mean 1.861 μs (1.844 μs .. 1.880 μs)+std dev 63.39 ns (54.74 ns .. 75.83 ns)+variance introduced by outliers: 46% (moderately inflated)++benchmarking plus-vector/plus32+time 1.547 μs (1.532 μs .. 1.562 μs)+ 0.999 R² (0.998 R² .. 0.999 R²)+mean 1.554 μs (1.538 μs .. 1.578 μs)+std dev 62.25 ns (48.22 ns .. 91.40 ns)+variance introduced by outliers: 54% (severely inflated)++Benchmark bench: FINISH+```++## Reference++* [Bit Manipulation Instruction Sets (Wikipedia)](https://en.wikipedia.org/wiki/Bit_Manipulation_Instruction_Sets)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,80 @@+module Main where++import Criterion.Main+import Data.Bits+import Data.Bits.Pdep+import Data.Bits.Pext+import Data.Word++import qualified Data.Vector.Storable as DVS++mkVector :: (Num w, DVS.Storable w) => w -> IO (DVS.Vector w)+mkVector w = return $ DVS.unfoldrN 1024 gen w+ where gen b = let a = b + 1 in Just (a, a)++benchPopCount :: [Benchmark]+benchPopCount =+ [ env (mkVector (0 :: Word64)) $ \_ -> bgroup "popCount-single"+ [ bench "popCount64" (whnf popCount (0 :: Word64))+ ]+ , env (mkVector (0 :: Word32)) $ \_ -> bgroup "popCount-single"+ [ bench "popCount32" (whnf popCount (0 :: Word32))+ ]+ , env (mkVector (0 :: Word64)) $ \v -> bgroup "pdep-vector"+ [ bench "popCount64" (whnf (DVS.map popCount) v)+ ]+ , env (mkVector (0 :: Word32)) $ \v -> bgroup "pdep-vector"+ [ bench "popCount32" (whnf (DVS.map popCount) v)+ ]+ ]++benchPlus :: [Benchmark]+benchPlus =+ [ env (mkVector (0 :: Word64)) $ \v -> bgroup "plus-vector"+ [ bench "plus64" (whnf (DVS.foldr (\a b -> (+) a 0 + b) 0) v)+ ]+ , env (mkVector (0 :: Word32)) $ \v -> bgroup "plus-vector"+ [ bench "plus32" (whnf (DVS.foldr (\a b -> (+) a 0 + b) 0) v)+ ]+ ]++benchPdep :: [Benchmark]+benchPdep =+ [ env (mkVector (0 :: Word64)) $ \_ -> bgroup "pdep-single"+ [ bench "pdep64" (whnf (pdep 0) (63 :: Word64))+ ]+ , env (mkVector (0 :: Word32)) $ \_ -> bgroup "pdep-single"+ [ bench "pdep32" (whnf (pdep 0) (63 :: Word32))+ ]+ , env (mkVector (0 :: Word64)) $ \v -> bgroup "pdep-vector"+ [ bench "pdep64" (whnf (DVS.foldr (\a b -> pdep a 0 + b) 0) v)+ ]+ , env (mkVector (0 :: Word32)) $ \v -> bgroup "pdep-vector"+ [ bench "pdep32" (whnf (DVS.foldr (\a b -> pdep a 0 + b) 0) v)+ ]+ ]++benchPext :: [Benchmark]+benchPext =+ [ env (mkVector (0 :: Word64)) $ \_ -> bgroup "pext-single"+ [ bench "pext64" (whnf (pext 0) (63 :: Word64))+ ]+ , env (mkVector (0 :: Word32)) $ \_ -> bgroup "pext-single"+ [ bench "pext32" (whnf (pext 0) (63 :: Word64))+ ]+ , env (mkVector (0 :: Word64)) $ \v -> bgroup "pext-vector"+ [ bench "pext64" (whnf (DVS.foldr (\a b -> pext a 0 + b) 0) v)+ ]+ , env (mkVector (0 :: Word32)) $ \v -> bgroup "pext-vector"+ [ bench "pext32" (whnf (DVS.foldr (\a b -> pext a 0 + b) 0) v)+ ]+ ]++benchAll :: [Benchmark]+benchAll = benchPopCount <> benchPdep <> benchPext <> benchPlus++main :: IO ()+main = do+ putStrLn $ "Fast pdep enabled: " <> show fastPdepEnabled+ putStrLn $ "Fast pext enabled: " <> show fastPextEnabled+ defaultMain benchAll
+ bits-extra.cabal view
@@ -0,0 +1,90 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2b16093c79f84feabd7fb8a6c4c36ce7e5cfdcf7aa6a2c48d7d3d84d3166701b++name: bits-extra+version: 0.0.0.1+description: Please see the README on Github at <https://github.com/haskell-works/bits-extra#readme>+homepage: https://github.com/haskell-works/bits-extra#readme+bug-reports: https://github.com/haskell-works/bits-extra/issues+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2018 John Ky+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/haskell-works/bits-extra++flag bmi2+ description: Enable bmi2 instruction set+ manual: False+ default: False++library+ hs-source-dirs:+ src+ ghc-options: -Wall -O2+ build-depends:+ base >=4.11 && <5+ , ghc-prim+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ cpp-options: -DBMI2_ENABLED+ exposed-modules:+ Data.Bits.Pdep+ Data.Bits.Pdep.Slow+ Data.Bits.Pext+ Data.Bits.Pext.Slow+ other-modules:+ Paths_bits_extra+ default-language: Haskell2010++test-suite bits-extra-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.11 && <5+ , bits-extra+ , ghc-prim+ , hedgehog+ , hspec+ , hw-hedgehog+ , hw-hspec-hedgehog+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ other-modules:+ Data.Bits.PdepSpec+ Data.Bits.PextSpec+ Paths_bits_extra+ default-language: Haskell2010++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ bench+ ghc-options: -Wall -O2+ build-depends:+ base >=4 && <5+ , bits-extra+ , criterion+ , ghc-prim+ , vector+ if (flag(bmi2)) && (impl(ghc >=8.4.1))+ ghc-options: -mbmi2 -msse4.2+ other-modules:+ Paths_bits_extra+ default-language: Haskell2010
+ src/Data/Bits/Pdep.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}++module Data.Bits.Pdep+ ( Pdep(..)+ , fastPdepEnabled+ ) where++import GHC.Prim+import GHC.Word++-- | Bitwise parallel deposit. Deposits bits from the source at the locations+-- described by the mask.+class Pdep a where+ pdep :: a -> a -> a++instance Pdep Word where+ pdep (W# src#) (W# mask#) = W# (pdep# src# mask#)+ {-# INLINE pdep #-}++instance Pdep Word8 where+ pdep src mask = fromIntegral (pdep (fromIntegral src) (fromIntegral mask) :: Word32)+ {-# INLINE pdep #-}++instance Pdep Word16 where+ pdep src mask = fromIntegral (pdep (fromIntegral src) (fromIntegral mask) :: Word32)+ {-# INLINE pdep #-}++#if MIN_VERSION_base(4,11,0)+instance Pdep Word32 where+ pdep (W32# src#) (W32# mask#) = W32# (pdep32# src# mask#)+ {-# INLINE pdep #-}++instance Pdep Word64 where+ pdep (W64# src#) (W64# mask#) = W64# (pdep64# src# mask#)+ {-# INLINE pdep #-}+#else+instance Pdep Word32 where+ pdep = slowPdep+ {-# INLINE pdep #-}++instance Pdep Word64 where+ pdep = slowPdep+ {-# INLINE pdep #-}+#endif++-- | Runtime flag indicating whether the 'pdep' function is using the high-performance.+-- BMI2 instruction set. A value of `False` indicates that `pdep` is emulated.+fastPdepEnabled :: Bool+#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED)+fastPdepEnabled = True+#else+fastPdepEnabled = False+#endif
+ src/Data/Bits/Pdep/Slow.hs view
@@ -0,0 +1,40 @@+module Data.Bits.Pdep.Slow+ ( SlowPdep(..)+ ) where++import Data.Bits+import GHC.Int+import GHC.Word++slowPdep64 :: Word64 -> Word64 -> Word64+slowPdep64 = slowPdep64' 0++lsb :: Word64 -> Word64+lsb src = fromIntegral ((fromIntegral (src `shiftL` 63) :: Int64) `shiftR` 63)++slowPdep64' :: Word64 -> Word64 -> Word64 -> Word64+slowPdep64' result src mask = if lowest /= 0+ then slowPdep64' newResult (src `shiftR` 1) (mask .&. complement lowest)+ else result+ where lowest = (-mask) .&. mask+ newResult = (result .|. ((lsb src) .&. lowest))++-- | Bitwise parallel deposit (emulated). Deposits bits from the source at the+-- locations described by the mask.+class SlowPdep a where+ slowPdep :: a -> a -> a++instance SlowPdep Word where+ slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))++instance SlowPdep Word8 where+ slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))++instance SlowPdep Word16 where+ slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))++instance SlowPdep Word32 where+ slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))++instance SlowPdep Word64 where+ slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))
+ src/Data/Bits/Pext.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}++module Data.Bits.Pext+ ( Pext(..)+ , fastPextEnabled+ ) where++import GHC.Prim+import GHC.Word++-- | Bitwise parallel extract. Extract bits from the source at the locations+-- described by the mask.+class Pext a where+ pext :: a -> a -> a++instance Pext Word where+ pext (W# src#) (W# mask#) = W# (pext# src# mask#)+ {-# INLINE pext #-}++instance Pext Word8 where+ pext src mask = fromIntegral (pext (fromIntegral src) (fromIntegral mask) :: Word32)+ {-# INLINE pext #-}++instance Pext Word16 where+ pext src mask = fromIntegral (pext (fromIntegral src) (fromIntegral mask) :: Word32)+ {-# INLINE pext #-}++#if MIN_VERSION_base(4,11,0)+instance Pext Word32 where+ pext (W32# src#) (W32# mask#) = W32# (pext32# src# mask#)+ {-# INLINE pext #-}++instance Pext Word64 where+ pext (W64# src#) (W64# mask#) = W64# (pext64# src# mask#)+ {-# INLINE pext #-}+#else+instance Pext Word32 where+ pext = slowPext+ {-# INLINE pext #-}++instance Pext Word64 where+ pext = slowPext+ {-# INLINE pext #-}+#endif++-- | Runtime flag indicating whether the 'pext' function is using the high-performance.+-- BMI2 instruction set. A value of `False` indicates that `pext` is emulated.+fastPextEnabled :: Bool+#if MIN_VERSION_base(4,11,0) && defined(BMI2_ENABLED)+fastPextEnabled = True+#else+fastPextEnabled = False+#endif
+ src/Data/Bits/Pext/Slow.hs view
@@ -0,0 +1,39 @@+module Data.Bits.Pext.Slow+ ( SlowPext(..)+ ) where++import Data.Bits+import GHC.Word++slowPext64 :: Word64 -> Word64 -> Word64+slowPext64 = slowPext64' 0 0 0++slowPext64' :: Word64 -> Int -> Int -> Word64 -> Word64 -> Word64+slowPext64' result offset index src mask = if index /= 64+ then if maskBit /= 0+ then slowPext64' nextResult (offset + 1) (index + 1) src mask+ else slowPext64' result offset (index + 1) src mask+ else result+ where srcBit = (src `shiftR` index) .&. 1+ maskBit = (mask `shiftR` index) .&. 1+ nextResult = result .|. (srcBit `shiftL` offset)++-- | Bitwise parallel extract (emulated). Extract bits from the source at+-- the locations described by the mask.+class SlowPext a where+ slowPext :: a -> a -> a++instance SlowPext Word where+ slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))++instance SlowPext Word8 where+ slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))++instance SlowPext Word16 where+ slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))++instance SlowPext Word32 where+ slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))++instance SlowPext Word64 where+ slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))
+ test/Data/Bits/PdepSpec.hs view
@@ -0,0 +1,42 @@++module Data.Bits.PdepSpec (spec) where++import Data.Bits+import Data.Bits.Pdep+import Data.Bits.Pdep.Slow+import Data.Int+import Data.Word+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++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 "Data.Bits.PdepSpec" $ do+ describe "Emulated pdep and native pdep give the same answer" $ do+ it "Word64" $ require $ property $ do+ a <- forAll $ G.word64 R.constantBounded+ b <- forAll $ G.word64 R.constantBounded+ pdep a b === slowPdep a b+ it "Word32" $ require $ property $ do+ a <- forAll $ G.word32 R.constantBounded+ b <- forAll $ G.word32 R.constantBounded+ pdep a b === slowPdep a b+ it "Word16" $ require $ property $ do+ a <- forAll $ G.word16 R.constantBounded+ b <- forAll $ G.word16 R.constantBounded+ pdep a b === slowPdep a b+ it "Word8" $ require $ property $ do+ a <- forAll $ G.word8 R.constantBounded+ b <- forAll $ G.word8 R.constantBounded+ pdep a b === slowPdep a b+ it "Word" $ require $ property $ do+ a <- forAll $ G.word R.constantBounded+ b <- forAll $ G.word R.constantBounded+ pdep a b === slowPdep a b
+ test/Data/Bits/PextSpec.hs view
@@ -0,0 +1,41 @@+module Data.Bits.PextSpec (spec) where++import Data.Bits+import Data.Bits.Pext+import Data.Bits.Pext.Slow+import Data.Int+import Data.Word+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++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 "Data.Bits.PextSpec" $ do+ describe "Emulated pext and native pext give the same answer" $ do+ it "Word64" $ require $ property $ do+ a <- forAll $ G.word64 R.constantBounded+ b <- forAll $ G.word64 R.constantBounded+ pext a b === slowPext a b+ it "Word32" $ require $ property $ do+ a <- forAll $ G.word32 R.constantBounded+ b <- forAll $ G.word32 R.constantBounded+ pext a b === slowPext a b+ it "Word16" $ require $ property $ do+ a <- forAll $ G.word16 R.constantBounded+ b <- forAll $ G.word16 R.constantBounded+ pext a b === slowPext a b+ it "Word8" $ require $ property $ do+ a <- forAll $ G.word8 R.constantBounded+ b <- forAll $ G.word8 R.constantBounded+ pext a b === slowPext a b+ it "Word" $ require $ property $ do+ a <- forAll $ G.word R.constantBounded+ b <- forAll $ G.word R.constantBounded+ pext a b === slowPext a b
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}