Group :: Desenvolvimento/Haskell
RPM: ghc8.6.4-vector-algorithms
Navegação
Main Changelog Spec Patches Sources Download Gear Bugs e FR Repocop
Patch: ghc8.6.4-vector-algorithms-0.8.0.3-alt1.patch
Download
Download
CHANGELOG.md | 10 ++++++
src/Data/Vector/Algorithms/AmericanFlag.hs | 1 +
src/Data/Vector/Algorithms/Heap.hs | 4 +--
src/Data/Vector/Algorithms/Tim.hs | 54 +++++++++++++++++++-----------
vector-algorithms.cabal | 8 +++--
5 files changed, 52 insertions(+), 25 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100755
index 0000000..b4ef00f
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,10 @@
+## Version 0.8.0.3 (2019-12-02)
+
+- Fix out-of-bounds access in Timsort.
+
+## Version 0.8.0.2 (2019-11-28)
+
+- Bump upper bounds on primitive and QuickCheck.
+- Expose 'terminate' function from 'AmericanFlag' module.
+- Fix an off-by-one error in Data.Vector.Algorithms.Heaps.heapInsert.
+
diff --git a/src/Data/Vector/Algorithms/AmericanFlag.hs b/src/Data/Vector/Algorithms/AmericanFlag.hs
index bfc09e0..ac6c841 100644
--- a/src/Data/Vector/Algorithms/AmericanFlag.hs
+++ b/src/Data/Vector/Algorithms/AmericanFlag.hs
@@ -28,6 +28,7 @@
module Data.Vector.Algorithms.AmericanFlag ( sort
, sortBy
+ , terminate
, Lexicographic(..)
) where
diff --git a/src/Data/Vector/Algorithms/Heap.hs b/src/Data/Vector/Algorithms/Heap.hs
index 20cd8d7..7bc84a7 100644
--- a/src/Data/Vector/Algorithms/Heap.hs
+++ b/src/Data/Vector/Algorithms/Heap.hs
@@ -265,8 +265,8 @@ heapInsert cmp v l u e = sift (u - l)
where
sift k
| k <= 0 = unsafeWrite v l e
- | otherwise = let pi = l + shiftR (k-1) 2
- in unsafeRead v pi >>= \p -> case cmp p e of
+ | otherwise = let pi = shiftR (k-1) 2
+ in unsafeRead v (l + pi) >>= \p -> case cmp p e of
LT -> unsafeWrite v (l + k) p >> sift pi
_ -> unsafeWrite v (l + k) e
{-# INLINE heapInsert #-}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
diff --git a/vector-algorithms.cabal b/vector-algorithms.cabal
index 59e51a0..3f69abc 100644
--- a/vector-algorithms.cabal
+++ b/vector-algorithms.cabal
@@ -1,5 +1,5 @@
name: vector-algorithms
-version: 0.8.0.1
+version: 0.8.0.3
license: BSD3
license-file: LICENSE
author: Dan Doel
@@ -14,6 +14,8 @@ description: Efficient algorithms for sorting vector arrays. At some stage
other vector algorithms may be added.
build-type: Simple
cabal-version: >= 1.9.2
+extra-source-files: CHANGELOG.md
+
flag BoundsChecks
description: Enable bounds checking
@@ -55,7 +57,7 @@ library
build-depends: base >= 4.5 && < 5,
vector >= 0.6 && < 0.13,
- primitive >=0.3 && <0.7,
+ primitive >=0.3 && <0.8,
bytestring >= 0.9 && < 1.0
if ! impl (ghc >= 7.8)
@@ -139,7 +141,7 @@ test-suite properties
base,
bytestring,
containers,
- QuickCheck > 2.9 && < 2.13,
+ QuickCheck > 2.9 && < 2.14,
vector,
vector-algorithms