From 13581bfec116019b93eb07e5d88b2e075886c7df Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 25 Nov 2023 23:50:58 +0530 Subject: [PATCH] Rename serialize/deserialize/size of Serialize class --- .../Streamly/Benchmark/Data/Serialize.hs | 6 +- core/src/Streamly/Data/MutByteArray.hs | 6 +- core/src/Streamly/Internal/Data/Array.hs | 7 +- .../Streamly/Internal/Data/MutByteArray.hs | 117 +++++++++--------- .../Streamly/Internal/Data/Serialize/TH.hs | 32 ++--- .../Internal/Data/Serialize/TH/Bottom.hs | 34 ++--- .../Internal/Data/Serialize/TH/RecHeader.hs | 46 +++---- .../Streamly/Internal/Data/Serialize/Type.hs | 115 ++++++++--------- test/Streamly/Test/Data/Serialize.hs | 8 +- test/Streamly/Test/Data/Unbox.hs | 6 +- 10 files changed, 190 insertions(+), 187 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Serialize.hs b/benchmark/Streamly/Benchmark/Data/Serialize.hs index 3b1d33536..aa0a33e68 100644 --- a/benchmark/Streamly/Benchmark/Data/Serialize.hs +++ b/benchmark/Streamly/Benchmark/Data/Serialize.hs @@ -49,8 +49,8 @@ import Streamly.Benchmark.Data.Serialize.RecNonCompatible #else #define SERIALIZE_CLASS Serialize #define DERIVE_CLASS(typ) $(deriveSerialize [d|instance Serialize typ|]) -#define SERIALIZE_OP serialize -#define DESERIALIZE_OP deserialize +#define SERIALIZE_OP serializeAt +#define DESERIALIZE_OP deserializeAt #endif ------------------------------------------------------------------------------- @@ -288,7 +288,7 @@ getSize :: forall a. SERIALIZE_CLASS a => a -> Int #ifdef USE_UNBOX getSize _ = sizeOf (Proxy :: Proxy a) #else -getSize = size 0 +getSize = addSizeTo 0 #endif ------------------------------------------------------------------------------- diff --git a/core/src/Streamly/Data/MutByteArray.hs b/core/src/Streamly/Data/MutByteArray.hs index 757077c34..92a674468 100644 --- a/core/src/Streamly/Data/MutByteArray.hs +++ b/core/src/Streamly/Data/MutByteArray.hs @@ -75,9 +75,9 @@ module Streamly.Data.MutByteArray -- Deriving Serialize , SerializeConfig , serializeConfig - , inlineSize - , inlineSerialize - , inlineDeserialize + , inlineAddSizeTo + , inlineSerializeAt + , inlineDeserializeAt , deriveSerialize , deriveSerializeWith diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 46823e5a2..788092440 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -561,9 +561,9 @@ streamFold f arr = f (A.read arr) encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8 encodeAs ps a = unsafeInlineIO $ do - let len = Serialize.size 0 a + let len = Serialize.addSizeTo 0 a mbarr <- MBA.newBytesAs ps len - off <- Serialize.serialize 0 mbarr a + off <- Serialize.serializeAt 0 mbarr a assertM(len == off) pure $ Array mbarr 0 off @@ -584,6 +584,7 @@ pinnedSerialize = encodeAs Pinned deserialize :: Serialize a => Array Word8 -> a deserialize arr@(Array {..}) = unsafeInlineIO $ do let lenArr = length arr - (off, val) <- Serialize.deserialize arrStart arrContents (arrStart + lenArr) + (off, val) <- + Serialize.deserializeAt arrStart arrContents (arrStart + lenArr) assertM(off == arrStart + lenArr) pure val diff --git a/core/src/Streamly/Internal/Data/MutByteArray.hs b/core/src/Streamly/Internal/Data/MutByteArray.hs index 796ff04d7..394418b1f 100644 --- a/core/src/Streamly/Internal/Data/MutByteArray.hs +++ b/core/src/Streamly/Internal/Data/MutByteArray.hs @@ -88,73 +88,73 @@ import Streamly.Internal.Data.Unbox.TH -- $(Serialize.deriveSerialize ''Maybe) instance Serialize a => Serialize (Maybe a) where - {-# INLINE size #-} - size acc x = + {-# INLINE addSizeTo #-} + addSizeTo acc x = case x of Nothing -> (acc + 1) - Just field0 -> (size (acc + 1)) field0 + Just field0 -> (addSizeTo (acc + 1)) field0 - {-# INLINE deserialize #-} - deserialize initialOffset arr endOffset = do - (i0, tag) <- ((deserialize initialOffset) arr) endOffset + {-# INLINE deserializeAt #-} + deserializeAt initialOffset arr endOffset = do + (i0, tag) <- ((deserializeAt initialOffset) arr) endOffset case tag :: Word8 of 0 -> pure (i0, Nothing) - 1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset + 1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset pure (i1, Just a0) _ -> error "Found invalid tag while peeking (Maybe a)" - {-# INLINE serialize #-} - serialize initialOffset arr val = + {-# INLINE serializeAt #-} + serializeAt initialOffset arr val = case val of Nothing -> do - i0 <- ((serialize initialOffset) arr) (0 :: Word8) + i0 <- ((serializeAt initialOffset) arr) (0 :: Word8) pure i0 Just field0 -> do - i0 <- ((serialize initialOffset) arr) (1 :: Word8) - i1 <- ((serialize i0) arr) field0 + i0 <- ((serializeAt initialOffset) arr) (1 :: Word8) + i1 <- ((serializeAt i0) arr) field0 pure i1 -- $(Serialize.deriveSerialize ''Either) instance (Serialize a, Serialize b) => Serialize (Either a b) where - {-# INLINE size #-} - size acc x = + {-# INLINE addSizeTo #-} + addSizeTo acc x = case x of - Left field0 -> (size (acc + 1)) field0 - Right field0 -> (size (acc + 1)) field0 + Left field0 -> (addSizeTo (acc + 1)) field0 + Right field0 -> (addSizeTo (acc + 1)) field0 - {-# INLINE deserialize #-} - deserialize initialOffset arr endOffset = do - (i0, tag) <- ((deserialize initialOffset) arr) endOffset + {-# INLINE deserializeAt #-} + deserializeAt initialOffset arr endOffset = do + (i0, tag) <- ((deserializeAt initialOffset) arr) endOffset case tag :: Word8 of - 0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset + 0 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset pure (i1, Left a0) - 1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset + 1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset pure (i1, Right a0) _ -> error "Found invalid tag while peeking (Either a b)" - {-# INLINE serialize #-} - serialize initialOffset arr val = + {-# INLINE serializeAt #-} + serializeAt initialOffset arr val = case val of Left field0 -> do - i0 <- ((serialize initialOffset) arr) (0 :: Word8) - i1 <- ((serialize i0) arr) field0 + i0 <- ((serializeAt initialOffset) arr) (0 :: Word8) + i1 <- ((serializeAt i0) arr) field0 pure i1 Right field0 -> do - i0 <- ((serialize initialOffset) arr) (1 :: Word8) - i1 <- ((serialize i0) arr) field0 + i0 <- ((serializeAt initialOffset) arr) (1 :: Word8) + i1 <- ((serializeAt i0) arr) field0 pure i1 instance Serialize (Proxy a) where - {-# INLINE size #-} - size acc _ = (acc + 1) + {-# INLINE addSizeTo #-} + addSizeTo acc _ = (acc + 1) - {-# INLINE deserialize #-} - deserialize initialOffset _ _ = pure ((initialOffset + 1), Proxy) + {-# INLINE deserializeAt #-} + deserializeAt initialOffset _ _ = pure ((initialOffset + 1), Proxy) - {-# INLINE serialize #-} - serialize initialOffset _ _ = pure (initialOffset + 1) + {-# INLINE serializeAt #-} + serializeAt initialOffset _ _ = pure (initialOffset + 1) -------------------------------------------------------------------------------- -- Integer @@ -168,39 +168,39 @@ data LiftedInteger -- $(Serialize.deriveSerialize ''LiftedInteger) instance Serialize LiftedInteger where - {-# INLINE size #-} - size acc x = + {-# INLINE addSizeTo #-} + addSizeTo acc x = case x of - LIS field0 -> (size (acc + 1)) field0 - LIP field0 -> (size (acc + 1)) field0 - LIN field0 -> (size (acc + 1)) field0 + LIS field0 -> (addSizeTo (acc + 1)) field0 + LIP field0 -> (addSizeTo (acc + 1)) field0 + LIN field0 -> (addSizeTo (acc + 1)) field0 - {-# INLINE deserialize #-} - deserialize initialOffset arr endOffset = do - (i0, tag) <- ((deserialize initialOffset) arr) endOffset + {-# INLINE deserializeAt #-} + deserializeAt initialOffset arr endOffset = do + (i0, tag) <- ((deserializeAt initialOffset) arr) endOffset case tag :: Word8 of - 0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset + 0 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset pure (i1, LIS a0) - 1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset + 1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset pure (i1, LIP a0) - 2 -> do (i1, a0) <- ((deserialize i0) arr) endOffset + 2 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset pure (i1, LIN a0) _ -> error "Found invalid tag while peeking (LiftedInteger)" - {-# INLINE serialize #-} - serialize initialOffset arr val = + {-# INLINE serializeAt #-} + serializeAt initialOffset arr val = case val of LIS field0 -> do - i0 <- ((serialize initialOffset) arr) (0 :: Word8) - i1 <- ((serialize i0) arr) field0 + i0 <- ((serializeAt initialOffset) arr) (0 :: Word8) + i1 <- ((serializeAt i0) arr) field0 pure i1 LIP field0 -> do - i0 <- ((serialize initialOffset) arr) (1 :: Word8) - i1 <- ((serialize i0) arr) field0 + i0 <- ((serializeAt initialOffset) arr) (1 :: Word8) + i1 <- ((serializeAt i0) arr) field0 pure i1 LIN field0 -> do - i0 <- ((serialize initialOffset) arr) (2 :: Word8) - i1 <- ((serialize i0) arr) field0 + i0 <- ((serializeAt initialOffset) arr) (2 :: Word8) + i1 <- ((serializeAt i0) arr) field0 pure i1 #if __GLASGOW_HASKELL__ >= 900 @@ -240,11 +240,12 @@ unliftInteger (LIN (Array (MutByteArray x) _ _)) = #endif instance Serialize Integer where - {-# INLINE size #-} - size i a = size i (liftInteger a) + {-# INLINE addSizeTo #-} + addSizeTo i a = addSizeTo i (liftInteger a) - {-# INLINE deserialize #-} - deserialize off arr end = fmap unliftInteger <$> deserialize off arr end + {-# INLINE deserializeAt #-} + deserializeAt off arr end = + fmap unliftInteger <$> deserializeAt off arr end - {-# INLINE serialize #-} - serialize off arr val = serialize off arr (liftInteger val) + {-# INLINE serializeAt #-} + serializeAt off arr val = serializeAt off arr (liftInteger val) diff --git a/core/src/Streamly/Internal/Data/Serialize/TH.hs b/core/src/Streamly/Internal/Data/Serialize/TH.hs index 2f2d13bfd..3e0216040 100644 --- a/core/src/Streamly/Internal/Data/Serialize/TH.hs +++ b/core/src/Streamly/Internal/Data/Serialize/TH.hs @@ -50,7 +50,7 @@ import Streamly.Internal.Data.Serialize.TH.RecHeader -------------------------------------------------------------------------------- exprGetSize :: Q Exp -> (Int, Type) -> Q Exp -exprGetSize acc (i, _) = [|size $(acc) $(varE (mkFieldName i))|] +exprGetSize acc (i, _) = [|addSizeTo $(acc) $(varE (mkFieldName i))|] getTagSize :: Int -> Int getTagSize numConstructors @@ -170,9 +170,9 @@ mkSizeDec (SerializeConfig {..}) headTy cons = do pure ( maybe [] - (\x -> [PragmaD (InlineP 'size x FunLike AllPhases)]) + (\x -> [PragmaD (InlineP 'addSizeTo x FunLike AllPhases)]) cfgInlineSize - ++ [FunD 'size [Clause [] (NormalB sizeOfMethod) []]] + ++ [FunD 'addSizeTo [Clause [] (NormalB sizeOfMethod) []]] ) -------------------------------------------------------------------------------- @@ -192,7 +192,7 @@ mkDeserializeExpr True False headTy tyOfTy = conLen <- newName "conLen" off1 <- newName "off1" [|do ($(varP off1), $(varP conLen) :: Word8) <- - deserialize + deserializeAt $(varE _initialOffset) $(varE _arr) $(varE _endOffset) @@ -212,7 +212,7 @@ mkDeserializeExpr True False headTy tyOfTy = [|($(litIntegral lenCname) == $(varE conLen)) && $(xorCmp tag off _arr)|] [|let $(varP (makeI 0)) = $(varE off) + $(litIntegral lenCname) - in $(mkDeserializeExprOne 'deserialize con)|] + in $(mkDeserializeExprOne 'deserializeAt con)|] mkDeserializeExpr False False headTy tyOfTy = case tyOfTy of @@ -223,7 +223,7 @@ mkDeserializeExpr False False headTy tyOfTy = TheType con -> letE [valD (varP (mkName "i0")) (normalB (varE _initialOffset)) []] - (mkDeserializeExprOne 'deserialize con) + (mkDeserializeExprOne 'deserializeAt con) -- Sum type MultiType cons -> do let lenCons = length cons @@ -231,7 +231,7 @@ mkDeserializeExpr False False headTy tyOfTy = doE [ bindS (tupP [varP (mkName "i0"), varP _tag]) - [|deserialize $(varE _initialOffset) $(varE _arr) $(varE _endOffset)|] + [|deserializeAt $(varE _initialOffset) $(varE _arr) $(varE _endOffset)|] , noBindS (caseE (sigE (varE _tag) (conT tagType)) @@ -241,7 +241,7 @@ mkDeserializeExpr False False headTy tyOfTy = peekMatch (i, con) = match (litP (IntegerL i)) - (normalB (mkDeserializeExprOne 'deserialize con)) [] + (normalB (mkDeserializeExprOne 'deserializeAt con)) [] peekErr = match wildP @@ -279,11 +279,11 @@ mkDeserializeDec (SerializeConfig {..}) headTy cons = do pure ( maybe [] - (\x -> [PragmaD (InlineP 'deserialize x FunLike AllPhases)]) + (\x -> [PragmaD (InlineP 'deserializeAt x FunLike AllPhases)]) cfgInlineDeserialize ++ [ FunD - 'deserialize + 'deserializeAt [ Clause (if isUnitType cons && not cfgConstructorTagAsString then [VarP _initialOffset, WildP, WildP] @@ -300,7 +300,7 @@ mkDeserializeDec (SerializeConfig {..}) headTy cons = do mkSerializeExprTag :: Name -> Int -> Q Exp mkSerializeExprTag tagType tagVal = - [|serialize + [|serializeAt $(varE _initialOffset) $(varE _arr) $((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|] @@ -335,7 +335,7 @@ mkSerializeExpr True False tyOfTy = (doE [ bindS (varP (mkName "i0")) (serializeW8List _initialOffset _arr conEnc) - , noBindS (mkSerializeExprFields 'serialize fields) + , noBindS (mkSerializeExprFields 'serializeAt fields) ]) mkSerializeExpr False False tyOfTy = @@ -351,7 +351,7 @@ mkSerializeExpr False False tyOfTy = [ matchConstructor cname (length fields) - (mkSerializeExprFields 'serialize fields) + (mkSerializeExprFields 'serializeAt fields) ]) -- Sum type (MultiType cons) -> do @@ -368,7 +368,7 @@ mkSerializeExpr False False tyOfTy = (mkSerializeExprTag tagType tagVal) , noBindS (mkSerializeExprFields - 'serialize + 'serializeAt fields) ])) (zip [0 ..] cons)) @@ -388,11 +388,11 @@ mkSerializeDec (SerializeConfig {..}) headTy cons = do pure ( maybe [] - (\x -> [PragmaD (InlineP 'serialize x FunLike AllPhases)]) + (\x -> [PragmaD (InlineP 'serializeAt x FunLike AllPhases)]) cfgInlineSerialize ++ [FunD - 'serialize + 'serializeAt [ Clause (if isUnitType cons && not cfgConstructorTagAsString then [VarP _initialOffset, WildP, WildP] diff --git a/core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs b/core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs index 8e7a3cf60..b5b6ddc24 100644 --- a/core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs +++ b/core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs @@ -13,9 +13,9 @@ module Streamly.Internal.Data.Serialize.TH.Bottom -- ** Config SerializeConfig(..) , serializeConfig - , inlineSize - , inlineSerialize - , inlineDeserialize + , inlineAddSizeTo + , inlineSerializeAt + , inlineDeserializeAt , encodeConstrNames , encodeRecordFields @@ -84,7 +84,7 @@ import Streamly.Internal.Data.Unbox.TH (DataCon(..)) -- 'serializeConfig' and config setter functions to generate desired Config. For -- example: -- --- >>> (inlineSize (Just Inline)) . (inlineSerialize (Just Inlinable)) serializeConfig +-- >>> (inlineAddSizeTo (Just Inline)) . (inlineSerializeAt (Just Inlinable)) serializeConfig -- data SerializeConfig = SerializeConfig @@ -95,11 +95,11 @@ data SerializeConfig = , cfgRecordSyntaxWithHeader :: Bool } --- | How should we inline the 'size' function? The default in 'serializeConfig' --- is 'Nothing' which means left to the compiler. Forcing inline on @size@ +-- | How should we inline the 'addSizeTo' function? The default in 'serializeConfig' +-- is 'Nothing' which means left to the compiler. Forcing inline on @addSizeTo@ -- function actually worsens some benchmarks and improves none. -inlineSize :: Maybe Inline -> SerializeConfig -> SerializeConfig -inlineSize v cfg = cfg {cfgInlineSize = v} +inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig +inlineAddSizeTo v cfg = cfg {cfgInlineSize = v} -- XXX Should we make the default Inlinable instead? @@ -108,15 +108,15 @@ inlineSize v cfg = cfg {cfgInlineSize = v} -- the code and increase in compilation times when there are big functions and -- too many nesting levels so you can change it accordingly. A 'Nothing' value -- leaves the decision to the compiler. -inlineSerialize :: Maybe Inline -> SerializeConfig -> SerializeConfig -inlineSerialize v cfg = cfg {cfgInlineSerialize = v} +inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig +inlineSerializeAt v cfg = cfg {cfgInlineSerialize = v} -- XXX Should we make the default Inlinable instead? -- | How should we inline the 'deserialize' function? See guidelines in --- 'inlineSerialize'. -inlineDeserialize :: Maybe Inline -> SerializeConfig -> SerializeConfig -inlineDeserialize v cfg = cfg {cfgInlineDeserialize = v} +-- 'inlineSerializeAt'. +inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig +inlineDeserializeAt v cfg = cfg {cfgInlineDeserialize = v} -- | __Experimental__ -- @@ -184,9 +184,9 @@ encodeRecordFields v cfg = cfg {cfgRecordSyntaxWithHeader = v} -- | The default configuration settings are: -- --- * 'inlineSize' 'Nothing' --- * 'inlineSerialize' (Just Inline) --- * 'inlineDeserialize' (Just Inline) +-- * 'inlineAddSizeTo' 'Nothing' +-- * 'inlineSerializeAt' (Just Inline) +-- * 'inlineDeserializeAt' (Just Inline) -- serializeConfig :: SerializeConfig serializeConfig = @@ -425,7 +425,7 @@ serializeW8List off arr w8List = do makeBind i = bindS (varP (makeN (i + 1))) - [|$(varE 'serialize) + [|$(varE 'serializeAt) $(varE (makeN i)) $(varE arr) ($(litIntegral (w8List !! i)) :: Word8)|] diff --git a/core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs b/core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs index 3cbcb300b..d1f257cfe 100644 --- a/core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs +++ b/core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs @@ -103,36 +103,36 @@ newtype CompactList a = -- the list is 255. instance forall a. Serialize a => Serialize (CompactList a) where - -- {-# INLINE size #-} - size acc (CompactList xs) = - foldl' size (acc + (Unbox.sizeOf (Proxy :: Proxy Word8))) xs + -- {-# INLINE addSizeTo #-} + addSizeTo acc (CompactList xs) = + foldl' addSizeTo (acc + (Unbox.sizeOf (Proxy :: Proxy Word8))) xs -- Inlining this causes large compilation times for tests - {-# INLINABLE deserialize #-} - deserialize off arr sz = do - (off1, len8) <- deserialize off arr sz :: IO (Int, Word8) + {-# INLINABLE deserializeAt #-} + deserializeAt off arr sz = do + (off1, len8) <- deserializeAt off arr sz :: IO (Int, Word8) let len = w8_int len8 peekList f o i | i >= 3 = do -- Unfold the loop three times - (o1, x1) <- deserialize o arr sz - (o2, x2) <- deserialize o1 arr sz - (o3, x3) <- deserialize o2 arr sz + (o1, x1) <- deserializeAt o arr sz + (o2, x2) <- deserializeAt o1 arr sz + (o3, x3) <- deserializeAt o2 arr sz peekList (f . (\xs -> x1:x2:x3:xs)) o3 (i - 3) peekList f o 0 = pure (o, f []) peekList f o i = do - (o1, x) <- deserialize o arr sz + (o1, x) <- deserializeAt o arr sz peekList (f . (x:)) o1 (i - 1) (nextOff, lst) <- peekList id off1 len pure (nextOff, CompactList lst) -- Inlining this causes large compilation times for tests - {-# INLINABLE serialize #-} - serialize off arr (CompactList val) = do - void $ serialize off arr (int_w8 (length val) :: Word8) + {-# INLINABLE serializeAt #-} + serializeAt off arr (CompactList val) = do + void $ serializeAt off arr (int_w8 (length val) :: Word8) let off1 = off + Unbox.sizeOf (Proxy :: Proxy Word8) let pokeList o [] = pure o pokeList o (x:xs) = do - o1 <- serialize o arr x + o1 <- serializeAt o arr x pokeList o1 xs pokeList off1 val @@ -154,7 +154,7 @@ isMaybeType _ = False -- We add 4 here because we use 'serializeWithSize' for serializing. exprGetSize :: Q Exp -> (Int, Type) -> Q Exp exprGetSize acc (i, _) = - [|size $(acc) $(varE (mkFieldName i)) + 4|] + [|addSizeTo $(acc) $(varE (mkFieldName i)) + 4|] sizeOfHeader :: SimpleDataCon -> Int sizeOfHeader (SimpleDataCon _ fields) = @@ -227,7 +227,7 @@ headerValue (SimpleDataCon _ fields) = {-# INLINE serializeWithSize #-} serializeWithSize :: Serialize a => Int -> MutByteArray -> a -> IO Int serializeWithSize off arr val = do - off1 <- serialize (off + 4) arr val + off1 <- serializeAt (off + 4) arr val Unbox.pokeAt off arr (int_w32 (off1 - off - 4) :: Word32) pure off1 @@ -238,7 +238,7 @@ mkRecSerializeExpr initialOffset (con@(SimpleDataCon cname fields)) = do -- We first compare the header length encoded and the current header -- length. Only if the header lengths match, we compare the headers. [|do $(varP afterHLen) <- - serialize + serializeAt ($(varE initialOffset) + 4) $(varE _arr) ($(litIntegral hlen) :: Word32) @@ -264,7 +264,7 @@ mkRecSerializeExpr initialOffset (con@(SimpleDataCon cname fields)) = do {-# INLINE deserializeWithSize #-} deserializeWithSize :: Serialize a => Int -> MutByteArray -> Int -> IO (Int, a) -deserializeWithSize off arr endOff = deserialize (off + 4) arr endOff +deserializeWithSize off arr endOff = deserializeAt (off + 4) arr endOff conUpdateFuncDec :: Name -> [Field] -> Q [Dec] conUpdateFuncDec funcName fields = do @@ -282,7 +282,7 @@ conUpdateFuncDec funcName fields = do wildP (normalB [|do (valOff, valLen :: Word32) <- - deserialize + deserializeAt $(varE curOff) $(varE arr) $(varE endOff) @@ -317,7 +317,7 @@ conUpdateFuncDec funcName fields = do (litP fnameLit) (normalB [|do (valOff, valLen :: Word32) <- - deserialize + deserializeAt $(varE currOff) $(varE arr) $(varE endOff) @@ -345,7 +345,7 @@ mkDeserializeKeysDec funcName updateFunc (SimpleDataCon cname fields) = do errorUnsupported "The datatype should use record syntax." method <- [|do (dataOff, hlist :: CompactList (CompactList Word8)) <- - deserialize $(varE hOff) $(varE arr) $(varE endOff) + deserializeAt $(varE hOff) $(varE arr) $(varE endOff) let keys = wListToString . unCompactList <$> unCompactList hlist ($(varP kvEncoded), _) <- foldlM @@ -390,9 +390,9 @@ mkRecDeserializeExpr initialOff endOff deserializeWithKeys con = do sizeForHeaderLength = 4 -- Word32 sizePreData = sizeForFinalOff + sizeForHeaderLength + hlen [|do (hlenOff, encLen :: Word32) <- - deserialize $(varE initialOff) $(varE _arr) $(varE endOff) + deserializeAt $(varE initialOff) $(varE _arr) $(varE endOff) ($(varP hOff), hlen1 :: Word32) <- - deserialize hlenOff $(varE _arr) $(varE endOff) + deserializeAt hlenOff $(varE _arr) $(varE endOff) if (hlen1 == $(litIntegral hlen)) && $(xorCmp hval hOff _arr) then do let $(varP (makeI 0)) = diff --git a/core/src/Streamly/Internal/Data/Serialize/Type.hs b/core/src/Streamly/Internal/Data/Serialize/Type.hs index c324de4f4..55ece26fa 100644 --- a/core/src/Streamly/Internal/Data/Serialize/Type.hs +++ b/core/src/Streamly/Internal/Data/Serialize/Type.hs @@ -58,14 +58,14 @@ import GHC.Exts -- particular constructor. For variable length data types the length is encoded -- along with the data. -- --- The 'deserialize' operation reads bytes from the mutable byte array and +-- The 'deserializeAt' operation reads bytes from the mutable byte array and -- builds a Haskell data type from these bytes, the number of bytes it reads --- depends on the type and the encoded value it is reading. 'serialize' +-- depends on the type and the encoded value it is reading. 'serializeAt' -- operation converts a Haskell data type to its binary representation which --- must consist of as many bytes as returned by the @size@ operation on that +-- must consist of as many bytes as added by the @addSizeTo@ operation for that -- value and then stores these bytes into the mutable byte array. The --- programmer is expected to use the @size@ operation and allocate an array of --- sufficient length before calling 'serialize'. +-- programmer is expected to use the @addSizeTo@ operation and allocate an +-- array of sufficient length before calling 'serializeAt'. -- -- IMPORTANT: The serialized data's byte ordering remains the same as the host -- machine's byte order. Therefore, it can not be deserialized from host @@ -98,15 +98,15 @@ import GHC.Exts -- -- >>> :{ -- instance Serialize Object where --- size acc obj = size (size acc (_obj1 obj)) (_obj2 obj) --- deserialize i arr len = do +-- addSizeTo acc obj = addSizeTo (addSizeTo acc (_obj1 obj)) (_obj2 obj) +-- deserializeAt i arr len = do -- -- Check the array bounds before reading --- (i1, x0) <- deserialize i arr len --- (i2, x1) <- deserialize i1 arr len +-- (i1, x0) <- deserializeAt i arr len +-- (i2, x1) <- deserializeAt i1 arr len -- pure (i2, Object x0 x1) --- serialize i arr (Object x0 x1) = do --- i1 <- serialize i arr x0 --- i2 <- serialize i1 arr x1 +-- serializeAt i arr (Object x0 x1) = do +-- i1 <- serializeAt i arr x0 +-- i2 <- serializeAt i1 arr x1 -- pure i2 -- :} -- @@ -117,30 +117,30 @@ class Serialize a where -- It is of the form @Int -> a -> Int@ because you can have tail-recursive -- traversal of the structures. - -- | @size accum value@ returns @accum@ incremented by the size of the + -- | @addSizeTo accum value@ returns @accum@ incremented by the size of the -- serialized representation of @value@ in bytes. Size cannot be zero. It -- should be at least 1 byte. - size :: Int -> a -> Int + addSizeTo :: Int -> a -> Int -- We can implement the following functions without returning the `Int` -- offset but that may require traversing the Haskell structure again to get -- the size. Therefore, this is a performance optimization. - -- | @deserialize byte-offset array arrayLen@ deserializes a value from the + -- | @deserializeAt byte-offset array arrayLen@ deserializes a value from the -- given byte-offset in the array. Returns a tuple consisting of the next -- byte-offset and the deserialized value. -- -- Throws an exception if the operation would exceed the supplied arrayLen. - deserialize :: Int -> MutByteArray -> Int -> IO (Int, a) + deserializeAt :: Int -> MutByteArray -> Int -> IO (Int, a) - -- | @serialize byte-offset array value@ writes the serialized + -- | @serializeAt byte-offset array value@ writes the serialized -- representation of the @value@ in the array at the given byte-offset. -- Returns the next byte-offset. -- -- This is an unsafe operation, the programmer must ensure that the array -- has enough space available to serialize the value as determined by the - -- @size@ operation. - serialize :: Int -> MutByteArray -> a -> IO Int + -- @addSizeTo@ operation. + serializeAt :: Int -> MutByteArray -> a -> IO Int -------------------------------------------------------------------------------- -- Instances @@ -191,7 +191,7 @@ deserializeUnsafe off arr sz = if (next <= sz) then Unbox.peekAt off arr >>= \val -> pure (next, val) else error - $ "deserialize: accessing array at offset = " + $ "deserializeAt: accessing array at offset = " ++ show (next - 1) ++ " max valid offset = " ++ show (sz - 1) @@ -201,19 +201,19 @@ serializeUnsafe off arr val = let next = off + Unbox.sizeOf (Proxy :: Proxy a) in do #ifdef DEBUG - checkBounds "serialize" next arr + checkBounds "serializeAt" next arr #endif Unbox.pokeAt off arr val pure next #define DERIVE_SERIALIZE_FROM_UNBOX(_type) \ instance Serialize _type where \ -; {-# INLINE size #-} \ -; size acc _ = acc + Unbox.sizeOf (Proxy :: Proxy _type) \ -; {-# INLINE deserialize #-} \ -; deserialize off arr end = deserializeUnsafe off arr end :: IO (Int, _type) \ -; {-# INLINE serialize #-} \ -; serialize = \ +; {-# INLINE addSizeTo #-} \ +; addSizeTo acc _ = acc + Unbox.sizeOf (Proxy :: Proxy _type) \ +; {-# INLINE deserializeAt #-} \ +; deserializeAt off arr end = deserializeUnsafe off arr end :: IO (Int, _type) \ +; {-# INLINE serializeAt #-} \ +; serializeAt = \ serializeUnsafe :: Int -> MutByteArray -> _type -> IO Int DERIVE_SERIALIZE_FROM_UNBOX(()) @@ -237,68 +237,69 @@ DERIVE_SERIALIZE_FROM_UNBOX((FunPtr a)) instance forall a. Serialize a => Serialize [a] where - -- {-# INLINE size #-} - size acc xs = foldl' size (acc + (Unbox.sizeOf (Proxy :: Proxy Int))) xs + -- {-# INLINE addSizeTo #-} + addSizeTo acc xs = + foldl' addSizeTo (acc + (Unbox.sizeOf (Proxy :: Proxy Int))) xs -- Inlining this causes large compilation times for tests - {-# INLINABLE deserialize #-} - deserialize off arr sz = do - (off1, len64) <- deserialize off arr sz :: IO (Int, Int64) + {-# INLINABLE deserializeAt #-} + deserializeAt off arr sz = do + (off1, len64) <- deserializeAt off arr sz :: IO (Int, Int64) let len = (fromIntegral :: Int64 -> Int) len64 peekList f o i | i >= 3 = do -- Unfold the loop three times - (o1, x1) <- deserialize o arr sz - (o2, x2) <- deserialize o1 arr sz - (o3, x3) <- deserialize o2 arr sz + (o1, x1) <- deserializeAt o arr sz + (o2, x2) <- deserializeAt o1 arr sz + (o3, x3) <- deserializeAt o2 arr sz peekList (f . (\xs -> x1:x2:x3:xs)) o3 (i - 3) peekList f o 0 = pure (o, f []) peekList f o i = do - (o1, x) <- deserialize o arr sz + (o1, x) <- deserializeAt o arr sz peekList (f . (x:)) o1 (i - 1) peekList id off1 len -- Inlining this causes large compilation times for tests - {-# INLINABLE serialize #-} - serialize off arr val = do + {-# INLINABLE serializeAt #-} + serializeAt off arr val = do let off1 = off + Unbox.sizeOf (Proxy :: Proxy Int64) let pokeList acc o [] = Unbox.pokeAt off arr (acc :: Int64) >> pure o pokeList acc o (x:xs) = do - o1 <- serialize o arr x + o1 <- serializeAt o arr x pokeList (acc + 1) o1 xs pokeList 0 off1 val instance Serialize (Array a) where - {-# INLINE size #-} - size i (Array {..}) = i + (arrEnd - arrStart) + 8 + {-# INLINE addSizeTo #-} + addSizeTo i (Array {..}) = i + (arrEnd - arrStart) + 8 - {-# INLINE deserialize #-} - deserialize off arr end = do - (off1, byteLen) <- deserialize off arr end :: IO (Int, Int) + {-# INLINE deserializeAt #-} + deserializeAt off arr end = do + (off1, byteLen) <- deserializeAt off arr end :: IO (Int, Int) let off2 = off1 + byteLen let slice = MutArray.MutArray arr off1 off2 off2 newArr <- MutArray.clone slice pure (off2, Array.unsafeFreeze newArr) - {-# INLINE serialize #-} - serialize off arr (Array {..}) = do + {-# INLINE serializeAt #-} + serializeAt off arr (Array {..}) = do let arrLen = arrEnd - arrStart - off1 <- serialize off arr arrLen + off1 <- serializeAt off arr arrLen MBA.putSliceUnsafe arrContents arrStart arr off1 arrLen pure (off1 + arrLen) instance (Serialize a, Serialize b) => Serialize (a, b) where - {-# INLINE size #-} - size acc (a, b) = size (size acc a) b + {-# INLINE addSizeTo #-} + addSizeTo acc (a, b) = addSizeTo (addSizeTo acc a) b - {-# INLINE serialize #-} - serialize off arr (a, b) = do - off1 <- serialize off arr a - serialize off1 arr b + {-# INLINE serializeAt #-} + serializeAt off arr (a, b) = do + off1 <- serializeAt off arr a + serializeAt off1 arr b - {-# INLINE deserialize #-} - deserialize off arr end = do - (off1, a) <- deserialize off arr end - (off2, b) <- deserialize off1 arr end + {-# INLINE deserializeAt #-} + deserializeAt off arr end = do + (off1, a) <- deserializeAt off arr end + (off2, b) <- deserializeAt off1 arr end pure (off2, (a, b)) diff --git a/test/Streamly/Test/Data/Serialize.hs b/test/Streamly/Test/Data/Serialize.hs index 58aef4436..d41062a71 100644 --- a/test/Streamly/Test/Data/Serialize.hs +++ b/test/Streamly/Test/Data/Serialize.hs @@ -160,7 +160,7 @@ poke :: => a -> IO (MutByteArray, Int, Int) poke val = do - let sz = Serialize.size 0 val + let sz = Serialize.addSizeTo 0 val let excessSize = 100 randomOff <- randomRIO (10, excessSize) @@ -171,7 +171,7 @@ poke val = do serEndOff = randomOff + sz arr <- Serialize.new arrSize - off1 <- Serialize.serialize serStartOff arr val + off1 <- Serialize.serializeAt serStartOff arr val off1 `shouldBe` serEndOff pure (arr, serStartOff, serEndOff) @@ -181,7 +181,7 @@ peekAndVerify :: -> a -> IO () peekAndVerify (arr, serStartOff, serEndOff) val = do - (off2, val2) <- Serialize.deserialize serStartOff arr serEndOff + (off2, val2) <- Serialize.deserializeAt serStartOff arr serEndOff val2 `shouldBe` val off2 `shouldBe` serEndOff let slice = Array.Array arr serStartOff serEndOff @@ -207,7 +207,7 @@ testSerializeList -> IO () testSerializeList sizeOfA val = do - let sz = Serialize.size 0 val + let sz = Serialize.addSizeTo 0 val sz `shouldBe` sizeOfA diff --git a/test/Streamly/Test/Data/Unbox.hs b/test/Streamly/Test/Data/Unbox.hs index 7e6febb7f..1f943484e 100644 --- a/test/Streamly/Test/Data/Unbox.hs +++ b/test/Streamly/Test/Data/Unbox.hs @@ -40,8 +40,8 @@ import Test.Hspec as H #define MODULE_NAME "Data.Serialize.Deriving.TH" #define DERIVE_UNBOX(typ) $(deriveSerialize [d|instance Serialize typ|]) -#define PEEK(i, arr, sz) (deserialize i arr sz) -#define POKE(i, arr, val) (serialize i arr val) +#define PEEK(i, arr, sz) (deserializeAt i arr sz) +#define POKE(i, arr, val) (serializeAt i arr val) #define TYPE_CLASS Serialize #else @@ -185,7 +185,7 @@ variableSizeOf :: forall a. Serialize a => a -> Int -variableSizeOf = size 0 +variableSizeOf = addSizeTo 0 #endif testSerialization ::