From 152055a19cf368439c8450040b68142f8e7d0346 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Tue, 13 Mar 2018 13:36:38 -0400
Subject: [PATCH] Drop GHC 8.0 compatibility

GHC 8.4.1 is out, so now GHC's support window only extends
back to GHC 8.2. This means we can delete gobs of code that were
only used for GHC 8.0 support. Hooray!

Test Plan: ./validate

Reviewers: bgamari, erikd, dfeuer

Reviewed By: bgamari, dfeuer

Subscribers: alexbiehl, dfeuer, rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4492
---
 compiler/basicTypes/BasicTypes.hs    |  2 +-
 compiler/basicTypes/Module.hs        |  8 +++-----
 compiler/basicTypes/RdrName.hs       |  2 +-
 compiler/hsSyn/HsExpr.hs             |  2 --
 compiler/main/SysTools/BaseDir.hs    |  4 ----
 compiler/utils/Binary.hs             | 26 --------------------------
 compiler/utils/UniqFM.hs             | 10 +---------
 compiler/utils/UniqMap.hs            |  3 +--
 libraries/ghc-boot/GHC/PackageDb.hs  | 22 ++--------------------
 libraries/ghc-boot/GHC/Serialized.hs |  7 -------
 libraries/ghci/GHCi/Message.hs       |  6 +-----
 libraries/ghci/GHCi/TH/Binary.hs     | 17 -----------------
 testsuite/timeout/WinCBindings.hsc   |  3 ---
 13 files changed, 10 insertions(+), 102 deletions(-)

diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index d8c3eb739d92..c2f442985c29 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -442,7 +442,7 @@ compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
 -- |Captures the fixity of declarations as they are parsed. This is not
 -- necessarily the same as the fixity declaration, as the normal fixity may be
 -- overridden using parens or backticks.
-data LexicalFixity = Prefix | Infix deriving (Typeable,Data,Eq)
+data LexicalFixity = Prefix | Infix deriving (Data,Eq)
 
 instance Outputable LexicalFixity where
   ppr Prefix = text "Prefix"
diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs
index 7fec612234dd..5b198b33dec0 100644
--- a/compiler/basicTypes/Module.hs
+++ b/compiler/basicTypes/Module.hs
@@ -551,7 +551,6 @@ instance Outputable ComponentId where
 data UnitId
     = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId
     |   DefiniteUnitId {-# UNPACK #-} !DefUnitId
-    deriving (Typeable)
 
 unitIdFS :: UnitId -> FastString
 unitIdFS (IndefiniteUnitId x) = indefUnitIdFS x
@@ -589,7 +588,7 @@ data IndefUnitId
         -- fully instantiated (free module variables are empty)
         -- and whether or not a substitution can have any effect.
         indefUnitIdFreeHoles :: UniqDSet ModuleName
-    } deriving (Typeable)
+    }
 
 instance Eq IndefUnitId where
   u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2
@@ -644,7 +643,7 @@ indefUnitIdToUnitId dflags iuid =
 data IndefModule = IndefModule {
         indefModuleUnitId :: IndefUnitId,
         indefModuleName   :: ModuleName
-    } deriving (Typeable, Eq, Ord)
+    } deriving (Eq, Ord)
 
 instance Outputable IndefModule where
   ppr (IndefModule uid m) =
@@ -672,7 +671,6 @@ newtype InstalledUnitId =
       -- and the hash.
       installedUnitIdFS :: FastString
     }
-   deriving (Typeable)
 
 instance Binary InstalledUnitId where
   put_ bh (InstalledUnitId fs) = put_ bh fs
@@ -763,7 +761,7 @@ installedUnitIdEq iuid uid =
 -- it only refers to a definite library; i.e., one we have generated
 -- code for.
 newtype DefUnitId = DefUnitId { unDefUnitId :: InstalledUnitId }
-    deriving (Eq, Ord, Typeable)
+    deriving (Eq, Ord)
 
 instance Outputable DefUnitId where
     ppr (DefUnitId uid) = ppr uid
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs
index 2ff0be30d178..6ff114b343fc 100644
--- a/compiler/basicTypes/RdrName.hs
+++ b/compiler/basicTypes/RdrName.hs
@@ -473,7 +473,7 @@ data Parent = NoParent
             | ParentIs  { par_is :: Name }
             | FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString }
               -- ^ See Note [Parents for record fields]
