[Git][ghc/ghc][master] Revert use of generic instances for compiler time perf reasons.

23 Apr 2026


      Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
86a646a6 by Andreas Klebinger at 2026-04-22T13:00:05-04:00
Revert use of generic instances for compiler time perf reasons.

Revert "Derive Semigroup/Monoid for instances believed could be derived in #25871"

This reverts commit 11a04cbb221cc404fe00d65d7c951558ede4caa9.

Revert "add Ghc.Data.Pair deriving"

This reverts commit 15d9ce449e1be8c01b89fd39bdf1e700ea7d1dce.

- - - - -


10 changed files:

- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Data/Pair.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Types/Unique/DSet.hs
- compiler/GHC/Utils/Ppr/Colour.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -2,8 +2,6 @@
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE ParallelListComp #-}
 {-# LANGUAGE NondecreasingIndentation #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
 
 -----------------------------------------------------------------------------
 --
@@ -74,8 +72,6 @@ import GHC.Cmm.CLabel
 import GHC.Types.Tickish ( GenTickish(..) )
 import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 
-import GHC.Generics (Generic, Generically(..))
-
 -- The rest:
 import GHC.Data.Maybe ( expectJust )
 import GHC.Types.ForeignCall ( CCallConv(..) )
@@ -440,7 +436,7 @@ getRegisterReg _   (CmmLocal lreg) = getLocalRegReg lreg
 
 getRegisterReg platform  (CmmGlobal mid)
   = case globalRegMaybe platform $ globalRegUse_reg mid of
-        Just reg -> RegReal reg
+        Just reg -> RegReal $ reg
         Nothing  -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
         -- By this stage, the only MagicIds remaining should be the
         -- ones which map to a real machine register on this
@@ -4936,8 +4932,11 @@ data LoadArgs
   -- | The code to assign arguments to registers used for argument passing.
   , assignArgsCode :: InstrBlock
   }
-  deriving (Generic)
-  deriving (Semigroup, Monoid) via Generically LoadArgs
+instance Semigroup LoadArgs where
+  LoadArgs a1 d1 r1 j1 <> LoadArgs a2 d2 r2 j2
+    = LoadArgs (a1 ++ a2) (d1 ++ d2) (r1 ++ r2) (j1 S.<> j2)
+instance Monoid LoadArgs where
+  mempty = LoadArgs [] [] [] nilOL
 
 -- | An argument passed on the stack, either directly or by reference.
 --


=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -1,8 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
 
 -- | Handle conversion of CmmProc to LLVM code.
 module GHC.CmmToLlvm.CodeGen ( genLlvmProc ) where
@@ -31,8 +29,6 @@ import GHC.Data.FastString
 import GHC.Data.Maybe (expectJust)
 import GHC.Data.OrdList
 
-import GHC.Generics (Generic, Generically(..))
-
 import GHC.Types.ForeignCall
 import GHC.Types.Unique.DSM
 import GHC.Types.Unique
@@ -52,6 +48,7 @@ import Data.List ( nub )
 import qualified Data.List as List
 import Data.List.NonEmpty ( NonEmpty (..), nonEmpty )
 import Data.Maybe ( catMaybes )
+import qualified Data.Semigroup as Semigroup
 
 type Atomic = Maybe MemoryOrdering
 type LlvmStatements = OrdList LlvmStatement
@@ -2478,8 +2475,14 @@ getTBAARegMeta = getTBAAMeta . getTBAA
 
 -- | A more convenient way of accumulating LLVM statements and declarations.
 data LlvmAccum = LlvmAccum LlvmStatements [LlvmCmmDecl]
-  deriving (Generic)
-  deriving (Monoid, Semigroup) via Generically LlvmAccum
+
+instance Semigroup LlvmAccum where
+  LlvmAccum stmtsA declsA <> LlvmAccum stmtsB declsB =
+        LlvmAccum (stmtsA Semigroup.<> stmtsB) (declsA Semigroup.<> declsB)
+
+instance Monoid LlvmAccum where
+    mempty = LlvmAccum nilOL []
+    mappend = (Semigroup.<>)
 
 liftExprData :: LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar
 liftExprData action = do


