bits 0.3.3 → 0.4

raw patch · 5 files changed

+182/−43 lines, 5 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +4/−0
• bits.cabal +6/−5
• src/Data/Bits/Coded.hs +81/−0
• src/Data/Bits/Coding.hs +36/−8
• src/Data/Bits/Extras.hs +55/−30

@@ -1,3 +1,7 @@+0.4+---+* Embrace `FiniteBits` from GHC 7.8.3 now that a platform has shipped with it.+ 0.3.3 ----- * Fixed dependencies on old busted versions

@@ -1,6 +1,6 @@ name:          bits category:      Data, Serialization-version:       0.3.3+version:       0.4 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -11,7 +11,7 @@ bug-reports:   http://github.com/analytics/bits/issues copyright:     Copyright (C) 2013 Edward A. Kmett build-type:    Custom-tested-with:   GHC == 7.4.1, GHC == 7.6.1+tested-with:   GHC == 7.8.3 synopsis:      Various bit twiddling and bitwise serialization primitives description:   Various bit twiddling and bitwise serialization primitives @@ -41,13 +41,14 @@  library   build-depends:-    base         >= 4.3      && < 5,+    base         >= 4.7      && < 5,     bytes        >= 0.11     && < 1,-    mtl          >= 2.0      && < 2.2,-    transformers >= 0.2      && < 0.4+    mtl          >= 2.0      && < 2.3,+    transformers >= 0.2      && < 0.5    exposed-modules:     Data.Bits.Coding+    Data.Bits.Coded     Data.Bits.Extras    if flag(lib-Werror)

@@ -0,0 +1,81 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+--------------------------------------------------------------------+-- |+-- License   :  BSD3+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Data.Bits.Coded+  (+    Coded(..)+    , Unary(..)+    , Elias(..)+    , Gamma+    , Delta+    , runEncode+    , runDecode+  ) where++import Data.Bits+import Data.Bits.Coding+import Data.Bits.Extras+import Data.Bytes.Get+import Data.Bytes.Put+import Data.Foldable++-- | Unaligned codes+class Coded c where+  encode     :: MonadPut m => c -> Coding m ()+  encodeMany :: (MonadPut m, Foldable t) => t c -> Coding m ()+  encodeMany = traverse_ encode+  decode     :: MonadGet m => Coding m c++-- | Unary-coded integers+--+-- >>> runPutL . runEncode $ encode (Unary 1) >> flush+-- "\128"+-- >>> runPutL . runEncode $ encode (Unary 7) >> flush+-- "\254"+newtype Unary n = Unary {+  unUnary :: n+} deriving (Eq, Ord, Read, Show, Num, Integral, Real, Enum)++ones :: Integer+ones = oneBits `unsafeShiftL` 1+instance Integral n => Coded (Unary n) where+  encode (Unary n) = putBitsFrom (fromIntegral n) ones+  decode = do b <- getBit+              if b then fmap (1+) decode else return 0++runEncode :: MonadPut m => Coding m () -> m ()+runEncode (Coding c) = c k 0 0+  where k _ _ _ = return ()++runDecode :: MonadGet m => Coding m a -> m a+runDecode (Coding c) = c k 0 0+  where k a _ _ = return a++-- | Representation for Elias 'Gamma' and 'Delta' codes.  A positive+-- integer @n@ is encoded by encoding the position of its most+-- significant bit, and then the binary representation of the rest of+-- the number.+newtype Elias c n = Elias {+  unElias :: n+} deriving (Eq, Ord, Read, Show, Num, Real, Integral, Enum)++instance (Coded c, Integral c, Ranked n) => Coded (Elias c n) where+  encode (Elias n) = do encode (fromIntegral m :: c)+                        putBitsFrom (pred m) n+    where m = msb n+  decode = do m :: c <- decode+              n <- getBitsFrom (pred $ fromIntegral m) (bit $ fromIntegral m)+              return $ Elias n++-- | Elias Gamma codes the position of the most significant in+-- 'Unary'.+type Gamma c = Elias (Unary c)+-- | Elias Delta codes the position of the most significant bit in+-- Elias 'Gamma'.+type Delta c n = Elias (Gamma c n) n