-            deriving (Eq, Data, Typeable)
+            deriving (Eq, Data)
 
 instance Outputable Parent where
    ppr NoParent        = empty
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 925967271f06..5e43645854f4 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -2132,7 +2132,6 @@ data HsSplice id
                 -- between the two.
         ThModFinalizers     -- TH finalizers produced by the splice.
         (HsSplicedThing id) -- The result of splicing
-  deriving Typeable
 deriving instance (DataId id) => Data (HsSplice id)
 
 -- | A splice can appear with various decorations wrapped around it. This data
@@ -2173,7 +2172,6 @@ data HsSplicedThing id
     = HsSplicedExpr (HsExpr id) -- ^ Haskell Spliced Expression
     | HsSplicedTy   (HsType id) -- ^ Haskell Spliced Type
     | HsSplicedPat  (Pat id)    -- ^ Haskell Spliced Pattern
-  deriving Typeable
 
 deriving instance (DataId id) => Data (HsSplicedThing id)
 
diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs
index 2c264b8a2f50..c707dac7e752 100644
--- a/compiler/main/SysTools/BaseDir.hs
+++ b/compiler/main/SysTools/BaseDir.hs
@@ -29,11 +29,7 @@ import System.Environment (getExecutablePath)
 
 -- Windows
 #if defined(mingw32_HOST_OS)
-#if MIN_VERSION_Win32(2,5,0)
 import qualified System.Win32.Types as Win32
-#else
-import qualified System.Win32.Info as Win32
-#endif
 import Exception
 import Foreign
 import Foreign.C.String
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index c3c8ae3ab7b1..447317ca476c 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -79,14 +79,10 @@ import qualified Data.ByteString.Unsafe   as BS
 import Data.IORef
 import Data.Char                ( ord, chr )
 import Data.Time
-#if MIN_VERSION_base(4,10,0)
 import Type.Reflection
 import Type.Reflection.Unsafe
 import Data.Kind (Type)
 import GHC.Exts (TYPE, RuntimeRep(..), VecCount(..), VecElem(..))
-#else
-import Data.Typeable
-#endif
 import Control.Monad            ( when )
 import System.IO as IO
 import System.IO.Unsafe         ( unsafeInterleaveIO )
@@ -610,7 +606,6 @@ instance Binary (Bin a) where
 -- -----------------------------------------------------------------------------
 -- Instances for Data.Typeable stuff
 
-#if MIN_VERSION_base(4,10,0)
 instance Binary TyCon where
     put_ bh tc = do
         put_ bh (tyConPackage tc)
@@ -620,17 +615,7 @@ instance Binary TyCon where
         put_ bh (tyConKindRep tc)
     get bh =
         mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh
-#else
-instance Binary TyCon where
-    put_ bh tc = do
-        put_ bh (tyConPackage tc)
-        put_ bh (tyConModule tc)
-        put_ bh (tyConName tc)
-    get bh =
-        mkTyCon3 <$> get bh <*> get bh <*> get bh
-#endif
 
-#if MIN_VERSION_base(4,10,0)
 instance Binary VecCount where
     put_ bh = putByte bh . fromIntegral . fromEnum
     get bh = toEnum . fromIntegral <$> getByte bh
@@ -781,17 +766,6 @@ instance Typeable a => Binary (TypeRep (a :: k)) where
 instance Binary SomeTypeRep where
     put_ bh (SomeTypeRep rep) = putTypeRep bh rep
     get = getSomeTypeRep
