Drop GHC 7.10 compatibility
authorRyan Scott <ryan.gl.scott@gmail.com>
Tue, 1 Aug 2017 13:48:52 +0000 (09:48 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 1 Aug 2017 14:37:34 +0000 (10:37 -0400)
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:
compiler/cmm/CmmMonad.hs
compiler/cmm/CmmOpt.hs
compiler/coreSyn/CoreLint.hs
compiler/deSugar/Coverage.hs
compiler/ghc.cabal.in
compiler/ghci/ByteCodeGen.hs
compiler/ghci/ByteCodeInstr.hs
compiler/ghci/ByteCodeTypes.hs
compiler/ghci/GHCi.hs [moved from compiler/ghci/GHCi.hsc with 96% similarity]
compiler/ghci/Linker.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/main/InteractiveEvalTypes.hs
compiler/main/Packages.hs
compiler/nativeGen/X86/CodeGen.hs
compiler/parser/Lexer.x
compiler/prelude/TysWiredIn.hs
compiler/specialise/Specialise.hs
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcSMonad.hs
compiler/types/OptCoercion.hs
compiler/types/Unify.hs
compiler/utils/IOEnv.hs
compiler/utils/MonadUtils.hs
compiler/utils/OrdList.hs
compiler/utils/Outputable.hs
compiler/utils/UniqFM.hs
compiler/utils/UniqSet.hs
compiler/utils/Util.hs
ghc/hschooks.c
libraries/base/Data/Bits.hs
libraries/base/GHC/Natural.hs
libraries/base/GHC/Real.hs
libraries/ghci/GHCi/Message.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs

index fc66bf5..c035577 100644 (file)
@@ -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
index 3cb2821..78a1867 100644 (file)
@@ -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
 
 -----------------------------------------------------------------------------
 --
index 2be1020..8b6be2e 100644 (file)
@@ -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))
index 1889203..a9d953d 100644 (file)
@@ -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
index f40c8ba..152e156 100644 (file)
@@ -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
index d8d44cb..939d1dd 100644 (file)
@@ -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
index 5252802..fabde4e 100644 (file)
@@ -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
index 1318a47..4b78600 100644 (file)
@@ -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
similarity index 96%
rename from compiler/ghci/GHCi.hsc
rename to compiler/ghci/GHCi.hs
index d2f2f5a..403cffd 100644 (file)
@@ -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
index aee7684..d174cc0 100644 (file)
@@ -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
 
 
 
index f6ff838..f09237c 100644 (file)
@@ -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 []
index cb01219..e45ef6d 100644 (file)
@@ -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
index 1bd2531..50b9967 100644 (file)
@@ -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
index 341fa43..bd4774a 100644 (file)
@@ -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
 
 -----------------------------------------------------------------------------
 --
index 936948b..c5332fb 100644 (file)
@@ -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)
index 28c6629..5a8c4aa 100644 (file)
@@ -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
index e8c6c28..0fb7eb0 100644 (file)
@@ -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
index 63bc016..d18ec71 100644 (file)
@@ -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 [] [] []
index d3645e7..381710b 100644 (file)
@@ -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
index 92b753f..eaa84d6 100644 (file)
@@ -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
index 6764409..f26351f 100644 (file)
@@ -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
 
index 79d0897..c9c78f7 100644 (file)
@@ -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
index 29854c5..5a7ccd9 100644 (file)
@@ -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
index 93a835e..d6fb317 100644 (file)
@@ -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
index 3c5b9d7..1660090 100644 (file)
@@ -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
index 4107e5b..de27546 100644 (file)
@@ -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"
index 71a092b..8ea8ba4 100644 (file)
@@ -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
index f29a1e6..fcac865 100644 (file)
@@ -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)
index 35a6340..6146bf0 100644 (file)
@@ -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
index 031cb02..87feab3 100644 (file)
@@ -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);
index d12d6dc..da2ea3d 100644 (file)
@@ -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
index 0e5abc7..1356085 100644 (file)
@@ -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##
index 1154091..6206598 100644 (file)
@@ -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)]
index 81de2fb..fe63d64 100644 (file)
@@ -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
index 14aeaeb..90c7282 100644 (file)
@@ -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)