Use DeriveFunctor throughout the codebase (#15654)wip/derive-functor

46 files changed, 114 insertions, 201 deletions

diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index 8780a52208..9697566efc 100644
--- a/compiler/basicTypes/UniqSupply.hs
+++ b/compiler/basicTypes/UniqSupply.hs
@@ -4,6 +4,7 @@
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE PatternSynonyms #-}
 
 #if !defined(GHC_LOADED_INTO_GHCI)
@@ -148,20 +149,18 @@ pattern UniqResult x y = (# x, y #)
 #else
 
 data UniqResult result = UniqResult !result {-# UNPACK #-} !UniqSupply
+  deriving (Functor)
 
 #endif
 
 -- | A monad which just gives the ability to obtain 'Unique's
 newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result }
+    deriving (Functor)
 
 instance Monad UniqSM where
   (>>=) = thenUs
   (>>)  = (*>)
 
-instance Functor UniqSM where
-    fmap f (USM x) = USM (\us0 -> case x us0 of
-                                 UniqResult r us1 -> UniqResult (f r) us1)
-
 instance Applicative UniqSM where
     pure = returnUs
     (USM f) <*> (USM x) = USM $ \us0 -> case f us0 of
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index 3224bb8cab..d5c3f84443 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -5,6 +5,7 @@
 -- CmmLint: checking the correctness of Cmm statements and expressions
 --
 -----------------------------------------------------------------------------
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GADTs #-}
 module CmmLint (
     cmmLint, cmmLintGraph
@@ -24,7 +25,7 @@ import PprCmm ()
 import Outputable
 import DynFlags
 
-import Control.Monad (liftM, ap)
+import Control.Monad (ap)
 
 -- Things to check:
 --     - invariant on CmmBlock in CmmExpr (see comment there)
@@ -212,9 +213,7 @@ checkCond _ expr
 -- just a basic error monad:
 
 newtype CmmLint a = CmmLint { unCL :: DynFlags -> Either SDoc a }
-
-instance Functor CmmLint where
-      fmap = liftM
+    deriving (Functor)
 
 instance Applicative CmmLint where
       pure a = CmmLint (\_ -> Right a)
diff --git a/compiler/cmm/Hoopl/Block.hs b/compiler/cmm/Hoopl/Block.hs
index c4ff1794e8..5c31932934 100644
--- a/compiler/cmm/Hoopl/Block.hs
+++ b/compiler/cmm/Hoopl/Block.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE StandaloneDeriving #-}
 module Hoopl.Block
     ( C
     , O
@@ -64,14 +66,8 @@ data MaybeC ex t where
   JustC    :: t -> MaybeC C t
   NothingC ::      MaybeC O t
 
-
-instance Functor (MaybeO ex) where
-  fmap _ NothingO = NothingO
-  fmap f (JustO a) = JustO (f a)
-
-instance Functor (MaybeC ex) where
-  fmap _ NothingC = NothingC
-  fmap f (JustC a) = JustC (f a)
+deriving instance Functor (MaybeO ex)
+deriving instance Functor (MaybeC ex)
 
 -- -----------------------------------------------------------------------------
 -- The Block type
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 822de431a4..2038801de3 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, GADTs #-}
+{-# LANGUAGE CPP, DeriveFunctor, GADTs, PatternSynonyms #-}
 
 -----------------------------------------------------------------------------
 --
@@ -61,7 +61,7 @@ import Data.Map (Map)
 import Data.Word
 import System.IO
 import qualified Data.Map as Map
-import Control.Monad (liftM, ap)
+import Control.Monad (ap)
 import qualified Data.Array.Unsafe as U ( castSTUArray )
 import Data.Array.ST
 
@@ -1078,10 +1078,7 @@ pprExternDecl lbl
         <> semi
 
 type TEState = (UniqSet LocalReg, Map CLabel ())
-newtype TE a = TE { unTE :: TEState -> (a, TEState) }
-
-instance Functor TE where
-      fmap = liftM
+newtype TE a = TE { unTE :: TEState -> (a, TEState) } deriving (Functor)
 
 instance Applicative TE where
       pure a = TE $ \s -> (a, s)
diff --git a/compiler/codeGen/StgCmmExtCode.hs b/compiler/codeGen/StgCmmExtCode.hs
index 551535d758..1d35c3454e 100644
--- a/compiler/codeGen/StgCmmExtCode.hs
+++ b/compiler/codeGen/StgCmmExtCode.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor #-}
 -- | Our extended FCode monad.
 
 -- We add a mapping from names to CmmExpr, to support local variable names in
@@ -53,7 +54,7 @@ import UniqFM
 import Unique
 import UniqSupply
 
-import Control.Monad (liftM, ap)
+import Control.Monad (ap)
 
 -- | The environment contains variable definitions or blockids.
 data Named
@@ -73,6 +74,7 @@ type Decls      = [(FastString,Named)]
 --      and a list of local declarations. Returns the resulting list of declarations.
 newtype CmmParse a
         = EC { unEC :: String -> Env -> Decls -> FCode (Decls, a) }
+    deriving (Functor)
 
 type ExtCode = CmmParse ()
 
@@ -82,9 +84,6 @@ returnExtFC a   = EC $ \_ _ s -> return (s, a)
 thenExtFC :: CmmParse a -> (a -> CmmParse b) -> CmmParse b
 thenExtFC (EC m) k = EC $ \c e s -> do (s',r) <- m c e s; unEC (k r) c e s'
 
-instance Functor CmmParse where
-      fmap = liftM
-
 instance Applicative CmmParse where
       pure = returnExtFC
       (<*>) = ap
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index 8be5c4551f..d6f84c6a0a 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GADTs #-}
 
 -----------------------------------------------------------------------------
@@ -111,9 +112,7 @@ import Data.List
 --------------------------------------------------------
 
 newtype FCode a = FCode { doFCode :: CgInfoDownwards -> CgState -> (a, CgState) }
-
-instance Functor FCode where
-    fmap f (FCode g) = FCode $ \i s -> case g i s of (a, s') -> (f a, s')
+    deriving (Functor)
 
 instance Applicative FCode where
     pure val = FCode (\_info_down state -> (val, state))
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index ef4e858568..91760c282b 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -7,6 +7,7 @@ A ``lint'' pass to check for Core correctness
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module CoreLint (
     lintCoreBindings, lintUnfolding,
@@ -2076,6 +2077,7 @@ newtype LintM a =
             LintEnv ->
             WarnsAndErrs ->           -- Warning and error messages so far
             (Maybe a, WarnsAndErrs) } -- Result and messages (if any)
+   deriving (Functor)
 
 type WarnsAndErrs = (Bag MsgDoc, Bag MsgDoc)
 
@@ -2146,9 +2148,6 @@ we behave as follows (#15057, #T15664):
   when the type is expanded.
 -}
 
-instance Functor LintM where
-      fmap = liftM
-
 instance Applicative LintM where
       pure x = LintM $ \ _ errs -> (Just x, errs)
       (<*>) = ap
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index d140829544..59b8bcfc78 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE NondecreasingIndentation, RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module Coverage (addTicksToBinds, hpcInitCode) where
 
@@ -1071,12 +1072,10 @@ noFVs = emptyOccEnv
 --   over what free variables we track.
 
 data TM a = TM { unTM :: TickTransEnv -> TickTransState -> (a,FreeVars,TickTransState) }
+    deriving (Functor)
         -- a combination of a state monad (TickTransState) and a writer
         -- monad (FreeVars).
 
-instance Functor TM where
-    fmap = liftM
-
 instance Applicative TM where
     pure a = TM $ \ _env st -> (a,noFVs,st)
     (<*>) = ap
diff --git a/compiler/ghci/ByteCodeAsm.hs b/compiler/ghci/ByteCodeAsm.hs
index 0776e406d6..fb38ca1c02 100644
--- a/compiler/ghci/ByteCodeAsm.hs
+++ b/compiler/ghci/ByteCodeAsm.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP, MagicHash, RecordWildCards #-}
+{-# LANGUAGE BangPatterns, CPP, DeriveFunctor, MagicHash, RecordWildCards #-}
 {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
 --
 --  (c) The University of Glasgow 2002-2006
@@ -224,9 +224,7 @@ data Assembler a
   | AllocLabel Word16 (Assembler a)
   | Emit Word16 [Operand] (Assembler a)
   | NullAsm a
-
-instance Functor Assembler where
-    fmap = liftM
+  deriving (Functor)
 
 instance Applicative Assembler where
     pure = NullAsm
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index c4a08c4e40..33ae172d71 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP, MagicHash, RecordWildCards, BangPatterns #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fprof-auto-top #-}
 --
@@ -1861,7 +1862,7 @@ data BcM_State
           -- See Note [generating code for top-level string literal bindings].
         }
 
-newtype BcM r = BcM (BcM_State -> IO (BcM_State, r))
+newtype BcM r = BcM (BcM_State -> IO (BcM_State, r)) deriving (Functor)
 
 ioToBc :: IO a -> BcM a
 ioToBc io = BcM $ \st -> do
@@ -1891,9 +1892,6 @@ thenBc_ (BcM expr) (BcM cont) = BcM $ \st0 -> do
 returnBc :: a -> BcM a
 returnBc result = BcM $ \st -> (return (st, result))
 
-instance Functor BcM where
-    fmap = liftM
-
 instance Applicative BcM where
     pure = returnBc
     (<*>) = ap
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 2292a9fea4..b4be2f0000 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -6,6 +6,7 @@
 This module converts Template Haskell syntax into HsSyn
 -}
 
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -40,7 +41,7 @@ import Outputable
 import MonadUtils ( foldrM )
 
 import qualified Data.ByteString as BS
-import Control.Monad( unless, liftM, ap )
+import Control.Monad( unless, ap )
 
 import Data.Maybe( catMaybes, isNothing )
 import Language.Haskell.TH as TH hiding (sigP)
@@ -71,6 +72,7 @@ convertToHsType loc t
 
 -------------------------------------------------------------------
 newtype CvtM a = CvtM { unCvtM :: SrcSpan -> Either MsgDoc (SrcSpan, a) }
+    deriving (Functor)
         -- Push down the source location;
         -- Can fail, with a single error message
 
@@ -83,9 +85,6 @@ newtype CvtM a = CvtM { unCvtM :: SrcSpan -> Either MsgDoc (SrcSpan, a) }
 -- In particular, we want it on binding locations, so that variables bound in
 -- the spliced-in declarations get a location that at least relates to the splice point
 
-instance Functor CvtM where
-    fmap = liftM
-
 instance Applicative CvtM where
     pure x = CvtM $ \loc -> Right (loc,x)
     (<*>) = ap
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index 8e3448d0f0..1763c3f2de 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -8,6 +8,7 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
 -}
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
@@ -1262,7 +1263,7 @@ data RecordPatSynField a
       , recordPatSynPatVar :: a
       -- Filled in by renamer, the name used internally
       -- by the pattern
-      } deriving Data
+      } deriving (Data, Functor)
 
 
 
@@ -1287,12 +1288,6 @@ when we have a different name for the local and top-level binder
 the distinction between the two names clear
 
 -}
-instance Functor RecordPatSynField where
-    fmap f (RecordPatSynField { recordPatSynSelectorId = visible
-                              , recordPatSynPatVar = hidden })
-      = RecordPatSynField { recordPatSynSelectorId = f visible
-                          , recordPatSynPatVar = f hidden }
-
 instance Outputable a => Outputable (RecordPatSynField a) where
     ppr (RecordPatSynField { recordPatSynSelectorId = v }) = ppr v
 
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index d55c339888..ab9695778c 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 -- ----------------------------------------------------------------------------
 -- | Base LLVM Code Generation module
@@ -209,10 +210,7 @@ type LlvmEnvMap = UniqFM LlvmType
 
 -- | The Llvm monad. Wraps @LlvmEnv@ state as well as the @IO@ monad
 newtype LlvmM a = LlvmM { runLlvmM :: LlvmEnv -> IO (a, LlvmEnv) }
-
-instance Functor LlvmM where
-    fmap f m = LlvmM $ \env -> do (x, env') <- runLlvmM m env
-                                  return (f x, env')
+    deriving (Functor)
 
 instance Applicative LlvmM where
     pure x = LlvmM $ \env -> return (x, env)
diff --git a/compiler/main/Annotations.hs b/compiler/main/Annotations.hs
index f6d5a1cb12..82d80aae43 100644
--- a/compiler/main/Annotations.hs
+++ b/compiler/main/Annotations.hs
@@ -4,6 +4,7 @@
 -- (c) The University of Glasgow 2006
 -- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 --
+{-# LANGUAGE DeriveFunctor #-}
 module Annotations (
         -- * Main Annotation data types
         Annotation(..), AnnPayload,
@@ -49,14 +50,11 @@ data AnnTarget name
   = NamedTarget name          -- ^ We are annotating something with a name:
                               --      a type or identifier
   | ModuleTarget Module       -- ^ We are annotating a particular module
+  deriving (Functor)
 
 -- | The kind of annotation target found in the middle end of the compiler
 type CoreAnnTarget = AnnTarget Name
 
-instance Functor AnnTarget where
-    fmap f (NamedTarget nm) = NamedTarget (f nm)
-    fmap _ (ModuleTarget mod) = ModuleTarget mod
-
 -- | Get the 'name' of an annotation target if it exists.
 getAnnTargetName_maybe :: AnnTarget name -> Maybe name
 getAnnTargetName_maybe (NamedTarget nm) = Just nm
diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index 6763aed128..d2cc56f033 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 -------------------------------------------------------------------------------
 --
@@ -166,9 +167,7 @@ liftEwM action = EwM (\_ es ws -> do { r <- action; return (es, ws, r) })
 
 -- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)
 newtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }
-
-instance Functor (CmdLineP s) where
-    fmap = liftM
+    deriving (Functor)
 
 instance Applicative (CmdLineP s) where
     pure a = CmdLineP $ \s -> (a, s)
diff --git a/compiler/main/GhcMonad.hs b/compiler/main/GhcMonad.hs
index f72cacc7ef..846744c439 100644
--- a/compiler/main/GhcMonad.hs
+++ b/compiler/main/GhcMonad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, RankNTypes #-}
+{-# LANGUAGE CPP, DeriveFunctor, RankNTypes #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 -- -----------------------------------------------------------------------------
 --
@@ -90,7 +90,7 @@ logWarnings warns = do
 -- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,
 -- e.g., to maintain additional state consider wrapping this monad or using
 -- 'GhcT'.
-newtype Ghc a = Ghc { unGhc :: Session -> IO a }
+newtype Ghc a = Ghc { unGhc :: Session -> IO a } deriving (Functor)
 
 -- | The Session is a handle to the complete state of a compilation
 -- session.  A compilation session consists of a set of modules
@@ -98,9 +98,6 @@ newtype Ghc a = Ghc { unGhc :: Session -> IO a }
 -- interactive evaluation, and various caches.
 data Session = Session !(IORef HscEnv)
 
-instance Functor Ghc where
-  fmap f m = Ghc $ \s -> f `fmap` unGhc m s
-
 instance Applicative Ghc where
   pure a = Ghc $ \_ -> return a
   g <*> m = do f <- g; a <- m; return (f a)
@@ -158,13 +155,11 @@ reifyGhc act = Ghc $ act
 --
 -- Note that the wrapped monad must support IO and handling of exceptions.
 newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
+    deriving (Functor)
 
 liftGhcT :: m a -> GhcT m a
 liftGhcT m = GhcT $ \_ -> m
 
-instance Functor m => Functor (GhcT m) where
-  fmap f m = GhcT $ \s -> f `fmap` unGhcT m s
-
 instance Applicative m => Applicative (GhcT m) where
   pure x  = GhcT $ \_ -> pure x
   g <*> m = GhcT $ \s -> unGhcT g s <*> unGhcT m s
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index eb9877b096..2749073ff1 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -5,6 +5,7 @@
 -}
 
 {-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -231,9 +232,7 @@ data HscStatus
 -- The Hsc monad: Passing an environment and warning state
 
 newtype Hsc a = Hsc (HscEnv -> WarningMessages -> IO (a, WarningMessages))
-
-instance Functor Hsc where
-    fmap = liftM
+    deriving (Functor)
 
 instance Applicative Hsc where
     pure a = Hsc $ \_ w -> return (a, w)
diff --git a/compiler/main/PipelineMonad.hs b/compiler/main/PipelineMonad.hs
index bbb1a17b65..d152d04530 100644
--- a/compiler/main/PipelineMonad.hs
+++ b/compiler/main/PipelineMonad.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE NamedFieldPuns #-}
 -- | The CompPipeline monad and associated ops
 --
@@ -22,13 +23,11 @@ import FileCleanup (TempFileLifetime)
 import Control.Monad
 
 newtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) }
+    deriving (Functor)
 
 evalP :: CompPipeline a -> PipeEnv -> PipeState -> IO a
 evalP f env st = liftM snd $ unP f env st
 
-instance Functor CompPipeline where
-    fmap = liftM
-
 instance Applicative CompPipeline where
     pure a = P $ \_env state -> return (state, a)
     (<*>) = ap
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs
index d0e813a403..4f9c8c856f 100644
--- a/compiler/main/TidyPgm.hs
+++ b/compiler/main/TidyPgm.hs
@@ -4,7 +4,7 @@
 \section{Tidying up Core}
 -}
 
-{-# LANGUAGE CPP, ViewPatterns #-}
+{-# LANGUAGE CPP, DeriveFunctor, ViewPatterns #-}
 
 module TidyPgm (
        mkBootModDetailsTc, tidyProgram, globaliseAndTidyId
@@ -751,9 +751,7 @@ newtype DFFV a
                               -- we don't want to record these as free vars
       -> (VarSet, [Var])      -- Input State: (set, list) of free vars so far
       -> ((VarSet,[Var]),a))  -- Output state
-
-instance Functor DFFV where
-    fmap = liftM
+    deriving (Functor)
 
 instance Applicative DFFV where
     pure a = DFFV $ \_ st -> (st, a)
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index cc608b1ec6..ed0c57e1e2 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -6,7 +6,8 @@
 --
 -- -----------------------------------------------------------------------------
 
-{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, PatternSynonyms #-}
+{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, PatternSynonyms,
+    DeriveFunctor #-}
 
 #if !defined(GHC_LOADED_INTO_GHCI)
 {-# LANGUAGE UnboxedTuples #-}
@@ -1038,13 +1039,11 @@ pattern OptMResult x y = (# x, y #)
 {-# COMPLETE OptMResult #-}
 #else
 
-data OptMResult a = OptMResult !a ![CLabel]
+data OptMResult a = OptMResult !a ![CLabel] deriving (Functor)
 #endif
 
 newtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> OptMResult a)
-
-instance Functor CmmOptM where
-    fmap = liftM
+    deriving (Functor)
 
 instance Applicative CmmOptM where
     pure x = CmmOptM $ \_ _ imports -> OptMResult x imports
diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index 0f53ef6690..3680c1c7b0 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 -- -----------------------------------------------------------------------------
 --
@@ -59,7 +60,7 @@ import Unique           ( Unique )
 import DynFlags
 import Module
 
-import Control.Monad    ( liftM, ap )
+import Control.Monad    ( ap )
 
 import Instruction
 import Outputable (SDoc, pprPanic, ppr)
@@ -113,6 +114,7 @@ data NatM_State
 type DwarfFiles = UniqFM (FastString, Int)
 
 newtype NatM result = NatM (NatM_State -> (result, NatM_State))
+    deriving (Functor)
 
 unNat :: NatM a -> NatM_State -> (a, NatM_State)
 unNat (NatM a) = a
@@ -138,9 +140,6 @@ initNat :: NatM_State -> NatM a -> (a, NatM_State)
 initNat init_st m
         = case unNat m init_st of { (r,st) -> (r,st) }
 
-instance Functor NatM where
-      fmap = liftM
-
 instance Applicative NatM where
       pure = returnNat
       (<*>) = ap
diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs
index 8df4dd04f0..43b8f6c129 100644
--- a/compiler/nativeGen/RegAlloc/Linear/State.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/State.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, PatternSynonyms #-}
+{-# LANGUAGE CPP, PatternSynonyms, DeriveFunctor #-}
 
 #if !defined(GHC_LOADED_INTO_GHCI)
 {-# LANGUAGE UnboxedTuples #-}
@@ -50,7 +50,7 @@ import DynFlags
 import Unique
 import UniqSupply
 
-import Control.Monad (liftM, ap)
+import Control.Monad (ap)
 
 -- Avoids using unboxed tuples when loading into GHCi
 #if !defined(GHC_LOADED_INTO_GHCI)
@@ -63,15 +63,14 @@ pattern RA_Result a b = (# a, b #)
 #else
 
 data RA_Result freeRegs a = RA_Result {-# UNPACK #-} !(RA_State freeRegs) !a
+  deriving (Functor)
 
 #endif
 
 -- | The register allocator monad type.
 newtype RegM freeRegs a
         = RegM { unReg :: RA_State freeRegs -> RA_Result freeRegs a }
-
-instance Functor (RegM freeRegs) where
-      fmap = liftM
+        deriving (Functor)
 
 instance Applicative (RegM freeRegs) where
       pure a  =  RegM $ \s -> RA_Result s a
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index bd18bfec63..63a8c9d48a 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -12,7 +12,8 @@ ToDo:
    (i1 + i2) only if it results in a valid Float.
 -}
 
-{-# LANGUAGE CPP, RankNTypes, PatternSynonyms, ViewPatterns, RecordWildCards #-}
+{-# LANGUAGE CPP, RankNTypes, PatternSynonyms, ViewPatterns, RecordWildCards,
+    DeriveFunctor #-}
 {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
 
 module PrelRules
@@ -739,9 +740,7 @@ mkBasicRule op_name n_args rm
 
 newtype RuleM r = RuleM
   { runRuleM :: DynFlags -> InScopeEnv -> [CoreExpr] -> Maybe r }
-
-instance Functor RuleM where
-    fmap = liftM
+  deriving (Functor)
 
 instance Applicative RuleM where
     pure x = RuleM $ \_ _ _ -> Just x
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index ca8c665e28..4a08ab4761 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -16,6 +16,7 @@ free variables.
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module RnPat (-- main entry points
               rnPat, rnPats, rnBindPat, rnPatAndThen,
@@ -72,7 +73,7 @@ import TysWiredIn          ( nilDataCon )
 import DataCon
 import qualified GHC.LanguageExtensions as LangExt
 
-import Control.Monad       ( when, liftM, ap, guard )
+import Control.Monad       ( when, ap, guard )
 import qualified Data.List.NonEmpty as NE
 import Data.Ratio
 
@@ -107,11 +108,9 @@ p1 scope over p2,p3.
 
 newtype CpsRn b = CpsRn { unCpsRn :: forall r. (b -> RnM (r, FreeVars))
                                             -> RnM (r, FreeVars) }
+        deriving (Functor)
         -- See Note [CpsRn monad]
 
-instance Functor CpsRn where
-    fmap = liftM
-
 instance Applicative CpsRn where
     pure x = CpsRn (\k -> k x)
     (<*>) = ap
diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs
index 3a2277a7a7..29e4b00c4d 100644
--- a/compiler/simplCore/CoreMonad.hs
+++ b/compiler/simplCore/CoreMonad.hs
@@ -5,6 +5,7 @@
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module CoreMonad (
     -- * Configuration of the core-to-core passes
@@ -582,9 +583,7 @@ type CoreIOEnv = IOEnv CoreReader
 -- | The monad used by Core-to-Core passes to access common state, register simplification
 -- statistics and so on
 newtype CoreM a = CoreM { unCoreM :: CoreState -> CoreIOEnv (a, CoreState, CoreWriter) }
-
-instance Functor CoreM where
-    fmap = liftM
+    deriving (Functor)
 
 instance Monad CoreM where
     mx >>= f = CoreM $ \s -> do
diff --git a/compiler/simplCore/SimplMonad.hs b/compiler/simplCore/SimplMonad.hs
index c28f99f9dd..732805e9ee 100644
--- a/compiler/simplCore/SimplMonad.hs
+++ b/compiler/simplCore/SimplMonad.hs
@@ -4,6 +4,7 @@
 \section[SimplMonad]{The simplifier Monad}
 -}
 
+{-# LANGUAGE DeriveFunctor #-}
 module SimplMonad (
         -- The monad
         SimplM,
@@ -37,7 +38,7 @@ import MonadUtils
 import ErrUtils as Err
 import Panic (throwGhcExceptionIO, GhcException (..))
 import BasicTypes          ( IntWithInf, treatZeroAsInf, mkIntWithInf )
-import Control.Monad       ( liftM, ap )
+import Control.Monad       ( ap )
 
 {-
 ************************************************************************
@@ -57,6 +58,7 @@ newtype SimplM result
                 -> SimplCount
                 -> IO (result, UniqSupply, SimplCount)}
   -- we only need IO here for dump output
+    deriving (Functor)
 
 data SimplTopEnv
   = STE { st_flags     :: DynFlags
@@ -104,9 +106,6 @@ computeMaxTicks dflags size
 {-# INLINE returnSmpl #-}
 
 
-instance Functor SimplM where
-    fmap = liftM
-
 instance Applicative SimplM where
     pure  = returnSmpl
     (<*>) = ap
diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs
index ed2ae073e9..3434172de2 100644
--- a/compiler/specialise/Specialise.hs
+++ b/compiler/specialise/Specialise.hs
@@ -5,6 +5,7 @@
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE ViewPatterns #-}
 module Specialise ( specProgram, specUnfolding ) where
 
@@ -2530,7 +2531,7 @@ deleteCallsFor bs calls = delDVarEnvList calls bs
 ************************************************************************
 -}
 
-newtype SpecM a = SpecM (State SpecState a)
+newtype SpecM a = SpecM (State SpecState a) deriving (Functor)
 
 data SpecState = SpecState {
                      spec_uniq_supply :: UniqSupply,
@@ -2538,9 +2539,6 @@ data SpecState = SpecState {
                      spec_dflags :: DynFlags
                  }
 
-instance Functor SpecM where
-    fmap = liftM
-
 instance Applicative SpecM where
     pure x = SpecM $ return x
     (<*>) = ap
diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs
index 12766e90d4..3187298425 100644
--- a/compiler/stgSyn/CoreToStg.hs
+++ b/compiler/stgSyn/CoreToStg.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, DeriveFunctor #-}
 
 --
 -- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
@@ -50,7 +50,7 @@ import SrcLoc           ( mkGeneralSrcSpan )
 
 import Data.List.NonEmpty (nonEmpty, toList)
 import Data.Maybe    (fromMaybe)
-import Control.Monad (liftM, ap)
+import Control.Monad (ap)
 
 -- Note [Live vs free]
 -- ~~~~~~~~~~~~~~~~~~~
@@ -813,6 +813,7 @@ newtype CtsM a = CtsM
     { unCtsM :: IdEnv HowBound
              -> a
     }
+    deriving (Functor)
 
 data HowBound
   = ImportBound         -- Used only as a response to lookupBinding; never
@@ -861,9 +862,6 @@ thenCts :: CtsM a -> (a -> CtsM b) -> CtsM b
 thenCts m k = CtsM $ \env
   -> unCtsM (k (unCtsM m env)) env
 
-instance Functor CtsM where
-    fmap = liftM
-
 instance Applicative CtsM where
     pure = returnCts
     (<*>) = ap
diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs
index c949f348f1..f83b44859c 100644
--- a/compiler/stgSyn/StgLint.hs
+++ b/compiler/stgSyn/StgLint.hs
@@ -32,7 +32,8 @@ Since then there were some attempts at enabling it again, as summarised in
 basic properties listed above.
 -}
 
-{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, TypeFamilies,
+  DeriveFunctor #-}
 
 module StgLint ( lintStgTopBindings ) where
 
@@ -258,6 +259,7 @@ newtype LintM a = LintM
               -> Bag MsgDoc        -- Error messages so far
               -> (a, Bag MsgDoc)   -- Result and error messages (if any)
     }
+    deriving (Functor)
 
 data LintFlags = LintFlags { lf_unarised :: !Bool
                              -- ^ have we run the unariser yet?
@@ -293,9 +295,6 @@ initL this_mod unarised locals (LintM m) = do
   else
       Just (vcat (punctuate blankLine (bagToList errs)))
 
-instance Functor LintM where
-      fmap = liftM
-
 instance Applicative LintM where
       pure a = LintM $ \_mod _lf _loc _scope errs -> (a, errs)
       (<*>) = ap
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index bbb29f5e38..941a6eab29 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module TcCanonical(
      canonicalize,
@@ -2198,10 +2199,7 @@ data StopOrContinue a
   | Stop CtEvidence   -- The (rewritten) constraint was solved
          SDoc         -- Tells how it was solved
                       -- Any new sub-goals have been put on the work list
-
-instance Functor StopOrContinue where
-  fmap f (ContinueWith x) = ContinueWith (f x)
-  fmap _ (Stop ev s)      = Stop ev s
+  deriving (Functor)
 
 instance Outputable a => Outputable (StopOrContinue a) where
   ppr (Stop ev s)      = text "Stop" <> parens s <+> ppr ev
diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs
index 39a33f3fd7..2bb3d1c0e8 100644
--- a/compiler/typecheck/TcFlatten.hs
+++ b/compiler/typecheck/TcFlatten.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, ViewPatterns, BangPatterns #-}
+{-# LANGUAGE CPP, DeriveFunctor, ViewPatterns, BangPatterns #-}
 
 module TcFlatten(
    FlattenMode(..),
@@ -485,15 +485,13 @@ eqFlattenMode _  _ = False
 -- See Note [The flattening work list].
 newtype FlatM a
   = FlatM { runFlatM :: FlattenEnv -> TcS a }
+  deriving (Functor)
 
 instance Monad FlatM where
   m >>= k  = FlatM $ \env ->
              do { a  <- runFlatM m env
                 ; runFlatM (k a) env }
 
-instance Functor FlatM where
-  fmap = liftM
-
 instance Applicative FlatM where
   pure x = FlatM $ const (pure x)
   (<*>) = ap
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 8957014036..573051d657 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -16,7 +16,7 @@ For state that is global and should be returned at the end (e.g not part
 of the stack mechanism), you should use a TcRef (= IORef) to store them.
 -}
 
-{-# LANGUAGE CPP, ExistentialQuantification, GeneralizedNewtypeDeriving,
+{-# LANGUAGE CPP, DeriveFunctor, ExistentialQuantification, GeneralizedNewtypeDeriving,
              ViewPatterns #-}
 
 module TcRnTypes(
@@ -195,7 +195,7 @@ import Util
 import PrelNames ( isUnboundName )
 import CostCentreState
 
-import Control.Monad (ap, liftM, msum)
+import Control.Monad (ap, msum)
 import qualified Control.Monad.Fail as MonadFail
 import Data.Set      ( Set )
 import qualified Data.Set as S
@@ -3823,10 +3823,7 @@ type TcPluginSolver = [Ct]    -- given
                    -> [Ct]    -- wanted
                    -> TcPluginM TcPluginResult
 
-newtype TcPluginM a = TcPluginM (EvBindsVar -> TcM a)
-
-instance Functor TcPluginM where
-  fmap = liftM
+newtype TcPluginM a = TcPluginM (EvBindsVar -> TcM a) deriving (Functor)
 
 instance Applicative TcPluginM where
   pure x = TcPluginM (const $ pure x)
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index 8d98a17149..68496dfca6 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, TypeFamilies #-}
+{-# LANGUAGE CPP, DeriveFunctor, TypeFamilies #-}
 
 -- Type definitions for the constraint solver
 module TcSMonad (
@@ -2601,10 +2601,7 @@ data TcSEnv
     }
 
 ---------------
-newtype TcS a = TcS { unTcS :: TcSEnv -> TcM a }
-
-instance Functor TcS where
-  fmap f m = TcS $ fmap f . unTcS m
+newtype TcS a = TcS { unTcS :: TcSEnv -> TcM a } deriving (Functor)
 
 instance Applicative TcS where
   pure x = TcS (\_ -> return x)
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index 205771b2db..7a68fe1144 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -10,6 +10,7 @@ files for imported data types.
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -149,12 +150,10 @@ synonymTyConsOfType ty
 -- a failure message reporting that a cycle was found.
 newtype SynCycleM a = SynCycleM {
     runSynCycleM :: SynCycleState -> Either (SrcSpan, SDoc) (a, SynCycleState) }
+    deriving (Functor)
 
 type SynCycleState = NameSet
 
-instance Functor SynCycleM where
-    fmap = liftM
-
 instance Applicative SynCycleM where
     pure x = SynCycleM $ \state -> Right (x, state)
     (<*>) = ap
@@ -677,9 +676,7 @@ newtype RoleM a = RM { unRM :: Maybe Name -- of the tycon
                             -> Int          -- size of VarPositions
                             -> RoleInferenceState
                             -> (a, RoleInferenceState) }
-
-instance Functor RoleM where
-    fmap = liftM
+    deriving (Functor)
 
 instance Applicative RoleM where
     pure x = RM $ \_ _ _ state -> (x, state)
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index cbf98d888c..078ebecd54 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -6,7 +6,8 @@
 Type subsumption and unification
 -}
 
-{-# LANGUAGE CPP, MultiWayIf, TupleSections, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, DeriveFunctor, MultiWayIf, TupleSections,
+    ScopedTypeVariables #-}
 
 module TcUnify (
   -- Full-blown subsumption
@@ -2119,9 +2120,7 @@ data MetaTyVarUpdateResult a
   = MTVU_OK a
   | MTVU_Bad     -- Forall, predicate, or type family
   | MTVU_Occurs
-
-instance Functor MetaTyVarUpdateResult where
-      fmap = liftM
+    deriving (Functor)
 
 instance Applicative MetaTyVarUpdateResult where
       pure = MTVU_OK
diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs
index 50d5bf41cc..cfe166c0b7 100644
--- a/compiler/types/FamInstEnv.hs
+++ b/compiler/types/FamInstEnv.hs
@@ -2,7 +2,8 @@
 --
 -- FamInstEnv: Type checked family instance declarations
 
-{-# LANGUAGE CPP, GADTs, ScopedTypeVariables, BangPatterns, TupleSections #-}
+{-# LANGUAGE CPP, GADTs, ScopedTypeVariables, BangPatterns, TupleSections,
+    DeriveFunctor #-}
 
 module FamInstEnv (
         FamInst(..), FamFlavor(..), famInstAxiom, famInstTyCon, famInstRHS,
@@ -1501,6 +1502,7 @@ normalise_var_bndr tcvar
 -- a 'LiftingContext', and a 'Role'.
 newtype NormM a = NormM { runNormM ::
                             FamInstEnvs -> LiftingContext -> Role -> a }
+    deriving (Functor)
 
 initNormM :: FamInstEnvs -> Role
           -> TyCoVarSet   -- the in-scope variables
@@ -1531,8 +1533,6 @@ instance Monad NormM where
                let a = runNormM ma env lc r in
                runNormM (fmb a) env lc r
 
-instance Functor NormM where
-  fmap = liftM
 instance Applicative NormM where
   pure x = NormM $ \ _ _ _ -> x
   (<*>)  = ap
diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs
index 3bcf521603..b7ce569490 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -1206,9 +1206,7 @@ data UMState = UMState
                    , um_cv_env   :: CvSubstEnv }
 
 newtype UM a = UM { unUM :: UMState -> UnifyResultM (UMState, a) }
-
-instance Functor UM where
-      fmap = liftM
+    deriving (Functor)
 
 instance Applicative UM where
       pure a = UM (\s -> pure (s, a))
diff --git a/compiler/utils/Bag.hs b/compiler/utils/Bag.hs
index 41c80390cc..2105eefc71 100644
--- a/compiler/utils/Bag.hs
+++ b/compiler/utils/Bag.hs
@@ -6,7 +6,7 @@
 Bag: an unordered collection with duplicates
 -}
 
-{-# LANGUAGE ScopedTypeVariables, CPP #-}
+{-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor #-}
 
 module Bag (
         Bag, -- abstract type
@@ -45,6 +45,7 @@ data Bag a
   | UnitBag a
   | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty
   | ListBag [a]             -- INVARIANT: the list is non-empty
+  deriving (Functor)
 
 emptyBag :: Bag a
 emptyBag = EmptyBag
@@ -221,10 +222,7 @@ foldlBagM k z (TwoBags b1 b2) = do { z' <- foldlBagM k z b1; foldlBagM k z' b2 }
 foldlBagM k z (ListBag xs)    = foldlM k z xs
 
 mapBag :: (a -> b) -> Bag a -> Bag b
-mapBag _ EmptyBag        = EmptyBag
-mapBag f (UnitBag x)     = UnitBag (f x)
-mapBag f (TwoBags b1 b2) = TwoBags (mapBag f b1) (mapBag f b2)
-mapBag f (ListBag xs)    = ListBag (map f xs)
+mapBag = fmap
 
 concatMapBag :: (a -> Bag b) -> Bag a -> Bag b
 concatMapBag _ EmptyBag        = EmptyBag
@@ -344,8 +342,5 @@ instance Data a => Data (Bag a) where
   dataTypeOf _ = mkNoRepType "Bag"
   dataCast1 x  = gcast1 x
 
-instance Functor Bag where
-    fmap = mapBag
-
 instance Foldable.Foldable Bag where
     foldr = foldrBag
diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs
index d6807da71a..e62a2bcddf 100644
--- a/compiler/utils/IOEnv.hs
+++ b/compiler/utils/IOEnv.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 --
 -- (c) The University of Glasgow 2002-2006
 --
@@ -51,7 +52,7 @@ import Control.Applicative (Alternative(..))
 ----------------------------------------------------------------------
 
 
-newtype IOEnv env a = IOEnv (env -> IO a)
+newtype IOEnv env a = IOEnv (env -> IO a) deriving (Functor)
 
 unIOEnv :: IOEnv env a -> (env -> IO a)
 unIOEnv (IOEnv m) = m
@@ -71,9 +72,6 @@ instance Applicative (IOEnv m) where
     IOEnv f <*> IOEnv x = IOEnv (\ env -> f env <*> x env )
     (*>) = thenM_
 
-instance Functor (IOEnv m) where
-    fmap f (IOEnv m) = IOEnv (\ env -> fmap f (m env))
-
 returnM :: a -> IOEnv env a
 returnM a = IOEnv (\ _ -> return a)
 
diff --git a/compiler/utils/ListT.hs b/compiler/utils/ListT.hs
index 105e27b3d4..66e52ed9f4 100644
--- a/compiler/utils/ListT.hs
+++ b/compiler/utils/ListT.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -42,6 +43,7 @@ import Control.Monad.Fail as MonadFail
 -- layered over another monad 'm'
 newtype ListT m a =
     ListT { unListT :: forall r. (a -> m r -> m r) -> m r -> m r }
+    deriving (Functor)
 
 select :: Monad m => [a] -> ListT m a
 select xs = foldr (<|>) mzero (map pure xs)
@@ -55,9 +57,6 @@ fold = runListT
 runListT :: ListT m a -> (a -> m r -> m r) -> m r -> m r
 runListT = unListT
 
-instance Functor (ListT f) where
-    fmap f lt = ListT $ \sk fk -> unListT lt (sk . f) fk
-
 instance Applicative (ListT f) where
     pure a = ListT $ \sk fk -> sk a fk
     f <*> a = ListT $ \sk fk -> unListT f (\g fk' -> unListT a (sk . g) fk') fk
diff --git a/compiler/utils/Maybes.hs b/compiler/utils/Maybes.hs
index 14bc46b9b8..37acb25a1a 100644
--- a/compiler/utils/Maybes.hs
+++ b/compiler/utils/Maybes.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 
@@ -95,9 +96,7 @@ tryMaybeT action = MaybeT $ catch (Just `fmap` action) handler
 -}
 
 data MaybeErr err val = Succeeded val | Failed err
-
-instance Functor (MaybeErr err) where
-  fmap = liftM
+    deriving (Functor)
 
 instance Applicative (MaybeErr err) where
   pure  = Succeeded
diff --git a/compiler/utils/OrdList.hs b/compiler/utils/OrdList.hs
index 2d7a43f228..e8b50e5968 100644
--- a/compiler/utils/OrdList.hs
+++ b/compiler/utils/OrdList.hs
@@ -8,6 +8,7 @@ This is useful, general stuff for the Native Code Generator.
 Provide trees (of instructions), so that lists of instructions
 can be appended in linear time.
 -}
+{-# LANGUAGE DeriveFunctor #-}
 
 module OrdList (
         OrdList,
@@ -34,6 +35,7 @@ data OrdList a
   | Snoc (OrdList a) a
   | Two (OrdList a) -- Invariant: non-empty
         (OrdList a) -- Invariant: non-empty
+  deriving (Functor)
 
 instance Outputable a => Outputable (OrdList a) where
   ppr ol = ppr (fromOL ol)  -- Convert to list and print that
@@ -46,9 +48,6 @@ instance Monoid (OrdList a) where
   mappend = (Semigroup.<>)
   mconcat = concatOL
 
-instance Functor OrdList where
-  fmap = mapOL
-
 instance Foldable OrdList where
   foldr = foldrOL
 
@@ -117,12 +116,7 @@ fromOLReverse a = go a []
         go (Many xs)  acc = reverse xs ++ acc
 
 mapOL :: (a -> b) -> OrdList a -> OrdList b
-mapOL _ None = None
-mapOL f (One x) = One (f x)
-mapOL f (Cons x xs) = Cons (f x) (mapOL f xs)
-mapOL f (Snoc xs x) = Snoc (mapOL f xs) (f x)
-mapOL f (Two x y) = Two (mapOL f x) (mapOL f y)
-mapOL f (Many xs) = Many (map f xs)
+mapOL = fmap
 
 foldrOL :: (a->b->b) -> b -> OrdList a -> b
 foldrOL _ z None        = z
diff --git a/compiler/utils/Pair.hs b/compiler/utils/Pair.hs
index 036dab062d..e9313f89b2 100644
--- a/compiler/utils/Pair.hs
+++ b/compiler/utils/Pair.hs
@@ -4,6 +4,7 @@ Traversable instances.
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 module Pair ( Pair(..), unPair, toPair, swap, pLiftFst, pLiftSnd ) where
 
@@ -15,14 +16,13 @@ import Outputable
 import qualified Data.Semigroup as Semi
 
 data Pair a = Pair { pFst :: a, pSnd :: a }
+  deriving (Functor)
 -- Note that Pair is a *unary* type constructor
 -- whereas (,) is binary
 
 -- The important thing about Pair is that it has a *homogeneous*
 -- Functor instance, so you can easily apply the same function
 -- to both components
-instance Functor Pair where
-  fmap f (Pair x y) = Pair (f x) (f y)
 
 instance Applicative Pair where
   pure x = Pair x x
diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs
index 11bd7686d7..92269e91e7 100644
--- a/compiler/utils/State.hs
+++ b/compiler/utils/State.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE UnboxedTuples #-}
 
 module State where
@@ -5,10 +6,7 @@ module State where
 import GhcPrelude
 
 newtype State s a = State { runState' :: s -> (# a, s #) }
-
-instance Functor (State s) where
-    fmap f m  = State $ \s -> case runState' m s of
-                              (# r, s' #) -> (# f r, s' #)
+    deriving (Functor)
 
 instance Applicative (State s) where
    pure x   = State $ \s -> (# x, s #)
diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs
index bd530b76c3..60449bcc65 100644
--- a/compiler/utils/UniqDFM.hs
+++ b/compiler/utils/UniqDFM.hs
@@ -116,7 +116,7 @@ data TaggedVal val =
   TaggedVal
     val
     {-# UNPACK #-} !Int -- ^ insertion time
-  deriving Data
+  deriving (Data, Functor)
 
 taggedFst :: TaggedVal val -> val
 taggedFst (TaggedVal v _) = v
@@ -127,9 +127,6 @@ taggedSnd (TaggedVal _ i) = i
 instance Eq val => Eq (TaggedVal val) where
   (TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2
 
-instance Functor TaggedVal where
-  fmap f (TaggedVal val i) = TaggedVal (f val) i
-
 -- | Type of unique deterministic finite maps
 data UniqDFM ele =
   UDFM
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 696303b949..f271ac5440 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, FlexibleInstances #-}
+{-# LANGUAGE CPP, FlexibleInstances, DeriveFunctor #-}
 {-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
@@ -247,6 +247,7 @@ recordBreak brkLoc = do
       return (False, oldCounter)
 
 newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> Ghc a }
+    deriving (Functor)
 
 reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
 reflectGHCi (s, gs) m = unGhc (unGHCi m gs) s
@@ -254,9 +255,6 @@ reflectGHCi (s, gs) m = unGhc (unGHCi m gs) s
 startGHCi :: GHCi a -> GHCiState -> Ghc a
 startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref
 
-instance Functor GHCi where
-    fmap = liftM
-
 instance Applicative GHCi where
     pure a = GHCi $ \_ -> pure a
     (<*>) = ap