mirror of
https://github.com/composewell/streamly.git
synced 2024-08-16 23:10:36 +03:00
Rename Data.Serialize to Data.MutByteArray
This commit is contained in:
parent
bc14a48af1
commit
6705ec00b9
@ -53,7 +53,7 @@ import Streamly.Benchmark.Common.Handle
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
|
||||
#ifdef INSPECTION
|
||||
import Streamly.Internal.Data.Serialize (Unbox)
|
||||
import Streamly.Internal.Data.MutByteArray (Unbox)
|
||||
import Streamly.Internal.Data.Stream (Step(..))
|
||||
import Test.Inspection
|
||||
#endif
|
||||
|
@ -24,7 +24,7 @@ import System.Random (randomRIO)
|
||||
import Test.QuickCheck (Arbitrary, arbitrary)
|
||||
#endif
|
||||
|
||||
import Streamly.Internal.Data.Serialize hiding (encode)
|
||||
import Streamly.Internal.Data.MutByteArray hiding (encode)
|
||||
#ifdef USE_UNBOX
|
||||
import Data.Proxy (Proxy(..))
|
||||
#else
|
||||
|
@ -9,10 +9,10 @@ module Streamly.Benchmark.Data.Serialize.RecCompatible
|
||||
-- Imports
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Streamly.Internal.Data.Serialize (Serialize)
|
||||
import Streamly.Internal.Data.MutByteArray (Serialize)
|
||||
import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)
|
||||
|
||||
import qualified Streamly.Internal.Data.Serialize as Serialize
|
||||
import qualified Streamly.Internal.Data.MutByteArray as Serialize
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Code
|
||||
|
@ -11,7 +11,7 @@ module Streamly.Benchmark.Data.Serialize.RecNonCompatible
|
||||
|
||||
import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)
|
||||
|
||||
import qualified Streamly.Internal.Data.Serialize as Serialize
|
||||
import qualified Streamly.Internal.Data.MutByteArray as Serialize
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Code
|
||||
|
@ -8,7 +8,7 @@ module Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) where
|
||||
|
||||
import Language.Haskell.TH
|
||||
|
||||
import Streamly.Internal.Data.Serialize (makeI)
|
||||
import Streamly.Internal.Data.MutByteArray (makeI)
|
||||
import Control.DeepSeq (NFData(..))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -43,7 +43,7 @@ import Streamly.Benchmark.Common
|
||||
import Streamly.Benchmark.Common.Handle
|
||||
|
||||
#ifdef INSPECTION
|
||||
import Streamly.Internal.Data.Serialize (Unbox)
|
||||
import Streamly.Internal.Data.MutByteArray (Unbox)
|
||||
import Streamly.Internal.Data.Stream (Step(..))
|
||||
import qualified Streamly.Internal.Data.Fold as Fold
|
||||
import qualified Streamly.Internal.Data.Tuple.Strict as Strict
|
||||
|
@ -1,5 +1,5 @@
|
||||
-- |
|
||||
-- Module : Streamly.Data.Serialize
|
||||
-- Module : Streamly.Data.MutByteArray
|
||||
-- Copyright : (c) 2023 Composewell Technologies
|
||||
-- License : BSD3-3-Clause
|
||||
-- Maintainer : streamly@composewell.com
|
||||
@ -42,7 +42,7 @@
|
||||
-- to and from an 'Array' type. You can also serialize and deserialize directly
|
||||
-- to and from a 'MutByteArray', using the type class methods.
|
||||
--
|
||||
module Streamly.Data.Serialize
|
||||
module Streamly.Data.MutByteArray
|
||||
(
|
||||
|
||||
-- * Mutable Byte Array
|
||||
@ -82,4 +82,4 @@ module Streamly.Data.Serialize
|
||||
-- Imports
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Streamly.Internal.Data.Serialize
|
||||
import Streamly.Internal.Data.MutByteArray
|
@ -121,7 +121,7 @@ import qualified Streamly.Internal.Data.MutArray.Type as MA
|
||||
import qualified Streamly.Internal.Data.Stream.Type as D
|
||||
import qualified Streamly.Internal.Data.Stream.Generate as D
|
||||
import qualified Streamly.Internal.Data.StreamK.Type as K
|
||||
import qualified Streamly.Internal.Data.MutByteArray as Unboxed
|
||||
import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed
|
||||
import qualified Streamly.Internal.Data.Unfold.Type as Unfold
|
||||
import qualified Text.ParserCombinators.ReadPrec as ReadPrec
|
||||
|
||||
|
@ -40,7 +40,8 @@ where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Streamly.Internal.Data.MutByteArray (MutByteArray(..), newByteArray)
|
||||
import Streamly.Internal.Data.MutByteArray.Type
|
||||
(MutByteArray(..), newByteArray)
|
||||
import Streamly.Internal.Data.Unbox (Unbox(..), sizeOf)
|
||||
|
||||
import qualified Streamly.Internal.Data.Stream.Type as D
|
||||
|
@ -239,7 +239,7 @@ import Data.Proxy (Proxy(..))
|
||||
import Data.Word (Word8)
|
||||
import Foreign.C.Types (CSize(..), CInt(..))
|
||||
import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
|
||||
import Streamly.Internal.Data.MutByteArray
|
||||
import Streamly.Internal.Data.MutByteArray.Type
|
||||
( MutByteArray(..)
|
||||
, MutableByteArray
|
||||
, PinnedState(..)
|
||||
@ -266,7 +266,7 @@ import Streamly.Internal.Data.Unfold.Type (Unfold(..))
|
||||
import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)
|
||||
|
||||
import qualified Streamly.Internal.Data.Fold.Type as FL
|
||||
import qualified Streamly.Internal.Data.MutByteArray as Unboxed
|
||||
import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed
|
||||
import qualified Streamly.Internal.Data.Producer as Producer
|
||||
import qualified Streamly.Internal.Data.Stream.Type as D
|
||||
import qualified Streamly.Internal.Data.Stream.Lift as D
|
||||
|
@ -1,249 +1,250 @@
|
||||
{-# LANGUAGE UnboxedTuples #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
-- This is required as all the instances in this module are orphan instances.
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
-- |
|
||||
-- Module : Streamly.Internal.Data.MutByteArray
|
||||
-- Copyright : (c) 2023 Composewell Technologies
|
||||
-- License : BSD3-3-Clause
|
||||
-- Maintainer : streamly@composewell.com
|
||||
-- Stability : experimental
|
||||
-- Portability : GHC
|
||||
--
|
||||
|
||||
module Streamly.Internal.Data.MutByteArray
|
||||
(
|
||||
-- ** MutByteArray
|
||||
MutByteArray(..)
|
||||
, MutableByteArray
|
||||
, getMutableByteArray#
|
||||
|
||||
-- ** Pinning
|
||||
, PinnedState(..)
|
||||
, isPinned
|
||||
, pin
|
||||
, unpin
|
||||
|
||||
-- ** Allocation
|
||||
, nil
|
||||
, newBytesAs
|
||||
, newByteArray
|
||||
, pinnedNewByteArray
|
||||
, pinnedNewAlignedBytes
|
||||
|
||||
-- ** Access
|
||||
, sizeOfMutableByteArray
|
||||
, putSliceUnsafe
|
||||
, asPtrUnsafe
|
||||
-- * MutByteArray
|
||||
module Streamly.Internal.Data.MutByteArray.Type
|
||||
-- * Unbox
|
||||
, module Streamly.Internal.Data.Unbox
|
||||
, module Streamly.Internal.Data.Unbox.TH
|
||||
-- * Serialize
|
||||
, module Streamly.Internal.Data.Serialize.Type
|
||||
-- * Serialize TH
|
||||
, module Streamly.Internal.Data.Serialize.TH
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
#ifdef DEBUG
|
||||
import Debug.Trace (trace)
|
||||
#endif
|
||||
import GHC.Base (IO(..))
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
||||
import GHC.Exts
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- The ArrayContents type
|
||||
-- Imports
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data PinnedState
|
||||
= Pinned
|
||||
| Unpinned
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Streamly.Internal.Data.Array (Array(..))
|
||||
import GHC.Exts (Int(..), sizeofByteArray#, unsafeCoerce#)
|
||||
import GHC.Word (Word8)
|
||||
|
||||
-- XXX can use UnliftedNewtypes
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
import GHC.Num.Integer (Integer(..))
|
||||
#else
|
||||
import GHC.Integer.GMP.Internals (Integer(..), BigNat(..))
|
||||
#endif
|
||||
|
||||
-- | A lifted mutable byte array type wrapping @MutableByteArray# RealWorld@.
|
||||
-- This is a low level array used to back high level unboxed arrays and
|
||||
-- serialized data.
|
||||
data MutByteArray = MutByteArray (MutableByteArray# RealWorld)
|
||||
|
||||
{-# DEPRECATED MutableByteArray "Please use MutByteArray instead" #-}
|
||||
type MutableByteArray = MutByteArray
|
||||
|
||||
{-# INLINE getMutableByteArray# #-}
|
||||
getMutableByteArray# :: MutByteArray -> MutableByteArray# RealWorld
|
||||
getMutableByteArray# (MutByteArray mbarr) = mbarr
|
||||
|
||||
-- | Return the size of the array in bytes.
|
||||
{-# INLINE sizeOfMutableByteArray #-}
|
||||
sizeOfMutableByteArray :: MutByteArray -> IO Int
|
||||
sizeOfMutableByteArray (MutByteArray arr) =
|
||||
IO $ \s ->
|
||||
case getSizeofMutableByteArray# arr s of
|
||||
(# s1, i #) -> (# s1, I# i #)
|
||||
|
||||
{-# INLINE touch #-}
|
||||
touch :: MutByteArray -> IO ()
|
||||
touch (MutByteArray contents) =
|
||||
IO $ \s -> case touch# contents s of s' -> (# s', () #)
|
||||
|
||||
-- XXX We can provide another API for "unsafe" FFI calls passing an unlifted
|
||||
-- pointer to the FFI call. For unsafe calls we do not need to pin the array.
|
||||
-- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in
|
||||
-- before the pointer is wrapped.
|
||||
--
|
||||
-- From the GHC manual:
|
||||
--
|
||||
-- GHC, since version 8.4, guarantees that garbage collection will never occur
|
||||
-- during an unsafe call, even in the bytecode interpreter, and further
|
||||
-- guarantees that unsafe calls will be performed in the calling thread. Making
|
||||
-- it safe to pass heap-allocated objects to unsafe functions.
|
||||
|
||||
-- | Use a @MutByteArray@ as @Ptr a@. This is useful when we want to pass
|
||||
-- an array as a pointer to some operating system call or to a "safe" FFI call.
|
||||
--
|
||||
-- If the array is not pinned it is copied to pinned memory before passing it
|
||||
-- to the monadic action.
|
||||
--
|
||||
-- /Performance Notes:/ Forces a copy if the array is not pinned. It is advised
|
||||
-- that the programmer keeps this in mind and creates a pinned array
|
||||
-- opportunistically before this operation occurs, to avoid the cost of a copy
|
||||
-- if possible.
|
||||
--
|
||||
-- /Unsafe/ because of direct pointer operations. The user must ensure that
|
||||
-- they are writing within the legal bounds of the array.
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE asPtrUnsafe #-}
|
||||
asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b
|
||||
asPtrUnsafe arr f = do
|
||||
contents <- liftIO $ pin arr
|
||||
let !ptr = Ptr (byteArrayContents#
|
||||
(unsafeCoerce# (getMutableByteArray# contents)))
|
||||
r <- f ptr
|
||||
liftIO $ touch contents
|
||||
return r
|
||||
import Streamly.Internal.Data.MutByteArray.Type
|
||||
import Streamly.Internal.Data.Serialize.TH
|
||||
import Streamly.Internal.Data.Serialize.Type
|
||||
import Streamly.Internal.Data.Unbox
|
||||
import Streamly.Internal.Data.Unbox.TH
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Creation
|
||||
-- Common instances
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{-# NOINLINE nil #-}
|
||||
nil :: MutByteArray
|
||||
nil = unsafePerformIO $ newByteArray 0
|
||||
-- Note
|
||||
-- ====
|
||||
--
|
||||
-- Even a non-functional change such as changing the order of constructors will
|
||||
-- change the instance derivation.
|
||||
--
|
||||
-- This will not pose a problem if both, encode, and decode are done by the same
|
||||
-- version of the application. There *might* be a problem if version that
|
||||
-- encodes differs from the version that decodes.
|
||||
--
|
||||
-- We need to add some compatibility tests using different versions of
|
||||
-- dependencies.
|
||||
--
|
||||
-- Although such chages for the most basic types won't happen we need to detect
|
||||
-- if it ever happens.
|
||||
--
|
||||
-- Should we worry about these kind of changes and this kind of compatibility?
|
||||
-- This is a problem for all types of derivations that depend on the order of
|
||||
-- constructors, for example, Enum.
|
||||
|
||||
{-# INLINE newByteArray #-}
|
||||
newByteArray :: Int -> IO MutByteArray
|
||||
newByteArray nbytes | nbytes < 0 =
|
||||
errorWithoutStackTrace "newByteArray: size must be >= 0"
|
||||
newByteArray (I# nbytes) = IO $ \s ->
|
||||
case newByteArray# nbytes s of
|
||||
(# s', mbarr# #) ->
|
||||
let c = MutByteArray mbarr#
|
||||
in (# s', c #)
|
||||
-- Note on Windows build
|
||||
-- =====================
|
||||
--
|
||||
-- On Windows, having template haskell splices here fail the build with the
|
||||
-- following error:
|
||||
--
|
||||
-- @
|
||||
-- addLibrarySearchPath: C:\... (Win32 error 3): The system cannot find the path specified.
|
||||
-- @
|
||||
--
|
||||
-- The error might be irrelavant but having these splices triggers it. We should
|
||||
-- either fix the problem or avoid the use to template haskell splices in this
|
||||
-- file.
|
||||
--
|
||||
-- Similar issue: https://github.com/haskell/cabal/issues/4741
|
||||
|
||||
{-# INLINE pinnedNewByteArray #-}
|
||||
pinnedNewByteArray :: Int -> IO MutByteArray
|
||||
pinnedNewByteArray nbytes | nbytes < 0 =
|
||||
errorWithoutStackTrace "pinnedNewByteArray: size must be >= 0"
|
||||
pinnedNewByteArray (I# nbytes) = IO $ \s ->
|
||||
case newPinnedByteArray# nbytes s of
|
||||
(# s', mbarr# #) ->
|
||||
let c = MutByteArray mbarr#
|
||||
in (# s', c #)
|
||||
-- $(Serialize.deriveSerialize ''Maybe)
|
||||
instance Serialize a => Serialize (Maybe a) where
|
||||
|
||||
{-# INLINE pinnedNewAlignedBytes #-}
|
||||
pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray
|
||||
pinnedNewAlignedBytes nbytes _align | nbytes < 0 =
|
||||
errorWithoutStackTrace "pinnedNewAlignedBytes: size must be >= 0"
|
||||
pinnedNewAlignedBytes (I# nbytes) (I# align) = IO $ \s ->
|
||||
case newAlignedPinnedByteArray# nbytes align s of
|
||||
(# s', mbarr# #) ->
|
||||
let c = MutByteArray mbarr#
|
||||
in (# s', c #)
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
Nothing -> (acc + 1)
|
||||
Just field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE newBytesAs #-}
|
||||
newBytesAs :: PinnedState -> Int -> IO MutByteArray
|
||||
newBytesAs Unpinned = newByteArray
|
||||
newBytesAs Pinned = pinnedNewByteArray
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> pure (i0, Nothing)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Just a0)
|
||||
_ -> error "Found invalid tag while peeking (Maybe a)"
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Copying
|
||||
-------------------------------------------------------------------------------
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
Nothing -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
pure i0
|
||||
Just field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
-- $(Serialize.deriveSerialize ''Either)
|
||||
instance (Serialize a, Serialize b) => Serialize (Either a b) where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
Left field0 -> (size (acc + 1)) field0
|
||||
Right field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Left a0)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Right a0)
|
||||
_ -> error "Found invalid tag while peeking (Either a b)"
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
Left field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
Right field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
instance Serialize (Proxy a) where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc _ = (acc + 1)
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset _ _ = pure ((initialOffset + 1), Proxy)
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset _ _ = pure (initialOffset + 1)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Integer
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data LiftedInteger
|
||||
= LIS Int
|
||||
| LIP (Array Word)
|
||||
| LIN (Array Word)
|
||||
|
||||
-- $(Serialize.deriveSerialize ''LiftedInteger)
|
||||
instance Serialize LiftedInteger where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
LIS field0 -> (size (acc + 1)) field0
|
||||
LIP field0 -> (size (acc + 1)) field0
|
||||
LIN field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIS a0)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIP a0)
|
||||
2 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIN a0)
|
||||
_ -> error "Found invalid tag while peeking (LiftedInteger)"
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
LIS field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
LIP field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
LIN field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (2 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
|
||||
{-# INLINE liftInteger #-}
|
||||
liftInteger :: Integer -> LiftedInteger
|
||||
liftInteger (IS x) = LIS (I# x)
|
||||
liftInteger (IP x) =
|
||||
LIP (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
|
||||
liftInteger (IN x) =
|
||||
LIN (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
|
||||
|
||||
{-# INLINE unliftInteger #-}
|
||||
unliftInteger :: LiftedInteger -> Integer
|
||||
unliftInteger (LIS (I# x)) = IS x
|
||||
unliftInteger (LIP (Array (MutByteArray x) _ _)) = IP (unsafeCoerce# x)
|
||||
unliftInteger (LIN (Array (MutByteArray x) _ _)) = IN (unsafeCoerce# x)
|
||||
|
||||
#else
|
||||
|
||||
{-# INLINE liftInteger #-}
|
||||
liftInteger :: Integer -> LiftedInteger
|
||||
liftInteger (S# x) = LIS (I# x)
|
||||
liftInteger (Jp# (BN# x)) =
|
||||
LIP (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
|
||||
liftInteger (Jn# (BN# x)) =
|
||||
LIN (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
|
||||
|
||||
{-# INLINE unliftInteger #-}
|
||||
unliftInteger :: LiftedInteger -> Integer
|
||||
unliftInteger (LIS (I# x)) = S# x
|
||||
unliftInteger (LIP (Array (MutByteArray x) _ _)) =
|
||||
Jp# (BN# (unsafeCoerce# x))
|
||||
unliftInteger (LIN (Array (MutByteArray x) _ _)) =
|
||||
Jn# (BN# (unsafeCoerce# x))
|
||||
|
||||
-- | Put a sub range of a source array into a subrange of a destination array.
|
||||
-- This is not safe as it does not check the bounds.
|
||||
{-# INLINE putSliceUnsafe #-}
|
||||
putSliceUnsafe ::
|
||||
MonadIO m
|
||||
=> MutByteArray
|
||||
-> Int
|
||||
-> MutByteArray
|
||||
-> Int
|
||||
-> Int
|
||||
-> m ()
|
||||
putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do
|
||||
#ifdef DEBUG
|
||||
srcLen <- sizeOfMutableByteArray src
|
||||
dstLen <- sizeOfMutableByteArray src
|
||||
when (srcLen - srcStartBytes < lenBytes) $ error "SRC: Insufficient length."
|
||||
when (dstLen - dstStartBytes < lenBytes) $ error "DST: Insufficient length."
|
||||
#endif
|
||||
let !(I# srcStartBytes#) = srcStartBytes
|
||||
!(I# dstStartBytes#) = dstStartBytes
|
||||
!(I# lenBytes#) = lenBytes
|
||||
let arrS# = getMutableByteArray# src
|
||||
arrD# = getMutableByteArray# dst
|
||||
IO $ \s# -> (# copyMutableByteArray#
|
||||
arrS# srcStartBytes# arrD# dstStartBytes# lenBytes# s#
|
||||
, () #)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Pinning & Unpinning
|
||||
-------------------------------------------------------------------------------
|
||||
instance Serialize Integer where
|
||||
{-# INLINE size #-}
|
||||
size i a = size i (liftInteger a)
|
||||
|
||||
{-# INLINE isPinned #-}
|
||||
isPinned :: MutByteArray -> Bool
|
||||
isPinned (MutByteArray arr#) =
|
||||
let pinnedInt = I# (isMutableByteArrayPinned# arr#)
|
||||
in pinnedInt /= 0
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize off arr end = fmap unliftInteger <$> deserialize off arr end
|
||||
|
||||
|
||||
{-# INLINE cloneMutableArrayWith# #-}
|
||||
cloneMutableArrayWith#
|
||||
:: (Int# -> State# RealWorld -> (# State# RealWorld
|
||||
, MutableByteArray# RealWorld #))
|
||||
-> MutableByteArray# RealWorld
|
||||
-> State# RealWorld
|
||||
-> (# State# RealWorld, MutableByteArray# RealWorld #)
|
||||
cloneMutableArrayWith# alloc# arr# s# =
|
||||
case getSizeofMutableByteArray# arr# s# of
|
||||
(# s1#, i# #) ->
|
||||
case alloc# i# s1# of
|
||||
(# s2#, arr1# #) ->
|
||||
case copyMutableByteArray# arr# 0# arr1# 0# i# s2# of
|
||||
s3# -> (# s3#, arr1# #)
|
||||
|
||||
{-# INLINE pin #-}
|
||||
pin :: MutByteArray -> IO MutByteArray
|
||||
pin arr@(MutByteArray marr#) =
|
||||
if isPinned arr
|
||||
then return arr
|
||||
else
|
||||
#ifdef DEBUG
|
||||
do
|
||||
-- XXX dump stack trace
|
||||
trace ("pin: Copying array") (return ())
|
||||
#endif
|
||||
IO
|
||||
$ \s# ->
|
||||
case cloneMutableArrayWith# newPinnedByteArray# marr# s# of
|
||||
(# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)
|
||||
|
||||
{-# INLINE unpin #-}
|
||||
unpin :: MutByteArray -> IO MutByteArray
|
||||
unpin arr@(MutByteArray marr#) =
|
||||
if not (isPinned arr)
|
||||
then return arr
|
||||
else
|
||||
#ifdef DEBUG
|
||||
do
|
||||
-- XXX dump stack trace
|
||||
trace ("unpin: Copying array") (return ())
|
||||
#endif
|
||||
IO
|
||||
$ \s# ->
|
||||
case cloneMutableArrayWith# newByteArray# marr# s# of
|
||||
(# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)
|
||||
{-# INLINE serialize #-}
|
||||
serialize off arr val = serialize off arr (liftInteger val)
|
||||
|
249
core/src/Streamly/Internal/Data/MutByteArray/Type.hs
Normal file
249
core/src/Streamly/Internal/Data/MutByteArray/Type.hs
Normal file
@ -0,0 +1,249 @@
|
||||
{-# LANGUAGE UnboxedTuples #-}
|
||||
|
||||
-- |
|
||||
-- Module : Streamly.Internal.Data.MutByteArray.Type
|
||||
-- Copyright : (c) 2023 Composewell Technologies
|
||||
-- License : BSD3-3-Clause
|
||||
-- Maintainer : streamly@composewell.com
|
||||
-- Stability : experimental
|
||||
-- Portability : GHC
|
||||
--
|
||||
module Streamly.Internal.Data.MutByteArray.Type
|
||||
(
|
||||
-- ** MutByteArray
|
||||
MutByteArray(..)
|
||||
, MutableByteArray
|
||||
, getMutableByteArray#
|
||||
|
||||
-- ** Pinning
|
||||
, PinnedState(..)
|
||||
, isPinned
|
||||
, pin
|
||||
, unpin
|
||||
|
||||
-- ** Allocation
|
||||
, nil
|
||||
, newBytesAs
|
||||
, newByteArray
|
||||
, pinnedNewByteArray
|
||||
, pinnedNewAlignedBytes
|
||||
|
||||
-- ** Access
|
||||
, sizeOfMutableByteArray
|
||||
, putSliceUnsafe
|
||||
, asPtrUnsafe
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
#ifdef DEBUG
|
||||
import Debug.Trace (trace)
|
||||
#endif
|
||||
import GHC.Base (IO(..))
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
||||
import GHC.Exts
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- The ArrayContents type
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data PinnedState
|
||||
= Pinned
|
||||
| Unpinned
|
||||
|
||||
-- XXX can use UnliftedNewtypes
|
||||
|
||||
-- | A lifted mutable byte array type wrapping @MutableByteArray# RealWorld@.
|
||||
-- This is a low level array used to back high level unboxed arrays and
|
||||
-- serialized data.
|
||||
data MutByteArray = MutByteArray (MutableByteArray# RealWorld)
|
||||
|
||||
{-# DEPRECATED MutableByteArray "Please use MutByteArray instead" #-}
|
||||
type MutableByteArray = MutByteArray
|
||||
|
||||
{-# INLINE getMutableByteArray# #-}
|
||||
getMutableByteArray# :: MutByteArray -> MutableByteArray# RealWorld
|
||||
getMutableByteArray# (MutByteArray mbarr) = mbarr
|
||||
|
||||
-- | Return the size of the array in bytes.
|
||||
{-# INLINE sizeOfMutableByteArray #-}
|
||||
sizeOfMutableByteArray :: MutByteArray -> IO Int
|
||||
sizeOfMutableByteArray (MutByteArray arr) =
|
||||
IO $ \s ->
|
||||
case getSizeofMutableByteArray# arr s of
|
||||
(# s1, i #) -> (# s1, I# i #)
|
||||
|
||||
{-# INLINE touch #-}
|
||||
touch :: MutByteArray -> IO ()
|
||||
touch (MutByteArray contents) =
|
||||
IO $ \s -> case touch# contents s of s' -> (# s', () #)
|
||||
|
||||
-- XXX We can provide another API for "unsafe" FFI calls passing an unlifted
|
||||
-- pointer to the FFI call. For unsafe calls we do not need to pin the array.
|
||||
-- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in
|
||||
-- before the pointer is wrapped.
|
||||
--
|
||||
-- From the GHC manual:
|
||||
--
|
||||
-- GHC, since version 8.4, guarantees that garbage collection will never occur
|
||||
-- during an unsafe call, even in the bytecode interpreter, and further
|
||||
-- guarantees that unsafe calls will be performed in the calling thread. Making
|
||||
-- it safe to pass heap-allocated objects to unsafe functions.
|
||||
|
||||
-- | Use a @MutByteArray@ as @Ptr a@. This is useful when we want to pass
|
||||
-- an array as a pointer to some operating system call or to a "safe" FFI call.
|
||||
--
|
||||
-- If the array is not pinned it is copied to pinned memory before passing it
|
||||
-- to the monadic action.
|
||||
--
|
||||
-- /Performance Notes:/ Forces a copy if the array is not pinned. It is advised
|
||||
-- that the programmer keeps this in mind and creates a pinned array
|
||||
-- opportunistically before this operation occurs, to avoid the cost of a copy
|
||||
-- if possible.
|
||||
--
|
||||
-- /Unsafe/ because of direct pointer operations. The user must ensure that
|
||||
-- they are writing within the legal bounds of the array.
|
||||
--
|
||||
-- /Pre-release/
|
||||
--
|
||||
{-# INLINE asPtrUnsafe #-}
|
||||
asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b
|
||||
asPtrUnsafe arr f = do
|
||||
contents <- liftIO $ pin arr
|
||||
let !ptr = Ptr (byteArrayContents#
|
||||
(unsafeCoerce# (getMutableByteArray# contents)))
|
||||
r <- f ptr
|
||||
liftIO $ touch contents
|
||||
return r
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Creation
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{-# NOINLINE nil #-}
|
||||
nil :: MutByteArray
|
||||
nil = unsafePerformIO $ newByteArray 0
|
||||
|
||||
{-# INLINE newByteArray #-}
|
||||
newByteArray :: Int -> IO MutByteArray
|
||||
newByteArray nbytes | nbytes < 0 =
|
||||
errorWithoutStackTrace "newByteArray: size must be >= 0"
|
||||
newByteArray (I# nbytes) = IO $ \s ->
|
||||
case newByteArray# nbytes s of
|
||||
(# s', mbarr# #) ->
|
||||
let c = MutByteArray mbarr#
|
||||
in (# s', c #)
|
||||
|
||||
{-# INLINE pinnedNewByteArray #-}
|
||||
pinnedNewByteArray :: Int -> IO MutByteArray
|
||||
pinnedNewByteArray nbytes | nbytes < 0 =
|
||||
errorWithoutStackTrace "pinnedNewByteArray: size must be >= 0"
|
||||
pinnedNewByteArray (I# nbytes) = IO $ \s ->
|
||||
case newPinnedByteArray# nbytes s of
|
||||
(# s', mbarr# #) ->
|
||||
let c = MutByteArray mbarr#
|
||||
in (# s', c #)
|
||||
|
||||
{-# INLINE pinnedNewAlignedBytes #-}
|
||||
pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray
|
||||
pinnedNewAlignedBytes nbytes _align | nbytes < 0 =
|
||||
errorWithoutStackTrace "pinnedNewAlignedBytes: size must be >= 0"
|
||||
pinnedNewAlignedBytes (I# nbytes) (I# align) = IO $ \s ->
|
||||
case newAlignedPinnedByteArray# nbytes align s of
|
||||
(# s', mbarr# #) ->
|
||||
let c = MutByteArray mbarr#
|
||||
in (# s', c #)
|
||||
|
||||
{-# INLINE newBytesAs #-}
|
||||
newBytesAs :: PinnedState -> Int -> IO MutByteArray
|
||||
newBytesAs Unpinned = newByteArray
|
||||
newBytesAs Pinned = pinnedNewByteArray
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Copying
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- | Put a sub range of a source array into a subrange of a destination array.
|
||||
-- This is not safe as it does not check the bounds.
|
||||
{-# INLINE putSliceUnsafe #-}
|
||||
putSliceUnsafe ::
|
||||
MonadIO m
|
||||
=> MutByteArray
|
||||
-> Int
|
||||
-> MutByteArray
|
||||
-> Int
|
||||
-> Int
|
||||
-> m ()
|
||||
putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do
|
||||
#ifdef DEBUG
|
||||
srcLen <- sizeOfMutableByteArray src
|
||||
dstLen <- sizeOfMutableByteArray src
|
||||
when (srcLen - srcStartBytes < lenBytes) $ error "SRC: Insufficient length."
|
||||
when (dstLen - dstStartBytes < lenBytes) $ error "DST: Insufficient length."
|
||||
#endif
|
||||
let !(I# srcStartBytes#) = srcStartBytes
|
||||
!(I# dstStartBytes#) = dstStartBytes
|
||||
!(I# lenBytes#) = lenBytes
|
||||
let arrS# = getMutableByteArray# src
|
||||
arrD# = getMutableByteArray# dst
|
||||
IO $ \s# -> (# copyMutableByteArray#
|
||||
arrS# srcStartBytes# arrD# dstStartBytes# lenBytes# s#
|
||||
, () #)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Pinning & Unpinning
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE isPinned #-}
|
||||
isPinned :: MutByteArray -> Bool
|
||||
isPinned (MutByteArray arr#) =
|
||||
let pinnedInt = I# (isMutableByteArrayPinned# arr#)
|
||||
in pinnedInt /= 0
|
||||
|
||||
|
||||
{-# INLINE cloneMutableArrayWith# #-}
|
||||
cloneMutableArrayWith#
|
||||
:: (Int# -> State# RealWorld -> (# State# RealWorld
|
||||
, MutableByteArray# RealWorld #))
|
||||
-> MutableByteArray# RealWorld
|
||||
-> State# RealWorld
|
||||
-> (# State# RealWorld, MutableByteArray# RealWorld #)
|
||||
cloneMutableArrayWith# alloc# arr# s# =
|
||||
case getSizeofMutableByteArray# arr# s# of
|
||||
(# s1#, i# #) ->
|
||||
case alloc# i# s1# of
|
||||
(# s2#, arr1# #) ->
|
||||
case copyMutableByteArray# arr# 0# arr1# 0# i# s2# of
|
||||
s3# -> (# s3#, arr1# #)
|
||||
|
||||
{-# INLINE pin #-}
|
||||
pin :: MutByteArray -> IO MutByteArray
|
||||
pin arr@(MutByteArray marr#) =
|
||||
if isPinned arr
|
||||
then return arr
|
||||
else
|
||||
#ifdef DEBUG
|
||||
do
|
||||
-- XXX dump stack trace
|
||||
trace ("pin: Copying array") (return ())
|
||||
#endif
|
||||
IO
|
||||
$ \s# ->
|
||||
case cloneMutableArrayWith# newPinnedByteArray# marr# s# of
|
||||
(# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)
|
||||
|
||||
{-# INLINE unpin #-}
|
||||
unpin :: MutByteArray -> IO MutByteArray
|
||||
unpin arr@(MutByteArray marr#) =
|
||||
if not (isPinned arr)
|
||||
then return arr
|
||||
else
|
||||
#ifdef DEBUG
|
||||
do
|
||||
-- XXX dump stack trace
|
||||
trace ("unpin: Copying array") (return ())
|
||||
#endif
|
||||
IO
|
||||
$ \s# ->
|
||||
case cloneMutableArrayWith# newByteArray# marr# s# of
|
||||
(# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)
|
@ -1,250 +0,0 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
-- This is required as all the instances in this module are orphan instances.
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
-- |
|
||||
-- Module : Streamly.Internal.Data.Serialize
|
||||
-- Copyright : (c) 2023 Composewell Technologies
|
||||
-- License : BSD3-3-Clause
|
||||
-- Maintainer : streamly@composewell.com
|
||||
-- Portability : GHC
|
||||
--
|
||||
|
||||
module Streamly.Internal.Data.Serialize
|
||||
(
|
||||
-- * MutByteArray
|
||||
module Streamly.Internal.Data.MutByteArray
|
||||
-- * Unbox
|
||||
, module Streamly.Internal.Data.Unbox
|
||||
, module Streamly.Internal.Data.Unbox.TH
|
||||
-- * Serialize
|
||||
, module Streamly.Internal.Data.Serialize.Type
|
||||
-- * Serialize TH
|
||||
, module Streamly.Internal.Data.Serialize.TH
|
||||
) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Imports
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Streamly.Internal.Data.Array (Array(..))
|
||||
import GHC.Exts (Int(..), sizeofByteArray#, unsafeCoerce#)
|
||||
import GHC.Word (Word8)
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
import GHC.Num.Integer (Integer(..))
|
||||
#else
|
||||
import GHC.Integer.GMP.Internals (Integer(..), BigNat(..))
|
||||
#endif
|
||||
|
||||
import Streamly.Internal.Data.MutByteArray
|
||||
import Streamly.Internal.Data.Serialize.TH
|
||||
import Streamly.Internal.Data.Serialize.Type
|
||||
import Streamly.Internal.Data.Unbox
|
||||
import Streamly.Internal.Data.Unbox.TH
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Common instances
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- Note
|
||||
-- ====
|
||||
--
|
||||
-- Even a non-functional change such as changing the order of constructors will
|
||||
-- change the instance derivation.
|
||||
--
|
||||
-- This will not pose a problem if both, encode, and decode are done by the same
|
||||
-- version of the application. There *might* be a problem if version that
|
||||
-- encodes differs from the version that decodes.
|
||||
--
|
||||
-- We need to add some compatibility tests using different versions of
|
||||
-- dependencies.
|
||||
--
|
||||
-- Although such chages for the most basic types won't happen we need to detect
|
||||
-- if it ever happens.
|
||||
--
|
||||
-- Should we worry about these kind of changes and this kind of compatibility?
|
||||
-- This is a problem for all types of derivations that depend on the order of
|
||||
-- constructors, for example, Enum.
|
||||
|
||||
-- Note on Windows build
|
||||
-- =====================
|
||||
--
|
||||
-- On Windows, having template haskell splices here fail the build with the
|
||||
-- following error:
|
||||
--
|
||||
-- @
|
||||
-- addLibrarySearchPath: C:\... (Win32 error 3): The system cannot find the path specified.
|
||||
-- @
|
||||
--
|
||||
-- The error might be irrelavant but having these splices triggers it. We should
|
||||
-- either fix the problem or avoid the use to template haskell splices in this
|
||||
-- file.
|
||||
--
|
||||
-- Similar issue: https://github.com/haskell/cabal/issues/4741
|
||||
|
||||
-- $(Serialize.deriveSerialize ''Maybe)
|
||||
instance Serialize a => Serialize (Maybe a) where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
Nothing -> (acc + 1)
|
||||
Just field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> pure (i0, Nothing)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Just a0)
|
||||
_ -> error "Found invalid tag while peeking (Maybe a)"
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
Nothing -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
pure i0
|
||||
Just field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
-- $(Serialize.deriveSerialize ''Either)
|
||||
instance (Serialize a, Serialize b) => Serialize (Either a b) where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
Left field0 -> (size (acc + 1)) field0
|
||||
Right field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Left a0)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, Right a0)
|
||||
_ -> error "Found invalid tag while peeking (Either a b)"
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
Left field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
Right field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
instance Serialize (Proxy a) where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc _ = (acc + 1)
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset _ _ = pure ((initialOffset + 1), Proxy)
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset _ _ = pure (initialOffset + 1)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Integer
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data LiftedInteger
|
||||
= LIS Int
|
||||
| LIP (Array Word)
|
||||
| LIN (Array Word)
|
||||
|
||||
-- $(Serialize.deriveSerialize ''LiftedInteger)
|
||||
instance Serialize LiftedInteger where
|
||||
|
||||
{-# INLINE size #-}
|
||||
size acc x =
|
||||
case x of
|
||||
LIS field0 -> (size (acc + 1)) field0
|
||||
LIP field0 -> (size (acc + 1)) field0
|
||||
LIN field0 -> (size (acc + 1)) field0
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize initialOffset arr endOffset = do
|
||||
(i0, tag) <- ((deserialize initialOffset) arr) endOffset
|
||||
case tag :: Word8 of
|
||||
0 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIS a0)
|
||||
1 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIP a0)
|
||||
2 -> do (i1, a0) <- ((deserialize i0) arr) endOffset
|
||||
pure (i1, LIN a0)
|
||||
_ -> error "Found invalid tag while peeking (LiftedInteger)"
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize initialOffset arr val =
|
||||
case val of
|
||||
LIS field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (0 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
LIP field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (1 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
LIN field0 -> do
|
||||
i0 <- ((serialize initialOffset) arr) (2 :: Word8)
|
||||
i1 <- ((serialize i0) arr) field0
|
||||
pure i1
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
|
||||
{-# INLINE liftInteger #-}
|
||||
liftInteger :: Integer -> LiftedInteger
|
||||
liftInteger (IS x) = LIS (I# x)
|
||||
liftInteger (IP x) =
|
||||
LIP (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
|
||||
liftInteger (IN x) =
|
||||
LIN (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
|
||||
|
||||
{-# INLINE unliftInteger #-}
|
||||
unliftInteger :: LiftedInteger -> Integer
|
||||
unliftInteger (LIS (I# x)) = IS x
|
||||
unliftInteger (LIP (Array (MutByteArray x) _ _)) = IP (unsafeCoerce# x)
|
||||
unliftInteger (LIN (Array (MutByteArray x) _ _)) = IN (unsafeCoerce# x)
|
||||
|
||||
#else
|
||||
|
||||
{-# INLINE liftInteger #-}
|
||||
liftInteger :: Integer -> LiftedInteger
|
||||
liftInteger (S# x) = LIS (I# x)
|
||||
liftInteger (Jp# (BN# x)) =
|
||||
LIP (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
|
||||
liftInteger (Jn# (BN# x)) =
|
||||
LIN (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))
|
||||
|
||||
{-# INLINE unliftInteger #-}
|
||||
unliftInteger :: LiftedInteger -> Integer
|
||||
unliftInteger (LIS (I# x)) = S# x
|
||||
unliftInteger (LIP (Array (MutByteArray x) _ _)) =
|
||||
Jp# (BN# (unsafeCoerce# x))
|
||||
unliftInteger (LIN (Array (MutByteArray x) _ _)) =
|
||||
Jn# (BN# (unsafeCoerce# x))
|
||||
|
||||
#endif
|
||||
|
||||
instance Serialize Integer where
|
||||
{-# INLINE size #-}
|
||||
size i a = size i (liftInteger a)
|
||||
|
||||
{-# INLINE deserialize #-}
|
||||
deserialize off arr end = fmap unliftInteger <$> deserialize off arr end
|
||||
|
||||
{-# INLINE serialize #-}
|
||||
serialize off arr val = serialize off arr (liftInteger val)
|
@ -27,7 +27,7 @@ import Data.Maybe (fromJust)
|
||||
import Language.Haskell.TH
|
||||
import Streamly.Internal.Data.Serialize.Type (Serialize(..))
|
||||
import Data.Foldable (foldlM)
|
||||
import Streamly.Internal.Data.MutByteArray (MutByteArray)
|
||||
import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)
|
||||
import Data.Proxy (Proxy(..))
|
||||
|
||||
import qualified Streamly.Internal.Data.Unbox as Unbox
|
||||
|
@ -28,14 +28,15 @@ import Control.Exception (assert)
|
||||
import Data.List (foldl')
|
||||
import Data.Proxy (Proxy (..))
|
||||
import Streamly.Internal.Data.Unbox (Unbox)
|
||||
import Streamly.Internal.Data.MutByteArray (MutByteArray(..), PinnedState(..))
|
||||
import Streamly.Internal.Data.MutByteArray.Type
|
||||
(MutByteArray(..), PinnedState(..))
|
||||
import Streamly.Internal.Data.Array.Type (Array(..))
|
||||
import Streamly.Internal.System.IO (unsafeInlineIO)
|
||||
import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
|
||||
import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))
|
||||
import GHC.Stable (StablePtr(..))
|
||||
|
||||
import qualified Streamly.Internal.Data.MutByteArray as MBA
|
||||
import qualified Streamly.Internal.Data.MutByteArray.Type as MBA
|
||||
import qualified Streamly.Internal.Data.Unbox as Unbox
|
||||
import qualified Streamly.Internal.Data.Array as Array
|
||||
import qualified Streamly.Internal.Data.MutArray as MutArray
|
||||
@ -95,17 +96,17 @@ import GHC.Exts
|
||||
-- :}
|
||||
--
|
||||
-- @
|
||||
-- import Streamly.Data.Serialize (deriveSerialize)
|
||||
-- import Streamly.Data.MutByteArray (deriveSerialize)
|
||||
-- \$(deriveSerialize [d|instance Serialize Object|])
|
||||
-- @
|
||||
--
|
||||
-- See 'Streamly.Data.Serialize.deriveSerialize' and
|
||||
-- 'Streamly.Data.Serialize.deriveSerializeWith' for more information on
|
||||
-- See 'Streamly.Data.MutByteArray.deriveSerialize' and
|
||||
-- 'Streamly.Data.MutByteArray.deriveSerializeWith' for more information on
|
||||
-- deriving using Template Haskell.
|
||||
--
|
||||
-- Here is an example of a manual instance.
|
||||
--
|
||||
-- >>> import Streamly.Data.Serialize (Serialize(..))
|
||||
-- >>> import Streamly.Data.MutByteArray (Serialize(..))
|
||||
--
|
||||
-- >>> :{
|
||||
-- instance Serialize Object where
|
||||
|
@ -67,7 +67,7 @@ import GHC.Exts
|
||||
import GHC.TypeLits
|
||||
import Prelude hiding (read)
|
||||
|
||||
import Streamly.Internal.Data.MutByteArray (MutByteArray(..))
|
||||
import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- The Unbox type class
|
||||
@ -196,17 +196,17 @@ import Streamly.Internal.Data.MutByteArray (MutByteArray(..))
|
||||
-- } deriving Generic
|
||||
-- :}
|
||||
--
|
||||
-- >>> import Streamly.Data.Serialize (Unbox(..))
|
||||
-- >>> import Streamly.Data.MutByteArray (Unbox(..))
|
||||
-- >>> instance Unbox Object
|
||||
--
|
||||
-- To derive the instance via Template Haskell:
|
||||
--
|
||||
-- @
|
||||
-- import Streamly.Data.Serialize (deriveUnbox)
|
||||
-- import Streamly.Data.MutByteArray (deriveUnbox)
|
||||
-- \$(deriveUnbox [d|instance Unbox Object|])
|
||||
-- @
|
||||
--
|
||||
-- See 'Streamly.Data.Serialize.deriveUnbox' for more information on deriving
|
||||
-- See 'Streamly.Data.MutByteArray.deriveUnbox' for more information on deriving
|
||||
-- using Template Haskell.
|
||||
--
|
||||
-- If you want to write the instance manually:
|
||||
|
@ -292,7 +292,7 @@ library
|
||||
, Streamly.Internal.Data.Producer
|
||||
|
||||
-- streamly-core-array-types
|
||||
, Streamly.Internal.Data.Serialize
|
||||
, Streamly.Internal.Data.MutByteArray
|
||||
, Streamly.Internal.Data.Serialize.Parser
|
||||
, Streamly.Internal.Data.Serialize.Stream
|
||||
|
||||
@ -367,7 +367,7 @@ library
|
||||
-- streamly-core released modules in alphabetic order
|
||||
-- NOTE: these must be added to streamly.cabal as well
|
||||
, Streamly.Console.Stdio
|
||||
, Streamly.Data.Serialize
|
||||
, Streamly.Data.MutByteArray
|
||||
, Streamly.Data.Array
|
||||
, Streamly.Data.Array.Generic
|
||||
, Streamly.Data.MutArray
|
||||
@ -421,9 +421,10 @@ library
|
||||
, Streamly.Internal.Data.Array.Type
|
||||
|
||||
-- Unboxed IORef
|
||||
, Streamly.Internal.Data.MutByteArray
|
||||
, Streamly.Internal.Data.Unbox
|
||||
, Streamly.Internal.Data.IORef.Unboxed
|
||||
|
||||
, Streamly.Internal.Data.MutByteArray.Type
|
||||
, Streamly.Internal.Data.Unbox
|
||||
, Streamly.Internal.Data.Unbox.TH
|
||||
, Streamly.Internal.Data.Serialize.Type
|
||||
, Streamly.Internal.Data.Serialize.TH
|
||||
|
@ -79,7 +79,7 @@ import Streamly.Internal.Data.Stream.IsStream.Type
|
||||
import Streamly.Internal.Data.Stream.Serial (SerialT)
|
||||
import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64)
|
||||
import Streamly.Internal.System.IO (defaultChunkSize)
|
||||
import Streamly.Data.Serialize (Unbox)
|
||||
import Streamly.Data.MutByteArray (Unbox)
|
||||
|
||||
import qualified Streamly.Internal.Data.Array as A
|
||||
import qualified Streamly.Internal.Data.Stream.Async as Async
|
||||
|
@ -164,7 +164,7 @@ import Streamly.Internal.Data.Stream.IsStream.Common
|
||||
import Streamly.Internal.Data.Stream.IsStream.Type
|
||||
(IsStream, fromStreamD, toStreamD)
|
||||
import Streamly.Internal.Data.Stream.Serial (SerialT)
|
||||
import Streamly.Data.Serialize (Unbox)
|
||||
import Streamly.Data.MutByteArray (Unbox)
|
||||
|
||||
import qualified Streamly.Internal.Data.Array as A
|
||||
import qualified Streamly.Internal.Data.Stream.Serial as Stream
|
||||
|
@ -103,7 +103,7 @@ import Streamly.Internal.Data.Stream.IsStream.Type
|
||||
(IsStream (..), fromSerial, consM, fromStreamD)
|
||||
import Streamly.Internal.Data.Stream.Serial (SerialT, WSerialT)
|
||||
import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64)
|
||||
import Streamly.Data.Serialize (Unbox)
|
||||
import Streamly.Data.MutByteArray (Unbox)
|
||||
|
||||
import qualified Streamly.Internal.Data.MutArray as Unboxed
|
||||
(pollIntIORef, IORef)
|
||||
|
@ -180,7 +180,7 @@ import Streamly.Internal.Data.Stream.Serial(toStreamK)
|
||||
import Streamly.Internal.Data.Time.Units
|
||||
( AbsTime, MilliSecond64(..), addToAbsTime, toRelTime
|
||||
, toAbsTime)
|
||||
import Streamly.Data.Serialize (Unbox)
|
||||
import Streamly.Data.MutByteArray (Unbox)
|
||||
|
||||
import qualified Data.Heap as H
|
||||
import qualified Streamly.Internal.Data.Unfold as Unfold
|
||||
|
@ -111,7 +111,7 @@ import Streamly.Internal.Data.Array (pinnedWriteNUnsafe)
|
||||
import Streamly.Internal.Data.Fold ( Fold(..) )
|
||||
import Streamly.Data.Stream (Stream)
|
||||
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
|
||||
import Streamly.Data.Serialize (Unbox)
|
||||
import Streamly.Data.MutByteArray (Unbox)
|
||||
import Streamly.Data.Unfold (Unfold)
|
||||
import Streamly.Internal.Network.Socket (SockSpec(..), accept, acceptor)
|
||||
import Streamly.Internal.System.IO (defaultChunkSize)
|
||||
|
@ -72,7 +72,7 @@ import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Data.Maybe (isNothing, fromJust)
|
||||
import Data.Word (Word8)
|
||||
import Foreign.Ptr (plusPtr, Ptr, castPtr)
|
||||
import Streamly.Data.Serialize (Unbox)
|
||||
import Streamly.Data.MutByteArray (Unbox)
|
||||
import Network.Socket
|
||||
(Socket, SocketOption(..), Family(..), SockAddr(..),
|
||||
ProtocolNumber, withSocketsDo, SocketType(..), socket, bind,
|
||||
|
@ -138,7 +138,7 @@ import Data.Word (Word8)
|
||||
import Network.Socket (Socket, SockAddr)
|
||||
import Streamly.Internal.Data.Unfold (Unfold(..))
|
||||
import Streamly.Internal.Data.Array (Array(..))
|
||||
import Streamly.Data.Serialize (Unbox)
|
||||
import Streamly.Data.MutByteArray (Unbox)
|
||||
|
||||
import Streamly.Internal.Network.Socket hiding (accept, read, readChunks)
|
||||
import Prelude hiding (read)
|
||||
|
@ -14,7 +14,7 @@ import Data.Proxy (Proxy(..))
|
||||
import Data.Word(Word8)
|
||||
import Foreign.Storable (peek)
|
||||
import GHC.Ptr (plusPtr)
|
||||
import Streamly.Internal.Data.Serialize (Unbox, sizeOf)
|
||||
import Streamly.Internal.Data.MutByteArray (Unbox, sizeOf)
|
||||
import Streamly.Internal.Data.MutArray (MutArray)
|
||||
import Test.QuickCheck (chooseInt, listOf)
|
||||
|
||||
|
@ -13,7 +13,7 @@ import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
|
||||
import GHC.Real (Ratio(..))
|
||||
import GHC.Stable (StablePtr(..))
|
||||
import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))
|
||||
import Streamly.Internal.Data.Serialize (Unbox)
|
||||
import Streamly.Internal.Data.MutByteArray (Unbox)
|
||||
import Streamly.Test.Common (chooseInt)
|
||||
import Test.Hspec (hspec, describe, it)
|
||||
import Test.Hspec.QuickCheck
|
||||
|
@ -22,15 +22,15 @@ module Streamly.Test.Data.Serialize (main) where
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import System.Random (randomRIO)
|
||||
import Streamly.Internal.Data.Serialize (MutByteArray, newByteArray)
|
||||
import Streamly.Internal.Data.MutByteArray (MutByteArray, newByteArray)
|
||||
import GHC.Generics (Generic)
|
||||
import Streamly.Data.Serialize (Serialize)
|
||||
import Streamly.Data.MutByteArray (Serialize)
|
||||
import Streamly.Test.Data.Serialize.TH (genDatatype)
|
||||
|
||||
import Data.Functor.Identity (Identity (..))
|
||||
|
||||
import qualified Streamly.Internal.Data.Array as Array
|
||||
import qualified Streamly.Internal.Data.Serialize as Serialize
|
||||
import qualified Streamly.Internal.Data.MutByteArray as Serialize
|
||||
|
||||
import qualified Streamly.Test.Data.Serialize.CompatV0 as CompatV0
|
||||
import qualified Streamly.Test.Data.Serialize.CompatV1 as CompatV1
|
||||
|
@ -10,8 +10,8 @@ module Streamly.Test.Data.Serialize.CompatV0
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Test.QuickCheck (Arbitrary, arbitrary, elements)
|
||||
import Streamly.Internal.Data.Serialize (Serialize)
|
||||
import qualified Streamly.Internal.Data.Serialize as Serialize
|
||||
import Streamly.Internal.Data.MutByteArray (Serialize)
|
||||
import qualified Streamly.Internal.Data.MutByteArray as Serialize
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Types
|
||||
|
@ -10,8 +10,8 @@ module Streamly.Test.Data.Serialize.CompatV1
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Test.QuickCheck (Arbitrary, arbitrary, elements)
|
||||
import Streamly.Internal.Data.Serialize (Serialize)
|
||||
import qualified Streamly.Internal.Data.Serialize as Serialize
|
||||
import Streamly.Internal.Data.MutByteArray (Serialize)
|
||||
import qualified Streamly.Internal.Data.MutByteArray as Serialize
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Types
|
||||
|
@ -27,7 +27,7 @@ import Data.Proxy (Proxy(..))
|
||||
import GHC.Generics (Generic, Rep(..))
|
||||
import GHC.Real (Ratio(..))
|
||||
|
||||
import Streamly.Internal.Data.Serialize
|
||||
import Streamly.Internal.Data.MutByteArray
|
||||
|
||||
import Test.Hspec as H
|
||||
|
||||
|
@ -15,7 +15,7 @@ module Streamly.Test.Data.Unbox.TH (main) where
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Streamly.Internal.Data.Serialize
|
||||
import Streamly.Internal.Data.MutByteArray
|
||||
|
||||
import Test.Hspec as H
|
||||
|
||||
|
@ -26,7 +26,7 @@ import Data.Maybe ( isJust, fromJust )
|
||||
import Data.Word (Word8)
|
||||
import Data.Semigroup (Sum(..), getSum)
|
||||
import Foreign.Storable (Storable)
|
||||
import Streamly.Internal.Data.Serialize (Unbox)
|
||||
import Streamly.Internal.Data.MutByteArray (Unbox)
|
||||
import Test.Hspec.QuickCheck
|
||||
import Test.QuickCheck
|
||||
( Gen
|
||||
|
Loading…
Reference in New Issue
Block a user