psqueues 0.2.7.3 → 0.2.8.0
raw patch · 7 files changed
+57/−95 lines, 7 filesdep −fingertree-psqueuedep ~QuickCheckdep ~deepseqdep ~hashablePVP ok
version bump matches the API change (PVP)
Dependencies removed: fingertree-psqueue
Dependency ranges changed: QuickCheck, deepseq, hashable, tasty, tasty-quickcheck
API changes (from Hackage documentation)
Files
- CHANGELOG +17/−0
- benchmarks/Data/FingerTree/PSQueue/Benchmark.hs +0/−61
- benchmarks/Main.hs +0/−4
- psqueues.cabal +4/−5
- src/Data/IntPSQ/Internal.hs +9/−17
- src/Data/OrdPSQ/Internal.hs +22/−6
- tests/Data/PSQ/Class/Tests.hs +5/−2
CHANGELOG view
@@ -1,5 +1,22 @@ # CHANGELOG +- 0.2.8.0 (2022-10-27)+ * Add a number of minor optimizations and INLINE pragmas:+ - The previous `INLINABLE` pragmas were insufficient to fully specialize+ functions. Add a bunch more. I believe they now do the job they were+ meant to.+ - Change the way we check for very short queues in `lbalance` and+ `rbalance` to avoid redundant size comparisons in the non-short+ case.+ - Make the fields of `Play` strict. I doubt this makes any practical+ difference, since `tourView` is `INLINE`, but in fact the fields are+ always in WHNF, so we might as well make that explicitly clear.+ * Fix a bug in `fromList`. It previously used the *first* occurrence+ of a duplicated key; it now uses the *last* occurrence, as documented.+ * Cleanup: refactor `binShrinkL` and `binShrinkR` into `bin`.+ * Bump deepseq upper bound to 1.6+ * Bump tasty upper bound to 1.6+ - 0.2.7.3 (2021-11-05) * Relax hashable, tasty and QuickCheck upper bounds * Bump Cabal-version to 1.10
− benchmarks/Data/FingerTree/PSQueue/Benchmark.hs
@@ -1,61 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- | This module contains benchmarks for the 'PSQueue' type from the--- `fingertree-psqueue` package.-module Data.FingerTree.PSQueue.Benchmark- ( benchmark- ) where--import Data.List (foldl')-import Data.FingerTree.PSQueue (Binding (..))-import qualified Data.FingerTree.PSQueue as PSQueue-import Criterion.Main-import Prelude hiding (lookup)-import BenchmarkTypes-import Data.Maybe (fromMaybe)--benchmark :: String -> [BElem] -> BenchmarkSet-benchmark name elems = BenchmarkSet- { bGroupName = name- , bMinView = whnf bench_minView initialPSQ- , bLookup = whnf (bench_lookup keys) initialPSQ- , bInsertEmpty = nf' (bench_insert firstElems) PSQueue.empty- , bInsertNew = nf' (bench_insert secondElems) initialPSQ- , bInsertDuplicates = nf' (bench_insert firstElems) initialPSQ- , bDelete = nf' (bench_delete firstKeys) initialPSQ- }- where- (firstElems, secondElems) = splitAt (numElems `div` 2) elems- numElems = length elems- keys = map (\(x, _, _) -> x) elems- firstKeys = map (\(x, _, _) -> x) firstElems-- initialPSQ :: PSQueue.PSQ Int Int- initialPSQ = PSQueue.fromList $ map toBinding firstElems-- toBinding :: BElem -> Binding Int Int- toBinding (k, p, _) = k :-> p-- -- Get the size of the resulting PSQs, since there's no NFData instance- nf' f x = whnf (PSQueue.size . f) x--bench_lookup :: [Int] -> PSQueue.PSQ Int Int -> Int-bench_lookup xs m = foldl' (\n k -> fromMaybe n (PSQueue.lookup k m)) 0 xs--bench_insert :: [BElem] -> PSQueue.PSQ Int Int -> PSQueue.PSQ Int Int-bench_insert xs m0 = foldl' (\m (k, p, _) -> fingerInsert k p m) m0 xs- where- fingerInsert- :: (Ord k, Ord v) => k -> v -> PSQueue.PSQ k v -> PSQueue.PSQ k v- fingerInsert k v m = PSQueue.alter (const $ Just v) k m--bench_minView :: PSQueue.PSQ Int Int -> Int-bench_minView = go 0- where- go !n t = case PSQueue.minView t of- Nothing -> n- Just ((k :-> x), t') -> go (n + k + x) t'---- Empty a queue by sequentially removing all elements-bench_delete :: [Int] -> PSQueue.PSQ Int Int -> PSQueue.PSQ Int Int-bench_delete keys t0 = foldl' (\t k -> PSQueue.delete k t) t0 keys
benchmarks/Main.hs view
@@ -10,7 +10,6 @@ import qualified Data.IntPSQ.Benchmark as IntPSQ import qualified Data.HashPSQ.Benchmark as HashPSQ import qualified Data.PSQueue.Benchmark as PSQueue-import qualified Data.FingerTree.PSQueue.Benchmark as FingerPSQ benchmarkSize :: Int benchmarkSize = 2 ^ (12 :: Int)@@ -47,7 +46,4 @@ , PSQueue.benchmark "PSQueue increasing" increasing , PSQueue.benchmark "PSQueue decreasing" decreasing , PSQueue.benchmark "PSQueue semirandom" semirandom- , FingerPSQ.benchmark "FingerTree PSQueue increasing" increasing- , FingerPSQ.benchmark "FingerTree PSQueue decreasing" decreasing- , FingerPSQ.benchmark "FingerTree PSQueue semirandom" semirandom ]
psqueues.cabal view
@@ -1,5 +1,5 @@ Name: psqueues-Version: 0.2.7.3+Version: 0.2.8.0 License: BSD3 License-file: LICENSE Maintainer: Jasper Van der Jeugt <jaspervdj@gmail.com>@@ -8,6 +8,7 @@ Category: Data Structures Build-type: Simple Cabal-version: >=1.10+Tested-with: GHC==9.6.1, GHC==9.4.2, GHC==9.2.2, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 Description: The psqueues package provides@@ -66,7 +67,7 @@ Build-depends: base >= 4.2 && < 5- , deepseq >= 1.2 && < 1.5+ , deepseq >= 1.2 && < 1.6 , hashable >= 1.1.2.3 && < 1.5 if impl(ghc>=6.10)@@ -92,7 +93,6 @@ Other-modules: BenchmarkTypes Data.BitUtil- Data.FingerTree.PSQueue.Benchmark Data.HashPSQ Data.HashPSQ.Benchmark Data.HashPSQ.Internal@@ -109,7 +109,6 @@ , unordered-containers >= 0.2.4 , criterion >= 0.8 , mtl >= 2.1- , fingertree-psqueue >= 0.3 , PSQueue >= 1.1 , random >= 1.0 @@ -146,7 +145,7 @@ Build-depends: HUnit >= 1.2 && < 1.7 , QuickCheck >= 2.7 && < 2.15- , tasty >= 1.2 && < 1.5+ , tasty >= 1.2 && < 1.6 , tasty-hunit >= 0.9 && < 0.11 , tasty-quickcheck >= 0.8 && < 0.11
src/Data/IntPSQ/Internal.hs view
@@ -282,8 +282,8 @@ Bin k' p' x' m l r | nomatch k k' m -> t | k == k' -> merge m l r- | zero k m -> binShrinkL k' p' x' m (go l) r- | otherwise -> binShrinkR k' p' x' m l (go r)+ | zero k m -> bin k' p' x' m (go l) r+ | otherwise -> bin k' p' x' m l (go r) -- | /O(min(n,W))/ Delete the binding with the least priority, and return the -- rest of the queue stripped of that binding. In case the queue is empty, the@@ -336,19 +336,11 @@ | p' <= p -> (b, Bin k p' x' m l r) | otherwise -> (b, unsafeInsertNew k p' x' (merge m l r)) --- | Smart constructor for a 'Bin' node whose left subtree could have become--- 'Nil'.-{-# INLINE binShrinkL #-}-binShrinkL :: Key -> p -> v -> Mask -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v-binShrinkL k p x m Nil r = case r of Nil -> Tip k p x; _ -> Bin k p x m Nil r-binShrinkL k p x m l r = Bin k p x m l r---- | Smart constructor for a 'Bin' node whose right subtree could have become--- 'Nil'.-{-# INLINE binShrinkR #-}-binShrinkR :: Key -> p -> v -> Mask -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v-binShrinkR k p x m l Nil = case l of Nil -> Tip k p x; _ -> Bin k p x m l Nil-binShrinkR k p x m l r = Bin k p x m l r+-- | Smart constructor for a 'Bin' node.+{-# INLINE bin #-}+bin :: Key -> p -> v -> Mask -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v+bin k p x _ Nil Nil = Tip k p x+bin k p x m l r = Bin k p x m l r ------------------------------------------------------------------------------@@ -413,11 +405,11 @@ in t' `seq` (# t', Just (p', x') #) | zero k m -> case delFrom l of- (# l', mbPX #) -> let t' = binShrinkL k' p' x' m l' r+ (# l', mbPX #) -> let t' = bin k' p' x' m l' r in t' `seq` (# t', mbPX #) | otherwise -> case delFrom r of- (# r', mbPX #) -> let t' = binShrinkR k' p' x' m l r'+ (# r', mbPX #) -> let t' = bin k' p' x' m l r' in t' `seq` (# t', mbPX #) -- | /O(min(n,W))/ Retrieve the binding with the least priority, and the
src/Data/OrdPSQ/Internal.hs view
@@ -71,7 +71,7 @@ ) where import Control.DeepSeq (NFData (rnf))-import Data.Foldable (Foldable (foldr))+import Data.Foldable (Foldable (foldl')) import qualified Data.List as List import Data.Maybe (isJust) import Data.Traversable@@ -290,7 +290,7 @@ -- last priority and value for the key is retained. {-# INLINABLE fromList #-} fromList :: (Ord k, Ord p) => [(k, p, v)] -> OrdPSQ k p v-fromList = foldr (\(k, p, v) q -> insert k p v q) empty+fromList = foldl' (\q (k, p, v) -> insert k p v q) empty -- | /O(n)/ Convert a queue to a list of (key, priority, value) tuples. The -- order of the list is not specified.@@ -302,7 +302,7 @@ keys t = [k | (k, _, _) <- toList t] -- TODO (jaspervdj): There must be faster implementations. --- | /O(n)/ Convert to an ascending list.+-- | /O(n)/ Convert to a list in ascending order by key. toAscList :: OrdPSQ k p v -> [(k, p, v)] toAscList q = seqToList (toAscLists q) where@@ -352,6 +352,7 @@ minView Void = Nothing minView (Winner (E k p v) t m) = Just (k, p, v, secondBest t m) +{-# INLINABLE secondBest #-} secondBest :: (Ord k, Ord p) => LTree k p v -> k -> OrdPSQ k p v secondBest Start _ = Void secondBest (LLoser _ e tl m tr) m' = Winner e tl m `play` secondBest tr m'@@ -360,6 +361,7 @@ -- | Return a list of elements ordered by key whose priorities are at most @pt@, -- and the rest of the queue stripped of these elements. The returned list of -- elements can be in any order: no guarantees there.+{-# INLINABLE atMostView #-} atMostView :: (Ord k, Ord p) => p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v) atMostView pt = go [] where@@ -448,7 +450,7 @@ data TourView k p v = Null | Single {-# UNPACK #-} !(Elem k p v)- | Play (OrdPSQ k p v) (OrdPSQ k p v)+ | Play !(OrdPSQ k p v) !(OrdPSQ k p v) tourView :: OrdPSQ k p v -> TourView k p v tourView Void = Null@@ -508,21 +510,26 @@ lloser k p v tl m tr = LLoser (1 + size' tl + size' tr) (E k p v) tl m tr rloser k p v tl m tr = RLoser (1 + size' tl + size' tr) (E k p v) tl m tr +{-# INLINABLE lbalance #-}+{-# INLINABLE rbalance #-} lbalance, rbalance :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v+lbalance k p v Start m r = lloser k p v Start m r+lbalance k p v l m Start = lloser k p v l m Start lbalance k p v l m r- | size' l + size' r < 2 = lloser k p v l m r | size' r > omega * size' l = lbalanceLeft k p v l m r | size' l > omega * size' r = lbalanceRight k p v l m r | otherwise = lloser k p v l m r +rbalance k p v Start m r = rloser k p v Start m r+rbalance k p v l m Start = rloser k p v l m Start rbalance k p v l m r- | size' l + size' r < 2 = rloser k p v l m r | size' r > omega * size' l = rbalanceLeft k p v l m r | size' l > omega * size' r = rbalanceRight k p v l m r | otherwise = rloser k p v l m r +{-# INLINABLE lbalanceLeft #-} lbalanceLeft :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -530,6 +537,7 @@ | size' (left r) < size' (right r) = lsingleLeft k p v l m r | otherwise = ldoubleLeft k p v l m r +{-# INLINABLE lbalanceRight #-} lbalanceRight :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -537,6 +545,7 @@ | size' (left l) > size' (right l) = lsingleRight k p v l m r | otherwise = ldoubleRight k p v l m r +{-# INLINABLE rbalanceLeft #-} rbalanceLeft :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -544,6 +553,7 @@ | size' (left r) < size' (right r) = rsingleLeft k p v l m r | otherwise = rdoubleLeft k p v l m r +{-# INLINABLE rbalanceRight #-} rbalanceRight :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -551,6 +561,7 @@ | size' (left l) > size' (right l) = rsingleRight k p v l m r | otherwise = rdoubleRight k p v l m r +{-# INLINABLE lsingleLeft #-} lsingleLeft :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -577,6 +588,7 @@ lloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3) lsingleRight _ _ _ _ _ _ = moduleError "lsingleRight" "malformed tree" +{-# INLINABLE rsingleRight #-} rsingleRight :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -589,6 +601,7 @@ rloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3) rsingleRight _ _ _ _ _ _ = moduleError "rsingleRight" "malformed tree" +{-# INLINABLE ldoubleLeft #-} ldoubleLeft :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -598,6 +611,7 @@ lsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3) ldoubleLeft _ _ _ _ _ _ = moduleError "ldoubleLeft" "malformed tree" +{-# INLINABLE ldoubleRight #-} ldoubleRight :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -607,6 +621,7 @@ lsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3 ldoubleRight _ _ _ _ _ _ = moduleError "ldoubleRight" "malformed tree" +{-# INLINABLE rdoubleLeft #-} rdoubleLeft :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v@@ -616,6 +631,7 @@ rsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3) rdoubleLeft _ _ _ _ _ _ = moduleError "rdoubleLeft" "malformed tree" +{-# INLINABLE rdoubleRight #-} rdoubleRight :: (Ord k, Ord p) => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
tests/Data/PSQ/Class/Tests.hs view
@@ -178,9 +178,12 @@ :: forall psq. (PSQ psq, TestKey (Key psq), Eq (psq Int Char), Show (psq Int Char)) => Tagged psq Assertion-test_fromList = Tagged $+test_fromList = Tagged $ do let ls = [(1, 0, 'A'), (2, 0, 'B'), (3, 0, 'C'), (4, 0, 'D')]- in (fromList ls :: psq Int Char) @?= fromList (reverse ls)+ in (fromList ls :: psq Int Char) @?= fromList (reverse ls)+ let qs = [(4, 0, 'D'), (1, 5, 'Q'), (2, 0, 'B'), (1, 0, 'A'), (3, 0, 'C'), (2, 5, 'Z')]+ qs' = [(1, 0, 'A'), (2, 5, 'Z'), (3, 0, 'C'), (4, 0, 'D')]+ in List.sort (toList (fromList qs :: psq Int Char)) @?= qs' test_foldr :: forall psq. (PSQ psq, TestKey (Key psq),