diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 350168c3..1bc148d6 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.13.20211116 +# version: 0.14.1 # -# REGENDATA ("0.13.20211116",["github","unordered-containers.cabal"]) +# REGENDATA ("0.14.1",["github","unordered-containers.cabal"]) # name: Haskell-CI on: @@ -37,10 +37,10 @@ jobs: compilerVersion: 9.2.1 setup-method: ghcup allow-failure: false - - compiler: ghc-9.0.1 + - compiler: ghc-9.0.2 compilerKind: ghc - compilerVersion: 9.0.1 - setup-method: hvr-ppa + compilerVersion: 9.0.2 + setup-method: ghcup allow-failure: false - compiler: ghc-8.10.7 compilerKind: ghc @@ -67,11 +67,6 @@ jobs: compilerVersion: 8.2.2 setup-method: hvr-ppa allow-failure: false - - compiler: ghc-8.0.2 - compilerKind: ghc - compilerVersion: 8.0.2 - setup-method: hvr-ppa - allow-failure: false fail-fast: false steps: - name: apt @@ -198,8 +193,8 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_unordered_containers}" >> cabal.project - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package unordered-containers" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + echo "package unordered-containers" >> cabal.project + echo " ghc-options: -Werror=missing-methods" >> cabal.project cat >> cabal.project <> cabal.project.local diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs index cf60bb43..65d4cf07 100644 --- a/Data/HashMap/Internal.hs +++ b/Data/HashMap/Internal.hs @@ -10,10 +10,8 @@ {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} -#if __GLASGOW_HASKELL__ >= 802 {-# LANGUAGE TypeInType #-} {-# LANGUAGE UnboxedSums #-} -#endif {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-} @@ -148,9 +146,7 @@ import Control.Monad.ST (ST, runST) import Data.Bits ((.&.), (.|.), complement, popCount, unsafeShiftL, unsafeShiftR) import Data.Data import qualified Data.Foldable as Foldable -#if MIN_VERSION_base(4,10,0) import Data.Bifoldable -#endif import qualified Data.List as L import GHC.Exts ((==#), build, reallyUnsafePtrEquality#, inline) import Prelude hiding (filter, foldl, foldr, lookup, map, null, pred) @@ -171,13 +167,9 @@ import GHC.Stack import qualified Data.Hashable.Lifted as H #endif -#if MIN_VERSION_deepseq(1,4,3) import qualified Control.DeepSeq as NF -#endif -#if __GLASGOW_HASKELL__ >= 802 import GHC.Exts (TYPE, Int (..), Int#) -#endif import Data.Functor.Identity (Identity (..)) import Control.Applicative (Const (..)) @@ -205,7 +197,6 @@ instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where lift (L k v) = [| L k $! v |] #endif -#if MIN_VERSION_deepseq(1,4,3) -- | @since 0.2.14.0 instance NFData k => NF.NFData1 (Leaf k) where liftRnf rnf2 = NF.liftRnf2 rnf rnf2 @@ -213,7 +204,6 @@ instance NFData k => NF.NFData1 (Leaf k) where -- | @since 0.2.14.0 instance NF.NFData2 Leaf where liftRnf2 rnf1 rnf2 (L k v) = rnf1 k `seq` rnf2 v -#endif -- Invariant: The length of the 1st argument to 'Full' is -- 2^bitsPerSubkey @@ -239,7 +229,6 @@ instance (NFData k, NFData v) => NFData (HashMap k v) where rnf (Full ary) = rnf ary rnf (Collision _ ary) = rnf ary -#if MIN_VERSION_deepseq(1,4,3) -- | @since 0.2.14.0 instance NFData k => NF.NFData1 (HashMap k) where liftRnf rnf2 = NF.liftRnf2 rnf rnf2 @@ -251,7 +240,6 @@ instance NF.NFData2 HashMap where liftRnf2 rnf1 rnf2 (Leaf _ l) = NF.liftRnf2 rnf1 rnf2 l liftRnf2 rnf1 rnf2 (Full ary) = NF.liftRnf (NF.liftRnf2 rnf1 rnf2) ary liftRnf2 rnf1 rnf2 (Collision _ ary) = NF.liftRnf (NF.liftRnf2 rnf1 rnf2) ary -#endif instance Functor (HashMap k) where fmap = map @@ -272,7 +260,6 @@ instance Foldable.Foldable (HashMap k) where length = size {-# INLINE length #-} -#if MIN_VERSION_base(4,10,0) -- | @since 0.2.11 instance Bifoldable HashMap where bifoldMap f g = foldMapWithKey (\ k v -> f k `mappend` g v) @@ -281,7 +268,6 @@ instance Bifoldable HashMap where {-# INLINE bifoldr #-} bifoldl f g = foldlWithKey (\ acc k v -> (acc `f` k) `g` v) {-# INLINE bifoldl #-} -#endif -- | '<>' = 'union' -- @@ -606,7 +592,6 @@ member k m = case lookup k m of -- | /O(log n)/ Return the value to which the specified key is mapped, -- or 'Nothing' if this map contains no mapping for the key. lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v -#if __GLASGOW_HASKELL__ >= 802 -- GHC does not yet perform a worker-wrapper transformation on -- unboxed sums automatically. That seems likely to happen at some -- point (possibly as early as GHC 8.6) but for now we do it manually. @@ -619,16 +604,9 @@ lookup# :: (Eq k, Hashable k) => k -> HashMap k v -> (# (# #) | v #) lookup# k m = lookupCont (\_ -> (# (# #) | #)) (\v _i -> (# | v #)) (hash k) k 0 m {-# INLINABLE lookup# #-} -#else - -lookup k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) (hash k) k 0 m -{-# INLINABLE lookup #-} -#endif - -- | lookup' is a version of lookup that takes the hash separately. -- It is used to implement alterF. lookup' :: Eq k => Hash -> k -> HashMap k v -> Maybe v -#if __GLASGOW_HASKELL__ >= 802 -- GHC does not yet perform a worker-wrapper transformation on -- unboxed sums automatically. That seems likely to happen at some -- point (possibly as early as GHC 8.6) but for now we do it manually. @@ -639,10 +617,6 @@ lookup' h k m = case lookupRecordCollision# h k m of (# (# #) | #) -> Nothing (# | (# a, _i #) #) -> Just a {-# INLINE lookup' #-} -#else -lookup' h k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h k 0 m -{-# INLINABLE lookup' #-} -#endif -- The result of a lookup, keeping track of if a hash collision occured. -- If a collision did not occur then it will have the Int value (-1). @@ -662,7 +636,6 @@ data LookupRes a = Absent | Present a !Int -- Key in map, no collision => Present v (-1) -- Key in map, collision => Present v position lookupRecordCollision :: Eq k => Hash -> k -> HashMap k v -> LookupRes v -#if __GLASGOW_HASKELL__ >= 802 lookupRecordCollision h k m = case lookupRecordCollision# h k m of (# (# #) | #) -> Absent (# | (# a, i #) #) -> Present a (I# i) -- GHC will eliminate the I# @@ -679,12 +652,6 @@ lookupRecordCollision# h k m = -- INLINABLE to specialize to the Eq instance. {-# INLINABLE lookupRecordCollision# #-} -#else /* GHC < 8.2 so there are no unboxed sums */ - -lookupRecordCollision h k m = lookupCont (\_ -> Absent) Present h k 0 m -{-# INLINABLE lookupRecordCollision #-} -#endif - -- A two-continuation version of lookupRecordCollision. This lets us -- share source code between lookup and lookupRecordCollision without -- risking any performance degradation. @@ -698,11 +665,7 @@ lookupRecordCollision h k m = lookupCont (\_ -> Absent) Present h k 0 m -- keys at the top-level of a hashmap, the offset should be 0. When looking up -- keys at level @n@ of a hashmap, the offset should be @n * bitsPerSubkey@. lookupCont :: -#if __GLASGOW_HASKELL__ >= 802 forall rep (r :: TYPE rep) k v. -#else - forall r k v. -#endif Eq k => ((# #) -> r) -- Absent continuation -> (v -> Int -> r) -- Present continuation @@ -2155,11 +2118,7 @@ fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty -- | /O(n)/ Look up the value associated with the given key in an -- array. lookupInArrayCont :: -#if __GLASGOW_HASKELL__ >= 802 forall rep (r :: TYPE rep) k v. -#else - forall r k v. -#endif Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r lookupInArrayCont absent present k0 ary0 = go k0 ary0 0 (A.length ary0) where diff --git a/Data/HashMap/Internal/Array.hs b/Data/HashMap/Internal/Array.hs index aac9cc75..a2215764 100644 --- a/Data/HashMap/Internal/Array.hs +++ b/Data/HashMap/Internal/Array.hs @@ -92,9 +92,7 @@ import qualified Language.Haskell.TH.Syntax as TH import qualified Prelude #endif -#if MIN_VERSION_deepseq(1,4,3) import qualified Control.DeepSeq as NF -#endif import Control.Monad ((>=>)) @@ -173,7 +171,6 @@ rnfArray ary0 = go ary0 n0 0 -- relevant rnf is strict, or in case it actually isn't. {-# INLINE rnfArray #-} -#if MIN_VERSION_deepseq(1,4,3) -- | @since 0.2.14.0 instance NF.NFData1 Array where liftRnf = liftRnfArray @@ -187,7 +184,6 @@ liftRnfArray rnf0 ary0 = go ary0 n0 0 | (# x #) <- index# ary i = rnf0 x `seq` go ary n (i+1) {-# INLINE liftRnfArray #-} -#endif -- | Create a new mutable array of specified size, in the specified -- state thread, with each element containing the specified initial diff --git a/Data/HashSet/Internal.hs b/Data/HashSet/Internal.hs index e0ed5fe3..83478f0b 100644 --- a/Data/HashSet/Internal.hs +++ b/Data/HashSet/Internal.hs @@ -110,9 +110,7 @@ import Text.Read import qualified Data.Hashable.Lifted as H #endif -#if MIN_VERSION_deepseq(1,4,3) import qualified Control.DeepSeq as NF -#endif import qualified Language.Haskell.TH.Syntax as TH -- | A set of values. A set cannot contain duplicate values. @@ -129,11 +127,9 @@ instance (NFData a) => NFData (HashSet a) where rnf = rnf . asMap {-# INLINE rnf #-} -#if MIN_VERSION_deepseq(1,4,3) -- | @since 0.2.14.0 instance NF.NFData1 HashSet where liftRnf rnf1 = NF.liftRnf2 rnf1 rnf . asMap -#endif -- | Note that, in the presence of hash collisions, equal @HashSet@s may -- behave differently, i.e. substitutivity may be violated: diff --git a/tests/Properties/HashMapLazy.hs b/tests/Properties/HashMapLazy.hs index e1d582bd..b783c4f1 100644 --- a/tests/Properties/HashMapLazy.hs +++ b/tests/Properties/HashMapLazy.hs @@ -12,9 +12,7 @@ module Properties.HashMapLazy (tests) where import Control.Monad ( guard ) import qualified Data.Foldable as Foldable -#if MIN_VERSION_base(4,10,0) import Data.Bifoldable -#endif import Data.Function (on) import Data.Hashable (Hashable(hashWithSalt)) import qualified Data.List as L @@ -337,7 +335,6 @@ pFoldr = (L.sort . M.foldr (:) []) `eq` (L.sort . HM.foldr (:) []) pFoldl :: [(Int, Int)] -> Bool pFoldl = (L.sort . M.foldl (flip (:)) []) `eq` (L.sort . HM.foldl (flip (:)) []) -#if MIN_VERSION_base(4,10,0) pBifoldMap :: [(Int, Int)] -> Bool pBifoldMap xs = concatMap f (HM.toList m) == bifoldMap (:[]) (:[]) m where f (k, v) = [k, v] @@ -352,7 +349,6 @@ pBifoldl :: [(Int, Int)] -> Bool pBifoldl xs = reverse (concatMap f $ HM.toList m) == bifoldl (flip (:)) (flip (:)) [] m where f (k, v) = [k, v] m = HM.fromList xs -#endif pFoldrWithKey :: [(Int, Int)] -> Bool pFoldrWithKey = (sortByKey . M.foldrWithKey f []) `eq` @@ -514,11 +510,9 @@ tests = , testGroup "folds" [ testProperty "foldr" pFoldr , testProperty "foldl" pFoldl -#if MIN_VERSION_base(4,10,0) , testProperty "bifoldMap" pBifoldMap , testProperty "bifoldr" pBifoldr , testProperty "bifoldl" pBifoldl -#endif , testProperty "foldrWithKey" pFoldrWithKey , testProperty "foldlWithKey" pFoldlWithKey , testProperty "foldrWithKey'" pFoldrWithKey' diff --git a/unordered-containers.cabal b/unordered-containers.cabal index 1dc086ac..7bf037aa 100644 --- a/unordered-containers.cabal +++ b/unordered-containers.cabal @@ -30,13 +30,12 @@ extra-source-files: CHANGES.md tested-with: GHC ==9.2.1 - || ==9.0.1 + || ==9.0.2 || ==8.10.7 || ==8.8.4 || ==8.6.5 || ==8.4.4 || ==8.2.2 - || ==8.0.2 flag debug description: Enable debug support @@ -54,8 +53,8 @@ library Data.HashSet.Internal build-depends: - base >= 4.9 && < 5, - deepseq >= 1.1, + base >= 4.10 && < 5, + deepseq >= 1.4.3, hashable >= 1.0.1.1 && < 1.5, template-haskell < 2.19 @@ -70,11 +69,6 @@ library ghc-options: -Wall -O2 -fwarn-tabs -ferror-spans - if impl (ghc < 8.2) - -- This is absolutely necessary (but not sufficient) for correctness due to - -- the referential-transparency-breaking mutability in unsafeInsertWith. See - -- #147 and GHC #13615 for details. The bug was fixed in GHC 8.2. - ghc-options: -feager-blackholing if flag(debug) cpp-options: -DASSERTS diff --git a/utils/Stats.hs b/utils/Stats.hs index 8b01ecdc..c0150c82 100644 --- a/utils/Stats.hs +++ b/utils/Stats.hs @@ -27,9 +27,6 @@ instance Semigroup Histogram where instance Monoid Histogram where mempty = H 0 0 0 0 0 -#if __GLASGOW_HASKELL__ < 803 - mappend = (<>) -#endif -- | Count the number of node types at each level nodeHistogram :: HM.HashMap k v -> [Histogram]