Use DeriveFunctor throughout the codebase (#15654)

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

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)

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

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
 
@@ -1082,10 +1082,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)

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

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

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

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

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

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

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

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
 

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)

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

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)