beamable 0.1.0.1 → 0.1.0.2
raw patch · 5 files changed
+147/−69 lines, 5 filesdep +criterion
Dependencies added: criterion
Files
- beamable.cabal +18/−1
- bench/Bench.hs +31/−0
- src/Data/Beamable/Int.hs +47/−47
- src/Data/Beamable/Internal.hs +32/−21
- src/Data/Beamable/Splits.hs +19/−0
beamable.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.1+version: 0.1.0.2 -- A short (one-line) description of the package. synopsis: Generic serializer/deserializer with compact representation@@ -60,6 +60,7 @@ other-modules: Data.Beamable.Int Data.Beamable.Integer+ Data.Beamable.Splits -- Other library packages from which modules are imported. build-depends:@@ -87,6 +88,22 @@ ghc-prim, integer-gmp >= 0.4 && < 0.6, murmur-hash >= 0.1 && < 0.2++benchmark beamable-bench+ type: exitcode-stdio-1.0+ hs-source-dirs: src bench+ main-is: Bench.hs++ build-depends:+ criterion >= 0.6 && < 0.9,+ -- Copied from regular dependencies...+ base >= 4.5 && < 4.8,+ blaze-builder >= 0.3,+ bytestring >= 0.9,+ ghc-prim,+ integer-gmp >= 0.4 && < 0.6,+ murmur-hash >= 0.1 && < 0.2+ source-repository head type: git
+ bench/Bench.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE BangPatterns #-}+module Main where++import Criterion+import Criterion.Main+import Data.Beamable+import Data.List (sort)+import Data.Word++main :: IO ()+main = defaultMain+ [ bgroup "roundTrip" rtGroup+ ]+ where+ !_unused = sum testWords+ !_unused' = sum testInts++rtGroup =+ [ bgroup "Int" $ map mkBenchRT testInts+ , bgroup "Word" $ map mkBenchRT testWords+ ]++mkBenchRT x = bench (show x) $ whnf ((`asTypeOf` x) . decode . encode) x++test10s :: [Word]+test10s = 0:[10^x | x <- [0..10]]+testWords = sort $ test10s ++ map (*5) test10s++testInts :: [Int]+testInts = let xs = map fromIntegral testWords+ in reverse (map negate xs) ++ tail xs
src/Data/Beamable/Int.hs view
@@ -1,81 +1,81 @@+{-# LANGUAGE BangPatterns #-}+ module Data.Beamable.Int ( beamInt , unbeamInt+ , pokeWord8 ) where -import Data.Bits ((.|.), (.&.), shift, testBit)-import qualified Data.ByteString as B-import Data.List (unfoldr)-import Data.Word (Word8)-import Data.Int (Int64)-+import Data.Beamable.Splits import Blaze.ByteString.Builder+import qualified Blaze.ByteString.Builder.Internal.Write as Write+import Data.Bits ((.|.), (.&.), shift, shiftR)+import Data.Int (Int64)+import Data.Monoid ((<>))+import Foreign.Storable+import GHC.Word+import qualified Data.ByteString as B {- Beamed int representation: -1. The integer is chunked up into 7-bit groups. Each of these 7bit-chunks are encoded as a single octet.+1. The integer is chunked up into 7-bit groups, little-endian.+ Each of these 7bit chunks are encoded as a single octet. 2. All the octets except the last one has its 8th bit set. -3. 7th bit of the first octet represents sign.--3. Octets with bits 1..7 containing only 1 or 0 can be ignored when it's not affecting the sign:+3. 7th bit of the last octet represents sign. 0 | 0 0000000 1 | 0 0000001 63 | 0 0111111-64 | 1 0000000 0 1000000-127 | 1 0000000 0 1111111-128 | 1 0000001 0 0000000-8191 | 1 0111111 0 1111111+64 | 1 1000000 0 0000000+127 | 1 1111111 0 0000000+128 | 1 0000000 0 0000001+8191 | 1 1111111 0 0111111 8192 | 1 0000000 1 1000000 0 0000000-65535 | 1 0000011 1 1111111 0 1111111+65535 | 1 1111111 1 1111111 0 0000011 -1 | 0 1111111 -64 | 0 1000000--65 | 1 1111111 0 0111111--127 | 1 1111111 0 0000001--128 | 1 1111111 0 0000000--129 | 1 1111110 0 0111111--8191 | 1 1000000 0 0000001--8192 | 1 1000000 0 0000000+-65 | 1 0111111 0 1111111+-127 | 1 0000001 0 1111111+-128 | 1 0000000 0 1111111+-129 | 1 1111111 0 1111110+-8191 | 1 0000001 0 1000000+-8192 | 1 0000000 0 1000000 -8193 | 1 1111111 1 0111111 0 1111111 -} --- This might not work well for 32bit platform-beamInt :: Int64 -> Builder -- {{{-beamInt 0 = fromWord8 0-beamInt n = toBldr . bitmark . reverse . unfoldr f $ n+beamInt :: Int64 -> Builder+beamInt !n = fromWrite $ Write.boundedWrite 10 $ beamIntPoke n+{-# INLINE beamInt #-}++beamIntPoke :: Int64 -> Write.Poke+beamIntPoke n+ | isZeroOrMinus1 (n `shiftR` 6) = pokeWord8 firstSeptet+ | otherwise =+ pokeWord8 (firstSeptet .|. 0x80) <> beamIntPoke next where- f :: Int64 -> Maybe (Word8, Int64)- f 0 = Nothing- f x = let w = fromIntegral x .&. 0x7F :: Word8- rest = x `shift` (negate 7)- in Just (w, if rest == (-1) then 0 else rest)+ firstSeptet :: Word8+ firstSeptet = fromIntegral $ n .&. 0x7F+ next = n `shiftR` 7 - bitmark :: [Word8] -> [Word8]- bitmark (w:[]) = [w]- bitmark (w:ws) = (w .|. 0x80) : bitmark ws- bitmark [] = []+ isZeroOrMinus1 x = (x + 1) `shiftR` 1 == 0 - toBldr :: [Word8] -> Builder- toBldr ws =- let ws' = if testBit (head ws) 6- then if n > 0 then 0x80:ws else ws- else if n > 0 then ws else 0xFF:ws- in fromWriteList writeWord8 ws'+pokeWord8 :: Word8 -> Write.Poke+pokeWord8 w = Write.pokeN 1 $ flip poke w +{-# INLINE unbeamInt #-} -- This might not work well for 32bit platform unbeamInt :: B.ByteString -> (Int64, B.ByteString)-unbeamInt bs = (fixSign (B.foldl f 0 this), rest)+unbeamInt bs = (fixSign (B.foldr' f 0 this), rest) where- f :: Int64 -> Word8 -> Int64- f i w = (i `shift` 7) .|. fromIntegral (w .&. 0x7F)+ f :: Word8 -> Int64 -> Int64+ f w i = (i `shift` 7) .|. fromIntegral (w .&. 0x7F) fixSign :: Int64 -> Int64 fixSign x = x `shift` (64 - l * 7) `shift` (l * 7 - 64) - Just lastWord = B.findIndex (not . flip testBit 7) bs- l = lastWord + 1- (this, rest) = B.splitAt l bs-- }}}+ !l = B.length this+ !(!this, !rest) = splitAtLastWord bs+ -- }}}
src/Data/Beamable/Internal.hs view
@@ -15,17 +15,19 @@ import Data.Beamable.Int import Data.Beamable.Integer+import Data.Beamable.Splits import Data.Beamable.Util import Blaze.ByteString.Builder+import qualified Blaze.ByteString.Builder.Internal.Write as Write import Data.Digest.Murmur64 import Control.Arrow (first)-import Data.Bits ((.|.), (.&.), shift, testBit)+import Data.Bits ((.|.), (.&.), shift, shiftL, shiftR, testBit) import Data.ByteString (ByteString) import Data.Char (ord, chr) import Data.Int (Int8, Int16, Int32, Int64)-import Data.Monoid (mempty, mappend, mconcat)+import Data.Monoid (mempty, mappend, mconcat, (<>)) import Data.Word (Word, Word8, Word16, Word32, Word64) import Foreign.Storable import GHC.Generics@@ -94,6 +96,7 @@ -- values are prefixed by uniq number for each constructor instance (GBeamable a, Constructor c) => GBeamable (M1 C c a) where gbeam (M1 x) t@(_, dirs) = mappend (beamWord $ fromIntegral dirs) (gbeam x t)+ {-# INLINE gbeam #-} gunbeam bs = first M1 . gunbeam bs gtypeSign prev x = signMur (conName x, '<', gtypeSign prev (unM1 x)) @@ -110,7 +113,7 @@ -- choose correct constructor based on the first word uncoded from the BS (dirs variable) instance (GBeamable a, GBeamable b) => GBeamable (a :+: b) where gbeam (L1 x) (lev, dirs) = gbeam x (lev + 1, dirs)- gbeam (R1 x) (lev, dirs) = gbeam x (lev + 1, dirs + 2^lev)+ gbeam (R1 x) (lev, dirs) = gbeam x (lev + 1, dirs + (1 `shiftL` lev)) gunbeam bs (lev, dirs) = if testBit dirs lev then first R1 $ gunbeam bs (lev + 1, dirs) else first L1 $ gunbeam bs (lev + 1, dirs)@@ -138,29 +141,37 @@ gunbeam bs _ = first K1 (unbeam bs) gtypeSign prev x = signMur ('K', typeSignR prev (unK1 x)) --- | [un]beamWord functions are a bit more efficient than [un]beamInt--- it assumes that values are non-negative which allows more compact representation+{-+Beamed word representation:+ Same as positive ints, except that the last octet is dropped if it's 0. -beamWord :: Word64 -> Builder-- {{{-beamWord 0 = fromWord8 0-beamWord i = fromByteString . B.reverse . fst $ B.unfoldrN 10 octets (i, True)- where- octets :: (Word64, Bool) -> Maybe (Word8, (Word64, Bool))- octets (x, isFirst)- | x > 0 = let r = (fromIntegral (x .&. 0x7F)) .|. (if isFirst then 0 else 0x80)- in Just (r, (x `shift` (negate 7), False))- | otherwise = Nothing+63 | 0 0111111+64 | 1 1000000+127 | 1 1111111+128 | 1 0000000 0 0000001+-} +beamWord :: Word64 -> Builder+beamWord !n = fromWrite $ Write.boundedWrite 10 $ beamWordPoke n+{-# INLINE beamWord #-} -unbeamWord :: B.ByteString -> (Word64, B.ByteString)-unbeamWord bs = (B.foldl f 0 this, rest)+beamWordPoke :: Word64 -> Write.Poke+beamWordPoke n+ | next == 0 = pokeWord8 firstSeptet+ | otherwise = pokeWord8 (firstSeptet .|. 0x80) <> beamWordPoke next where- f :: Word64 -> Word8 -> Word64- f i w = (i `shift` 7) .|. fromIntegral (w .&. 0x7F)-- Just lastWord = B.findIndex (not . flip testBit 7) bs- (this, rest) = B.splitAt (lastWord + 1) bs+ firstSeptet :: Word8+ firstSeptet = fromIntegral $ n .&. 0x7F+ next = n `shiftR` 7 +{-# INLINE unbeamWord #-}+unbeamWord :: B.ByteString -> (Word64, B.ByteString)+unbeamWord bs = (B.foldr' f 0 this, rest)+ where+ f :: Word8 -> Word64 -> Word64+ f w i = (i `shift` 7) .|. fromIntegral (w .&. 0x7F)+ !(!this, !rest) = splitAtLastWord bs+--}} {-# SPECIALIZE beamWordX :: Word8 -> Builder #-} {-# SPECIALIZE beamWordX :: Word16 -> Builder #-}
+ src/Data/Beamable/Splits.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE BangPatterns #-}++module Data.Beamable.Splits (+ splitAtLastWord,+) where++import Data.Bits ((.&.))+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B++{-# INLINE splitAtLastWord #-}+splitAtLastWord :: B.ByteString -> (B.ByteString, B.ByteString)+splitAtLastWord bs = let err = error "corrupted stream"+ !pos = maybe err (+1) $ B.findIndex (\w -> w .&. 0x80 /= 0x80) bs+ !this = B.unsafeTake pos bs+ !rest = B.unsafeDrop pos bs+ in (this, rest)++