Commit c13720c8 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

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
parent b311096c
......@@ -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
......
......@@ -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
-----------------------------------------------------------------------------
--
......
......@@ -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))
......
......@@ -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
......
......@@ -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
......@@ -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
......
......@@ -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
......
{-# 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
......
......@@ -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
......
......@@ -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
......
......@@ -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 []
......
{-# 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
......
......@@ -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
......
......@@ -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
-----------------------------------------------------------------------------
--
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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 [] [] []
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
{-# 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
......
{-# 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
......
......@@ -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
......
......@@ -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"
......
......@@ -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
......
......@@ -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)
......
......@@ -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