From 95dfdceb8b4dcc54a366949577d9ee389bad5bc3 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 24 May 2016 09:22:04 -0400 Subject: Remove 'deriving Typeable' statements Summary: Deriving `Typeable` has been a no-op since GHC 7.10, and now that we require 7.10+ to build GHC, we can remove all the redundant `deriving Typeable` statements in GHC. Test Plan: ./validate Reviewers: goldfire, austin, hvr, bgamari Reviewed By: austin, hvr, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2260 --- libraries/base/Data/Semigroup.hs | 14 +-- libraries/base/GHC/Exception.hs | 6 +- libraries/ghci/GHCi/TH.hs | 2 +- .../template-haskell/Language/Haskell/TH/Syntax.hs | 100 ++++++++++----------- 4 files changed, 60 insertions(+), 62 deletions(-) (limited to 'libraries') diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index 518e215661..1f4944a411 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -290,7 +290,7 @@ instance Semigroup (NonEmpty a) where newtype Min a = Min { getMin :: a } - deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1) + deriving (Eq, Ord, Show, Read, Data, Generic, Generic1) instance Bounded a => Bounded (Min a) where minBound = Min minBound @@ -347,7 +347,7 @@ instance Num a => Num (Min a) where fromInteger = Min . fromInteger newtype Max a = Max { getMax :: a } - deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1) + deriving (Eq, Ord, Show, Read, Data, Generic, Generic1) instance Bounded a => Bounded (Max a) where minBound = Max minBound @@ -405,7 +405,7 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. data Arg a b = Arg a b deriving - (Show, Read, Data, Typeable, Generic, Generic1) + (Show, Read, Data, Generic, Generic1) type ArgMin a b = Min (Arg a b) type ArgMax a b = Max (Arg a b) @@ -437,7 +437,7 @@ instance Bifunctor Arg where -- | Use @'Option' ('First' a)@ to get the behavior of -- 'Data.Monoid.First' from "Data.Monoid". newtype First a = First { getFirst :: a } deriving - (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1) + (Eq, Ord, Show, Read, Data, Generic, Generic1) instance Bounded a => Bounded (First a) where minBound = First minBound @@ -482,7 +482,7 @@ instance MonadFix First where -- | Use @'Option' ('Last' a)@ to get the behavior of -- 'Data.Monoid.Last' from "Data.Monoid" newtype Last a = Last { getLast :: a } deriving - (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1) + (Eq, Ord, Show, Read, Data, Generic, Generic1) instance Bounded a => Bounded (Last a) where minBound = Last minBound @@ -527,7 +527,7 @@ instance MonadFix Last where -- | Provide a Semigroup for an arbitrary Monoid. newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m } - deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1) + deriving (Eq, Ord, Show, Read, Data, Generic, Generic1) instance Monoid m => Semigroup (WrappedMonoid m) where (<>) = coerce (mappend :: m -> m -> m) @@ -570,7 +570,7 @@ mtimesDefault n x -- Ideally, this type would not exist at all and we would just fix the -- 'Monoid' instance of 'Maybe' newtype Option a = Option { getOption :: Maybe a } - deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, Generic1) + deriving (Eq, Ord, Show, Read, Data, Generic, Generic1) instance Functor Option where fmap f (Option a) = Option (fmap f a) diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index be9e6f956c..aeaef20805 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -59,7 +59,7 @@ instance of the @Exception@ class. The simplest case is a new exception type directly below the root: > data MyException = ThisException | ThatException -> deriving (Show, Typeable) +> deriving Show > > instance Exception MyException @@ -79,7 +79,6 @@ of exceptions: > -- Make the root exception type for all the exceptions in a compiler > > data SomeCompilerException = forall e . Exception e => SomeCompilerException e -> deriving Typeable > > instance Show SomeCompilerException where > show (SomeCompilerException e) = show e @@ -98,7 +97,6 @@ of exceptions: > -- Make a subhierarchy for exceptions in the frontend of the compiler > > data SomeFrontendException = forall e . Exception e => SomeFrontendException e -> deriving Typeable > > instance Show SomeFrontendException where > show (SomeFrontendException e) = show e @@ -119,7 +117,7 @@ of exceptions: > -- Make an exception type for a particular frontend compiler exception > > data MismatchedParentheses = MismatchedParentheses -> deriving (Typeable, Show) +> deriving Show > > instance Exception MismatchedParentheses where > toException = frontendExceptionToException diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs index 152522166c..69f114cfd2 100644 --- a/libraries/ghci/GHCi/TH.hs +++ b/libraries/ghci/GHCi/TH.hs @@ -42,7 +42,7 @@ runModFinalizers = go =<< getState newtype GHCiQ a = GHCiQ { runGHCiQ :: QState -> IO (a, QState) } data GHCiQException = GHCiQException QState String - deriving (Show, Typeable) + deriving Show instance Exception GHCiQException diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index fc9c80d140..dfcf471f1d 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -790,17 +790,17 @@ dataToPatQ = dataToQa id litP conP ----------------------------------------------------- newtype ModName = ModName String -- Module name - deriving (Show,Eq,Ord,Typeable,Data,Generic) + deriving (Show,Eq,Ord,Data,Generic) newtype PkgName = PkgName String -- package name - deriving (Show,Eq,Ord,Typeable,Data,Generic) + deriving (Show,Eq,Ord,Data,Generic) -- | Obtained from 'reifyModule' and 'thisModule'. data Module = Module PkgName ModName -- package qualified module name - deriving (Show,Eq,Ord,Typeable,Data,Generic) + deriving (Show,Eq,Ord,Data,Generic) newtype OccName = OccName String - deriving (Show,Eq,Ord,Typeable,Data,Generic) + deriving (Show,Eq,Ord,Data,Generic) mkModName :: String -> ModName mkModName s = ModName s @@ -911,7 +911,7 @@ Names constructed using @newName@ and @mkName@ may be used in bindings (such as @let x = ...@ or @\x -> ...@), but names constructed using @lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not. -} -data Name = Name OccName NameFlavour deriving (Typeable, Data, Eq, Generic) +data Name = Name OccName NameFlavour deriving (Data, Eq, Generic) instance Ord Name where -- check if unique is different before looking at strings @@ -927,13 +927,13 @@ data NameFlavour -- An original name (occurrences only, not binders) -- Need the namespace too to be sure which -- thing we are naming - deriving ( Typeable, Data, Eq, Ord, Show, Generic ) + deriving ( Data, Eq, Ord, Show, Generic ) data NameSpace = VarName -- ^ Variables | DataName -- ^ Data constructors | TcClsName -- ^ Type constructors and classes; Haskell has them -- in the same name space for now. - deriving( Eq, Ord, Show, Data, Typeable, Generic ) + deriving( Eq, Ord, Show, Data, Generic ) type Uniq = Int @@ -1184,7 +1184,7 @@ data Loc , loc_module :: String , loc_start :: CharPos , loc_end :: CharPos } - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) type CharPos = (Int, Int) -- ^ Line and character position @@ -1261,13 +1261,13 @@ data Info | TyVarI -- Scoped type variable Name Type -- What it is bound to - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) -- | Obtained from 'reifyModule' in the 'Q' Monad. data ModuleInfo = -- | Contains the import list of the module. ModuleInfo [Module] - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) {- | In 'ClassOpI' and 'DataConI', name of the parent class or type @@ -1291,9 +1291,9 @@ type Unlifted = Bool type InstanceDec = Dec data Fixity = Fixity Int FixityDirection - deriving( Eq, Ord, Show, Data, Typeable, Generic ) + deriving( Eq, Ord, Show, Data, Generic ) data FixityDirection = InfixL | InfixR | InfixN - deriving( Eq, Ord, Show, Data, Typeable, Generic ) + deriving( Eq, Ord, Show, Data, Generic ) -- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9) maxPrecedence :: Int @@ -1386,7 +1386,7 @@ data Lit = CharL Char | DoublePrimL Rational | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr# | CharPrimL Char - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) -- We could add Int, Float, Double etc, as we do in HsLit, -- but that could complicate the @@ -1414,15 +1414,15 @@ data Pat | ListP [ Pat ] -- ^ @{ [1,2,3] }@ | SigP Pat Type -- ^ @{ p :: t }@ | ViewP Exp Pat -- ^ @{ e -> p }@ - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) type FieldPat = (Name,Pat) data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@ - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Clause = Clause [Pat] Body [Dec] -- ^ @f { p1 p2 = body where decs }@ - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Exp = VarE Name -- ^ @{ x }@ @@ -1471,7 +1471,7 @@ data Exp | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ | StaticE Exp -- ^ @{ static e }@ | UnboundVarE Name -- ^ @{ _x }@ (hole) - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) type FieldExp = (Name,Exp) @@ -1482,23 +1482,23 @@ data Body -- | e3 = e4 } -- where ds@ | NormalB Exp -- ^ @f p { = e } where ds@ - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Guard = NormalG Exp -- ^ @f x { | odd x } = x@ | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@ - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Stmt = BindS Pat Exp | LetS [ Dec ] | NoBindS Exp | ParS [[Stmt]] - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Range = FromR Exp | FromThenR Exp Exp | FromToR Exp Exp | FromThenToR Exp Exp Exp - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Dec = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@ @@ -1565,7 +1565,7 @@ data Dec -- pattern synonyms are supported. See 'PatSynArgs' for details | PatSynSigD Name PatSynType -- ^ A pattern synonym's type signature. - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) -- | Varieties of allowed instance overlap. data Overlap = Overlappable -- ^ May be overlapped by more specific instances @@ -1574,7 +1574,7 @@ data Overlap = Overlappable -- ^ May be overlapped by more specific instances | Incoherent -- ^ Both 'Overlappable' and 'Overlappable', and -- pick an arbitrary one if multiple choices are -- available. - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) -- | A Pattern synonym's type. Note that a pattern synonym's *fully* -- specified type has a peculiar shape coming with two forall @@ -1630,30 +1630,30 @@ type PatSynType = Type -- between @type family@ and @where@. data TypeFamilyHead = TypeFamilyHead Name [TyVarBndr] FamilyResultSig (Maybe InjectivityAnn) - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) -- | One equation of a type family instance or closed type family. The -- arguments are the left-hand-side type patterns and the right-hand-side -- result. data TySynEqn = TySynEqn [Type] Type - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data FunDep = FunDep [Name] [Name] - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data FamFlavour = TypeFam | DataFam - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Foreign = ImportF Callconv Safety String Name Type | ExportF Callconv String Name Type - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) -- keep Callconv in sync with module ForeignCall in ghc/compiler/prelude/ForeignCall.hs data Callconv = CCall | StdCall | CApi | Prim | JavaScript - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Safety = Unsafe | Safe | Interruptible - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Pragma = InlineP Name Inline RuleMatch Phases | SpecialiseP Name Type (Maybe Inline) Phases @@ -1661,30 +1661,30 @@ data Pragma = InlineP Name Inline RuleMatch Phases | RuleP String [RuleBndr] Exp Exp Phases | AnnP AnnTarget Exp | LineP Int String - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Inline = NoInline | Inline | Inlinable - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) data RuleMatch = ConLike | FunLike - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) data Phases = AllPhases | FromPhase Int | BeforePhase Int - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) data RuleBndr = RuleVar Name | TypedRuleVar Name Type - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) data AnnTarget = ModuleAnnotation | TypeAnnotation Name | ValueAnnotation Name - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) type Cxt = [Pred] -- ^ @(Eq a, Ord b)@ @@ -1697,12 +1697,12 @@ data SourceUnpackedness = NoSourceUnpackedness -- ^ @C a@ | SourceNoUnpack -- ^ @C { {\-\# NOUNPACK \#-\} } a@ | SourceUnpack -- ^ @C { {\-\# UNPACK \#-\} } a@ - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) data SourceStrictness = NoSourceStrictness -- ^ @C a@ | SourceLazy -- ^ @C {~}a@ | SourceStrict -- ^ @C {!}a@ - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) -- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness' -- refers to the strictness that the compiler chooses for a data constructor @@ -1711,7 +1711,7 @@ data SourceStrictness = NoSourceStrictness -- ^ @C a@ data DecidedStrictness = DecidedLazy | DecidedStrict | DecidedUnpack - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) data Con = NormalC Name [BangType] -- ^ @C Int a@ | RecC Name [VarBangType] -- ^ @C { v :: Int, w :: a }@ @@ -1723,7 +1723,7 @@ data Con = NormalC Name [BangType] -- ^ @C Int a@ | RecGadtC [Name] [VarBangType] Type -- See Note [GADT return type] -- ^ @C :: { v :: Int } -> T b Int@ - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) -- Note [GADT return type] -- ~~~~~~~~~~~~~~~~~~~~~~~ @@ -1755,7 +1755,7 @@ data Con = NormalC Name [BangType] -- ^ @C Int a@ data Bang = Bang SourceUnpackedness SourceStrictness -- ^ @C { {\-\# UNPACK \#-\} !}a@ - deriving (Show, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Eq, Ord, Data, Generic) type BangType = (Bang, Type) type VarBangType = (Name, Bang, Type) @@ -1776,14 +1776,14 @@ data PatSynDir = Unidir -- ^ @pattern P x {<-} p@ | ImplBidir -- ^ @pattern P x {=} p@ | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@ - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) -- | A pattern synonym's argument type. data PatSynArgs = PrefixPatSyn [Name] -- ^ @pattern P {x y z} = p@ | InfixPatSyn Name Name -- ^ @pattern {x P y} = p@ | RecordPatSyn [Name] -- ^ @pattern P { {x,y,z} } = p@ - deriving( Show, Eq, Ord, Data, Typeable, Generic ) + deriving( Show, Eq, Ord, Data, Generic ) data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \. \ -> \@ | AppT Type Type -- ^ @T a b@ @@ -1810,37 +1810,37 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \. \ -> \