From dfa5a58e7dc09a74e2c32b09dcacb8bed6c5f1c5 Mon Sep 17 00:00:00 2001 From: David Feuer Date: Mon, 17 Jan 2022 21:14:44 -0500 Subject: [PATCH] Bump to GHC 8.0 * Raise minimum GHC version to 8.0 so we'll be able to define `Lift` instances, avoid certain conditional definitions, etc. * Raise Cabal version for tests to 2.2; use `common` stanzas. --- .github/workflows/haskell-ci.yml | 27 +- containers-tests/benchmarks/IntSet.hs | 3 - containers-tests/benchmarks/Map.hs | 6 - containers-tests/containers-tests.cabal | 243 ++++-------------- containers-tests/tests/bitqueue-properties.hs | 3 - containers-tests/tests/intmap-properties.hs | 6 - containers-tests/tests/intset-strictness.hs | 2 - containers-tests/tests/seq-properties.hs | 18 -- containers-tests/tests/set-properties.hs | 3 - containers/changelog.md | 7 + containers/containers.cabal | 4 +- containers/include/containers.h | 19 +- containers/src/Data/Graph.hs | 18 +- containers/src/Data/IntMap.hs | 5 +- containers/src/Data/IntMap/Internal.hs | 84 +----- containers/src/Data/IntMap/Merge/Lazy.hs | 13 - containers/src/Data/IntMap/Merge/Strict.hs | 15 -- containers/src/Data/IntMap/Strict/Internal.hs | 6 - containers/src/Data/IntSet/Internal.hs | 46 +--- containers/src/Data/Map/Internal.hs | 95 +------ containers/src/Data/Map/Merge/Lazy.hs | 15 +- containers/src/Data/Map/Merge/Strict.hs | 15 +- containers/src/Data/Map/Strict/Internal.hs | 20 +- containers/src/Data/Sequence/Internal.hs | 85 +----- containers/src/Data/Set.hs | 2 +- containers/src/Data/Set/Internal.hs | 53 +--- containers/src/Data/Tree.hs | 33 +-- .../src/Utils/Containers/Internal/BitQueue.hs | 13 - .../src/Utils/Containers/Internal/BitUtil.hs | 33 +-- .../Utils/Containers/Internal/Coercions.hs | 6 +- .../Utils/Containers/Internal/PtrEquality.hs | 9 - .../src/Utils/Containers/Internal/State.hs | 13 +- .../Utils/Containers/Internal/StrictMaybe.hs | 5 - .../Utils/Containers/Internal/TypeError.hs | 14 +- 34 files changed, 143 insertions(+), 796 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index dbfe133e6..d3d0615ce 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.20211111 +# version: 0.13.20211030 # -# REGENDATA ("0.13.20211111",["github","--config=cabal.haskell-ci","cabal.project"]) +# REGENDATA ("0.13.20211030",["github","--config=cabal.haskell-ci","cabal.project"]) # name: Haskell-CI on: @@ -24,8 +24,6 @@ jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} runs-on: ubuntu-18.04 - timeout-minutes: - 60 container: image: buildpack-deps:bionic continue-on-error: ${{ matrix.allow-failure }} @@ -72,21 +70,6 @@ jobs: compilerVersion: 8.0.2 setup-method: hvr-ppa allow-failure: false - - compiler: ghc-7.10.3 - compilerKind: ghc - compilerVersion: 7.10.3 - setup-method: hvr-ppa - allow-failure: false - - compiler: ghc-7.8.4 - compilerKind: ghc - compilerVersion: 7.8.4 - setup-method: hvr-ppa - allow-failure: false - - compiler: ghc-7.6.3 - compilerKind: ghc - compilerVersion: 7.6.3 - setup-method: hvr-ppa - allow-failure: false fail-fast: false steps: - name: apt @@ -136,7 +119,7 @@ jobs: HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 70800 && HCNUMVER < 90200)) -ne 0 ] ; then echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" ; else echo "ARG_BENCH=--disable-benchmarks" >> "$GITHUB_ENV" ; fi + if [ $((HCNUMVER < 90200)) -ne 0 ] ; then echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" ; else echo "ARG_BENCH=--disable-benchmarks" >> "$GITHUB_ENV" ; fi echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" @@ -166,10 +149,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - cat >> $CABAL_CONFIG <= 708 import Data.Coerce -#endif import Prelude hiding (lookup) main = do @@ -134,11 +132,7 @@ atIns xs m = foldl' (\m (k, v) -> runIdentity (alterF (\_ -> Identity (Just v)) newtype Ident a = Ident { runIdent :: a } instance Functor Ident where -#if __GLASGOW_HASKELL__ >= 708 fmap = coerce -#else - fmap f (Ident a) = Ident (f a) -#endif atInsNoRules :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int atInsNoRules xs m = foldl' (\m (k, v) -> runIdent (alterF (\_ -> Ident (Just v)) k m)) m xs diff --git a/containers-tests/containers-tests.cabal b/containers-tests/containers-tests.cabal index e3efa6971..0ffd1d317 100644 --- a/containers-tests/containers-tests.cabal +++ b/containers-tests/containers-tests.cabal @@ -1,6 +1,7 @@ +cabal-version: 2.2 name: containers-tests version: 0 -license: BSD3 +license: BSD-3-Clause license-file: LICENSE maintainer: libraries@haskell.org bug-reports: https://github.com/haskell/containers/issues @@ -11,7 +12,6 @@ description: This package contains tests and benchmarks for @containers-package build-type: Simple -cabal-version: >=1.10 extra-source-files: include/containers.h tests/Makefile @@ -26,21 +26,41 @@ extra-source-files: benchmarks/LookupGE/*.hs tested-with: - GHC ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1 + GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1 source-repository head type: git location: http://github.com/haskell/containers.git +common deps + build-depends: + array >=0.4.0.0 + , base >=4.9.1 && <5 + , deepseq >=1.2 && <1.5 + +common test-deps + import: deps + build-depends: + containers-tests + , QuickCheck >=2.7.1 + , tasty + , tasty-hunit + , tasty-quickcheck + , transformers + +common benchmark-deps + import: deps + build-depends: + containers-tests + , deepseq >=1.1.0.0 && <1.5 + , gauge >=0.2.3 && <0.3 + -- Copy of containers library, library + import: deps default-language: Haskell2010 -- this is important for testing; may it affect benchmarks? cpp-options: -DTESTING - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 if impl(ghc >= 8.6.0) build-depends: nothunks @@ -107,129 +127,95 @@ library ----------------------------- benchmark intmap-benchmarks + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: IntMap.hs ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , containers-tests - , deepseq >=1.1.0.0 && <1.5 - , gauge >=0.2.3 && <0.3 benchmark intset-benchmarks + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: IntSet.hs ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , containers-tests - , deepseq >=1.1.0.0 && <1.5 - , gauge >=0.2.3 && <0.3 benchmark map-benchmarks + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Map.hs ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , containers-tests - , deepseq >=1.1.0.0 && <1.5 - , gauge >=0.2.3 && <0.3 - , transformers benchmark sequence-benchmarks + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Sequence.hs ghc-options: -O2 build-depends: - base >=4.6 && <5 - , containers-tests - , deepseq >=1.1.0.0 && <1.5 - , gauge >=0.2.3 && <0.3 - , random >=0 && <1.2 + random >=0 && <1.2 , transformers benchmark set-benchmarks + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Set.hs ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , containers-tests - , deepseq >=1.1.0.0 && <1.5 - , gauge >=0.2.3 && <0.3 benchmark set-operations-intmap + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks/SetOperations main-is: SetOperations-IntMap.hs other-modules: SetOperations ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , containers-tests - , gauge >=0.2.3 && <0.3 benchmark set-operations-intset + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks/SetOperations main-is: SetOperations-IntSet.hs other-modules: SetOperations ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , containers-tests - , gauge >=0.2.3 && <0.3 benchmark set-operations-map + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks/SetOperations main-is: SetOperations-Map.hs other-modules: SetOperations ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , containers-tests - , gauge >=0.2.3 && <0.3 benchmark set-operations-set + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks/SetOperations main-is: SetOperations-Set.hs other-modules: SetOperations ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , containers-tests - , gauge >=0.2.3 && <0.3 benchmark lookupge-intmap + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks/LookupGE main-is: IntMap.hs other-modules: LookupGE_IntMap build-depends: containers-tests - build-depends: - base >=4.6 && <5 - , deepseq >=1.1.0.0 && <1.5 - , gauge >=0.2.3 && <0.3 benchmark lookupge-map + import: benchmark-deps default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks/LookupGE @@ -237,10 +223,6 @@ benchmark lookupge-map other-modules: LookupGE_Map build-depends: containers-tests ghc-options: -O2 - build-depends: - base >=4.6 && <5 - , deepseq >=1.1.0.0 && <1.5 - , gauge >=0.2.3 && <0.3 ------------------- -- T E S T I N G -- @@ -250,91 +232,53 @@ benchmark lookupge-map -- plus the testing stuff. test-suite map-lazy-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: map-properties.hs type: exitcode-stdio-1.0 - build-depends: containers-tests - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: - QuickCheck >=2.7.1 - , tasty - , tasty-hunit - , tasty-quickcheck - , transformers - test-suite map-strict-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: map-properties.hs type: exitcode-stdio-1.0 cpp-options: -DSTRICT - build-depends: containers-tests - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: - QuickCheck >=2.7.1 - , tasty - , tasty-hunit - , tasty-quickcheck - , transformers - test-suite bitqueue-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: bitqueue-properties.hs type: exitcode-stdio-1.0 - build-depends: base >=4.6 && <5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: containers-tests - build-depends: - tasty - , tasty-quickcheck - test-suite set-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: set-properties.hs type: exitcode-stdio-1.0 - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: containers-tests - build-depends: - QuickCheck >=2.7.1 - , tasty - , tasty-hunit - , tasty-quickcheck - , transformers - if impl(ghc >= 8.6) build-depends: nothunks @@ -342,134 +286,77 @@ test-suite set-properties Utils.NoThunks test-suite intmap-lazy-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: intmap-properties.hs type: exitcode-stdio-1.0 other-modules: IntMapValidity - build-depends: containers-tests - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: - QuickCheck >=2.7.1 - , tasty - , tasty-hunit - , tasty-quickcheck - test-suite intmap-strict-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: intmap-properties.hs type: exitcode-stdio-1.0 cpp-options: -DSTRICT other-modules: IntMapValidity - build-depends: containers-tests - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: containers-tests - build-depends: - QuickCheck >=2.7.1 - , tasty - , tasty-hunit - , tasty-quickcheck - test-suite intset-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: intset-properties.hs type: exitcode-stdio-1.0 other-modules: IntSetValidity - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: containers-tests - build-depends: - tasty - , tasty-hunit - , tasty-quickcheck - test-suite seq-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: seq-properties.hs type: exitcode-stdio-1.0 - build-depends: containers-tests - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: - QuickCheck >=2.7.1 - , tasty - , tasty-quickcheck - , transformers - test-suite tree-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: tree-properties.hs type: exitcode-stdio-1.0 - build-depends: containers-tests - build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: - QuickCheck >=2.7.1 - , tasty - , tasty-quickcheck - , transformers - test-suite map-strictness-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: map-strictness.hs type: exitcode-stdio-1.0 - build-depends: containers-tests build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , ChasingBottoms - , deepseq >=1.2 && <1.5 - , QuickCheck >=2.7.1 - , tasty - , tasty-quickcheck - , tasty-hunit + ChasingBottoms ghc-options: -Wall other-extensions: @@ -486,6 +373,7 @@ test-suite map-strictness-properties Utils.NoThunks test-suite intmap-strictness-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: intmap-strictness.hs @@ -494,16 +382,8 @@ test-suite intmap-strictness-properties BangPatterns CPP - build-depends: containers-tests build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , ChasingBottoms - , deepseq >=1.2 && <1.5 - , QuickCheck >=2.7.1 - , tasty - , tasty-quickcheck - , tasty-hunit + ChasingBottoms ghc-options: -Wall @@ -517,6 +397,7 @@ test-suite intmap-strictness-properties Utils.NoThunks test-suite intset-strictness-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: intset-strictness.hs @@ -525,15 +406,8 @@ test-suite intset-strictness-properties BangPatterns CPP - build-depends: containers-tests build-depends: - array >=0.4.0.0 - , base >=4.6 && <5 - , ChasingBottoms - , deepseq >=1.2 && <1.5 - , QuickCheck >=2.7.1 - , tasty - , tasty-quickcheck + ChasingBottoms ghc-options: -Wall @@ -544,17 +418,12 @@ test-suite intset-strictness-properties Utils.NoThunks test-suite listutils-properties + import: test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: listutils-properties.hs type: exitcode-stdio-1.0 - build-depends: containers-tests build-depends: - base >=4.6 && <5 - , ChasingBottoms - , deepseq >=1.2 && <1.5 - , QuickCheck >=2.7.1 - , tasty - , tasty-quickcheck + ChasingBottoms ghc-options: -Wall diff --git a/containers-tests/tests/bitqueue-properties.hs b/containers-tests/tests/bitqueue-properties.hs index f15824740..95ce473a3 100644 --- a/containers-tests/tests/bitqueue-properties.hs +++ b/containers-tests/tests/bitqueue-properties.hs @@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif import qualified Data.List as List import Test.Tasty import Test.Tasty.QuickCheck diff --git a/containers-tests/tests/intmap-properties.hs b/containers-tests/tests/intmap-properties.hs index f91316982..017c00a45 100644 --- a/containers-tests/tests/intmap-properties.hs +++ b/containers-tests/tests/intmap-properties.hs @@ -131,10 +131,8 @@ main = defaultMain $ testGroup "intmap-properties" , testCase "maxView" test_maxView , testCase "minViewWithKey" test_minViewWithKey , testCase "maxViewWithKey" test_maxViewWithKey -#if MIN_VERSION_base(4,8,0) , testCase "minimum" test_minimum , testCase "maximum" test_maximum -#endif , testProperty "valid" prop_valid , testProperty "empty valid" prop_emptyValid , testProperty "insert to singleton" prop_singleton @@ -1110,8 +1108,6 @@ test_maxViewWithKey = do maxViewWithKey (fromList [(5,"a"), (-3,"b")]) @?= Just ((5,"a"), singleton (-3) "b") maxViewWithKey (empty :: SMap) @?= Nothing - -#if MIN_VERSION_base(4,8,0) test_minimum :: Assertion test_minimum = do getOW (minimum testOrdMap) @?= "min" @@ -1132,8 +1128,6 @@ data OrdWith a = OrdWith String a instance Ord a => Ord (OrdWith a) where OrdWith _ a1 <= OrdWith _ a2 = a1 <= a2 -#endif - ---------------------------------------------------------------- -- Valid IntMaps diff --git a/containers-tests/tests/intset-strictness.hs b/containers-tests/tests/intset-strictness.hs index b91d6f09b..5c6e2b9c6 100644 --- a/containers-tests/tests/intset-strictness.hs +++ b/containers-tests/tests/intset-strictness.hs @@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -Wno-orphans #-} -#endif module Main (main) where import Prelude hiding (foldl) diff --git a/containers-tests/tests/seq-properties.hs b/containers-tests/tests/seq-properties.hs index 3bce3ef7a..69f173562 100644 --- a/containers-tests/tests/seq-properties.hs +++ b/containers-tests/tests/seq-properties.hs @@ -25,9 +25,7 @@ import Data.Functor ((<$>), (<$)) import Data.Maybe import Data.Function (on) import Data.Monoid (Monoid(..), All(..), Endo(..), Dual(..)) -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (stimes, stimesMonoid) -#endif import Data.Traversable (Traversable(traverse), sequenceA) import Prelude hiding ( lookup, null, length, take, drop, splitAt, @@ -144,17 +142,13 @@ main = defaultMain $ testGroup "seq-properties" , testProperty "intersperse" prop_intersperse , testProperty ">>=" prop_bind , testProperty "mfix" test_mfix -#if __GLASGOW_HASKELL__ >= 800 , testProperty "Empty pattern" prop_empty_pat , testProperty "Empty constructor" prop_empty_con , testProperty "Left view pattern" prop_viewl_pat , testProperty "Left view constructor" prop_viewl_con , testProperty "Right view pattern" prop_viewr_pat , testProperty "Right view constructor" prop_viewr_con -#endif -#if MIN_VERSION_base(4,9,0) , testProperty "stimes" prop_stimes -#endif ] ------------------------------------------------------------------------ @@ -594,21 +588,13 @@ prop_sortOn :: Fun A OrdB -> Seq A -> Bool prop_sortOn (Fun _ f) xs = toList' (sortOn f xs) ~= listSortOn f (toList xs) where -#if MIN_VERSION_base(4,8,0) listSortOn = Data.List.sortOn -#else - listSortOn k = Data.List.sortBy (compare `on` k) -#endif prop_sortOnStable :: Fun A UnstableOrd -> Seq A -> Bool prop_sortOnStable (Fun _ f) xs = toList' (sortOn f xs) ~= listSortOn f (toList xs) where -#if MIN_VERSION_base(4,8,0) listSortOn = Data.List.sortOn -#else - listSortOn k = Data.List.sortBy (compare `on` k) -#endif prop_unstableSort :: Seq OrdA -> Bool prop_unstableSort xs = @@ -857,7 +843,6 @@ prop_cycleTaking :: Int -> Seq A -> Property prop_cycleTaking n xs = (n <= 0 || not (null xs)) ==> toList' (cycleTaking n xs) ~= Data.List.take n (Data.List.cycle (toList xs)) -#if __GLASGOW_HASKELL__ >= 800 prop_empty_pat :: Seq A -> Bool prop_empty_pat xs@Empty = null xs prop_empty_pat xs = not (null xs) @@ -882,7 +867,6 @@ prop_viewr_pat xs = property $ null xs prop_viewr_con :: Seq A -> A -> Property prop_viewr_con xs x = xs :|> x === xs |> x -#endif -- Monad operations @@ -892,11 +876,9 @@ prop_bind xs (Fun _ f) = -- Semigroup operations -#if MIN_VERSION_base(4,9,0) prop_stimes :: NonNegative Int -> Seq A -> Property prop_stimes (NonNegative n) s = stimes n s === stimesMonoid n s -#endif -- MonadFix operation diff --git a/containers-tests/tests/set-properties.hs b/containers-tests/tests/set-properties.hs index 2e8ed6abc..4c4ab1b85 100644 --- a/containers-tests/tests/set-properties.hs +++ b/containers-tests/tests/set-properties.hs @@ -15,9 +15,6 @@ import Control.Monad.Trans.Class import Control.Monad (liftM, liftM3) import Data.Functor.Identity import Data.Foldable (all) -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative (Applicative (..), (<$>)) -#endif import Control.Applicative (liftA2) #if __GLASGOW_HASKELL__ >= 806 diff --git a/containers/changelog.md b/containers/changelog.md index 39272b4cc..1ef098812 100644 --- a/containers/changelog.md +++ b/containers/changelog.md @@ -1,5 +1,12 @@ # Changelog for [`containers` package](http://github.com/haskell/containers) +## FIXME + +* Drop support for GHC versions before 8.0.2. + +* Bump Cabal version for tests, and use `common` clauses to reduce + duplication. + ## 0.6.5.1 ### Bug fixes diff --git a/containers/containers.cabal b/containers/containers.cabal index 17a739d5f..bfedc96dc 100644 --- a/containers/containers.cabal +++ b/containers/containers.cabal @@ -25,7 +25,7 @@ extra-source-files: include/containers.h changelog.md -tested-with: GHC==9.2.1, GHC==9.0.1, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3 +tested-with: GHC==9.2.1, GHC==9.0.1, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 source-repository head type: git @@ -33,7 +33,7 @@ source-repository head Library default-language: Haskell2010 - build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5 + build-depends: base >= 4.9.1 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5 hs-source-dirs: src ghc-options: -O2 -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates diff --git a/containers/include/containers.h b/containers/include/containers.h index fc2a0e848..4aa226e81 100644 --- a/containers/include/containers.h +++ b/containers/include/containers.h @@ -12,24 +12,7 @@ #include "MachDeps.h" #endif -/* - * Define INSTANCE_TYPEABLE[0-2] - */ -#if __GLASGOW_HASKELL__ >= 707 -#define INSTANCE_TYPEABLE0(tycon) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE1(tycon) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE2(tycon) deriving instance Typeable tycon -#elif defined(__GLASGOW_HASKELL__) -#define INSTANCE_TYPEABLE0(tycon) deriving instance Typeable tycon -#define INSTANCE_TYPEABLE1(tycon) deriving instance Typeable1 tycon -#define INSTANCE_TYPEABLE2(tycon) deriving instance Typeable2 tycon -#else -#define INSTANCE_TYPEABLE0(tycon) -#define INSTANCE_TYPEABLE1(tycon) -#define INSTANCE_TYPEABLE2(tycon) -#endif - -#if __GLASGOW_HASKELL__ >= 800 +#ifdef __GLASGOW_HASKELL__ #define DEFINE_PATTERN_SYNONYMS 1 #endif diff --git a/containers/src/Data/Graph.hs b/containers/src/Data/Graph.hs index 88063e0cc..ea54440b4 100644 --- a/containers/src/Data/Graph.hs +++ b/containers/src/Data/Graph.hs @@ -4,11 +4,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} -# if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE Safe #-} -# else -{-# LANGUAGE Trustworthy #-} -# endif #endif #include "containers.h" @@ -107,12 +103,7 @@ import Data.Tree (Tree(Node), Forest) -- std interfaces import Control.Applicative -#if !MIN_VERSION_base(4,8,0) -import qualified Data.Foldable as F -import Data.Traversable -#else import Data.Foldable as F -#endif import Control.DeepSeq (NFData(rnf)) import Data.Maybe import Data.Array @@ -123,16 +114,13 @@ import Data.Array.Unboxed ( UArray ) import qualified Data.Array as UA #endif import qualified Data.List as L -#if MIN_VERSION_base(4,9,0) import Data.Functor.Classes -#endif -#if (!MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0) +#if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup (..)) #endif #ifdef __GLASGOW_HASKELL__ import GHC.Generics (Generic, Generic1) import Data.Data (Data) -import Data.Typeable #endif -- Make sure we don't use Integer by mistake. @@ -158,8 +146,6 @@ data SCC vertex = AcyclicSCC vertex -- ^ A single vertex that is not deriving (Eq, Show, Read) #endif -INSTANCE_TYPEABLE1(SCC) - #ifdef __GLASGOW_HASKELL__ -- | @since 0.5.9 deriving instance Data vertex => Data (SCC vertex) @@ -171,7 +157,6 @@ deriving instance Generic1 SCC deriving instance Generic (SCC vertex) #endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Eq1 SCC where liftEq eq (AcyclicSCC v1) (AcyclicSCC v2) = eq v1 v2 @@ -186,7 +171,6 @@ instance Read1 SCC where liftReadsPrec rp rl = readsData $ readsUnaryWith rp "AcyclicSCC" AcyclicSCC <> readsUnaryWith (const rl) "CyclicSCC" CyclicSCC -#endif -- | @since 0.5.9 instance F.Foldable SCC where diff --git a/containers/src/Data/IntMap.hs b/containers/src/Data/IntMap.hs index 805f32547..5f6836b44 100644 --- a/containers/src/Data/IntMap.hs +++ b/containers/src/Data/IntMap.hs @@ -3,9 +3,8 @@ {-# LANGUAGE Safe #-} #endif #ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE DataKinds, FlexibleContexts #-} -#endif -#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} #endif diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs index badd5a158..bd8ecaa44 100644 --- a/containers/src/Data/IntMap/Internal.hs +++ b/containers/src/Data/IntMap/Internal.hs @@ -1,16 +1,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} -#if __GLASGOW_HASKELL__ -{-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-} +#ifdef __GLASGOW_HASKELL__ +{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} #endif #if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE TypeFamilies #-} -#endif {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} @@ -293,34 +292,19 @@ module Data.IntMap.Internal ( , mapGentlyWhenMatched ) where -#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity (..)) import Control.Applicative (liftA2) -#else -import Control.Applicative (Applicative(pure, (<*>)), (<$>), liftA2) -import Data.Monoid (Monoid(..)) -import Data.Traversable (Traversable(traverse)) -import Data.Word (Word) -#endif -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(stimes)) -#endif -#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0) +#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>))) #endif -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (stimesIdempotentMonoid) import Data.Functor.Classes -#endif import Control.DeepSeq (NFData(rnf)) import Data.Bits import qualified Data.Foldable as Foldable -#if !MIN_VERSION_base(4,8,0) -import Data.Foldable (Foldable()) -#endif import Data.Maybe (fromMaybe) -import Data.Typeable import Prelude hiding (lookup, map, filter, foldr, foldl, null) import Data.IntSet.Internal (Key) @@ -328,22 +312,15 @@ import qualified Data.IntSet.Internal as IntSet import Utils.Containers.Internal.BitUtil import Utils.Containers.Internal.StrictPair -#if __GLASGOW_HASKELL__ +#ifdef __GLASGOW_HASKELL__ +import Data.Coerce import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), - DataType, mkDataType) + DataType, mkDataType, gcast1) import GHC.Exts (build) -#if !MIN_VERSION_base(4,8,0) -import Data.Functor ((<$)) -#endif -#if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as GHCExts -#endif import Text.Read #endif import qualified Control.Category as Category -#if __GLASGOW_HASKELL__ >= 709 -import Data.Coerce -#endif -- A "Nat" is a natural machine word (an unsigned Int) @@ -433,16 +410,12 @@ infixl 9 !?,\\{-This comment teaches CPP correct behaviour -} instance Monoid (IntMap a) where mempty = empty mconcat = unions -#if !(MIN_VERSION_base(4,9,0)) - mappend = union -#else mappend = (<>) -- | @since 0.5.7 instance Semigroup (IntMap a) where (<>) = union stimes = stimesIdempotentMonoid -#endif -- | Folds in order of increasing key. instance Foldable.Foldable IntMap where @@ -468,7 +441,6 @@ instance Foldable.Foldable IntMap where {-# INLINE foldl' #-} foldr' = foldr' {-# INLINE foldr' #-} -#if MIN_VERSION_base(4,8,0) length = size {-# INLINE length #-} null = null @@ -506,7 +478,6 @@ instance Foldable.Foldable IntMap where {-# INLINABLE sum #-} product = foldl' (*) 1 {-# INLINABLE product #-} -#endif -- | Traverses in order of increasing key. instance Traversable IntMap where @@ -1477,9 +1448,6 @@ instance (Applicative f, Monad f) => Applicative (WhenMissing f x) where -- -- @since 0.5.9 instance (Applicative f, Monad f) => Monad (WhenMissing f x) where -#if !MIN_VERSION_base(4,8,0) - return = pure -#endif m >>= f = traverseMaybeMissing $ \k x -> do res1 <- missingKey m k x @@ -1562,17 +1530,6 @@ contramapSecondWhenMatched f t = {-# INLINE contramapSecondWhenMatched #-} -#if !MIN_VERSION_base(4,8,0) -newtype Identity a = Identity {runIdentity :: a} - -instance Functor Identity where - fmap f (Identity x) = Identity (f x) - -instance Applicative Identity where - pure = Identity - Identity f <*> Identity x = Identity (f x) -#endif - -- | A tactic for dealing with keys present in one map but not the -- other in 'merge'. -- @@ -1651,9 +1608,6 @@ instance (Monad f, Applicative f) => Applicative (WhenMatched f x y) where -- -- @since 0.5.9 instance (Monad f, Applicative f) => Monad (WhenMatched f x y) where -#if !MIN_VERSION_base(4,8,0) - return = pure -#endif m >>= f = zipWithMaybeAMatched $ \k x y -> do res <- runWhenMatched m k x y @@ -2452,11 +2406,6 @@ map f = go {-# NOINLINE [1] map #-} {-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs - #-} -#endif -#if __GLASGOW_HASKELL__ >= 709 --- Safe coercions were introduced in 7.8, but did not play well with RULES yet. -{-# RULES "map/coerce" map coerce = coerce #-} #endif @@ -3056,7 +3005,8 @@ fromSet f (IntSet.Tip kx bm) = buildTree f kx bm (IntSet.suffixBitMask + 1) {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} -#if __GLASGOW_HASKELL__ >= 708 + +#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance GHCExts.IsList (IntMap a) where type Item (IntMap a) = (Key,a) @@ -3284,7 +3234,6 @@ nequal (Tip kx x) (Tip ky y) nequal Nil Nil = False nequal _ _ = True -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Eq1 IntMap where liftEq eq (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2) @@ -3293,7 +3242,6 @@ instance Eq1 IntMap where = (kx == ky) && (eq x y) liftEq _eq Nil Nil = True liftEq _eq _ _ = False -#endif {-------------------------------------------------------------------- Ord @@ -3302,12 +3250,10 @@ instance Eq1 IntMap where instance Ord a => Ord (IntMap a) where compare m1 m2 = compare (toList m1) (toList m2) -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Ord1 IntMap where liftCompare cmp m n = liftCompare (liftCompare cmp) (toList m) (toList n) -#endif {-------------------------------------------------------------------- Functor @@ -3330,7 +3276,6 @@ instance Show a => Show (IntMap a) where showsPrec d m = showParen (d > 10) $ showString "fromList " . shows (toList m) -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Show1 IntMap where liftShowsPrec sp sl d m = @@ -3338,7 +3283,6 @@ instance Show1 IntMap where where sp' = liftShowsPrec sp sl sl' = liftShowList sp sl -#endif {-------------------------------------------------------------------- Read @@ -3358,7 +3302,6 @@ instance (Read e) => Read (IntMap e) where return (fromList xs,t) #endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Read1 IntMap where liftReadsPrec rp rl = readsData $ @@ -3366,13 +3309,6 @@ instance Read1 IntMap where where rp' = liftReadsPrec rp rl rl' = liftReadList rp rl -#endif - -{-------------------------------------------------------------------- - Typeable ---------------------------------------------------------------------} - -INSTANCE_TYPEABLE1(IntMap) {-------------------------------------------------------------------- Helpers diff --git a/containers/src/Data/IntMap/Merge/Lazy.hs b/containers/src/Data/IntMap/Merge/Lazy.hs index c24d0e45f..2dfa33311 100644 --- a/containers/src/Data/IntMap/Merge/Lazy.hs +++ b/containers/src/Data/IntMap/Merge/Lazy.hs @@ -1,20 +1,7 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} -#if __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} -#endif #if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE TypeFamilies #-} -#define USE_MAGIC_PROXY 1 -#endif - -#if USE_MAGIC_PROXY -{-# LANGUAGE MagicHash #-} -#endif #include "containers.h" diff --git a/containers/src/Data/IntMap/Merge/Strict.hs b/containers/src/Data/IntMap/Merge/Strict.hs index d21c4e1ca..26f90072e 100644 --- a/containers/src/Data/IntMap/Merge/Strict.hs +++ b/containers/src/Data/IntMap/Merge/Strict.hs @@ -1,20 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} -#if __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} -#endif #if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE TypeFamilies #-} -#define USE_MAGIC_PROXY 1 -#endif - -#if USE_MAGIC_PROXY -{-# LANGUAGE MagicHash #-} -#endif #include "containers.h" @@ -112,9 +100,6 @@ import Data.IntMap.Internal , runWhenMissing ) import Data.IntMap.Strict.Internal -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative (Applicative (..), (<$>)) -#endif import Prelude hiding (filter, map, foldl, foldr) -- | Map covariantly over a @'WhenMissing' f k x@. diff --git a/containers/src/Data/IntMap/Strict/Internal.hs b/containers/src/Data/IntMap/Strict/Internal.hs index 347c9370c..1e02cfc66 100644 --- a/containers/src/Data/IntMap/Strict/Internal.hs +++ b/containers/src/Data/IntMap/Strict/Internal.hs @@ -345,14 +345,8 @@ import Data.IntMap.Internal.DeprecatedDebug (showTree, showTreeWith) import qualified Data.IntSet.Internal as IntSet import Utils.Containers.Internal.BitUtil import Utils.Containers.Internal.StrictPair -#if !MIN_VERSION_base(4,8,0) -import Data.Functor((<$>)) -#endif import Control.Applicative (Applicative (..), liftA2) import qualified Data.Foldable as Foldable -#if !MIN_VERSION_base(4,8,0) -import Data.Foldable (Foldable()) -#endif {-------------------------------------------------------------------- Query diff --git a/containers/src/Data/IntSet/Internal.hs b/containers/src/Data/IntSet/Internal.hs index fe097abd3..9a2fac54a 100644 --- a/containers/src/Data/IntSet/Internal.hs +++ b/containers/src/Data/IntSet/Internal.hs @@ -1,15 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} -#if __GLASGOW_HASKELL__ -{-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-} +#ifdef __GLASGOW_HASKELL__ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeFamilies #-} #endif #if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE TypeFamilies #-} -#endif {-# OPTIONS_HADDOCK not-home #-} @@ -193,20 +191,11 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits import qualified Data.List as List import Data.Maybe (fromMaybe) -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid (Monoid(..)) -import Data.Word (Word) -#endif -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(stimes)) -#endif -#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0) +#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>))) #endif -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (stimesIdempotentMonoid) -#endif -import Data.Typeable import Prelude hiding (filter, foldr, foldl, null, map) import Utils.Containers.Internal.BitUtil @@ -220,17 +209,13 @@ import Text.Read #if __GLASGOW_HASKELL__ import qualified GHC.Exts -#if !(MIN_VERSION_base(4,8,0) && (WORD_SIZE_IN_BITS==64)) +#if !(WORD_SIZE_IN_BITS==64) import qualified GHC.Int #endif #endif import qualified Data.Foldable as Foldable -#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity(..)) -#else -import Data.Foldable (Foldable()) -#endif infixl 9 \\{-This comment teaches CPP correct behaviour -} @@ -286,16 +271,12 @@ type Key = Int instance Monoid IntSet where mempty = empty mconcat = unions -#if !(MIN_VERSION_base(4,9,0)) - mappend = union -#else mappend = (<>) -- | @since 0.5.7 instance Semigroup IntSet where (<>) = union stimes = stimesIdempotentMonoid -#endif #if __GLASGOW_HASKELL__ @@ -541,9 +522,7 @@ alterF f k s = fmap choose (f member_) #-} #endif -#if MIN_VERSION_base(4,8,0) {-# SPECIALIZE alterF :: (Bool -> Identity Bool) -> Key -> IntSet -> Identity IntSet #-} -#endif {-------------------------------------------------------------------- Union @@ -1055,7 +1034,8 @@ elems {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} -#if __GLASGOW_HASKELL__ >= 708 + +#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance GHC.Exts.IsList IntSet where type Item IntSet = Key @@ -1243,12 +1223,6 @@ instance Read IntSet where return (fromList xs,t) #endif -{-------------------------------------------------------------------- - Typeable ---------------------------------------------------------------------} - -INSTANCE_TYPEABLE0(IntSet) - {-------------------------------------------------------------------- NFData --------------------------------------------------------------------} @@ -1375,11 +1349,7 @@ tip kx bm = Tip kx bm ----------------------------------------------------------------------} suffixBitMask :: Int -#if MIN_VERSION_base(4,7,0) suffixBitMask = finiteBitSize (undefined::Word) - 1 -#else -suffixBitMask = bitSize (undefined::Word) - 1 -#endif {-# INLINE suffixBitMask #-} prefixBitMask :: Int @@ -1474,7 +1444,7 @@ foldr'Bits :: Int -> (Int -> a -> a) -> a -> Nat -> a #if defined(__GLASGOW_HASKELL__) && (WORD_SIZE_IN_BITS==32 || WORD_SIZE_IN_BITS==64) indexOfTheOnlyBit :: Nat -> Int {-# INLINE indexOfTheOnlyBit #-} -#if MIN_VERSION_base(4,8,0) && (WORD_SIZE_IN_BITS==64) +#if WORD_SIZE_IN_BITS==64 indexOfTheOnlyBit bitmask = countTrailingZeros bitmask lowestBitSet x = countTrailingZeros x diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs index a2edf6914..a7379055c 100644 --- a/containers/src/Data/Map/Internal.hs +++ b/containers/src/Data/Map/Internal.hs @@ -1,17 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} -#if __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} -#endif #if defined(__GLASGOW_HASKELL__) -{-# LANGUAGE Trustworthy #-} -#endif -#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} -#define USE_MAGIC_PROXY 1 #endif +#define USE_MAGIC_PROXY 1 #ifdef USE_MAGIC_PROXY {-# LANGUAGE MagicHash #-} @@ -344,7 +339,7 @@ module Data.Map.Internal ( -- Used by the strict version , AreWeStrict (..) , atKeyImpl -#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,8,0) +#ifdef __GLASGOW_HASKELL__ , atKeyPlain #endif , bin @@ -369,35 +364,21 @@ module Data.Map.Internal ( , mapGentlyWhenMatched ) where -#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity (..)) import Control.Applicative (liftA3) -#else -import Control.Applicative (Applicative(..), (<$>), liftA3) -import Data.Monoid (Monoid(..)) -import Data.Traversable (Traversable(traverse)) -#endif -#if MIN_VERSION_base(4,9,0) import Data.Functor.Classes import Data.Semigroup (stimesIdempotentMonoid) -#endif -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(stimes)) -#endif -#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0) +#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>))) #endif import Control.Applicative (Const (..)) import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR) import qualified Data.Foldable as Foldable -#if !MIN_VERSION_base(4,8,0) -import Data.Foldable (Foldable()) -#endif #if MIN_VERSION_base(4,10,0) import Data.Bifoldable #endif -import Data.Typeable import Prelude hiding (lookup, map, filter, foldr, foldl, null, splitAt, take, drop) import qualified Data.Set.Internal as Set @@ -412,20 +393,13 @@ import Utils.Containers.Internal.BitUtil (wordSize) #if __GLASGOW_HASKELL__ import GHC.Exts (build, lazy) -#if !MIN_VERSION_base(4,8,0) -import Data.Functor ((<$)) -#endif -#ifdef USE_MAGIC_PROXY +# ifdef USE_MAGIC_PROXY import GHC.Exts (Proxy#, proxy# ) -#endif -#if __GLASGOW_HASKELL__ >= 708 +# endif import qualified GHC.Exts as GHCExts -#endif import Text.Read hiding (lift) import Data.Data import qualified Control.Category as Category -#endif -#if __GLASGOW_HASKELL__ >= 708 import Data.Coerce #endif @@ -484,22 +458,18 @@ data Map k a = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a) type Size = Int -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ type role Map nominal representational #endif instance (Ord k) => Monoid (Map k v) where mempty = empty mconcat = unions -#if !(MIN_VERSION_base(4,9,0)) - mappend = union -#else mappend = (<>) instance (Ord k) => Semigroup (Map k v) where (<>) = union stimes = stimesIdempotentMonoid -#endif #if __GLASGOW_HASKELL__ @@ -1238,14 +1208,12 @@ alterF f k m = atKeyImpl Lazy k f m "alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)) . alterF f k = \m -> Const . getConst . f $ lookup k m #-} -#if MIN_VERSION_base(4,8,0) -- base 4.8 and above include Data.Functor.Identity, so we can -- save a pretty decent amount of time by handling it specially. {-# RULES "alterF/Identity" forall k f . alterF f k = atKeyIdentity k f #-} #endif -#endif atKeyImpl :: (Functor f, Ord k) => AreWeStrict -> k -> (Maybe a -> f (Maybe a)) -> Map k a -> f (Map k a) @@ -1299,10 +1267,7 @@ lookupTrace = go emptyQB GT -> (go $! q `snocQB` True) k r EQ -> TraceResult (Just x) (buildQ q) --- GHC 7.8 doesn't manage to unbox the queue properly --- unless we explicitly inline this function. This stuff --- is a bit touchy, unfortunately. -#if __GLASGOW_HASKELL__ >= 710 +#ifdef __GLASGOW_HASKELL__ {-# INLINABLE lookupTrace #-} #else {-# INLINE lookupTrace #-} @@ -1372,7 +1337,7 @@ replaceAlong q x (Bin sz ky y l r) = Just (True,tl) -> Bin sz ky y l (replaceAlong tl x r) Nothing -> Bin sz ky x l r -#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,8,0) +#ifdef __GLASGOW_HASKELL__ atKeyIdentity :: Ord k => k -> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a) atKeyIdentity k f t = Identity $ atKeyPlain Lazy k (coerce f) t {-# INLINABLE atKeyIdentity #-} @@ -2118,24 +2083,6 @@ compose bc !ab | null bc = empty | otherwise = mapMaybe (bc !?) ab -#if !MIN_VERSION_base (4,8,0) --- | The identity type. -newtype Identity a = Identity { runIdentity :: a } -#if __GLASGOW_HASKELL__ == 708 -instance Functor Identity where - fmap = coerce -instance Applicative Identity where - (<*>) = coerce - pure = Identity -#else -instance Functor Identity where - fmap f (Identity a) = Identity (f a) -instance Applicative Identity where - Identity f <*> Identity x = Identity (f x) - pure = Identity -#endif -#endif - -- | A tactic for dealing with keys present in one map but not the other in -- 'merge' or 'mergeA'. -- @@ -2182,9 +2129,6 @@ instance (Applicative f, Monad f) => Applicative (WhenMissing f k x) where -- -- @since 0.5.9 instance (Applicative f, Monad f) => Monad (WhenMissing f k x) where -#if !MIN_VERSION_base(4,8,0) - return = pure -#endif m >>= f = traverseMaybeMissing $ \k x -> do res1 <- missingKey m k x case res1 of @@ -2320,9 +2264,6 @@ instance (Monad f, Applicative f) => Applicative (WhenMatched f k x y) where -- -- @since 0.5.9 instance (Monad f, Applicative f) => Monad (WhenMatched f k x y) where -#if !MIN_VERSION_base(4,8,0) - return = pure -#endif m >>= f = zipWithMaybeAMatched $ \k x y -> do res <- runWhenMatched m k x y case res of @@ -3105,11 +3046,6 @@ map f = go where {-# NOINLINE [1] map #-} {-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs - #-} -#endif -#if __GLASGOW_HASKELL__ >= 709 --- Safe coercions were introduced in 7.8, but did not work well with RULES yet. -{-# RULES "map/coerce" map coerce = coerce #-} #endif @@ -3431,7 +3367,8 @@ fromSet f (Set.Bin sz x l r) = Bin sz x (f x) (fromSet f l) (fromSet f r) {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} -#if __GLASGOW_HASKELL__ >= 708 + +#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance (Ord k) => GHCExts.IsList (Map k v) where type Item (Map k v) = (k,v) @@ -4183,7 +4120,6 @@ instance (Eq k,Eq a) => Eq (Map k a) where instance (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toAscList m1) (toAscList m2) -#if MIN_VERSION_base(4,9,0) {-------------------------------------------------------------------- Lifted instances --------------------------------------------------------------------} @@ -4225,7 +4161,6 @@ instance (Ord k, Read k) => Read1 (Map k) where where rp' = liftReadsPrec rp rl rl' = liftReadList rp rl -#endif {-------------------------------------------------------------------- Functor @@ -4262,7 +4197,6 @@ instance Foldable.Foldable (Map k) where {-# INLINE foldl' #-} foldr' = foldr' {-# INLINE foldr' #-} -#if MIN_VERSION_base(4,8,0) length = size {-# INLINE length #-} null = null @@ -4291,7 +4225,6 @@ instance Foldable.Foldable (Map k) where {-# INLINABLE sum #-} product = foldl' (*) 1 {-# INLINABLE product #-} -#endif #if MIN_VERSION_base(4,10,0) -- | @since 0.6.3.1 @@ -4345,12 +4278,6 @@ instance (Show k, Show a) => Show (Map k a) where showsPrec d m = showParen (d > 10) $ showString "fromList " . shows (toList m) -{-------------------------------------------------------------------- - Typeable ---------------------------------------------------------------------} - -INSTANCE_TYPEABLE2(Map) - {-------------------------------------------------------------------- Utilities --------------------------------------------------------------------} diff --git a/containers/src/Data/Map/Merge/Lazy.hs b/containers/src/Data/Map/Merge/Lazy.hs index cfc52c5b2..5ac059ab9 100644 --- a/containers/src/Data/Map/Merge/Lazy.hs +++ b/containers/src/Data/Map/Merge/Lazy.hs @@ -1,20 +1,7 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} -#if __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} -#endif -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) +#if defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE TypeFamilies #-} -#define USE_MAGIC_PROXY 1 -#endif - -#if USE_MAGIC_PROXY -{-# LANGUAGE MagicHash #-} -#endif #include "containers.h" diff --git a/containers/src/Data/Map/Merge/Strict.hs b/containers/src/Data/Map/Merge/Strict.hs index bf683f8bd..e502454ac 100644 --- a/containers/src/Data/Map/Merge/Strict.hs +++ b/containers/src/Data/Map/Merge/Strict.hs @@ -1,20 +1,7 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} -#if __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} -#endif -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) +#if defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE TypeFamilies #-} -#define USE_MAGIC_PROXY 1 -#endif - -#if USE_MAGIC_PROXY -{-# LANGUAGE MagicHash #-} -#endif #include "containers.h" diff --git a/containers/src/Data/Map/Strict/Internal.hs b/containers/src/Data/Map/Strict/Internal.hs index d8b5325ba..bf814e762 100644 --- a/containers/src/Data/Map/Strict/Internal.hs +++ b/containers/src/Data/Map/Strict/Internal.hs @@ -299,7 +299,7 @@ module Data.Map.Strict.Internal , maxViewWithKey -- * Debugging -#if defined(__GLASGOW_HASKELL__) +#ifdef __GLASGOW_HASKELL__ , showTree , showTreeWith #endif @@ -329,9 +329,7 @@ import Data.Map.Internal , (\\) , assocs , atKeyImpl -#if MIN_VERSION_base(4,8,0) , atKeyPlain -#endif , balance , balanceL , balanceR @@ -415,26 +413,20 @@ import Data.Map.Internal.DeprecatedShowTree (showTree, showTreeWith) import Data.Map.Internal.Debug (valid) import Control.Applicative (Const (..), liftA3) -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative (Applicative (..), (<$>)) -#endif import qualified Data.Set.Internal as Set import qualified Data.Map.Internal as L import Utils.Containers.Internal.StrictPair import Data.Bits (shiftL, shiftR) -#if __GLASGOW_HASKELL__ >= 709 +#ifdef __GLASGOW_HASKELL__ import Data.Coerce #endif -#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,8,0) +#ifdef __GLASGOW_HASKELL__ import Data.Functor.Identity (Identity (..)) #endif import qualified Data.Foldable as Foldable -#if !MIN_VERSION_base(4,8,0) -import Data.Foldable (Foldable()) -#endif -- $strictness -- @@ -872,11 +864,6 @@ alterF f k m = atKeyImpl Strict k f m -- `Control.Applicative.Const` and just doing a lookup. {-# RULES "alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)) . alterF f k = \m -> Const . getConst . f $ lookup k m - #-} -#if MIN_VERSION_base(4,8,0) --- base 4.8 and above include Data.Functor.Identity, so we can --- save a pretty decent amount of time by handling it specially. -{-# RULES "alterF/Identity" forall k f . alterF f k = atKeyIdentity k f #-} @@ -884,7 +871,6 @@ atKeyIdentity :: Ord k => k -> (Maybe a -> Identity (Maybe a)) -> Map k a -> Ide atKeyIdentity k f t = Identity $ atKeyPlain Strict k (coerce f) t {-# INLINABLE atKeyIdentity #-} #endif -#endif {-------------------------------------------------------------------- Indexing diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs index 686e15f16..299b5151e 100644 --- a/containers/src/Data/Sequence/Internal.hs +++ b/containers/src/Data/Sequence/Internal.hs @@ -197,9 +197,7 @@ import Prelude hiding ( #if MIN_VERSION_base(4,11,0) (<>), #endif -#if MIN_VERSION_base(4,8,0) Applicative, (<$>), foldMap, Monoid, -#endif null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1, scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3, unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all) @@ -214,16 +212,9 @@ import Utils.Containers.Internal.State (State(..), execState) import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, foldl', foldr'), toList) import qualified Data.Foldable as F -#if !(__GLASGOW_HASKELL__ >= 708) -import qualified Data.List -#endif - -#if MIN_VERSION_base(4,9,0) import qualified Data.Semigroup as Semigroup import Data.Functor.Classes -#endif import Data.Traversable -import Data.Typeable -- GHC specific stuff #ifdef __GLASGOW_HASKELL__ @@ -245,21 +236,10 @@ import qualified GHC.Arr #endif import Utils.Containers.Internal.Coercions ((.#), (.^#)) --- Coercion on GHC 7.8+ -#if __GLASGOW_HASKELL__ >= 708 import Data.Coerce import qualified GHC.Exts -#else -#endif --- Identity functor on base 4.8 (GHC 7.10+) -#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity(..)) -#endif - -#if !MIN_VERSION_base(4,8,0) -import Data.Word (Word) -#endif import Utils.Containers.Internal.StrictPair (StrictPair (..), toPair) import Control.Monad.Zip (MonadZip (..)) @@ -371,11 +351,6 @@ fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs) {-# NOINLINE [1] fmapSeq #-} {-# RULES "fmapSeq/fmapSeq" forall f g xs . fmapSeq f (fmapSeq g xs) = fmapSeq (f . g) xs - #-} -#endif -#if __GLASGOW_HASKELL__ >= 709 --- Safe coercions were introduced in 7.8, but did not work well with RULES yet. -{-# RULES "fmapSeq/coerce" fmapSeq coerce = coerce #-} #endif @@ -408,12 +383,10 @@ instance Foldable Seq where foldl1 f (Seq xs) = getElem (foldl1 f' xs) where f' (Elem x) (Elem y) = Elem (f x y) -#if MIN_VERSION_base(4,8,0) length = length {-# INLINE length #-} null = null {-# INLINE null #-} -#endif instance Traversable Seq where #if __GLASGOW_HASKELL__ @@ -601,7 +574,7 @@ liftA2Seq f xs ys@(Seq ysFT) = case viewl xs of (fmap (fmap (f lastx)) (nodeToDigit sf)) where lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ lift_elem = coerce #else lift_elem f x (Elem y) = Elem (f x y) @@ -914,7 +887,6 @@ instance Show a => Show (Seq a) where showString "fromList " . shows (toList xs) #endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Show1 Seq where liftShowsPrec _shwsPrc shwList p xs = showParen (p > 10) $ @@ -927,7 +899,6 @@ instance Eq1 Seq where -- | @since 0.5.9 instance Ord1 Seq where liftCompare cmp xs ys = liftCompare cmp (toList xs) (toList ys) -#endif instance Read a => Read (Seq a) where #ifdef __GLASGOW_HASKELL__ @@ -944,31 +915,21 @@ instance Read a => Read (Seq a) where return (fromList xs,t) #endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Read1 Seq where liftReadsPrec _rp readLst p = readParen (p > 10) $ \r -> do ("fromList",s) <- lex r (xs,t) <- readLst s pure (fromList xs, t) -#endif instance Monoid (Seq a) where mempty = empty -#if MIN_VERSION_base(4,9,0) mappend = (Semigroup.<>) -#else - mappend = (><) -#endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.7 instance Semigroup.Semigroup (Seq a) where (<>) = (><) stimes = cycleNTimes . fromIntegral -#endif - -INSTANCE_TYPEABLE1(Seq) #if __GLASGOW_HASKELL__ instance Data a => Data (Seq a) where @@ -1380,7 +1341,7 @@ instance Sized (Elem a) where size _ = 1 instance Functor Elem where -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ -- This cuts the time for <*> by around a fifth. fmap = coerce #else @@ -1389,7 +1350,7 @@ instance Functor Elem where instance Foldable Elem where foldr f z (Elem x) = f x z -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ foldMap = coerce foldl = coerce foldl' = coerce @@ -1408,16 +1369,6 @@ instance NFData a => NFData (Elem a) where ------------------------------------------------------- -- Applicative construction ------------------------------------------------------- -#if !MIN_VERSION_base(4,8,0) -newtype Identity a = Identity {runIdentity :: a} - -instance Functor Identity where - fmap f (Identity x) = Identity (f x) - -instance Applicative Identity where - pure = Identity - Identity f <*> Identity x = Identity (f x) -#endif -- | 'applicativeTree' takes an Applicative-wrapped construction of a -- piece of a FingerTree, assumed to always have the same size (which @@ -1718,15 +1669,8 @@ replicateA n x -- -- For @base >= 4.8.0@ and @containers >= 0.5.11@, 'replicateM' -- is a synonym for 'replicateA'. -#if MIN_VERSION_base(4,8,0) replicateM :: Applicative m => Int -> m a -> m (Seq a) replicateM = replicateA -#else -replicateM :: Monad m => Int -> m a -> m (Seq a) -replicateM n x - | n >= 0 = Applicative.unwrapMonad (replicateA n (Applicative.WrapMonad x)) - | otherwise = error "replicateM takes a nonnegative integer argument" -#endif -- | /O(/log/ k)/. @'cycleTaking' k xs@ forms a sequence of length @k@ by -- repeatedly concatenating @xs@ with itself. @xs@ may only be empty if @@ -2189,8 +2133,6 @@ deriving instance Generic1 ViewL deriving instance Generic (ViewL a) #endif -INSTANCE_TYPEABLE1(ViewL) - instance Functor ViewL where {-# INLINE fmap #-} fmap _ EmptyL = EmptyL @@ -2209,13 +2151,11 @@ instance Foldable ViewL where foldl1 _ EmptyL = error "foldl1: empty view" foldl1 f (x :< xs) = foldl f x xs -#if MIN_VERSION_base(4,8,0) null EmptyL = True null (_ :< _) = False length EmptyL = 0 length (_ :< xs) = 1 + length xs -#endif instance Traversable ViewL where traverse _ EmptyL = pure EmptyL @@ -2257,8 +2197,6 @@ deriving instance Generic1 ViewR deriving instance Generic (ViewR a) #endif -INSTANCE_TYPEABLE1(ViewR) - instance Functor ViewR where {-# INLINE fmap #-} fmap _ EmptyR = EmptyR @@ -2276,13 +2214,12 @@ instance Foldable ViewR where foldr1 _ EmptyR = error "foldr1: empty view" foldr1 f (xs :> x) = foldr f x xs -#if MIN_VERSION_base(4,8,0) + null EmptyR = True null (_ :> _) = False length EmptyR = 0 length (xs :> _) = length xs + 1 -#endif instance Traversable ViewR where traverse _ EmptyR = pure EmptyR @@ -2553,7 +2490,7 @@ adjust f i (Seq xs) -- -- @since 0.5.8 adjust' :: forall a . (a -> a) -> Int -> Seq a -> Seq a -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ adjust' f i xs -- See note on unsigned arithmetic in splitAt | fromIntegral i < (fromIntegral (length xs) :: Word) = @@ -3161,7 +3098,7 @@ foldMapWithIndex :: Monoid m => (Int -> a -> m) -> Seq a -> m foldMapWithIndex f' (Seq xs') = foldMapWithIndexTreeE (lift_elem f') 0 xs' where lift_elem :: (Int -> a -> m) -> (Int -> Elem a -> m) -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ lift_elem g = coerce g #else lift_elem g = \s (Elem a) -> g s a @@ -3358,7 +3295,7 @@ fromFunction len f | len < 0 = error "Data.Sequence.fromFunction called with neg {-# INLINE mb #-} lift_elem :: (Int -> a) -> (Int -> Elem a) -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ lift_elem g = coerce g #else lift_elem g = Elem . g @@ -4393,7 +4330,7 @@ fromList = Seq . mkTree . map_elem !n10 = Node3 (3*s) n1 n2 n3 map_elem :: [a] -> [Elem a] -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ map_elem xs = coerce xs #else map_elem xs = Data.List.map Elem xs @@ -4403,7 +4340,7 @@ fromList = Seq . mkTree . map_elem -- essentially: Free ((,) a) b. data ListFinal a cont = LFinal !cont | LCons !a (ListFinal a cont) -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ instance GHC.Exts.IsList (Seq a) where type Item (Seq a) = a fromList = fromList @@ -4434,7 +4371,7 @@ fmapReverse :: (a -> b) -> Seq a -> Seq b fmapReverse f (Seq xs) = Seq (fmapReverseTree (lift_elem f) xs) where lift_elem :: (a -> b) -> (Elem a -> Elem b) -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ lift_elem = coerce #else lift_elem g (Elem a) = Elem (g a) @@ -4762,7 +4699,7 @@ class UnzipWith f where -- This instance is only used at the very top of the tree; -- the rest of the elements are handled by unzipWithNodeElem instance UnzipWith Elem where -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ unzipWith' = coerce #else unzipWith' f (Elem a) = case f a of (x, y) -> (Elem x, Elem y) diff --git a/containers/src/Data/Set.hs b/containers/src/Data/Set.hs index e3f7281b6..0b4bc57d4 100644 --- a/containers/src/Data/Set.hs +++ b/containers/src/Data/Set.hs @@ -67,7 +67,7 @@ module Data.Set ( -- * Set type #if !defined(TESTING) - Set -- instance Eq,Ord,Show,Read,Data,Typeable + Set -- instance Eq,Ord,Show,Read,Data #else Set(..) #endif diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs index ffcca01ed..305830449 100644 --- a/containers/src/Data/Set/Internal.hs +++ b/containers/src/Data/Set/Internal.hs @@ -1,13 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} -#if __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} -#endif #if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TypeFamilies #-} #endif @@ -124,7 +121,7 @@ module Data.Set.Internal ( -- * Set type - Set(..) -- instance Eq,Ord,Show,Read,Data,Typeable + Set(..) -- instance Eq,Ord,Show,Read,Data , Size -- * Operators @@ -234,27 +231,14 @@ import Prelude hiding (filter,foldl,foldr,null,map,take,drop,splitAt) import Control.Applicative (Const(..)) import qualified Data.List as List import Data.Bits (shiftL, shiftR) -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid (Monoid(..)) -#endif -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(stimes)) -#endif -#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0) +#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>))) #endif -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (stimesIdempotentMonoid) import Data.Functor.Classes -#endif -#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity) -#endif import qualified Data.Foldable as Foldable -#if !MIN_VERSION_base(4,8,0) -import Data.Foldable (Foldable (foldMap)) -#endif -import Data.Typeable import Control.DeepSeq (NFData(rnf)) import Utils.Containers.Internal.StrictPair @@ -262,9 +246,7 @@ import Utils.Containers.Internal.PtrEquality #if __GLASGOW_HASKELL__ import GHC.Exts ( build, lazy ) -#if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as GHCExts -#endif import Text.Read ( readPrec, Read (..), Lexeme (..), parens, prec , lexP, readListPrecDefault ) import Data.Data @@ -294,24 +276,19 @@ data Set a = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a) type Size = Int -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ type role Set nominal #endif instance Ord a => Monoid (Set a) where mempty = empty mconcat = unions -#if !(MIN_VERSION_base(4,9,0)) - mappend = union -#else mappend = (<>) -- | @since 0.5.7 instance Ord a => Semigroup (Set a) where (<>) = union stimes = stimesIdempotentMonoid -#endif - -- | Folds in order of increasing key. instance Foldable.Foldable Set where @@ -333,7 +310,6 @@ instance Foldable.Foldable Set where {-# INLINE foldl' #-} foldr' = foldr' {-# INLINE foldr' #-} -#if MIN_VERSION_base(4,8,0) length = size {-# INLINE length #-} null = null @@ -352,8 +328,6 @@ instance Foldable.Foldable Set where {-# INLINABLE sum #-} product = foldl' (*) 1 {-# INLINABLE product #-} -#endif - #if __GLASGOW_HASKELL__ @@ -633,9 +607,7 @@ alterF f k s = fmap choose (f member_) #-} #endif -#if MIN_VERSION_base(4,8,0) {-# SPECIALIZE alterF :: Ord a => (Bool -> Identity Bool) -> a -> Set a -> Identity (Set a) #-} -#endif data AlteredSet a -- | The needle is present in the original set. @@ -1030,7 +1002,8 @@ elems = toAscList {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} -#if __GLASGOW_HASKELL__ >= 708 + +#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance (Ord a) => GHCExts.IsList (Set a) where type Item (Set a) = a @@ -1232,7 +1205,6 @@ instance Show a => Show (Set a) where showsPrec p xs = showParen (p > 10) $ showString "fromList " . shows (toList xs) -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Eq1 Set where liftEq eq m n = @@ -1247,7 +1219,6 @@ instance Ord1 Set where instance Show1 Set where liftShowsPrec sp sl d m = showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m) -#endif {-------------------------------------------------------------------- Read @@ -1267,12 +1238,6 @@ instance (Read a, Ord a) => Read (Set a) where return (fromList xs,t) #endif -{-------------------------------------------------------------------- - Typeable/Data ---------------------------------------------------------------------} - -INSTANCE_TYPEABLE1(Set) - {-------------------------------------------------------------------- NFData --------------------------------------------------------------------} @@ -1878,19 +1843,13 @@ cartesianProduct as bs = -- This is used to define cartesianProduct. newtype MergeSet a = MergeSet { getMergeSet :: Set a } -#if (MIN_VERSION_base(4,9,0)) instance Semigroup (MergeSet a) where MergeSet xs <> MergeSet ys = MergeSet (merge xs ys) -#endif instance Monoid (MergeSet a) where mempty = MergeSet empty -#if (MIN_VERSION_base(4,9,0)) mappend = (<>) -#else - mappend (MergeSet xs) (MergeSet ys) = MergeSet (merge xs ys) -#endif -- | Calculate the disjoint union of two sets. -- diff --git a/containers/src/Data/Tree.hs b/containers/src/Data/Tree.hs index 0bc7c0c60..318cb13ef 100644 --- a/containers/src/Data/Tree.hs +++ b/containers/src/Data/Tree.hs @@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE Trustworthy #-} #endif @@ -51,21 +51,12 @@ module Data.Tree( ) where -#if MIN_VERSION_base(4,8,0) import Data.Foldable (toList) import Control.Applicative (Applicative(..), liftA2) -#else -import Control.Applicative (Applicative(..), liftA2, (<$>)) -import Data.Foldable (Foldable(foldMap), toList) -import Data.Monoid (Monoid(..)) -import Data.Traversable (Traversable(traverse)) -#endif - import Control.Monad (liftM) import Control.Monad.Fix (MonadFix (..), fix) import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList, ViewL(..), ViewR(..), viewl, viewr) -import Data.Typeable import Control.DeepSeq (NFData(rnf)) #ifdef __GLASGOW_HASKELL__ @@ -75,20 +66,14 @@ import GHC.Generics (Generic, Generic1) import Control.Monad.Zip (MonadZip (..)) -#if MIN_VERSION_base(4,8,0) import Data.Coerce -#endif -#if MIN_VERSION_base(4,9,0) import Data.Functor.Classes -#endif -#if (!MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0) + +#if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup (..)) #endif -#if !MIN_VERSION_base(4,8,0) -import Data.Functor ((<$)) -#endif -- | Non-empty, possibly infinite, multi-way trees; also known as /rose trees/. data Tree a = Node { @@ -112,7 +97,6 @@ data Tree a = Node { -- reasons. type Forest a = [Tree a] -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Eq1 Tree where liftEq eq = leq @@ -147,9 +131,6 @@ instance Read1 Tree where (fr, s9) <- liftReadList rd rdl s8 ("}", s10) <- lex s9 pure (Node a fr, s10) -#endif - -INSTANCE_TYPEABLE1(Tree) instance Functor Tree where fmap = fmapTree @@ -157,9 +138,8 @@ instance Functor Tree where fmapTree :: (a -> b) -> Tree a -> Tree b fmapTree f (Node x ts) = Node (f x) (map (fmapTree f) ts) -#if MIN_VERSION_base(4,8,0) --- Safe coercions were introduced in 4.7.0, but I am not sure if they played --- well enough with RULES to do what we want. + +#ifdef __GLASGOW_HASKELL__ {-# NOINLINE [1] fmapTree #-} {-# RULES "fmapTree/coerce" fmapTree coerce = coerce @@ -200,12 +180,11 @@ instance Traversable Tree where instance Foldable Tree where foldMap f (Node x ts) = f x `mappend` foldMap (foldMap f) ts -#if MIN_VERSION_base(4,8,0) null _ = False {-# INLINE null #-} + toList = flatten {-# INLINE toList #-} -#endif instance NFData a => NFData (Tree a) where rnf (Node x ts) = rnf x `seq` rnf ts diff --git a/containers/src/Utils/Containers/Internal/BitQueue.hs b/containers/src/Utils/Containers/Internal/BitQueue.hs index 99d9ea065..200c4493b 100644 --- a/containers/src/Utils/Containers/Internal/BitQueue.hs +++ b/containers/src/Utils/Containers/Internal/BitQueue.hs @@ -44,22 +44,9 @@ module Utils.Containers.Internal.BitQueue , toListQ ) where -#if !MIN_VERSION_base(4,8,0) -import Data.Word (Word) -#endif import Utils.Containers.Internal.BitUtil (shiftLL, shiftRL, wordSize) import Data.Bits ((.|.), (.&.), testBit) -#if MIN_VERSION_base(4,8,0) import Data.Bits (countTrailingZeros) -#else -import Data.Bits (popCount) -#endif - -#if !MIN_VERSION_base(4,8,0) -countTrailingZeros :: Word -> Int -countTrailingZeros x = popCount ((x .&. (-x)) - 1) -{-# INLINE countTrailingZeros #-} -#endif -- A bit queue builder. We represent a double word using two words -- because we don't currently have access to proper double words. diff --git a/containers/src/Utils/Containers/Internal/BitUtil.hs b/containers/src/Utils/Containers/Internal/BitUtil.hs index b049abae1..df876c4f4 100644 --- a/containers/src/Utils/Containers/Internal/BitUtil.hs +++ b/containers/src/Utils/Containers/Internal/BitUtil.hs @@ -38,23 +38,10 @@ module Utils.Containers.Internal.BitUtil , wordSize ) where -#if !MIN_VERSION_base(4,8,0) -import Data.Bits ((.|.), xor) -#endif import Data.Bits (popCount, unsafeShiftL, unsafeShiftR -#if MIN_VERSION_base(4,8,0) - , countLeadingZeros -#endif + , countLeadingZeros, finiteBitSize ) -#if MIN_VERSION_base(4,7,0) -import Data.Bits (finiteBitSize) -#else -import Data.Bits (bitSize) -#endif -#if !MIN_VERSION_base (4,8,0) -import Data.Word (Word) -#endif {---------------------------------------------------------------------- [bitcount] as posted by David F. Place to haskell-cafe on April 11, 2006, @@ -78,21 +65,7 @@ bitcount a x = a + popCount x -- | Return a word where only the highest bit is set. highestBitMask :: Word -> Word -#if MIN_VERSION_base(4,8,0) highestBitMask w = shiftLL 1 (wordSize - 1 - countLeadingZeros w) -#else -highestBitMask x1 = let x2 = x1 .|. x1 `shiftRL` 1 - x3 = x2 .|. x2 `shiftRL` 2 - x4 = x3 .|. x3 `shiftRL` 4 - x5 = x4 .|. x4 `shiftRL` 8 - x6 = x5 .|. x5 `shiftRL` 16 -#if !(defined(__GLASGOW_HASKELL__) && WORD_SIZE_IN_BITS==32) - x7 = x6 .|. x6 `shiftRL` 32 - in x7 `xor` (x7 `shiftRL` 1) -#else - in x6 `xor` (x6 `shiftRL` 1) -#endif -#endif {-# INLINE highestBitMask #-} -- Right and left logical shifts. @@ -102,8 +75,4 @@ shiftLL = unsafeShiftL {-# INLINE wordSize #-} wordSize :: Int -#if MIN_VERSION_base(4,7,0) wordSize = finiteBitSize (0 :: Word) -#else -wordSize = bitSize (0 :: Word) -#endif diff --git a/containers/src/Utils/Containers/Internal/Coercions.hs b/containers/src/Utils/Containers/Internal/Coercions.hs index 6d76eaf2b..6f1aa26ab 100644 --- a/containers/src/Utils/Containers/Internal/Coercions.hs +++ b/containers/src/Utils/Containers/Internal/Coercions.hs @@ -5,12 +5,12 @@ module Utils.Containers.Internal.Coercions where -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ import Data.Coerce #endif infixl 8 .# -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ (.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c (.#) f _ = coerce f #else @@ -34,7 +34,7 @@ infix 9 .^# -- @ -- foldl f b . fmap g = foldl (f .^# g) b -- @ -#if __GLASGOW_HASKELL__ >= 708 +#ifdef __GLASGOW_HASKELL__ (.^#) :: Coercible c b => (a -> c -> d) -> (b -> c) -> (a -> b -> d) (.^#) f _ = coerce f #else diff --git a/containers/src/Utils/Containers/Internal/PtrEquality.hs b/containers/src/Utils/Containers/Internal/PtrEquality.hs index 3161d6c7b..6374307b5 100644 --- a/containers/src/Utils/Containers/Internal/PtrEquality.hs +++ b/containers/src/Utils/Containers/Internal/PtrEquality.hs @@ -11,12 +11,8 @@ module Utils.Containers.Internal.PtrEquality (ptrEq, hetPtrEq) where #ifdef __GLASGOW_HASKELL__ import GHC.Exts ( reallyUnsafePtrEquality# ) import Unsafe.Coerce ( unsafeCoerce ) -#if __GLASGOW_HASKELL__ < 707 -import GHC.Exts ( (==#) ) -#else import GHC.Exts ( Int#, isTrue# ) #endif -#endif -- | Checks if two pointers are equal. Yes means yes; -- no means maybe. The values should be forced to at least @@ -30,13 +26,8 @@ ptrEq :: a -> a -> Bool hetPtrEq :: a -> b -> Bool #ifdef __GLASGOW_HASKELL__ -#if __GLASGOW_HASKELL__ < 707 -ptrEq x y = reallyUnsafePtrEquality# x y ==# 1# -hetPtrEq x y = unsafeCoerce reallyUnsafePtrEquality# x y ==# 1# -#else ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y) hetPtrEq x y = isTrue# (unsafeCoerce (reallyUnsafePtrEquality# :: x -> x -> Int#) x y) -#endif #else -- Not GHC diff --git a/containers/src/Utils/Containers/Internal/State.hs b/containers/src/Utils/Containers/Internal/State.hs index 0df041596..0ddf214fc 100644 --- a/containers/src/Utils/Containers/Internal/State.hs +++ b/containers/src/Utils/Containers/Internal/State.hs @@ -5,13 +5,7 @@ -- | A clone of Control.Monad.State.Strict. module Utils.Containers.Internal.State where -import Prelude hiding ( -#if MIN_VERSION_base(4,8,0) - Applicative -#endif - ) - -import Control.Monad (ap) +import Control.Monad (ap, liftM2) import Control.Applicative (Applicative(..), liftA) newtype State s a = State {runState :: s -> (s, a)} @@ -30,6 +24,11 @@ instance Applicative (State s) where {-# INLINE pure #-} pure x = State $ \ s -> (s, x) (<*>) = ap + m *> n = State $ \s -> case runState m s of + (s', _) -> runState n s' +#if MIN_VERSION_base(4,10,0) + liftA2 = liftM2 +#endif execState :: State s a -> s -> a execState m x = snd (runState m x) diff --git a/containers/src/Utils/Containers/Internal/StrictMaybe.hs b/containers/src/Utils/Containers/Internal/StrictMaybe.hs index ed0e3c915..22611cd45 100644 --- a/containers/src/Utils/Containers/Internal/StrictMaybe.hs +++ b/containers/src/Utils/Containers/Internal/StrictMaybe.hs @@ -7,11 +7,6 @@ module Utils.Containers.Internal.StrictMaybe (MaybeS (..), maybeS, toMaybe, toMaybeS) where -#if !MIN_VERSION_base(4,8,0) -import Data.Foldable (Foldable (..)) -import Data.Monoid (Monoid (..)) -#endif - data MaybeS a = NothingS | JustS !a instance Foldable MaybeS where diff --git a/containers/src/Utils/Containers/Internal/TypeError.hs b/containers/src/Utils/Containers/Internal/TypeError.hs index 972918b2e..3bbdbb4fc 100644 --- a/containers/src/Utils/Containers/Internal/TypeError.hs +++ b/containers/src/Utils/Containers/Internal/TypeError.hs @@ -2,11 +2,7 @@ KindSignatures, TypeFamilies, CPP #-} #if !defined(TESTING) -# if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE Safe #-} -# else -{-# LANGUAGE Trustworthy #-} -#endif #endif -- | Unsatisfiable constraints for functions being removed. @@ -14,11 +10,9 @@ module Utils.Containers.Internal.TypeError where import GHC.TypeLits --- | The constraint @Whoops s@ is unsatisfiable for every 'Symbol' @s@. --- Under GHC 8.0 and above, trying to use a function with a @Whoops s@ --- constraint will lead to a pretty type error explaining how to fix --- the problem. Under earlier GHC versions, it will produce an extremely --- ugly type error within which the desired message is buried. +-- | The constraint @Whoops s@ is unsatisfiable for every 'Symbol' @s@. Trying +-- to use a function with a @Whoops s@ constraint will lead to a pretty type +-- error explaining how to fix the problem. -- -- ==== Example -- @@ -28,9 +22,7 @@ import GHC.TypeLits -- @ class Whoops (a :: Symbol) -#if __GLASGOW_HASKELL__ >= 800 instance TypeError ('Text a) => Whoops a -#endif -- Why don't we just use --