Skip to content

Commit

Permalink
Update streamly to the latest master
Browse files Browse the repository at this point in the history
  • Loading branch information
adithyaov committed Dec 2, 2023
1 parent 2cfe0ec commit 4ec7597
Show file tree
Hide file tree
Showing 7 changed files with 103 additions and 109 deletions.
30 changes: 15 additions & 15 deletions benchmark/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,9 +19,9 @@ import Control.DeepSeq (NFData(..), deepseq, force)
import System.Random (randomRIO)
import Streamly.Data.Serialize.Instances ()
import Test.QuickCheck (Gen, generate, arbitrary)
import Streamly.Internal.Data.Unbox (newBytes, MutableByteArray)
import Streamly.Internal.Data.Serialize hiding (encode)
import Streamly.Internal.Data.MutByteArray (Serialize, MutByteArray)

import qualified Streamly.Internal.Data.MutByteArray as MBA
import qualified Streamly.Data.Stream as Stream
import qualified Data.Text as TextS
import qualified Data.Text.Lazy as TextL
Expand All @@ -39,7 +39,7 @@ import Test.Tasty.Bench

{-# INLINE getSize #-}
getSize :: forall a. Serialize a => a -> Int
getSize = size 0
getSize = MBA.addSizeTo 0

-------------------------------------------------------------------------------
-- Common helpers
Expand Down Expand Up @@ -76,14 +76,14 @@ benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
-------------------------------------------------------------------------------

{-# INLINE poke #-}
poke :: Serialize a => MutableByteArray -> a -> IO ()
poke arr val = serialize 0 arr val >> return ()
poke :: Serialize a => MutByteArray -> a -> IO ()
poke arr val = MBA.serializeAt 0 arr val >> return ()

{-# INLINE pokeTimes #-}
pokeTimes :: Serialize a => a -> Int -> IO ()
pokeTimes val times = do
let n = getSize val
arr <- newBytes n
arr <- MBA.new n
loopWith times poke arr val

-- There is peoblem with using tasty. For 'Value', 'encode' goes to an infinite
Expand All @@ -94,18 +94,18 @@ pokeTimes val times = do
encode :: Serialize a => a -> IO ()
encode val = do
let n = getSize val
arr <- newBytes n
serialize 0 arr val >> return ()
arr <- MBA.new n
MBA.serializeAt 0 arr val >> return ()

{-# INLINE encodeTimes #-}
encodeTimes :: Serialize a => a -> Int -> IO ()
encodeTimes val times = loop times encode val

{-# INLINE peek #-}
peek :: forall a. (NFData a, Serialize a) =>
(a, Int) -> MutableByteArray -> IO ()
(a, Int) -> MutByteArray -> IO ()
peek (_val, n) arr = do
(_, val1 :: a) <- deserialize 0 arr n
(_, val1 :: a) <- MBA.deserializeAt 0 arr n
-- If the datatype is not deeply strict or deepseq is not used then use
-- Equality.
-- Ensure that we are actually constructing the type and using it. This
Expand All @@ -125,17 +125,17 @@ peek (_val, n) arr = do
{-# INLINE peekTimes #-}
peekTimes :: (NFData a, Serialize a) => Int -> a -> Int -> IO ()
peekTimes n val times = do
arr <- newBytes n
_ <- serialize 0 arr val
arr <- MBA.new n
_ <- MBA.serializeAt 0 arr val
loopWith times peek (val, n) arr

{-# INLINE roundtrip #-}
roundtrip :: forall a. (NFData a, Serialize a) => a -> IO ()
roundtrip val = do
let n = getSize val
arr <- newBytes n
_ <- serialize 0 arr val
(_, val1 :: a) <- deserialize 0 arr n
arr <- MBA.new n
_ <- MBA.serializeAt 0 arr val
(_, val1 :: a) <- MBA.deserializeAt 0 arr n
-- Do not remove this or use deepseq, see the comments in peek.
{-
if (val1 /= val)
Expand Down
2 changes: 1 addition & 1 deletion cabal.project.set-1
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ packages: .
source-repository-package
type: git
location: https://github.com/composewell/streamly.git
tag: 8e04e4b9885d573bef9a3ccac0f891a35212aaf6
tag: 12d85026291d9305f93f573d284d0d35abf40968
subdir: core

constraints:
Expand Down
2 changes: 1 addition & 1 deletion cabal.project.user
Original file line number Diff line number Diff line change
Expand Up @@ -3,5 +3,5 @@ packages: .
source-repository-package
type: git
location: https://github.com/composewell/streamly.git
tag: 8e04e4b9885d573bef9a3ccac0f891a35212aaf6
tag: 12d85026291d9305f93f573d284d0d35abf40968
subdir: core
91 changes: 44 additions & 47 deletions src/Streamly/Data/Serialize/Instances.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,7 @@ import Data.Scientific (Scientific)
import Data.Time (Day, TimeOfDay, LocalTime, DiffTime, UTCTime)
import Streamly.Data.Serialize.Instances.Text ()
import Streamly.Data.Serialize.Instances.ByteString ()
import Streamly.Internal.Data.Serialize (Serialize(..))
import Streamly.Internal.Data.Unbox (MutableByteArray)
import Streamly.Internal.Data.MutByteArray (Serialize(..), MutByteArray)

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as Aeson
Expand All @@ -33,27 +32,24 @@ import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Vector as Vector
import qualified Data.Vector.Mutable as MVector
import qualified Streamly.Internal.Data.Serialize.TH as Serialize
import qualified Streamly.Internal.Data.Unbox as Unbox
import qualified Streamly.Internal.Data.MutByteArray as MBA

--------------------------------------------------------------------------------
-- Time
--------------------------------------------------------------------------------

$(Serialize.deriveSerializeWith
Serialize.defaultConfig
[d|instance Serialize (Fixed a)|])
$(Serialize.deriveSerialize ''Day)
$(Serialize.deriveSerialize ''TimeOfDay)
$(Serialize.deriveSerialize ''LocalTime)
$(Serialize.deriveSerialize ''DiffTime)
$(Serialize.deriveSerialize ''UTCTime)
$(MBA.deriveSerialize [d|instance Serialize (Fixed a)|])
$(MBA.deriveSerialize [d|instance Serialize Day|])
$(MBA.deriveSerialize [d|instance Serialize TimeOfDay|])
$(MBA.deriveSerialize [d|instance Serialize LocalTime|])
$(MBA.deriveSerialize [d|instance Serialize DiffTime|])
$(MBA.deriveSerialize [d|instance Serialize UTCTime|])

--------------------------------------------------------------------------------
-- Scientific
--------------------------------------------------------------------------------

$(Serialize.deriveSerialize ''Scientific)
$(MBA.deriveSerialize [d|instance Serialize Scientific|])

--------------------------------------------------------------------------------
-- Map
Expand All @@ -68,16 +64,16 @@ $(Serialize.deriveSerialize ''Scientific)
-- Strategy 2 is more efficient than Strategy 1.
-- Check why this is the case.

-- $(Serialize.deriveSerialize ''Map)
-- $(MBA.deriveSerialize [d|instance Serialize Map|])

instance (Ord k, Serialize k, Serialize v) => Serialize (Map k v) where
{-# INLINE size #-}
size acc val = size acc (Map.toList val)
{-# INLINE serialize #-}
serialize off arr val = serialize off arr (Map.toList val)
{-# INLINE deserialize #-}
deserialize off arr end = do
(off1, kvList) <- deserialize off arr end
{-# INLINE addSizeTo #-}
addSizeTo acc val = addSizeTo acc (Map.toList val)
{-# INLINE serializeAt #-}
serializeAt off arr val = serializeAt off arr (Map.toList val)
{-# INLINE deserializeAt #-}
deserializeAt off arr end = do
(off1, kvList) <- deserializeAt off arr end
pure (off1, Map.fromList kvList)

--------------------------------------------------------------------------------
Expand All @@ -103,59 +99,60 @@ instance (Ord k, Serialize k, Serialize v) => Serialize (Map k v) where
-- much nesting. We can revisit this to find the exact cause.

{-
$(Serialize.deriveSerialize ''HashMap.Leaf)
$(Serialize.deriveSerialize ''HashMap.HashMap)
$(MBA.deriveSerialize [d|instance Serialize HashMap.Leaf|])
$(MBA.deriveSerialize [d|instance Serialize HashMap.HashMap|])
-}

instance (Eq k, Hashable k, Serialize k, Serialize v) =>
Serialize (HashMap.HashMap k v) where
{-# INLINE size #-}
size acc val = size acc (HashMap.toList val)
{-# INLINE serialize #-}
serialize off arr val = serialize off arr (HashMap.toList val)
{-# INLINE deserialize #-}
deserialize off arr end = do
(off1, kvList) <- deserialize off arr end
{-# INLINE addSizeTo #-}
addSizeTo acc val = addSizeTo acc (HashMap.toList val)
{-# INLINE serializeAt #-}
serializeAt off arr val = serializeAt off arr (HashMap.toList val)
{-# INLINE deserializeAt #-}
deserializeAt off arr end = do
(off1, kvList) <- deserializeAt off arr end
pure (off1, HashMap.fromList kvList)

--------------------------------------------------------------------------------
-- Aeson.Value
--------------------------------------------------------------------------------

#if MIN_VERSION_aeson(2,0,0)
$(Serialize.deriveSerialize ''Aeson.Key)
$(Serialize.deriveSerialize ''Aeson.KeyMap)
$(MBA.deriveSerialize [d|instance Serialize Aeson.Key|])
$(MBA.deriveSerialize
[d|instance Serialize v => Serialize (Aeson.KeyMap v)|])
#endif

$(Serialize.deriveSerialize ''Aeson.Value)
$(MBA.deriveSerialize [d|instance Serialize Aeson.Value|])

--------------------------------------------------------------------------------
-- Vector.Vector
--------------------------------------------------------------------------------

instance Serialize a => Serialize (Vector.Vector a) where

{-# INLINE size #-}
size :: Int -> (Vector.Vector a) -> Int
size acc = Vector.foldl' size (acc + Unbox.sizeOf (Proxy :: Proxy Int64))
{-# INLINE addSizeTo #-}
addSizeTo :: Int -> (Vector.Vector a) -> Int
addSizeTo acc = Vector.foldl' addSizeTo (acc + MBA.sizeOf (Proxy :: Proxy Int64))

{-# INLINE serialize #-}
serialize :: Int -> MutableByteArray -> (Vector.Vector a) -> IO Int
serialize off arr val = do
{-# INLINE serializeAt #-}
serializeAt :: Int -> MutByteArray -> (Vector.Vector a) -> IO Int
serializeAt off arr val = do
let len = Vector.length val
finalOffset <-
Vector.foldM'
(\curOff v -> serialize curOff arr v)
(off + Unbox.sizeOf (Proxy :: Proxy Int64))
(\curOff v -> serializeAt curOff arr v)
(off + MBA.sizeOf (Proxy :: Proxy Int64))
val
Unbox.pokeByteIndex off arr ((fromIntegral :: Int -> Int64) len)
MBA.pokeAt off arr ((fromIntegral :: Int -> Int64) len)
pure finalOffset

{-# INLINE deserialize #-}
deserialize :: Int -> MutableByteArray -> Int -> IO (Int, Vector.Vector a)
deserialize off arr s = do
{-# INLINE deserializeAt #-}
deserializeAt :: Int -> MutByteArray -> Int -> IO (Int, Vector.Vector a)
deserializeAt off arr s = do

(off1, len64) <- deserialize off arr s
(off1, len64) <- deserializeAt off arr s
let len = (fromIntegral :: Int64 -> Int) len64
val <- MVector.new len
(off2, val1) <- fillVector len 0 off1 val
Expand All @@ -167,6 +164,6 @@ instance Serialize a => Serialize (Vector.Vector a) where
fillVector len acc off1 val
| acc >= len = pure (off1, val)
| otherwise = do
(off2, v) <- deserialize off1 arr s
(off2, v) <- deserializeAt off1 arr s
MVector.write val acc v
fillVector len (acc + 1) off2 val
27 changes: 13 additions & 14 deletions src/Streamly/Data/Serialize/Instances/ByteString.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,12 +6,11 @@ import Data.Int (Int64)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (plusPtr)
import GHC.Base (IO(..))
import Streamly.Internal.Data.Serialize (Serialize(..))
import Streamly.Internal.Data.MutByteArray (Serialize(..))

import qualified Data.ByteString.Internal as Strict
import qualified Data.ByteString.Lazy as Lazy
import qualified Streamly.Internal.Data.Unbox as Unbox
import qualified Streamly.Internal.Data.Serialize.TH as Serialize
import qualified Streamly.Internal.Data.MutByteArray as MBA

import GHC.Exts

Expand All @@ -21,26 +20,26 @@ import GHC.Exts

instance Serialize Strict.ByteString where

{-# INLINE size #-}
size i (Strict.PS _ _ l) = i + l + 8 -- 8 is the length of Int64
{-# INLINE addSizeTo #-}
addSizeTo i (Strict.PS _ _ l) = i + l + 8 -- 8 is the length of Int64

{-# INLINE deserialize #-}
deserialize off arr end = do
(off1, len) <- deserialize off arr end :: IO (Int, Int64)
{-# INLINE deserializeAt #-}
deserializeAt off arr end = do
(off1, len) <- deserializeAt off arr end :: IO (Int, Int64)
let lenBytes = fromIntegral len
bs <- Strict.create lenBytes $ \(Ptr addr#) ->
let arrS# = Unbox.getMutableByteArray# arr
let arrS# = MBA.getMutableByteArray# arr
!(I# srcStartBytes#) = off1
!(I# lenBytes#) = lenBytes
in IO $ \s# -> (# copyMutableByteArrayToAddr#
arrS# srcStartBytes# addr# lenBytes# s#
, () #)
return (off1 + lenBytes, bs)

{-# INLINE serialize #-}
serialize off arr (Strict.PS fp srcOffset lenBytes) = do
off1 <- serialize off arr (fromIntegral lenBytes :: Int64)
let arrD# = Unbox.getMutableByteArray# arr
{-# INLINE serializeAt #-}
serializeAt off arr (Strict.PS fp srcOffset lenBytes) = do
off1 <- serializeAt off arr (fromIntegral lenBytes :: Int64)
let arrD# = MBA.getMutableByteArray# arr
!(I# dstStartBytes#) = off1
!(I# lenBytes#) = lenBytes
withForeignPtr fp $ \srcPtr ->
Expand All @@ -54,4 +53,4 @@ instance Serialize Strict.ByteString where
-- Lazy ByteString
--------------------------------------------------------------------------------

$(Serialize.deriveSerialize ''Lazy.ByteString)
$(MBA.deriveSerialize [d|instance Serialize Lazy.ByteString|])
32 changes: 15 additions & 17 deletions src/Streamly/Data/Serialize/Instances/Text.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,13 +13,11 @@ module Streamly.Data.Serialize.Instances.Text () where
--------------------------------------------------------------------------------

import Data.Int (Int64)
import Streamly.Internal.Data.Serialize (Serialize(..))
import Streamly.Internal.Data.Unbox (MutableByteArray(..))
import Streamly.Internal.Data.MutByteArray (MutByteArray(..), Serialize(..))

import qualified Data.Text.Internal as Strict (Text(..))
import qualified Data.Text.Lazy as Lazy
import qualified Streamly.Internal.Data.Unbox as Unbox
import qualified Streamly.Internal.Data.Serialize.TH as Serialize
import qualified Streamly.Internal.Data.MutByteArray as MBA

#if MIN_VERSION_text(2,0,0)

Expand All @@ -42,40 +40,40 @@ import GHC.Exts
--------------------------------------------------------------------------------

instance Serialize Strict.Text where
size i (Strict.Text _ _ lenTArr) =
addSizeTo i (Strict.Text _ _ lenTArr) =
-- 8 is the length of Int64
i + LEN_TO_BYTES(lenTArr) + 8

{-# INLINE deserialize #-}
deserialize off arr end = do
(off1, lenTArr64) <- deserialize off arr end :: IO (Int, Int64)
{-# INLINE deserializeAt #-}
deserializeAt off arr end = do
(off1, lenTArr64) <- deserializeAt off arr end :: IO (Int, Int64)
let lenTArr = fromIntegral lenTArr64 :: Int
lenBytes = fromIntegral (LEN_TO_BYTES(lenTArr))

-- Check the available length in input buffer
if (off1 + lenBytes <= end)
then do
newArr <- Unbox.newBytes lenBytes
newArr <- MBA.new lenBytes
-- XXX We can perform an unrolled word copy directly?
Unbox.putSliceUnsafe arr off1 newArr 0 lenBytes
MBA.putSliceUnsafe arr off1 newArr 0 lenBytes
pure
( off1 + lenBytes
, Strict.Text
(T_ARR_CON
(unsafeCoerce# (Unbox.getMutableByteArray# newArr)))
(unsafeCoerce# (MBA.getMutableByteArray# newArr)))
0
lenTArr
)
else error $ "deserialize: Strict.Text: input buffer underflow: off1 = "
++ show off1 ++ " lenBytes = " ++ show lenBytes
++ " end = " ++ show end

{-# INLINE serialize #-}
serialize off arr (Strict.Text (T_ARR_CON barr#) offTArr lenTArr) = do
off1 <- serialize off arr (fromIntegral lenTArr :: Int64)
{-# INLINE serializeAt #-}
serializeAt off arr (Strict.Text (T_ARR_CON barr#) offTArr lenTArr) = do
off1 <- serializeAt off arr (fromIntegral lenTArr :: Int64)
let lenBytes = LEN_TO_BYTES(lenTArr)
Unbox.putSliceUnsafe
(MutableByteArray (unsafeCoerce# barr#)) (LEN_TO_BYTES(offTArr))
MBA.putSliceUnsafe
(MutByteArray (unsafeCoerce# barr#)) (LEN_TO_BYTES(offTArr))
arr off1
lenBytes
pure (off1 + lenBytes)
Expand All @@ -84,4 +82,4 @@ instance Serialize Strict.Text where
-- Lazy Text
--------------------------------------------------------------------------------

$(Serialize.deriveSerialize ''Lazy.Text)
$(MBA.deriveSerialize [d|instance Serialize Lazy.Text|])
Loading

0 comments on commit 4ec7597

Please sign in to comment.