91e4160 · streamly · git.iko.soy

git.iko.soy/streamly

Fix A.fromList crashes on empty list of type [()]

commit91e4160e4b734442ef18f7488fe18a2f7c478c58 authorRanjeet Kumar Ranjan <ranjeetr@composewell.com> dateFri 26 Nov 2021, 15:40 (5 years ago) parent7acb24a

10 files changed+102−86

compare with master

unifiedsplit

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

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

130130

131131import GHC.Ptr (Ptr(..))

132132

133−import Streamly.Internal.Data.Array.Foreign.Mut.Type (ReadUState(..), touch)

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

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

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

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

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

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

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

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

206207 let !x = unsafeInlineIO $ peek cur

207− cur1 = cur `plusPtr` sizeOf (undefined :: a)

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

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

209210

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

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

249250 r <- peek p

250251 touch contents

251252 return r

252− let !p1 = p `plusPtr` sizeOf (undefined :: a)

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

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

254255

255256-- |

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

271272 unsafeInlineIO

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

273274 $ \ptr -> do

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

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

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

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

277278 then Just <$> peek elemPtr

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

382383 -> Array a

383384 -> Array a

384385getSliceUnsafe index len (Array contents start e) =

385− let size = sizeOf (undefined :: a)

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

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

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

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

@@ -437,7 +438,7 @@ getIndex arr i =

437438 unsafeInlineIO

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

439440 $ \ptr -> do

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

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

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

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

443444 then Just <$> peek elemPtr

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

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

550551cast arr =

551552 let len = A.byteLength arr

552− r = len `mod` sizeOf (undefined :: b)

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

553554 in if r /= 0

554555 then Nothing

555556 else Just $ unsafeCast arr

src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+52−43

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

200200 , memcpy

201201 , memcmp

202202 , c_memchr

203+ , sizeOfElem

203204 )

204205where

205206

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

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

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

277278

279+-------------------------------------------------------------------------------

280+-- Utilities

281+-------------------------------------------------------------------------------

282+

