@@ -1,3 +1,4 @@
1+{-# LANGUAGE UnboxedTuples #-}
12-- |
23-- Module : Streamly.Internal.Data.Array.Foreign.Mut.Type
34-- Copyright : (c) 2020 Composewell Technologies
@@ -16,6 +17,12 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
1617 -- * Type
1718 -- $arrayNotes
1819 Array (..)
20+ , ArrayContents
21+ , arrayToFptrContents
22+ , fptrToArrayContents
23+ , unsafeWithArrayContents
24+ , nilArrayContents
25+ , touch
1926
2027 -- * Constructing and Writing
2128 -- ** Construction
@@ -196,6 +203,10 @@ where
196203
197204#include "inline.hs"
198205
206+#ifdef USE_C_MALLOC
207+#define USE_FOREIGN_PTR
208+#endif
209+
199210import Control.Exception (assert)
200211import Control.DeepSeq (NFData(..))
201212import Control.Monad (when, void)
@@ -207,17 +218,29 @@ import Data.Semigroup (Semigroup(..))
207218#endif
208219import Data.Word (Word8)
209220import Foreign.C.Types (CSize(..), CInt(..))
210−import Foreign.ForeignPtr (touchForeignPtr, castForeignPtr)
211221import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
222+#ifndef USE_FOREIGN_PTR
223+import Foreign.Marshal.Alloc (mallocBytes)
224+#endif
212225import Foreign.Ptr (plusPtr, minusPtr, castPtr, nullPtr)
213226import Foreign.Storable (Storable(..))
214−import GHC.Base (build)
227+import GHC.Base
228+ ( build, touch#, IO(..), byteArrayContents#
229+ , Int(..), newAlignedPinnedByteArray#
230+ )
231+#ifndef USE_FOREIGN_PTR
232+import GHC.Base (RealWorld, MutableByteArray#)
233+#endif
215234#if __GLASGOW_HASKELL__ < 802
216235#define noinline
217236#else
218237import GHC.Base (noinline)
219238#endif
220−import GHC.ForeignPtr (ForeignPtr(..))
239+import GHC.Exts (unsafeCoerce#)
240+import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))
241+#ifdef USE_C_MALLOC
242+import GHC.ForeignPtr (mallocForeignPtrAlignedBytes)
243+#endif
221244import GHC.Ptr (Ptr(..))
222245
223246import Streamly.Internal.BaseCompat
@@ -225,9 +248,9 @@ import Streamly.Internal.Data.Fold.Type (Fold(..))
225248import Streamly.Internal.Data.Producer.Type (Producer (..))
226249import Streamly.Internal.Data.SVar.Type (adaptState)
227250import Streamly.Internal.Data.Unfold.Type (Unfold(..))
228−
229251import Streamly.Internal.System.IO
230252 (defaultChunkSize, arrayPayloadSize, unsafeInlineIO)
253+import System.IO.Unsafe (unsafePerformIO)
231254
232255#ifdef DEVBUILD
233256import qualified Data.Foldable as F
@@ -236,20 +259,13 @@ import qualified Streamly.Internal.Data.Fold.Type as FL
236259import qualified Streamly.Internal.Data.Producer as Producer
237260import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
238261import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
262+#ifdef USE_FOREIGN_PTR
239263import qualified Streamly.Internal.Foreign.Malloc as Malloc
264+#endif
240265
241266import Prelude hiding
242267 (length, foldr, read, unlines, splitAt, reverse, truncate)
243268
244−#if MIN_VERSION_base(4,10,0)
245−import Foreign.ForeignPtr (plusForeignPtr)
246−#else
247−import GHC.Base (Int(..), plusAddr#)
248−import GHC.ForeignPtr (ForeignPtr(..))
249−plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b
250−plusForeignPtr (ForeignPtr addr c) (I# d) = ForeignPtr (plusAddr# addr d) c
251−#endif
252−
253269-- $setup
254270-- >>> :m
255271-- >>> import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as Array
@@ -292,12 +308,44 @@ memcmp p1 p2 len = do
292308 r <- c_memcmp p1 p2 (fromIntegral len)
293309 return $ r == 0
294310
295−-- | Same as unsafeWithForeignPtr but lifted to any MonadIO monad.
296−{-# INLINE unsafeWithForeignPtrM #-}
297−unsafeWithForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b
298−unsafeWithForeignPtrM fo f = do
299− r <- f (unsafeForeignPtrToPtr fo)
300− liftIO $ touchForeignPtr fo
311+-------------------------------------------------------------------------------
312+-- Array Contents
313+-------------------------------------------------------------------------------
314+
315+-- We support using ForeignPtrContents or MutableByteArray.
316+
317+#ifdef USE_FOREIGN_PTR
318+newtype ArrayContents = ArrayContents ForeignPtrContents
319+#define UNPACKIF
320+#else
321+-- XXX can use UnliftedNewtypes
322+data ArrayContents = ArrayContents !(MutableByteArray# RealWorld)
323+#define UNPACKIF {-# UNPACK #-}
324+#endif
325+
326+{-# INLINE touch #-}
327+touch :: ArrayContents -> IO ()
328+touch (ArrayContents contents) =
329+ IO $ \s -> case touch# contents s of s' -> (# s', () #)
330+
331+fptrToArrayContents :: ForeignPtrContents -> ArrayContents
332+arrayToFptrContents :: ArrayContents -> ForeignPtrContents
333+#ifdef USE_FOREIGN_PTR
334+fptrToArrayContents = ArrayContents
335+arrayToFptrContents (ArrayContents contents) = contents
336+#else
337+fptrToArrayContents (PlainPtr mbarr) = ArrayContents mbarr
338+fptrToArrayContents _ = error "Unsupported foreign ptr"
339+arrayToFptrContents (ArrayContents contents) = PlainPtr contents
340+#endif
341+
342+-- | Similar to unsafeWithForeignPtr.
343+{-# INLINE unsafeWithArrayContents #-}
344+unsafeWithArrayContents :: MonadIO m =>
345+ ArrayContents -> Ptr a -> (Ptr a -> m b) -> m b
346+unsafeWithArrayContents contents ptr f = do
347+ r <- f ptr
348+ liftIO $ touch contents
301349 return r
302350
303351-------------------------------------------------------------------------------
@@ -335,7 +383,8 @@ data Array a =
335383 Storable a =>
336384#endif
337385 Array
338− { aStart :: {-# UNPACK #-} !(ForeignPtr a) -- ^ first address
386+ { arrContents :: UNPACKIF !ArrayContents
387+ , arrStart :: {-# UNPACK #-} !(Ptr a) -- ^ first address
339388 , aEnd :: {-# UNPACK #-} !(Ptr a) -- ^ first unused address
340389 , aBound :: {-# UNPACK #-} !(Ptr a) -- ^ first address beyond allocated memory
341390 }
@@ -345,7 +394,8 @@ data Array a =
345394-- address, and @bound@ is the first address beyond the allocated memory.
346395--
347396-- Unsafe: Make sure that foreignPtr <= end <= bound and (end - start) is an
348−-- integral multiple of the element size.
397+-- integral multiple of the element size. Only PlainPtr type ForeignPtr is
398+-- supported.
349399--
350400-- /Pre-release/
351401--
@@ -355,9 +405,9 @@ fromForeignPtrUnsafe ::
355405 Storable a =>
356406#endif
357407 ForeignPtr a -> Ptr a -> Ptr a -> Array a
358−fromForeignPtrUnsafe fp end bound =
408+fromForeignPtrUnsafe fp@(ForeignPtr start contents) end bound =
359409 assert (unsafeForeignPtrToPtr fp <= end && end <= bound)
360− (Array fp end bound)
410+ (Array (fptrToArrayContents contents) (Ptr start) end bound)
361411
362412-------------------------------------------------------------------------------
363413-- Construction
@@ -385,17 +435,42 @@ fromForeignPtrUnsafe fp end bound =
385435-- /Pre-release/
386436{-# INLINE newArrayWith #-}
387437newArrayWith :: forall m a. (MonadIO m, Storable a)
388− => (Int -> Int -> m (ForeignPtr a)) -> Int -> Int -> m (Array a)
438+ => (Int -> Int -> m (ArrayContents, Ptr a)) -> Int -> Int -> m (Array a)
389439newArrayWith alloc alignSize count = do
390440 let size = max (count * sizeOf (undefined :: a)) 0
391− fptr <- alloc size alignSize
392− let p = unsafeForeignPtrToPtr fptr
441+ (contents, p) <- alloc size alignSize
393442 return $ Array
394− { aStart = fptr
443+ { arrContents = contents
444+ , arrStart = p
395445 , aEnd = p
396446 , aBound = p `plusPtr` size
397447 }
398448
449+newAlignedArrayContents :: Int -> Int -> IO (ArrayContents, Ptr a)
450+#ifdef USE_C_MALLOC
451+newAlignedArrayContents size align = do
452+ ForeignPtr addr contents = mallocForeignPtrAlignedBytes size align
453+ return (ArrayContents contents, Ptr addr)
454+#else
455+newAlignedArrayContents size _align | size < 0 =
456+ errorWithoutStackTrace "newAlignedArrayContents: size must be >= 0"
457+newAlignedArrayContents (I# size) (I# align) = IO $ \s ->
458+ case newAlignedPinnedByteArray# size align s of
459+ (# s', mbarr# #) ->
460+ let p = Ptr (byteArrayContents# (unsafeCoerce# mbarr#))
461+#ifdef USE_FOREIGN_PTR
462+ c = ArrayContents (PlainPtr mbarr#)
463+#else
464+ c = ArrayContents mbarr#
465+#endif
466+ in (# s', (c, p) #)
467+#endif
468+
469+{-# NOINLINE nilArrayContents #-}
470+nilArrayContents :: ArrayContents
471+nilArrayContents =
472+ fst $ unsafePerformIO $ newAlignedArrayContents 0 0
473+
399474-- | Like 'newArrayWith' but using an allocator that allocates unmanaged pinned
400475-- memory. The memory will never be freed by GHC. This could be useful in
401476-- allocate-once global data structures. Use carefully as incorrect use can
@@ -403,14 +478,29 @@ newArrayWith alloc alignSize count = do
403478--
404479-- /Internal/
405480{-# INLINE newArrayAlignedUnmanaged #-}
406−newArrayAlignedUnmanaged :: (MonadIO m, Storable a) =>
481+newArrayAlignedUnmanaged :: forall m a. (MonadIO m, Storable a) =>
407482 Int -> Int -> m (Array a)
408−newArrayAlignedUnmanaged = newArrayWith mallocForeignPtrAlignedUnmanagedBytes
483+#ifdef USE_FOREIGN_PTR
484+newArrayAlignedUnmanaged = do
485+ newArrayWith mallocForeignPtrAlignedUnmanagedBytes
409486
410487 where
411488
412− mallocForeignPtrAlignedUnmanagedBytes size alignSize =
413− liftIO $ Malloc.mallocForeignPtrAlignedUnmanagedBytes size alignSize
489+ mallocForeignPtrAlignedUnmanagedBytes size align = do
490+ ForeignPtr addr contents <-
491+ liftIO $ Malloc.mallocForeignPtrAlignedUnmanagedBytes size align
492+ return (ArrayContents contents, Ptr addr)
493+#else
494+newArrayAlignedUnmanaged _align count = do
495+ let size = max (count * sizeOf (undefined :: a)) 0
496+ p <- liftIO $ mallocBytes size
497+ return $ Array
498+ { arrContents = nilArrayContents
499+ , arrStart = p
500+ , aEnd = p
501+ , aBound = p `plusPtr` size
502+ }
503+#endif
414504
415505-- | Like 'newArrayWith' but using an allocator that aligns the memory to the
416506-- alignment dictated by the 'Storable' instance of the type.
@@ -418,12 +508,7 @@ newArrayAlignedUnmanaged = newArrayWith mallocForeignPtrAlignedUnmanagedBytes
418508-- /Internal/
419509{-# INLINE newArrayAligned #-}
420510newArrayAligned :: (MonadIO m, Storable a) => Int -> Int -> m (Array a)
421−newArrayAligned = newArrayWith mallocForeignPtrAlignedBytes
422−
423− where
424−
425− mallocForeignPtrAlignedBytes size alignSize =
426− liftIO $ Malloc.mallocForeignPtrAlignedBytes size alignSize
511+newArrayAligned = newArrayWith (\s a -> liftIO $ newAlignedArrayContents s a)
427512
428513-- XXX can unaligned allocation be more efficient when alignment is not needed?
429514--
@@ -445,7 +530,8 @@ withNewArrayUnsafe ::
445530 (MonadIO m, Storable a) => Int -> (Ptr a -> m ()) -> m (Array a)
446531withNewArrayUnsafe count f = do
447532 arr <- newArray count
448− unsafeWithForeignPtrM (aStart arr) $ \p -> f p >> return arr
533+ unsafeWithArrayContents (arrContents arr) (arrStart arr)
534+ $ \p -> f p >> return arr
449535
450536-------------------------------------------------------------------------------
451537-- Random writes
@@ -467,7 +553,7 @@ putIndices = undefined
467553putIndexUnsafe :: forall m a. (MonadIO m, Storable a)
468554 => Array a -> Int -> a -> m ()
469555putIndexUnsafe Array{..} i x =
470− unsafeWithForeignPtrM aStart $ \ptr -> do
556+ unsafeWithArrayContents arrContents arrStart $ \ptr -> do
471557 let elemSize = sizeOf (undefined :: a)
472558 elemPtr = ptr `plusPtr` (elemSize * i)
473559 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())
@@ -498,7 +584,8 @@ putIndexPtr ptr end i x = do
498584{-# INLINE putIndex #-}
499585putIndex :: (MonadIO m, Storable a) => Array a -> Int -> a -> m ()
500586putIndex arr i x =
501− unsafeWithForeignPtrM (aStart arr) $ \p -> putIndexPtr p (aEnd arr) i x
587+ unsafeWithArrayContents (arrContents arr) (arrStart arr)
588+ $ \p -> putIndexPtr p (aEnd arr) i x
502589
503590-- | Modify a given index of an array using a modifier function.
504591--
@@ -506,7 +593,7 @@ putIndex arr i x =
506593modifyIndexUnsafe :: forall m a b. (MonadIO m, Storable a) =>
507594 Array a -> Int -> (a -> (a, b)) -> m b
508595modifyIndexUnsafe Array{..} i f = do
509− liftIO $ unsafeWithForeignPtr aStart $ \ptr -> do
596+ liftIO $ unsafeWithArrayContents arrContents arrStart $ \ptr -> do
510597 let elemSize = sizeOf (undefined :: a)
511598 elemPtr = ptr `plusPtr` (elemSize * i)
512599 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())
@@ -521,7 +608,7 @@ modifyIndexUnsafe Array{..} i f = do
521608modifyIndex :: forall m a b. (MonadIO m, Storable a) =>
522609 Array a -> Int -> (a -> (a, b)) -> m b
523610modifyIndex Array{..} i f = do
524− liftIO $ unsafeWithForeignPtr aStart $ \ptr -> do
611+ liftIO $ unsafeWithArrayContents arrContents arrStart $ \ptr -> do
525612 let elemSize = sizeOf (undefined :: a)
526613 elemPtr = ptr `plusPtr` (elemSize * i)
527614 if i >= 0 && elemPtr `plusPtr` elemSize <= aEnd
@@ -635,7 +722,7 @@ snocNewEnd :: (MonadIO m, Storable a) => Ptr a -> Array a -> a -> m (Array a)
635722snocNewEnd newEnd arr@Array{..} x = liftIO $ do
636723 assert (newEnd <= aBound) (return ())
637724 poke aEnd x
638− touchForeignPtr aStart
725+ touch arrContents
639726 return $ arr {aEnd = newEnd}
640727
641728-- | Really really unsafe, appends the element into the first array, may
@@ -669,7 +756,7 @@ reallocWith :: forall m a. (MonadIO m , Storable a) =>
669756 -> Array a
670757 -> m (Array a)
671758reallocWith label sizer reqSize arr = do
672− let oldSize = aEnd arr `minusPtr` unsafeForeignPtrToPtr (aStart arr)
759+ let oldSize = aEnd arr `minusPtr` arrStart arr
673760 newSize = sizer oldSize
674761 safeSize = max newSize (oldSize + reqSize)
675762 rounded = roundUpLargeArray safeSize
@@ -767,21 +854,21 @@ snoc = snocWith (* 2)
767854reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)
768855reallocAligned elemSize alignSize newSize Array{..} = do
769856 assert (aEnd <= aBound) (return ())
770− let oldStart = unsafeForeignPtrToPtr aStart
857+ let oldStart = arrStart
771858 oldSize = aEnd `minusPtr` oldStart
772859 assert (oldSize `mod` elemSize == 0) (return ())
773− newPtr <- Malloc.mallocForeignPtrAlignedBytes newSize alignSize
774− unsafeWithForeignPtr newPtr $ \pNew -> do
775− let size = min oldSize newSize
776− assert (size >= 0) (return ())
777− assert (size `mod` elemSize == 0) (return ())
778− memcpy (castPtr pNew) (castPtr oldStart) size
779− touchForeignPtr aStart
780− return $ Array
781− { aStart = newPtr
782− , aEnd = pNew `plusPtr` (size - (size `mod` elemSize))
783− , aBound = pNew `plusPtr` newSize
784− }
860+ (contents, pNew) <- newAlignedArrayContents newSize alignSize
861+ let size = min oldSize newSize
862+ assert (size >= 0) (return ())
863+ assert (size `mod` elemSize == 0) (return ())
864+ memcpy (castPtr pNew) (castPtr oldStart) size
865+ touch arrContents
866+ return $ Array
867+ { arrStart = pNew
868+ , arrContents = contents
869+ , aEnd = pNew `plusPtr` (size - (size `mod` elemSize))
870+ , aBound = pNew `plusPtr` newSize
871+ }
785872
786873{-# INLINABLE realloc #-}
787874realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)
@@ -824,7 +911,7 @@ resizeExp = undefined
824911rightSize :: forall m a. (MonadIO m, Storable a) => Array a -> m (Array a)
825912rightSize arr@Array{..} = do
826913 assert (aEnd <= aBound) (return ())
827− let start = unsafeForeignPtrToPtr aStart
914+ let start = arrStart
828915 len = aEnd `minusPtr` start
829916 capacity = aBound `minusPtr` start
830917 target = roundUpLargeArray len
@@ -878,7 +965,7 @@ truncateExp = undefined
878965{-# INLINE_NORMAL getIndexUnsafe #-}
879966getIndexUnsafe :: forall m a. (MonadIO m, Storable a) => Array a -> Int -> m a
880967getIndexUnsafe Array {..} i =
881− unsafeWithForeignPtrM aStart $ \ptr -> do
968+ unsafeWithArrayContents arrContents arrStart $ \ptr -> do
882969 let elemSize = sizeOf (undefined :: a)
883970 elemPtr = ptr `plusPtr` (elemSize * i)
884971 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())
@@ -899,7 +986,8 @@ getIndexPtr ptr end i = do
899986{-# INLINE getIndex #-}
900987getIndex :: (MonadIO m, Storable a) => Array a -> Int -> m a
901988getIndex arr i =
902− unsafeWithForeignPtrM (aStart arr) $ \p -> getIndexPtr p (aEnd arr) i
989+ unsafeWithArrayContents (arrContents arr) (arrStart arr)
990+ $ \p -> getIndexPtr p (aEnd arr) i
903991
904992{-# INLINE getIndexPtrRev #-}
905993getIndexPtrRev :: forall m a. (MonadIO m, Storable a) =>
@@ -919,9 +1007,11 @@ getIndexPtrRev ptr end i = do
9191007{-# INLINE getIndexRev #-}
9201008getIndexRev :: (MonadIO m, Storable a) => Array a -> Int -> m a
9211009getIndexRev arr i =
922− unsafeWithForeignPtrM (aStart arr) $ \p -> getIndexPtrRev p (aEnd arr) i
1010+ unsafeWithArrayContents (arrContents arr) (arrStart arr)
1011+ $ \p -> getIndexPtrRev p (aEnd arr) i
9231012
924−data GetIndicesState fp end st = GetIndicesState fp end st
1013+data GetIndicesState contents start end st =
1014+ GetIndicesState contents start end st
9251015
9261016-- | Given an unfold that generates array indices, read the elements on those
9271017-- indices from the supplied Array. An error is thrown if an index is out of
@@ -935,20 +1025,20 @@ getIndices (Unfold stepi injecti) = Unfold step inject
9351025
9361026 where
9371027
938− inject arr@(Array fp@(ForeignPtr _ _) (Ptr end) _) = do
1028+ inject arr@(Array contents start (Ptr end) _) = do
9391029 st <- injecti arr
940− return $ GetIndicesState fp (Ptr end) st
1030+ return $ GetIndicesState contents start (Ptr end) st
9411031
9421032 {-# INLINE_LATE step #-}
943− step (GetIndicesState fp@(ForeignPtr start _) end st) = do
1033+ step (GetIndicesState contents start end st) = do
9441034 r <- stepi st
9451035 case r of
9461036 D.Yield i s -> do
947− x <- liftIO $ getIndexPtr (Ptr start) end i
948− return $ D.Yield x (GetIndicesState fp end s)
949− D.Skip s -> return $ D.Skip (GetIndicesState fp end s)
1037+ x <- liftIO $ getIndexPtr start end i
1038+ return $ D.Yield x (GetIndicesState contents start end s)
1039+ D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)
9501040 D.Stop -> do
951− liftIO $ touchForeignPtr fp
1041+ liftIO $ touch contents
9521042 return D.Stop
9531043
9541044-------------------------------------------------------------------------------
@@ -970,11 +1060,13 @@ getSliceUnsafe :: forall a. Storable a
9701060 -> Int -- ^ length of the slice
9711061 -> Array a
9721062 -> Array a
973−getSliceUnsafe index len (Array fp e _) =
1063+getSliceUnsafe index len (Array contents start e _) =
9741064 let size = sizeOf (undefined :: a)
975− fp1 = fp `plusForeignPtr` (index * size)
976− end = unsafeForeignPtrToPtr fp1 `plusPtr` (len * size)
977− in assert (index >= 0 && len >= 0 && end <= e) (Array fp1 end end)
1065+ fp1 = start `plusPtr` (index * size)
1066+ end = fp1 `plusPtr` (len * size)
1067+ in assert
1068+ (index >= 0 && len >= 0 && end <= e)
1069+ (Array contents fp1 end end)
9781070
9791071-- | /O(1)/ Slice an array in constant time. Throws an error if the slice
9801072-- extends out of the array bounds.
@@ -986,12 +1078,12 @@ getSlice :: forall a. Storable a =>
9861078 -> Int -- ^ length of the slice
9871079 -> Array a
9881080 -> Array a
989−getSlice index len (Array fp e _) =
1081+getSlice index len (Array contents start e _) =
9901082 let size = sizeOf (undefined :: a)
991− fp1 = fp `plusForeignPtr` (index * size)
992− end = unsafeForeignPtrToPtr fp1 `plusPtr` (len * size)
1083+ fp1 = start `plusPtr` (index * size)
1084+ end = fp1 `plusPtr` (len * size)
9931085 in if index >= 0 && len >= 0 && end <= e
994− then Array fp1 end end
1086+ then Array contents fp1 end end
9951087 else error
9961088 $ "getSlice: invalid slice, index "
9971089 ++ show index ++ " length " ++ show len
@@ -1077,8 +1169,7 @@ mergeBy = undefined
10771169{-# INLINE byteLength #-}
10781170byteLength :: Array a -> Int
10791171byteLength Array{..} =
1080− let p = unsafeForeignPtrToPtr aStart
1081− len = aEnd `minusPtr` p
1172+ let len = aEnd `minusPtr` arrStart
10821173 in assert (len >= 0) len
10831174
10841175-- Note: try to avoid the use of length in performance sensitive internal
@@ -1106,8 +1197,7 @@ length arr =
11061197{-# INLINE byteCapacity #-}
11071198byteCapacity :: Array a -> Int
11081199byteCapacity Array{..} =
1109− let p = unsafeForeignPtrToPtr aStart
1110− len = aBound `minusPtr` p
1200+ let len = aBound `minusPtr` arrStart
11111201 in assert (len >= 0) len
11121202
11131203-- | The remaining capacity in the array for appending more elements without
@@ -1124,10 +1214,11 @@ bytesFree Array{..} =
11241214-- Streams of arrays - Creation
11251215-------------------------------------------------------------------------------
11261216
1127−data GroupState s start end bound
1217+data GroupState s contents start end bound
11281218 = GroupStart s
1129− | GroupBuffer s start end bound
1130− | GroupYield start end bound (GroupState s start end bound)
1219+ | GroupBuffer s contents start end bound
1220+ | GroupYield
1221+ contents start end bound (GroupState s contents start end bound)
11311222 | GroupFinish
11321223
11331224-- | @arraysOf n stream@ groups the input stream into a stream of
@@ -1155,10 +1246,10 @@ arraysOf n (D.Stream step state) =
11551246 error $ "Streamly.Internal.Data.Array.Foreign.Mut.Type.arraysOf: "
11561247 ++ "the size of arrays [" ++ show n
11571248 ++ "] must be a natural number"
1158− Array start end bound <- liftIO $ newArray n
1159− return $ D.Skip (GroupBuffer st start end bound)
1249+ Array contents start end bound <- liftIO $ newArray n
1250+ return $ D.Skip (GroupBuffer st contents start end bound)
11601251
1161− step' gst (GroupBuffer st start end bound) = do
1252+ step' gst (GroupBuffer st contents start end bound) = do
11621253 r <- step (adaptState gst) st
11631254 case r of
11641255 D.Yield x s -> do
@@ -1166,13 +1257,18 @@ arraysOf n (D.Stream step state) =
11661257 let end' = end `plusPtr` sizeOf (undefined :: a)
11671258 return $
11681259 if end' >= bound
1169− then D.Skip (GroupYield start end' bound (GroupStart s))
1170− else D.Skip (GroupBuffer s start end' bound)
1171− D.Skip s -> return $ D.Skip (GroupBuffer s start end bound)
1172− D.Stop -> return $ D.Skip (GroupYield start end bound GroupFinish)
1173−
1174− step' _ (GroupYield start end bound next) =
1175− return $ D.Yield (Array start end bound) next
1260+ then D.Skip
1261+ (GroupYield
1262+ contents start end' bound (GroupStart s))
1263+ else D.Skip (GroupBuffer s contents start end' bound)
1264+ D.Skip s ->
1265+ return $ D.Skip (GroupBuffer s contents start end bound)
1266+ D.Stop ->
1267+ return
1268+ $ D.Skip (GroupYield contents start end bound GroupFinish)
1269+
1270+ step' _ (GroupYield contents start end bound next) =
1271+ return $ D.Yield (Array contents start end bound) next
11761272
11771273 step' _ GroupFinish = return D.Stop
11781274
@@ -1189,9 +1285,9 @@ arrayStreamKFromStreamD =
11891285-- Streams of arrays - Flattening
11901286-------------------------------------------------------------------------------
11911287
1192−data FlattenState s a =
1288+data FlattenState s contents a =
11931289 OuterLoop s
1194− | InnerLoop s !(ForeignPtr a) !(Ptr a) !(Ptr a)
1290+ | InnerLoop s contents !(Ptr a) !(Ptr a)
11951291
11961292-- | Use the "read" unfold instead.
11971293--
@@ -1211,20 +1307,19 @@ flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)
12111307 r <- step (adaptState gst) st
12121308 return $ case r of
12131309 D.Yield Array{..} s ->
1214− let p = unsafeForeignPtrToPtr aStart
1215− in D.Skip (InnerLoop s aStart p aEnd)
1310+ D.Skip (InnerLoop s arrContents arrStart aEnd)
12161311 D.Skip s -> D.Skip (OuterLoop s)
12171312 D.Stop -> D.Stop
12181313
12191314 step' _ (InnerLoop st _ p end) | assert (p <= end) (p == end) =
12201315 return $ D.Skip $ OuterLoop st
12211316
1222− step' _ (InnerLoop st startf p end) = do
1317+ step' _ (InnerLoop st contents p end) = do
12231318 x <- liftIO $ do
12241319 r <- peek p
1225− touchForeignPtr startf
1320+ touch contents
12261321 return r
1227− return $ D.Yield x (InnerLoop st startf
1322+ return $ D.Yield x (InnerLoop st contents
12281323 (p `plusPtr` sizeOf (undefined :: a)) end)
12291324
12301325-- | Use the "readRev" unfold instead.
@@ -1246,58 +1341,57 @@ flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)
12461341 return $ case r of
12471342 D.Yield Array{..} s ->
12481343 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))
1249− -- XXX we do not need aEnd
1250− in D.Skip (InnerLoop s aStart p aEnd)
1344+ in D.Skip (InnerLoop s arrContents p arrStart)
12511345 D.Skip s -> D.Skip (OuterLoop s)
12521346 D.Stop -> D.Stop
12531347
1254− step' _ (InnerLoop st start p _) | p < unsafeForeignPtrToPtr start =
1348+ step' _ (InnerLoop st _ p start) | p < start =
12551349 return $ D.Skip $ OuterLoop st
12561350
1257− step' _ (InnerLoop st startf p end) = do
1351+ step' _ (InnerLoop st contents p start) = do
12581352 x <- liftIO $ do
12591353 r <- peek p
1260− touchForeignPtr startf
1354+ touch contents
12611355 return r
1262− return $ D.Yield x (InnerLoop st startf
1263− (p `plusPtr` negate (sizeOf (undefined :: a))) end)
1356+ let cur = p `plusPtr` negate (sizeOf (undefined :: a))
1357+ return $ D.Yield x (InnerLoop st contents cur start)
12641358
12651359-------------------------------------------------------------------------------
12661360-- Unfolds
12671361-------------------------------------------------------------------------------
12681362
12691363data ReadUState a = ReadUState
1270− {-# UNPACK #-} !(ForeignPtr a) -- foreign ptr with end of array pointer
1271− {-# UNPACK #-} !(Ptr a) -- current pointer
1364+ UNPACKIF !ArrayContents -- contents
1365+ !(Ptr a) -- end address
1366+ !(Ptr a) -- current address
1367+
1368+toReadUState :: Array a -> ReadUState a
1369+toReadUState (Array contents start end _) = ReadUState contents end start
12721370
12731371-- | Resumable unfold of an array.
12741372--
12751373{-# INLINE_NORMAL producer #-}
12761374producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a
1277−producer = Producer step inject extract
1375+producer = Producer step (return . toReadUState) extract
12781376 where
12791377
1280− inject (Array (ForeignPtr start contents) (Ptr end) _) =
1281− return $ ReadUState (ForeignPtr end contents) (Ptr start)
1282−
12831378 {-# INLINE_LATE step #-}
1284− step (ReadUState fp@(ForeignPtr end _) p)
1285− | assert (p <= Ptr end) (p == Ptr end) =
1286− let x = unsafeInlineIO $ touchForeignPtr fp
1379+ step (ReadUState contents end cur)
1380+ | assert (cur <= end) (cur == end) =
1381+ let x = unsafeInlineIO $ touch contents
12871382 in x `seq` return D.Stop
1288− step (ReadUState fp p) = do
1383+ step (ReadUState contents end cur) = do
12891384 -- unsafeInlineIO allows us to run this in Identity monad for pure
12901385 -- toList/foldr case which makes them much faster due to not
12911386 -- accumulating the list and fusing better with the pure consumers.
12921387 --
12931388 -- This should be safe as the array contents are guaranteed to be
12941389 -- evaluated/written to before we peek at them.
1295− let !x = unsafeInlineIO $ peek p
1296− return $ D.Yield x
1297− (ReadUState fp (p `plusPtr` sizeOf (undefined :: a)))
1390+ let !x = unsafeInlineIO $ peek cur
1391+ cur1 = cur `plusPtr` sizeOf (undefined :: a)
1392+ return $ D.Yield x (ReadUState contents end cur1)
12981393
1299− extract (ReadUState (ForeignPtr end contents) (Ptr p)) =
1300− return $ Array (ForeignPtr p contents) (Ptr end) (Ptr end)
1394+ extract (ReadUState contents end cur) = return $ Array contents cur end end
13011395
13021396-- | Unfold an array into a stream.
13031397--
@@ -1314,15 +1408,15 @@ readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a
13141408readRev = Unfold step inject
13151409 where
13161410
1317− inject (Array fp end _) =
1411+ inject (Array contents start end _) =
13181412 let p = end `plusPtr` negate (sizeOf (undefined :: a))
1319− in return $ ReadUState fp p
1413+ in return $ ReadUState contents start p
13201414
13211415 {-# INLINE_LATE step #-}
1322− step (ReadUState fp@(ForeignPtr start _) p) | p < Ptr start =
1323− let x = unsafeInlineIO $ touchForeignPtr fp
1416+ step (ReadUState contents start p) | p < start =
1417+ let x = unsafeInlineIO $ touch contents
13241418 in x `seq` return D.Stop
1325− step (ReadUState fp p) = do
1419+ step (ReadUState contents start p) = do
13261420 -- unsafeInlineIO allows us to run this in Identity monad for pure
13271421 -- toList/foldr case which makes them much faster due to not
13281422 -- accumulating the list and fusing better with the pure consumers.
@@ -1330,8 +1424,8 @@ readRev = Unfold step inject
13301424 -- This should be safe as the array contents are guaranteed to be
13311425 -- evaluated/written to before we peek at them.
13321426 let !x = unsafeInlineIO $ peek p
1333− return $ D.Yield x
1334− (ReadUState fp (p `plusPtr` negate (sizeOf (undefined :: a))))
1427+ let cur = p `plusPtr` negate (sizeOf (undefined :: a))
1428+ return $ D.Yield x (ReadUState contents start cur)
13351429
13361430-------------------------------------------------------------------------------
13371431-- to Lists and streams
@@ -1341,7 +1435,7 @@ readRev = Unfold step inject
13411435-- This can be useful when using the IsList instance
13421436{-# INLINE_LATE toListFB #-}
13431437toListFB :: forall a b. Storable a => (a -> b -> b) -> b -> Array a -> b
1344−toListFB c n Array{..} = go (unsafeForeignPtrToPtr aStart)
1438+toListFB c n Array{..} = go arrStart
13451439 where
13461440
13471441 go p | assert (p <= aEnd) (p == aEnd) = n
@@ -1355,7 +1449,7 @@ toListFB c n Array{..} = go (unsafeForeignPtrToPtr aStart)
13551449 -- XXX
13561450 let !x = unsafeInlineIO $ do
13571451 r <- peek p
1358− touchForeignPtr aStart
1452+ touch arrContents
13591453 return r
13601454 in c x (go (p `plusPtr` sizeOf (undefined :: a)))
13611455
@@ -1375,7 +1469,7 @@ toList s = build (\c n -> toListFB c n s)
13751469{-# INLINE_NORMAL toStreamD #-}
13761470toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a
13771471toStreamD Array{..} =
1378− let p = unsafeForeignPtrToPtr aStart
1472+ let p = arrStart
13791473 in D.Stream step p
13801474
13811475 where
@@ -1394,14 +1488,14 @@ toStreamD Array{..} =
13941488 --
13951489 let !x = unsafeInlineIO $ do
13961490 r <- peek p
1397− touchForeignPtr aStart
1491+ touch arrContents
13981492 return r
13991493 return $ D.Yield x (p `plusPtr` sizeOf (undefined :: a))
14001494
14011495{-# INLINE toStreamK #-}
14021496toStreamK :: forall m a. Storable a => Array a -> K.Stream m a
14031497toStreamK Array{..} =
1404− let p = unsafeForeignPtrToPtr aStart
1498+ let p = arrStart
14051499 in go p
14061500
14071501 where
@@ -1412,7 +1506,7 @@ toStreamK Array{..} =
14121506 -- XXX May not be safe for mutable arrays.
14131507 let !x = unsafeInlineIO $ do
14141508 r <- peek p
1415− touchForeignPtr aStart
1509+ touch arrContents
14161510 return r
14171511 in x `K.cons` go (p `plusPtr` sizeOf (undefined :: a))
14181512
@@ -1430,13 +1524,13 @@ toStreamDRev Array{..} =
14301524 where
14311525
14321526 {-# INLINE_LATE step #-}
1433− step _ p | p < unsafeForeignPtrToPtr aStart = return D.Stop
1527+ step _ p | p < arrStart = return D.Stop
14341528 step _ p = do
14351529 -- See comments in toStreamD for why we use unsafeInlineIO
14361530 -- XXX
14371531 let !x = unsafeInlineIO $ do
14381532 r <- peek p
1439− touchForeignPtr aStart
1533+ touch arrContents
14401534 return r
14411535 return $ D.Yield x (p `plusPtr` negate (sizeOf (undefined :: a)))
14421536
@@ -1448,12 +1542,12 @@ toStreamKRev Array {..} =
14481542
14491543 where
14501544
1451− go p | p < unsafeForeignPtrToPtr aStart = K.nil
1545+ go p | p < arrStart = K.nil
14521546 | otherwise =
14531547 -- XXX
14541548 let !x = unsafeInlineIO $ do
14551549 r <- peek p
1456− touchForeignPtr aStart
1550+ touch arrContents
14571551 return r
14581552 in x `K.cons` go (p `plusPtr` negate (sizeOf (undefined :: a)))
14591553
@@ -1481,8 +1575,17 @@ foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr
14811575-------------------------------------------------------------------------------
14821576
14831577data ArrayUnsafe a = ArrayUnsafe
1484− {-# UNPACK #-} !(ForeignPtr a) -- first address
1485− {-# UNPACK #-} !(Ptr a) -- first unused address
1578+ UNPACKIF !ArrayContents -- contents
1579+ {-# UNPACK #-} !(Ptr a) -- start address
1580+ {-# UNPACK #-} !(Ptr a) -- first unused address
1581+
1582+toArrayUnsafe :: Array a -> ArrayUnsafe a
1583+toArrayUnsafe (Array contents start end _) =
1584+ ArrayUnsafe contents start end
1585+
1586+fromArrayUnsafe :: ArrayUnsafe a -> Array a
1587+fromArrayUnsafe (ArrayUnsafe contents start end) =
1588+ Array contents start end end
14861589
14871590-- Note: Arrays may be allocated with a specific alignment at the beginning of
14881591-- the array. If you need to maintain that alignment on reallocations then you
@@ -1505,29 +1608,28 @@ appendNUnsafe :: forall m a. (MonadIO m, Storable a) =>
15051608 -> Int
15061609 -> Fold m a (Array a)
15071610appendNUnsafe action n =
1508− fmap extract $ FL.foldlM' step initial
1611+ fmap fromArrayUnsafe $ FL.foldlM' step initial
15091612
15101613 where
15111614
15121615 initial = do
15131616 assert (n >= 0) (return ())
1514− arr@(Array _ end bound) <- action
1617+ arr@(Array _ _ end bound) <- action
15151618 let free = bound `minusPtr` end
15161619 elemSize = sizeOf (undefined :: a)
15171620 needed = n * elemSize
15181621 -- XXX We can also reallocate if the array has too much free space,
15191622 -- otherwise we lose that space.
1520− (Array start1 end1 _) <-
1623+ arr1 <-
15211624 if free < needed
15221625 then noinline reallocWith "appendNUnsafeWith" (+ needed) needed arr
15231626 else return arr
1524− return $ ArrayUnsafe start1 end1
1525−
1526− step (ArrayUnsafe start end) x = do
1527− liftIO $ poke end x >> touchForeignPtr start
1528− return $ ArrayUnsafe start (end `plusPtr` sizeOf (undefined :: a))
1627+ return $ toArrayUnsafe arr1
15291628
1530− extract (ArrayUnsafe start end) = Array start end end
1629+ step (ArrayUnsafe contents start end) x = do
1630+ liftIO $ poke end x >> touch contents
1631+ let end1 = end `plusPtr` sizeOf (undefined :: a)
1632+ return $ ArrayUnsafe contents start end1
15311633
15321634-- | Append @n@ elements to an existing array. Any free space left in the array
15331635-- after appending @n@ elements is lost.
@@ -1634,27 +1736,17 @@ writeNAlignedUnmanaged align = writeNWith (newArrayAlignedUnmanaged align)
16341736{-# INLINE_NORMAL writeNWithUnsafe #-}
16351737writeNWithUnsafe :: forall m a. (MonadIO m, Storable a)
16361738 => (Int -> m (Array a)) -> Int -> Fold m a (Array a)
1637−writeNWithUnsafe alloc n = Fold step initial extract
1739+writeNWithUnsafe alloc n = Fold step initial (return . fromArrayUnsafe)
16381740
16391741 where
16401742
1641− initial = do
1642− (Array start end _) <- alloc (max n 0)
1643− return $ FL.Partial $ ArrayUnsafe start end
1743+ initial = FL.Partial . toArrayUnsafe <$> alloc (max n 0)
16441744
1645− -- This condition is always true, but compiler does not know that.
1646− step (ArrayUnsafe start end) x | end /= nullPtr = do
1647− liftIO $ poke end x
1745+ step (ArrayUnsafe contents start end) x = do
1746+ liftIO $ poke end x >> touch contents
16481747 return
16491748 $ FL.Partial
1650− $ ArrayUnsafe start (end `plusPtr` sizeOf (undefined :: a))
1651− -- This condition is never met, just a hack to insert a touchForeignPtr.
1652− -- This condition increases the cputime by around 50% in several benchmarks
1653− -- but there seem to be no better way. XXX An unconditional touch increases
1654− -- the allocations and time by a very large amount, need to investigate.
1655− step (ArrayUnsafe start _) _ = liftIO $ touchForeignPtr start >> undefined
1656−
1657− extract (ArrayUnsafe start end) = return $ Array start end end -- liftIO . shrinkToFit
1749+ $ ArrayUnsafe contents start (end `plusPtr` sizeOf (undefined :: a))
16581750
16591751-- | Like 'writeN' but does not check the array bounds when writing. The fold
16601752-- driver must not call the step function more than 'n' times otherwise it will
@@ -1725,17 +1817,17 @@ writeWith elemCount =
17251817
17261818 where
17271819
1728− insertElem (Array start end bound) x = do
1820+ insertElem (Array contents start end bound) x = do
17291821 liftIO $ poke end x
1730− return $ Array start (end `plusPtr` sizeOf (undefined :: a)) bound
1822+ let end1 = end `plusPtr` sizeOf (undefined :: a)
1823+ return $ Array contents start end1 bound
17311824
17321825 initial = do
17331826 when (elemCount < 0) $ error "writeWith: elemCount is negative"
17341827 liftIO $ newArrayAligned (alignment (undefined :: a)) elemCount
1735− step arr@(Array start end bound) x
1828+ step arr@(Array _ start end bound) x
17361829 | end `plusPtr` sizeOf (undefined :: a) > bound = do
1737− let p = unsafeForeignPtrToPtr start
1738− oldSize = end `minusPtr` p
1830+ let oldSize = end `minusPtr` start
17391831 newSize = max (oldSize * 2) 1
17401832 arr1 <-
17411833 liftIO
@@ -1842,21 +1934,21 @@ fromList xs = fromStreamD $ D.fromList xs
18421934{-# INLINE spliceCopy #-}
18431935spliceCopy :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)
18441936spliceCopy arr1 arr2 = do
1845− let src1 = unsafeForeignPtrToPtr (aStart arr1)
1846− src2 = unsafeForeignPtrToPtr (aStart arr2)
1937+ let src1 = arrStart arr1
1938+ src2 = arrStart arr2
18471939 len1 = aEnd arr1 `minusPtr` src1
18481940 len2 = aEnd arr2 `minusPtr` src2
18491941
18501942 arr <- liftIO $ newArray (len1 + len2)
1851− let dst = unsafeForeignPtrToPtr (aStart arr)
1943+ let dst = arrStart arr
18521944
18531945 -- XXX Should we use copyMutableByteArray# instead? Is there an overhead to
18541946 -- ccall?
18551947 liftIO $ do
18561948 memcpy (castPtr dst) (castPtr src1) len1
1857− touchForeignPtr (aStart arr1)
1949+ touch (arrContents arr1)
18581950 memcpy (castPtr (dst `plusPtr` len1)) (castPtr src2) len2
1859− touchForeignPtr (aStart arr2)
1951+ touch (arrContents arr2)
18601952 return arr { aEnd = dst `plusPtr` (len1 + len2) }
18611953
18621954-- | Really really unsafe, appends the second array into the first array. If
@@ -1866,12 +1958,13 @@ spliceCopy arr1 arr2 = do
18661958spliceUnsafe :: MonadIO m => Array a -> (Array a, Int) -> m (Array a)
18671959spliceUnsafe dst (src, srcLen) =
18681960 liftIO $ do
1869− unsafeWithForeignPtr (aStart dst) $ \_ ->
1870− unsafeWithForeignPtr (aStart src) $ \psrc -> do
1871− let pdst = aEnd dst
1872− assert (pdst `plusPtr` srcLen <= aBound dst) (return ())
1873− memcpy (castPtr pdst) (castPtr psrc) srcLen
1874− return $ dst {aEnd = pdst `plusPtr` srcLen}
1961+ let psrc = arrStart src
1962+ let pdst = aEnd dst
1963+ assert (pdst `plusPtr` srcLen <= aBound dst) (return ())
1964+ memcpy (castPtr pdst) (castPtr psrc) srcLen
1965+ touch (arrContents src)
1966+ touch (arrContents dst)
1967+ return $ dst {aEnd = pdst `plusPtr` srcLen}
18751968
18761969-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no
18771970-- reserved space available in @dst@ it is reallocated to a size determined by
@@ -1884,19 +1977,18 @@ spliceUnsafe dst (src, srcLen) =
18841977{-# INLINE spliceWith #-}
18851978spliceWith :: forall m a. (MonadIO m, Storable a) =>
18861979 (Int -> Int -> Int) -> Array a -> Array a -> m (Array a)
1887−spliceWith sizer dst@(Array start end bound) src = do
1980+spliceWith sizer dst@(Array _ start end bound) src = do
18881981{-
18891982 let f = appendWith (`sizer` byteLength src) (return dst)
18901983 in D.fold f (toStreamD src)
18911984-}
18921985 assert (end <= bound) (return ())
1893− let srcLen = aEnd src `minusPtr` unsafeForeignPtrToPtr (aStart src)
1986+ let srcLen = aEnd src `minusPtr` arrStart src
18941987
18951988 dst1 <-
18961989 if end `plusPtr` srcLen >= bound
18971990 then do
1898− let oldStart = unsafeForeignPtrToPtr start
1899− oldSize = end `minusPtr` oldStart
1991+ let oldSize = end `minusPtr` start
19001992 newSize = sizer oldSize srcLen
19011993 when (newSize < oldSize + srcLen)
19021994 $ error
@@ -1943,19 +2035,21 @@ spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))
19432035breakOn :: MonadIO m
19442036 => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
19452037breakOn sep arr@Array{..} = liftIO $ do
1946− let p = unsafeForeignPtrToPtr aStart
2038+ let p = arrStart
19472039 loc <- c_memchr p sep (fromIntegral $ aEnd `minusPtr` p)
19482040 return $
19492041 if loc == nullPtr
19502042 then (arr, Nothing)
19512043 else
19522044 ( Array
1953− { aStart = aStart
2045+ { arrContents = arrContents
2046+ , arrStart = arrStart
19542047 , aEnd = loc
19552048 , aBound = loc
19562049 }
19572050 , Just $ Array
1958− { aStart = aStart `plusForeignPtr` (loc `minusPtr` p + 1)
2051+ { arrContents = arrContents
2052+ , arrStart = arrStart `plusPtr` (loc `minusPtr` p + 1)
19592053 , aEnd = aEnd
19602054 , aBound = aBound
19612055 }
@@ -1974,14 +2068,16 @@ splitAt i arr@Array{..} =
19742068 then error $ "sliceAt: specified array index " ++ show i
19752069 ++ " is beyond the maximum index " ++ show maxIndex
19762070 else let off = i * sizeOf (undefined :: a)
1977− p = unsafeForeignPtrToPtr aStart `plusPtr` off
2071+ p = arrStart `plusPtr` off
19782072 in ( Array
1979− { aStart = aStart
2073+ { arrContents = arrContents
2074+ , arrStart = arrStart
19802075 , aEnd = p
19812076 , aBound = p
19822077 }
19832078 , Array
1984− { aStart = aStart `plusForeignPtr` off
2079+ { arrContents = arrContents
2080+ , arrStart = arrStart `plusPtr` off
19852081 , aEnd = aEnd
19862082 , aBound = aBound
19872083 }
@@ -2003,8 +2099,8 @@ castUnsafe ::
20032099 Storable b =>
20042100#endif
20052101 Array a -> Array b
2006−castUnsafe (Array start end bound) =
2007− Array (castForeignPtr start) (castPtr end) (castPtr bound)
2102+castUnsafe (Array contents start end bound) =
2103+ Array contents (castPtr start) (castPtr end) (castPtr bound)
20082104
20092105-- | Cast an @Array a@ into an @Array Word8@.
20102106--
@@ -2035,7 +2131,7 @@ cast arr =
20352131--
20362132asPtrUnsafe :: Array a -> (Ptr b -> IO c) -> IO c
20372133asPtrUnsafe Array{..} act = do
2038− unsafeWithForeignPtr aStart $ \ptr -> act (castPtr ptr)
2134+ unsafeWithArrayContents arrContents arrStart $ \ptr -> act (castPtr ptr)
20392135
20402136-------------------------------------------------------------------------------
20412137-- Equality
@@ -2048,8 +2144,8 @@ asPtrUnsafe Array{..} act = do
20482144cmp :: MonadIO m => Array a -> Array a -> m Bool
20492145cmp arr1 arr2 =
20502146 liftIO $ do
2051− let ptr1 = unsafeForeignPtrToPtr $ aStart arr1
2052− let ptr2 = unsafeForeignPtrToPtr $ aStart arr2
2147+ let ptr1 = arrStart arr1
2148+ let ptr2 = arrStart arr2
20532149 let len1 = aEnd arr1 `minusPtr` ptr1
20542150 let len2 = aEnd arr2 `minusPtr` ptr2
20552151
@@ -2059,8 +2155,8 @@ cmp arr1 arr2 =
20592155 then return True
20602156 else do
20612157 r <- memcmp (castPtr ptr1) (castPtr ptr2) len1
2062− touchForeignPtr $ aStart arr1
2063− touchForeignPtr $ aStart arr2
2158+ touch (arrContents arr1)
2159+ touch (arrContents arr2)
20642160 return r
20652161 else return False
20662162