@@ -19,9 +19,9 @@ module Data.Bits.Coding   ( Coding(..)   -- * Get-  , getAligned, getBit+  , getAligned, getBit, getBits, getBitsFrom   -- * Put-  , putAligned, putBit+  , putAligned, putUnaligned, putBit, putBits, putBitsFrom   ) where  import Control.Applicative@@ -30,6 +30,7 @@ import Control.Monad.Reader.Class import Control.Monad.Trans import Data.Bits+import Data.Bits.Extras import Data.Bytes.Get import Data.Bytes.Put import Data.Word@@ -117,10 +118,20 @@ getBit :: MonadGet m => Coding m Bool getBit = Coding $ \ k i b ->   if i == 0-  then getWord8 >>= \b' -> ((k $! testBit b' 7) $! 7) $! shiftL b' 1-  else ((k $! testBit b 7) $! i - 1) $! shiftL b 1+  then getWord8 >>= \b' -> ((k $! testBit b' 7) $! 7) $! unsafeShiftL b' 1+  else ((k $! testBit b 7) $! i - 1) $! unsafeShiftL b 1 {-# INLINE getBit #-} +getBits :: (MonadGet m, Bits b) => Int -> Int -> b -> Coding m b+getBits from to bits | from < to = return bits+                     | otherwise = do b <- getBit+                                      getBits (pred from) to $ assignBit bits from b+{-# INLINE getBits #-}++getBitsFrom :: (MonadGet m, Bits b) => Int -> b -> Coding m b+getBitsFrom from bits = getBits from 0 bits+{-# INLINE getBitsFrom #-}+ instance MonadGet m => MonadGet (Coding m) where   type Remaining (Coding m) = Remaining m   type Bytes (Coding m) = Bytes m@@ -193,18 +204,35 @@    a <- m    k a 0 0 +-- | 'Put' all the bits without a 'flush'+putUnaligned :: (MonadPut m, FiniteBits b) => b -> Coding m ()+putUnaligned b = putBitsFrom (finiteBitSize b) b+{-# INLINE putUnaligned #-}+ -- | 'Put' a single bit, emitting an entire 'byte' if the bit buffer is full putBit :: MonadPut m => Bool -> Coding m () putBit v = Coding $ \k i b ->   if i == 7   then do-    putWord8 (pushBit b v)+    putWord8 (pushBit b i v)     k () 0 0-  else (k () $! i + 1) $! pushBit b v+  else (k () $! i + 1) $! pushBit b i v   where-    pushBit w False = shiftL w 1-    pushBit w True  = shiftL w 1 .|. 1+    pushBit w i False = clearBit w $ 7 - i+    pushBit w i True  = setBit   w $ 7 - i {-# INLINE putBit #-}++-- TODO: Make putBits less stupid+-- | 'Put' a (closed) range of bits+putBits :: (MonadPut m, Bits b) => Int -> Int -> b -> Coding m ()+putBits from to b | from < to = return ()+                  | otherwise = putBit (b `testBit` from) >> putBits (pred from) to b+{-# INLINE putBits #-}++-- | @putBitsFrom from b = putBits from 0 b@+putBitsFrom :: (MonadPut m, Bits b) => Int -> b -> Coding m ()+putBitsFrom from b = putBits from 0 b+{-# INLINE putBitsFrom #-}  instance MonadPut m => MonadPut (Coding m) where   putWord8 = putAligned . putWord8

@@ -1,10 +1,10 @@ {-# LANGUAGE CPP, ForeignFunctionInterface, MagicHash, UnboxedTuples, BangPatterns #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -------------------------------------------------------------------- -- |--- Copyright :  (c) Edward Kmett 2013+-- Copyright :  (c) Edward Kmett 2013-2014 -- License   :  BSD3 -- Maintainer:  Edward Kmett <ekmett@gmail.com> -- Stability :  experimental@@ -16,10 +16,15 @@ module Data.Bits.Extras   ( Ranked(..)   , log2+  , msb   , w8   , w16   , w32   , w64+  , assignBit+  , zeroBits+  , oneBits+  , srl   ) where  import Data.Bits@@ -31,17 +36,17 @@  -- TODO: generalize to 64 bits, etc. log2 :: Word32 -> Int-log2 !n0 = fromIntegral $ go (shiftR (n5 * 0x7C4ACDD) 27) where+log2 !n0 = fromIntegral $ go (unsafeShiftR (n5 * 0x7C4ACDD) 27) where   go :: Word32 -> Word8   go !i = inlinePerformIO $ peekElemOff debruijn_log32 (fromIntegral i)-  !n1 = n0 .|. shiftR n0 1-  !n2 = n1 .|. shiftR n1 2-  !n3 = n2 .|. shiftR n2 4-  !n4 = n3 .|. shiftR n3 8-  !n5 = n4 .|. shiftR n4 16+  !n1 = n0 .|. unsafeShiftR n0 1+  !n2 = n1 .|. unsafeShiftR n1 2+  !n3 = n2 .|. unsafeShiftR n2 4+  !n4 = n3 .|. unsafeShiftR n3 8+  !n5 = n4 .|. unsafeShiftR n4 16 {-# INLINE log2 #-} -class (Num t, Bits t) => Ranked t where+class (Num t, FiniteBits t) => Ranked t where   -- | Calculate the least significant set bit using a debruijn multiplication table.   -- /NB:/ The result of this function is undefined when given 0.   lsb :: t -> Int@@ -58,39 +63,39 @@   nlz :: t -> Int  instance Ranked Word64 where-  lsb n = fromIntegral $ go (shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58) where+  lsb n = fromIntegral $ go (unsafeShiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58) where     go :: Word64 -> Word8     go i = inlinePerformIO $ peekElemOff debruijn_lsb64 (fromIntegral i)   {-# INLINE lsb #-}    nlz x0 = popCount (complement x6) where-     x1 = x0 .|. shiftR x0 1-     x2 = x1 .|. shiftR x1 2-     x3 = x2 .|. shiftR x2 4-     x4 = x3 .|. shiftR x3 8-     x5 = x4 .|. shiftR x4 16-     x6 = x5 .|. shiftR x5 32+     x1 = x0 .|. unsafeShiftR x0 1+     x2 = x1 .|. unsafeShiftR x1 2+     x3 = x2 .|. unsafeShiftR x2 4+     x4 = x3 .|. unsafeShiftR x3 8+     x5 = x4 .|. unsafeShiftR x4 16+     x6 = x5 .|. unsafeShiftR x5 32   {-# INLINE nlz #-}  instance Ranked Word32 where-  lsb n = fromIntegral $ go (shiftR ((n .&. (-n)) * 0x077CB531) 27) where+  lsb n = fromIntegral $ go (unsafeShiftR ((n .&. (-n)) * 0x077CB531) 27) where     go :: Word32 -> Word8     go i = inlinePerformIO $ peekElemOff debruijn_lsb32 (fromIntegral i)   {-# INLINE lsb #-}  {--  rank n = fromIntegral $ go (shiftR ((n .&. (-n)) * 0x4279976B) 26) where+  rank n = fromIntegral $ go (unsafeShiftR ((n .&. (-n)) * 0x4279976B) 26) where     go :: Word32 -> Word8     go i = inlinePerformIO $ peekElemOff debruijn_rank32 (fromIntegral i)   {-# INLINE rank #-} -}    nlz x0 = popCount (complement x5) where-     x1 = x0 .|. shiftR x0 1-     x2 = x1 .|. shiftR x1 2-     x3 = x2 .|. shiftR x2 4-     x4 = x3 .|. shiftR x3 8-     x5 = x4 .|. shiftR x4 16+     x1 = x0 .|. unsafeShiftR x0 1+     x2 = x1 .|. unsafeShiftR x1 2+     x3 = x2 .|. unsafeShiftR x2 4+     x4 = x3 .|. unsafeShiftR x3 8+     x5 = x4 .|. unsafeShiftR x4 16   {-# INLINE nlz #-}  @@ -102,10 +107,10 @@   {-# INLINE rank #-}    nlz x0 = popCount (complement x4) where-     x1 = x0 .|. shiftR x0 1-     x2 = x1 .|. shiftR x1 2-     x3 = x2 .|. shiftR x2 4-     x4 = x3 .|. shiftR x3 8+     x1 = x0 .|. unsafeShiftR x0 1+     x2 = x1 .|. unsafeShiftR x1 2+     x3 = x2 .|. unsafeShiftR x2 4+     x4 = x3 .|. unsafeShiftR x3 8   {-# INLINE nlz #-}  instance Ranked Word8 where@@ -116,9 +121,9 @@   {-# INLINE rank #-}    nlz x0 = popCount (complement x3) where-     x1 = x0 .|. shiftR x0 1-     x2 = x1 .|. shiftR x1 2-     x3 = x2 .|. shiftR x2 4+     x1 = x0 .|. unsafeShiftR x0 1+     x2 = x1 .|. unsafeShiftR x1 2+     x3 = x2 .|. unsafeShiftR x2 4   {-# INLINE nlz #-}  instance Ranked Int64 where@@ -180,6 +185,26 @@ w64 :: Integral a => a -> Word64 w64 = fromIntegral {-# INLINE w64 #-}++-- | Calculate the most significant set bit.+msb :: Ranked t => t -> Int+msb n = finiteBitSize n - nlz n - 1+{-# INLINE msb #-}++assignBit :: Bits b => b -> Int -> Bool -> b+assignBit b n  True = b `setBit` n+assignBit b n False = b `clearBit` n+{-# INLINE assignBit #-}++oneBits :: Bits b => b+oneBits  = complement zeroBits++-- | Shift Right Logical (i.e., without sign extension)+--+-- /NB:/ When used on negative 'Integer's, hilarity may ensue.+srl :: Bits b => b -> Int -> b+srl b n = (b `shiftR` n) .&. rotateR (oneBits `shiftL` n) n+{-# INLINE srl #-}  ------------------------------------------------------------------------------ -- de Bruijn Multiplication Tables