283+{-# INLINE sizeOfElem #-}

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

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

286+

278287-------------------------------------------------------------------------------

279288-- Foreign helpers

280289-------------------------------------------------------------------------------

@@ -294,7 +303,7 @@ foreign import ccall unsafe "string.h memcmp" c_memcmp

294303{-# INLINE bytesToElemCount #-}

295304bytesToElemCount :: Storable a => a -> Int -> Int

296305bytesToElemCount x n =

297− let elemSize = sizeOf x

306+ let elemSize = sizeOfElem x

298307 in n `div` elemSize

299308

300309-- XXX we are converting Int to CSize

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

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

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

449458newArrayWith alloc alignSize count = do

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

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

451460 (contents, p) <- alloc size alignSize

452461 return $ Array

453462 { arrContents = contents

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

502511 return (ArrayContents contents, Ptr addr)

503512#else

504513newArrayAlignedUnmanaged _align count = do

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

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

506515 p <- liftIO $ mallocBytes size

507516 return $ Array

508517 { arrContents = nilArrayContents

@@ -556,7 +565,7 @@ putIndexUnsafe :: forall m a. (MonadIO m, Storable a)

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

557566putIndexUnsafe Array{..} i x =

558567 unsafeWithArrayContents arrContents arrStart $ \ptr -> do

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

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

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

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

562571 liftIO $ poke elemPtr x

@@ -569,7 +578,7 @@ invalidIndex label i =

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

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

571580putIndexPtr start end i x = do

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

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

573582 elemPtr = start `plusPtr` (elemSize * i)

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

575584 then liftIO $ poke elemPtr x

@@ -613,7 +622,7 @@ modifyIndexUnsafe :: forall m a b. (MonadIO m, Storable a) =>

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

614623modifyIndexUnsafe Array{..} i f = do

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

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

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

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

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

619628 r <- peek elemPtr

@@ -769,7 +778,7 @@ roundUpToPower2 x =

769778{-# INLINE allocBytesToBytes #-}

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

771780allocBytesToBytes _ n =

772− max (arrayPayloadSize n) (sizeOf (undefined :: a))

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

773782

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

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

@@ -819,7 +828,7 @@ snocNewEnd newEnd arr@Array{..} x = liftIO $ do

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

820829 Array a -> a -> m (Array a)

821830snocUnsafe arr@Array{..} =

822− snocNewEnd (aEnd `plusPtr` sizeOf (undefined :: a)) arr

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

823832

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

825834-- becomes full.

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

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

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

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

832− let newEnd = aEnd `plusPtr` sizeOf (undefined :: a)

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

833842 if newEnd <= aBound

834843 then Just <$> snocNewEnd newEnd arr x

835844 else return Nothing

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

866875 -> a

867876 -> m (Array a)

868877snocWithRealloc sizer arr x = do

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

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

870879 arr1 <- liftIO $ reallocWith "snocWith" sizer elemSize arr

871880 snocUnsafe arr1 x

872881

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

890899 -> a

891900 -> m (Array a)

892901snocWith allocSize arr x = liftIO $ do

893− let newEnd = aEnd arr `plusPtr` sizeOf (undefined :: a)

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

894903 if newEnd <= aBound arr

895904 then snocNewEnd newEnd arr x

896905 else snocWithRealloc allocSize arr x

@@ -963,7 +972,7 @@ realloc :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m (Array a)

963972realloc i arr =

964973 liftIO

965974 $ reallocAligned

966− (sizeOf (undefined :: a)) (alignment (undefined :: a)) i arr

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

967976

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

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

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

10051014 target = roundUpLargeArray len

10061015 waste = aBound `minusPtr` aEnd

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

1008− assert (len `mod` sizeOf (undefined :: a) == 0) (return ())

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

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

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

10111020 then realloc target arr

@@ -1056,7 +1065,7 @@ truncateExp = undefined

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

10571066getIndexUnsafe Array {..} i =

10581067 unsafeWithArrayContents arrContents arrStart $ \ptr -> do

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

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

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

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

10621071 liftIO $ peek elemPtr

@@ -1065,7 +1074,7 @@ getIndexUnsafe Array {..} i =

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

10661075 Ptr a -> Ptr a -> Int -> m a

10671076getIndexPtr ptr end i = do

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

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

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

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

10711080 then liftIO $ peek elemPtr

@@ -1083,7 +1092,7 @@ getIndex arr i =

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

10841093 Ptr a -> Ptr a -> Int -> m a

10851094getIndexPtrRev ptr end i = do

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

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

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

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

10891098 then liftIO $ peek elemPtr

@@ -1151,7 +1160,7 @@ getSliceUnsafe :: forall a. Storable a

11511160 -> Array a

11521161 -> Array a

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

1154− let size = sizeOf (undefined :: a)

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

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

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

11571166 in assert

@@ -1169,7 +1178,7 @@ getSlice :: forall a. Storable a =>

11691178 -> Array a

11701179 -> Array a

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

1172− let size = sizeOf (undefined :: a)

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

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

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

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

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

12881297{-# INLINE length #-}

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

12901299length arr =

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

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

12921301 blen = byteLength arr

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

12941303

@@ -1356,7 +1365,7 @@ arraysOf n (D.Stream step state) =

13561365 case r of

13571366 D.Yield x s -> do

13581367 liftIO $ poke end x >> touch contents

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

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

13601369 return $

13611370 if end' >= bound

13621371 then D.Skip

@@ -1422,7 +1431,7 @@ flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

14221431 touch contents

14231432 return r

14241433 return $ D.Yield x (InnerLoop st contents

1425− (p `plusPtr` sizeOf (undefined :: a)) end)

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

14261435

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

14281437--

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

14421451 r <- step (adaptState gst) st

14431452 return $ case r of

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

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

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

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

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

14481457 D.Stop -> D.Stop

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

14551464 r <- peek p

14561465 touch contents

14571466 return r

1458− let cur = p `plusPtr` negate (sizeOf (undefined :: a))

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

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

14601469

14611470-------------------------------------------------------------------------------

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

14841493 return D.Stop

14851494 step (ReadUState contents end cur) = do

14861495 !x <- liftIO $ peek cur

1487− let cur1 = cur `plusPtr` sizeOf (undefined :: a)

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

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

14891498

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

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

15051514 where

15061515

15071516 inject (Array contents start end _) =

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

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

15091518 in return $ ReadUState contents start p

15101519

15111520 {-# INLINE_LATE step #-}

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

15141523 return D.Stop

15151524 step (ReadUState contents start p) = do

15161525 x <- liftIO $ peek p

1517− let cur = p `plusPtr` negate (sizeOf (undefined :: a))

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

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

15191528

15201529-------------------------------------------------------------------------------

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

15421551 r <- peek p

15431552 touch arrContents

15441553 return r

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

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

15461555-}

15471556

15481557-- XXX Monadic foldr/build fusion?

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

15591568 go p = do

15601569 x <- peek p

15611570 touch arrContents

1562− (:) x <$> go (p `plusPtr` sizeOf (undefined :: a))

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

15631572

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

15651574--

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

15771586 step _ p = liftIO $ do

15781587 r <- peek p

15791588 touch arrContents

1580− return $ D.Yield r (p `plusPtr` sizeOf (undefined :: a))

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

15811590

15821591{-# INLINE toStreamK #-}

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

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

15911600 r <- peek p

15921601 touch arrContents

15931602 return r

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

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

15951604

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

15971606--

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

16011610{-# INLINE_NORMAL toStreamDRev #-}

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

16031612toStreamDRev Array{..} =

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

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

16051614 in D.Stream step p

16061615

16071616 where

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

16111620 step _ p = liftIO $ do

16121621 r <- peek p

16131622 touch arrContents

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

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

16151624

16161625{-# INLINE toStreamKRev #-}

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

16181627toStreamKRev Array {..} =

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

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

16201629 in go p

16211630

16221631 where

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

16271636 r <- peek p

16281637 touch arrContents

16291638 return r

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

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

16311640

16321641-------------------------------------------------------------------------------

16331642-- Folding

@@ -1696,7 +1705,7 @@ appendNUnsafe action n =

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

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

16981707 let free = bound `minusPtr` end

1699− elemSize = sizeOf (undefined :: a)

1708+ elemSize = sizeOfElem (undefined :: a)

17001709 needed = n * elemSize

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

17021711 -- otherwise we lose that space.

@@ -1708,7 +1717,7 @@ appendNUnsafe action n =

17081717

17091718 step (ArrayUnsafe contents start end) x = do

17101719 liftIO $ poke end x >> touch contents

1711− let end1 = end `plusPtr` sizeOf (undefined :: a)

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

17121721 return $ ArrayUnsafe contents start end1

17131722

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

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

18261835 liftIO $ poke end x >> touch contents

18271836 return

18281837 $ FL.Partial

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

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

18301839

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

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

@@ -1899,20 +1908,20 @@ writeWith elemCount =

18991908

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

19011910 liftIO $ poke end x

1902− let end1 = end `plusPtr` sizeOf (undefined :: a)

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

19031912 return $ Array contents start end1 bound

19041913

19051914 initial = do

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

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

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

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

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

19101919 let oldSize = end `minusPtr` start

19111920 newSize = max (oldSize * 2) 1

19121921 arr1 <-

19131922 liftIO

19141923 $ reallocAligned

1915− (sizeOf (undefined :: a))

1924+ (sizeOfElem (undefined :: a))

19161925 (alignment (undefined :: a))

19171926 newSize

19181927 arr

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

19531962

19541963 fwrite ptr x = do

19551964 liftIO $ poke ptr x

1956− return $ ptr `plusPtr` sizeOf (undefined :: a)

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

19571966

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

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

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

21472156 else if i > maxIndex

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

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

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

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

21512160 p = arrStart `plusPtr` off

21522161 in ( Array

21532162 { arrContents = arrContents

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

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

21992208cast arr =

22002209 let len = byteLength arr

2201− r = len `mod` sizeOf (undefined :: b)

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

22022211 in if r /= 0

22032212 then Nothing

22042213 else Just $ castUnsafe arr

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

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

9090import GHC.IO (unsafePerformIO)

9191import GHC.Ptr (Ptr(..))

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

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

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

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

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

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

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

466466 where

467467

468468 inject (Array contents start end) =

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

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

470470 in return $ ReadUState contents start p

471471

472472 {-# INLINE_LATE step #-}

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

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

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

483483 let !x = unsafeInlineIO $ peek p

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

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

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

486486

487487

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

505505 r <- peek p

506506 touch arrContents

507507 return r

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

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

509509

510510{-# INLINE toStreamK #-}

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

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

520520 r <- peek p

521521 touch arrContents

522522 return r

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

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

524524

525525{-# INLINE_NORMAL toStreamDRev #-}

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

527527toStreamDRev Array{..} =

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

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

529529 in D.Stream step p

530530

531531 where

@@ -538,12 +538,12 @@ toStreamDRev Array{..} =

538538 r <- peek p

539539 touch arrContents

540540 return r

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

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

542542

543543{-# INLINE toStreamKRev #-}

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

545545toStreamKRev Array {..} =

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

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

547547 in go p

548548

549549 where

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

554554 r <- peek p

555555 touch arrContents

556556 return r

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

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

558558

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

560560--

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

613613 r <- peek p

614614 touch arrContents

615615 return r

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

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

617617

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

619619--

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

781781{-# INLINE_NORMAL _foldr #-}

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

783783_foldr f z arr =

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

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

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

786786

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

src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs+1−1

@@ -83,7 +83,7 @@ length ::

8383length arr =

8484 liftIO $ do

8585 blen <- byteLength arr

86− return $ blen `quot` (sizeOf (undefined :: a))

86+ return $ blen `quot` (max 1 $ sizeOf (undefined :: a))

8787

8888-------------------------------------------------------------------------------

8989-- Random Access

src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs+6−3

@@ -128,10 +128,13 @@ defaultChunkSize = mkChunkSizeKB 32

128128-- Length

129129-------------------------------------------------------------------------------

130130

131+sizeOfPrimElem :: forall a . (Prim a) => a -> Int

132+sizeOfPrimElem _ = max 1 $ sizeOf (undefined :: a)

133+

131134-- XXX rename to byteCount?

132135{-# INLINE byteLength #-}

133136byteLength :: forall a. Prim a => Array a -> Int

134−byteLength (Array _ _ len) = len * sizeOf (undefined :: a)

137+byteLength (Array _ _ len) = len * sizeOfPrimElem (undefined :: a)

135138

136139-- XXX Also, rename to elemCount

137140-- XXX I would prefer length to keep the API consistent

@@ -546,7 +549,7 @@ packArraysChunksOf n (D.Stream step state) =

546549

547550 where

548551

549− nElem = n `quot` sizeOf (undefined :: a)

552+ nElem = n `quot` sizeOfPrimElem (undefined :: a)

550553

551554 {-# INLINE_LATE step' #-}

552555 step' gst (SpliceInitial st) = do

@@ -597,7 +600,7 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

597600

598601 where

599602

600− nElem = n `quot` sizeOf (undefined :: a)

603+ nElem = n `quot` sizeOfPrimElem (undefined :: a)

601604

602605 initial = do

603606 when (n <= 0) $

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

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

5858import Foreign.Ptr (minusPtr, plusPtr)

5959import Foreign.Storable (Storable(..))

6060import GHC.Types (SPEC(..))

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

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

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

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

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

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

118118 goArray !_ !cur !fs = do

119119 x <- liftIO $ peek cur

120120 res <- fstep fs x

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

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

122122 next = cur `plusPtr` elemSize

123123 case res of

124124 Fold.Done b ->

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

156156 x <- liftIO $ peek cur

157157 liftIO $ touch contents

158158 res <- step1 fs x

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

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

160160 next = cur `plusPtr` elemSize

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

162162 case res of

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

320320 Error err -> return $ Error err

321321 else do

322322 let !(Array contents start _) = arr

323− sz = sizeOf (undefined :: a)

323+ sz = sizeOfElem (undefined :: a)

324324 end = start `plusPtr` (i * sz)

325325 arr1 = Array contents start end

326326 remaining = negate i1

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

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

7676 (IsStream, fromStreamD, toStreamD)

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

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

79− (memcpy, allocBytesToElemCount)

79+ (memcpy, allocBytesToElemCount, sizeOfElem)

8080

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

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

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

195195 touch contents

196196 return r

197197 return $ D.Yield x (InnerLoop st contents

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

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

199199

200200-------------------------------------------------------------------------------

201201-- Compact

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

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

350350 x <- liftIO $ peek cur

351351 res <- fstep fs x

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

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

353353 next = cur `plusPtr` elemSize

354354 case res of

355355 FL.Done b -> do

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

390390 else if n == len

391391 then [x]

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

393− sz = sizeOf (undefined :: a)

393+ sz = sizeOfElem (undefined :: a)

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

395395 in [Array contents start end]

396396

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

413413 else if m == len

414414 then ([x],xs)

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

416− sz = sizeOf (undefined :: a)

416+ sz = sizeOfElem (undefined :: a)

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

418418 arr2 = Array contents start end1

419419 arr1 = Array contents end1 end

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

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

569569 x <- liftIO $ peek cur

570570 pRes <- pstep pst x

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

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

572572 next = cur `plusPtr` elemSize

573573 case pRes of

574574 PR.Partial 0 pst1 ->

src/Streamly/Internal/Data/Ring/Foreign.hs+8−7

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

7979import Foreign.Storable (Storable(..))

8080import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)

8181import GHC.Ptr (Ptr(..))

82−import Streamly.Internal.Data.Array.Foreign.Mut.Type (Array, memcmp)

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

83+ (Array, memcmp, sizeOfElem)

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

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

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

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

123124{-# INLINE new #-}

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

125126new count = do

126− let size = count * sizeOf (undefined :: a)

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

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

128129 let p = unsafeForeignPtrToPtr fptr

129130 return (Ring

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

147148{-# INLINE advance #-}

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

149150advance Ring{..} ringHead =

150− let ptr = ringHead `plusPtr` sizeOf (undefined :: a)

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

151152 in if ptr < ringBound

152153 then ptr

153154 else unsafeForeignPtrToPtr ringStart

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

161162

162163 where

163164

164− elemSize = sizeOf (undefined :: a)

165+ elemSize = sizeOfElem (undefined :: a)

165166 ringStartPtr = unsafeForeignPtrToPtr ringStart

166167 lenInBytes = ringBound `minusPtr` ringStartPtr

167168 offInBytes = ringHead `minusPtr` ringStartPtr

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

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

362363cast arr =

363364 let len = byteLength arr

364− r = len `mod` sizeOf (undefined :: b)

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

365366 in if r /= 0

366367 then Nothing

367368 else Just $ castUnsafe arr

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

443444 | p == q = return acc

444445 | otherwise = do

445446 x <- peek p

446− go (f acc x) (p `plusPtr` sizeOf (undefined :: a)) q

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

447448

448449-- XXX Can we remove MonadIO here?

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

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

464465 | otherwise = do

465466 let !x = unsafeInlineIO $ peek start

466467 acc' <- f acc x

467− go acc' (start `plusPtr` sizeOf (undefined :: a)) end

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

468469

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

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

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

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

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

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

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

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

170171

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

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

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

16711672

16721673 patLen = A.length patArr

16731674 maxIndex = patLen - 1

1674− elemBits = sizeOf (undefined :: a) * 8

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

16751676

16761677 -- For word pattern case

16771678 wordMask :: Word

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

19851986

19861987 patLen = A.length patArr

19871988 maxIndex = patLen - 1

1988− elemBits = sizeOf (undefined :: a) * 8

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

19891990

19901991 -- For word pattern case

19911992 wordMask :: Word

src/Streamly/Internal/Data/Stream/StreamD/Transform.hs+3−2

@@ -1109,12 +1109,13 @@ reverse' :: forall m a. (MonadIO m, Storable a) => Stream m a -> Stream m a

11091109import Foreign.ForeignPtr (touchForeignPtr)

11101110import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

11111111import Foreign.Ptr (Ptr, plusPtr)

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

11121113reverse' m = Stream step Nothing

11131114 where

11141115 {-# INLINE_LATE step #-}

11151116 step _ Nothing = do

11161117 arr <- A.fromStreamD m

1117− let p = A.aEnd arr `plusPtr` negate (sizeOf (undefined :: a))

1118+ let p = A.aEnd arr `plusPtr` negate (sizeOfElem (undefined :: a))

11181119 return $ Skip $ Just (A.aStart arr, p)

11191120

11201121 step _ (Just (start, p)) | p < unsafeForeignPtrToPtr start = return Stop

@@ -1124,7 +1125,7 @@ reverse' m = Stream step Nothing

11241125 r <- peek p

11251126 touchForeignPtr start

11261127 return r

1127− next = p `plusPtr` negate (sizeOf (undefined :: a))

1128+ next = p `plusPtr` negate (sizeOfElem (undefined :: a))

11281129 return $ Yield x (Just (start, next))

11291130-}

11301131