diff options
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) |