bit-stream 0.1.0.0 → 0.1.0.1
raw patch · 6 files changed
+116/−41 lines, 6 filesdep +ghc-primdep +transformersdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: ghc-prim, transformers
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Data/BitStream.hs +18/−9
- Data/BitStream/Compat.hs +57/−0
- Data/BitStream/ContinuousMapping.hs +26/−25
- bench/Bench.hs +3/−0
- bit-stream.cabal +10/−6
- test/Test.hs +2/−1
Data/BitStream.hs view
@@ -72,6 +72,8 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-}+ module Data.BitStream ( BitStream , tabulate@@ -97,8 +99,11 @@ import Data.Functor.Identity import qualified Data.Vector.Unboxed as U import qualified Data.Vector as V+import Data.Word import Unsafe.Coerce +import Data.BitStream.Compat+ -- | Compact representation of infinite stream of 'Bool'. -- -- It spends one bit (1/8 byte) for one 'Bool' in store.@@ -121,10 +126,10 @@ int2word = unsafeCoerce bits :: Int-bits = finiteBitSize (0 :: Word)+bits = fbs (0 :: Word) bitsLog :: Int-bitsLog = bits - 1 - countLeadingZeros (int2word bits)+bitsLog = bits - 1 - word2int (clz (int2word bits)) -- | Create a bit stream from the predicate. -- The predicate must be well-defined for any value of argument@@ -147,7 +152,7 @@ ii = 1 `shiftL` i tabulateW :: Int -> m Word- tabulateW j = foldlM go zeroBits [0 .. bits - 1]+ tabulateW j = foldlM go 0 [0 .. bits - 1] where jj = j `shiftL` bitsLog go acc k = do@@ -183,7 +188,7 @@ if k < int2word iii then return (index bs' k) else uf f k tabulateW :: (Word -> m Bool) -> Int -> m Word- tabulateW f j = foldlM go zeroBits [0 .. bits - 1]+ tabulateW f j = foldlM go 0 [0 .. bits - 1] where jj = j `shiftL` bitsLog go acc k = do@@ -200,7 +205,7 @@ else indexU (vus `V.unsafeIndex` (sgm + 1)) (word2int $ i - int2word bits `shiftL` sgm) where sgm :: Int- sgm = finiteBitSize i - 1 - bitsLog - countLeadingZeros i+ sgm = fbs i - 1 - bitsLog - word2int (clz i) indexU :: U.Vector Word -> Int -> Bool indexU vec j = testBit (vec `U.unsafeIndex` jHi) jLo@@ -218,7 +223,9 @@ -- | Traverse over all indices and respective elements in the stream. traverseWithKey :: forall m. Monad m => (Word -> Bool -> m Bool) -> BitStream -> m BitStream-traverseWithKey f (BitStream bs) = BitStream <$> V.imapM g bs+traverseWithKey f (BitStream bs) = do+ bs' <- V.imapM g bs+ return $ BitStream bs' where g :: Int -> U.Vector Word -> m (U.Vector Word) g 0 = U.imapM h@@ -227,7 +234,7 @@ offset = 1 `shiftL` (logOffset - 1) h :: Int -> Word -> m Word- h offset w = foldlM go zeroBits [0 .. bits - 1]+ h offset w = foldlM go 0 [0 .. bits - 1] where go acc k = do b <- f (int2word $ offset + k) (testBit w k)@@ -248,7 +255,9 @@ -- | Zip two streams with the monadic function, which is provided with an index and respective elements of both streams. zipWithKeyM :: forall m. Monad m => (Word -> Bool -> Bool -> m Bool) -> BitStream -> BitStream -> m BitStream-zipWithKeyM f (BitStream bs1) (BitStream bs2) = BitStream <$> V.izipWithM g bs1 bs2+zipWithKeyM f (BitStream bs1) (BitStream bs2) = do+ bs' <- V.izipWithM g bs1 bs2+ return $ BitStream bs' where g :: Int -> U.Vector Word -> U.Vector Word -> m (U.Vector Word) g 0 = U.izipWithM h@@ -257,7 +266,7 @@ offset = 1 `shiftL` (logOffset - 1) h :: Int -> Word -> Word -> m Word- h offset w1 w2 = foldlM go zeroBits [0 .. bits - 1]+ h offset w1 w2 = foldlM go 0 [0 .. bits - 1] where go acc k = do b <- f (int2word $ offset + k) (testBit w1 k) (testBit w2 k)
+ Data/BitStream/Compat.hs view
@@ -0,0 +1,57 @@+-- |+-- Module: Data.BitStream.Compat+-- Copyright: (c) 2017 Andrew Lelechenko+-- Licence: MIT+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>++{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK hide #-}++module Data.BitStream.Compat+ ( clz+ , fbs+ ) where++import Data.Bits+import GHC.Exts+import GHC.Prim+import Unsafe.Coerce++#if __GLASGOW_HASKELL__ > 709++clz :: Word -> Word+clz (W# w#) = W# (clz# w#)+{-# INLINE clz #-}++#else++int2word :: Int -> Word+int2word = unsafeCoerce++clz :: Word -> Word+clz w = int2word $ case setBits of+ [] -> sz+ (s : _) -> sz - s - 1+ where+ sz = fbs w+ setBits = map fst $ filter snd $ map (\i -> (i, testBit w i)) [sz - 1, sz - 2 .. 0]+{-# INLINE clz #-}++#endif++#if __GLASGOW_HASKELL__ > 707++fbs :: Word -> Int+fbs = finiteBitSize+{-# INLINE fbs #-}++#else++fbs :: Word -> Int+fbs = bitSize+{-# INLINE fbs #-}++#endif
Data/BitStream/ContinuousMapping.hs view
@@ -44,7 +44,7 @@ -- > \z -> let (x, y) = fromZCurve z in -- > board (wordToInt x) (wordToInt y) -{-# LANGUAGE BinaryLiterals #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-} module Data.BitStream.ContinuousMapping ( intToWord@@ -56,6 +56,7 @@ ) where import Data.Bits+import Data.Word import Unsafe.Coerce word2int :: Word -> Int@@ -130,42 +131,42 @@ part1by1 :: Word -> Word part1by1 x = x5 where- x0 = x .&. 0b0000000000000000000000000000000011111111111111111111111111111111- x1 = (x0 `xor` (x0 `shiftL` 16)) .&. 0b0000000000000000111111111111111100000000000000001111111111111111- x2 = (x1 `xor` (x1 `shiftL` 8)) .&. 0b0000000011111111000000001111111100000000111111110000000011111111- x3 = (x2 `xor` (x2 `shiftL` 4)) .&. 0b0000111100001111000011110000111100001111000011110000111100001111- x4 = (x3 `xor` (x3 `shiftL` 2)) .&. 0b0011001100110011001100110011001100110011001100110011001100110011- x5 = (x4 `xor` (x4 `shiftL` 1)) .&. 0b0101010101010101010101010101010101010101010101010101010101010101+ x0 = x .&. 0x00000000ffffffff+ x1 = (x0 `xor` (x0 `shiftL` 16)) .&. 0x0000ffff0000ffff+ x2 = (x1 `xor` (x1 `shiftL` 8)) .&. 0x00ff00ff00ff00ff+ x3 = (x2 `xor` (x2 `shiftL` 4)) .&. 0x0f0f0f0f0f0f0f0f+ x4 = (x3 `xor` (x3 `shiftL` 2)) .&. 0x3333333333333333+ x5 = (x4 `xor` (x4 `shiftL` 1)) .&. 0x5555555555555555 -- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/ part1by2 :: Word -> Word part1by2 x = x5 where- x0 = x .&. 0b0000000000000000000000000000000011111111111111111111111111111111- x1 = (x0 `xor` (x0 `shiftL` 32)) .&. 0b1111111111111111000000000000000000000000000000001111111111111111- x2 = (x1 `xor` (x1 `shiftL` 16)) .&. 0b0000000011111111000000000000000011111111000000000000000011111111- x3 = (x2 `xor` (x2 `shiftL` 8)) .&. 0b1111000000001111000000001111000000001111000000001111000000001111- x4 = (x3 `xor` (x3 `shiftL` 4)) .&. 0b0011000011000011000011000011000011000011000011000011000011000011- x5 = (x4 `xor` (x4 `shiftL` 2)) .&. 0b0001001001001001001001001001001001001001001001001001001001001001+ x0 = x .&. 0x00000000ffffffff+ x1 = (x0 `xor` (x0 `shiftL` 32)) .&. 0xffff00000000ffff+ x2 = (x1 `xor` (x1 `shiftL` 16)) .&. 0x00ff0000ff0000ff+ x3 = (x2 `xor` (x2 `shiftL` 8)) .&. 0xf00f00f00f00f00f+ x4 = (x3 `xor` (x3 `shiftL` 4)) .&. 0x30c30c30c30c30c3+ x5 = (x4 `xor` (x4 `shiftL` 2)) .&. 0x1249249249249249 -- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/ compact1by1 :: Word -> Word compact1by1 x = x5 where- x0 = x .&. 0b0101010101010101010101010101010101010101010101010101010101010101- x1 = (x0 `xor` (x0 `shiftR` 1)) .&. 0b0011001100110011001100110011001100110011001100110011001100110011- x2 = (x1 `xor` (x1 `shiftR` 2)) .&. 0b0000111100001111000011110000111100001111000011110000111100001111- x3 = (x2 `xor` (x2 `shiftR` 4)) .&. 0b0000000011111111000000001111111100000000111111110000000011111111- x4 = (x3 `xor` (x3 `shiftR` 8)) .&. 0b0000000000000000111111111111111100000000000000001111111111111111- x5 = (x4 `xor` (x4 `shiftR` 16)) .&. 0b0000000000000000000000000000000011111111111111111111111111111111+ x0 = x .&. 0x5555555555555555+ x1 = (x0 `xor` (x0 `shiftR` 1)) .&. 0x3333333333333333+ x2 = (x1 `xor` (x1 `shiftR` 2)) .&. 0x0f0f0f0f0f0f0f0f+ x3 = (x2 `xor` (x2 `shiftR` 4)) .&. 0x00ff00ff00ff00ff+ x4 = (x3 `xor` (x3 `shiftR` 8)) .&. 0x0000ffff0000ffff+ x5 = (x4 `xor` (x4 `shiftR` 16)) .&. 0x00000000ffffffff -- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/ compact1by2 :: Word -> Word compact1by2 x = x5 where- x0 = x .&. 0b0001001001001001001001001001001001001001001001001001001001001001- x1 = (x0 `xor` (x0 `shiftR` 2)) .&. 0b0011000011000011000011000011000011000011000011000011000011000011- x2 = (x1 `xor` (x1 `shiftR` 4)) .&. 0b1111000000001111000000001111000000001111000000001111000000001111- x3 = (x2 `xor` (x2 `shiftR` 8)) .&. 0b0000000011111111000000000000000011111111000000000000000011111111- x4 = (x3 `xor` (x3 `shiftR` 16)) .&. 0b1111111111111111000000000000000000000000000000001111111111111111- x5 = (x4 `xor` (x4 `shiftR` 32)) .&. 0b0000000000000000000000000000000011111111111111111111111111111111+ x0 = x .&. 0x1249249249249249+ x1 = (x0 `xor` (x0 `shiftR` 2)) .&. 0x30c30c30c30c30c3+ x2 = (x1 `xor` (x1 `shiftR` 4)) .&. 0xf00f00f00f00f00f+ x3 = (x2 `xor` (x2 `shiftR` 8)) .&. 0x00ff0000ff0000ff+ x4 = (x3 `xor` (x3 `shiftR` 16)) .&. 0xffff00000000ffff+ x5 = (x4 `xor` (x4 `shiftR` 32)) .&. 0x00000000ffffffff
bench/Bench.hs view
@@ -1,8 +1,11 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+ module Main where import Criterion.Main import Data.BitStream.WheelMapping+import Data.Word doBench :: String -> (Word -> Word) -> Benchmark doBench name fn = bench name $ nf (sum . (map fn)) [0..46409]
bit-stream.cabal view
@@ -1,5 +1,5 @@ name: bit-stream-version: 0.1.0.0+version: 0.1.0.1 homepage: https://github.com/Bodigrim/bit-stream#readme license: BSD3 license-file: LICENSE@@ -9,14 +9,18 @@ build-type: Simple extra-source-files: README.md cabal-version: >=1.10-synopsis: Lazy, infinite, compact stream of 'Bool' with O(1) indexing.+synopsis: Lazy, infinite, compact stream of Bool with O(1) indexing. library exposed-modules: Data.BitStream Data.BitStream.ContinuousMapping Data.BitStream.WheelMapping- build-depends: base >= 4.8 && < 5+ other-modules: Data.BitStream.Compat+ build-depends: base >= 4.5 && < 5+ , ghc-prim , vector+ if impl(ghc < 7.10)+ build-depends: transformers default-language: Haskell2010 ghc-options: -Wall -O2 @@ -30,7 +34,7 @@ ghc-options: -Wall -O2 main-is: Test.hs default-language: Haskell2010- build-depends: base >= 4.8 && < 5+ build-depends: base >= 4.5 && < 5 , bit-stream , QuickCheck >= 2.10 , tasty@@ -43,7 +47,7 @@ buildable: False main-is: find-foo.hs hs-source-dirs: app- build-depends: base >= 4.8 && < 5+ build-depends: base >= 4.5 && < 5 , bit-stream , vector default-language: Haskell2010@@ -53,7 +57,7 @@ type: exitcode-stdio-1.0 main-is: Bench.hs hs-source-dirs: bench- build-depends: base >= 4.8 && < 5+ build-depends: base >= 4.5 && < 5 , bit-stream , criterion default-language: Haskell2010
test/Test.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-} module Main where @@ -10,6 +10,7 @@ import Data.Bits import Data.Function (fix) import Data.List+import Data.Word import Data.BitStream as BS import Data.BitStream.ContinuousMapping