cc3bbd7 · streamly · git.iko.soy

git.iko.soy/streamly

Use a macro definition for assertM

So that the error location is reported correctly by the compiler when the assert is hit.

commitcc3bbd76dc42f62214e9c6ab50059fc37ce4354e authorHarendra Kumar <harendra@composewell.com> dateSat 13 Aug 2022, 15:07 (4 years ago) parent63ba027

7 files changed+51−48

compare with master

unifiedsplit

core/src/Streamly/Internal/Control/Exception.hs+1−13 core/src/Streamly/Internal/Data/Array/Unboxed/Mut/Type.hs+6−7 core/src/Streamly/Internal/Data/Parser/ParserD.hs+9−8 core/src/Streamly/Internal/Data/Parser/ParserD/Type.hs+19−18 core/src/assert.hs+6 src/assert.hs+6 streamly.cabal+4−2

core/src/Streamly/Internal/Control/Exception.hs+1−13

@@ -10,23 +10,11 @@

1010-- Additional "Control.Exception" utilities.

1111

1212module Streamly.Internal.Control.Exception

13− ( assertM

14− , verify

13+ ( verify

1514 , verifyM

1615 )

1716where

1817

19−import Control.Exception (assert)

20−

21−-- Like 'assert' but returns @()@ in an 'Applicative' context so that it can be

22−-- used as an independent statement in a @do@ block.

23−--

24−-- /Pre-release/

25−--

26−{-# INLINE assertM #-}

27−assertM :: Applicative f => Bool -> f ()

28−assertM predicate = assert predicate (pure ())

29−

3018-- | Like 'assert' but is not removed by the compiler, it is always present in

3119-- production code.

3220--

core/src/Streamly/Internal/Data/Array/Unboxed/Mut/Type.hs+6−7

@@ -210,11 +210,11 @@ where

210210-- When we use a purely lazy Monad like Identity, we need to force ordering of

211211-- some actions for correctness.

212212

213+#include "assert.hs"

213214#include "inline.hs"

214215#include "ArrayMacros.h"

215216#include "MachDeps.h"

216217

217−import Control.Exception (assert)

218218import Control.DeepSeq (NFData(..), NFData1(..))

219219import Control.Monad (when, void)

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

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

225225import Data.Word (Word8)

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

227227import Foreign.Ptr (plusPtr, minusPtr, nullPtr)

228−import Streamly.Internal.Control.Exception (assertM)

229228import Streamly.Internal.Data.Unboxed

230229 ( ArrayContents(..)

231230 , Unboxed

@@ -722,7 +721,7 @@ roundDownTo elemSize size = size - (size `mod` elemSize)

722721{-# NOINLINE reallocAligned #-}

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

724723reallocAligned elemSize alignSize newCapacityInBytes Array{..} = do

725− assertM (aEnd <= aBound)

724+ assertM(aEnd <= aBound)

726725

727726 -- Allocate new array

728727 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes

@@ -776,7 +775,7 @@ reallocWith label capSizer minIncrBytes arr = do

776775 newCapBytes = capSizer oldSizeBytes

777776 newSizeBytes = oldSizeBytes + minIncrBytes

778777 safeCapBytes = max newCapBytes newSizeBytes

779− assertM (safeCapBytes >= newSizeBytes || error (badSize newSizeBytes))

778+ assertM(safeCapBytes >= newSizeBytes || error (badSize newSizeBytes))

780779

781780 realloc safeCapBytes arr

782781

@@ -2023,8 +2022,8 @@ fromListRev xs = fromListRevN (Prelude.length xs) xs

20232022{-# INLINE putSliceUnsafe #-}

20242023putSliceUnsafe :: MonadIO m => Array a -> Int -> Array a -> Int -> Int -> m ()

20252024putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do

2026− assertM (lenBytes <= aBound dst - dstStartBytes)

2027− assertM (lenBytes <= aEnd src - srcStartBytes)

2025+ assertM(lenBytes <= aBound dst - dstStartBytes)

2026+ assertM(lenBytes <= aEnd src - srcStartBytes)

20282027 let !(I# srcStartBytes#) = srcStartBytes

20292028 !(I# dstStartBytes#) = dstStartBytes

20302029 !(I# lenBytes#) = lenBytes

@@ -2065,7 +2064,7 @@ spliceUnsafe dst src =

20652064 let startSrc = arrStart src

20662065 srcLen = aEnd src - startSrc

20672066 endDst = aEnd dst

2068− assertM (endDst + srcLen <= aBound dst)

2067+ assertM(endDst + srcLen <= aBound dst)

20692068 putSliceUnsafe src startSrc dst endDst srcLen

20702069 return $ dst {aEnd = endDst + srcLen}

20712070

core/src/Streamly/Internal/Data/Parser/ParserD.hs+9−8

@@ -196,12 +196,13 @@ module Streamly.Internal.Data.Parser.ParserD

196196 )

197197where

198198

199+#include "assert.hs"

200+

199201import Control.Exception (Exception)

200202import Control.Monad (when)

201203import Control.Monad.Catch (MonadCatch, MonadThrow(..))

202204import Data.Bifunctor (first)

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

204−import Streamly.Internal.Control.Exception (assertM)

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

206207import Streamly.Internal.Data.SVar.Type (defState)

207208import Streamly.Internal.Data.Either.Strict (Either'(..))

@@ -1705,17 +1706,17 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract

17051706 IError e -> return $ IError e

17061707

17071708 step (Tuple' cnt r) a = do

1708− assertM (cnt < lim)

1709+ assertM(cnt < lim)

17091710 res <- pstep r a

17101711 let cnt1 = cnt + 1

17111712 case res of

17121713 Partial 0 s -> do

1713− assertM (cnt1 >= 0)

1714+ assertM(cnt1 >= 0)

17141715 if cnt1 < lim

17151716 then return $ Partial 0 $ Tuple' cnt1 s

17161717 else Done 0 <$> pextract s

17171718 Continue 0 s -> do

1718− assertM (cnt1 >= 0)

1719+ assertM(cnt1 >= 0)

17191720 if cnt1 < lim

17201721 then return $ Continue 0 $ Tuple' cnt1 s

17211722 -- XXX This should error out?

@@ -1732,11 +1733,11 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract

17321733 else Done 0 <$> pextract s

17331734 Partial n s -> do

17341735 let taken = cnt1 - n

1735− assertM (taken >= 0)

1736+ assertM(taken >= 0)

17361737 return $ Partial n $ Tuple' taken s

17371738 Continue n s -> do

17381739 let taken = cnt1 - n

1739− assertM (taken >= 0)

1740+ assertM(taken >= 0)

17401741 return $ Continue n $ Tuple' taken s

17411742 Done n b -> return $ Done n b

17421743 Error str -> return $ Error str

@@ -2131,7 +2132,7 @@ manyTill (Fold fstep finitial fextract)

21312132 case r of

21322133 Partial n s -> return $ Partial n (ManyTillR 0 fs s)

21332134 Continue n s -> do

2134− assertM (cnt + 1 - n >= 0)

2135+ assertM(cnt + 1 - n >= 0)

21352136 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)

21362137 Done n _ -> do

21372138 b <- fextract fs

@@ -2157,7 +2158,7 @@ manyTill (Fold fstep finitial fextract)

21572158 case r of

21582159 Partial n s -> return $ Partial n (ManyTillL 0 fs s)

21592160 Continue n s -> do

2160− assertM (cnt + 1 - n >= 0)

2161+ assertM(cnt + 1 - n >= 0)

21612162 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)

21622163 Done n b -> do

21632164 fs1 <- fstep fs b

core/src/Streamly/Internal/Data/Parser/ParserD/Type.hs+19−18

@@ -207,6 +207,8 @@ module Streamly.Internal.Data.Parser.ParserD.Type

207207 )

208208where

209209

210+#include "assert.hs"

211+

210212import Control.Applicative (Alternative(..), liftA2)

211213import Control.Exception (Exception(..))

212214import Control.Monad (MonadPlus(..), (>=>))

@@ -216,7 +218,6 @@ import Control.Monad.State.Class (MonadState, get, put)

216218import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)

217219import Data.Bifunctor (Bifunctor(..))

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

219−import Streamly.Internal.Control.Exception (assertM)

220221import Streamly.Internal.Data.Fold.Type (Fold(..), toList)

221222import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))

222223

@@ -505,15 +506,15 @@ parseDToK pstep initial extract leftover (level, count) cont = do

505506 pRes <- pstep r x

506507 case pRes of

507508 Done n b -> do

508− assertM (n <= cnt1)

509+ assertM(n <= cnt1)

509510 cont (level, cnt1 - n) (K.Success n b)

510511 Error err ->

511512 cont (level, cnt1) (K.Failure err)

512513 Partial n pst1 -> do

513− assertM (n <= cnt1)

514+ assertM(n <= cnt1)

514515 return $ K.Partial n (parseCont (cnt1 - n) (return pst1))

515516 Continue n pst1 -> do

516− assertM (n <= cnt1)

517+ assertM(n <= cnt1)

517518 return $ K.Continue n (parseCont (cnt1 - n) (return pst1))

518519 parseCont cnt acc Nothing = do

519520 pst <- acc

@@ -584,7 +585,7 @@ fromParserK parser0 = Parser step initial extract

584585 -- always transitions to only FPKCont. The input remains unconsumed in

585586 -- this case so we use "n + 1".

586587 step (FPKDone n b) _ = do

587− assertM (n == 0)

588+ assertM(n == 0)

588589 return $ Done (n + 1) b

589590 step (FPKCont cont) a = do

590591 r <- cont (Just a)

@@ -981,7 +982,7 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

981982 case r of

982983 Partial n s -> return $ Partial n (AltParseL 0 s)

983984 Continue n s -> do

984− assertM (cnt + 1 - n >= 0)

985+ assertM(cnt + 1 - n >= 0)

985986 return $ Continue n (AltParseL (cnt + 1 - n) s)

986987 Done n b -> return $ Done n b

987988 Error _ -> do

@@ -1038,13 +1039,13 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10381039 let cnt1 = cnt + 1

10391040 case r of

10401041 Partial n s -> do

1041− assertM (cnt1 - n >= 0)

1042+ assertM(cnt1 - n >= 0)

10421043 return $ Continue n (Tuple3' s (cnt1 - n) fs)

10431044 Continue n s -> do

1044− assertM (cnt1 - n >= 0)

1045+ assertM(cnt1 - n >= 0)

10451046 return $ Continue n (Tuple3' s (cnt1 - n) fs)

10461047 Done n b -> do

1047− assertM (cnt1 - n >= 0)

1048+ assertM(cnt1 - n >= 0)

10481049 fstep fs b >>= handleCollect (Partial n) (Done n)

10491050 Error _ -> do

10501051 xs <- fextract fs

@@ -1098,13 +1099,13 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10981099 let cnt1 = cnt + 1

10991100 case r of

11001101 Partial n s -> do

1101− assertM (cnt1 - n >= 0)

1102+ assertM(cnt1 - n >= 0)

11021103 return $ Continue n (Tuple3' s (cnt1 - n) fs)

11031104 Continue n s -> do

1104− assertM (cnt1 - n >= 0)

1105+ assertM(cnt1 - n >= 0)

11051106 return $ Continue n (Tuple3' s (cnt1 - n) fs)

11061107 Done n b -> do

1107− assertM (cnt1 - n >= 0)

1108+ assertM(cnt1 - n >= 0)

11081109 fstep fs b >>= handleCollect (Partial n) (Done n)

11091110 Error _ -> do

11101111 xs <- fextract fs

@@ -1171,13 +1172,13 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

11711172 let cnt1 = cnt + 1

11721173 case r of

11731174 Partial n s -> do

1174− assertM (cnt1 - n >= 0)

1175+ assertM(cnt1 - n >= 0)

11751176 return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))

11761177 Continue n s -> do

1177− assertM (cnt1 - n >= 0)

1178+ assertM(cnt1 - n >= 0)

11781179 return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))

11791180 Done n b -> do

1180− assertM (cnt1 - n >= 0)

1181+ assertM(cnt1 - n >= 0)

11811182 fstep fs b >>= handleCollect (Partial n) (Done n)

11821183 Error err -> return $ Error err

11831184 step (Tuple3' st cnt (Right fs)) a = do

@@ -1185,13 +1186,13 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

11851186 let cnt1 = cnt + 1

11861187 case r of

11871188 Partial n s -> do

1188− assertM (cnt1 - n >= 0)

1189+ assertM(cnt1 - n >= 0)

11891190 return $ Partial n (Tuple3' s (cnt1 - n) (Right fs))

11901191 Continue n s -> do

1191− assertM (cnt1 - n >= 0)

1192+ assertM(cnt1 - n >= 0)

11921193 return $ Continue n (Tuple3' s (cnt1 - n) (Right fs))

11931194 Done n b -> do

1194− assertM (cnt1 - n >= 0)

1195+ assertM(cnt1 - n >= 0)

11951196 fstep fs b >>= handleCollect (Partial n) (Done n)

11961197 Error _ -> Done cnt1 <$> fextract fs

11971198

core/src/assert.hsnew file+6

@@ -0,0 +1,6 @@

1+-- A convenient macro to assert in a do block. We cannot define this as a

2+-- Haskell function because then the compiler reports the assert location

3+-- inside the wrapper function rather than the original location.

5+import Control.Exception (assert)

6+#define assertM(p) assert (p) (return ())

src/assert.hsnew file+6

@@ -0,0 +1,6 @@

1+-- A convenient macro to assert in a do block. We cannot define this as a

2+-- Haskell function because then the compiler reports the assert location

3+-- inside the wrapper function rather than the original location.

5+import Control.Exception (assert)

6+#define assertM(p) assert (p) (return ())

streamly.cabal+4−2

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

8585 src/Streamly/Internal/Data/Array/ArrayMacros.h

8686

8787 src/Streamly/Internal/FileSystem/Event/Darwin.h

88+ src/assert.hs

8889 src/config.h.in

8990 src/inline.hs

9091 test/Streamly/Test/Data/*.hs

@@ -124,11 +125,12 @@ extra-source-files:

124125 -- This is temporary as we will soon break this package out

125126 core/configure

126127 core/configure.ac

128+ core/src/assert.hs

129+ core/src/config.h.in

130+ core/src/inline.hs

127131 core/src/Streamly/Internal/Data/Stream/Instances.hs

128132 core/src/Streamly/Internal/Data/Array/ArrayMacros.h

129− core/src/inline.hs

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

131− core/src/config.h.in

132134 core/src/Streamly/Internal/BaseCompat.hs

133135 core/src/Streamly/Internal/Control/Exception.hs

134136 core/src/Streamly/Internal/Control/Monad.hs