=====================================
compiler/GHC/Data/Pair.hs
=====================================
@@ -1,6 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
-
 {-
 A simple homogeneous pair type with useful Functor, Applicative, and
 Traversable instances.
@@ -23,12 +20,8 @@ import GHC.Prelude
 import GHC.Utils.Outputable
 import qualified Data.Semigroup as Semi
 
-import GHC.Generics (Generic, Generically(..))
-
 data Pair a = Pair { pFst :: a, pSnd :: a }
-  deriving (Foldable, Functor, Traversable, Generic)
-  deriving (Semigroup, Monoid) via Generically (Pair a)
-
+  deriving (Foldable, Functor, Traversable)
 -- Note that Pair is a *unary* type constructor
 -- whereas (,) is binary
 
@@ -40,6 +33,13 @@ instance Applicative Pair where
   pure x = Pair x x
   (Pair f g) <*> (Pair x y) = Pair (f x) (g y)
 
+instance Semi.Semigroup a => Semi.Semigroup (Pair a) where
+  Pair a1 b1 <> Pair a2 b2 =  Pair (a1 Semi.<> a2) (b1 Semi.<> b2)
+
+instance (Semi.Semigroup a, Monoid a) => Monoid (Pair a) where
+  mempty = Pair mempty mempty
+  mappend = (Semi.<>)
+
 instance Outputable a => Outputable (Pair a) where
   ppr (Pair a b) = ppr a <+> char '~' <+> ppr b
 


=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -1,8 +1,8 @@
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                        -- in module Language.Haskell.Syntax.Extension
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
+
 {-# OPTIONS_GHC -Wno-orphans #-} -- NamedThing, Outputable, OutputableBndrId
 
 {-
@@ -117,7 +117,6 @@ import GHC.Core.Ppr ( pprOccWithTick)
 import GHC.Core.Type
 import GHC.Core.Multiplicity( pprArrowWithModifiers )
 import GHC.Hs.Doc
-import GHC.Generics (Generic, Generically(..))
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
 import GHC.Utils.Outputable
@@ -233,8 +232,6 @@ data HsTyPatRnBuilder =
     hstpb_imp_tvs :: Bag Name,
     hstpb_exp_tvs :: Bag Name
   }
-  deriving (Generic)
-  deriving (Semigroup, Monoid) via Generically HsTyPatRnBuilder
 
 tpBuilderExplicitTV :: Name -> HsTyPatRnBuilder
 tpBuilderExplicitTV name = mempty {hstpb_exp_tvs = unitBag name}
@@ -246,6 +243,16 @@ tpBuilderPatSig HsPSRn {hsps_nwcs, hsps_imp_tvs} =
     hstpb_imp_tvs = listToBag hsps_imp_tvs
   }
 
+instance Semigroup HsTyPatRnBuilder where
+  HsTPRnB nwcs1 imp_tvs1 exptvs1 <> HsTPRnB nwcs2 imp_tvs2 exptvs2 =
+    HsTPRnB
+      (nwcs1    `unionBags` nwcs2)
+      (imp_tvs1 `unionBags` imp_tvs2)
+      (exptvs1  `unionBags` exptvs2)
+
+instance Monoid HsTyPatRnBuilder where
+  mempty = HsTPRnB emptyBag emptyBag emptyBag
+
 buildHsTyPatRn :: HsTyPatRnBuilder -> HsTyPatRn
 buildHsTyPatRn HsTPRnB {hstpb_nwcs, hstpb_imp_tvs, hstpb_exp_tvs} =
   HsTPRn {


=====================================
compiler/GHC/HsToCore/Pmc.hs
=====================================
@@ -1,6 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
-
 -- | This module coverage checks pattern matches. It finds
 --
 --     * Uncovered patterns, certifying non-exhaustivity
@@ -66,7 +63,6 @@ import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr)
 import GHC.HsToCore.Monad
 import GHC.Data.Bag
 import GHC.Data.OrdList
-import GHC.Generics (Generic, Generically(..))
 
 import Control.Monad (when, forM_)
 import qualified Data.Semigroup as Semi
@@ -468,8 +464,13 @@ data CIRB
   , cirb_red   :: !(OrdList SrcInfo) -- ^ Redundant clauses
   , cirb_bangs :: !(OrdList SrcInfo) -- ^ Redundant bang patterns
   }
