[commit: packages/vector] ghc-head: Add internal checks (6d54109)
git at git.haskell.org
git at git.haskell.org
Thu Sep 26 11:54:26 CEST 2013
Repository : ssh://git@git.haskell.org/vector
On branch : ghc-head
Link : http://git.haskell.org/packages/vector.git/commitdiff/6d54109c2343b2466f8e5723728c0f9c189b2de7
>---------------------------------------------------------------
commit 6d54109c2343b2466f8e5723728c0f9c189b2de7
Author: Roman Leshchinskiy <rl at cse.unsw.edu.au>
Date: Sat Oct 6 21:48:17 2012 +0000
Add internal checks
>---------------------------------------------------------------
6d54109c2343b2466f8e5723728c0f9c189b2de7
Data/Vector/Fusion/Bundle/Monadic.hs | 8 ++++++--
Data/Vector/Generic/Mutable.hs | 10 ++++++----
2 files changed, 12 insertions(+), 6 deletions(-)
diff --git a/Data/Vector/Fusion/Bundle/Monadic.hs b/Data/Vector/Fusion/Bundle/Monadic.hs
index 4cbe3af..a487d7f 100644
--- a/Data/Vector/Fusion/Bundle/Monadic.hs
+++ b/Data/Vector/Fusion/Bundle/Monadic.hs
@@ -1704,7 +1704,9 @@ fromVectors vs = Bundle (Unf pstep (Left vs))
vstep :: [v a] -> m (Step [v a] (Chunk v a))
vstep [] = return Done
vstep (v:vs) = return $ Yield (Chunk (basicLength v)
- (\mv -> basicUnsafeCopy mv v)) vs
+ (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"
+ (M.basicLength mv == basicLength v)
+ $ basicUnsafeCopy mv v)) vs
concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a
@@ -1732,7 +1734,9 @@ concatVectors Bundle{sElems = Unf step s}
r <- step s
case r of
Yield v s' -> return (Yield (Chunk (basicLength v)
- (\mv -> basicUnsafeCopy mv v)) s')
+ (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"
+ (M.basicLength mv == basicLength v)
+ $ basicUnsafeCopy mv v)) s')
Skip s' -> return (Skip s')
Done -> return Done
diff --git a/Data/Vector/Generic/Mutable.hs b/Data/Vector/Generic/Mutable.hs
index 6726e64..12d9143 100644
--- a/Data/Vector/Generic/Mutable.hs
+++ b/Data/Vector/Generic/Mutable.hs
@@ -413,9 +413,10 @@ vmunstreamMax s n
v <- INTERNAL_CHECK(checkLength) "munstreamMax" n
$ unsafeNew n
let {-# INLINE_INNER copy #-}
- copy i (Chunk n f) = do
- f (basicUnsafeSlice i n v)
- return (i+n)
+ copy i (Chunk n f) =
+ INTERNAL_CHECK(checkSlice) "munstreamMax.copy" i n (length v) $ do
+ f (basicUnsafeSlice i n v)
+ return (i+n)
n' <- MBundle.vfoldlM' copy 0 s
return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n
@@ -438,7 +439,8 @@ vmunstreamUnknown s
v' <- if basicLength v < j
then unsafeGrow v (delay_inline max (enlarge_delta v) (j - basicLength v))
else return v
- f (basicUnsafeSlice i n v')
+ INTERNAL_CHECK(checkSlice) "munstreamUnknown.copy" i n (length v')
+ $ f (basicUnsafeSlice i n v')
return (v',j)
More information about the ghc-commits
mailing list