ce93caa · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Use CPP macros for manipulating array pointers

ce93caaHarendra Kumar5 years ago

.hlint.yaml+7−1

compare with master

unifiedsplit

@@ -36,7 +36,13 @@

37# Specify additional command line arguments

38#

39+- arguments:

40+ [ --cpp-include=src

41+ , --cpp-include=src/Streamly/Internal/Data/Stream

42+ , --cpp-include=src/Streamly/Internal/Data/Array

43+ , --cpp-include=test

39−- arguments: [--cpp-include=src, --cpp-include=test, --cpp-define=CABAL_OS_LINUX]

44+ , --cpp-define=CABAL_OS_LINUX

45+ ]

42# Control which extensions/flags/modules/functions can be used

48# Control which extensions/flags/modules/functions can be used

src/Streamly/Internal/Data/Array/ArrayMacros.hnew file+27

@@ -0,0 +1,27 @@

1+-------------------------------------------------------------------------------

2+-- Macros to access array pointers

3+-------------------------------------------------------------------------------

5+-- The Storable instance of () has size 0. We ensure that the size is non-zero

6+-- to avoid a zero sized element and issues due to that.

7+-- See https://mail.haskell.org/pipermail/libraries/2022-January/thread.html

8+--

9+-- XXX Check the core to see if max can be statically eliminated. llvm can

10+-- eliminate the comparison, but not sure if GHC NCG can.

11+#define SIZE_OF(a) max 1 (sizeOf (undefined :: a))

12+

13+-- Move the pointer to ith element of specified type. Type is specified as the

14+-- type variable in the signature of the function where this macro is used.

15+#define PTR_NEXT(ptr,a) ptr `plusPtr` SIZE_OF(a)

16+#define PTR_PREV(ptr,a) ptr `plusPtr` negate (SIZE_OF(a))

17+

18+#define PTR_INDEX(ptr,i,a) ptr `plusPtr` (SIZE_OF(a) * i)

19+#define PTR_RINDEX(ptr,i,a) ptr `plusPtr` negate (SIZE_OF(a) * (i + 1))

20+

21+-- XXX If we know that the array is guaranteed to have size multiples of the

22+-- element size then we can use a simpler check saying "ptr < end". Since we

23+-- always allocate in multiples of elem we can use the simpler check and assert

24+-- the rigorous check.

25+#define PTR_VALID(ptr,end,a) ptr `plusPtr` SIZE_OF(a) <= end

26+#define PTR_INVALID(ptr,end,a) ptr `plusPtr` SIZE_OF(a) > end

27+

src/Streamly/Internal/Data/Array/Foreign.hs+11−14

@@ -1,5 +1,3 @@

1−#include "inline.hs"

2−

3-- |

1-- |

4-- Module : Streamly.Internal.Data.Array.Foreign

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

@@ -115,6 +113,9 @@ module Streamly.Internal.Data.Array.Foreign

115 )

113 )

116where

114where

117

115

116+#include "inline.hs"

117+#include "ArrayMacros.h"

118+

118import Control.Exception (assert)

119import Control.Exception (assert)

119import Control.Monad (when)

120import Control.Monad (when)

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

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

@@ -130,8 +131,7 @@ import Prelude hiding (length, null, last, map, (!!), read, concat)

130

131

131import GHC.Ptr (Ptr(..))

132import GHC.Ptr (Ptr(..))

132

133

133−import Streamly.Internal.Data.Array.Foreign.Mut.Type

134+import Streamly.Internal.Data.Array.Foreign.Mut.Type (ReadUState(..), touch)

134− (ReadUState(..), sizeOfElem, touch)

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

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

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

@@ -205,8 +205,7 @@ producer = Producer step inject extract

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

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

207 let !x = unsafeInlineIO $ peek cur

208− cur1 = cur `plusPtr` sizeOfElem (undefined :: a)

209− return $ D.Yield x (ReadUState contents end cur1)

208+ return $ D.Yield x (ReadUState contents end (PTR_NEXT(cur,a)))

210

209

211 extract (ReadUState contents end cur) = return $ Array contents cur end

210 extract (ReadUState contents end cur) = return $ Array contents cur end

212

211

@@ -250,7 +249,7 @@ unsafeRead = Unfold step inject

250 r <- peek p

249 r <- peek p

251 touch contents

250 touch contents

252 return r

251 return r

253− let !p1 = p `plusPtr` sizeOfElem (undefined :: a)

252+ let !p1 = PTR_NEXT(p,a)

254 return $ D.Yield x (ReadUState contents end p1)

253 return $ D.Yield x (ReadUState contents end p1)

255

254

256-- |

255-- |

@@ -272,8 +271,7 @@ getIndexRev arr i =

272 unsafeInlineIO

271 unsafeInlineIO

273 $ MA.unsafeWithArrayContents (arrContents arr) (arrStart arr)

272 $ MA.unsafeWithArrayContents (arrContents arr) (arrStart arr)

274 $ \ptr -> do

273 $ \ptr -> do

275− let elemSize = sizeOfElem (undefined :: a)

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

274+ let elemPtr = PTR_RINDEX(aEnd arr,i,a)

277 if i >= 0 && elemPtr >= ptr

275 if i >= 0 && elemPtr >= ptr

278 then Just <$> peek elemPtr

276 then Just <$> peek elemPtr

279 else return Nothing

277 else return Nothing

@@ -383,7 +381,7 @@ getSliceUnsafe ::

383 -> Array a

381 -> Array a

384 -> Array a

382 -> Array a

385getSliceUnsafe index len (Array contents start e) =

383getSliceUnsafe index len (Array contents start e) =

386− let size = sizeOfElem (undefined :: a)

384+ let size = SIZE_OF(a)

387 fp1 = start `plusPtr` (index * size)

385 fp1 = start `plusPtr` (index * size)

388 end = fp1 `plusPtr` (len * size)

386 end = fp1 `plusPtr` (len * size)

389 in assert (end <= e) (Array contents fp1 end)

387 in assert (end <= e) (Array contents fp1 end)

@@ -438,9 +436,8 @@ getIndex arr i =

438 unsafeInlineIO

436 unsafeInlineIO

439 $ MA.unsafeWithArrayContents (arrContents arr) (arrStart arr)

437 $ MA.unsafeWithArrayContents (arrContents arr) (arrStart arr)

440 $ \ptr -> do

438 $ \ptr -> do

441− let elemSize = sizeOfElem (undefined :: a)

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

439+ let elemPtr = PTR_INDEX(ptr,i,a)

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

440+ if i >= 0 && PTR_VALID(elemPtr,aEnd arr,a)

444 then Just <$> peek elemPtr

441 then Just <$> peek elemPtr

445 else return Nothing

442 else return Nothing

446

443

@@ -550,7 +547,7 @@ asBytes = unsafeCast

550cast :: forall a b. (Storable b) => Array a -> Maybe (Array b)

547cast :: forall a b. (Storable b) => Array a -> Maybe (Array b)

551cast arr =

548cast arr =

552 let len = A.byteLength arr

549 let len = A.byteLength arr

553− r = len `mod` sizeOfElem (undefined :: b)

550+ r = len `mod` SIZE_OF(b)

554 in if r /= 0

551 in if r /= 0

555 then Nothing

552 then Nothing

556 else Just $ unsafeCast arr

553 else Just $ unsafeCast arr

src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+74−107

@@ -200,11 +200,11 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type

200 , memcpy

201 , memcmp

202 , c_memchr

203− , sizeOfElem

204 )

203 )

205where

204where

206

205

207#include "inline.hs"

206#include "inline.hs"

207+#include "ArrayMacros.h"

208#include "MachDeps.h"

209

210#ifdef USE_C_MALLOC

@@ -276,14 +276,6 @@ import Prelude hiding

276-- >>> import qualified Streamly.Internal.Data.Fold as Fold

277-- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold

278

279−-------------------------------------------------------------------------------

280−-- Utilities

281−-------------------------------------------------------------------------------

282−