-  deriving (Generic)
-  deriving (Semigroup, Monoid) via Generically CIRB
+
+instance Semigroup CIRB where
+  CIRB a b c d <> CIRB e f g h = CIRB (a <> e) (b <> f) (c <> g) (d <> h)
+    where (<>) = (Semi.<>)
+
+instance Monoid CIRB where
+  mempty = CIRB mempty mempty mempty mempty
 
 -- See Note [Determining inaccessible clauses]
 ensureOneNotRedundant :: CIRB -> CIRB


=====================================
compiler/GHC/HsToCore/Pmc/Solver/Types.hs
=====================================
@@ -2,8 +2,6 @@
 {-# LANGUAGE ViewPatterns        #-}
 {-# LANGUAGE MultiWayIf          #-}
 {-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE DerivingVia         #-}
 
 -- | Domain types used in "GHC.HsToCore.Pmc.Solver".
 -- The ultimate goal is to define 'Nabla', which models normalised refinement
@@ -71,7 +69,6 @@ import GHC.Types.CompleteMatch
 import GHC.Types.SourceText (SourceText(..), mkFractionalLit, FractionalLit
                             , fractionalLitFromRational
                             , FractionalExponentBase(..))
-import GHC.Generics (Generic, Generically(..))
 
 import Numeric (fromRat)
 import Data.Ratio
@@ -108,13 +105,19 @@ instance Outputable Nabla where
 
 -- | A disjunctive bag of 'Nabla's, representing a refinement type.
 newtype Nablas = MkNablas (Bag Nabla)
-  -- deriving 'Outputable' removes `MkNablas` label
-  deriving (Generic, Outputable)
-  deriving (Semigroup, Monoid) via Generically Nablas
 
 initNablas :: Nablas
 initNablas = MkNablas (unitBag initNabla)
 
+instance Outputable Nablas where
+  ppr (MkNablas nablas) = ppr nablas
+
+instance Semigroup Nablas where
+  MkNablas l <> MkNablas r = MkNablas (l `unionBags` r)
+
+instance Monoid Nablas where
+  mempty = MkNablas emptyBag
+
 -- | The type oracle state. An 'GHC.Tc.Solver.Monad.InertSet' that we
 -- incrementally add local type constraints to, together with a sequence
 -- number that counts the number of times we extended it with new facts.


=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -1,5 +1,4 @@
 {-# LANGUAGE ApplicativeDo              #-}
-{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE TypeFamilies               #-}
 
@@ -62,7 +61,6 @@ import {-# SOURCE #-} GHC.Parser (parseIdentifier)
 import GHC.Parser.Lexer
 import GHC.Parser.HaddockLex
 import GHC.Parser.Errors.Types
-import GHC.Generics (Generic, Generically(..))
 import GHC.Utils.Misc (mergeListsBy, filterOut, (<&&>))
 import qualified GHC.Data.Strict as Strict
 
@@ -1349,8 +1347,13 @@ data LocRange =
     { loc_range_from :: !LowerLocBound,
       loc_range_to   :: !UpperLocBound,
       loc_range_col  :: !ColumnBound }
-  deriving (Generic)
-  deriving (Semigroup, Monoid) via Generically LocRange
+
+instance Semigroup LocRange where
+  LocRange from1 to1 col1 <> LocRange from2 to2 col2 =
+    LocRange (from1 <> from2) (to1 <> to2) (col1 <> col2)
+
+instance Monoid LocRange where
+  mempty = LocRange mempty mempty mempty
 
 -- The location range from the specified position to the end of the file.
 locRangeFrom :: Strict.Maybe BufPos -> LocRange


=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -1,8 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE MultiWayIf            #-}
 {-# LANGUAGE RecursiveDo           #-}
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE DerivingVia           #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 {-
@@ -147,13 +145,13 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Constants (debugIsOn)
 
-import GHC.Generics (Generic, Generically(..))
-
 import Control.Monad
 import Data.IORef
 import GHC.Data.Maybe
 import GHC.Types.Name.Reader
 
+import qualified Data.Semigroup as Semi
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1281,8 +1279,17 @@ data CandidatesQTvs
          -- These are covars. Included only so that we don't repeatedly
          -- look at covars' kinds in accumulator. Not used by quantifyTyVars.
     }
-  deriving (Generic)
-  deriving (Semigroup, Monoid) via Generically CandidatesQTvs
+
+instance Semi.Semigroup CandidatesQTvs where
+   (DV { dv_kvs = kv1, dv_tvs = tv1, dv_cvs = cv1 })
+     <> (DV { dv_kvs = kv2, dv_tvs = tv2, dv_cvs = cv2 })
+          = DV { dv_kvs = kv1 `unionDVarSet` kv2
+               , dv_tvs = tv1 `unionDVarSet` tv2
+               , dv_cvs = cv1 `unionVarSet` cv2 }
+
+instance Monoid CandidatesQTvs where
+   mempty = DV { dv_kvs = emptyDVarSet, dv_tvs = emptyDVarSet, dv_cvs = emptyVarSet }
+   mappend = (Semi.<>)
 
 instance Outputable CandidatesQTvs where
   ppr (DV {dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs })


=====================================
compiler/GHC/Types/Unique/DSet.hs
=====================================
@@ -44,7 +44,6 @@ import GHC.Types.Unique
 
 import Data.Coerce
 import Data.Data
-import Data.Semigroup
 
 -- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here.
 -- Beyond preserving invariants, we may also want to 'override' typeclass
@@ -155,9 +154,3 @@ instance Outputable a => Outputable (UniqDSet a) where
 
 pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc
 pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList
-
-instance Semigroup (UniqDSet a) where
-  (<>) = unionUniqDSets
-
-instance Monoid (UniqDSet a) where
-  mempty = emptyUniqDSet


=====================================
compiler/GHC/Utils/Ppr/Colour.hs
=====================================
@@ -1,17 +1,21 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
-
 module GHC.Utils.Ppr.Colour where
 import GHC.Prelude.Basic
 
 import Data.Maybe (fromMaybe)
 import GHC.Data.Bool
-import GHC.Generics (Generic, Generically(..))
+import Data.Semigroup as Semi
 
 -- | A colour\/style for use with 'coloured'.
 newtype PprColour = PprColour { renderColour :: String }
-  deriving (Generic)
-  deriving (Semigroup, Monoid) via Generically PprColour
+
+instance Semi.Semigroup PprColour where
+  PprColour s1 <> PprColour s2 = PprColour (s1 <> s2)
+
+-- | Allow colours to be combined (e.g. bold + red);
+--   In case of conflict, right side takes precedence.
+instance Monoid PprColour where
+  mempty = PprColour mempty
+  mappend = (<>)
 
 renderColourAfresh :: PprColour -> String
 renderColourAfresh c = renderColour (colReset `mappend` c)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86a646a6b17f38e1afee644ccd691e16...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86a646a6b17f38e1afee644ccd691e16...
You're receiving this email because of your account on gitlab.haskell.org.

    

Marge Bot (＠marge-bot)

tags

participants (1)