hw-prim-bits 0.1.0.1 → 0.1.0.2
raw patch · 9 files changed
+193/−25 lines, 9 filesdep +QuickCheckdep +hedgehogdep +hspecPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: QuickCheck, hedgehog, hspec, hw-hedgehog, hw-hspec-hedgehog
API changes (from Hackage documentation)
- HaskellWorks.Prim.Bits: pdep64 :: Word64 -> Word64 -> Word64
+ HaskellWorks.Prim.Bits: instance HaskellWorks.Prim.Bits.Pdep GHC.Word.Word32
+ HaskellWorks.Prim.Bits: instance HaskellWorks.Prim.Bits.Pdep GHC.Word.Word64
+ HaskellWorks.Prim.Bits.Fast: pdep32 :: Word32 -> Word32 -> Word32
+ HaskellWorks.Prim.Bits.Fast: pdep64 :: Word64 -> Word64 -> Word64
+ HaskellWorks.Prim.Bits.Slow: pdep32 :: Word32 -> Word32 -> Word32
+ HaskellWorks.Prim.Bits.Slow: pdep64 :: Word64 -> Word64 -> Word64
Files
- bench/Main.hs +33/−7
- cbits/bits.c +63/−7
- cbits/bits.h +11/−1
- hw-prim-bits.cabal +11/−6
- src/HaskellWorks/Prim/Bits.hs +14/−2
- src/HaskellWorks/Prim/Bits/Fast.hs +18/−0
- src/HaskellWorks/Prim/Bits/Slow.hs +18/−0
- test/HaskellWorks/Prim/BitsSpec.hs +24/−0
- test/Spec.hs +1/−2
bench/Main.hs view
@@ -6,19 +6,45 @@ import Data.Word import HaskellWorks.Prim.Bits +import qualified HaskellWorks.Prim.Bits.Fast as F+import qualified HaskellWorks.Prim.Bits.Slow as S+ import qualified Data.Vector.Storable as DVS +setupVector64 :: Int -> IO (DVS.Vector Word64)+setupVector64 n = return $ DVS.fromList (take n (cycle [maxBound, 0]))++setupVector32 :: Int -> IO (DVS.Vector Word32)+setupVector32 n = return $ DVS.fromList (take n (cycle [maxBound, 0]))+ setup :: IO () setup = return () -benchPdep :: [Benchmark]-benchPdep =- [ env setup $ \bv -> bgroup "bits"- [ bench "pdep64" (whnf (pdep64 0) (0 :: Word64))- , bench "popCount" (whnf popCount (0 :: Word64))- , bench "sin" (whnf sin (0 :: Double))+benchPdep64 :: [Benchmark]+benchPdep64 =+ [ env (setupVector64 1) $ \bv -> bgroup "bits"+ [ bench "pdep64" (whnf (DVS.foldl pdep64 0) bv) ]+ , env (setupVector64 1) $ \bv -> bgroup "Fast"+ [ bench "pdep64" (whnf (DVS.foldl F.pdep64 0) bv)+ ]+ , env (setupVector64 1) $ \bv -> bgroup "Slow"+ [ bench "pdep64" (whnf (DVS.foldl S.pdep64 0) bv)+ ] ] +benchPdep32 :: [Benchmark]+benchPdep32 =+ [ env (setupVector32 1) $ \bv -> bgroup "bits"+ [ bench "pdep32" (whnf (DVS.foldl pdep32 0) bv)+ ]+ , env (setupVector32 1) $ \bv -> bgroup "Fast"+ [ bench "pdep32" (whnf (DVS.foldl F.pdep32 0) bv)+ ]+ , env (setupVector32 1) $ \bv -> bgroup "Slow"+ [ bench "pdep32" (whnf (DVS.foldl S.pdep32 0) bv)+ ]+ ]+ main :: IO ()-main = defaultMain benchPdep+main = defaultMain (benchPdep64 ++ benchPdep32)
cbits/bits.c view
@@ -1,15 +1,71 @@-#include <x86intrin.h>+#include "bits.h" -unsigned long long pdep64(- unsigned long long arga,- unsigned long long argb)-{- unsigned long long result;+uint32_t fast_pdep32(+ uint32_t src,+ uint32_t mask) {+ uint32_t result; __asm__ __volatile__("pdepl %%ecx,%%ebx,%%eax" :"=a"(result)- :"a"(result), "b"(arga), "c"(argb)+ :"a"(result), "b"(src), "c"(mask) );++ return result;+}++uint32_t slow_pdep32(+ uint32_t src,+ uint32_t mask) {+ uint32_t result = 0;++ while (1) {+ const uint32_t lowest = (-mask & mask);++ if (lowest == 0) {+ break;+ }++ const uint32_t lsb = (uint32_t)((int32_t)(src << 63) >> 63);++ result |= lsb & lowest;+ mask &= ~lowest;+ src >>= 1;+ }++ return result;+}++uint64_t fast_pdep64(+ uint64_t src,+ uint64_t mask) {+ uint64_t result;++ __asm__ __volatile__("pdepq %%rcx,%%rbx,%%rax"+ :"=a"(result)+ :"a"(result), "b"(src), "c"(mask)+ );++ return result;+}++uint64_t slow_pdep64(+ uint64_t src,+ uint64_t mask) {+ uint64_t result = 0;++ while (1) {+ const uint64_t lowest = (-mask & mask);++ if (lowest == 0) {+ break;+ }++ const uint64_t lsb = (uint64_t)((int64_t)(src << 63) >> 63);++ result |= lsb & lowest;+ mask &= ~lowest;+ src >>= 1;+ } return result; }
cbits/bits.h view
@@ -1,3 +1,13 @@-unsigned long long pdep64(++typedef unsigned long long uint64_t;+typedef signed long long int64_t;+typedef unsigned long uint32_t;+typedef signed long int32_t;++unsigned long long fast_pdep64(+ unsigned long long,+ unsigned long long);++unsigned long long ref_pdep64( unsigned long long, unsigned long long);
hw-prim-bits.cabal view
@@ -1,5 +1,5 @@ name: hw-prim-bits-version: 0.1.0.1+version: 0.1.0.2 synopsis: Primitive support for bit manipulation description: Please see README.md homepage: https://github.com/githubuser/hw-prim-bits#readme@@ -16,6 +16,8 @@ library hs-source-dirs: src exposed-modules: HaskellWorks.Prim.Bits+ , HaskellWorks.Prim.Bits.Fast+ , HaskellWorks.Prim.Bits.Slow build-depends: base >= 4.7 && < 5 default-language: Haskell2010 C-sources: cbits/bits.c@@ -34,8 +36,14 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs+ other-modules: HaskellWorks.Prim.BitsSpec build-depends: base+ , hedgehog+ , hspec+ , hw-hedgehog >= 0.1.0.1+ , hw-hspec-hedgehog , hw-prim-bits+ , QuickCheck ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 @@ -43,10 +51,7 @@ Type: exitcode-stdio-1.0 HS-Source-Dirs: bench Main-Is: Main.hs- if flag(sse42)- GHC-Options: -Wall -O2 -msse4.2- else- GHC-Options: -Wall -O2+ GHC-Options: -Wall -O2 Default-Language: Haskell2010 Build-Depends: base >= 4 && < 5 , criterion@@ -55,4 +60,4 @@ source-repository head type: git- location: https://github.com/githubuser/hw-prim-bits+ location: https://github.com/haskell-works/hw-prim-bits
src/HaskellWorks/Prim/Bits.hs view
@@ -1,5 +1,17 @@-module HaskellWorks.Prim.Bits where+module HaskellWorks.Prim.Bits+ ( module X+ ) where import Data.Word+import HaskellWorks.Prim.Bits.Fast as X -foreign import ccall unsafe "bits.h" pdep64 :: Word64 -> Word64 -> Word64+class Pdep a where+ pdep :: a -> a -> a++instance Pdep Word64 where+ pdep = pdep64+ {-# INLINE pdep #-}++instance Pdep Word32 where+ pdep = pdep32+ {-# INLINE pdep #-}
+ src/HaskellWorks/Prim/Bits/Fast.hs view
@@ -0,0 +1,18 @@+module HaskellWorks.Prim.Bits.Fast+ ( pdep64+ , pdep32+ ) where++import Data.Word++foreign import ccall unsafe "bits.h" fast_pdep64 :: Word64 -> Word64 -> Word64++pdep64 :: Word64 -> Word64 -> Word64+pdep64 = fast_pdep64+{-# INLINE pdep64 #-}++foreign import ccall unsafe "bits.h" fast_pdep32 :: Word32 -> Word32 -> Word32++pdep32 :: Word32 -> Word32 -> Word32+pdep32 = fast_pdep32+{-# INLINE pdep32 #-}
+ src/HaskellWorks/Prim/Bits/Slow.hs view
@@ -0,0 +1,18 @@+module HaskellWorks.Prim.Bits.Slow+ ( pdep64+ , pdep32+ ) where++import Data.Word++foreign import ccall unsafe "bits.h" slow_pdep64 :: Word64 -> Word64 -> Word64++pdep64 :: Word64 -> Word64 -> Word64+pdep64 = slow_pdep64+{-# INLINE pdep64 #-}++foreign import ccall unsafe "bits.h" slow_pdep32 :: Word32 -> Word32 -> Word32++pdep32 :: Word32 -> Word32 -> Word32+pdep32 = slow_pdep32+{-# INLINE pdep32 #-}
+ test/HaskellWorks/Prim/BitsSpec.hs view
@@ -0,0 +1,24 @@+module HaskellWorks.Prim.BitsSpec (spec) where++import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Prim.Bits.Fast as F+import qualified HaskellWorks.Prim.Bits.Slow as S+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) #-}++spec :: Spec+spec = describe "HaskellWorks.Prim.BitsSpec" $ do+ it "pdep64 behaves the same" $ require $ property $ do+ a <- forAll $ G.word64 R.constantBounded+ b <- forAll $ G.word64 R.constantBounded+ S.pdep64 a b === F.pdep64 a b+ it "pdep32 behaves the same" $ require $ property $ do+ a <- forAll $ G.word32 R.constantBounded+ b <- forAll $ G.word32 R.constantBounded+ S.pdep32 a b === F.pdep32 a b
test/Spec.hs view
@@ -1,2 +1,1 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}