-#else
-instance Binary TypeRep where
-    put_ bh type_rep = do
-        let (ty_con, child_type_reps) = splitTyConApp type_rep
-        put_ bh ty_con
-        put_ bh child_type_reps
-    get bh = do
-        ty_con <- get bh
-        child_type_reps <- get bh
-        return (mkTyConApp ty_con child_type_reps)
-#endif
 
 -- -----------------------------------------------------------------------------
 -- Lazy reading/writing
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index f0cc197b7101..2a9b8061789f 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -20,7 +20,6 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
 of arguments of combining function.
 -}
 
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -Wall #-}
@@ -79,19 +78,16 @@ import Outputable
 import Data.List (foldl')
 
 import qualified Data.IntMap as M
-#if MIN_VERSION_containers(0,5,9)
 import qualified Data.IntMap.Merge.Lazy as M
 import Control.Applicative (Const (..))
 import qualified Data.Monoid as Mon
-#endif
 import qualified Data.IntSet as S
-import Data.Typeable
 import Data.Data
 import qualified Data.Semigroup as Semi
 
 
 newtype UniqFM ele = UFM (M.IntMap ele)
-  deriving (Data, Eq, Functor, Typeable)
+  deriving (Data, Eq, Functor)
   -- We used to derive Traversable and Foldable, but they were nondeterministic
   -- and not obvious at the call site. You can use explicit nonDetEltsUFM
   -- and fold a list if needed.
@@ -346,14 +342,10 @@ ufmToIntMap (UFM m) = m
 
 -- Determines whether two 'UniqFm's contain the same keys.
 equalKeysUFM :: UniqFM a -> UniqFM b -> Bool
-#if MIN_VERSION_containers(0,5,9)
 equalKeysUFM (UFM m1) (UFM m2) = Mon.getAll $ getConst $
       M.mergeA (M.traverseMissing (\_ _ -> Const (Mon.All False)))
                (M.traverseMissing (\_ _ -> Const (Mon.All False)))
                (M.zipWithAMatched (\_ _ _ -> Const (Mon.All True))) m1 m2
-#else
-equalKeysUFM (UFM m1) (UFM m2) = M.keys m1 == M.keys m2
-#endif
 
 -- Instances
 
diff --git a/compiler/utils/UniqMap.hs b/compiler/utils/UniqMap.hs
index 2dd3cd57ea8d..1bd51c2b38a0 100644
--- a/compiler/utils/UniqMap.hs
+++ b/compiler/utils/UniqMap.hs
@@ -54,12 +54,11 @@ import Outputable
 import Data.Semigroup as Semi ( Semigroup(..) )
 import Data.Coerce
 import Data.Maybe
-import Data.Typeable
 import Data.Data
 
 -- | Maps indexed by 'Uniquable' keys
 newtype UniqMap k a = UniqMap (UniqFM (k, a))
-    deriving (Data, Eq, Functor, Typeable)
+    deriving (Data, Eq, Functor)
 type role UniqMap nominal representational
 
 instance Semigroup (UniqMap k a) where
diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs
index e2e469430882..0bce7001cdf3 100644
--- a/libraries/ghc-boot/GHC/PackageDb.hs
+++ b/libraries/ghc-boot/GHC/PackageDb.hs
@@ -80,9 +80,7 @@ import System.FilePath
 import System.IO
 import System.IO.Error
 import GHC.IO.Exception (IOErrorType(InappropriateType))
-#if MIN_VERSION_base(4,10,0)
 import GHC.IO.Handle.Lock
-#endif
 import System.Directory
 
 
@@ -209,12 +207,7 @@ emptyInstalledPackageInfo =
   }
 
 -- | Represents a lock of a package db.
-newtype PackageDbLock = PackageDbLock
-#if MIN_VERSION_base(4,10,0)
-  Handle
-#else
-  ()  -- no locking primitives available in base < 4.10
-#endif
+newtype PackageDbLock = PackageDbLock Handle
 
 -- | Acquire an exclusive lock related to package DB under given location.
 lockPackageDb :: FilePath -> IO PackageDbLock
@@ -222,8 +215,6 @@ lockPackageDb :: FilePath -> IO PackageDbLock
 -- | Release the lock related to package DB.
 unlockPackageDb :: PackageDbLock -> IO ()
 
-#if MIN_VERSION_base(4,10,0)
-
 -- | Acquire a lock of given type related to package DB under given location.
 lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock
 lockPackageDbWith mode file = do
@@ -273,15 +264,6 @@ unlockPackageDb (PackageDbLock hnd) = do
 #endif
     hClose hnd
 
--- MIN_VERSION_base(4,10,0)
-#else
-
-lockPackageDb _file = return $ PackageDbLock ()
-unlockPackageDb _lock = return ()
-
--- MIN_VERSION_base(4,10,0)
-#endif
-
 -- | Mode to open a package db in.
 data DbMode = DbReadOnly | DbReadWrite
 
