packages feed

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 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 #-}