From e725c277b13a747dc6d7e00dbf1c425b4e77ecbe Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Thu, 28 Nov 2019 20:15:54 +0000 Subject: [PATCH 1/2] Enable vector:unsafechecks flag --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 42d814a..0c548c0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -19,7 +19,7 @@ before_install: install: - cabal-1.24 update - - cabal-1.24 install --only-dependencies --enable-tests --enable-benchmarks + - cabal-1.24 install --constraint "vector +unsafechecks" --only-dependencies --enable-tests --enable-benchmarks script: - cabal-1.24 configure --enable-tests --enable-benchmarks From 96e86aa606f5e25fdf00227d77311ea0ca8cd54c Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Thu, 28 Nov 2019 21:24:23 +0000 Subject: [PATCH 2/2] Fix out-of-bounds errors in Timsort --- src/Data/Vector/Algorithms/Tim.hs | 54 +++++++++++++++++++------------ 1 file changed, 34 insertions(+), 20 deletions(-) diff --git a/src/Data/Vector/Algorithms/Tim.hs b/src/Data/Vector/Algorithms/Tim.hs index 819ee36..14b1b42 100644 --- a/src/Data/Vector/Algorithms/Tim.hs +++ b/src/Data/Vector/Algorithms/Tim.hs @@ -241,34 +241,41 @@ mergeLo cmp vec l m u tempBuf' = do gt a b = cmp a b == GT gte a b = cmp a b /= LT tmpBufLen = m - l - iter _ i _ _ _ _ _ _ | i >= tmpBufLen = return () - iter tmpBuf i j k _ _ _ _ | j >= u = do + + finalize tmpBuf i k = do let from = unsafeSlice i (tmpBufLen-i) tmpBuf to = unsafeSlice k (tmpBufLen-i) vec unsafeCopy to from + + iter _ i _ _ _ _ _ _ | i >= tmpBufLen = return () + iter tmpBuf i j k _ _ _ _ | j >= u = finalize tmpBuf i k iter tmpBuf i j k _ vj 0 _ = do i' <- gallopingSearchLeftPBounds (`gt` vj) tmpBuf i tmpBufLen let gallopLen = i' - i from = unsafeSlice i gallopLen tmpBuf to = unsafeSlice k gallopLen vec unsafeCopy to from - vi' <- unsafeRead tmpBuf i' - iter tmpBuf i' j (k+gallopLen) vi' vj minGallop minGallop + when (i' < tmpBufLen) $ do + vi' <- unsafeRead tmpBuf i' + iter tmpBuf i' j (k+gallopLen) vi' vj minGallop minGallop iter tmpBuf i j k vi _ _ 0 = do j' <- gallopingSearchLeftPBounds (`gte` vi) vec j u let gallopLen = j' - j from = slice j gallopLen vec to = slice k gallopLen vec unsafeMove to from - vj' <- unsafeRead vec j' - iter tmpBuf i j' (k+gallopLen) vi vj' minGallop minGallop + if j' >= u then finalize tmpBuf i (k + gallopLen) else do + vj' <- unsafeRead vec j' + iter tmpBuf i j' (k+gallopLen) vi vj' minGallop minGallop iter tmpBuf i j k vi vj ga gb | vj `gte` vi = do unsafeWrite vec k vi - vi' <- unsafeRead tmpBuf (i+1) - iter tmpBuf (i+1) j (k+1) vi' vj (ga-1) minGallop + when (i + 1 < tmpBufLen) $ do + vi' <- unsafeRead tmpBuf (i+1) + iter tmpBuf (i+1) j (k+1) vi' vj (ga-1) minGallop | otherwise = do unsafeWrite vec k vj - vj' <- unsafeRead vec (j+1) - iter tmpBuf i (j+1) (k+1) vi vj' minGallop (gb-1) + if j + 1 >= u then finalize tmpBuf i (k + 1) else do + vj' <- unsafeRead vec (j+1) + iter tmpBuf i (j+1) (k+1) vi vj' minGallop (gb-1) {-# INLINE mergeLo #-} -- | Merge the adjacent sorted slices [l,m) and [m,u) in vec. This is done by @@ -292,34 +299,41 @@ mergeHi cmp vec l m u tmpBuf' = do gt a b = cmp a b == GT gte a b = cmp a b /= LT tmpBufLen = u - m - iter _ _ j _ _ _ _ _ | j < 0 = return () - iter tmpBuf i j _ _ _ _ _ | i < l = do + + finalize tmpBuf j = do let from = unsafeSlice 0 (j+1) tmpBuf to = unsafeSlice l (j+1) vec unsafeCopy to from + + iter _ _ j _ _ _ _ _ | j < 0 = return () + iter tmpBuf i j _ _ _ _ _ | i < l = finalize tmpBuf j iter tmpBuf i j k _ vj 0 _ = do i' <- gallopingSearchRightPBounds (`gt` vj) vec l i let gallopLen = i - i' from = slice (i'+1) gallopLen vec to = slice (k-gallopLen+1) gallopLen vec unsafeMove to from - vi' <- unsafeRead vec i' - iter tmpBuf i' j (k-gallopLen) vi' vj minGallop minGallop + if i' < l then finalize tmpBuf j else do + vi' <- unsafeRead vec i' + iter tmpBuf i' j (k-gallopLen) vi' vj minGallop minGallop iter tmpBuf i j k vi _ _ 0 = do j' <- gallopingSearchRightPBounds (`gte` vi) tmpBuf 0 j let gallopLen = j - j' from = slice (j'+1) gallopLen tmpBuf to = slice (k-gallopLen+1) gallopLen vec unsafeCopy to from - vj' <- unsafeRead tmpBuf j' - iter tmpBuf i j' (k-gallopLen) vi vj' minGallop minGallop + when (j' >= 0) $ do + vj' <- unsafeRead tmpBuf j' + iter tmpBuf i j' (k-gallopLen) vi vj' minGallop minGallop iter tmpBuf i j k vi vj ga gb | vi `gt` vj = do unsafeWrite vec k vi - vi' <- unsafeRead vec (i-1) - iter tmpBuf (i-1) j (k-1) vi' vj (ga-1) minGallop + if i - 1 < l then finalize tmpBuf j else do + vi' <- unsafeRead vec (i-1) + iter tmpBuf (i-1) j (k-1) vi' vj (ga-1) minGallop | otherwise = do unsafeWrite vec k vj - vj' <- unsafeRead tmpBuf (j-1) - iter tmpBuf i (j-1) (k-1) vi vj' minGallop (gb-1) + when (j - 1 >= 0) $ do + vj' <- unsafeRead tmpBuf (j-1) + iter tmpBuf i (j-1) (k-1) vi vj' minGallop (gb-1) {-# INLINE mergeHi #-} -- | Merge the adjacent sorted slices A=[l,m) and B=[m,u) in vec. This begins