283−{-# INLINE sizeOfElem #-}

284−sizeOfElem :: forall a . (Storable a) => a -> Int

285−sizeOfElem _ = max 1 $ sizeOf (undefined :: a)

286−

287-------------------------------------------------------------------------------

279-------------------------------------------------------------------------------

288-- Foreign helpers

280-- Foreign helpers

289-------------------------------------------------------------------------------

281-------------------------------------------------------------------------------

@@ -301,10 +293,8 @@ foreign import ccall unsafe "string.h memcmp" c_memcmp

301-- how many elements of that type will completely fit in those bytes.

293-- how many elements of that type will completely fit in those bytes.

302--

294--

303{-# INLINE bytesToElemCount #-}

295{-# INLINE bytesToElemCount #-}

304−bytesToElemCount :: Storable a => a -> Int -> Int

296+bytesToElemCount :: forall a. Storable a => a -> Int -> Int

305−bytesToElemCount x n =

297+bytesToElemCount _ n = n `div` SIZE_OF(a)

306− let elemSize = sizeOfElem x

307− in n `div` elemSize

308

298

309-- XXX we are converting Int to CSize

299-- XXX we are converting Int to CSize

310memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()

300memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()

@@ -456,7 +446,7 @@ fromForeignPtrUnsafe fp@(ForeignPtr start contents) end bound =

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

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

457 => (Int -> Int -> m (ArrayContents, Ptr a)) -> Int -> Int -> m (Array a)

447 => (Int -> Int -> m (ArrayContents, Ptr a)) -> Int -> Int -> m (Array a)

458newArrayWith alloc alignSize count = do

448newArrayWith alloc alignSize count = do

459− let size = max (count * sizeOfElem (undefined :: a)) 0

449+ let size = max (count * SIZE_OF(a)) 0

460 (contents, p) <- alloc size alignSize

450 (contents, p) <- alloc size alignSize

461 return $ Array

451 return $ Array

462 { arrContents = contents

452 { arrContents = contents

@@ -511,7 +501,7 @@ newArrayAlignedUnmanaged = do

511 return (ArrayContents contents, Ptr addr)

501 return (ArrayContents contents, Ptr addr)

512#else

502#else

513newArrayAlignedUnmanaged _align count = do

503newArrayAlignedUnmanaged _align count = do

514− let size = max (count * sizeOfElem (undefined :: a)) 0

504+ let size = max (count * SIZE_OF(a)) 0

515 p <- liftIO $ mallocBytes size

505 p <- liftIO $ mallocBytes size

516 return $ Array

506 return $ Array

517 { arrContents = nilArrayContents

507 { arrContents = nilArrayContents

@@ -565,9 +555,8 @@ putIndexUnsafe :: forall m a. (MonadIO m, Storable a)

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

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

566putIndexUnsafe Array{..} i x =

556putIndexUnsafe Array{..} i x =

567 unsafeWithArrayContents arrContents arrStart $ \ptr -> do

557 unsafeWithArrayContents arrContents arrStart $ \ptr -> do

568− let elemSize = sizeOfElem (undefined :: a)

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

558+ let elemPtr = PTR_INDEX(ptr,i,a)

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

559+ assert (i >= 0 && PTR_VALID(elemPtr,aEnd,a)) (return ())

571 liftIO $ poke elemPtr x

560 liftIO $ poke elemPtr x

572

561

573invalidIndex :: String -> Int -> a

562invalidIndex :: String -> Int -> a

@@ -578,9 +567,8 @@ invalidIndex label i =

578putIndexPtr :: forall m a. (MonadIO m, Storable a) =>

567putIndexPtr :: forall m a. (MonadIO m, Storable a) =>

579 Ptr a -> Ptr a -> Int -> a -> m ()

568 Ptr a -> Ptr a -> Int -> a -> m ()

580putIndexPtr start end i x = do

569putIndexPtr start end i x = do

581− let elemSize = sizeOfElem (undefined :: a)

582− elemPtr = start `plusPtr` (elemSize * i)

570+ let elemPtr = PTR_INDEX(start,i,a)

583− if i >= 0 && elemPtr `plusPtr` elemSize <= end

571+ if i >= 0 && PTR_VALID(elemPtr,end,a)

584 then liftIO $ poke elemPtr x

572 then liftIO $ poke elemPtr x

585 else invalidIndex "putIndexPtr" i

573 else invalidIndex "putIndexPtr" i

586

574

@@ -622,9 +610,8 @@ modifyIndexUnsafe :: forall m a b. (MonadIO m, Storable a) =>

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

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

623modifyIndexUnsafe Array{..} i f = do

611modifyIndexUnsafe Array{..} i f = do

624 liftIO $ unsafeWithArrayContents arrContents arrStart $ \ptr -> do

612 liftIO $ unsafeWithArrayContents arrContents arrStart $ \ptr -> do

625− let elemSize = sizeOfElem (undefined :: a)

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

613+ let elemPtr = PTR_INDEX(ptr,i,a)

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

614+ assert (i >= 0 && PTR_NEXT(elemPtr,a) <= aEnd) (return ())

628 r <- peek elemPtr

615 r <- peek elemPtr

629 let (x, res) = f r

616 let (x, res) = f r

630 poke elemPtr x

617 poke elemPtr x

@@ -634,9 +621,8 @@ modifyIndexUnsafe Array{..} i f = do

634modifyIndexPtr :: forall m a b. (MonadIO m, Storable a) =>

621modifyIndexPtr :: forall m a b. (MonadIO m, Storable a) =>

635 Int -> (a -> (a, b)) -> Ptr a -> Ptr a -> m b

622 Int -> (a -> (a, b)) -> Ptr a -> Ptr a -> m b

636modifyIndexPtr i f start end = liftIO $ do

623modifyIndexPtr i f start end = liftIO $ do

637− let elemSize = sizeOfElem (undefined :: a)

638− elemPtr = start `plusPtr` (elemSize * i)

624+ let elemPtr = PTR_INDEX(start,i,a)

639− if i >= 0 && elemPtr `plusPtr` elemSize <= end

625+ if i >= 0 && PTR_VALID(elemPtr,end,a)

640 then do

626 then do

641 r <- peek elemPtr

627 r <- peek elemPtr

642 let (x, res) = f r

628 let (x, res) = f r

@@ -681,12 +667,11 @@ modify Array{..} f = liftIO $

681

667

682 where

668 where

683

669

684− go ptr = do

670+ go ptr =

685− let elemSize = sizeOfElem (undefined :: a)

686− when (ptr `plusPtr` elemSize <= aEnd) $ do

671+ when (PTR_VALID(ptr,aEnd,a)) $ do

687 r <- peek ptr

672 r <- peek ptr

688 poke ptr (f r)

673 poke ptr (f r)

689− go (ptr `plusPtr` elemSize)

674+ go (PTR_NEXT(ptr,a))

690

675

691{-# INLINE swapPtrs #-}

676{-# INLINE swapPtrs #-}

692swapPtrs :: Storable a => Ptr a -> Ptr a -> IO ()

677swapPtrs :: Storable a => Ptr a -> Ptr a -> IO ()

@@ -706,9 +691,8 @@ unsafeSwapIndices :: forall m a. (MonadIO m, Storable a)

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

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

707unsafeSwapIndices Array{..} i1 i2 = liftIO $ do

692unsafeSwapIndices Array{..} i1 i2 = liftIO $ do

708 unsafeWithArrayContents arrContents arrStart $ \ptr -> do

693 unsafeWithArrayContents arrContents arrStart $ \ptr -> do

709− let elemSize = sizeOfElem (undefined :: a)

694+ let ptr1 = PTR_INDEX(ptr,i1,a)

710− ptr1 = ptr `plusPtr` (elemSize * i1)

695+ ptr2 = PTR_INDEX(ptr,i2,a)

711− ptr2 = ptr `plusPtr` (elemSize * i2)

712 swapPtrs ptr1 (ptr2 :: Ptr a)

696 swapPtrs ptr1 (ptr2 :: Ptr a)

713

697

714-- | Swap the elements at two indices.

698-- | Swap the elements at two indices.

@@ -717,11 +701,12 @@ unsafeSwapIndices Array{..} i1 i2 = liftIO $ do

717swapIndices :: forall m a. (MonadIO m, Storable a)

701swapIndices :: forall m a. (MonadIO m, Storable a)

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

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

719swapIndices Array{..} i1 i2 = liftIO $ do

703swapIndices Array{..} i1 i2 = liftIO $ do

720− let elemSize = sizeOfElem (undefined :: a)

704+ let ptr1 = PTR_INDEX(arrStart,i1,a)

721− ptr1 = arrStart `plusPtr` (elemSize * i1)

705+ ptr2 = PTR_INDEX(arrStart,i2,a)

722− ptr2 = arrStart `plusPtr` (elemSize * i2)

706+ when (i1 < 0 || PTR_INVALID(ptr1,aEnd,a))

723− when (i1 < 0 || ptr1 >= aEnd ) $ invalidIndex "swapIndices" i1

707+ $ invalidIndex "swapIndices" i1

708+ when (i2 < 0 || PTR_INVALID(ptr2,aEnd,a))

724− when (i2 < 0 || ptr2 >= aEnd ) $ invalidIndex "swapIndices" i2

709+ $ invalidIndex "swapIndices" i2

725 swapPtrs ptr1 (ptr2 :: Ptr a)

710 swapPtrs ptr1 (ptr2 :: Ptr a)

726

711

727-------------------------------------------------------------------------------

712-------------------------------------------------------------------------------

@@ -777,8 +762,7 @@ roundUpToPower2 x =

777--

762--

778{-# INLINE allocBytesToBytes #-}

763{-# INLINE allocBytesToBytes #-}

779allocBytesToBytes :: forall a. Storable a => a -> Int -> Int

764allocBytesToBytes :: forall a. Storable a => a -> Int -> Int

780−allocBytesToBytes _ n =

765+allocBytesToBytes _ n = max (arrayPayloadSize n) (SIZE_OF(a))

781− max (arrayPayloadSize n) (sizeOfElem (undefined :: a))

782

766

783-- | Given a 'Storable' type (unused first arg) and real allocation size

767-- | Given a 'Storable' type (unused first arg) and real allocation size

784-- (including overhead), return how many elements of that type will completely

768-- (including overhead), return how many elements of that type will completely

@@ -827,8 +811,7 @@ snocNewEnd newEnd arr@Array{..} x = liftIO $ do

827{-# INLINE snocUnsafe #-}

811{-# INLINE snocUnsafe #-}

828snocUnsafe :: forall m a. (MonadIO m, Storable a) =>

812snocUnsafe :: forall m a. (MonadIO m, Storable a) =>

829 Array a -> a -> m (Array a)

813 Array a -> a -> m (Array a)

830−snocUnsafe arr@Array{..} =

814+snocUnsafe arr@Array{..} = snocNewEnd (PTR_NEXT(aEnd,a)) arr

831− snocNewEnd (aEnd `plusPtr` sizeOfElem (undefined :: a)) arr

832

815

833-- | Like 'snoc' but does not reallocate when pre-allocated array capacity

816-- | Like 'snoc' but does not reallocate when pre-allocated array capacity

834-- becomes full.

817-- becomes full.

@@ -838,7 +821,7 @@ snocUnsafe arr@Array{..} =

838snocMay :: forall m a. (MonadIO m, Storable a) =>

821snocMay :: forall m a. (MonadIO m, Storable a) =>

839 Array a -> a -> m (Maybe (Array a))

822 Array a -> a -> m (Maybe (Array a))

840snocMay arr@Array{..} x = liftIO $ do

823snocMay arr@Array{..} x = liftIO $ do

841− let newEnd = aEnd `plusPtr` sizeOfElem (undefined :: a)

824+ let newEnd = PTR_NEXT(aEnd,a)

842 if newEnd <= aBound

825 if newEnd <= aBound

843 then Just <$> snocNewEnd newEnd arr x

826 then Just <$> snocNewEnd newEnd arr x

844 else return Nothing

827 else return Nothing

@@ -875,8 +858,7 @@ snocWithRealloc :: forall m a. (MonadIO m, Storable a) =>

875 -> a

858 -> a

876 -> m (Array a)

859 -> m (Array a)

877snocWithRealloc sizer arr x = do

860snocWithRealloc sizer arr x = do

878− let elemSize = sizeOfElem (undefined :: a)

879− arr1 <- liftIO $ reallocWith "snocWith" sizer elemSize arr

861+ arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr

880 snocUnsafe arr1 x

862 snocUnsafe arr1 x

881

863

882-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of

864-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of

@@ -899,7 +881,7 @@ snocWith :: forall m a. (MonadIO m, Storable a) =>

899 -> a

881 -> a

900 -> m (Array a)

882 -> m (Array a)

901snocWith allocSize arr x = liftIO $ do

883snocWith allocSize arr x = liftIO $ do

902− let newEnd = aEnd arr `plusPtr` sizeOfElem (undefined :: a)

884+ let newEnd = PTR_NEXT(aEnd arr,a)

903 if newEnd <= aBound arr

885 if newEnd <= aBound arr

904 then snocNewEnd newEnd arr x

886 then snocNewEnd newEnd arr x

905 else snocWithRealloc allocSize arr x

887 else snocWithRealloc allocSize arr x

@@ -970,9 +952,7 @@ reallocAligned elemSize alignSize newSize Array{..} = do

970{-# INLINABLE realloc #-}

952{-# INLINABLE realloc #-}

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

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

972realloc i arr =

954realloc i arr =

973− liftIO

974− $ reallocAligned

975− (sizeOfElem (undefined :: a)) (alignment (undefined :: a)) i arr

955+ liftIO $ reallocAligned (SIZE_OF(a)) (alignment (undefined :: a)) i arr

976

956

977-- | Change the reserved memory of the array so that it is enough to hold the

957-- | Change the reserved memory of the array so that it is enough to hold the

978-- specified number of elements. Nothing is done if the specified capacity is

958-- specified number of elements. Nothing is done if the specified capacity is

@@ -1014,7 +994,7 @@ rightSize arr@Array{..} = do

1014 target = roundUpLargeArray len

994 target = roundUpLargeArray len

1015 waste = aBound `minusPtr` aEnd

995 waste = aBound `minusPtr` aEnd

1016 assert (target >= len) (return ())

996 assert (target >= len) (return ())

1017− assert (len `mod` sizeOfElem (undefined :: a) == 0) (return ())

997+ assert (len `mod` SIZE_OF(a) == 0) (return ())

1018 -- We trade off some wastage (25%) to avoid reallocations and copying.

998 -- We trade off some wastage (25%) to avoid reallocations and copying.

1019 if target < capacity && len < 3 * waste

999 if target < capacity && len < 3 * waste

1020 then realloc target arr

1000 then realloc target arr

@@ -1065,18 +1045,16 @@ truncateExp = undefined

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

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

1066getIndexUnsafe Array {..} i =

1046getIndexUnsafe Array {..} i =

1067 unsafeWithArrayContents arrContents arrStart $ \ptr -> do

1047 unsafeWithArrayContents arrContents arrStart $ \ptr -> do

1068− let elemSize = sizeOfElem (undefined :: a)

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

1048+ let elemPtr = PTR_INDEX(ptr,i,a)

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

1049+ assert (i >= 0 && PTR_VALID(elemPtr,aEnd,a)) (return ())

1071 liftIO $ peek elemPtr

1050 liftIO $ peek elemPtr

1072

1051

1073{-# INLINE getIndexPtr #-}

1052{-# INLINE getIndexPtr #-}

1074getIndexPtr :: forall m a. (MonadIO m, Storable a) =>

1053getIndexPtr :: forall m a. (MonadIO m, Storable a) =>

1075 Ptr a -> Ptr a -> Int -> m a

1054 Ptr a -> Ptr a -> Int -> m a

1076−getIndexPtr ptr end i = do

1055+getIndexPtr start end i = do

1077− let elemSize = sizeOfElem (undefined :: a)

1056+ let elemPtr = PTR_INDEX(start,i,a)

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

1079− if i >= 0 && elemPtr `plusPtr` elemSize <= end

1057+ if i >= 0 && PTR_VALID(elemPtr,end,a)

1080 then liftIO $ peek elemPtr

1058 then liftIO $ peek elemPtr

1081 else invalidIndex "getIndexPtr" i

1059 else invalidIndex "getIndexPtr" i

1082

1060

@@ -1091,10 +1069,9 @@ getIndex arr i =

1091{-# INLINE getIndexPtrRev #-}

1069{-# INLINE getIndexPtrRev #-}

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

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

1093 Ptr a -> Ptr a -> Int -> m a

1071 Ptr a -> Ptr a -> Int -> m a

1094−getIndexPtrRev ptr end i = do

1072+getIndexPtrRev start end i = do

1095− let elemSize = sizeOfElem (undefined :: a)

1073+ let elemPtr = PTR_RINDEX(end,i,a)

1096− elemPtr = end `plusPtr` negate (elemSize * (i + 1))

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

1074+ if i >= 0 && elemPtr >= start

1098 then liftIO $ peek elemPtr

1075 then liftIO $ peek elemPtr

1099 else invalidIndex "getIndexPtrRev" i

1076 else invalidIndex "getIndexPtrRev" i

1100

1077

@@ -1160,9 +1137,8 @@ getSliceUnsafe :: forall a. Storable a

1160 -> Array a

1137 -> Array a

1161 -> Array a

1138 -> Array a

1162getSliceUnsafe index len (Array contents start e _) =

1139getSliceUnsafe index len (Array contents start e _) =

1163− let size = sizeOfElem (undefined :: a)

1164− fp1 = start `plusPtr` (index * size)

1140+ let fp1 = PTR_INDEX(start,index,a)

1165− end = fp1 `plusPtr` (len * size)

1141+ end = fp1 `plusPtr` (len * SIZE_OF(a))

1166 in assert

1142 in assert

1167 (index >= 0 && len >= 0 && end <= e)

1143 (index >= 0 && len >= 0 && end <= e)

1168 (Array contents fp1 end end)

1144 (Array contents fp1 end end)

@@ -1178,9 +1154,8 @@ getSlice :: forall a. Storable a =>

1178 -> Array a

1154 -> Array a

1179 -> Array a

1155 -> Array a

1180getSlice index len (Array contents start e _) =

1156getSlice index len (Array contents start e _) =

1181− let size = sizeOfElem (undefined :: a)

1182− fp1 = start `plusPtr` (index * size)

1157+ let fp1 = PTR_INDEX(start,index,a)

1183− end = fp1 `plusPtr` (len * size)

1158+ end = fp1 `plusPtr` (len * SIZE_OF(a))

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

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

1185 then Array contents fp1 end end

1160 then Array contents fp1 end end

1186 else error

1161 else error

@@ -1203,17 +1178,15 @@ getSlice index len (Array contents start e _) =

1203reverse :: forall m a. (MonadIO m, Storable a) => Array a -> m ()

1178reverse :: forall m a. (MonadIO m, Storable a) => Array a -> m ()

1204reverse Array{..} = liftIO $ do

1179reverse Array{..} = liftIO $ do

1205 let l = arrStart

1180 let l = arrStart

1206− h = aEnd `plusPtr` (- elemSize)

1181+ h = PTR_PREV(aEnd,a)

1207 in swap l h

1182 in swap l h

1208

1183

1209 where

1184 where

1210

1185

1211− elemSize = sizeOfElem (undefined :: a)

1212−

1213 swap l h = do

1186 swap l h = do

1214 when (l < h) $ do

1187 when (l < h) $ do

1215 swapPtrs l h

1188 swapPtrs l h

1216− swap (l `plusPtr` elemSize) (h `plusPtr` (- elemSize))

1189+ swap (PTR_NEXT(l,a)) (PTR_PREV(h,a))

1217

1190

1218-- | Generate the next permutation of the sequence, returns False if this is

1191-- | Generate the next permutation of the sequence, returns False if this is

1219-- the last permutation.

1192-- the last permutation.

@@ -1297,7 +1270,7 @@ byteLength Array{..} =

1297{-# INLINE length #-}

1270{-# INLINE length #-}

1298length :: forall a. Storable a => Array a -> Int

1271length :: forall a. Storable a => Array a -> Int

1299length arr =

1272length arr =

1300− let elemSize = sizeOfElem (undefined :: a)

1273+ let elemSize = SIZE_OF(a)

1301 blen = byteLength arr

1274 blen = byteLength arr

1302 in assert (blen `mod` elemSize == 0) (blen `div` elemSize)

1275 in assert (blen `mod` elemSize == 0) (blen `div` elemSize)

1303

1276

@@ -1365,13 +1338,13 @@ arraysOf n (D.Stream step state) =

1365 case r of

1338 case r of

1366 D.Yield x s -> do

1339 D.Yield x s -> do

1367 liftIO $ poke end x >> touch contents

1340 liftIO $ poke end x >> touch contents

1368− let end' = end `plusPtr` sizeOfElem (undefined :: a)

1341+ let end1 = PTR_NEXT(end,a)

1369 return $

1342 return $

1370− if end' >= bound

1343+ if end1 >= bound

1371 then D.Skip

1344 then D.Skip

1372 (GroupYield

1345 (GroupYield

1373− contents start end' bound (GroupStart s))

1346+ contents start end1 bound (GroupStart s))

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

1347+ else D.Skip (GroupBuffer s contents start end1 bound)

1375 D.Skip s ->

1348 D.Skip s ->

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

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

1377 D.Stop ->

1350 D.Stop ->

@@ -1430,8 +1403,7 @@ flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

1430 r <- peek p

1403 r <- peek p

1431 touch contents

1404 touch contents

1432 return r

1405 return r

1433− return $ D.Yield x (InnerLoop st contents

1406+ return $ D.Yield x (InnerLoop st contents (PTR_NEXT(p,a)) end)

1434− (p `plusPtr` sizeOfElem (undefined :: a)) end)

1435

1407

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

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

1437--

1409--

@@ -1451,7 +1423,7 @@ flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

1451 r <- step (adaptState gst) st

1423 r <- step (adaptState gst) st

1452 return $ case r of

1424 return $ case r of

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

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

1454− let p = aEnd `plusPtr` negate (sizeOfElem (undefined :: a))

1426+ let p = PTR_PREV(aEnd,a)

1455 in D.Skip (InnerLoop s arrContents p arrStart)

1427 in D.Skip (InnerLoop s arrContents p arrStart)

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

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

1457 D.Stop -> D.Stop

1429 D.Stop -> D.Stop

@@ -1464,7 +1436,7 @@ flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

1464 r <- peek p

1436 r <- peek p

1465 touch contents

1437 touch contents

1466 return r

1438 return r

1467− let cur = p `plusPtr` negate (sizeOfElem (undefined :: a))

1439+ let cur = PTR_PREV(p,a)

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

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

1469

1441

1470-------------------------------------------------------------------------------

1442-------------------------------------------------------------------------------

@@ -1493,8 +1465,7 @@ producer = Producer step (return . toReadUState) extract

1493 return D.Stop

1465 return D.Stop

1494 step (ReadUState contents end cur) = do

1466 step (ReadUState contents end cur) = do

1495 !x <- liftIO $ peek cur

1467 !x <- liftIO $ peek cur

1496− let cur1 = cur `plusPtr` sizeOfElem (undefined :: a)

1497− return $ D.Yield x (ReadUState contents end cur1)

1468+ return $ D.Yield x (ReadUState contents end (PTR_NEXT(cur,a)))

1498

1469

1499 extract (ReadUState contents end cur) = return $ Array contents cur end end

1470 extract (ReadUState contents end cur) = return $ Array contents cur end end

1500

1471

@@ -1514,7 +1485,7 @@ readRev = Unfold step inject

1514 where

1485 where

1515

1486

1516 inject (Array contents start end _) =

1487 inject (Array contents start end _) =

1517− let p = end `plusPtr` negate (sizeOfElem (undefined :: a))

1488+ let p = PTR_PREV(end,a)

1518 in return $ ReadUState contents start p

1489 in return $ ReadUState contents start p

1519

1490

1520 {-# INLINE_LATE step #-}

1491 {-# INLINE_LATE step #-}

@@ -1522,9 +1493,8 @@ readRev = Unfold step inject

1522 liftIO $ touch contents

1493 liftIO $ touch contents

1523 return D.Stop

1494 return D.Stop

1524 step (ReadUState contents start p) = do

1495 step (ReadUState contents start p) = do

1525− x <- liftIO $ peek p

1496+ x <- liftIO $ peek p

1526− let cur = p `plusPtr` negate (sizeOfElem (undefined :: a))

1527− return $ D.Yield x (ReadUState contents start cur)

1497+ return $ D.Yield x (ReadUState contents start (PTR_PREV(p,a)))

1528

1498

1529-------------------------------------------------------------------------------

1499-------------------------------------------------------------------------------

1530-- to Lists and streams

1500-- to Lists and streams

@@ -1551,7 +1521,7 @@ toListFB c n Array{..} = go arrStart

1551 r <- peek p

1521 r <- peek p

1552 touch arrContents

1522 touch arrContents

1553 return r

1523 return r

1554− in c x (go (p `plusPtr` sizeOfElem (undefined :: a)))

1524+ in c x (go (PTR_NEXT(p,a)))

1555-}

1525-}

1556

1526

1557-- XXX Monadic foldr/build fusion?

1527-- XXX Monadic foldr/build fusion?

@@ -1568,7 +1538,7 @@ toList Array{..} = liftIO $ go arrStart

1568 go p = do

1538 go p = do

1569 x <- peek p

1539 x <- peek p

1570 touch arrContents

1540 touch arrContents

1571− (:) x <$> go (p `plusPtr` sizeOfElem (undefined :: a))

1541+ (:) x <$> go (PTR_NEXT(p,a))

1572

1542

1573-- | Use the 'read' unfold instead.

1543-- | Use the 'read' unfold instead.

1574--

1544--

@@ -1586,7 +1556,7 @@ toStreamD Array{..} = D.Stream step arrStart

1586 step _ p = liftIO $ do

1556 step _ p = liftIO $ do

1587 r <- peek p

1557 r <- peek p

1588 touch arrContents

1558 touch arrContents

1589− return $ D.Yield r (p `plusPtr` sizeOfElem (undefined :: a))

1559+ return $ D.Yield r (PTR_NEXT(p,a))

1590

1560

1591{-# INLINE toStreamK #-}

1561{-# INLINE toStreamK #-}

1592toStreamK :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a

1562toStreamK :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a

@@ -1600,7 +1570,7 @@ toStreamK Array{..} = go arrStart

1600 r <- peek p

1570 r <- peek p

1601 touch arrContents

1571 touch arrContents

1602 return r

1572 return r

1603− in liftIO elemM `K.consM` go (p `plusPtr` sizeOfElem (undefined :: a))

1573+ in liftIO elemM `K.consM` go (PTR_NEXT(p,a))

1604

1574

1605-- | Use the 'readRev' unfold instead.

1575-- | Use the 'readRev' unfold instead.

1606--

1576--

@@ -1610,7 +1580,7 @@ toStreamK Array{..} = go arrStart

1610{-# INLINE_NORMAL toStreamDRev #-}

1580{-# INLINE_NORMAL toStreamDRev #-}

1611toStreamDRev :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a

1581toStreamDRev :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a

1612toStreamDRev Array{..} =

1582toStreamDRev Array{..} =

1613− let p = aEnd `plusPtr` negate (sizeOfElem (undefined :: a))

1583+ let p = PTR_PREV(aEnd,a)

1614 in D.Stream step p

1584 in D.Stream step p

1615

1585

1616 where

1586 where

@@ -1620,12 +1590,12 @@ toStreamDRev Array{..} =

1620 step _ p = liftIO $ do

1590 step _ p = liftIO $ do

1621 r <- peek p

1591 r <- peek p

1622 touch arrContents

1592 touch arrContents

1623− return $ D.Yield r (p `plusPtr` negate (sizeOfElem (undefined :: a)))

1593+ return $ D.Yield r (PTR_PREV(p,a))

1624

1594

1625{-# INLINE toStreamKRev #-}

1595{-# INLINE toStreamKRev #-}

1626toStreamKRev :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a

1596toStreamKRev :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a

1627toStreamKRev Array {..} =

1597toStreamKRev Array {..} =

1628− let p = aEnd `plusPtr` negate (sizeOfElem (undefined :: a))

1598+ let p = PTR_PREV(aEnd,a)

1629 in go p

1599 in go p

1630

1600

1631 where

1601 where

@@ -1636,7 +1606,7 @@ toStreamKRev Array {..} =

1636 r <- peek p

1606 r <- peek p

1637 touch arrContents

1607 touch arrContents

1638 return r

1608 return r

1639− in liftIO elemM `K.consM` go (p `plusPtr` negate (sizeOfElem (undefined :: a)))

1609+ in liftIO elemM `K.consM` go (PTR_PREV(p,a))

1640

1610

1641-------------------------------------------------------------------------------

1611-------------------------------------------------------------------------------

1642-- Folding

1612-- Folding

@@ -1705,8 +1675,7 @@ appendNUnsafe action n =

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

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

1706 arr@(Array _ _ end bound) <- action

1676 arr@(Array _ _ end bound) <- action

1707 let free = bound `minusPtr` end

1677 let free = bound `minusPtr` end

1708− elemSize = sizeOfElem (undefined :: a)

1709− needed = n * elemSize

1678+ needed = n * SIZE_OF(a)

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

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

1711 -- otherwise we lose that space.

1680 -- otherwise we lose that space.

1712 arr1 <-

1681 arr1 <-

@@ -1717,8 +1686,7 @@ appendNUnsafe action n =

1717

1686

1718 step (ArrayUnsafe contents start end) x = do

1687 step (ArrayUnsafe contents start end) x = do

1719 liftIO $ poke end x >> touch contents

1688 liftIO $ poke end x >> touch contents

1720− let end1 = end `plusPtr` sizeOfElem (undefined :: a)

1721− return $ ArrayUnsafe contents start end1

1689+ return $ ArrayUnsafe contents start (PTR_NEXT(end,a))

1722

1690

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

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

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

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

@@ -1835,7 +1803,7 @@ writeNWithUnsafe alloc n = Fold step initial (return . fromArrayUnsafe)

1835 liftIO $ poke end x >> touch contents

1803 liftIO $ poke end x >> touch contents

1836 return

1804 return

1837 $ FL.Partial

1805 $ FL.Partial

1838− $ ArrayUnsafe contents start (end `plusPtr` sizeOfElem (undefined :: a))

1806+ $ ArrayUnsafe contents start (PTR_NEXT(end,a))

1839

1807

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

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

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

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

@@ -1908,20 +1876,19 @@ writeWith elemCount =

1908

1876

1909 insertElem (Array contents start end bound) x = do

1877 insertElem (Array contents start end bound) x = do

1910 liftIO $ poke end x

1878 liftIO $ poke end x

1911− let end1 = end `plusPtr` sizeOfElem (undefined :: a)

1912− return $ Array contents start end1 bound

1879+ return $ Array contents start (PTR_NEXT(end,a)) bound

1913

1880

1914 initial = do

1881 initial = do

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

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

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

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

1917 step arr@(Array _ start end bound) x

1884 step arr@(Array _ start end bound) x

1918− | end `plusPtr` sizeOfElem (undefined :: a) > bound = do

1885+ | PTR_NEXT(end,a) > bound = do

1919 let oldSize = end `minusPtr` start

1886 let oldSize = end `minusPtr` start

1920 newSize = max (oldSize * 2) 1

1887 newSize = max (oldSize * 2) 1

1921 arr1 <-

1888 arr1 <-

1922 liftIO

1889 liftIO

1923 $ reallocAligned

1890 $ reallocAligned

1924− (sizeOfElem (undefined :: a))

1891+ (SIZE_OF(a))

1925 (alignment (undefined :: a))

1892 (alignment (undefined :: a))

1926 newSize

1893 newSize

1927 arr

1894 arr

@@ -1962,7 +1929,7 @@ fromStreamDN limit str = do

1962

1929

1963 fwrite ptr x = do

1930 fwrite ptr x = do

1964 liftIO $ poke ptr x

1931 liftIO $ poke ptr x

1965− return $ ptr `plusPtr` sizeOfElem (undefined :: a)

1932+ return $ PTR_NEXT(ptr,a)

1966

1933

1967-- | Create an 'Array' from the first N elements of a list. The array is

1934-- | Create an 'Array' from the first N elements of a list. The array is

1968-- allocated to size N, if the list terminates before N elements then the

1935-- allocated to size N, if the list terminates before N elements then the

@@ -2156,7 +2123,7 @@ splitAt i arr@Array{..} =

2156 else if i > maxIndex

2123 else if i > maxIndex

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

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

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

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

2159− else let off = i * sizeOfElem (undefined :: a)

2126+ else let off = i * SIZE_OF(a)

2160 p = arrStart `plusPtr` off

2127 p = arrStart `plusPtr` off

2161 in ( Array

2128 in ( Array

2162 { arrContents = arrContents

2129 { arrContents = arrContents

@@ -2207,7 +2174,7 @@ asBytes = castUnsafe

2207cast :: forall a b. Storable b => Array a -> Maybe (Array b)

2174cast :: forall a b. Storable b => Array a -> Maybe (Array b)

2208cast arr =

2175cast arr =

2209 let len = byteLength arr

2176 let len = byteLength arr

2210− r = len `mod` sizeOfElem (undefined :: b)

2177+ r = len `mod` SIZE_OF(b)

2211 in if r /= 0

2178 in if r /= 0

2212 then Nothing

2179 then Nothing

2213 else Just $ castUnsafe arr

2180 else Just $ castUnsafe arr

src/Streamly/Internal/Data/Array/Foreign/Type.hs+14−18

@@ -1,5 +1,3 @@

1−#include "inline.hs"

2−

3-- |

1-- |

4-- Module : Streamly.Internal.Data.Array.Foreign.Type

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

@@ -74,6 +72,9 @@ module Streamly.Internal.Data.Array.Foreign.Type

74 )

72 )

75where

73where

75+#include "ArrayMacros.h"

76+#include "inline.hs"

77+

77import Control.Exception (assert)

78import Control.Exception (assert)

78import Control.DeepSeq (NFData(..))

79import Control.DeepSeq (NFData(..))

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

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

@@ -90,7 +91,7 @@ import GHC.ForeignPtr (ForeignPtr)

90import GHC.IO (unsafePerformIO)

91import GHC.IO (unsafePerformIO)

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

92import GHC.Ptr (Ptr(..))

92import Streamly.Internal.Data.Array.Foreign.Mut.Type

93import Streamly.Internal.Data.Array.Foreign.Mut.Type

93− (ArrayContents, ReadUState(..), sizeOfElem, touch)

94+ (ArrayContents, ReadUState(..), touch)

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

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

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

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

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

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

@@ -466,7 +467,7 @@ readRev = Unfold step inject

466 where

467 where

467

468

468 inject (Array contents start end) =

469 inject (Array contents start end) =

469− let p = end `plusPtr` negate (sizeOfElem (undefined :: a))

470+ let p = PTR_PREV(end,a)

470 in return $ ReadUState contents start p

471 in return $ ReadUState contents start p

471

472

472 {-# INLINE_LATE step #-}

473 {-# INLINE_LATE step #-}

@@ -481,8 +482,7 @@ readRev = Unfold step inject

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

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

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

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

483 let !x = unsafeInlineIO $ peek p

484 let !x = unsafeInlineIO $ peek p

484− let cur = p `plusPtr` negate (sizeOfElem (undefined :: a))

485− return $ D.Yield x (ReadUState contents start cur)

485+ return $ D.Yield x (ReadUState contents start (PTR_PREV(p,a)))

486

487

488{-# INLINE_NORMAL toStreamD #-}

@@ -505,7 +505,7 @@ toStreamD Array{..} = D.Stream step arrStart

505 r <- peek p

506 touch arrContents

507 return r

508− return $ D.Yield x (p `plusPtr` sizeOfElem (undefined :: a))

508+ return $ D.Yield x (PTR_NEXT(p,a))

509

510{-# INLINE toStreamK #-}

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

@@ -520,13 +520,11 @@ toStreamK Array{..} = go arrStart

520 r <- peek p

521 touch arrContents

522 return r

523− in x `K.cons` go (p `plusPtr` sizeOfElem (undefined :: a))

523+ in x `K.cons` go (PTR_NEXT(p,a))

524

525{-# INLINE_NORMAL toStreamDRev #-}

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

527−toStreamDRev Array{..} =

527+toStreamDRev Array{..} = D.Stream step (PTR_PREV(aEnd,a))

528− let p = aEnd `plusPtr` negate (sizeOfElem (undefined :: a))

529− in D.Stream step p

530

528

531 where

529 where

532

530

@@ -538,13 +536,11 @@ toStreamDRev Array{..} =

538 r <- peek p

536 r <- peek p

539 touch arrContents

537 touch arrContents

540 return r

538 return r

541− return $ D.Yield x (p `plusPtr` negate (sizeOfElem (undefined :: a)))

539+ return $ D.Yield x (PTR_PREV(p,a))

542

540

543{-# INLINE toStreamKRev #-}

541{-# INLINE toStreamKRev #-}

544toStreamKRev :: forall m a. Storable a => Array a -> K.Stream m a

542toStreamKRev :: forall m a. Storable a => Array a -> K.Stream m a

545−toStreamKRev Array {..} =

543+toStreamKRev Array {..} = go (PTR_PREV(aEnd,a))

546− let p = aEnd `plusPtr` negate (sizeOfElem (undefined :: a))

547− in go p

548

544

549 where

545 where

550

546

@@ -554,7 +550,7 @@ toStreamKRev Array {..} =

554 r <- peek p

550 r <- peek p

555 touch arrContents

551 touch arrContents

556 return r

552 return r

557− in x `K.cons` go (p `plusPtr` negate (sizeOfElem (undefined :: a)))

553+ in x `K.cons` go (PTR_PREV(p,a))

558

554

559-- | Convert an 'Array' into a stream.

555-- | Convert an 'Array' into a stream.

560--

556--

@@ -613,7 +609,7 @@ toListFB c n Array{..} = go arrStart

613 r <- peek p

609 r <- peek p

614 touch arrContents

610 touch arrContents

615 return r

611 return r

616− in c x (go (p `plusPtr` sizeOfElem (undefined :: a)))

612+ in c x (go (PTR_NEXT(p,a)))

617

613

618-- | Convert an 'Array' into a list.

614-- | Convert an 'Array' into a list.

619--

615--

@@ -781,7 +777,7 @@ contraint.

781{-# INLINE_NORMAL _foldr #-}

777{-# INLINE_NORMAL _foldr #-}

782_foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b

778_foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b

783_foldr f z arr =

779_foldr f z arr =

784− let !n = sizeOfElem (undefined :: a)

780+ let !n = SIZE_OF(a)

785 in unsafePerformIO $ D.foldr f z $ toStreamD_ n arr

781 in unsafePerformIO $ D.foldr f z $ toStreamD_ n arr

786

782

787-- | Note that the 'Foldable' instance is 7x slower than the direct

783-- | Note that the 'Foldable' instance is 7x slower than the direct

src/Streamly/Internal/Data/Array/Stream/Fold/Foreign.hs+8−7

@@ -51,6 +51,8 @@ module Streamly.Internal.Data.Array.Stream.Fold.Foreign

51 )

52where

54+#include "ArrayMacros.h"

55+

54import Control.Applicative (liftA2)

56import Control.Applicative (liftA2)

55import Control.Exception (assert)

57import Control.Exception (assert)

56import Control.Monad.Catch (MonadThrow)

58import Control.Monad.Catch (MonadThrow)

@@ -58,7 +60,7 @@ import Control.Monad.IO.Class (MonadIO(..))

58import Foreign.Ptr (minusPtr, plusPtr)

60import Foreign.Ptr (minusPtr, plusPtr)

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

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

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

62import GHC.Types (SPEC(..))

61−import Streamly.Internal.Data.Array.Foreign.Mut.Type (sizeOfElem, touch)

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

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

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

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

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

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

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

@@ -118,8 +120,8 @@ fromFold (Fold.Fold fstep finitial fextract) =

118 goArray !_ !cur !fs = do

120 goArray !_ !cur !fs = do

119 x <- liftIO $ peek cur

121 x <- liftIO $ peek cur

120 res <- fstep fs x

122 res <- fstep fs x

121− let elemSize = sizeOfElem (undefined :: a)

123+ let elemSize = SIZE_OF(a)

122− next = cur `plusPtr` elemSize

124+ next = PTR_NEXT(cur,a)

123 case res of

125 case res of

124 Fold.Done b ->

126 Fold.Done b ->

125 return $ Done ((end `minusPtr` next) `div` elemSize) b

127 return $ Done ((end `minusPtr` next) `div` elemSize) b

@@ -156,8 +158,8 @@ fromParser (ParserD.Parser step1 initial1 extract1) =

156 x <- liftIO $ peek cur

158 x <- liftIO $ peek cur

157 liftIO $ touch contents

159 liftIO $ touch contents

158 res <- step1 fs x

160 res <- step1 fs x

159− let elemSize = sizeOfElem (undefined :: a)

161+ let elemSize = SIZE_OF(a)

160− next = cur `plusPtr` elemSize

162+ next = PTR_NEXT(cur,a)

161 arrRem = (end `minusPtr` next) `div` elemSize

163 arrRem = (end `minusPtr` next) `div` elemSize

162 case res of

164 case res of

163 ParserD.Done n b -> do

165 ParserD.Done n b -> do

@@ -320,8 +322,7 @@ take n (Fold (ParserD.Parser step1 initial1 extract1)) =

320 Error err -> return $ Error err

322 Error err -> return $ Error err

321 else do

323 else do

322 let !(Array contents start _) = arr

324 let !(Array contents start _) = arr

323− sz = sizeOfElem (undefined :: a)

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

325+ end = PTR_INDEX(start,i,a)

325 arr1 = Array contents start end

326 arr1 = Array contents start end

326 remaining = negate i1

327 remaining = negate i1

327 res <- step1 r arr1

328 res <- step1 r arr1

src/Streamly/Internal/Data/Array/Stream/Foreign.hs+7−11

@@ -46,6 +46,7 @@ module Streamly.Internal.Data.Array.Stream.Foreign

46 )

47where

49+#include "ArrayMacros.h"

49#include "inline.hs"

50#include "inline.hs"

51import Data.Bifunctor (second)

52import Data.Bifunctor (second)

@@ -76,7 +77,7 @@ import Streamly.Internal.Data.Stream.IsStream.Type

76 (IsStream, fromStreamD, toStreamD)

77 (IsStream, fromStreamD, toStreamD)

77import Streamly.Internal.Data.SVar (adaptState, defState)

78import Streamly.Internal.Data.SVar (adaptState, defState)

78import Streamly.Internal.Data.Array.Foreign.Mut.Type

79import Streamly.Internal.Data.Array.Foreign.Mut.Type

79− (memcpy, allocBytesToElemCount, sizeOfElem)

80+ (memcpy, allocBytesToElemCount)

81import qualified Streamly.Internal.Data.Array.Foreign as A

82import qualified Streamly.Internal.Data.Array.Foreign as A

82import qualified Streamly.Internal.Data.Array.Foreign as Array

83import qualified Streamly.Internal.Data.Array.Foreign as Array

@@ -194,8 +195,7 @@ unlines sep (D.Stream step state) = D.Stream step' (OuterLoop state)

194 r <- peek p

195 r <- peek p

195 touch contents

196 touch contents

196 return r

197 return r

197− return $ D.Yield x (InnerLoop st contents

198+ return $ D.Yield x (InnerLoop st contents (PTR_NEXT(p,a)) end)

198− (p `plusPtr` sizeOfElem (undefined :: a)) end)

199

200-------------------------------------------------------------------------------

201-- Compact

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

349 goArray !_ st fp@(ForeignPtr end contents) !cur !fs = do

350 x <- liftIO $ peek cur

351 res <- fstep fs x

352− let elemSize = sizeOfElem (undefined :: a)

352+ let next = PTR_NEXT(cur,a)

353− next = cur `plusPtr` elemSize

354 case res of

353 case res of

355 FL.Done b -> do

354 FL.Done b -> do

356 let arr = Array (fptrToArrayContents contents) next (Ptr end)

355 let arr = Array (fptrToArrayContents contents) next (Ptr end)

@@ -390,8 +389,7 @@ takeArrayListRev = go

390 else if n == len

389 else if n == len

391 then [x]

390 then [x]

392 else let !(Array contents _ end) = x

391 else let !(Array contents _ end) = x

393− sz = sizeOfElem (undefined :: a)

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

392+ !start = end `plusPtr` negate (n * SIZE_OF(a))

395 in [Array contents start end]

393 in [Array contents start end]

396

394

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

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

@@ -413,8 +411,7 @@ splitAtArrayListRev n ls

413 else if m == len

411 else if m == len

414 then ([x],xs)

412 then ([x],xs)

415 else let !(Array contents start end) = x

413 else let !(Array contents start end) = x

416− sz = sizeOfElem (undefined :: a)

417− end1 = end `plusPtr` negate (m * sz)

414+ end1 = end `plusPtr` negate (m * SIZE_OF(a))

418 arr2 = Array contents start end1

415 arr2 = Array contents start end1

419 arr1 = Array contents end1 end

416 arr1 = Array contents end1 end

420 in ([arr1], arr2:xs)

417 in ([arr1], arr2:xs)

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

568 gobuf !_ s backBuf fp@(ForeignPtr end contents) !cur !pst = do

565 gobuf !_ s backBuf fp@(ForeignPtr end contents) !cur !pst = do

569 x <- liftIO $ peek cur

566 x <- liftIO $ peek cur

570 pRes <- pstep pst x

567 pRes <- pstep pst x

571− let elemSize = sizeOfElem (undefined :: a)

568+ let next = PTR_NEXT(cur,a)

572− next = cur `plusPtr` elemSize

573 case pRes of

569 case pRes of

574 PR.Partial 0 pst1 ->

570 PR.Partial 0 pst1 ->

575 gobuf SPEC s (List []) fp next pst1

571 gobuf SPEC s (List []) fp next pst1

src/Streamly/Internal/Data/Array/Stream/Mut/Foreign.hs+4−3

@@ -25,13 +25,14 @@ module Streamly.Internal.Data.Array.Stream.Mut.Foreign

25where

27#include "inline.hs"

28+#include "ArrayMacros.h"

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

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

30import Control.Monad (when)

31import Control.Monad (when)

31import Control.Monad.Catch (MonadThrow)

32import Control.Monad.Catch (MonadThrow)

32import Data.Bifunctor (first)

33import Data.Bifunctor (first)

33import Foreign.Storable (Storable(..))

34import Foreign.Storable (Storable(..))

34−import Streamly.Internal.Data.Array.Foreign.Mut.Type (Array(..), sizeOfElem)

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

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

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

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

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

37import Streamly.Internal.Data.Stream.IsStream.Type

38import Streamly.Internal.Data.Stream.IsStream.Type

@@ -211,7 +212,7 @@ compactLEParserD n = ParserD.Parser step initial extract

211

212

212 where

213 where

213

214

214− nBytes = n * sizeOfElem (undefined :: a)

215+ nBytes = n * SIZE_OF(a)

215

216

216 initial =

217 initial =

217 return

218 return

@@ -261,7 +262,7 @@ compactGEFold n = Fold step initial extract

261

262

262 where

263 where

263

264

264− nBytes = n * sizeOfElem (undefined :: a)

265+ nBytes = n * SIZE_OF(a)

265

266

266 initial =

267 initial =

267 return

268 return

src/Streamly/Internal/Data/Ring/Foreign.hs+9−9

@@ -68,6 +68,7 @@ module Streamly.Internal.Data.Ring.Foreign

68 , slidingWindow

69 ) where

71+#include "ArrayMacros.h"

71#include "inline.hs"

72#include "inline.hs"

73import Control.Exception (assert)

74import Control.Exception (assert)

@@ -79,8 +80,7 @@ import Foreign.Ptr (plusPtr, minusPtr, castPtr)

79import Foreign.Storable (Storable(..))

80import Foreign.Storable (Storable(..))

80import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)

81import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)

81import GHC.Ptr (Ptr(..))

82import GHC.Ptr (Ptr(..))

82−import Streamly.Internal.Data.Array.Foreign.Mut.Type

83+import Streamly.Internal.Data.Array.Foreign.Mut.Type (Array, memcmp)

83− (Array, memcmp, sizeOfElem)

84import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..))

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

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

@@ -124,7 +124,7 @@ startOf = unsafeForeignPtrToPtr . ringStart

124{-# INLINE new #-}

125new :: forall a. Storable a => Int -> IO (Ring a, Ptr a)

126new count = do

127− let size = count * sizeOfElem (undefined :: a)

127+ let size = count * SIZE_OF(a)

128 fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))

129 let p = unsafeForeignPtrToPtr fptr

130 return (Ring

@@ -148,7 +148,7 @@ newRing = undefined

148{-# INLINE advance #-}

149advance :: forall a. Storable a => Ring a -> Ptr a -> Ptr a

150advance Ring{..} ringHead =

151− let ptr = ringHead `plusPtr` sizeOfElem (undefined :: a)

151+ let ptr = PTR_NEXT(ringHead,a)

152 in if ptr < ringBound

153 then ptr

154 else unsafeForeignPtrToPtr ringStart

@@ -162,7 +162,7 @@ moveBy by Ring {..} ringHead = ringStartPtr `plusPtr` advanceFromHead

162

163 where

164

165− elemSize = sizeOfElem (undefined :: a)

165+ elemSize = SIZE_OF(a)

166 ringStartPtr = unsafeForeignPtrToPtr ringStart

167 lenInBytes = ringBound `minusPtr` ringStartPtr

168 offInBytes = ringHead `minusPtr` ringStartPtr

@@ -362,7 +362,7 @@ asBytes = castUnsafe

362cast :: forall a b. Storable b => Ring a -> Maybe (Ring b)

363cast arr =

364 let len = byteLength arr

365− r = len `mod` sizeOfElem (undefined :: b)

365+ r = len `mod` SIZE_OF(b)

366 in if r /= 0

367 then Nothing

368 else Just $ castUnsafe arr

@@ -444,7 +444,7 @@ unsafeFoldRing ptr f z Ring{..} =

444 | p == q = return acc

445 | otherwise = do

446 x <- peek p

447− go (f acc x) (p `plusPtr` sizeOfElem (undefined :: a)) q

447+ go (f acc x) (PTR_NEXT(p,a)) q

448

449-- XXX Can we remove MonadIO here?

450withForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b

@@ -464,8 +464,8 @@ unsafeFoldRingM ptr f z Ring {..} =

464 | start == end = return acc

465 | otherwise = do

466 let !x = unsafeInlineIO $ peek start

467− acc' <- f acc x

467+ acc1 <- f acc x

468− go acc' (start `plusPtr` sizeOfElem (undefined :: a)) end

468+ go acc1 (PTR_NEXT(start,a)) end

469

470-- | Fold the entire length of a ring buffer starting at the supplied ringHead

471-- pointer. Assuming the supplied ringHead pointer points to the oldest item,

src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs+5−5

@@ -146,6 +146,7 @@ module Streamly.Internal.Data.Stream.StreamD.Nesting

146where

147

148#include "inline.hs"

149+#include "ArrayMacros.h"

149

150

150import Control.Exception (assert)

151import Control.Exception (assert)

151import Control.Monad.Catch (MonadThrow, throwM)

152import Control.Monad.Catch (MonadThrow, throwM)

@@ -167,7 +168,6 @@ import Streamly.Internal.Data.Refold.Type (Refold(..))

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

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

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

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

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

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

170−import Streamly.Internal.Data.Array.Foreign.Mut.Type (sizeOfElem)

171

172import qualified Streamly.Internal.Data.Array.Foreign.Type as A

173import qualified Streamly.Internal.Data.Fold as FL

@@ -1672,7 +1672,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

1672

1673 patLen = A.length patArr

1674 maxIndex = patLen - 1

1675− elemBits = sizeOfElem (undefined :: a) * 8

1675+ elemBits = SIZE_OF(a) * 8

1676

1677 -- For word pattern case

1678 wordMask :: Word

@@ -1720,7 +1720,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

1720 then do

1721 pat <- liftIO $ A.unsafeIndexIO patArr 0

1722 return $ Skip $ SplitOnSeqSingle acc state pat

1723− else if sizeOfElem (undefined :: a) * patLen

1723+ else if SIZE_OF(a) * patLen

1724 <= sizeOf (undefined :: Word)

1725 then return $ Skip $ SplitOnSeqWordInit acc state

1726 else do

@@ -1986,7 +1986,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

1986

1987 patLen = A.length patArr

1988 maxIndex = patLen - 1

1989− elemBits = sizeOfElem (undefined :: a) * 8

1989+ elemBits = SIZE_OF(a) * 8

1990

1991 -- For word pattern case

1992 wordMask :: Word

@@ -2053,7 +2053,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2053 then do

2054 pat <- liftIO $ A.unsafeIndexIO patArr 0

2055 skip $ SplitOnSuffixSeqSingleInit fs state pat

2056− else if sizeOfElem (undefined :: a) * patLen

2056+ else if SIZE_OF(a) * patLen

2057 <= sizeOf (undefined :: Word)

2058 then skip $ SplitOnSuffixSeqWordInit fs state

2059 else do

streamly.cabal+6−1

@@ -86,6 +86,7 @@ extra-source-files:

86 src/Streamly/Internal/Data/Stream/Instances.hs

87 src/Streamly/Internal/Data/Stream/PreludeCommon.hs

88 src/Streamly/Internal/Data/Time/Clock/config-clock.h

89+ src/Streamly/Internal/Data/Array/ArrayMacros.h

89 src/Streamly/Internal/Data/Array/PrimInclude.hs

90 src/Streamly/Internal/Data/Array/PrimInclude.hs

90 src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs

91 src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs

91 src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs

92 src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs

@@ -321,7 +322,11 @@ library

321 default-extensions: QuantifiedConstraints

322 default-extensions: QuantifiedConstraints

322

323

323 js-sources: jsbits/clock.js

324 js-sources: jsbits/clock.js

325+ include-dirs:

326+ src

324− include-dirs: src, src/Streamly/Internal/Data/Stream

327+ , src/Streamly/Internal/Data/Stream

328+ , src/Streamly/Internal/Data/Array

329+

325 if os(windows)

330 if os(windows)

326 c-sources: src/Streamly/Internal/Data/Time/Clock/Windows.c

331 c-sources: src/Streamly/Internal/Data/Time/Clock/Windows.c

327 exposed-modules: Streamly.Internal.FileSystem.Event.Windows

332 exposed-modules: Streamly.Internal.FileSystem.Event.Windows