{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, FlexibleContexts #-}
module GHCi.BinaryArray(putArray, getArray) where
import Prelude
import Foreign.Ptr
import Data.Binary
import Data.Binary.Put (putBuilder)
import qualified Data.Binary.Get.Internal as Binary
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Builder.Internal as BB
import qualified Data.Array.Base as A
import qualified Data.Array.IO.Internals as A
import qualified Data.Array.Unboxed as A
import GHC.Exts
import GHC.IO
putArray :: Binary i => A.UArray i a -> Put
putArray :: forall i a. Binary i => UArray i a -> Put
putArray (A.UArray i
l i
u Int
_ ByteArray#
arr#) = do
i -> Put
forall t. Binary t => t -> Put
put i
l
i -> Put
forall t. Binary t => t -> Put
put i
u
Builder -> Put
putBuilder (Builder -> Put) -> Builder -> Put
forall a b. (a -> b) -> a -> b
$ ByteArray# -> Builder
byteArrayBuilder ByteArray#
arr#
byteArrayBuilder :: ByteArray# -> BB.Builder
byteArrayBuilder :: ByteArray# -> Builder
byteArrayBuilder ByteArray#
arr# = (forall r. BuildStep r -> BuildStep r) -> Builder
BB.builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BuildStep r -> BuildStep r
forall a. Int -> Int -> BuildStep a -> BuildStep a
go Int
0 (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr#))
where
go :: Int -> Int -> BB.BuildStep a -> BB.BuildStep a
go :: forall a. Int -> Int -> BuildStep a -> BuildStep a
go !Int
inStart !Int
inEnd BuildStep a
k (BB.BufferRange Ptr Word8
outStart Ptr Word8
outEnd)
| Int
inRemaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
outRemaining = do
ByteArray# -> Int -> Ptr Word8 -> Int -> IO ()
forall a. ByteArray# -> Int -> Ptr a -> Int -> IO ()
copyByteArrayToAddr ByteArray#
arr# Int
inStart Ptr Word8
outStart Int
inRemaining
BuildStep a
k (Ptr Word8 -> Ptr Word8 -> BufferRange
BB.BufferRange (Ptr Word8
outStart Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
inRemaining) Ptr Word8
outEnd)
| Bool
otherwise = do
ByteArray# -> Int -> Ptr Word8 -> Int -> IO ()
forall a. ByteArray# -> Int -> Ptr a -> Int -> IO ()
copyByteArrayToAddr ByteArray#
arr# Int
inStart Ptr Word8
outStart Int
outRemaining
let !inStart' :: Int
inStart' = Int
inStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outRemaining
BuildSignal a -> IO (BuildSignal a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$! Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
BB.bufferFull Int
1 Ptr Word8
outEnd (Int -> Int -> BuildStep a -> BuildStep a
forall a. Int -> Int -> BuildStep a -> BuildStep a
go Int
inStart' Int
inEnd BuildStep a
k)
where
inRemaining :: Int
inRemaining = Int
inEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inStart
outRemaining :: Int
outRemaining = Ptr Word8
outEnd Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
outStart
copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO ()
copyByteArrayToAddr :: forall a. ByteArray# -> Int -> Ptr a -> Int -> IO ()
copyByteArrayToAddr ByteArray#
src# (I# Int#
src_off#) (Ptr Addr#
dst#) (I# Int#
len#) =
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
src# Int#
src_off# Addr#
dst# Int#
len# State# RealWorld
s of
State# RealWorld
s' -> (# State# RealWorld
s', () #)
getArray :: (Binary i, A.Ix i, A.MArray A.IOUArray a IO) => Get (A.UArray i a)
getArray :: forall i a.
(Binary i, Ix i, MArray IOUArray a IO) =>
Get (UArray i a)
getArray = do
i
l <- Get i
forall t. Binary t => Get t
get
i
u <- Get i
forall t. Binary t => Get t
get
arr :: IOUArray i a
arr@(A.IOUArray (A.STUArray i
_ i
_ Int
_ MutableByteArray# RealWorld
arr#)) <-
IOUArray i a -> Get (IOUArray i a)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOUArray i a -> Get (IOUArray i a))
-> IOUArray i a -> Get (IOUArray i a)
forall a b. (a -> b) -> a -> b
$ IO (IOUArray i a) -> IOUArray i a
forall a. IO a -> a
unsafeDupablePerformIO (IO (IOUArray i a) -> IOUArray i a)
-> IO (IOUArray i a) -> IOUArray i a
forall a b. (a -> b) -> a -> b
$ (i, i) -> IO (IOUArray i a)
forall i. Ix i => (i, i) -> IO (IOUArray i a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
A.newArray_ (i
l,i
u)
let go :: Int -> Int -> Get ()
go Int
0 Int
_ = () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go !Int
remaining !Int
off = do
Int -> (Ptr () -> IO ()) -> Get ()
forall a. Int -> (Ptr a -> IO a) -> Get a
Binary.readNWith Int
n ((Ptr () -> IO ()) -> Get ()) -> (Ptr () -> IO ()) -> Get ()
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr ->
Ptr () -> MutableByteArray# RealWorld -> Int -> Int -> IO ()
forall a.
Ptr a -> MutableByteArray# RealWorld -> Int -> Int -> IO ()
copyAddrToByteArray Ptr ()
ptr MutableByteArray# RealWorld
arr# Int
off Int
n
Int -> Int -> Get ()
go (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
where n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
chunkSize Int
remaining
Int -> Int -> Get ()
go (Int# -> Int
I# (MutableByteArray# RealWorld -> Int#
forall d. MutableByteArray# d -> Int#
sizeofMutableByteArray# MutableByteArray# RealWorld
arr#)) Int
0
UArray i a -> Get (UArray i a)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (UArray i a -> Get (UArray i a)) -> UArray i a -> Get (UArray i a)
forall a b. (a -> b) -> a -> b
$! IO (UArray i a) -> UArray i a
forall a. IO a -> a
unsafeDupablePerformIO (IO (UArray i a) -> UArray i a) -> IO (UArray i a) -> UArray i a
forall a b. (a -> b) -> a -> b
$ IOUArray i a -> IO (UArray i a)
forall ix e. IOUArray ix e -> IO (UArray ix e)
unsafeFreezeIOUArray IOUArray i a
arr
where
chunkSize :: Int
chunkSize = Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1024
copyAddrToByteArray :: Ptr a -> MutableByteArray# RealWorld
-> Int -> Int -> IO ()
copyAddrToByteArray :: forall a.
Ptr a -> MutableByteArray# RealWorld -> Int -> Int -> IO ()
copyAddrToByteArray (Ptr Addr#
src#) MutableByteArray# RealWorld
dst# (I# Int#
dst_off#) (I# Int#
len#) =
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
src# MutableByteArray# RealWorld
dst# Int#
dst_off# Int#
len# State# RealWorld
s of
State# RealWorld
s' -> (# State# RealWorld
s', () #)
unsafeFreezeIOUArray :: A.IOUArray ix e -> IO (A.UArray ix e)
unsafeFreezeIOUArray :: forall ix e. IOUArray ix e -> IO (UArray ix e)
unsafeFreezeIOUArray (A.IOUArray STUArray RealWorld ix e
marr) = ST RealWorld (UArray ix e) -> IO (UArray ix e)
forall a. ST RealWorld a -> IO a
stToIO (STUArray RealWorld ix e -> ST RealWorld (UArray ix e)
forall s i e. STUArray s i e -> ST s (UArray i e)
A.unsafeFreezeSTUArray STUArray RealWorld ix e
marr)