@@ -410,7 +392,7 @@ decodeFromFile file mode decoder = case mode of
   -- shared lock on non-Windows platform because we update the database with an
   -- atomic rename, so readers will always see the database in a consistent
   -- state.
-#if MIN_VERSION_base(4,10,0) && defined(mingw32_HOST_OS)
+#if defined(mingw32_HOST_OS)
     bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \_ -> do
 #endif
       (, DbOpenReadOnly) <$> decodeFileContents
diff --git a/libraries/ghc-boot/GHC/Serialized.hs b/libraries/ghc-boot/GHC/Serialized.hs
index 161bbb31f74d..ea5dba7624a0 100644
--- a/libraries/ghc-boot/GHC/Serialized.hs
+++ b/libraries/ghc-boot/GHC/Serialized.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
@@ -34,16 +33,10 @@ toSerialized serialize what = Serialized (typeOf what) (serialize what)
 -- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that.
 -- Otherwise return @Nothing@.
 fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a
-#if MIN_VERSION_base(4,10,0)
 fromSerialized deserialize (Serialized the_type bytes)
   | the_type == rep = Just (deserialize bytes)
   | otherwise       = Nothing
   where rep = typeRep (Proxy :: Proxy a)
-#else
-fromSerialized deserialize (Serialized the_type bytes)
-  | the_type == typeOf (undefined :: a) = Just (deserialize bytes)
-  | otherwise                           = Nothing
-#endif
 
 -- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData'
 serializeWithData :: Data a => a -> [Word8]
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index de91c5bd401b..380edf6057af 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables,
-    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards,
-    CPP #-}
+    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}
 
 -- |
@@ -41,10 +40,7 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
 import Data.Dynamic
-#if MIN_VERSION_base(4,10,0)
--- Previously this was re-exported by Data.Dynamic
 import Data.Typeable (TypeRep)
-#endif
 import Data.IORef
 import Data.Map (Map)
 import GHC.Generics
diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs
index 58e626cbc5b7..4cda7f2d21e7 100644
--- a/libraries/ghci/GHCi/TH/Binary.hs
+++ b/libraries/ghci/GHCi/TH/Binary.hs
@@ -1,5 +1,4 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -13,9 +12,6 @@ import qualified Data.ByteString as B
 import GHC.Serialized
 import qualified Language.Haskell.TH        as TH
 import qualified Language.Haskell.TH.Syntax as TH
-#if !MIN_VERSION_base(4,10,0)
-import Data.Typeable
-#endif
 -- Put these in a separate module because they take ages to compile
 
 instance Binary TH.Loc
@@ -75,16 +71,3 @@ instance Binary TH.PatSynArgs
 instance Binary Serialized where
     put (Serialized tyrep wds) = put tyrep >> put (B.pack wds)
     get = Serialized <$> get <*> (B.unpack <$> get)
-
--- Typeable and related instances live in binary since GHC 8.2
-#if !MIN_VERSION_base(4,10,0)
-instance Binary TyCon where
-    put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc)
-    get = mkTyCon3 <$> get <*> get <*> get
-
-instance Binary TypeRep where
-    put type_rep = put (splitTyConApp type_rep)
-    get = do
-        (ty_con, child_type_reps) <- get
-        return (mkTyConApp ty_con child_type_reps)
-#endif
diff --git a/testsuite/timeout/WinCBindings.hsc b/testsuite/timeout/WinCBindings.hsc
index a72cdcfafb63..36379301a417 100644
--- a/testsuite/timeout/WinCBindings.hsc
+++ b/testsuite/timeout/WinCBindings.hsc
@@ -260,9 +260,6 @@ type JOBOBJECTINFOCLASS = CInt
 
 type PVOID = Ptr ()
 type PULONG_PTR = Ptr ULONG_PTR
-#if !MIN_VERSION_Win32(2,5,0)
-type ULONG_PTR  = CUIntPtr
-#endif
 
 jobObjectExtendedLimitInformation :: JOBOBJECTINFOCLASS
 jobObjectExtendedLimitInformation = #const JobObjectExtendedLimitInformation
-- 
GitLab