57ab52c · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Use MutableByteArray# instead of ForeignPtr

57ab52cHarendra Kumar5 years ago

src/Streamly/Internal/Data/Array/Foreign.hs+27−34

compare with master

unifiedsplit

@@ -126,8 +126,6 @@ import Data.Semigroup ((<>))

126#endif

127import Data.Word (Word8)

128import Foreign.C.String (CString)

129−import Foreign.ForeignPtr (castForeignPtr)

130−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

131import Foreign.Ptr (plusPtr, castPtr)

129import Foreign.Ptr (plusPtr, castPtr)

132import Foreign.Storable (Storable(..))

130import Foreign.Storable (Storable(..))

133import Prelude hiding (length, null, last, map, (!!), read, concat)

131import Prelude hiding (length, null, last, map, (!!), read, concat)

@@ -137,7 +135,7 @@ import GHC.Ptr (Ptr(..))

137import GHC.Prim (touch#)

135import GHC.Prim (touch#)

138import GHC.IO (IO(..))

136import GHC.IO (IO(..))

139

137

140−import Streamly.Internal.BaseCompat

138+import Streamly.Internal.Data.Array.Foreign.Mut.Type (arrayToFptrContents)

141import Streamly.Internal.Data.Array.Foreign.Type (Array(..), length)

139import Streamly.Internal.Data.Array.Foreign.Type (Array(..), length)

142import Streamly.Internal.Data.Fold.Type (Fold(..))

140import Streamly.Internal.Data.Fold.Type (Fold(..))

143import Streamly.Internal.Data.Producer.Type (Producer)

141import Streamly.Internal.Data.Producer.Type (Producer)

@@ -156,15 +154,6 @@ import qualified Streamly.Internal.Data.Unfold as Unfold

156import qualified Streamly.Internal.Data.Producer.Type as Producer

154import qualified Streamly.Internal.Data.Producer.Type as Producer

157import qualified Streamly.Internal.Ring.Foreign as RB

155import qualified Streamly.Internal.Ring.Foreign as RB

158

156

159−#if MIN_VERSION_base(4,10,0)

160−import Foreign.ForeignPtr (plusForeignPtr)

161−#else

162−import GHC.Base (Int(..), plusAddr#)

163−import GHC.ForeignPtr (ForeignPtr(..))

164−plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b

165−plusForeignPtr (ForeignPtr addr c) (I# d) = ForeignPtr (plusAddr# addr d) c

166−#endif

167−

168-------------------------------------------------------------------------------

157-------------------------------------------------------------------------------

169-- Construction

158-- Construction

170-------------------------------------------------------------------------------

159-------------------------------------------------------------------------------

@@ -227,7 +216,8 @@ unsafeRead :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a

227unsafeRead = Unfold step inject

216unsafeRead = Unfold step inject

228 where

217 where

229

218

230− inject (Array fp _) = return fp

219+ inject (Array contents (Ptr start) _) =

220+ return (ForeignPtr start (arrayToFptrContents contents))

231

221

232 {-# INLINE_LATE step #-}

222 {-# INLINE_LATE step #-}

233 step (ForeignPtr p contents) = do

223 step (ForeignPtr p contents) = do

@@ -262,13 +252,14 @@ null arr = A.byteLength arr == 0

262{-# INLINE getIndexRev #-}

252{-# INLINE getIndexRev #-}

263getIndexRev :: forall a. Storable a => Array a -> Int -> Maybe a

253getIndexRev :: forall a. Storable a => Array a -> Int -> Maybe a

264getIndexRev arr i =

254getIndexRev arr i =

265− unsafeInlineIO $

255+ unsafeInlineIO

266− unsafeWithForeignPtr (aStart arr) $ \ptr -> do

256+ $ MA.unsafeWithArrayContents (arrContents arr) (arrStart arr)

257+ $ \ptr -> do

267− let elemSize = sizeOf (undefined :: a)

258+ let elemSize = sizeOf (undefined :: a)

268− elemPtr = aEnd arr `plusPtr` negate (elemSize * (i + 1))

259+ elemPtr = aEnd arr `plusPtr` negate (elemSize * (i + 1))

269− if i >= 0 && elemPtr >= ptr

260+ if i >= 0 && elemPtr >= ptr

270− then Just <$> peek elemPtr

261+ then Just <$> peek elemPtr

271− else return Nothing

262+ else return Nothing

272

263

273-- |

264-- |

274--

265--

@@ -374,11 +365,11 @@ getSliceUnsafe ::

374 -> Int -- ^ length of the slice

365 -> Int -- ^ length of the slice

375 -> Array a

366 -> Array a

376 -> Array a

367 -> Array a

377−getSliceUnsafe index len (Array fp e) =

368+getSliceUnsafe index len (Array contents start e) =

378 let size = sizeOf (undefined :: a)

369 let size = sizeOf (undefined :: a)

379− fp1 = fp `plusForeignPtr` (index * size)

370+ fp1 = start `plusPtr` (index * size)

380− end = unsafeForeignPtrToPtr fp1 `plusPtr` (len * size)

371+ end = fp1 `plusPtr` (len * size)

381− in assert (end <= e) (Array fp1 end)

372+ in assert (end <= e) (Array contents fp1 end)

382

373

383-- | Split the array into a stream of slices using a predicate. The element

374-- | Split the array into a stream of slices using a predicate. The element

384-- matching the predicate is dropped.

375-- matching the predicate is dropped.

@@ -425,13 +416,14 @@ getSlicesFromLen from len =

425{-# INLINE getIndex #-}

416{-# INLINE getIndex #-}

426getIndex :: forall a. Storable a => Array a -> Int -> Maybe a

417getIndex :: forall a. Storable a => Array a -> Int -> Maybe a

427getIndex arr i =

418getIndex arr i =

428− unsafeInlineIO $

419+ unsafeInlineIO

429− unsafeWithForeignPtr (aStart arr) $ \ptr -> do

420+ $ MA.unsafeWithArrayContents (arrContents arr) (arrStart arr)

421+ $ \ptr -> do

430− let elemSize = sizeOf (undefined :: a)

422+ let elemSize = sizeOf (undefined :: a)

431− elemPtr = ptr `plusPtr` (elemSize * i)

423+ elemPtr = ptr `plusPtr` (elemSize * i)

432− if i >= 0 && elemPtr `plusPtr` elemSize <= aEnd arr

424+ if i >= 0 && elemPtr `plusPtr` elemSize <= aEnd arr

433− then Just <$> peek elemPtr

425+ then Just <$> peek elemPtr

434− else return Nothing

426+ else return Nothing

435

427

436-- | Given a stream of array indices, read the elements on those indices from

428-- | Given a stream of array indices, read the elements on those indices from

437-- the supplied Array. An exception is thrown if an index is out of bounds.

429-- the supplied Array. An exception is thrown if an index is out of bounds.

@@ -520,7 +512,8 @@ unsafeCast ::

520 Storable b =>

512 Storable b =>

521#endif

513#endif

522 Array a -> Array b

514 Array a -> Array b

523−unsafeCast (Array start end) = Array (castForeignPtr start) (castPtr end)

515+unsafeCast (Array contents start end) =

516+ Array contents (castPtr start) (castPtr end)

524

517

525-- | Cast an @Array a@ into an @Array Word8@.

518-- | Cast an @Array a@ into an @Array Word8@.

526--

519--

@@ -551,7 +544,7 @@ cast arr =

551--

544--

552unsafeAsPtr :: Array a -> (Ptr b -> IO c) -> IO c

545unsafeAsPtr :: Array a -> (Ptr b -> IO c) -> IO c

553unsafeAsPtr Array{..} act = do

546unsafeAsPtr Array{..} act = do

554− unsafeWithForeignPtr aStart $ \ptr -> act (castPtr ptr)

547+ MA.unsafeWithArrayContents arrContents arrStart $ \ptr -> act (castPtr ptr)

555

548

556-- | Convert an array of any type into a null terminated CString Ptr.

549-- | Convert an array of any type into a null terminated CString Ptr.

557--

550--

@@ -564,7 +557,7 @@ unsafeAsPtr Array{..} act = do

564unsafeAsCString :: Array a -> (CString -> IO b) -> IO b

557unsafeAsCString :: Array a -> (CString -> IO b) -> IO b

565unsafeAsCString arr act = do

558unsafeAsCString arr act = do

566 let Array{..} = asBytes arr <> A.fromList [0]

559 let Array{..} = asBytes arr <> A.fromList [0]

567− unsafeWithForeignPtr aStart $ \ptr -> act (castPtr ptr)

560+ MA.unsafeWithArrayContents arrContents arrStart $ \ptr -> act (castPtr ptr)

568

561

569-------------------------------------------------------------------------------

562-------------------------------------------------------------------------------

570-- Folds

563-- Folds

src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+295−199

@@ -1,3 +1,4 @@

1+{-# LANGUAGE UnboxedTuples #-}

1-- |

2-- |

2-- Module : Streamly.Internal.Data.Array.Foreign.Mut.Type

3-- Module : Streamly.Internal.Data.Array.Foreign.Mut.Type

@@ -16,6 +17,12 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type

16 -- * Type

17 -- * Type

17 -- $arrayNotes

18 -- $arrayNotes

18 Array (..)

19 Array (..)

20+ , ArrayContents

21+ , arrayToFptrContents

22+ , fptrToArrayContents

23+ , unsafeWithArrayContents

24+ , nilArrayContents

25+ , touch

20 -- * Constructing and Writing

27 -- * Constructing and Writing

21 -- ** Construction

28 -- ** Construction

@@ -196,6 +203,10 @@ where

196

203

197#include "inline.hs"

204#include "inline.hs"

198

205

206+#ifdef USE_C_MALLOC

207+#define USE_FOREIGN_PTR

208+#endif

209+

199import Control.Exception (assert)

210import Control.Exception (assert)

200import Control.DeepSeq (NFData(..))

211import Control.DeepSeq (NFData(..))

201import Control.Monad (when, void)

212import Control.Monad (when, void)

@@ -207,17 +218,29 @@ import Data.Semigroup (Semigroup(..))

207#endif

218#endif

208import Data.Word (Word8)

219import Data.Word (Word8)

209import Foreign.C.Types (CSize(..), CInt(..))

220import Foreign.C.Types (CSize(..), CInt(..))

210−import Foreign.ForeignPtr (touchForeignPtr, castForeignPtr)

211import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

221import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

222+#ifndef USE_FOREIGN_PTR

223+import Foreign.Marshal.Alloc (mallocBytes)

224+#endif

212import Foreign.Ptr (plusPtr, minusPtr, castPtr, nullPtr)

225import Foreign.Ptr (plusPtr, minusPtr, castPtr, nullPtr)

213import Foreign.Storable (Storable(..))

226import 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

215#if __GLASGOW_HASKELL__ < 802

234#if __GLASGOW_HASKELL__ < 802

216#define noinline

235#define noinline

217#else

236#else

218import GHC.Base (noinline)

237import GHC.Base (noinline)

219#endif

238#endif

239+import GHC.Exts (unsafeCoerce#)

220−import GHC.ForeignPtr (ForeignPtr(..))

240+import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))

241+#ifdef USE_C_MALLOC

242+import GHC.ForeignPtr (mallocForeignPtrAlignedBytes)

243+#endif

221import GHC.Ptr (Ptr(..))

244import GHC.Ptr (Ptr(..))

222

245

223import Streamly.Internal.BaseCompat

246import Streamly.Internal.BaseCompat

@@ -225,9 +248,9 @@ import Streamly.Internal.Data.Fold.Type (Fold(..))

225import Streamly.Internal.Data.Producer.Type (Producer (..))

248import Streamly.Internal.Data.Producer.Type (Producer (..))

226import Streamly.Internal.Data.SVar.Type (adaptState)

249import Streamly.Internal.Data.SVar.Type (adaptState)

227import Streamly.Internal.Data.Unfold.Type (Unfold(..))

250import Streamly.Internal.Data.Unfold.Type (Unfold(..))

228−

229import Streamly.Internal.System.IO

251import Streamly.Internal.System.IO

230 (defaultChunkSize, arrayPayloadSize, unsafeInlineIO)

252 (defaultChunkSize, arrayPayloadSize, unsafeInlineIO)

253+import System.IO.Unsafe (unsafePerformIO)

231

254

232#ifdef DEVBUILD

255#ifdef DEVBUILD

233import qualified Data.Foldable as F

256import qualified Data.Foldable as F

@@ -236,20 +259,13 @@ import qualified Streamly.Internal.Data.Fold.Type as FL

236import qualified Streamly.Internal.Data.Producer as Producer

259import qualified Streamly.Internal.Data.Producer as Producer

237import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

260import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

238import qualified Streamly.Internal.Data.Stream.StreamK.Type as K

261import qualified Streamly.Internal.Data.Stream.StreamK.Type as K

262+#ifdef USE_FOREIGN_PTR

239import qualified Streamly.Internal.Foreign.Malloc as Malloc

263import qualified Streamly.Internal.Foreign.Malloc as Malloc

264+#endif

240

265

241import Prelude hiding

266import Prelude hiding

242 (length, foldr, read, unlines, splitAt, reverse, truncate)

267 (length, foldr, read, unlines, splitAt, reverse, truncate)

243

268

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−

253-- $setup

269-- $setup

254-- >>> :m

270-- >>> :m

255-- >>> import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as Array

271-- >>> import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as Array

@@ -292,12 +308,44 @@ memcmp p1 p2 len = do

292 r <- c_memcmp p1 p2 (fromIntegral len)

308 r <- c_memcmp p1 p2 (fromIntegral len)

293 return $ r == 0

309 return $ r == 0

294

310

295−-- | Same as unsafeWithForeignPtr but lifted to any MonadIO monad.

311+-------------------------------------------------------------------------------

296−{-# INLINE unsafeWithForeignPtrM #-}

312+-- Array Contents

297−unsafeWithForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b

313+-------------------------------------------------------------------------------

298−unsafeWithForeignPtrM fo f = do

314+

299− r <- f (unsafeForeignPtrToPtr fo)

315+-- We support using ForeignPtrContents or MutableByteArray.

300− liftIO $ touchForeignPtr fo

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

301 return r

349 return r

302

350

303-------------------------------------------------------------------------------

351-------------------------------------------------------------------------------

@@ -335,7 +383,8 @@ data Array a =

335 Storable a =>

383 Storable a =>

336#endif

384#endif

337 Array

385 Array

386+ { arrContents :: UNPACKIF !ArrayContents

338− { aStart :: {-# UNPACK #-} !(ForeignPtr a) -- ^ first address

387+ , arrStart :: {-# UNPACK #-} !(Ptr a) -- ^ first address

339 , aEnd :: {-# UNPACK #-} !(Ptr a) -- ^ first unused address

388 , aEnd :: {-# UNPACK #-} !(Ptr a) -- ^ first unused address

340 , aBound :: {-# UNPACK #-} !(Ptr a) -- ^ first address beyond allocated memory

389 , aBound :: {-# UNPACK #-} !(Ptr a) -- ^ first address beyond allocated memory

341 }

390 }

@@ -345,7 +394,8 @@ data Array a =

345-- address, and @bound@ is the first address beyond the allocated memory.

394-- address, and @bound@ is the first address beyond the allocated memory.

346--

395--

347-- Unsafe: Make sure that foreignPtr <= end <= bound and (end - start) is an

396-- 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.

349--

399--

350-- /Pre-release/

400-- /Pre-release/

351--

401--

@@ -355,9 +405,9 @@ fromForeignPtrUnsafe ::

355 Storable a =>

405 Storable a =>

356#endif

406#endif

357 ForeignPtr a -> Ptr a -> Ptr a -> Array a

407 ForeignPtr a -> Ptr a -> Ptr a -> Array a

358−fromForeignPtrUnsafe fp end bound =

408+fromForeignPtrUnsafe fp@(ForeignPtr start contents) end bound =

359 assert (unsafeForeignPtrToPtr fp <= end && end <= bound)

409 assert (unsafeForeignPtrToPtr fp <= end && end <= bound)

360− (Array fp end bound)

410+ (Array (fptrToArrayContents contents) (Ptr start) end bound)

361

411

362-------------------------------------------------------------------------------

412-------------------------------------------------------------------------------

363-- Construction

413-- Construction

@@ -385,17 +435,42 @@ fromForeignPtrUnsafe fp end bound =

385-- /Pre-release/

435-- /Pre-release/

386{-# INLINE newArrayWith #-}

436{-# INLINE newArrayWith #-}

387newArrayWith :: forall m a. (MonadIO m, Storable a)

437newArrayWith :: 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)

389newArrayWith alloc alignSize count = do

439newArrayWith alloc alignSize count = do

390 let size = max (count * sizeOf (undefined :: a)) 0

440 let size = max (count * sizeOf (undefined :: a)) 0

391− fptr <- alloc size alignSize

441+ (contents, p) <- alloc size alignSize

392− let p = unsafeForeignPtrToPtr fptr

393 return $ Array

442 return $ Array

394− { aStart = fptr

443+ { arrContents = contents

444+ , arrStart = p

395 , aEnd = p

445 , aEnd = p

396 , aBound = p `plusPtr` size

446 , aBound = p `plusPtr` size

397 }

447 }

398

448

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+

399-- | Like 'newArrayWith' but using an allocator that allocates unmanaged pinned

474-- | Like 'newArrayWith' but using an allocator that allocates unmanaged pinned

400-- memory. The memory will never be freed by GHC. This could be useful in

475-- memory. The memory will never be freed by GHC. This could be useful in

401-- allocate-once global data structures. Use carefully as incorrect use can

476-- allocate-once global data structures. Use carefully as incorrect use can

@@ -403,14 +478,29 @@ newArrayWith alloc alignSize count = do

403--

478--

404-- /Internal/

479-- /Internal/

405{-# INLINE newArrayAlignedUnmanaged #-}

480{-# INLINE newArrayAlignedUnmanaged #-}

406−newArrayAlignedUnmanaged :: (MonadIO m, Storable a) =>

481+newArrayAlignedUnmanaged :: forall m a. (MonadIO m, Storable a) =>

407 Int -> Int -> m (Array a)

482 Int -> Int -> m (Array a)

483+#ifdef USE_FOREIGN_PTR

484+newArrayAlignedUnmanaged = do

408−newArrayAlignedUnmanaged = newArrayWith mallocForeignPtrAlignedUnmanagedBytes

485+ newArrayWith mallocForeignPtrAlignedUnmanagedBytes

409

486

410 where

487 where

411

488

412− mallocForeignPtrAlignedUnmanagedBytes size alignSize =

489+ mallocForeignPtrAlignedUnmanagedBytes size align = do

490+ ForeignPtr addr contents <-

413− liftIO $ Malloc.mallocForeignPtrAlignedUnmanagedBytes size alignSize

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

414

504

415-- | Like 'newArrayWith' but using an allocator that aligns the memory to the

505-- | Like 'newArrayWith' but using an allocator that aligns the memory to the

416-- alignment dictated by the 'Storable' instance of the type.

506-- alignment dictated by the 'Storable' instance of the type.

@@ -418,12 +508,7 @@ newArrayAlignedUnmanaged = newArrayWith mallocForeignPtrAlignedUnmanagedBytes

418-- /Internal/

508-- /Internal/

419{-# INLINE newArrayAligned #-}

509{-# INLINE newArrayAligned #-}

420newArrayAligned :: (MonadIO m, Storable a) => Int -> Int -> m (Array a)

510newArrayAligned :: (MonadIO m, Storable a) => Int -> Int -> m (Array a)

421−newArrayAligned = newArrayWith mallocForeignPtrAlignedBytes

511+newArrayAligned = newArrayWith (\s a -> liftIO $ newAlignedArrayContents s a)

422−

423− where

424−

425− mallocForeignPtrAlignedBytes size alignSize =

426− liftIO $ Malloc.mallocForeignPtrAlignedBytes size alignSize

427

512

428-- XXX can unaligned allocation be more efficient when alignment is not needed?

513-- XXX can unaligned allocation be more efficient when alignment is not needed?

429--

514--

@@ -445,7 +530,8 @@ withNewArrayUnsafe ::

445 (MonadIO m, Storable a) => Int -> (Ptr a -> m ()) -> m (Array a)

530 (MonadIO m, Storable a) => Int -> (Ptr a -> m ()) -> m (Array a)

446withNewArrayUnsafe count f = do

531withNewArrayUnsafe count f = do

447 arr <- newArray count

532 arr <- newArray count

533+ unsafeWithArrayContents (arrContents arr) (arrStart arr)

448− unsafeWithForeignPtrM (aStart arr) $ \p -> f p >> return arr

534+ $ \p -> f p >> return arr

449

535

450-------------------------------------------------------------------------------

536-------------------------------------------------------------------------------

451-- Random writes

537-- Random writes

@@ -467,7 +553,7 @@ putIndices = undefined

467putIndexUnsafe :: forall m a. (MonadIO m, Storable a)

553putIndexUnsafe :: forall m a. (MonadIO m, Storable a)

468 => Array a -> Int -> a -> m ()

554 => Array a -> Int -> a -> m ()

469putIndexUnsafe Array{..} i x =

555putIndexUnsafe Array{..} i x =

470− unsafeWithForeignPtrM aStart $ \ptr -> do

556+ unsafeWithArrayContents arrContents arrStart $ \ptr -> do

471 let elemSize = sizeOf (undefined :: a)

557 let elemSize = sizeOf (undefined :: a)

472 elemPtr = ptr `plusPtr` (elemSize * i)

558 elemPtr = ptr `plusPtr` (elemSize * i)

473 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())

559 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())

@@ -498,7 +584,8 @@ putIndexPtr ptr end i x = do

498{-# INLINE putIndex #-}

584{-# INLINE putIndex #-}

499putIndex :: (MonadIO m, Storable a) => Array a -> Int -> a -> m ()

585putIndex :: (MonadIO m, Storable a) => Array a -> Int -> a -> m ()

500putIndex arr i x =

586putIndex arr i x =

587+ unsafeWithArrayContents (arrContents arr) (arrStart arr)

501− unsafeWithForeignPtrM (aStart arr) $ \p -> putIndexPtr p (aEnd arr) i x

588+ $ \p -> putIndexPtr p (aEnd arr) i x

502

589

503-- | Modify a given index of an array using a modifier function.

590-- | Modify a given index of an array using a modifier function.

504--

591--

@@ -506,7 +593,7 @@ putIndex arr i x =

506modifyIndexUnsafe :: forall m a b. (MonadIO m, Storable a) =>

593modifyIndexUnsafe :: forall m a b. (MonadIO m, Storable a) =>

507 Array a -> Int -> (a -> (a, b)) -> m b

594 Array a -> Int -> (a -> (a, b)) -> m b

508modifyIndexUnsafe Array{..} i f = do

595modifyIndexUnsafe Array{..} i f = do

509− liftIO $ unsafeWithForeignPtr aStart $ \ptr -> do

596+ liftIO $ unsafeWithArrayContents arrContents arrStart $ \ptr -> do

510 let elemSize = sizeOf (undefined :: a)

597 let elemSize = sizeOf (undefined :: a)

511 elemPtr = ptr `plusPtr` (elemSize * i)

598 elemPtr = ptr `plusPtr` (elemSize * i)

512 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())

599 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())

@@ -521,7 +608,7 @@ modifyIndexUnsafe Array{..} i f = do

521modifyIndex :: forall m a b. (MonadIO m, Storable a) =>

608modifyIndex :: forall m a b. (MonadIO m, Storable a) =>

522 Array a -> Int -> (a -> (a, b)) -> m b

609 Array a -> Int -> (a -> (a, b)) -> m b

523modifyIndex Array{..} i f = do

610modifyIndex Array{..} i f = do

524− liftIO $ unsafeWithForeignPtr aStart $ \ptr -> do

611+ liftIO $ unsafeWithArrayContents arrContents arrStart $ \ptr -> do

525 let elemSize = sizeOf (undefined :: a)

612 let elemSize = sizeOf (undefined :: a)

526 elemPtr = ptr `plusPtr` (elemSize * i)

613 elemPtr = ptr `plusPtr` (elemSize * i)

527 if i >= 0 && elemPtr `plusPtr` elemSize <= aEnd

614 if i >= 0 && elemPtr `plusPtr` elemSize <= aEnd

@@ -635,7 +722,7 @@ snocNewEnd :: (MonadIO m, Storable a) => Ptr a -> Array a -> a -> m (Array a)

635snocNewEnd newEnd arr@Array{..} x = liftIO $ do

722snocNewEnd newEnd arr@Array{..} x = liftIO $ do

636 assert (newEnd <= aBound) (return ())

723 assert (newEnd <= aBound) (return ())

637 poke aEnd x

724 poke aEnd x

638− touchForeignPtr aStart

725+ touch arrContents

639 return $ arr {aEnd = newEnd}

726 return $ arr {aEnd = newEnd}

640

727

641-- | Really really unsafe, appends the element into the first array, may

728-- | Really really unsafe, appends the element into the first array, may

@@ -669,7 +756,7 @@ reallocWith :: forall m a. (MonadIO m , Storable a) =>

669 -> Array a

756 -> Array a

670 -> m (Array a)

757 -> m (Array a)

671reallocWith label sizer reqSize arr = do

758reallocWith label sizer reqSize arr = do

672− let oldSize = aEnd arr `minusPtr` unsafeForeignPtrToPtr (aStart arr)

759+ let oldSize = aEnd arr `minusPtr` arrStart arr

673 newSize = sizer oldSize

760 newSize = sizer oldSize

674 safeSize = max newSize (oldSize + reqSize)

761 safeSize = max newSize (oldSize + reqSize)

675 rounded = roundUpLargeArray safeSize

762 rounded = roundUpLargeArray safeSize

@@ -767,21 +854,21 @@ snoc = snocWith (* 2)

767reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)

854reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)

768reallocAligned elemSize alignSize newSize Array{..} = do

855reallocAligned elemSize alignSize newSize Array{..} = do

769 assert (aEnd <= aBound) (return ())

856 assert (aEnd <= aBound) (return ())

770− let oldStart = unsafeForeignPtrToPtr aStart

857+ let oldStart = arrStart

771 oldSize = aEnd `minusPtr` oldStart

858 oldSize = aEnd `minusPtr` oldStart

772 assert (oldSize `mod` elemSize == 0) (return ())

859 assert (oldSize `mod` elemSize == 0) (return ())

773− newPtr <- Malloc.mallocForeignPtrAlignedBytes newSize alignSize

860+ (contents, pNew) <- newAlignedArrayContents newSize alignSize

774− unsafeWithForeignPtr newPtr $ \pNew -> do

775− let size = min oldSize newSize

861+ let size = min oldSize newSize

776− assert (size >= 0) (return ())

862+ assert (size >= 0) (return ())

777− assert (size `mod` elemSize == 0) (return ())

863+ assert (size `mod` elemSize == 0) (return ())

778− memcpy (castPtr pNew) (castPtr oldStart) size

864+ memcpy (castPtr pNew) (castPtr oldStart) size

779− touchForeignPtr aStart

865+ touch arrContents

780− return $ Array

866+ return $ Array

781− { aStart = newPtr

867+ { arrStart = pNew

868+ , arrContents = contents

782− , aEnd = pNew `plusPtr` (size - (size `mod` elemSize))

869+ , aEnd = pNew `plusPtr` (size - (size `mod` elemSize))

783− , aBound = pNew `plusPtr` newSize

870+ , aBound = pNew `plusPtr` newSize

784− }

871+ }

785

872

786{-# INLINABLE realloc #-}

873{-# INLINABLE realloc #-}

787realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)

874realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)

@@ -824,7 +911,7 @@ resizeExp = undefined

824rightSize :: forall m a. (MonadIO m, Storable a) => Array a -> m (Array a)

911rightSize :: forall m a. (MonadIO m, Storable a) => Array a -> m (Array a)

825rightSize arr@Array{..} = do

912rightSize arr@Array{..} = do

826 assert (aEnd <= aBound) (return ())

913 assert (aEnd <= aBound) (return ())

827− let start = unsafeForeignPtrToPtr aStart

914+ let start = arrStart

828 len = aEnd `minusPtr` start

915 len = aEnd `minusPtr` start

829 capacity = aBound `minusPtr` start

916 capacity = aBound `minusPtr` start

830 target = roundUpLargeArray len

917 target = roundUpLargeArray len

@@ -878,7 +965,7 @@ truncateExp = undefined

878{-# INLINE_NORMAL getIndexUnsafe #-}

965{-# INLINE_NORMAL getIndexUnsafe #-}

879getIndexUnsafe :: forall m a. (MonadIO m, Storable a) => Array a -> Int -> m a

966getIndexUnsafe :: forall m a. (MonadIO m, Storable a) => Array a -> Int -> m a

880getIndexUnsafe Array {..} i =

967getIndexUnsafe Array {..} i =

881− unsafeWithForeignPtrM aStart $ \ptr -> do

968+ unsafeWithArrayContents arrContents arrStart $ \ptr -> do

882 let elemSize = sizeOf (undefined :: a)

969 let elemSize = sizeOf (undefined :: a)

883 elemPtr = ptr `plusPtr` (elemSize * i)

970 elemPtr = ptr `plusPtr` (elemSize * i)

884 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())

971 assert (i >= 0 && elemPtr `plusPtr` elemSize <= aEnd) (return ())

@@ -899,7 +986,8 @@ getIndexPtr ptr end i = do

899{-# INLINE getIndex #-}

986{-# INLINE getIndex #-}

900getIndex :: (MonadIO m, Storable a) => Array a -> Int -> m a

987getIndex :: (MonadIO m, Storable a) => Array a -> Int -> m a

901getIndex arr i =

988getIndex arr i =

989+ unsafeWithArrayContents (arrContents arr) (arrStart arr)

902− unsafeWithForeignPtrM (aStart arr) $ \p -> getIndexPtr p (aEnd arr) i

990+ $ \p -> getIndexPtr p (aEnd arr) i

903

991

904{-# INLINE getIndexPtrRev #-}

992{-# INLINE getIndexPtrRev #-}

905getIndexPtrRev :: forall m a. (MonadIO m, Storable a) =>

993getIndexPtrRev :: forall m a. (MonadIO m, Storable a) =>

@@ -919,9 +1007,11 @@ getIndexPtrRev ptr end i = do

919{-# INLINE getIndexRev #-}

1007{-# INLINE getIndexRev #-}

920getIndexRev :: (MonadIO m, Storable a) => Array a -> Int -> m a

1008getIndexRev :: (MonadIO m, Storable a) => Array a -> Int -> m a

921getIndexRev arr i =

1009getIndexRev arr i =

1010+ unsafeWithArrayContents (arrContents arr) (arrStart arr)

922− unsafeWithForeignPtrM (aStart arr) $ \p -> getIndexPtrRev p (aEnd arr) i

1011+ $ \p -> getIndexPtrRev p (aEnd arr) i

923

1012

924−data GetIndicesState fp end st = GetIndicesState fp end st

1013+data GetIndicesState contents start end st =

1014+ GetIndicesState contents start end st

925

1015

926-- | Given an unfold that generates array indices, read the elements on those

1016-- | Given an unfold that generates array indices, read the elements on those

927-- indices from the supplied Array. An error is thrown if an index is out of

1017-- 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

935

1025

936 where

1026 where

937

1027

938− inject arr@(Array fp@(ForeignPtr _ _) (Ptr end) _) = do

1028+ inject arr@(Array contents start (Ptr end) _) = do

939 st <- injecti arr

1029 st <- injecti arr

940− return $ GetIndicesState fp (Ptr end) st

1030+ return $ GetIndicesState contents start (Ptr end) st

941

1031

942 {-# INLINE_LATE step #-}

1032 {-# INLINE_LATE step #-}

943− step (GetIndicesState fp@(ForeignPtr start _) end st) = do

1033+ step (GetIndicesState contents start end st) = do

944 r <- stepi st

1034 r <- stepi st

945 case r of

1035 case r of

946 D.Yield i s -> do

1036 D.Yield i s -> do

947− x <- liftIO $ getIndexPtr (Ptr start) end i

1037+ x <- liftIO $ getIndexPtr start end i

948− return $ D.Yield x (GetIndicesState fp end s)

1038+ return $ D.Yield x (GetIndicesState contents start end s)

949− D.Skip s -> return $ D.Skip (GetIndicesState fp end s)

1039+ D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)

950 D.Stop -> do

1040 D.Stop -> do

951− liftIO $ touchForeignPtr fp

1041+ liftIO $ touch contents

952 return D.Stop

1042 return D.Stop

953

1043

954-------------------------------------------------------------------------------

1044-------------------------------------------------------------------------------

@@ -970,11 +1060,13 @@ getSliceUnsafe :: forall a. Storable a

970 -> Int -- ^ length of the slice

1060 -> Int -- ^ length of the slice

971 -> Array a

1061 -> Array a

972 -> Array a

1062 -> Array a

973−getSliceUnsafe index len (Array fp e _) =

1063+getSliceUnsafe index len (Array contents start e _) =

974 let size = sizeOf (undefined :: a)

1064 let size = sizeOf (undefined :: a)

975− fp1 = fp `plusForeignPtr` (index * size)

1065+ fp1 = start `plusPtr` (index * size)

976− end = unsafeForeignPtrToPtr fp1 `plusPtr` (len * size)

1066+ end = fp1 `plusPtr` (len * size)

1067+ in assert

977− in assert (index >= 0 && len >= 0 && end <= e) (Array fp1 end end)

1068+ (index >= 0 && len >= 0 && end <= e)

1069+ (Array contents fp1 end end)

978

1070

979-- | /O(1)/ Slice an array in constant time. Throws an error if the slice

1071-- | /O(1)/ Slice an array in constant time. Throws an error if the slice

980-- extends out of the array bounds.

1072-- extends out of the array bounds.

@@ -986,12 +1078,12 @@ getSlice :: forall a. Storable a =>

986 -> Int -- ^ length of the slice

1078 -> Int -- ^ length of the slice

987 -> Array a

1079 -> Array a

988 -> Array a

1080 -> Array a

989−getSlice index len (Array fp e _) =

1081+getSlice index len (Array contents start e _) =

990 let size = sizeOf (undefined :: a)

1082 let size = sizeOf (undefined :: a)

991− fp1 = fp `plusForeignPtr` (index * size)

1083+ fp1 = start `plusPtr` (index * size)

992− end = unsafeForeignPtrToPtr fp1 `plusPtr` (len * size)

1084+ end = fp1 `plusPtr` (len * size)

993 in if index >= 0 && len >= 0 && end <= e

1085 in if index >= 0 && len >= 0 && end <= e

994− then Array fp1 end end

1086+ then Array contents fp1 end end

995 else error

1087 else error

996 $ "getSlice: invalid slice, index "

1088 $ "getSlice: invalid slice, index "

997 ++ show index ++ " length " ++ show len

1089 ++ show index ++ " length " ++ show len

@@ -1077,8 +1169,7 @@ mergeBy = undefined

1077{-# INLINE byteLength #-}

1169{-# INLINE byteLength #-}

1078byteLength :: Array a -> Int

1170byteLength :: Array a -> Int

1079byteLength Array{..} =

1171byteLength Array{..} =

1080− let p = unsafeForeignPtrToPtr aStart

1081− len = aEnd `minusPtr` p

1172+ let len = aEnd `minusPtr` arrStart

1082 in assert (len >= 0) len

1173 in assert (len >= 0) len

1083

1174

1084-- Note: try to avoid the use of length in performance sensitive internal

1175-- Note: try to avoid the use of length in performance sensitive internal

@@ -1106,8 +1197,7 @@ length arr =

1106{-# INLINE byteCapacity #-}

1197{-# INLINE byteCapacity #-}

1107byteCapacity :: Array a -> Int

1198byteCapacity :: Array a -> Int

1108byteCapacity Array{..} =

1199byteCapacity Array{..} =

1109− let p = unsafeForeignPtrToPtr aStart

1110− len = aBound `minusPtr` p

1200+ let len = aBound `minusPtr` arrStart

1111 in assert (len >= 0) len

1201 in assert (len >= 0) len

1112

1202

1113-- | The remaining capacity in the array for appending more elements without

1203-- | The remaining capacity in the array for appending more elements without

@@ -1124,10 +1214,11 @@ bytesFree Array{..} =

1124-- Streams of arrays - Creation

1214-- Streams of arrays - Creation

1125-------------------------------------------------------------------------------

1215-------------------------------------------------------------------------------

1126

1216

1127−data GroupState s start end bound

1217+data GroupState s contents start end bound

1128 = GroupStart s

1218 = GroupStart s

1129− | GroupBuffer s start end bound

1219+ | GroupBuffer s contents start end bound

1220+ | GroupYield

1130− | GroupYield start end bound (GroupState s start end bound)

1221+ contents start end bound (GroupState s contents start end bound)

1131 | GroupFinish

1222 | GroupFinish

1132

1223

1133-- | @arraysOf n stream@ groups the input stream into a stream of

1224-- | @arraysOf n stream@ groups the input stream into a stream of

@@ -1155,10 +1246,10 @@ arraysOf n (D.Stream step state) =

1155 error $ "Streamly.Internal.Data.Array.Foreign.Mut.Type.arraysOf: "

1246 error $ "Streamly.Internal.Data.Array.Foreign.Mut.Type.arraysOf: "

1156 ++ "the size of arrays [" ++ show n

1247 ++ "the size of arrays [" ++ show n

1157 ++ "] must be a natural number"

1248 ++ "] must be a natural number"

1158− Array start end bound <- liftIO $ newArray n

1249+ Array contents start end bound <- liftIO $ newArray n

1159− return $ D.Skip (GroupBuffer st start end bound)

1250+ return $ D.Skip (GroupBuffer st contents start end bound)

1160

1251

1161− step' gst (GroupBuffer st start end bound) = do

1252+ step' gst (GroupBuffer st contents start end bound) = do

1162 r <- step (adaptState gst) st

1253 r <- step (adaptState gst) st

1163 case r of

1254 case r of

1164 D.Yield x s -> do

1255 D.Yield x s -> do

@@ -1166,13 +1257,18 @@ arraysOf n (D.Stream step state) =

1166 let end' = end `plusPtr` sizeOf (undefined :: a)

1257 let end' = end `plusPtr` sizeOf (undefined :: a)

1167 return $

1258 return $

1168 if end' >= bound

1259 if end' >= bound

1260+ then D.Skip

1261+ (GroupYield

1169− then D.Skip (GroupYield start end' bound (GroupStart s))

1262+ contents start end' bound (GroupStart s))

1170− else D.Skip (GroupBuffer s start end' bound)

1263+ else D.Skip (GroupBuffer s contents start end' bound)

1264+ D.Skip s ->

1171− D.Skip s -> return $ D.Skip (GroupBuffer s start end bound)

1265+ return $ D.Skip (GroupBuffer s contents start end bound)

1266+ D.Stop ->

1267+ return

1172− D.Stop -> return $ D.Skip (GroupYield start end bound GroupFinish)

1268+ $ D.Skip (GroupYield contents start end bound GroupFinish)

1173−

1269+

1174− step' _ (GroupYield start end bound next) =

1270+ step' _ (GroupYield contents start end bound next) =

1175− return $ D.Yield (Array start end bound) next

1271+ return $ D.Yield (Array contents start end bound) next

1176

1272

1177 step' _ GroupFinish = return D.Stop

1273 step' _ GroupFinish = return D.Stop

1178

1274

@@ -1189,9 +1285,9 @@ arrayStreamKFromStreamD =

1189-- Streams of arrays - Flattening

1285-- Streams of arrays - Flattening

1190-------------------------------------------------------------------------------

1286-------------------------------------------------------------------------------

1191

1287

1192−data FlattenState s a =

1288+data FlattenState s contents a =

1193 OuterLoop s

1289 OuterLoop s

1194− | InnerLoop s !(ForeignPtr a) !(Ptr a) !(Ptr a)

1290+ | InnerLoop s contents !(Ptr a) !(Ptr a)

1195

1291

1196-- | Use the "read" unfold instead.

1292-- | Use the "read" unfold instead.

1197--

1293--

@@ -1211,20 +1307,19 @@ flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

1211 r <- step (adaptState gst) st

1307 r <- step (adaptState gst) st

1212 return $ case r of

1308 return $ case r of

1213 D.Yield Array{..} s ->

1309 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)

1216 D.Skip s -> D.Skip (OuterLoop s)

1311 D.Skip s -> D.Skip (OuterLoop s)

1217 D.Stop -> D.Stop

1312 D.Stop -> D.Stop

1218

1313

1219 step' _ (InnerLoop st _ p end) | assert (p <= end) (p == end) =

1314 step' _ (InnerLoop st _ p end) | assert (p <= end) (p == end) =

1220 return $ D.Skip $ OuterLoop st

1315 return $ D.Skip $ OuterLoop st

1221

1316

1222− step' _ (InnerLoop st startf p end) = do

1317+ step' _ (InnerLoop st contents p end) = do

1223 x <- liftIO $ do

1318 x <- liftIO $ do

1224 r <- peek p

1319 r <- peek p

1225− touchForeignPtr startf

1320+ touch contents

1226 return r

1321 return r

1227− return $ D.Yield x (InnerLoop st startf

1322+ return $ D.Yield x (InnerLoop st contents

1228 (p `plusPtr` sizeOf (undefined :: a)) end)

1323 (p `plusPtr` sizeOf (undefined :: a)) end)

1229

1324

1230-- | Use the "readRev" unfold instead.

1325-- | Use the "readRev" unfold instead.

@@ -1246,58 +1341,57 @@ flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

1246 return $ case r of

1341 return $ case r of

1247 D.Yield Array{..} s ->

1342 D.Yield Array{..} s ->

1248 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

1343 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)

1251 D.Skip s -> D.Skip (OuterLoop s)

1345 D.Skip s -> D.Skip (OuterLoop s)

1252 D.Stop -> D.Stop

1346 D.Stop -> D.Stop

1253

1347

1254− step' _ (InnerLoop st start p _) | p < unsafeForeignPtrToPtr start =

1348+ step' _ (InnerLoop st _ p start) | p < start =

1255 return $ D.Skip $ OuterLoop st

1349 return $ D.Skip $ OuterLoop st

1256

1350

1257− step' _ (InnerLoop st startf p end) = do

1351+ step' _ (InnerLoop st contents p start) = do

1258 x <- liftIO $ do

1352 x <- liftIO $ do

1259 r <- peek p

1353 r <- peek p

1260− touchForeignPtr startf

1354+ touch contents

1261 return r

1355 return r

1356+ let cur = p `plusPtr` negate (sizeOf (undefined :: a))

1262− return $ D.Yield x (InnerLoop st startf

1357+ return $ D.Yield x (InnerLoop st contents cur start)

1263− (p `plusPtr` negate (sizeOf (undefined :: a))) end)

1264

1358

1265-------------------------------------------------------------------------------

1359-------------------------------------------------------------------------------

1266-- Unfolds

1360-- Unfolds

1267-------------------------------------------------------------------------------

1361-------------------------------------------------------------------------------

1268

1362

1269data ReadUState a = ReadUState

1363data ReadUState a = ReadUState

1270− {-# UNPACK #-} !(ForeignPtr a) -- foreign ptr with end of array pointer

1364+ UNPACKIF !ArrayContents -- contents

1365+ !(Ptr a) -- end address

1271− {-# UNPACK #-} !(Ptr a) -- current pointer

1366+ !(Ptr a) -- current address

1367+

1368+toReadUState :: Array a -> ReadUState a

1369+toReadUState (Array contents start end _) = ReadUState contents end start

1272

1370

1273-- | Resumable unfold of an array.

1371-- | Resumable unfold of an array.

1274--

1372--

1275{-# INLINE_NORMAL producer #-}

1373{-# INLINE_NORMAL producer #-}

1276producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a

1374producer :: 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

1278 where

1376 where

1279

1377

1280− inject (Array (ForeignPtr start contents) (Ptr end) _) =

1281− return $ ReadUState (ForeignPtr end contents) (Ptr start)

1282−

1283 {-# INLINE_LATE step #-}

1378 {-# INLINE_LATE step #-}

1284− step (ReadUState fp@(ForeignPtr end _) p)

1379+ step (ReadUState contents end cur)

1285− | assert (p <= Ptr end) (p == Ptr end) =

1380+ | assert (cur <= end) (cur == end) =

1286− let x = unsafeInlineIO $ touchForeignPtr fp

1381+ let x = unsafeInlineIO $ touch contents

1287 in x `seq` return D.Stop

1382 in x `seq` return D.Stop

1288− step (ReadUState fp p) = do

1383+ step (ReadUState contents end cur) = do

1289 -- unsafeInlineIO allows us to run this in Identity monad for pure

1384 -- unsafeInlineIO allows us to run this in Identity monad for pure

1290 -- toList/foldr case which makes them much faster due to not

1385 -- toList/foldr case which makes them much faster due to not

1291 -- accumulating the list and fusing better with the pure consumers.

1386 -- accumulating the list and fusing better with the pure consumers.

1292 --

1387 --

1293 -- This should be safe as the array contents are guaranteed to be

1388 -- This should be safe as the array contents are guaranteed to be

1294 -- evaluated/written to before we peek at them.

1389 -- evaluated/written to before we peek at them.

1295− let !x = unsafeInlineIO $ peek p

1390+ let !x = unsafeInlineIO $ peek cur

1296− return $ D.Yield x

1297− (ReadUState fp (p `plusPtr` sizeOf (undefined :: a)))

1391+ cur1 = cur `plusPtr` sizeOf (undefined :: a)

1392+ return $ D.Yield x (ReadUState contents end cur1)

1298

1393

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

1301

1395

1302-- | Unfold an array into a stream.

1396-- | Unfold an array into a stream.

1303--

1397--

@@ -1314,15 +1408,15 @@ readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a

1314readRev = Unfold step inject

1408readRev = Unfold step inject

1315 where

1409 where

1316

1410

1317− inject (Array fp end _) =

1411+ inject (Array contents start end _) =

1318 let p = end `plusPtr` negate (sizeOf (undefined :: a))

1412 let p = end `plusPtr` negate (sizeOf (undefined :: a))

1319− in return $ ReadUState fp p

1413+ in return $ ReadUState contents start p

1320

1414

1321 {-# INLINE_LATE step #-}

1415 {-# INLINE_LATE step #-}

1322− step (ReadUState fp@(ForeignPtr start _) p) | p < Ptr start =

1416+ step (ReadUState contents start p) | p < start =

1323− let x = unsafeInlineIO $ touchForeignPtr fp

1417+ let x = unsafeInlineIO $ touch contents

1324 in x `seq` return D.Stop

1418 in x `seq` return D.Stop

1325− step (ReadUState fp p) = do

1419+ step (ReadUState contents start p) = do

1326 -- unsafeInlineIO allows us to run this in Identity monad for pure

1420 -- unsafeInlineIO allows us to run this in Identity monad for pure

1327 -- toList/foldr case which makes them much faster due to not

1421 -- toList/foldr case which makes them much faster due to not

1328 -- accumulating the list and fusing better with the pure consumers.

1422 -- accumulating the list and fusing better with the pure consumers.

@@ -1330,8 +1424,8 @@ readRev = Unfold step inject

1330 -- This should be safe as the array contents are guaranteed to be

1424 -- This should be safe as the array contents are guaranteed to be

1331 -- evaluated/written to before we peek at them.

1425 -- evaluated/written to before we peek at them.

1332 let !x = unsafeInlineIO $ peek p

1426 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)

1335

1429

1336-------------------------------------------------------------------------------

1430-------------------------------------------------------------------------------

1337-- to Lists and streams

1431-- to Lists and streams

@@ -1341,7 +1435,7 @@ readRev = Unfold step inject

1341-- This can be useful when using the IsList instance

1435-- This can be useful when using the IsList instance

1342{-# INLINE_LATE toListFB #-}

1436{-# INLINE_LATE toListFB #-}

1343toListFB :: forall a b. Storable a => (a -> b -> b) -> b -> Array a -> b

1437toListFB :: 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

1345 where

1439 where

1346

1440

1347 go p | assert (p <= aEnd) (p == aEnd) = n

1441 go p | assert (p <= aEnd) (p == aEnd) = n

@@ -1355,7 +1449,7 @@ toListFB c n Array{..} = go (unsafeForeignPtrToPtr aStart)

1355 -- XXX

1449 -- XXX

1356 let !x = unsafeInlineIO $ do

1450 let !x = unsafeInlineIO $ do

1357 r <- peek p

1451 r <- peek p

1358− touchForeignPtr aStart

1452+ touch arrContents

1359 return r

1453 return r

1360 in c x (go (p `plusPtr` sizeOf (undefined :: a)))

1454 in c x (go (p `plusPtr` sizeOf (undefined :: a)))

1361

1455

@@ -1375,7 +1469,7 @@ toList s = build (\c n -> toListFB c n s)

1375{-# INLINE_NORMAL toStreamD #-}

1469{-# INLINE_NORMAL toStreamD #-}

1376toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

1470toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

1377toStreamD Array{..} =

1471toStreamD Array{..} =

1378− let p = unsafeForeignPtrToPtr aStart

1472+ let p = arrStart

1379 in D.Stream step p

1473 in D.Stream step p

1380

1474

1381 where

1475 where

@@ -1394,14 +1488,14 @@ toStreamD Array{..} =

1394 --

1488 --

1395 let !x = unsafeInlineIO $ do

1489 let !x = unsafeInlineIO $ do

1396 r <- peek p

1490 r <- peek p

1397− touchForeignPtr aStart

1491+ touch arrContents

1398 return r

1492 return r

1399 return $ D.Yield x (p `plusPtr` sizeOf (undefined :: a))

1493 return $ D.Yield x (p `plusPtr` sizeOf (undefined :: a))

1400

1494

1401{-# INLINE toStreamK #-}

1495{-# INLINE toStreamK #-}

1402toStreamK :: forall m a. Storable a => Array a -> K.Stream m a

1496toStreamK :: forall m a. Storable a => Array a -> K.Stream m a

1403toStreamK Array{..} =

1497toStreamK Array{..} =

1404− let p = unsafeForeignPtrToPtr aStart

1498+ let p = arrStart

1405 in go p

1499 in go p

1406

1500

1407 where

1501 where

@@ -1412,7 +1506,7 @@ toStreamK Array{..} =

1412 -- XXX May not be safe for mutable arrays.

1506 -- XXX May not be safe for mutable arrays.

1413 let !x = unsafeInlineIO $ do

1507 let !x = unsafeInlineIO $ do

1414 r <- peek p

1508 r <- peek p

1415− touchForeignPtr aStart

1509+ touch arrContents

1416 return r

1510 return r

1417 in x `K.cons` go (p `plusPtr` sizeOf (undefined :: a))

1511 in x `K.cons` go (p `plusPtr` sizeOf (undefined :: a))

1418

1512

@@ -1430,13 +1524,13 @@ toStreamDRev Array{..} =

1430 where

1524 where

1431

1525

1432 {-# INLINE_LATE step #-}

1526 {-# INLINE_LATE step #-}

1433− step _ p | p < unsafeForeignPtrToPtr aStart = return D.Stop

1527+ step _ p | p < arrStart = return D.Stop

1434 step _ p = do

1528 step _ p = do

1435 -- See comments in toStreamD for why we use unsafeInlineIO

1529 -- See comments in toStreamD for why we use unsafeInlineIO

1436 -- XXX

1530 -- XXX

1437 let !x = unsafeInlineIO $ do

1531 let !x = unsafeInlineIO $ do

1438 r <- peek p

1532 r <- peek p

1439− touchForeignPtr aStart

1533+ touch arrContents

1440 return r

1534 return r

1441 return $ D.Yield x (p `plusPtr` negate (sizeOf (undefined :: a)))

1535 return $ D.Yield x (p `plusPtr` negate (sizeOf (undefined :: a)))

1442

1536

@@ -1448,12 +1542,12 @@ toStreamKRev Array {..} =

1448

1542

1449 where

1543 where

1450

1544

1451− go p | p < unsafeForeignPtrToPtr aStart = K.nil

1545+ go p | p < arrStart = K.nil

1452 | otherwise =

1546 | otherwise =

1453 -- XXX

1547 -- XXX

1454 let !x = unsafeInlineIO $ do

1548 let !x = unsafeInlineIO $ do

1455 r <- peek p

1549 r <- peek p

1456− touchForeignPtr aStart

1550+ touch arrContents

1457 return r

1551 return r

1458 in x `K.cons` go (p `plusPtr` negate (sizeOf (undefined :: a)))

1552 in x `K.cons` go (p `plusPtr` negate (sizeOf (undefined :: a)))

1459

1553

@@ -1481,8 +1575,17 @@ foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr

1481-------------------------------------------------------------------------------

1575-------------------------------------------------------------------------------

1482

1576

1483data ArrayUnsafe a = ArrayUnsafe

1577data ArrayUnsafe a = ArrayUnsafe

1578+ UNPACKIF !ArrayContents -- contents

1484− {-# UNPACK #-} !(ForeignPtr a) -- first address

1579+ {-# UNPACK #-} !(Ptr a) -- start address

1485− {-# UNPACK #-} !(Ptr a) -- first unused 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

1486

1589

1487-- Note: Arrays may be allocated with a specific alignment at the beginning of

1590-- Note: Arrays may be allocated with a specific alignment at the beginning of

1488-- the array. If you need to maintain that alignment on reallocations then you

1591-- 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) =>

1505 -> Int

1608 -> Int

1506 -> Fold m a (Array a)

1609 -> Fold m a (Array a)

1507appendNUnsafe action n =

1610appendNUnsafe action n =

1508− fmap extract $ FL.foldlM' step initial

1611+ fmap fromArrayUnsafe $ FL.foldlM' step initial

1509

1612

1510 where

1613 where

1511

1614

1512 initial = do

1615 initial = do

1513 assert (n >= 0) (return ())

1616 assert (n >= 0) (return ())

1514− arr@(Array _ end bound) <- action

1617+ arr@(Array _ _ end bound) <- action

1515 let free = bound `minusPtr` end

1618 let free = bound `minusPtr` end

1516 elemSize = sizeOf (undefined :: a)

1619 elemSize = sizeOf (undefined :: a)

1517 needed = n * elemSize

1620 needed = n * elemSize

1518 -- XXX We can also reallocate if the array has too much free space,

1621 -- XXX We can also reallocate if the array has too much free space,

1519 -- otherwise we lose that space.

1622 -- otherwise we lose that space.

1520− (Array start1 end1 _) <-

1623+ arr1 <-

1521 if free < needed

1624 if free < needed

1522 then noinline reallocWith "appendNUnsafeWith" (+ needed) needed arr

1625 then noinline reallocWith "appendNUnsafeWith" (+ needed) needed arr

1523 else return arr

1626 else return arr

1524− return $ ArrayUnsafe start1 end1

1627+ return $ toArrayUnsafe arr1

1525−

1526− step (ArrayUnsafe start end) x = do

1527− liftIO $ poke end x >> touchForeignPtr start

1528− return $ ArrayUnsafe start (end `plusPtr` sizeOf (undefined :: a))

1529

1628

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

1531

1633

1532-- | Append @n@ elements to an existing array. Any free space left in the array

1634-- | Append @n@ elements to an existing array. Any free space left in the array

1533-- after appending @n@ elements is lost.

1635-- after appending @n@ elements is lost.

@@ -1634,27 +1736,17 @@ writeNAlignedUnmanaged align = writeNWith (newArrayAlignedUnmanaged align)

1634{-# INLINE_NORMAL writeNWithUnsafe #-}

1736{-# INLINE_NORMAL writeNWithUnsafe #-}

1635writeNWithUnsafe :: forall m a. (MonadIO m, Storable a)

1737writeNWithUnsafe :: forall m a. (MonadIO m, Storable a)

1636 => (Int -> m (Array a)) -> Int -> Fold m a (Array a)

1738 => (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)

1638

1740

1639 where

1741 where

1640

1742

1641− initial = do

1743+ initial = FL.Partial . toArrayUnsafe <$> alloc (max n 0)

1642− (Array start end _) <- alloc (max n 0)

1643− return $ FL.Partial $ ArrayUnsafe start end

1644

1744

1645− -- This condition is always true, but compiler does not know that.

1646− step (ArrayUnsafe start end) x | end /= nullPtr = do

1745+ step (ArrayUnsafe contents start end) x = do

1647− liftIO $ poke end x

1746+ liftIO $ poke end x >> touch contents

1648 return

1747 return

1649 $ FL.Partial

1748 $ FL.Partial

1650− $ ArrayUnsafe start (end `plusPtr` sizeOf (undefined :: a))

1749+ $ ArrayUnsafe contents 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

1658

1750

1659-- | Like 'writeN' but does not check the array bounds when writing. The fold

1751-- | Like 'writeN' but does not check the array bounds when writing. The fold

1660-- driver must not call the step function more than 'n' times otherwise it will

1752-- driver must not call the step function more than 'n' times otherwise it will

@@ -1725,17 +1817,17 @@ writeWith elemCount =

1725

1817

1726 where

1818 where

1727

1819

1728− insertElem (Array start end bound) x = do

1820+ insertElem (Array contents start end bound) x = do

1729 liftIO $ poke end x

1821 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

1731

1824

1732 initial = do

1825 initial = do

1733 when (elemCount < 0) $ error "writeWith: elemCount is negative"

1826 when (elemCount < 0) $ error "writeWith: elemCount is negative"

1734 liftIO $ newArrayAligned (alignment (undefined :: a)) elemCount

1827 liftIO $ newArrayAligned (alignment (undefined :: a)) elemCount

1735− step arr@(Array start end bound) x

1828+ step arr@(Array _ start end bound) x

1736 | end `plusPtr` sizeOf (undefined :: a) > bound = do

1829 | end `plusPtr` sizeOf (undefined :: a) > bound = do

1737− let p = unsafeForeignPtrToPtr start

1738− oldSize = end `minusPtr` p

1830+ let oldSize = end `minusPtr` start

1739 newSize = max (oldSize * 2) 1

1831 newSize = max (oldSize * 2) 1

1740 arr1 <-

1832 arr1 <-

1741 liftIO

1833 liftIO

@@ -1842,21 +1934,21 @@ fromList xs = fromStreamD $ D.fromList xs

1842{-# INLINE spliceCopy #-}

1934{-# INLINE spliceCopy #-}

1843spliceCopy :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)

1935spliceCopy :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)

1844spliceCopy arr1 arr2 = do

1936spliceCopy arr1 arr2 = do

1845− let src1 = unsafeForeignPtrToPtr (aStart arr1)

1937+ let src1 = arrStart arr1

1846− src2 = unsafeForeignPtrToPtr (aStart arr2)

1938+ src2 = arrStart arr2

1847 len1 = aEnd arr1 `minusPtr` src1

1939 len1 = aEnd arr1 `minusPtr` src1

1848 len2 = aEnd arr2 `minusPtr` src2

1940 len2 = aEnd arr2 `minusPtr` src2

1849

1941

1850 arr <- liftIO $ newArray (len1 + len2)

1942 arr <- liftIO $ newArray (len1 + len2)

1851− let dst = unsafeForeignPtrToPtr (aStart arr)

1943+ let dst = arrStart arr

1852

1944

1853 -- XXX Should we use copyMutableByteArray# instead? Is there an overhead to

1945 -- XXX Should we use copyMutableByteArray# instead? Is there an overhead to

1854 -- ccall?

1946 -- ccall?

1855 liftIO $ do

1947 liftIO $ do

1856 memcpy (castPtr dst) (castPtr src1) len1

1948 memcpy (castPtr dst) (castPtr src1) len1

1857− touchForeignPtr (aStart arr1)

1949+ touch (arrContents arr1)

1858 memcpy (castPtr (dst `plusPtr` len1)) (castPtr src2) len2

1950 memcpy (castPtr (dst `plusPtr` len1)) (castPtr src2) len2

1859− touchForeignPtr (aStart arr2)

1951+ touch (arrContents arr2)

1860 return arr { aEnd = dst `plusPtr` (len1 + len2) }

1952 return arr { aEnd = dst `plusPtr` (len1 + len2) }

1861

1953

1862-- | Really really unsafe, appends the second array into the first array. If

1954-- | Really really unsafe, appends the second array into the first array. If

@@ -1866,12 +1958,13 @@ spliceCopy arr1 arr2 = do

1866spliceUnsafe :: MonadIO m => Array a -> (Array a, Int) -> m (Array a)

1958spliceUnsafe :: MonadIO m => Array a -> (Array a, Int) -> m (Array a)

1867spliceUnsafe dst (src, srcLen) =

1959spliceUnsafe dst (src, srcLen) =

1868 liftIO $ do

1960 liftIO $ do

1869− unsafeWithForeignPtr (aStart dst) $ \_ ->

1961+ let psrc = arrStart src

1870− unsafeWithForeignPtr (aStart src) $ \psrc -> do

1871− let pdst = aEnd dst

1962+ let pdst = aEnd dst

1872− assert (pdst `plusPtr` srcLen <= aBound dst) (return ())

1963+ assert (pdst `plusPtr` srcLen <= aBound dst) (return ())

1873− memcpy (castPtr pdst) (castPtr psrc) srcLen

1964+ memcpy (castPtr pdst) (castPtr psrc) srcLen

1965+ touch (arrContents src)

1966+ touch (arrContents dst)

1874− return $ dst {aEnd = pdst `plusPtr` srcLen}

1967+ return $ dst {aEnd = pdst `plusPtr` srcLen}

1875

1968

1876-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no

1969-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no

1877-- reserved space available in @dst@ it is reallocated to a size determined by

1970-- reserved space available in @dst@ it is reallocated to a size determined by

@@ -1884,19 +1977,18 @@ spliceUnsafe dst (src, srcLen) =

1884{-# INLINE spliceWith #-}

1977{-# INLINE spliceWith #-}

1885spliceWith :: forall m a. (MonadIO m, Storable a) =>

1978spliceWith :: forall m a. (MonadIO m, Storable a) =>

1886 (Int -> Int -> Int) -> Array a -> Array a -> m (Array a)

1979 (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

1888{-

1981{-

1889 let f = appendWith (`sizer` byteLength src) (return dst)

1982 let f = appendWith (`sizer` byteLength src) (return dst)

1890 in D.fold f (toStreamD src)

1983 in D.fold f (toStreamD src)

1891-}

1984-}

1892 assert (end <= bound) (return ())

1985 assert (end <= bound) (return ())

1893− let srcLen = aEnd src `minusPtr` unsafeForeignPtrToPtr (aStart src)

1986+ let srcLen = aEnd src `minusPtr` arrStart src

1894

1987

1895 dst1 <-

1988 dst1 <-

1896 if end `plusPtr` srcLen >= bound

1989 if end `plusPtr` srcLen >= bound

1897 then do

1990 then do

1898− let oldStart = unsafeForeignPtrToPtr start

1899− oldSize = end `minusPtr` oldStart

1991+ let oldSize = end `minusPtr` start

1900 newSize = sizer oldSize srcLen

1992 newSize = sizer oldSize srcLen

1901 when (newSize < oldSize + srcLen)

1993 when (newSize < oldSize + srcLen)

1902 $ error

1994 $ error

@@ -1943,19 +2035,21 @@ spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))

1943breakOn :: MonadIO m

2035breakOn :: MonadIO m

1944 => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))

2036 => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))

1945breakOn sep arr@Array{..} = liftIO $ do

2037breakOn sep arr@Array{..} = liftIO $ do

1946− let p = unsafeForeignPtrToPtr aStart

2038+ let p = arrStart

1947 loc <- c_memchr p sep (fromIntegral $ aEnd `minusPtr` p)

2039 loc <- c_memchr p sep (fromIntegral $ aEnd `minusPtr` p)

1948 return $

2040 return $

1949 if loc == nullPtr

2041 if loc == nullPtr

1950 then (arr, Nothing)

2042 then (arr, Nothing)

1951 else

2043 else

1952 ( Array

2044 ( Array

1953− { aStart = aStart

2045+ { arrContents = arrContents

2046+ , arrStart = arrStart

1954 , aEnd = loc

2047 , aEnd = loc

1955 , aBound = loc

2048 , aBound = loc

1956 }

2049 }

1957 , Just $ Array

2050 , Just $ Array

1958− { aStart = aStart `plusForeignPtr` (loc `minusPtr` p + 1)

2051+ { arrContents = arrContents

2052+ , arrStart = arrStart `plusPtr` (loc `minusPtr` p + 1)

1959 , aEnd = aEnd

2053 , aEnd = aEnd

1960 , aBound = aBound

2054 , aBound = aBound

1961 }

2055 }

@@ -1974,14 +2068,16 @@ splitAt i arr@Array{..} =

1974 then error $ "sliceAt: specified array index " ++ show i

2068 then error $ "sliceAt: specified array index " ++ show i

1975 ++ " is beyond the maximum index " ++ show maxIndex

2069 ++ " is beyond the maximum index " ++ show maxIndex

1976 else let off = i * sizeOf (undefined :: a)

2070 else let off = i * sizeOf (undefined :: a)

1977− p = unsafeForeignPtrToPtr aStart `plusPtr` off

2071+ p = arrStart `plusPtr` off

1978 in ( Array

2072 in ( Array

1979− { aStart = aStart

2073+ { arrContents = arrContents

2074+ , arrStart = arrStart

1980 , aEnd = p

2075 , aEnd = p

1981 , aBound = p

2076 , aBound = p

1982 }

2077 }

1983 , Array

2078 , Array

1984− { aStart = aStart `plusForeignPtr` off

2079+ { arrContents = arrContents

2080+ , arrStart = arrStart `plusPtr` off

1985 , aEnd = aEnd

2081 , aEnd = aEnd

1986 , aBound = aBound

2082 , aBound = aBound

1987 }

2083 }

@@ -2003,8 +2099,8 @@ castUnsafe ::

2003 Storable b =>

2099 Storable b =>

2004#endif

2100#endif

2005 Array a -> Array b

2101 Array a -> Array b

2006−castUnsafe (Array start end bound) =

2102+castUnsafe (Array contents start end bound) =

2007− Array (castForeignPtr start) (castPtr end) (castPtr bound)

2103+ Array contents (castPtr start) (castPtr end) (castPtr bound)

2008

2104

2009-- | Cast an @Array a@ into an @Array Word8@.

2105-- | Cast an @Array a@ into an @Array Word8@.

2010--

2106--

@@ -2035,7 +2131,7 @@ cast arr =

2035--

2131--

2036asPtrUnsafe :: Array a -> (Ptr b -> IO c) -> IO c

2132asPtrUnsafe :: Array a -> (Ptr b -> IO c) -> IO c

2037asPtrUnsafe Array{..} act = do

2133asPtrUnsafe Array{..} act = do

2038− unsafeWithForeignPtr aStart $ \ptr -> act (castPtr ptr)

2134+ unsafeWithArrayContents arrContents arrStart $ \ptr -> act (castPtr ptr)

2039

2135

2040-------------------------------------------------------------------------------

2136-------------------------------------------------------------------------------

2041-- Equality

2137-- Equality

@@ -2048,8 +2144,8 @@ asPtrUnsafe Array{..} act = do

2048cmp :: MonadIO m => Array a -> Array a -> m Bool

2144cmp :: MonadIO m => Array a -> Array a -> m Bool

2049cmp arr1 arr2 =

2145cmp arr1 arr2 =

2050 liftIO $ do

2146 liftIO $ do

2051− let ptr1 = unsafeForeignPtrToPtr $ aStart arr1

2147+ let ptr1 = arrStart arr1

2052− let ptr2 = unsafeForeignPtrToPtr $ aStart arr2

2148+ let ptr2 = arrStart arr2

2053 let len1 = aEnd arr1 `minusPtr` ptr1

2149 let len1 = aEnd arr1 `minusPtr` ptr1

2054 let len2 = aEnd arr2 `minusPtr` ptr2

2150 let len2 = aEnd arr2 `minusPtr` ptr2

2055

2151

@@ -2059,8 +2155,8 @@ cmp arr1 arr2 =

2059 then return True

2155 then return True

2060 else do

2156 else do

2061 r <- memcmp (castPtr ptr1) (castPtr ptr2) len1

2157 r <- memcmp (castPtr ptr1) (castPtr ptr2) len1

2062− touchForeignPtr $ aStart arr1

2158+ touch (arrContents arr1)

2063− touchForeignPtr $ aStart arr2

2159+ touch (arrContents arr2)

2064 return r

2160 return r

2065 else return False

2161 else return False

2066

2162

src/Streamly/Internal/Data/Array/Foreign/Type.hs+16−13

@@ -83,12 +83,13 @@ import Foreign.Ptr (plusPtr, castPtr)

83import Foreign.Storable (Storable(..))

84import GHC.Base (Addr#, nullAddr#)

85import GHC.Exts (IsList, IsString(..))

86−import GHC.ForeignPtr (ForeignPtr(..), newForeignPtr_)

86+

87#ifdef DEVBUILD

88import GHC.ForeignPtr (touchForeignPtr, unsafeForeignPtrToPtr)

89#endif

90import GHC.IO (unsafePerformIO)

91import GHC.Ptr (Ptr(..))

92+import Streamly.Internal.Data.Array.Foreign.Mut.Type (ArrayContents)

92import Streamly.Internal.Data.Fold.Type (Fold(..))

93import Streamly.Internal.Data.Fold.Type (Fold(..))

93import Streamly.Internal.Data.Stream.Serial (SerialT(..))

94import Streamly.Internal.Data.Stream.Serial (SerialT(..))

94import Streamly.Internal.Data.Unfold.Type (Unfold(..))

95import Streamly.Internal.Data.Unfold.Type (Unfold(..))

@@ -137,7 +138,12 @@ data Array a =

137 Storable a =>

138 Storable a =>

138#endif

139#endif

139 Array

140 Array

141+ { arrContents ::

142+#ifndef USE_FOREIGN_PTR

143+ {-# UNPACK #-}

144+#endif

145+ !ArrayContents -- ^ first address

140− { aStart :: {-# UNPACK #-} !(ForeignPtr a) -- first address

146+ , arrStart :: {-# UNPACK #-} !(Ptr a) -- start address

141 , aEnd :: {-# UNPACK #-} !(Ptr a) -- first unused addres

147 , aEnd :: {-# UNPACK #-} !(Ptr a) -- first unused addres

142 }

148 }

143

149

@@ -167,15 +173,15 @@ foreign import ccall unsafe "string.h strlen" c_strlen

167-- /Pre-release/

173-- /Pre-release/

168{-# INLINE unsafeFreeze #-}

174{-# INLINE unsafeFreeze #-}

169unsafeFreeze :: MA.Array a -> Array a

175unsafeFreeze :: MA.Array a -> Array a

170−unsafeFreeze (MA.Array as ae _) = Array as ae

176+unsafeFreeze (MA.Array ac as ae _) = Array ac as ae

171

177

172-- | Similar to 'unsafeFreeze' but uses 'MA.rightSize' on the mutable array

178-- | Similar to 'unsafeFreeze' but uses 'MA.rightSize' on the mutable array

173-- first.

179-- first.

174{-# INLINE unsafeFreezeWithShrink #-}

180{-# INLINE unsafeFreezeWithShrink #-}

175unsafeFreezeWithShrink :: Storable a => MA.Array a -> Array a

181unsafeFreezeWithShrink :: Storable a => MA.Array a -> Array a

176unsafeFreezeWithShrink arr = unsafePerformIO $ do

182unsafeFreezeWithShrink arr = unsafePerformIO $ do

177− MA.Array as ae _ <- MA.rightSize arr

183+ MA.Array ac as ae _ <- MA.rightSize arr

178− return $ Array as ae

184+ return $ Array ac as ae

179

185

180-- | Makes a mutable array using the underlying memory of the immutable array.

186-- | Makes a mutable array using the underlying memory of the immutable array.

181--

187--

@@ -187,7 +193,7 @@ unsafeFreezeWithShrink arr = unsafePerformIO $ do

187-- /Pre-release/

193-- /Pre-release/

188{-# INLINE unsafeThaw #-}

194{-# INLINE unsafeThaw #-}

189unsafeThaw :: Array a -> MA.Array a

195unsafeThaw :: Array a -> MA.Array a

190−unsafeThaw (Array as ae) = MA.Array as ae ae

196+unsafeThaw (Array ac as ae) = MA.Array ac as ae ae

191

197

192-------------------------------------------------------------------------------

198-------------------------------------------------------------------------------

193-- Construction

199-- Construction

@@ -220,11 +226,11 @@ fromPtr ::

220#endif

226#endif

221 Int -> Ptr a -> Array a

227 Int -> Ptr a -> Array a

222fromPtr n ptr = unsafeInlineIO $ do

228fromPtr n ptr = unsafeInlineIO $ do

223− fptr <- newForeignPtr_ ptr

224 let end = ptr `plusPtr` n

229 let end = ptr `plusPtr` n

225 return $ Array

230 return $ Array

226− { aStart = fptr

231+ { arrContents = MA.nilArrayContents

232+ , arrStart = ptr

227− , aEnd = end

233+ , aEnd = end

228 }

234 }

229

235

230-- XXX when converting an array of Word8 from a literal string we can simply

236-- XXX when converting an array of Word8 from a literal string we can simply

@@ -672,15 +678,12 @@ instance Foldable Array where

672instance Storable a => Semigroup (Array a) where

678instance Storable a => Semigroup (Array a) where

673 arr1 <> arr2 = unsafePerformIO $ splice arr1 arr2

679 arr1 <> arr2 = unsafePerformIO $ splice arr1 arr2

674

680

675−nullForeignPtr :: ForeignPtr a

676−nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr")

677−

678nil ::

681nil ::

679#ifdef DEVBUILD

682#ifdef DEVBUILD

680 Storable a =>

683 Storable a =>

681#endif

684#endif

682 Array a

685 Array a

683−nil = Array nullForeignPtr (Ptr nullAddr#)

686+nil = Array MA.nilArrayContents (Ptr nullAddr#) (Ptr nullAddr#)

684

687

685instance Storable a => Monoid (Array a) where

688instance Storable a => Monoid (Array a) where

686 mempty = nil

689 mempty = nil

src/Streamly/Internal/Data/Array/Stream/Fold/Foreign.hs+12−14

@@ -55,12 +55,10 @@ import Control.Applicative (liftA2)

55import Control.Exception (assert)

56import Control.Monad.Catch (MonadThrow)

57import Control.Monad.IO.Class (MonadIO(..))

58−import Foreign.ForeignPtr (touchForeignPtr)

59import Foreign.Ptr (minusPtr, plusPtr)

58import Foreign.Ptr (minusPtr, plusPtr)

60import Foreign.Storable (Storable(..))

59import Foreign.Storable (Storable(..))

61−import GHC.ForeignPtr (ForeignPtr(..))

62−import GHC.Ptr (Ptr(..))

63import GHC.Types (SPEC(..))

60import GHC.Types (SPEC(..))

61+import Streamly.Internal.Data.Array.Foreign.Mut.Type (touch)

64import Streamly.Internal.Data.Array.Foreign.Type (Array(..))

62import Streamly.Internal.Data.Array.Foreign.Type (Array(..))

65import Streamly.Internal.Data.Parser.ParserD (Initial(..), Step(..))

63import Streamly.Internal.Data.Parser.ParserD (Initial(..), Step(..))

66import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))

64import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))

@@ -108,14 +106,14 @@ fromFold (Fold.Fold fstep finitial fextract) =

108 Fold.Partial s1 -> IPartial s1

106 Fold.Partial s1 -> IPartial s1

109 Fold.Done b -> IDone b

107 Fold.Done b -> IDone b

110

108

111− step s (Array fp@(ForeignPtr start _) end) = do

109+ step s (Array contents start end) = do

112− goArray SPEC (Ptr start) s

110+ goArray SPEC start s

113

111

114 where

112 where

115

113

116 goArray !_ !cur !fs | cur >= end = do

114 goArray !_ !cur !fs | cur >= end = do

117 assert (cur == end) (return ())

115 assert (cur == end) (return ())

118− liftIO $ touchForeignPtr fp

116+ liftIO $ touch contents

119 return $ Partial 0 fs

117 return $ Partial 0 fs

120 goArray !_ !cur !fs = do

118 goArray !_ !cur !fs = do

121 x <- liftIO $ peek cur

119 x <- liftIO $ peek cur

@@ -140,23 +138,23 @@ fromParser (ParserD.Parser step1 initial1 extract1) =

140

138

141 where

139 where

142

140

143− step s (Array fp@(ForeignPtr start _) end) = do

141+ step s (Array contents start end) = do

144− if Ptr start >= end

142+ if start >= end

145 then return $ Continue 0 s

143 then return $ Continue 0 s

146− else goArray SPEC (Ptr start) s

144+ else goArray SPEC start s

147

145

148 where

146 where

149

147

150 {-# INLINE partial #-}

148 {-# INLINE partial #-}

151 partial arrRem cur next elemSize st n fs1 = do

149 partial arrRem cur next elemSize st n fs1 = do

152 let next1 = next `plusPtr` negate (n * elemSize)

150 let next1 = next `plusPtr` negate (n * elemSize)

153− if next1 >= Ptr start && cur < end

151+ if next1 >= start && cur < end

154 then goArray SPEC next1 fs1

152 then goArray SPEC next1 fs1

155 else return $ st (arrRem + n) fs1

153 else return $ st (arrRem + n) fs1

156

154

157 goArray !_ !cur !fs = do

155 goArray !_ !cur !fs = do

158 x <- liftIO $ peek cur

156 x <- liftIO $ peek cur

159− liftIO $ touchForeignPtr fp

157+ liftIO $ touch contents

160 res <- step1 fs x

158 res <- step1 fs x

161 let elemSize = sizeOf (undefined :: a)

159 let elemSize = sizeOf (undefined :: a)

162 next = cur `plusPtr` elemSize

160 next = cur `plusPtr` elemSize

@@ -321,10 +319,10 @@ take n (Fold (ParserD.Parser step1 initial1 extract1)) =

321 Done j b -> return $ Done j b

319 Done j b -> return $ Done j b

322 Error err -> return $ Error err

320 Error err -> return $ Error err

323 else do

321 else do

324− let !(Array (ForeignPtr start contents) _) = arr

322+ let !(Array contents start _) = arr

325 sz = sizeOf (undefined :: a)

323 sz = sizeOf (undefined :: a)

326− end = Ptr start `plusPtr` (i * sz)

324+ end = start `plusPtr` (i * sz)

327− arr1 = Array (ForeignPtr start contents) end

325+ arr1 = Array contents start end

328 remaining = negate i1

326 remaining = negate i1

329 res <- step1 r arr1

327 res <- step1 r arr1

330 case res of

328 case res of

src/Streamly/Internal/Data/Array/Stream/Foreign.hs+42−43

@@ -57,7 +57,6 @@ import Data.Semigroup (Semigroup(..))

57#endif

58import Data.Word (Word8)

59import Foreign.ForeignPtr (touchForeignPtr)

60−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

61import Foreign.Ptr (minusPtr, plusPtr, castPtr)

60import Foreign.Ptr (minusPtr, plusPtr, castPtr)

62import Foreign.Storable (Storable(..))

61import Foreign.Storable (Storable(..))

63import Fusion.Plugin.Types (Fuse(..))

62import Fusion.Plugin.Types (Fuse(..))

@@ -67,7 +66,8 @@ import GHC.Ptr (Ptr(..))

67import GHC.Types (SPEC(..))

66import GHC.Types (SPEC(..))

68import Prelude hiding (null, last, (!!), read, concat, unlines)

67import Prelude hiding (null, last, (!!), read, concat, unlines)

70−import Streamly.Internal.BaseCompat

69+import Streamly.Internal.Data.Array.Foreign.Mut.Type

70+ (arrayToFptrContents, fptrToArrayContents, touch)

71import Streamly.Internal.Data.Array.Foreign.Type (Array(..))

72import Streamly.Internal.Data.Fold.Type (Fold(..))

73import Streamly.Internal.Data.Parser (ParseError(..))

@@ -165,7 +165,7 @@ interposeSuffix x = S.interposeSuffix x A.read

165

166data FlattenState s a =

167 OuterLoop s

168− | InnerLoop s !(ForeignPtr a) !(Ptr a) !(Ptr a)

168+ | InnerLoop s !MA.ArrayContents !(Ptr a) !(Ptr a)

169

170{-# INLINE_NORMAL unlines #-}

171unlines :: forall m a. (MonadIO m, Storable a)

@@ -177,20 +177,19 @@ unlines sep (D.Stream step state) = D.Stream step' (OuterLoop state)

177 r <- step (adaptState gst) st

178 return $ case r of

179 D.Yield Array{..} s ->

180− let p = unsafeForeignPtrToPtr aStart

181− in D.Skip (InnerLoop s aStart p aEnd)

180+ D.Skip (InnerLoop s arrContents arrStart aEnd)

182 D.Skip s -> D.Skip (OuterLoop s)

181 D.Skip s -> D.Skip (OuterLoop s)

183 D.Stop -> D.Stop

182 D.Stop -> D.Stop

184

183

185 step' _ (InnerLoop st _ p end) | p == end =

184 step' _ (InnerLoop st _ p end) | p == end =

186 return $ D.Yield sep $ OuterLoop st

185 return $ D.Yield sep $ OuterLoop st

187

186

188− step' _ (InnerLoop st startf p end) = do

187+ step' _ (InnerLoop st contents p end) = do

189 x <- liftIO $ do

188 x <- liftIO $ do

190 r <- peek p

189 r <- peek p

191− touchForeignPtr startf

190+ touch contents

192 return r

191 return r

193− return $ D.Yield x (InnerLoop st startf

192+ return $ D.Yield x (InnerLoop st contents

194 (p `plusPtr` sizeOf (undefined :: a)) end)

193 (p `plusPtr` sizeOf (undefined :: a)) end)

195

194

196-------------------------------------------------------------------------------

195-------------------------------------------------------------------------------

@@ -329,8 +328,9 @@ foldD (Fold fstep initial extract) stream@(D.Stream step state) = do

329 go !_ st !fs = do

328 go !_ st !fs = do

330 r <- step defState st

329 r <- step defState st

331 case r of

330 case r of

332− D.Yield (Array (ForeignPtr start contents) (Ptr end)) s ->

331+ D.Yield (Array contents start (Ptr end)) s ->

332+ let fp = ForeignPtr end (arrayToFptrContents contents)

333− goArray SPEC s (ForeignPtr end contents) (Ptr start) fs

333+ in goArray SPEC s fp start fs

334 D.Skip s -> go SPEC s fs

335 D.Stop -> do

336 b <- extract fs

@@ -347,8 +347,7 @@ foldD (Fold fstep initial extract) stream@(D.Stream step state) = do

347 next = cur `plusPtr` elemSize

348 case res of

349 FL.Done b -> do

350− let !(Ptr curAddr) = next

351− arr = Array (ForeignPtr curAddr contents) (Ptr end)

350+ let arr = Array (fptrToArrayContents contents) next (Ptr end)

352 return $! (b, D.cons arr (D.Stream step st))

351 return $! (b, D.cons arr (D.Stream step st))

353 FL.Partial fs1 -> goArray SPEC st fp next fs1

352 FL.Partial fs1 -> goArray SPEC st fp next fs1

354

353

@@ -384,10 +383,10 @@ takeArrayListRev = go

384 then x : go (n - len) xs

383 then x : go (n - len) xs

385 else if n == len

384 else if n == len

386 then [x]

385 then [x]

387− else let !(Array (ForeignPtr _ contents) end) = x

386+ else let !(Array contents _ end) = x

388 sz = sizeOf (undefined :: a)

387 sz = sizeOf (undefined :: a)

389− !(Ptr start) = end `plusPtr` negate (n * sz)

388+ !start = end `plusPtr` negate (n * sz)

390− in [Array (ForeignPtr start contents) end]

389+ in [Array contents start end]

391

390

392-- When we have to take an array partially, take the last part of the array in

391-- When we have to take an array partially, take the last part of the array in

393-- the first split.

392-- the first split.

@@ -407,12 +406,11 @@ splitAtArrayListRev n ls

407 then (x:xs', xs'')

406 then (x:xs', xs'')

408 else if m == len

407 else if m == len

409 then ([x],xs)

408 then ([x],xs)

410− else let !(Array (ForeignPtr start contents) end) = x

409+ else let !(Array contents start end) = x

411 sz = sizeOf (undefined :: a)

410 sz = sizeOf (undefined :: a)

412 end1 = end `plusPtr` negate (m * sz)

411 end1 = end `plusPtr` negate (m * sz)

413− arr2 = Array (ForeignPtr start contents) end1

412+ arr2 = Array contents start end1

414− !(Ptr addrEnd1) = end1

413+ arr1 = Array contents end1 end

415− arr1 = Array (ForeignPtr addrEnd1 contents) end

416 in ([arr1], arr2:xs)

414 in ([arr1], arr2:xs)

417

415

418-------------------------------------------------------------------------------

416-------------------------------------------------------------------------------

@@ -434,11 +432,12 @@ spliceArraysLenUnsafe len buffered = do

434

432

435 where

433 where

436

434

437− writeArr dst (MA.Array as ae _) =

435+ writeArr dst (MA.Array ac src ae _) =

438− liftIO $ unsafeWithForeignPtr as $ \src -> do

436+ liftIO $ do

439− let count = ae `minusPtr` src

437+ let count = ae `minusPtr` src

440− memcpy (castPtr dst) (castPtr src) count

438+ memcpy (castPtr dst) (castPtr src) count

439+ touch ac

441− return $ dst `plusPtr` count

440+ return $ dst `plusPtr` count

442

441

443{-# INLINE _spliceArrays #-}

442{-# INLINE _spliceArrays #-}

444_spliceArrays :: (MonadIO m, Storable a)

443_spliceArrays :: (MonadIO m, Storable a)

@@ -452,11 +451,12 @@ _spliceArrays s = do

452

451

453 where

452 where

454

453

455− writeArr dst (Array as ae) =

454+ writeArr dst (Array ac src ae) =

456− liftIO $ unsafeWithForeignPtr as $ \src -> do

455+ liftIO $ do

457− let count = ae `minusPtr` src

456+ let count = ae `minusPtr` src

458− memcpy (castPtr dst) (castPtr src) count

457+ memcpy (castPtr dst) (castPtr src) count

458+ touch ac

459− return $ dst `plusPtr` count

459+ return $ dst `plusPtr` count

460

461{-# INLINE _spliceArraysBuffered #-}

462_spliceArraysBuffered :: (MonadIO m, Storable a)

@@ -546,8 +546,9 @@ parseD (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do

546 go !_ st backBuf !pst = do

547 r <- step defState st

548 case r of

549− D.Yield (Array (ForeignPtr start contents) (Ptr end)) s ->

549+ D.Yield (Array contents start (Ptr end)) s ->

550+ gobuf SPEC s backBuf

550− gobuf SPEC s backBuf (ForeignPtr end contents) (Ptr start) pst

551+ (ForeignPtr end (arrayToFptrContents contents)) start pst

551 D.Skip s -> go SPEC s backBuf pst

552 D.Skip s -> go SPEC s backBuf pst

552 D.Stop -> do

553 D.Stop -> do

553 b <- extract pst

554 b <- extract pst

@@ -570,33 +571,31 @@ parseD (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do

570 assert (n <= Prelude.length (x:getList backBuf)) (return ())

571 assert (n <= Prelude.length (x:getList backBuf)) (return ())

571 let src0 = Prelude.take n (x:getList backBuf)

572 let src0 = Prelude.take n (x:getList backBuf)

572 arr0 = A.fromListN n (Prelude.reverse src0)

573 arr0 = A.fromListN n (Prelude.reverse src0)

573− !(Ptr curAddr) = next

574− arr1 = Array (ForeignPtr curAddr contents) (Ptr end)

574+ arr1 = Array (fptrToArrayContents contents) next (Ptr end)

575 src = arr0 <> arr1

576− let !(Array (ForeignPtr start cont1) (Ptr end1)) = src

576+ let !(Array cont1 start (Ptr end1)) = src

577+ fp1 = ForeignPtr end1 (arrayToFptrContents cont1)

577− gobuf SPEC s (List []) (ForeignPtr end1 cont1) (Ptr start) pst1

578+ gobuf SPEC s (List []) fp1 start pst1

578 PR.Continue 0 pst1 ->

579 PR.Continue 0 pst1 ->

579 gobuf SPEC s (List (x:getList backBuf)) fp next pst1

580 gobuf SPEC s (List (x:getList backBuf)) fp next pst1

580 PR.Continue n pst1 -> do

581 PR.Continue n pst1 -> do

581 assert (n <= Prelude.length (x:getList backBuf)) (return ())

582 assert (n <= Prelude.length (x:getList backBuf)) (return ())

582 let (src0, buf1) = splitAt n (x:getList backBuf)

583 let (src0, buf1) = splitAt n (x:getList backBuf)

583 arr0 = A.fromListN n (Prelude.reverse src0)

584 arr0 = A.fromListN n (Prelude.reverse src0)

584− !(Ptr curAddr) = next

585− arr1 = Array (ForeignPtr curAddr contents) (Ptr end)

585+ arr1 = Array (fptrToArrayContents contents) next (Ptr end)

586 src = arr0 <> arr1

587− let !(Array (ForeignPtr start cont1) (Ptr end1)) = src

587+ let !(Array cont1 start (Ptr end1)) = src

588+ fp1 = ForeignPtr end1 (arrayToFptrContents cont1)

588− gobuf SPEC s (List buf1) (ForeignPtr end1 cont1) (Ptr start) pst1

589+ gobuf SPEC s (List buf1) fp1 start pst1

589 PR.Done 0 b -> do

590 PR.Done 0 b -> do

590− let !(Ptr curAddr) = next

591− arr = Array (ForeignPtr curAddr contents) (Ptr end)

591+ let arr = Array (fptrToArrayContents contents) next (Ptr end)

592 return (b, D.cons arr (D.Stream step s))

593 PR.Done n b -> do

594 assert (n <= Prelude.length (x:getList backBuf)) (return ())

595 let src0 = Prelude.take n (x:getList backBuf)

596 -- XXX create the array in reverse instead

597 arr0 = A.fromListN n (Prelude.reverse src0)

598− !(Ptr curAddr) = next

599− arr1 = Array (ForeignPtr curAddr contents) (Ptr end)

598+ arr1 = Array (fptrToArrayContents contents) next (Ptr end)

600 -- XXX Use StreamK to avoid adding arbitrary layers of

599 -- XXX Use StreamK to avoid adding arbitrary layers of

601 -- constructors every time.

600 -- constructors every time.

602 str = D.cons arr0 (D.cons arr1 (D.Stream step s))

601 str = D.cons arr0 (D.cons arr1 (D.Stream step s))

src/Streamly/Internal/FileSystem/FD.hs+5−3

@@ -132,7 +132,8 @@ import qualified GHC.IO.Device as RawIO

132

133import Streamly.Internal.Data.Array.Foreign.Type

134 (Array(..), byteLength, unsafeFreeze)

135−import Streamly.Internal.Data.Array.Foreign.Mut.Type (fromForeignPtrUnsafe)

135+import Streamly.Internal.Data.Array.Foreign.Mut.Type

136+ (fromForeignPtrUnsafe, unsafeWithArrayContents)

136import Streamly.Internal.System.IO (defaultChunkSize)

137import Streamly.Internal.System.IO (defaultChunkSize)

137import Streamly.Internal.Data.Stream.Serial (SerialT)

138import Streamly.Internal.Data.Stream.Serial (SerialT)

138import Streamly.Internal.Data.Stream.IsStream.Type

139import Streamly.Internal.Data.Stream.IsStream.Type

@@ -239,7 +240,8 @@ readArrayUpto size (Handle fd) = do

239{-# INLINABLE writeArray #-}

240{-# INLINABLE writeArray #-}

240writeArray :: Storable a => Handle -> Array a -> IO ()

241writeArray :: Storable a => Handle -> Array a -> IO ()

241writeArray _ arr | A.length arr == 0 = return ()

242writeArray _ arr | A.length arr == 0 = return ()

242−writeArray (Handle fd) arr = withForeignPtr (aStart arr) $ \p ->

243+writeArray (Handle fd) arr =

244+ unsafeWithArrayContents (arrContents arr) (arrStart arr) $ \p ->

243 -- RawIO.writeAll fd (castPtr p) aLen

245 -- RawIO.writeAll fd (castPtr p) aLen

244#if MIN_VERSION_base(4,15,0)

246#if MIN_VERSION_base(4,15,0)

245 RawIO.write fd (castPtr p) 0 aLen

247 RawIO.write fd (castPtr p) 0 aLen

@@ -264,7 +266,7 @@ writeArray (Handle fd) arr = withForeignPtr (aStart arr) $ \p ->

264writeIOVec :: Handle -> Array RawIO.IOVec -> IO ()

266writeIOVec :: Handle -> Array RawIO.IOVec -> IO ()

265writeIOVec _ iov | A.length iov == 0 = return ()

267writeIOVec _ iov | A.length iov == 0 = return ()

266writeIOVec (Handle fd) iov =

268writeIOVec (Handle fd) iov =

267− withForeignPtr (aStart iov) $ \p ->

269+ unsafeWithArrayContents (arrContents iov) (arrStart iov) $ \p ->

268 RawIO.writevAll fd p (A.length iov)

270 RawIO.writevAll fd p (A.length iov)

269#endif

271#endif

270

272

src/Streamly/Internal/FileSystem/Handle.hs+3−6

@@ -101,7 +101,6 @@ where

101import Control.Exception (assert)

102import Control.Monad.IO.Class (MonadIO(..))

103import Data.Word (Word8)

104−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

105import Foreign.ForeignPtr (withForeignPtr)

104import Foreign.ForeignPtr (withForeignPtr)

106import Foreign.Ptr (minusPtr, plusPtr)

105import Foreign.Ptr (minusPtr, plusPtr)

107import Foreign.Storable (Storable(..))

106import Foreign.Storable (Storable(..))

@@ -109,7 +108,7 @@ import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

109import System.IO (Handle, SeekMode(..), hGetBufSome, hPutBuf, hSeek)

108import System.IO (Handle, SeekMode(..), hGetBufSome, hPutBuf, hSeek)

110import Prelude hiding (read)

109import Prelude hiding (read)

111

110

112−import Streamly.Internal.BaseCompat

111+import Streamly.Internal.Data.Array.Foreign.Mut.Type (touch)

113import Streamly.Internal.Data.Fold (Fold)

112import Streamly.Internal.Data.Fold (Fold)

114import Streamly.Internal.Data.Refold.Type (Refold(..))

113import Streamly.Internal.Data.Refold.Type (Refold(..))

115import Streamly.Internal.Data.Unfold.Type (Unfold(..))

114import Streamly.Internal.Data.Unfold.Type (Unfold(..))

@@ -380,13 +379,11 @@ toBytes = AS.concat . toChunks

380putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()

379putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()

381putChunk _ arr | A.length arr == 0 = return ()

380putChunk _ arr | A.length arr == 0 = return ()

382putChunk h Array{..} =

381putChunk h Array{..} =

383− liftIO $ unsafeWithForeignPtr aStart $ \p -> hPutBuf h p aLen

382+ liftIO $ hPutBuf h arrStart aLen >> touch arrContents

384

383

385 where

384 where

386

385

387− aLen =

388− let p = unsafeForeignPtrToPtr aStart

389− in aEnd `minusPtr` p

386+ aLen = aEnd `minusPtr` arrStart

390

387

391-------------------------------------------------------------------------------

388-------------------------------------------------------------------------------

392-- Stream of Arrays IO

389-- Stream of Arrays IO

src/Streamly/Internal/Network/Socket.hs+7−7

@@ -68,7 +68,6 @@ import Control.Monad.IO.Class (MonadIO(..))

68import Control.Monad (forM_, when)

69import Data.Word (Word8)

71−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

72import Foreign.Ptr (minusPtr, plusPtr, Ptr, castPtr)

71import Foreign.Ptr (minusPtr, plusPtr, Ptr, castPtr)

73import Foreign.Storable (Storable(..))

72import Foreign.Storable (Storable(..))

74import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

73import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

@@ -87,7 +86,8 @@ import qualified Network.Socket as Net

88import Streamly.Internal.BaseCompat

87import Streamly.Internal.BaseCompat

89import Streamly.Internal.Control.Concurrent (MonadAsync)

88import Streamly.Internal.Control.Concurrent (MonadAsync)

90−import Streamly.Internal.Data.Array.Foreign.Mut.Type (fromForeignPtrUnsafe)

89+import Streamly.Internal.Data.Array.Foreign.Mut.Type

90+ (fromForeignPtrUnsafe, touch)

91import Streamly.Internal.Data.Array.Foreign.Type (Array(..))

92import Streamly.Internal.Data.Array.Stream.Foreign (lpackArraysChunksOf)

93import Streamly.Internal.Data.Fold (Fold)

@@ -305,12 +305,12 @@ writeArrayWith :: Storable a

305 -> Array a

306 -> IO ()

307writeArrayWith _ _ arr | A.length arr == 0 = return ()

308−writeArrayWith f h Array{..} = unsafeWithForeignPtr aStart $ \p ->

308+writeArrayWith f h Array{..} =

309− f h (castPtr p) aLen

309+ f h (castPtr arrStart) aLen >> touch arrContents

310+

310 where

311 where

311− aLen =

312+

312− let p = unsafeForeignPtrToPtr aStart

313− in aEnd `minusPtr` p

313+ aLen = aEnd `minusPtr` arrStart

314

315-- | Write an Array to a file handle.

316--

src/Streamly/Internal/Ring/Foreign.hs+2−2

@@ -127,7 +127,7 @@ unsafeEqArrayN :: Ring a -> Ptr a -> A.Array a -> Int -> Bool

127unsafeEqArrayN Ring{..} rh A.Array{..} n =

128 let !res = unsafeInlineIO $ do

129 let rs = unsafeForeignPtrToPtr ringStart

130− as = unsafeForeignPtrToPtr aStart

130+ as = arrStart

131 assert (aEnd `minusPtr` as >= ringBound `minusPtr` rs) (return ())

132 let len = ringBound `minusPtr` rh

133 r1 <- memcmp (castPtr rh) (castPtr as) (min len n)

@@ -153,7 +153,7 @@ unsafeEqArray :: Ring a -> Ptr a -> A.Array a -> Bool

153unsafeEqArray Ring{..} rh A.Array{..} =

154 let !res = unsafeInlineIO $ do

155 let rs = unsafeForeignPtrToPtr ringStart

156− let as = unsafeForeignPtrToPtr aStart

156+ let as = arrStart

157 assert (aEnd `minusPtr` as >= ringBound `minusPtr` rs)

158 (return ())

159 let len = ringBound `minusPtr` rh

src/Streamly/Internal/System/IOVec.hs+2−3

@@ -26,7 +26,6 @@ where

26#if !defined(mingw32_HOST_OS)

27import Control.Monad (when)

28import Control.Monad.IO.Class (MonadIO(..))

29−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

30import Foreign.Ptr (castPtr)

29import Foreign.Ptr (castPtr)

31import Streamly.Internal.Data.Array.Foreign.Mut.Type (length)

30import Streamly.Internal.Data.Array.Foreign.Mut.Type (length)

32import Streamly.Internal.Data.SVar (adaptState)

31import Streamly.Internal.Data.SVar (adaptState)

@@ -74,7 +73,7 @@ groupIOVecsOfMut n maxIOVLen (D.Stream step state) =

74 r <- step (adaptState gst) st

73 r <- step (adaptState gst) st

75 case r of

74 case r of

76 D.Yield arr s -> do

75 D.Yield arr s -> do

77− let p = unsafeForeignPtrToPtr (aStart arr)

76+ let p = arrStart arr

78 len = MArray.byteLength arr

77 len = MArray.byteLength arr

79 iov <- liftIO $ MArray.newArray maxIOVLen

78 iov <- liftIO $ MArray.newArray maxIOVLen

80 iov' <- liftIO $ MArray.snocUnsafe iov (IOVec (castPtr p)

79 iov' <- liftIO $ MArray.snocUnsafe iov (IOVec (castPtr p)

@@ -89,7 +88,7 @@ groupIOVecsOfMut n maxIOVLen (D.Stream step state) =

89 r <- step (adaptState gst) st

88 r <- step (adaptState gst) st

90 case r of

89 case r of

91 D.Yield arr s -> do

90 D.Yield arr s -> do

92− let p = unsafeForeignPtrToPtr (aStart arr)

91+ let p = arrStart arr

93 alen = MArray.byteLength arr

92 alen = MArray.byteLength arr

94 len' = len + alen

93 len' = len + alen

95 if len' > n || length iov >= maxIOVLen

94 if len' > n || length iov >= maxIOVLen

src/Streamly/Internal/Unicode/Stream.hs+16−24

@@ -81,16 +81,14 @@ import Control.Monad.IO.Class (MonadIO, liftIO)

81import Data.Bits (shiftR, shiftL, (.|.), (.&.))

82import Data.Char (chr, ord)

83import Data.Word (Word8)

84−import Foreign.ForeignPtr (touchForeignPtr)

85−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

86import Foreign.Storable (Storable(..))

84import Foreign.Storable (Storable(..))

87import Fusion.Plugin.Types (Fuse(..))

85import Fusion.Plugin.Types (Fuse(..))

88import GHC.Base (assert, unsafeChr)

86import GHC.Base (assert, unsafeChr)

89−import GHC.ForeignPtr (ForeignPtr (..))

90import GHC.IO.Encoding.Failure (isSurrogate)

87import GHC.IO.Encoding.Failure (isSurrogate)

91import GHC.Ptr (Ptr (..), plusPtr)

88import GHC.Ptr (Ptr (..), plusPtr)

92import System.IO.Unsafe (unsafePerformIO)

89import System.IO.Unsafe (unsafePerformIO)

93import Streamly.Internal.Data.Array.Foreign (Array)

90import Streamly.Internal.Data.Array.Foreign (Array)

91+import Streamly.Internal.Data.Array.Foreign.Mut.Type (ArrayContents, touch)

94import Streamly.Internal.Data.Fold (Fold)

92import Streamly.Internal.Data.Fold (Fold)

95import Streamly.Internal.Data.Stream.IsStream.Type

93import Streamly.Internal.Data.Stream.IsStream.Type

96 (IsStream, fromStreamD, toStreamD, adapt)

94 (IsStream, fromStreamD, toStreamD, adapt)

@@ -258,9 +256,8 @@ decode0 table byte =

258 where

256 where

259

257

260 utf8table =

258 utf8table =

261− let !(Ptr addr) = table

262− end = table `plusPtr` 364

259+ let end = table `plusPtr` 364

263− in A.Array (ForeignPtr addr undefined) end :: A.Array Word8

260+ in A.Array undefined table end :: A.Array Word8

264 showByte = "Streamly: decode0: byte: " ++ show byte

261 showByte = "Streamly: decode0: byte: " ++ show byte

265 showTable = " table: " ++ show utf8table

262 showTable = " table: " ++ show utf8table

266

263

@@ -285,9 +282,8 @@ decode1 table state codep byte =

285 where

282 where

286

283

287 utf8table =

284 utf8table =

288− let !(Ptr addr) = table

289− end = table `plusPtr` 364

285+ let end = table `plusPtr` 364

290− in A.Array (ForeignPtr addr undefined) end :: A.Array Word8

286+ in A.Array undefined table end :: A.Array Word8

291 showByte = "Streamly: decode1: byte: " ++ show byte

287 showByte = "Streamly: decode1: byte: " ++ show byte

292 showState st cp =

288 showState st cp =

293 " state: " ++ show st ++

289 " state: " ++ show st ++

@@ -318,8 +314,8 @@ resumeDecodeUtf8EitherD

318 -> Stream m Word8

314 -> Stream m Word8

319 -> Stream m (Either DecodeError Char)

315 -> Stream m (Either DecodeError Char)

320resumeDecodeUtf8EitherD dst codep (Stream step state) =

316resumeDecodeUtf8EitherD dst codep (Stream step state) =

321− let A.Array p _ = utf8d

317+ let A.Array _ p _ = utf8d

322− !ptr = unsafeForeignPtrToPtr p

318+ !ptr = p

323 stt =

319 stt =

324 if dst == 0

320 if dst == 0

325 then UTF8DecodeInit state

321 then UTF8DecodeInit state

@@ -437,8 +433,7 @@ replacementChar = '\xFFFD'

437decodeUtf8WithD :: Monad m

433decodeUtf8WithD :: Monad m

438 => CodingFailureMode -> Stream m Word8 -> Stream m Char

434 => CodingFailureMode -> Stream m Word8 -> Stream m Char

439decodeUtf8WithD cfm (Stream step state) =

435decodeUtf8WithD cfm (Stream step state) =

440− let A.Array p _ = utf8d

436+ let A.Array _ ptr _ = utf8d

441− !ptr = unsafeForeignPtrToPtr p

442 in Stream (step' ptr) (UTF8DecodeInit state)

437 in Stream (step' ptr) (UTF8DecodeInit state)

443

438

444 where

439 where

@@ -576,9 +571,9 @@ decodeUtf8Lax = decodeUtf8

576#endif

571#endif

577data FlattenState s a

572data FlattenState s a

578 = OuterLoop s !(Maybe (DecodeState, CodePoint))

573 = OuterLoop s !(Maybe (DecodeState, CodePoint))

579− | InnerLoopDecodeInit s (ForeignPtr a) !(Ptr a) !(Ptr a)

574+ | InnerLoopDecodeInit s ArrayContents !(Ptr a) !(Ptr a)

580− | InnerLoopDecodeFirst s (ForeignPtr a) !(Ptr a) !(Ptr a) Word8

575+ | InnerLoopDecodeFirst s ArrayContents !(Ptr a) !(Ptr a) Word8

581− | InnerLoopDecoding s (ForeignPtr a) !(Ptr a) !(Ptr a)

576+ | InnerLoopDecoding s ArrayContents !(Ptr a) !(Ptr a)

582 !DecodeState !CodePoint

577 !DecodeState !CodePoint

583 | YAndC !Char (FlattenState s a) -- These constructors can be

578 | YAndC !Char (FlattenState s a) -- These constructors can be

584 -- encoded in the UTF8DecodeState

579 -- encoded in the UTF8DecodeState

@@ -599,8 +594,7 @@ decodeUtf8ArraysWithD ::

599 -> Stream m (A.Array Word8)

594 -> Stream m (A.Array Word8)

600 -> Stream m Char

595 -> Stream m Char

601decodeUtf8ArraysWithD cfm (Stream step state) =

596decodeUtf8ArraysWithD cfm (Stream step state) =

602− let A.Array p _ = utf8d

597+ let A.Array _ ptr _ = utf8d

603− !ptr = unsafeForeignPtrToPtr p

604 in Stream (step' ptr) (OuterLoop state Nothing)

598 in Stream (step' ptr) (OuterLoop state Nothing)

605 where

599 where

606 {-# INLINE transliterateOrError #-}

600 {-# INLINE transliterateOrError #-}

@@ -624,8 +618,7 @@ decodeUtf8ArraysWithD cfm (Stream step state) =

624 return $

618 return $

625 case r of

619 case r of

626 Yield A.Array {..} s ->

620 Yield A.Array {..} s ->

627− let p = unsafeForeignPtrToPtr aStart

628− in Skip (InnerLoopDecodeInit s aStart p aEnd)

621+ Skip (InnerLoopDecodeInit s arrContents arrStart aEnd)

629 Skip s -> Skip (OuterLoop s Nothing)

622 Skip s -> Skip (OuterLoop s Nothing)

630 Stop -> Skip D

623 Stop -> Skip D

631 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do

624 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do

@@ -633,13 +626,12 @@ decodeUtf8ArraysWithD cfm (Stream step state) =

633 return $

626 return $

634 case r of

627 case r of

635 Yield A.Array {..} s ->

628 Yield A.Array {..} s ->

636− let p = unsafeForeignPtrToPtr aStart

637− in Skip (InnerLoopDecoding s aStart p aEnd ds cp)

629+ Skip (InnerLoopDecoding s arrContents arrStart aEnd ds cp)

638 Skip s -> Skip (OuterLoop s dst)

630 Skip s -> Skip (OuterLoop s dst)

639 Stop -> Skip inputUnderflow

631 Stop -> Skip inputUnderflow

640 step' _ _ (InnerLoopDecodeInit st startf p end)

632 step' _ _ (InnerLoopDecodeInit st startf p end)

641 | p == end = do

633 | p == end = do

642− liftIO $ touchForeignPtr startf

634+ liftIO $ touch startf

643 return $ Skip $ OuterLoop st Nothing

635 return $ Skip $ OuterLoop st Nothing

644 step' _ _ (InnerLoopDecodeInit st startf p end) = do

636 step' _ _ (InnerLoopDecodeInit st startf p end) = do

645 x <- liftIO $ peek p

637 x <- liftIO $ peek p

@@ -675,7 +667,7 @@ decodeUtf8ArraysWithD cfm (Stream step state) =

675 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)

667 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)

676 step' _ _ (InnerLoopDecoding st startf p end sv cp)

668 step' _ _ (InnerLoopDecoding st startf p end sv cp)

677 | p == end = do

669 | p == end = do

678− liftIO $ touchForeignPtr startf

670+ liftIO $ touch startf

679 return $ Skip $ OuterLoop st (Just (sv, cp))

671 return $ Skip $ OuterLoop st (Just (sv, cp))

680 step' table _ (InnerLoopDecoding st startf p end statePtr codepointPtr) = do

672 step' table _ (InnerLoopDecoding st startf p end statePtr codepointPtr) = do

681 x <- liftIO $ peek p

673 x <- liftIO $ peek p