cc3bbd7 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Use a macro definition for assertM

cc3bbd7Harendra Kumar4 years ago

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

compare with master

unifiedsplit

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

10-- Additional "Control.Exception" utilities.

12module Streamly.Internal.Control.Exception

13− ( assertM

14− , verify

13+ ( verify

15 , verifyM

14 , verifyM

16 )

15 )

17where

16where

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−

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

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

31-- production code.

19-- production code.

32--

20--

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

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

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

211-- some actions for correctness.

212

213+#include "assert.hs"

213#include "inline.hs"

214#include "inline.hs"

214#include "ArrayMacros.h"

215#include "ArrayMacros.h"

215#include "MachDeps.h"

216#include "MachDeps.h"

216

217

217−import Control.Exception (assert)

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

219import Control.Monad (when, void)

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

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

225import Data.Word (Word8)

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

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

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

229import Streamly.Internal.Data.Unboxed

228import Streamly.Internal.Data.Unboxed

230 ( ArrayContents(..)

229 ( ArrayContents(..)

231 , Unboxed

230 , Unboxed

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

722{-# NOINLINE reallocAligned #-}

721{-# NOINLINE reallocAligned #-}

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

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

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

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

725− assertM (aEnd <= aBound)

724+ assertM(aEnd <= aBound)

726

725

727 -- Allocate new array

726 -- Allocate new array

728 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes

727 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes

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

776 newCapBytes = capSizer oldSizeBytes

775 newCapBytes = capSizer oldSizeBytes

777 newSizeBytes = oldSizeBytes + minIncrBytes

776 newSizeBytes = oldSizeBytes + minIncrBytes

778 safeCapBytes = max newCapBytes newSizeBytes

777 safeCapBytes = max newCapBytes newSizeBytes

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

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

780

779

781 realloc safeCapBytes arr

780 realloc safeCapBytes arr

782

781

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

2023{-# INLINE putSliceUnsafe #-}

2022{-# INLINE putSliceUnsafe #-}

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

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

2025putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do

2024putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do

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

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

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

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

2028 let !(I# srcStartBytes#) = srcStartBytes

2027 let !(I# srcStartBytes#) = srcStartBytes

2029 !(I# dstStartBytes#) = dstStartBytes

2028 !(I# dstStartBytes#) = dstStartBytes

2030 !(I# lenBytes#) = lenBytes

2029 !(I# lenBytes#) = lenBytes

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

2065 let startSrc = arrStart src

2064 let startSrc = arrStart src

2066 srcLen = aEnd src - startSrc

2065 srcLen = aEnd src - startSrc

2067 endDst = aEnd dst

2066 endDst = aEnd dst

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

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

2069 putSliceUnsafe src startSrc dst endDst srcLen

2068 putSliceUnsafe src startSrc dst endDst srcLen

2070 return $ dst {aEnd = endDst + srcLen}

2069 return $ dst {aEnd = endDst + srcLen}

2071

2070

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

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

196 )

197where

198

199+#include "assert.hs"

200+

199import Control.Exception (Exception)

201import Control.Exception (Exception)

200import Control.Monad (when)

202import Control.Monad (when)

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

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

202import Data.Bifunctor (first)

204import Data.Bifunctor (first)

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

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

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

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

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

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

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

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

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

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

1705 IError e -> return $ IError e

1706 IError e -> return $ IError e

1706

1707

1707 step (Tuple' cnt r) a = do

1708 step (Tuple' cnt r) a = do

1708− assertM (cnt < lim)

1709+ assertM(cnt < lim)

1709 res <- pstep r a

1710 res <- pstep r a

1710 let cnt1 = cnt + 1

1711 let cnt1 = cnt + 1

1711 case res of

1712 case res of

1712 Partial 0 s -> do

1713 Partial 0 s -> do

1713− assertM (cnt1 >= 0)

1714+ assertM(cnt1 >= 0)

1714 if cnt1 < lim

1715 if cnt1 < lim

1715 then return $ Partial 0 $ Tuple' cnt1 s

1716 then return $ Partial 0 $ Tuple' cnt1 s

1716 else Done 0 <$> pextract s

1717 else Done 0 <$> pextract s

1717 Continue 0 s -> do

1718 Continue 0 s -> do

1718− assertM (cnt1 >= 0)

1719+ assertM(cnt1 >= 0)

1719 if cnt1 < lim

1720 if cnt1 < lim

1720 then return $ Continue 0 $ Tuple' cnt1 s

1721 then return $ Continue 0 $ Tuple' cnt1 s

1721 -- XXX This should error out?

1722 -- XXX This should error out?

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

1732 else Done 0 <$> pextract s

1733 else Done 0 <$> pextract s

1733 Partial n s -> do

1734 Partial n s -> do

1734 let taken = cnt1 - n

1735 let taken = cnt1 - n

1735− assertM (taken >= 0)

1736+ assertM(taken >= 0)

1736 return $ Partial n $ Tuple' taken s

1737 return $ Partial n $ Tuple' taken s

1737 Continue n s -> do

1738 Continue n s -> do

1738 let taken = cnt1 - n

1739 let taken = cnt1 - n

1739− assertM (taken >= 0)

1740+ assertM(taken >= 0)

1740 return $ Continue n $ Tuple' taken s

1741 return $ Continue n $ Tuple' taken s

1741 Done n b -> return $ Done n b

1742 Done n b -> return $ Done n b

1742 Error str -> return $ Error str

1743 Error str -> return $ Error str

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

2131 case r of

2132 case r of

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

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

2133 Continue n s -> do

2134 Continue n s -> do

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

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

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

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

2136 Done n _ -> do

2137 Done n _ -> do

2137 b <- fextract fs

2138 b <- fextract fs

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

2157 case r of

2158 case r of

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

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

2159 Continue n s -> do

2160 Continue n s -> do

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

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

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

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

2162 Done n b -> do

2163 Done n b -> do

2163 fs1 <- fstep fs b

2164 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

207 )

208where

209

210+#include "assert.hs"

211+

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

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

211import Control.Exception (Exception(..))

213import Control.Exception (Exception(..))

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

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

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

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

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

217import Data.Bifunctor (Bifunctor(..))

219import Data.Bifunctor (Bifunctor(..))

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

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

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

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

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

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

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

222

223

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

505 pRes <- pstep r x

506 pRes <- pstep r x

506 case pRes of

507 case pRes of

507 Done n b -> do

508 Done n b -> do

508− assertM (n <= cnt1)

509+ assertM(n <= cnt1)

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

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

510 Error err ->

511 Error err ->

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

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

512 Partial n pst1 -> do

513 Partial n pst1 -> do

513− assertM (n <= cnt1)

514+ assertM(n <= cnt1)

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

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

515 Continue n pst1 -> do

516 Continue n pst1 -> do

516− assertM (n <= cnt1)

517+ assertM(n <= cnt1)

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

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

518 parseCont cnt acc Nothing = do

519 parseCont cnt acc Nothing = do

519 pst <- acc

520 pst <- acc

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

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

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

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

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

586 step (FPKDone n b) _ = do

587 step (FPKDone n b) _ = do

587− assertM (n == 0)

588+ assertM(n == 0)

588 return $ Done (n + 1) b

589 return $ Done (n + 1) b

589 step (FPKCont cont) a = do

590 step (FPKCont cont) a = do

590 r <- cont (Just a)

591 r <- cont (Just a)

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

981 case r of

982 case r of

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

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

983 Continue n s -> do

984 Continue n s -> do

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

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

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

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

986 Done n b -> return $ Done n b

987 Done n b -> return $ Done n b

987 Error _ -> do

988 Error _ -> do

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

1038 let cnt1 = cnt + 1

1039 let cnt1 = cnt + 1

1039 case r of

1040 case r of

1040 Partial n s -> do

1041 Partial n s -> do

1041− assertM (cnt1 - n >= 0)

1042+ assertM(cnt1 - n >= 0)

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

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

1043 Continue n s -> do

1044 Continue n s -> do

1044− assertM (cnt1 - n >= 0)

1045+ assertM(cnt1 - n >= 0)

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

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

1046 Done n b -> do

1047 Done n b -> do

1047− assertM (cnt1 - n >= 0)

1048+ assertM(cnt1 - n >= 0)

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

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

1049 Error _ -> do

1050 Error _ -> do

1050 xs <- fextract fs

1051 xs <- fextract fs

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

1098 let cnt1 = cnt + 1

1099 let cnt1 = cnt + 1

1099 case r of

1100 case r of

1100 Partial n s -> do

1101 Partial n s -> do

1101− assertM (cnt1 - n >= 0)

1102+ assertM(cnt1 - n >= 0)

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

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

1103 Continue n s -> do

1104 Continue n s -> do

1104− assertM (cnt1 - n >= 0)

1105+ assertM(cnt1 - n >= 0)

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

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

1106 Done n b -> do

1107 Done n b -> do

1107− assertM (cnt1 - n >= 0)

1108+ assertM(cnt1 - n >= 0)

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

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

1109 Error _ -> do

1110 Error _ -> do

1110 xs <- fextract fs

1111 xs <- fextract fs

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

1171 let cnt1 = cnt + 1

1172 let cnt1 = cnt + 1

1172 case r of

1173 case r of

1173 Partial n s -> do

1174 Partial n s -> do

1174− assertM (cnt1 - n >= 0)

1175+ assertM(cnt1 - n >= 0)

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

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

1176 Continue n s -> do

1177 Continue n s -> do

1177− assertM (cnt1 - n >= 0)

1178+ assertM(cnt1 - n >= 0)

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

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

1179 Done n b -> do

1180 Done n b -> do

1180− assertM (cnt1 - n >= 0)

1181+ assertM(cnt1 - n >= 0)

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

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

1182 Error err -> return $ Error err

1183 Error err -> return $ Error err

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

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

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

1185 let cnt1 = cnt + 1

1186 let cnt1 = cnt + 1

1186 case r of

1187 case r of

1187 Partial n s -> do

1188 Partial n s -> do

1188− assertM (cnt1 - n >= 0)

1189+ assertM(cnt1 - n >= 0)

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

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

1190 Continue n s -> do

1191 Continue n s -> do

1191− assertM (cnt1 - n >= 0)

1192+ assertM(cnt1 - n >= 0)

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

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

1193 Done n b -> do

1194 Done n b -> do

1194− assertM (cnt1 - n >= 0)

1195+ assertM(cnt1 - n >= 0)

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

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

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

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

1197

1198

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:

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

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

88+ src/assert.hs

88 src/config.h.in

89 src/config.h.in

89 src/inline.hs

90 src/inline.hs

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

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

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

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

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

125 core/configure

126 core/configure

126 core/configure.ac

127 core/configure.ac

128+ core/src/assert.hs

129+ core/src/config.h.in

130+ core/src/inline.hs

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

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

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

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

129− core/src/inline.hs

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

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

131− core/src/config.h.in

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

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

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

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

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

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