@@ -47,9 +47,6 @@ import Data.Functor.Const (Const(..))
4747import Data.Functor.Identity (Identity(..))
4848import Data.Kind (Type)
4949import Data.Proxy (Proxy (..))
50−#ifdef DEBUG
51−import Debug.Trace (trace)
52−#endif
5350import Foreign.Ptr (IntPtr(..), WordPtr(..))
5451import GHC.Base (IO(..))
5552import GHC.Fingerprint.Type (Fingerprint(..))
@@ -68,6 +65,9 @@ import GHC.TypeLits
6865import Prelude hiding (read)
6966
7067import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))
68+#ifdef DEBUG
69+import Streamly.Internal.Data.MutByteArray.Type (sizeOfMutableByteArray)
70+#endif
7171
7272--------------------------------------------------------------------------------
7373-- The Unbox type class
@@ -266,43 +266,66 @@ class Unbox a where
266266{-# DEPRECATED peekByteIndex "Use peekAt." #-}
267267{-# DEPRECATED pokeByteIndex "Use pokeAt." #-}
268268
269−-- XXX Add asserts to check bounds
269+-- _size is the length from array start to the last accessed byte.
270+{-# INLINE checkBounds #-}
271+checkBounds :: String -> Int -> MutByteArray -> IO ()
272+checkBounds _label _size _arr = do
273+#ifdef DEBUG
274+ sz <- sizeOfMutableByteArray _arr
275+ if (_size > sz)
276+ then error
277+ $ _label
278+ ++ ": accessing array at offset = "
279+ ++ show (_size - 1)
280+ ++ " max valid offset = " ++ show (sz - 1)
281+ else return ()
282+#else
283+ return ()
284+#endif
270285
271286#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \
272−instance Unbox _type where { \
273−; {-# INLINE peekAt #-} \
274−; peekAt (I# n) (MutByteArray mbarr) = IO $ \s -> \
275− case _readArray mbarr n s of \
276− { (# s1, i #) -> (# s1, _constructor i #) } \
277−; {-# INLINE pokeAt #-} \
278−; pokeAt (I# n) (MutByteArray mbarr) (_constructor val) = \
279− IO $ \s -> (# _writeArray mbarr n val s, () #) \
280−; {-# INLINE sizeOf #-} \
281−; sizeOf _ = _sizeOf \
287+instance Unbox _type where { \
288+; {-# INLINE peekAt #-} \
289+; peekAt off@(I# n) arr@(MutByteArray mbarr) = \
290+ checkBounds "peek" (off + sizeOf (Proxy :: Proxy _type)) arr \
291+ >> (IO $ \s -> \
292+ case _readArray mbarr n s of \
293+ { (# s1, i #) -> (# s1, _constructor i #) }) \
294+; {-# INLINE pokeAt #-} \
295+; pokeAt off@(I# n) arr@(MutByteArray mbarr) (_constructor val) = \
296+ checkBounds "poke" (off + sizeOf (Proxy :: Proxy _type)) arr \
297+ >> (IO $ \s -> (# _writeArray mbarr n val s, () #)) \
298+; {-# INLINE sizeOf #-} \
299+; sizeOf _ = _sizeOf \
282300}
283301
284302#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType) \
285303instance _constraint Unbox _type where \
286−; {-# INLINE peekAt #-} \
287−; peekAt i arr = _constructor <$> peekAt i arr \
288−; {-# INLINE pokeAt #-} \
289−; pokeAt i arr (_constructor a) = pokeAt i arr a \
304+; {-# INLINE peekAt #-} \
305+; peekAt i arr = \
306+ checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr \
307+ >> _constructor <$> peekAt i arr \
308+; {-# INLINE pokeAt #-} \
309+; pokeAt i arr (_constructor a) = \
310+ checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr \
311+ >> pokeAt i arr a \
290312; {-# INLINE sizeOf #-} \
291313; sizeOf _ = SIZE_OF(_innerType)
292314
293−#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \
294−instance _constraint Unbox _type where { \
295−; {-# INLINE peekAt #-} \
296−; peekAt i arr = \
297− peekAt i arr >>= \
298− (\p1 -> peekAt (i + SIZE_OF(_innerType)) arr \
299− <&> _constructor p1) \
300−; {-# INLINE pokeAt #-} \
301−; pokeAt i arr (_constructor p1 p2) = \
302− pokeAt i arr p1 >> \
303− pokeAt (i + SIZE_OF(_innerType)) arr p2 \
304−; {-# INLINE sizeOf #-} \
305−; sizeOf _ = 2 * SIZE_OF(_innerType) \
315+#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \
316+instance _constraint Unbox _type where { \
317+; {-# INLINE peekAt #-} \
318+; peekAt i arr = \
319+ checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr >> \
320+ peekAt i arr >>= \
321+ (\p1 -> peekAt (i + SIZE_OF(_innerType)) arr <&> _constructor p1) \
322+; {-# INLINE pokeAt #-} \
323+; pokeAt i arr (_constructor p1 p2) = \
324+ checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr >> \
325+ pokeAt i arr p1 >> \
326+ pokeAt (i + SIZE_OF(_innerType)) arr p2 \
327+; {-# INLINE sizeOf #-} \
328+; sizeOf _ = 2 * SIZE_OF(_innerType) \
306329}
307330
308331-------------------------------------------------------------------------------
@@ -423,10 +446,12 @@ DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)
423446instance Unbox () where
424447
425448 {-# INLINE peekAt #-}
426− peekAt _ _ = return ()
449+ peekAt i arr =
450+ checkBounds "peek ()" (i + sizeOf (Proxy :: Proxy ())) arr >> return ()
427451
428452 {-# INLINE pokeAt #-}
429− pokeAt _ _ _ = return ()
453+ pokeAt i arr _ =
454+ checkBounds "poke ()" (i + sizeOf (Proxy :: Proxy ())) arr >> return ()
430455
431456 {-# INLINE sizeOf #-}
432457 sizeOf _ = 1
@@ -435,10 +460,16 @@ instance Unbox () where
435460instance Unbox IoSubSystem where
436461
437462 {-# INLINE peekAt #-}
438− peekAt i arr = toEnum <$> peekAt i arr
463+ peekAt i arr =
464+ checkBounds
465+ "peek IoSubSystem" (i + sizeOf (Proxy :: Proxy IoSubSystem)) arr
466+ >> toEnum <$> peekAt i arr
439467
440468 {-# INLINE pokeAt #-}
441− pokeAt i arr a = pokeAt i arr (fromEnum a)
469+ pokeAt i arr a =
470+ checkBounds
471+ "poke IoSubSystem" (i + sizeOf (Proxy :: Proxy IoSubSystem)) arr
472+ >> pokeAt i arr (fromEnum a)
442473
443474 {-# INLINE sizeOf #-}
444475 sizeOf _ = sizeOf (Proxy :: Proxy Int)
@@ -448,14 +479,16 @@ instance Unbox Bool where
448479
449480 {-# INLINE peekAt #-}
450481 peekAt i arr = do
482+ checkBounds "peek Bool" (i + sizeOf (Proxy :: Proxy Bool)) arr
451483 res <- peekAt i arr
452484 return $ res /= (0 :: Int8)
453485
454486 {-# INLINE pokeAt #-}
455487 pokeAt i arr a =
456− if a
457− then pokeAt i arr (1 :: Int8)
458− else pokeAt i arr (0 :: Int8)
488+ checkBounds "poke Bool" (i + sizeOf (Proxy :: Proxy Bool)) arr
489+ >> if a
490+ then pokeAt i arr (1 :: Int8)
491+ else pokeAt i arr (0 :: Int8)
459492
460493 {-# INLINE sizeOf #-}
461494 sizeOf _ = 1