blob: 9529744b33371b839f2583287a4bc8103c8bc07c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, FlexibleContexts #-}
-- | Efficient serialisation for GHCi Instruction arrays
--
-- Author: Ben Gamari
--
module GHCi.BinaryArray(putArray, getArray) where
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
-- | An efficient serialiser of 'A.UArray'.
putArray :: Binary i => A.UArray i a -> Put
putArray (A.UArray l u _ arr#) = do
put l
put u
putBuilder $ byteArrayBuilder arr#
byteArrayBuilder :: ByteArray# -> BB.Builder
byteArrayBuilder arr# = BB.builder $ go 0 (I# (sizeofByteArray# arr#))
where
go :: Int -> Int -> BB.BuildStep a -> BB.BuildStep a
go !inStart !inEnd k (BB.BufferRange outStart outEnd)
-- There is enough room in this output buffer to write all remaining array
-- contents
| inRemaining <= outRemaining = do
copyByteArrayToAddr arr# inStart outStart inRemaining
k (BB.BufferRange (outStart `plusPtr` inRemaining) outEnd)
-- There is only enough space for a fraction of the remaining contents
| otherwise = do
copyByteArrayToAddr arr# inStart outStart outRemaining
let !inStart' = inStart + outRemaining
return $! BB.bufferFull 1 outEnd (go inStart' inEnd k)
where
inRemaining = inEnd - inStart
outRemaining = outEnd `minusPtr` outStart
copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO ()
copyByteArrayToAddr src# (I# src_off#) (Ptr dst#) (I# len#) =
IO $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of
s' -> (# s', () #)
-- | An efficient deserialiser of 'A.UArray'.
getArray :: (Binary i, A.Ix i, A.MArray A.IOUArray a IO) => Get (A.UArray i a)
getArray = do
l <- get
u <- get
arr@(A.IOUArray (A.STUArray _ _ _ arr#)) <-
return $ unsafeDupablePerformIO $ A.newArray_ (l,u)
let go 0 _ = return ()
go !remaining !off = do
Binary.readNWith n $ \ptr ->
copyAddrToByteArray ptr arr# off n
go (remaining - n) (off + n)
where n = min chunkSize remaining
go (I# (sizeofMutableByteArray# arr#)) 0
return $! unsafeDupablePerformIO $ unsafeFreezeIOUArray arr
where
chunkSize = 10*1024
copyAddrToByteArray :: Ptr a -> MutableByteArray# RealWorld
-> Int -> Int -> IO ()
copyAddrToByteArray (Ptr src#) dst# (I# dst_off#) (I# len#) =
IO $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of
s' -> (# s', () #)
-- this is inexplicably not exported in currently released array versions
unsafeFreezeIOUArray :: A.IOUArray ix e -> IO (A.UArray ix e)
unsafeFreezeIOUArray (A.IOUArray marr) = stToIO (A.unsafeFreezeSTUArray marr)
|
