Permalink
Browse files

fix #3: improved benchmarking by Bas Van Dijk

  • Loading branch information...
meiersi committed May 12, 2012
2 parents d2bc3f0 + c33b5d7 commit 4883a44f6d44ab9e586de6d0b8690d3055743df7
View

Large diffs are not rendered by default.

Oops, something went wrong.
View
@@ -1,30 +0,0 @@
-Copyright (c) 2012, Simon Meier
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
- * Redistributions in binary form must reproduce the above
- copyright notice, this list of conditions and the following
- disclaimer in the documentation and/or other materials provided
- with the distribution.
-
- * Neither the name of Simon Meier nor the names of other
- contributors may be used to endorse or promote products derived
- from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
View
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
@@ -1,31 +0,0 @@
-name: blaze-binary-bench
-version: 0.1.0.0
-synopsis: Benchmarks for the blaze-binary library
--- description:
-homepage: git://github.com/meiersi/blaze-binary.git
-license: BSD3
-license-file: LICENSE
-author: Simon Meier <iridcode@gmail.com>
-maintainer: Simon Meier <iridcode@gmail.com>
--- copyright:
-category: System
-build-type: Simple
-cabal-version: >=1.8
-
-executable blaze-binary-bench
- main-is: Benchmark.hs
- hs-source-dirs: src .
- -- Currently we are benchmarking with GHC 7.4.1
- build-depends: base
- , ghc-prim
- , containers == 0.4.*
- , array == 0.4.*
- , bytestring == 0.9.*
- , criterion
- , cereal == 0.3.*
- -- The 'cps' branch from https://github.com/kolmodin/binary.git
- , binary == 0.6.0.0
- , bytestring-builder == 0.1.*
- , deepseq == 1.3.*
- , primitive == 0.4.*
- , attoparsec == 0.10.*
View
@@ -33,14 +33,31 @@ library
hs-source-dirs: src
exposed-modules: Data.Blaze.Binary
- extensions: FlexibleContexts
- , FlexibleInstances
- , MagicHash
- , BangPatterns
- , OverloadedStrings
ghc-options: -Wall
ghc-prof-options: -prof -auto-all
if impl(ghc >= 7.2.1)
cpp-options: -DGENERICS
+
+benchmark bench
+ type: exitcode-stdio-1.0
+ main-is: Benchmark.hs
+ hs-source-dirs: bench, src
+ build-depends: base >= 4 && < 5
+ , ghc-prim >= 0.2 && < 0.3
+ , containers >= 0.4 && < 0.5
+ , array >= 0.4 && < 0.5
+ , bytestring >= 0.9 && < 0.10
+ , criterion >= 0.6 && < 0.7
+ , cereal >= 0.3 && < 0.4
+ -- Use the 'cps' branch from https://github.com/kolmodin/binary.git
+ -- for binary-0.6.0.0
+ , binary >= 0.6 && < 0.7
+ , bytestring-builder >= 0.1 && < 0.2
+ , deepseq >= 1.3 && < 1.4
+ , primitive >= 0.4 && < 0.5
+ , attoparsec >= 0.10 && < 0.11
+
+ if impl(ghc >= 7.2.1)
+ cpp-options: -DGENERICS
View
@@ -75,9 +75,11 @@ class Binary t where
#ifdef GENERICS
default encode :: (Generic t, GBinary (Rep t)) => Encoding t
encode = gEncode . from
+ {-# INLINE encode #-}
default decode :: (Generic t, GBinary (Rep t)) => D.Decoder t
decode = to <$> gDecode
+ {-# INLINE decode #-}
#endif
-- | Encode a value to a strict 'S.ByteString'.
@@ -1,10 +1,10 @@
-{-# LANGUAGE UnboxedTuples, MagicHash, ScopedTypeVariables, BangPatterns, DeriveDataTypeable, OverloadedStrings #-}
+{-# LANGUAGE CPP, UnboxedTuples, MagicHash, ScopedTypeVariables, BangPatterns, DeriveDataTypeable, OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Blaze.Binary.Encoding
-- Copyright : 2012, Simon Meier <iridcode@gmail.com>
-- License : BSD3-style (see LICENSE)
---
+--
-- Maintainer : Simon Meier <iridcode@gmail.com>
-- Stability :
-- Portability : portable
@@ -19,28 +19,36 @@ import Prelude hiding (catch)
import Control.Applicative
import Control.Exception
+import Data.Int (Int8, Int16, Int32, Int64)
import Data.Typeable
import qualified Data.ByteString.Internal as S
import GHC.Prim
import GHC.Ptr
import GHC.Word
import GHC.Exts
import GHC.IO (IO(IO))
-import Foreign
+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
+import Foreign.Storable (Storable, sizeOf, peek)
+
+#if __GLASGOW_HASKELL__ >= 702
+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
+#else
+import Foreign.ForeignPtr (unsafeForeignPtrToPtr)
+#endif
data ParseException = ParseException String -- {-# UNPACK #-} !(Ptr Word8)
deriving( Show, Typeable )
instance Exception ParseException where
-newtype Decoder a = Decoder {
- -- unDecoder :: ForeignPtr Word8 -> Addr# -> Addr#
+newtype Decoder a = Decoder {
+ -- unDecoder :: ForeignPtr Word8 -> Addr# -> Addr#
unDecoder :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8
-> State# RealWorld -> (# State# RealWorld, Addr#, a #)
}
instance Functor Decoder where
- fmap f = \(Decoder io) -> Decoder $ \fpbuf ip0 ipe s0 ->
+ fmap f = \(Decoder io) -> Decoder $ \fpbuf ip0 ipe s0 ->
case io fpbuf ip0 ipe s0 of
(# s1, ip1, x #) -> (# s1, ip1, f x #)
@@ -82,19 +90,19 @@ requires n p = Decoder $ \buf@(Buffer ip ipe) ->
if ipe `minusPtr` ip >= n
then unDecoder p buf
else throw $ ParseException $
- "required " ++ show n ++
+ "required " ++ show n ++
" bytes, but there are only " ++ show (ipe `minusPtr` ip) ++
" bytes left."
-}
{-# INLINE storable #-}
storable :: forall a. Storable a => Decoder a
storable = Decoder $ \fpbuf ip0 ipe s0 ->
- let ip1 = ip0 `plusPtr` size in
+ let ip1 = ip0 `plusPtr` size in
if ip1 <= ipe
then case runIO (peek (castPtr ip0 :: Ptr a)) s0 of
(# s1, x #) -> (# s1, getAddr ip1, x #)
- else unDecoder
+ else unDecoder
(fail $ "less than the required " ++ show size ++ " bytes left.")
fpbuf ip0 ipe s0
where
@@ -172,13 +180,13 @@ byteString = int >>= byteStringSlice
byteStringSlice :: Int -> Decoder S.ByteString
byteStringSlice len = Decoder $ \fpbuf ip0 ipe s0 ->
let ip1 = ip0 `plusPtr` len
- in
+ in
if ip1 <= ipe
then (# s0
, getAddr ip1
, S.PS fpbuf (ip0 `minusPtr` unsafeForeignPtrToPtr fpbuf) len
#)
- else unDecoder
+ else unDecoder
(fail $ "less than the required " ++ show len ++ " bytes left.")
fpbuf ip0 ipe s0
@@ -200,9 +208,9 @@ getAddr (Ptr a) = a
{-# INLINE decodeList #-}
decodeList :: Decoder a -> Decoder [a]
-decodeList x =
+decodeList x =
go
- where
+ where
go = do tag <- word8
case tag of
0 -> return []
@@ -211,9 +219,9 @@ decodeList x =
{-# INLINE decodeMaybe #-}
decodeMaybe :: Decoder a -> Decoder (Maybe a)
-decodeMaybe just =
+decodeMaybe just =
go
- where
+ where
go = do tag <- word8
case tag of
0 -> return Nothing
@@ -222,12 +230,12 @@ decodeMaybe just =
{-# INLINE decodeEither #-}
decodeEither :: Decoder a -> Decoder b -> Decoder (Either a b)
-decodeEither left right =
+decodeEither left right =
go
- where
+ where
go = do tag <- word8
case tag of
- 0 -> Left <$> left
+ 0 -> Left <$> left
1 -> Right <$> right
_ -> fail $ "decodeEither: unexpected tag " ++ show tag
@@ -19,6 +19,7 @@ module Data.Blaze.Binary.Encoding (
-- * Streams of values to be encoded
, VStream
, render
+ , renderCompact
, renderTagged
, renderTextualUtf8
@@ -119,7 +120,7 @@ renderCompact = renderWith
E.wordBase128LE
(E.fromF E.int8) E.int16ZigZagBase128LE E.int32ZigZagBase128LE E.int64ZigZagBase128LE
E.intZigZagBase128LE
- E.charUtf8
+ E.charUtf8
(E.fromF E.floatLE) (E.fromF E.doubleLE)
(error "render: integer: implement")
(\x -> E.encodeWithB E.intZigZagBase128LE (S.length x) <> B.byteString x)
@@ -1,4 +1,4 @@
-{-# LANGUAGE UnboxedTuples, BangPatterns #-}
+{-# LANGUAGE CPP, UnboxedTuples, BangPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Blaze.Binary.Encoding
@@ -21,7 +21,15 @@ import Control.Applicative
import qualified Data.ByteString.Internal as S
-import Foreign
+import Foreign.Ptr (plusPtr)
+import Foreign.ForeignPtr (touchForeignPtr)
+import Foreign.Storable (peek)
+
+#if __GLASGOW_HASKELL__ >= 702
+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
+#else
+import Foreign.ForeignPtr (unsafeForeignPtrToPtr)
+#endif
------------------------------------------------------------------------
@@ -56,12 +64,12 @@ toVStream (S.PS fpbuf off len) =
ip0 = pbuf `plusPtr` off
ipe = ip0 `plusPtr` len
- go !ip
+ go !ip
| ip < ipe = S.inlinePerformIO $ do
w <- peek ip
touchForeignPtr fpbuf
return $ VWord8 w (go (ip `plusPtr` 1))
- | otherwise =
+ | otherwise =
VEmpty
runDecoder :: Decoder a -> S.ByteString -> Either String a
@@ -80,7 +88,7 @@ instance Applicative Decoder where
pure = \x -> Decoder $ \vs -> (# x, vs #)
{-# INLINE (<*>) #-}
- (<*>) = \fd xd -> Decoder $ \vs0 ->
+ (<*>) = \fd xd -> Decoder $ \vs0 ->
case unDecoder fd vs0 of
(# f, vs1 #) -> case unDecoder xd vs1 of
(# x, vs2 #) -> (# f x, vs2 #)
@@ -90,7 +98,7 @@ instance Monad Decoder where
return = pure
{-# INLINE (>>=) #-}
- (>>=) = \md f -> Decoder $ \vs0 ->
+ (>>=) = \md f -> Decoder $ \vs0 ->
case unDecoder md vs0 of
(# _, vs1@(VFail _) #) -> (# error "impossible", vs1 #)
(# m, vs1 #) -> unDecoder (f m) vs1

0 comments on commit 4883a44

Please sign in to comment.