Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
  • 2 commits
  • 5 files changed
  • 0 commit comments
  • 1 contributor
Commits on Apr 30, 2012
@meiersi implemented UTF-8 encoding for Builder 17bf155
Commits on May 01, 2012
@meiersi implemented a full copy of cereal that uses a tagged representation
It achieves a speedup of up to a factor 1.5x. However, serializing Seq's and
Tree's seems to be slightly slower, without INLINE pragmas. For highly
polymorphic functions this inlining might not happen and we might loose some
speed.
62da0cd
View
16 bench/Benchmark.hs
@@ -20,8 +20,8 @@ import qualified Data.Serialize2 as S2
import Data.Binary (Binary)
import qualified Data.Binary as Binary
--- import qualified Data.Sequence as Seq
--- import Data.Tree
+import qualified Data.Sequence as Seq
+import Data.Tree
------------------------------------------------------------------------------
@@ -30,7 +30,7 @@ import qualified Data.Binary as Binary
-- | The number of repetitions to consider.
nRepl :: Int
-nRepl = 100
+nRepl = 1000
-- We use NOINLINE to ensure that GHC has no chance of optimizing too much.
@@ -42,7 +42,6 @@ intData n = take n [0..]
stringData :: Int -> [String]
stringData n = take n $ cycle ["hello", "world"]
-{-
{-# NOINLINE seqIntData #-}
seqIntData :: Int -> Seq.Seq Int
seqIntData = Seq.fromList . intData
@@ -59,16 +58,15 @@ treeIntData n =
[Node r $ concatMap go [ls, rs]]
where
(ls, r:rs) = splitAt (length xs `div` 2) xs
--}
-- benchmarks
-------------
main :: IO ()
main = Criterion.Main.defaultMain $
- -- [ benchmarks "Tree Int memoized " id (treeIntData nRepl)
- -- , benchmarks "Seq Int memoized " id (seqIntData nRepl)
- [ benchmarks "[Int] memoized " id (intData nRepl)
+ [ benchmarks "Tree Int memoized " id (treeIntData nRepl)
+ , benchmarks "Seq Int memoized " id (seqIntData nRepl)
+ , benchmarks "[Int] memoized " id (intData nRepl)
-- , benchmarks "[Int] generated " intData nRepl
, benchmarks "[String] memoized" id (stringData nRepl)
-- , benchmarks "[String] generated" stringData nRepl
@@ -78,6 +76,6 @@ main = Criterion.Main.defaultMain $
=> String -> (b -> a) -> b -> Benchmark
benchmarks name f x = bgroup (name ++ show nRepl)
[ bench "cereal" $ whnf (L.length . encodeLazy . f) x
- , bench "flat value" $ whnf (L.length . S2.encodeLazy . f) x
+ , bench "value stream" $ whnf (L.length . S2.encodeLazy . f) x
, bench "binary" $ whnf (L.length . Binary.encode . f) x
]
View
49 src/Data/Serialize/Builder.hs
@@ -54,10 +54,14 @@ module Data.Serialize.Builder (
, putWord32host -- :: Word32 -> Builder
, putWord64host -- :: Word64 -> Builder
+ -- * UTF-8 encoding
+ , putCharUtf8
+
) where
import Data.Monoid
import Data.Word
+import Data.Bits
import Foreign.ForeignPtr
import Foreign.Ptr (Ptr,plusPtr)
import Foreign.Storable
@@ -217,7 +221,21 @@ ensureFree n = n `seq` withSize $ \ l ->
flush `append` unsafeLiftIO (const (newBuffer (max n defaultSize)))
{-# INLINE ensureFree #-}
--- | Ensure that @n@ many bytes are available, and then use @f@ to write some
+-- | Ensure that @n@ many bytes are available, and then use @f@ to write at
+-- most @n@ bytes into the memory.
+write :: Int -> (Ptr Word8 -> IO Int) -> Builder
+write n f = ensureFree n `append` unsafeLiftIO (writeBuffer f)
+{-# INLINE write #-}
+
+-- | Write to a buffer and return the number of bytes written.
+writeBuffer :: (Ptr Word8 -> IO Int) -> Buffer -> IO Buffer
+writeBuffer f (Buffer fp o u l) = do
+ n <- withForeignPtr fp (\p -> f (p `plusPtr` (o + u)))
+ return (Buffer fp o (u + n) (l - n))
+{-# INLINE writeBuffer #-}
+
+
+-- | Ensure that @n@ many bytes are available, and then use @f@ to write @n@
-- bytes into the memory.
writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder
writeN n f = ensureFree n `append` unsafeLiftIO (writeNBuffer n f)
@@ -427,3 +445,32 @@ shiftr_w16 = shiftR
shiftr_w32 = shiftR
shiftr_w64 = shiftR
#endif
+
+
+-- | Encode a 'Char' using UTF-8.
+putCharUtf8 :: Char -> Builder
+putCharUtf8 c = write 4 $ \op -> case ord c of
+ x | x <= 0x7F -> do
+ poke8 op 0 x
+ return 1
+ | x <= 0x07FF -> do
+ poke8 op 0 $ (x `shiftR` 6) + 0xC0
+ poke8 op 1 $ (x .&. 0x3F) + 0x80
+ return 2
+ | x <= 0xFFFF -> do
+ poke8 op 0 $ (x `shiftR` 12) + 0xE0
+ poke8 op 1 $ ((x `shiftR` 6) .&. 0x3F) + 0x80
+ poke8 op 2 $ (x .&. 0x3F) + 0x80
+ return 3
+ | otherwise -> do
+ poke8 op 0 $ (x `shiftR` 18) + 0xF0
+ poke8 op 1 $ ((x `shiftR` 12) .&. 0x3F) + 0x80
+ poke8 op 2 $ ((x `shiftR` 6) .&. 0x3F) + 0x80
+ poke8 op 3 $ (x .&. 0x3F) + 0x80
+ return 4
+
+ where
+ poke8 :: Ptr Word8 -> Int -> Int -> IO ()
+ poke8 op n = pokeByteOff op n . (fromIntegral :: Int -> Word8)
+ {-# INLINE poke8 #-}
+
View
138 src/Data/Serialize/Put2.hs
@@ -18,13 +18,12 @@ module Data.Serialize.Put2 (
Put
, PutM(..)
, Putter
- -- , runPut
- -- , runPutM
+ , runPut
+ , runPutM
, runPutLazy
, tell
- {-
, runPutMLazy
- , putFlatValueBuilder
+ , putBuilder
, execPut
-- * Flushing the implicit parse state
@@ -35,6 +34,9 @@ module Data.Serialize.Put2 (
, putByteString
, putLazyByteString
+ -- * Unicode characters
+ , putCharUtf8
+
-- * Big-endian primitives
, putWord16be
, putWord32be
@@ -62,41 +64,41 @@ module Data.Serialize.Put2 (
, putIntSetOf
, putMaybeOf
, putEitherOf
- -}
, putListOf
) where
-import Data.Serialize.FlatValue (FlatValueBuilder)
-import qualified Data.Serialize.FlatValue as FV
+import Data.Serialize.VStream (VStream)
+import qualified Data.Serialize.VStream as VS
+import qualified Data.Serialize.Builder as B
import Control.Applicative
--- import Data.Array.Unboxed
+import Data.Array.Unboxed
import Data.Monoid
import Data.Foldable (foldMap)
--- import Data.Word
--- import qualified Data.ByteString as S
+import Data.Word
+import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
--- import qualified Data.IntMap as IntMap
--- import qualified Data.IntSet as IntSet
--- import qualified Data.Map as Map
--- import qualified Data.Sequence as Seq
--- import qualified Data.Set as Set
--- import qualified Data.Tree as T
+import qualified Data.IntMap as IntMap
+import qualified Data.IntSet as IntSet
+import qualified Data.Map as Map
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+import qualified Data.Tree as T
------------------------------------------------------------------------
-- XXX Strict in builder only.
-data PairS a = PairS a FlatValueBuilder
+data PairS a = PairS a VStream
-sndS :: PairS a -> FlatValueBuilder
+sndS :: PairS a -> VStream
sndS (PairS _ b) = b
--- | The PutM type. A Writer monad over the efficient FlatValueBuilder monoid.
+-- | The PutM type. A Writer monad over the efficient VStream monoid.
newtype PutM a = Put { unPut :: PairS a }
--- | Put merely lifts FlatValueBuilder into a Writer monad, applied to ().
+-- | Put merely lifts VStream into a Writer monad, applied to ().
type Put = PutM ()
type Putter a = a -> Put
@@ -133,46 +135,51 @@ instance Monad PutM where
in PairS b (w `mappend` w')
{-# INLINE (>>) #-}
-tell :: Putter FlatValueBuilder
-tell b = Put $ PairS () b
+-- | Add another 'VStream'.
+tellVStream :: Putter VStream
+tellVStream = Put . PairS ()
+{-# INLINE tellVStream #-}
+
+-- | Get the embedded 'VStream'.
+getVStream :: PutM a -> VStream
+getVStream = sndS . unPut
+{-# INLINE getVStream #-}
+
+tell :: Putter B.Builder
+tell b = Put $ PairS () (VS.builder b)
{-# INLINE tell #-}
-putFlatValueBuilder :: Putter FlatValueBuilder
-putFlatValueBuilder = tell
-{-# INLINE putFlatValueBuilder #-}
+putBuilder :: Putter B.Builder
+putBuilder = tell
+{-# INLINE putBuilder #-}
-- | Run the 'Put' monad
-execPut :: PutM a -> FlatValueBuilder
-execPut = sndS . unPut
+execPut :: PutM a -> B.Builder
+execPut = VS.encode . getVStream
{-# INLINE execPut #-}
-{-
-- | Run the 'Put' monad with a serialiser
runPut :: Put -> S.ByteString
-runPut = toByteString . sndS . unPut
+runPut = B.toByteString . execPut
{-# INLINE runPut #-}
-- | Run the 'Put' monad with a serialiser and get its result
runPutM :: PutM a -> (a, S.ByteString)
-runPutM (Put (PairS f s)) = (f, toByteString s)
+runPutM (Put (PairS f s)) = (f, B.toByteString $ VS.encode s)
{-# INLINE runPutM #-}
--}
-- | Run the 'Put' monad with a serialiser
runPutLazy :: Put -> L.ByteString
-runPutLazy = FV.toLazyByteString . sndS . unPut
+runPutLazy = B.toLazyByteString . execPut
{-# INLINE runPutLazy #-}
-{-
-- | Run the 'Put' monad with a serialiser
runPutMLazy :: PutM a -> (a, L.ByteString)
-runPutMLazy (Put (PairS f s)) = (f, toLazyByteString s)
+runPutMLazy (Put (PairS f s)) = (f, B.toLazyByteString $ VS.encode s)
{-# INLINE runPutMLazy #-}
--}
------------------------------------------------------------------------
-{-
-- | Pop the ByteString we have constructed so far, if any, yielding a
-- new chunk in the result ByteString.
flush :: Put
@@ -181,46 +188,54 @@ flush = tell B.flush
-- | Efficiently write a byte into the output buffer
putWord8 :: Putter Word8
-putWord8 = tell . B.singleton
+putWord8 = tellVStream . VS.word8
{-# INLINE putWord8 #-}
-- | An efficient primitive to write a strict ByteString into the output buffer.
-- It flushes the current buffer, and writes the argument into a new chunk.
putByteString :: Putter S.ByteString
-putByteString = tell . B.fromByteString
+putByteString = tellVStream . VS.byteString
{-# INLINE putByteString #-}
-- | Write a lazy ByteString efficiently, simply appending the lazy
-- ByteString chunks to the output buffer
putLazyByteString :: Putter L.ByteString
-putLazyByteString = tell . B.fromLazyByteString
+putLazyByteString = tellVStream . VS.lazyByteString
{-# INLINE putLazyByteString #-}
+-- | Write a 'Char' using UTF-8.
+putCharUtf8 :: Putter Char
+putCharUtf8 = tellVStream . VS.char
+{-# INLINE putCharUtf8 #-}
+
-- | Write a Word16 in big endian format
putWord16be :: Putter Word16
-putWord16be = tell . B.putWord16be
+putWord16be = tellVStream . VS.word16
{-# INLINE putWord16be #-}
--- | Write a Word16 in little endian format
-putWord16le :: Putter Word16
-putWord16le = tell . B.putWord16le
-{-# INLINE putWord16le #-}
-
-- | Write a Word32 in big endian format
putWord32be :: Putter Word32
-putWord32be = tell . B.putWord32be
+putWord32be = tellVStream . VS.word32
{-# INLINE putWord32be #-}
+-- | Write a Word64 in big endian format
+putWord64be :: Putter Word64
+putWord64be = tellVStream . VS.word64
+{-# INLINE putWord64be #-}
+
+-- Hmm. In a future serialization library, we should get rid of these
+-- functions. They just clutter the API.
+
+-- | Write a Word16 in little endian format. /Currently slow/
+putWord16le :: Putter Word16
+putWord16le = tell . B.putWord16le
+{-# INLINE putWord16le #-}
+
-- | Write a Word32 in little endian format
putWord32le :: Putter Word32
putWord32le = tell . B.putWord32le
{-# INLINE putWord32le #-}
--- | Write a Word64 in big endian format
-putWord64be :: Putter Word64
-putWord64be = tell . B.putWord64be
-{-# INLINE putWord64be #-}
-
-- | Write a Word64 in little endian format
putWord64le :: Putter Word64
putWord64le = tell . B.putWord64le
@@ -256,26 +271,23 @@ putWord32host = tell . B.putWord32host
putWord64host :: Putter Word64
putWord64host = tell . B.putWord64host
{-# INLINE putWord64host #-}
--}
+
-- Containers ------------------------------------------------------------------
-encodeListOf :: (a -> FlatValueBuilder) -> [a] -> FlatValueBuilder
+encodeListOf :: (a -> VStream) -> [a] -> VStream
encodeListOf f = -- allow inlining with just a single argument
- \xs -> FV.putInt (length xs) `mappend`
- foldMap f xs
+ \xs -> VS.int (length xs) `mappend` foldMap f xs
{-# INLINE encodeListOf #-}
putListOf :: Putter a -> Putter [a]
-putListOf pa = tell . encodeListOf (execPut . pa)
+putListOf pa = tellVStream . encodeListOf (getVStream . pa)
{-# INLINE putListOf #-}
-{-
putTwoOf :: Putter a -> Putter b -> Putter (a,b)
putTwoOf pa pb (a,b) = pa a >> pb b
{-# INLINE putTwoOf #-}
-
putIArrayOf :: (Ix i, IArray a e) => Putter i -> Putter e -> Putter (a i e)
putIArrayOf pix pe a = do
putTwoOf pix pix (bounds a)
@@ -283,16 +295,15 @@ putIArrayOf pix pe a = do
{-# INLINE putIArrayOf #-}
putSeqOf :: Putter a -> Putter (Seq.Seq a)
-putSeqOf pa = \s -> do
- putWord64be (fromIntegral $ Seq.length s)
- tell (foldMap (execPut . pa) s)
+putSeqOf pa = \s ->
+ tellVStream (VS.int (Seq.length s) `mappend` foldMap (getVStream . pa) s)
{-# INLINE putSeqOf #-}
putTreeOf :: Putter a -> Putter (T.Tree a)
putTreeOf pa =
- tell . go
+ tellVStream . go
where
- go (T.Node x cs) = execPut (pa x) `mappend` encodeListOf go cs
+ go (T.Node x cs) = getVStream (pa x) `mappend` encodeListOf go cs
{-# INLINE putTreeOf #-}
putMapOf :: Ord k => Putter k -> Putter a -> Putter (Map.Map k a)
@@ -320,4 +331,3 @@ putEitherOf :: Putter a -> Putter b -> Putter (Either a b)
putEitherOf pa _ (Left a) = putWord8 0 >> pa a
putEitherOf _ pb (Right b) = putWord8 1 >> pb b
{-# INLINE putEitherOf #-}
--}
View
157 src/Data/Serialize/VStream.hs
@@ -0,0 +1,157 @@
+{-# LANGUAGE BangPatterns #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Serialize.VStream
+-- Copyright : 2012, Simon Meier <iridcode@gmail.com>
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : Trevor Elliott <trevor@galois.com>
+-- Stability :
+-- Portability : portable
+--
+-- Representation and renderings of a stream of values that should be binary
+-- encoded.
+--
+-----------------------------------------------------------------------------
+module Data.Serialize.VStream (
+
+ -- * Streams of values to be encoded
+ VStream
+ , encode
+
+ -- ** Construction
+ , word
+ , word8
+ , word16
+ , word32
+ , word64
+
+ , int
+ , int8
+ , int16
+ , int32
+ , int64
+
+ , char
+
+ , byteString
+ , lazyByteString
+
+ , builder
+
+ ) where
+
+import Prelude hiding (putChar)
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import qualified Data.Serialize.Builder as B
+import Data.Monoid
+import Data.Word
+import Data.Int
+-- import Foreign.Ptr
+
+------------------------------------------------------------------------
+
+-- | The representation for a stream of values to be serialized.
+data VStreamRep =
+ VChar {-# UNPACK #-} !Char VStreamRep
+ | VWord {-# UNPACK #-} !Word VStreamRep
+ | VWord8 {-# UNPACK #-} !Word8 VStreamRep
+ | VWord16 {-# UNPACK #-} !Word16 VStreamRep
+ | VWord32 {-# UNPACK #-} !Word32 VStreamRep
+ | VWord64 {-# UNPACK #-} !Word64 VStreamRep
+ | VByteString !S.ByteString VStreamRep
+ | VLazyByteString !L.ByteString VStreamRep
+ | VBuilder B.Builder VStreamRep
+ | VEmpty
+
+-- | A stream of values to be encoded.
+newtype VStream = VStream { toVStreamRep :: VStreamRep -> VStreamRep }
+
+instance Monoid VStream where
+ {-# INLINE mempty #-}
+ mempty = VStream id
+ {-# INLINE mappend #-}
+ b1 `mappend` b2 = VStream (toVStreamRep b1 . toVStreamRep b2)
+ {-# INLINE mconcat #-}
+ mconcat = foldr mappend mempty
+
+-- | Binary encode a 'VStream' to a lazy bytestring 'B.Builder'.
+encode :: VStream -> B.Builder
+encode vs0 =
+ go (toVStreamRep vs0 VEmpty)
+ where
+ ap = mappend
+
+ go VEmpty = mempty
+ go (VWord8 x vs) = B.singleton x `ap` go vs
+ go (VWord16 x vs) = B.putWord16be x `ap` go vs
+ go (VWord32 x vs) = B.putWord32be x `ap` go vs
+ go (VWord64 x vs) = B.putWord64be x `ap` go vs
+ go (VWord x vs) = B.putWord64be (fromIntegral x) `ap` go vs
+ go (VChar x vs) = B.putCharUtf8 x `ap` go vs
+ go (VByteString x vs) = B.fromByteString x `ap` go vs
+ go (VLazyByteString x vs) = B.fromLazyByteString x `ap` go vs
+ go (VBuilder x vs) = x `ap` go vs
+
+
+-- VStream construction
+------------------------------
+
+{-# INLINE word #-}
+word :: Word -> VStream
+word = VStream . VWord
+
+{-# INLINE word8 #-}
+word8 :: Word8 -> VStream
+word8 = VStream . VWord8
+
+{-# INLINE word16 #-}
+word16 :: Word16 -> VStream
+word16 = VStream . VWord16
+
+{-# INLINE word32 #-}
+word32 :: Word32 -> VStream
+word32 = VStream . VWord32
+
+{-# INLINE word64 #-}
+word64 :: Word64 -> VStream
+word64 = VStream . VWord64
+
+{-# INLINE int #-}
+int :: Int -> VStream
+int = word . fromIntegral
+
+{-# INLINE int8 #-}
+int8 :: Int8 -> VStream
+int8 = word8 . fromIntegral
+
+{-# INLINE int16 #-}
+int16 :: Int16 -> VStream
+int16 = word16 . fromIntegral
+
+{-# INLINE int32 #-}
+int32 :: Int32 -> VStream
+int32 = word32 . fromIntegral
+
+{-# INLINE int64 #-}
+int64 :: Int64 -> VStream
+int64 = word64 . fromIntegral
+
+{-# INLINE char #-}
+char :: Char -> VStream
+char = VStream . VChar
+
+{-# INLINE byteString #-}
+byteString :: S.ByteString -> VStream
+byteString = VStream . VBuilder . B.fromByteString
+
+{-# INLINE lazyByteString #-}
+lazyByteString :: L.ByteString -> VStream
+lazyByteString = VStream . VBuilder . B.fromLazyByteString
+-- lazyByteString = VStream . VLazyByteString
+
+{-# INLINE builder #-}
+builder :: B.Builder -> VStream
+builder = VStream . VBuilder
View
48 src/Data/Serialize2.hs
@@ -31,7 +31,7 @@ module Data.Serialize2 (
-- $example
-- * Serialize serialisation
- -- , encode
+ , encode
, encodeLazy
, decode, decodeLazy
@@ -40,7 +40,6 @@ module Data.Serialize2 (
-- , module Data.Serialize.IEEE754
) where
-import qualified Data.Serialize.FlatValue as FV
import Data.Serialize.Put2
import Data.Serialize.Get
-- import Data.Serialize.IEEE754
@@ -48,7 +47,7 @@ import Data.Serialize.Get
import Control.Monad
import Data.Array.Unboxed
import Data.ByteString (ByteString)
-import Data.Char (chr,ord)
+import Data.Char (chr)
import Data.List (unfoldr)
import Data.Word
import Foreign
@@ -96,11 +95,9 @@ class Serialize t where
------------------------------------------------------------------------
-- Wrappers to run the underlying monad
-{-
-- | Encode a value using binary serialization to a strict ByteString.
encode :: Serialize a => a -> ByteString
encode = runPut . put
--}
-- | Encode a value using binary serialization to a lazy ByteString.
encodeLazy :: Serialize a => a -> L.ByteString
@@ -122,17 +119,19 @@ decodeLazy = runGetLazy get
-- The () type need never be written to disk: values of singleton type
-- can be reconstructed from the type alone
instance Serialize () where
+ {-# INLINE put #-}
put () = return ()
get = return ()
-{-
-- Bools are encoded as a byte in the range 0 .. 1
instance Serialize Bool where
+ {-# INLINE put #-}
put = putWord8 . fromIntegral . fromEnum
get = liftM (toEnum . fromIntegral) getWord8
-- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2
instance Serialize Ordering where
+ {-# INLINE put #-}
put = putWord8 . fromIntegral . fromEnum
get = liftM (toEnum . fromIntegral) getWord8
@@ -141,60 +140,66 @@ instance Serialize Ordering where
-- Words8s are written as bytes
instance Serialize Word8 where
+ {-# INLINE put #-}
put = putWord8
get = getWord8
-- Words16s are written as 2 bytes in big-endian (network) order
instance Serialize Word16 where
+ {-# INLINE put #-}
put = putWord16be
get = getWord16be
-- Words32s are written as 4 bytes in big-endian (network) order
instance Serialize Word32 where
+ {-# INLINE put #-}
put = putWord32be
get = getWord32be
-- Words64s are written as 8 bytes in big-endian (network) order
instance Serialize Word64 where
+ {-# INLINE put #-}
put = putWord64be
get = getWord64be
-- Int8s are written as a single byte.
instance Serialize Int8 where
- put i = put (fromIntegral i :: Word8)
+ {-# INLINE put #-}
+ put = put . (fromIntegral :: Int8 -> Word8)
get = liftM fromIntegral (get :: Get Word8)
-- Int16s are written as a 2 bytes in big endian format
instance Serialize Int16 where
- put i = put (fromIntegral i :: Word16)
+ {-# INLINE put #-}
+ put = put . (fromIntegral :: Int16 -> Word16)
get = liftM fromIntegral (get :: Get Word16)
-- Int32s are written as a 4 bytes in big endian format
instance Serialize Int32 where
- put i = put (fromIntegral i :: Word32)
+ {-# INLINE put #-}
+ put = put . (fromIntegral :: Int32 -> Word32)
get = liftM fromIntegral (get :: Get Word32)
-- Int64s are written as a 8 bytes in big endian format
instance Serialize Int64 where
- put i = put (fromIntegral i :: Word64)
+ {-# INLINE put #-}
+ put = put . (fromIntegral :: Int64 -> Word64)
get = liftM fromIntegral (get :: Get Word64)
------------------------------------------------------------------------
--}
-- Words are are written as Word64s, that is, 8 bytes in big endian format
instance Serialize Word where
{-# INLINE put #-}
- put = tell . FV.putWord
+ put = put . (fromIntegral :: Word -> Word64)
get = error "liftM fromIntegral (get :: Get Word64)"
-- Ints are are written as Int64s, that is, 8 bytes in big endian format
instance Serialize Int where
{-# INLINE put #-}
- put = tell . FV.putInt
+ put = put . (fromIntegral :: Int -> Word64)
get = error "liftM fromIntegral (get :: Get Int64)"
-{-
------------------------------------------------------------------------
--
-- Portable, and pretty efficient, serialisation of Integer
@@ -252,14 +257,12 @@ instance (Serialize a,Integral a) => Serialize (R.Ratio a) where
get = liftM2 (R.%) get get
------------------------------------------------------------------------
--}
+
-- Char is serialised as UTF-8
instance Serialize Char where
{-# INLINE put #-}
- put = tell . FV.putChar
+ put = putCharUtf8
- get = error "get: Char"
- {-
get = do
let getByte = liftM (fromIntegral :: Word8 -> Int) get
shiftL6 = flip shiftL 6 :: Int -> Int
@@ -281,8 +284,7 @@ instance Serialize Char where
return (z .|. shiftL6 (y .|. shiftL6
(x .|. shiftL6 (xor 0xf0 w))))
return $! chr r
- -}
-{-
+
------------------------------------------------------------------------
-- Instances for the first few tuples
@@ -340,7 +342,7 @@ instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e,
put (a,b,c,d,e,f,g,h,i,j) = put (a,(b,c,d,e,f,g,h,i,j))
get = do (a,(b,c,d,e,f,g,h,i,j)) <- get
return (a,b,c,d,e,f,g,h,i,j)
--}
+
------------------------------------------------------------------------
-- Container types
@@ -349,7 +351,6 @@ instance Serialize a => Serialize [a] where
put = putListOf put
get = getListOf get
-{-
instance (Serialize a) => Serialize (Maybe a) where
put = putMaybeOf put
get = getMaybeOf get
@@ -395,6 +396,7 @@ instance (Serialize e) => Serialize (IntMap.IntMap e) where
-- Queues and Sequences
instance (Serialize e) => Serialize (Seq.Seq e) where
+ {-# INLINE put #-}
put = putSeqOf put
get = getSeqOf get
@@ -413,6 +415,7 @@ instance Serialize Float where
-- Trees
instance (Serialize e) => Serialize (T.Tree e) where
+ {-# INLINE put #-}
put = putTreeOf put
get = getTreeOf get
@@ -555,4 +558,3 @@ instance (SumSize a, SumSize b) => SumSize (a :+: b) where
instance SumSize (C1 c a) where
sumSize = Tagged 1
#endif
--}

No commit comments for this range

Something went wrong with that request. Please try again.