[commit: vector] : Add internal checks (e48c3c2)

Geoffrey Mainland gmainlan at ghc.haskell.org
Fri Jul 19 14:24:50 CEST 2013


Repository : http://darcs.haskell.org/ghc.git/

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/e48c3c2dcdd8363851003eb4ef046f4db7d43801

>---------------------------------------------------------------

commit e48c3c2dcdd8363851003eb4ef046f4db7d43801
Author: Roman Leshchinskiy <rl at cse.unsw.edu.au>
Date:   Sat Oct 6 21:48:17 2012 +0000

    Add internal checks

>---------------------------------------------------------------

 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