diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-08-01 09:48:52 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-08-01 10:37:34 -0400 |
commit | c13720c8c6047844f659ad4ce684946b80c99bee (patch) | |
tree | 9c6462bf94d69daa318e5a4a9e2d84981743e1ec | |
parent | b311096c5cf4b669dcfceb99561ac6e1c4cca0cd (diff) | |
download | haskell-c13720c8c6047844f659ad4ce684946b80c99bee.tar.gz |
Drop GHC 7.10 compatibility
GHC 8.2.1 is out, so now GHC's support window only extends back to GHC
8.0. This means we can delete gobs of code that was only used for GHC
7.10 support. Hooray!
Test Plan: ./validate
Reviewers: hvr, bgamari, austin, goldfire, simonmar
Reviewed By: bgamari
Subscribers: Phyx, rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D3781
35 files changed, 21 insertions, 242 deletions
diff --git a/compiler/cmm/CmmMonad.hs b/compiler/cmm/CmmMonad.hs index fc66bf5928..c035577473 100644 --- a/compiler/cmm/CmmMonad.hs +++ b/compiler/cmm/CmmMonad.hs @@ -7,16 +7,13 @@ -- The parser for C-- requires access to a lot more of the 'DynFlags', -- so 'PD' provides access to 'DynFlags' via a 'HasDynFlags' instance. ----------------------------------------------------------------------------- -{-# LANGUAGE CPP #-} module CmmMonad ( PD(..) , liftP ) where import Control.Monad -#if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail -#endif import DynFlags import Lexer @@ -34,10 +31,8 @@ instance Monad PD where (>>=) = thenPD fail = failPD -#if __GLASGOW_HASKELL__ > 710 instance MonadFail.MonadFail PD where fail = failPD -#endif liftP :: P a -> PD a liftP (P f) = PD $ \_ s -> f s diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index 3cb28217f2..78a186721b 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -2,9 +2,7 @@ -- The default iteration limit is a bit too low for the definitions -- in this module. -#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-} -#endif ----------------------------------------------------------------------------- -- diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 2be1020674..8b6be2e661 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -64,9 +64,7 @@ import Demand ( splitStrictSig, isBotRes ) import HscTypes import DynFlags import Control.Monad -#if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail -#endif import MonadUtils import Data.Maybe import Pair @@ -1949,10 +1947,8 @@ instance Monad LintM where Just r -> unLintM (k r) env errs' Nothing -> (Nothing, errs')) -#if __GLASGOW_HASKELL__ > 710 instance MonadFail.MonadFail LintM where fail err = failWithL (text err) -#endif instance HasDynFlags LintM where getDynFlags = LintM (\ e errs -> (Just (le_dynflags e), errs)) diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index 18892035cd..a9d953dc0e 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -3,7 +3,7 @@ (c) University of Glasgow, 2007 -} -{-# LANGUAGE CPP, NondecreasingIndentation, RecordWildCards #-} +{-# LANGUAGE NondecreasingIndentation, RecordWildCards #-} module Coverage (addTicksToBinds, hpcInitCode) where @@ -11,11 +11,7 @@ import qualified GHCi import GHCi.RemoteTypes import Data.Array import ByteCodeTypes -#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS -#else -import GHC.Stack as GHC.Stack.CCS -#endif import Type import HsSyn import Module diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index f40c8baed6..152e15682c 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -631,10 +631,3 @@ Library RtClosureInspect DebuggerUtils GHCi - - if !flag(stage1) - -- ghc:Serialized moved to ghc-boot:GHC.Serialized. So for - -- compatibility with GHC 7.10 and earlier, we reexport it - -- under the old name. - reexported-modules: - ghc-boot:GHC.Serialized as Serialized diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index d8d44cb2d0..939d1dd760 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -71,11 +71,7 @@ import qualified Data.Map as Map import qualified Data.IntMap as IntMap import qualified FiniteMap as Map import Data.Ord -#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS -#else -import GHC.Stack as GHC.Stack.CCS -#endif -- ----------------------------------------------------------------------------- -- Generating byte code for a complete module diff --git a/compiler/ghci/ByteCodeInstr.hs b/compiler/ghci/ByteCodeInstr.hs index 525280290f..fabde4e52d 100644 --- a/compiler/ghci/ByteCodeInstr.hs +++ b/compiler/ghci/ByteCodeInstr.hs @@ -30,11 +30,7 @@ import PrimOp import SMRep import Data.Word -#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS (CostCentre) -#else -import GHC.Stack (CostCentre) -#endif -- ---------------------------------------------------------------------------- -- Bytecode instructions diff --git a/compiler/ghci/ByteCodeTypes.hs b/compiler/ghci/ByteCodeTypes.hs index 1318a47ef4..4b78600f70 100644 --- a/compiler/ghci/ByteCodeTypes.hs +++ b/compiler/ghci/ByteCodeTypes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-} -- -- (c) The University of Glasgow 2002-2006 -- @@ -34,11 +34,7 @@ import Data.Array.Base ( UArray(..) ) import Data.ByteString (ByteString) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap -#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS -#else -import GHC.Stack as GHC.Stack.CCS -#endif -- ----------------------------------------------------------------------------- -- Compiled Byte Code diff --git a/compiler/ghci/GHCi.hsc b/compiler/ghci/GHCi.hs index d2f2f5a833..403cffdc70 100644 --- a/compiler/ghci/GHCi.hsc +++ b/compiler/ghci/GHCi.hs @@ -75,23 +75,13 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LB import Data.IORef import Foreign hiding (void) -#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS (CostCentre,CostCentreStack) -#else -import GHC.Stack (CostCentre,CostCentreStack) -#endif import System.Exit import Data.Maybe import GHC.IO.Handle.Types (Handle) #if defined(mingw32_HOST_OS) import Foreign.C import GHC.IO.Handle.FD (fdToHandle) -#if !MIN_VERSION_process(1,4,2) -import System.Posix.Internals -import Foreign.Marshal.Array -import Foreign.C.Error -import Foreign.Storable -#endif #else import System.Posix as Posix #endif @@ -545,22 +535,6 @@ runWithPipes createProc prog opts = do where mkHandle :: CInt -> IO Handle mkHandle fd = (fdToHandle fd) `onException` (c__close fd) -#if !MIN_VERSION_process(1,4,2) --- This #include and the _O_BINARY below are the only reason this is hsc, --- so we can remove that once we can depend on process 1.4.2 -#include <fcntl.h> - -createPipeFd :: IO (FD, FD) -createPipeFd = do - allocaArray 2 $ \ pfds -> do - throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY) - readfd <- peek pfds - writefd <- peekElemOff pfds 1 - return (readfd, writefd) - -foreign import ccall "io.h _pipe" c__pipe :: - Ptr CInt -> CUInt -> CInt -> IO CInt -#endif #else runWithPipes createProc prog opts = do (rfd1, wfd1) <- Posix.createPipe -- we read on rfd1 diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index aee7684157..d174cc089d 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -722,15 +722,6 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp) adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp) adjust_ul _ l@(BCOs {}) = return l -#if !MIN_VERSION_filepath(1,4,1) - stripExtension :: String -> FilePath -> Maybe FilePath - stripExtension [] path = Just path - stripExtension ext@(x:_) path = stripSuffix dotExt path - where dotExt = if isExtSeparator x then ext else '.':ext - - stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] - stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys) -#endif diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index f6ff838d14..f09237c6d9 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -36,10 +36,8 @@ import Util import Control.Monad.Trans.Class import Control.Monad.Trans.Writer -#if __GLASGOW_HASKELL__ > 710 import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup -#endif import Data.List ( nub ) import Data.Maybe ( catMaybes ) @@ -1863,11 +1861,9 @@ getTBAARegMeta = getTBAAMeta . getTBAA -- | A more convenient way of accumulating LLVM statements and declarations. data LlvmAccum = LlvmAccum LlvmStatements [LlvmCmmDecl] -#if __GLASGOW_HASKELL__ > 710 instance Semigroup LlvmAccum where LlvmAccum stmtsA declsA <> LlvmAccum stmtsB declsB = LlvmAccum (stmtsA Semigroup.<> stmtsB) (declsA Semigroup.<> declsB) -#endif instance Monoid LlvmAccum where mempty = LlvmAccum nilOL [] diff --git a/compiler/main/InteractiveEvalTypes.hs b/compiler/main/InteractiveEvalTypes.hs index cb0121950f..e45ef6dde3 100644 --- a/compiler/main/InteractiveEvalTypes.hs +++ b/compiler/main/InteractiveEvalTypes.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow, 2005-2007 @@ -25,11 +23,7 @@ import SrcLoc import Exception import Data.Word -#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS -#else -import GHC.Stack as GHC.Stack.CCS -#endif data ExecOptions = ExecOptions diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 1bd2531caa..50b9967e01 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -89,10 +89,8 @@ import Data.List as List import Data.Map (Map) import Data.Set (Set) import Data.Monoid (First(..)) -#if __GLASGOW_HASKELL__ > 710 import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup -#endif import qualified Data.Map as Map import qualified Data.Map.Strict as MapStrict import qualified Data.Set as Set @@ -206,7 +204,6 @@ fromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False fromFlag :: ModuleOrigin fromFlag = ModOrigin Nothing [] [] True -#if __GLASGOW_HASKELL__ > 710 instance Semigroup ModuleOrigin where ModOrigin e res rhs f <> ModOrigin e' res' rhs' f' = ModOrigin (g e e') (res ++ res') (rhs ++ rhs') (f || f') @@ -216,7 +213,6 @@ instance Semigroup ModuleOrigin where g Nothing x = x g x Nothing = x _x <> _y = panic "ModOrigin: hidden module redefined" -#endif instance Monoid ModuleOrigin where mempty = ModOrigin Nothing [] [] False diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 341fa43dbc..bd4774ae2c 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -2,9 +2,7 @@ -- The default iteration limit is a bit too low for the definitions -- in this module. -#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-} -#endif ----------------------------------------------------------------------------- -- diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 936948b40f..c5332fbe2f 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -77,9 +77,7 @@ module Lexer ( -- base import Control.Monad -#if __GLASGOW_HASKELL__ > 710 import Control.Monad.Fail -#endif import Data.Bits import Data.Char import Data.List @@ -1894,10 +1892,8 @@ instance Monad P where (>>=) = thenP fail = failP -#if __GLASGOW_HASKELL__ > 710 instance MonadFail P where fail = failP -#endif returnP :: a -> P a returnP a = a `seq` (P $ \s -> POk s a) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 28c6629a91..5a8c4aae78 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -162,10 +162,6 @@ import Util import BooleanFormula ( mkAnd ) import qualified Data.ByteString.Char8 as BS -#if !MIN_VERSION_bytestring(0,10,8) -import qualified Data.ByteString.Internal as BSI -import qualified Data.ByteString.Unsafe as BSU -#endif alpha_tyvar :: [TyVar] alpha_tyvar = [alphaTyVar] @@ -690,7 +686,7 @@ isBuiltInOcc_maybe occ = -- boxed tuple data/tycon "()" -> Just $ tup_name Boxed 0 - _ | Just rest <- "(" `stripPrefix` name + _ | Just rest <- "(" `BS.stripPrefix` name , (commas, rest') <- BS.span (==',') rest , ")" <- rest' -> Just $ tup_name Boxed (1+BS.length commas) @@ -698,21 +694,21 @@ isBuiltInOcc_maybe occ = -- unboxed tuple data/tycon "(##)" -> Just $ tup_name Unboxed 0 "Unit#" -> Just $ tup_name Unboxed 1 - _ | Just rest <- "(#" `stripPrefix` name + _ | Just rest <- "(#" `BS.stripPrefix` name , (commas, rest') <- BS.span (==',') rest , "#)" <- rest' -> Just $ tup_name Unboxed (1+BS.length commas) -- unboxed sum tycon - _ | Just rest <- "(#" `stripPrefix` name + _ | Just rest <- "(#" `BS.stripPrefix` name , (pipes, rest') <- BS.span (=='|') rest , "#)" <- rest' -> Just $ tyConName $ sumTyCon (1+BS.length pipes) -- unboxed sum datacon - _ | Just rest <- "(#" `stripPrefix` name + _ | Just rest <- "(#" `BS.stripPrefix` name , (pipes1, rest') <- BS.span (=='|') rest - , Just rest'' <- "_" `stripPrefix` rest' + , Just rest'' <- "_" `BS.stripPrefix` rest' , (pipes2, rest''') <- BS.span (=='|') rest'' , "#)" <- rest''' -> let arity = BS.length pipes1 + BS.length pipes2 + 1 @@ -720,15 +716,6 @@ isBuiltInOcc_maybe occ = in Just $ dataConName $ sumDataCon alt arity _ -> Nothing where - -- TODO: Drop when bytestring 0.10.8 can be assumed -#if MIN_VERSION_bytestring(0,10,8) - stripPrefix = BS.stripPrefix -#else - stripPrefix bs1@(BSI.PS _ _ l1) bs2 - | bs1 `BS.isPrefixOf` bs2 = Just (BSU.unsafeDrop l1 bs2) - | otherwise = Nothing -#endif - name = fastStringToByteString $ occNameFS occ choose_ns :: Name -> Name -> Name diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index e8c6c28eaf..0fb7eb0472 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -43,9 +43,7 @@ import State import UniqDFM import Control.Monad -#if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail -#endif {- ************************************************************************ @@ -2289,10 +2287,8 @@ instance Monad SpecM where z fail str = SpecM $ fail str -#if __GLASGOW_HASKELL__ > 710 instance MonadFail.MonadFail SpecM where fail str = SpecM $ fail str -#endif instance MonadUnique SpecM where getUniqueSupplyM diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 63bc01699c..d18ec71094 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -61,10 +61,8 @@ import Control.Monad ( when ) import Data.List ( partition, mapAccumL, nub, sortBy, unfoldr ) import qualified Data.Set as Set -#if __GLASGOW_HASKELL__ > 710 import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup -#endif {- @@ -247,10 +245,8 @@ Unfortunately, unlike the context, the relevant bindings are added in multiple places so they have to be in the Report. -} -#if __GLASGOW_HASKELL__ > 710 instance Semigroup Report where Report a1 b1 c1 <> Report a2 b2 c2 = Report (a1 ++ a2) (b1 ++ b2) (c1 ++ c2) -#endif instance Monoid Report where mempty = Report [] [] [] diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index d3645e7138..381710b938 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -183,9 +183,7 @@ import Util import PrelNames ( isUnboundName ) import Control.Monad (ap, liftM, msum) -#if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail -#endif import Data.Set ( Set ) import qualified Data.Set as S @@ -3513,10 +3511,8 @@ instance Monad TcPluginM where TcPluginM (\ ev -> do a <- m ev runTcPluginM (k a) ev) -#if __GLASGOW_HASKELL__ > 710 instance MonadFail.MonadFail TcPluginM where fail x = TcPluginM (const $ fail x) -#endif runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a runTcPluginM (TcPluginM m) = m diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 92b753f101..eaa84d6d13 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -160,9 +160,7 @@ import Maybes import TrieMap import Control.Monad -#if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail -#endif import MonadUtils import Data.IORef import Data.List ( foldl', partition ) @@ -2298,10 +2296,8 @@ instance Monad TcS where fail err = TcS (\_ -> fail err) m >>= k = TcS (\ebs -> unTcS m ebs >>= \r -> unTcS (k r) ebs) -#if __GLASGOW_HASKELL__ > 710 instance MonadFail.MonadFail TcS where fail err = TcS (\_ -> fail err) -#endif instance MonadUnique TcS where getUniqueSupplyM = wrapTcS getUniqueSupplyM diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index 67644094ed..f26351f3bd 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -4,9 +4,7 @@ -- The default iteration limit is a bit too low for the definitions -- in this module. -#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-} -#endif module OptCoercion ( optCoercion, checkAxInstCo ) where diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 79d0897a14..c9c78f7d19 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -42,9 +42,7 @@ import UniqFM import UniqSet import Control.Monad -#if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail -#endif import Control.Applicative hiding ( empty ) import qualified Control.Applicative @@ -1050,10 +1048,8 @@ instance Alternative UM where instance MonadPlus UM -#if __GLASGOW_HASKELL__ > 710 instance MonadFail.MonadFail UM where fail _ = UM (\_ -> SurelyApart) -- failed pattern match -#endif initUM :: TvSubstEnv -- subst to extend -> CvSubstEnv diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index 29854c51fe..5a7ccd9972 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- -- (c) The University of Glasgow 2002-2006 -- @@ -41,9 +39,7 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef, import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) import Control.Monad -#if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail -#endif import MonadUtils import Control.Applicative (Alternative(..)) @@ -62,11 +58,8 @@ instance Monad (IOEnv m) where (>>) = (*>) fail _ = failM -- Ignore the string -#if __GLASGOW_HASKELL__ > 710 instance MonadFail.MonadFail (IOEnv m) where fail _ = failM -- Ignore the string -#endif - instance Applicative (IOEnv m) where pure = returnM diff --git a/compiler/utils/MonadUtils.hs b/compiler/utils/MonadUtils.hs index 93a835e04e..d6fb31731e 100644 --- a/compiler/utils/MonadUtils.hs +++ b/compiler/utils/MonadUtils.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | Utilities related to Monad and Applicative classes -- Mostly for backwards compatibility. @@ -34,9 +32,6 @@ import Maybes import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class -#if __GLASGOW_HASKELL__ < 800 -import Control.Monad.Trans.Error () -- for orphan `instance MonadPlus IO` -#endif ------------------------------------------------------------------------------- -- Lift combinators diff --git a/compiler/utils/OrdList.hs b/compiler/utils/OrdList.hs index 3c5b9d7380..1660090ba7 100644 --- a/compiler/utils/OrdList.hs +++ b/compiler/utils/OrdList.hs @@ -9,7 +9,6 @@ Provide trees (of instructions), so that lists of instructions can be appended in linear time. -} -{-# LANGUAGE CPP #-} module OrdList ( OrdList, nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL, @@ -18,10 +17,8 @@ module OrdList ( import Outputable -#if __GLASGOW_HASKELL__ > 710 import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup -#endif infixl 5 `appOL` infixl 5 `snocOL` @@ -39,10 +36,8 @@ data OrdList a instance Outputable a => Outputable (OrdList a) where ppr ol = ppr (fromOL ol) -- Convert to list and print that -#if __GLASGOW_HASKELL__ > 710 instance Semigroup (OrdList a) where (<>) = appOL -#endif instance Monoid (OrdList a) where mempty = nilOL diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 4107e5beef..de27546ac4 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -122,6 +122,7 @@ import Data.List (intersperse) import GHC.Fingerprint import GHC.Show ( showMultiLineString ) +import GHC.Stack ( callStack, prettyCallStack ) {- ************************************************************************ @@ -1130,7 +1131,8 @@ doOrDoes _ = text "do" callStackDoc :: HasCallStack => SDoc callStackDoc = - hang (text "Call stack:") 4 (vcat $ map text $ lines prettyCurrentCallStack) + hang (text "Call stack:") + 4 (vcat $ map text $ lines (prettyCallStack callStack)) pprPanic :: HasCallStack => String -> SDoc -> a -- ^ Throw an exception saying "bug in GHC" diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs index 71a092b28e..8ea8ba4537 100644 --- a/compiler/utils/UniqFM.hs +++ b/compiler/utils/UniqFM.hs @@ -85,10 +85,8 @@ import qualified Data.Monoid as Mon import qualified Data.IntSet as S import Data.Typeable import Data.Data -#if __GLASGOW_HASKELL__ > 710 import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup -#endif newtype UniqFM ele = UFM (M.IntMap ele) @@ -358,10 +356,8 @@ equalKeysUFM (UFM m1) (UFM m2) = M.keys m1 == M.keys m2 -- Instances -#if __GLASGOW_HASKELL__ > 710 instance Semigroup (UniqFM a) where (<>) = plusUFM -#endif instance Monoid (UniqFM a) where mempty = emptyUFM diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs index f29a1e6e1f..fcac865ea8 100644 --- a/compiler/utils/UniqSet.hs +++ b/compiler/utils/UniqSet.hs @@ -9,7 +9,6 @@ Based on @UniqFMs@ (as you would expect). Basically, the things need to be in class @Uniquable@. -} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module UniqSet ( @@ -53,9 +52,7 @@ import Data.Coerce import Outputable import Data.Foldable (foldl') import Data.Data -#if __GLASGOW_HASKELL__ >= 801 import qualified Data.Semigroup -#endif -- Note [UniqSet invariant] -- ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -189,10 +186,8 @@ unsafeUFMToUniqSet = UniqSet instance Outputable a => Outputable (UniqSet a) where ppr = pprUniqSet ppr -#if __GLASGOW_HASKELL__ >= 801 instance Data.Semigroup.Semigroup (UniqSet a) where (<>) = mappend -#endif instance Monoid (UniqSet a) where mempty = UniqSet mempty UniqSet s `mappend` UniqSet t = UniqSet (s `mappend` t) diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index 35a6340fd4..6146bf0113 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -4,11 +4,6 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE BangPatterns #-} -#if __GLASGOW_HASKELL__ < 800 --- For CallStack business -{-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE FlexibleContexts #-} -#endif -- | Highly random utility functions -- @@ -124,12 +119,8 @@ module Util ( hashString, -- * Call stacks -#if MIN_VERSION_GLASGOW_HASKELL(7,10,2,0) - GHC.Stack.CallStack, -#endif HasCallStack, HasDebugCallStack, - prettyCurrentCallStack, -- * Utils for flags OverridingBool(..), @@ -147,7 +138,7 @@ import System.IO.Unsafe ( unsafePerformIO ) import Data.List hiding (group) import GHC.Exts -import qualified GHC.Stack +import GHC.Stack (HasCallStack) import Control.Applicative ( liftA2 ) import Control.Monad ( liftM ) @@ -1368,16 +1359,6 @@ mulHi a b = fromIntegral (r `shiftR` 32) where r :: Int64 r = fromIntegral a * fromIntegral b --- | A compatibility wrapper for the @GHC.Stack.HasCallStack@ constraint. -#if __GLASGOW_HASKELL__ >= 800 -type HasCallStack = GHC.Stack.HasCallStack -#elif MIN_VERSION_GLASGOW_HASKELL(7,10,2,0) -type HasCallStack = (?callStack :: GHC.Stack.CallStack) --- CallStack wasn't present in GHC 7.10.1, disable callstacks in stage 1 -#else -type HasCallStack = (() :: Constraint) -#endif - -- | A call stack constraint, but only when 'isDebugOn'. #if defined(DEBUG) type HasDebugCallStack = HasCallStack @@ -1385,18 +1366,6 @@ type HasDebugCallStack = HasCallStack type HasDebugCallStack = (() :: Constraint) #endif --- | Pretty-print the current callstack -#if __GLASGOW_HASKELL__ >= 800 -prettyCurrentCallStack :: HasCallStack => String -prettyCurrentCallStack = GHC.Stack.prettyCallStack GHC.Stack.callStack -#elif MIN_VERSION_GLASGOW_HASKELL(7,10,2,0) -prettyCurrentCallStack :: (?callStack :: GHC.Stack.CallStack) => String -prettyCurrentCallStack = GHC.Stack.showCallStack ?callStack -#else -prettyCurrentCallStack :: HasCallStack => String -prettyCurrentCallStack = "Call stack unavailable" -#endif - data OverridingBool = Auto | Always diff --git a/ghc/hschooks.c b/ghc/hschooks.c index 031cb02d1a..87feab370a 100644 --- a/ghc/hschooks.c +++ b/ghc/hschooks.c @@ -63,11 +63,9 @@ StackOverflowHook (StgWord stack_size) /* in bytes */ int main (int argc, char *argv[]) { RtsConfig conf = defaultRtsConfig; -#if __GLASGOW_HASKELL__ >= 711 conf.defaultsHook = defaultsHook; conf.rts_opts_enabled = RtsOptsAll; conf.stackOverflowHook = StackOverflowHook; -#endif extern StgClosure ZCMain_main_closure; hs_main(argc, argv, &ZCMain_main_closure, conf); diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs index d12d6dc4bd..da2ea3d18f 100644 --- a/libraries/base/Data/Bits.hs +++ b/libraries/base/Data/Bits.hs @@ -57,17 +57,13 @@ module Data.Bits ( #include "MachDeps.h" -#if defined(MIN_VERSION_integer_gmp) -# define HAVE_INTEGER_GMP1 MIN_VERSION_integer_gmp(1,0,0) -#endif - import Data.Maybe import GHC.Enum import GHC.Num import GHC.Base import GHC.Real -#if HAVE_INTEGER_GMP1 +#if defined(MIN_VERSION_integer_gmp) import GHC.Integer.GMP.Internals (bitInteger, popCountInteger) #endif @@ -526,7 +522,7 @@ instance Bits Integer where testBit x (I# i) = testBitInteger x i zeroBits = 0 -#if HAVE_INTEGER_GMP1 +#if defined(MIN_VERSION_integer_gmp) bit (I# i#) = bitInteger i# popCount x = I# (popCountInteger x) #else diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index 0e5abc77bc..13560850af 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -47,16 +47,10 @@ module GHC.Natural #include "MachDeps.h" -#if defined(MIN_VERSION_integer_gmp) -# define HAVE_GMP_BIGNAT MIN_VERSION_integer_gmp(1,0,0) -#else -# define HAVE_GMP_BIGNAT 0 -#endif - import GHC.Arr import GHC.Base import {-# SOURCE #-} GHC.Exception (underflowException) -#if HAVE_GMP_BIGNAT +#if defined(MIN_VERSION_integer_gmp) import GHC.Integer.GMP.Internals import Data.Word import Data.Int @@ -87,7 +81,7 @@ underflowError = raise# underflowException -- Natural type ------------------------------------------------------------------------------- -#if HAVE_GMP_BIGNAT +#if defined(MIN_VERSION_integer_gmp) -- TODO: if saturated arithmetic is to used, replace 'underflowError' by '0' -- | Type representing arbitrary-precision non-negative integers. @@ -450,7 +444,7 @@ naturalToInt :: Natural -> Int naturalToInt (NatS# w#) = I# (word2Int# w#) naturalToInt (NatJ# bn) = I# (bigNatToInt bn) -#else /* !HAVE_GMP_BIGNAT */ +#else /* !defined(MIN_VERSION_integer_gmp) */ ---------------------------------------------------------------------------- -- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package @@ -606,7 +600,7 @@ instance Integral Natural where -- -- @since 4.8.0.0 wordToNatural :: Word -> Natural -#if HAVE_GMP_BIGNAT +#if defined(MIN_VERSION_integer_gmp) wordToNatural (W# w#) = NatS# w# #else wordToNatural w = Natural (fromIntegral w) @@ -617,7 +611,7 @@ wordToNatural w = Natural (fromIntegral w) -- -- @since 4.8.0.0 naturalToWordMaybe :: Natural -> Maybe Word -#if HAVE_GMP_BIGNAT +#if defined(MIN_VERSION_integer_gmp) naturalToWordMaybe (NatS# w#) = Just (W# w#) naturalToWordMaybe (NatJ# _) = Nothing #else @@ -633,7 +627,7 @@ naturalToWordMaybe (Natural i) -- -- @since 4.8.0.0 powModNatural :: Natural -> Natural -> Natural -> Natural -#if HAVE_GMP_BIGNAT +#if defined(MIN_VERSION_integer_gmp) powModNatural _ _ (NatS# 0##) = divZeroError powModNatural _ _ (NatS# 1##) = NatS# 0## powModNatural _ (NatS# 0##) _ = NatS# 1## diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs index 1154091dd5..6206598e39 100644 --- a/libraries/base/GHC/Real.hs +++ b/libraries/base/GHC/Real.hs @@ -646,7 +646,6 @@ lcm x y = abs ((x `quot` (gcd x y)) * y) gcdInt' :: Int -> Int -> Int gcdInt' (I# x) (I# y) = I# (gcdInt x y) -#if MIN_VERSION_integer_gmp(1,0,0) {-# RULES "gcd/Word->Word->Word" gcd = gcdWord' #-} @@ -654,7 +653,6 @@ gcdInt' (I# x) (I# y) = I# (gcdInt x y) gcdWord' :: Word -> Word -> Word gcdWord' (W# x) (W# y) = W# (gcdWord x y) #endif -#endif integralEnumFrom :: (Integral a, Bounded a) => a -> [a] integralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)] diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index 81de2fbd21..fe63d641a4 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -48,11 +48,7 @@ import Data.Typeable (TypeRep) import Data.IORef import Data.Map (Map) import GHC.Generics -#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS -#else -import GHC.Stack as GHC.Stack.CCS -#endif import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH import System.Exit @@ -384,17 +380,7 @@ fromSerializableException EUserInterrupt = toException UserInterrupt fromSerializableException (EExitCode c) = toException c fromSerializableException (EOtherException str) = toException (ErrorCall str) --- NB: Replace this with a derived instance once we depend on GHC 8.0 --- as the minimum -instance Binary ExitCode where - put ExitSuccess = putWord8 0 - put (ExitFailure ec) = putWord8 1 >> put ec - get = do - w <- getWord8 - case w of - 0 -> pure ExitSuccess - _ -> ExitFailure <$> get - +instance Binary ExitCode instance Binary SerializableException data THResult a diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 14aeaeb380..90c728296b 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1,14 +1,10 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleInstances, DefaultSignatures, RankNTypes, RoleAnnotations, ScopedTypeVariables, Trustworthy #-} {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} -#if MIN_VERSION_base(4,9,0) -# define HAS_MONADFAIL 1 -#endif - ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Syntax @@ -45,9 +41,7 @@ import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions import Numeric.Natural -#if HAS_MONADFAIL import qualified Control.Monad.Fail as Fail -#endif ----------------------------------------------------- -- @@ -55,11 +49,7 @@ import qualified Control.Monad.Fail as Fail -- ----------------------------------------------------- -#if HAS_MONADFAIL class Fail.MonadFail m => Quasi m where -#else -class Monad m => Quasi m where -#endif qNewName :: String -> m Name -- ^ Fresh names @@ -179,14 +169,10 @@ runQ (Q m) = m instance Monad Q where Q m >>= k = Q (m >>= \x -> unQ (k x)) (>>) = (*>) -#if !HAS_MONADFAIL - fail s = report True s >> Q (fail "Q monad failure") -#else fail = Fail.fail instance Fail.MonadFail Q where fail s = report True s >> Q (Fail.fail "Q monad failure") -#endif instance Functor Q where fmap f (Q x) = Q (fmap f x) |