diff options
41 files changed, 57 insertions, 121 deletions
diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs index 02062e2e19..521ea9fe55 100644 --- a/libraries/base/Control/Applicative.hs +++ b/libraries/base/Control/Applicative.hs @@ -1,5 +1,4 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} diff --git a/libraries/base/Control/Concurrent/Chan.hs b/libraries/base/Control/Concurrent/Chan.hs index 487187503d..f5785f5a65 100644 --- a/libraries/base/Control/Concurrent/Chan.hs +++ b/libraries/base/Control/Concurrent/Chan.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -37,7 +37,6 @@ module Control.Concurrent.Chan import System.IO.Unsafe ( unsafeInterleaveIO ) import Control.Concurrent.MVar import Control.Exception (mask_) -import Data.Typeable #define _UPK_(x) {-# UNPACK #-} !(x) @@ -49,7 +48,7 @@ import Data.Typeable data Chan a = Chan _UPK_(MVar (Stream a)) _UPK_(MVar (Stream a)) -- Invariant: the Stream a is always an empty MVar - deriving (Eq,Typeable) + deriving (Eq) type Stream a = MVar (ChItem a) diff --git a/libraries/base/Control/Concurrent/QSem.hs b/libraries/base/Control/Concurrent/QSem.hs index e20c737fdb..51624e4777 100644 --- a/libraries/base/Control/Concurrent/QSem.hs +++ b/libraries/base/Control/Concurrent/QSem.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Safe #-} -{-# LANGUAGE AutoDeriveTypeable, BangPatterns #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-} ----------------------------------------------------------------------------- diff --git a/libraries/base/Control/Concurrent/QSemN.hs b/libraries/base/Control/Concurrent/QSemN.hs index bd520cf40d..7686d3f327 100644 --- a/libraries/base/Control/Concurrent/QSemN.hs +++ b/libraries/base/Control/Concurrent/QSemN.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Safe #-} -{-# LANGUAGE AutoDeriveTypeable, BangPatterns #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-} ----------------------------------------------------------------------------- @@ -28,7 +28,6 @@ module Control.Concurrent.QSemN import Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, tryTakeMVar , putMVar, newMVar , tryPutMVar, isEmptyMVar) -import Data.Typeable import Control.Exception import Data.Maybe @@ -43,7 +42,6 @@ import Data.Maybe -- is safe; it never loses any of the resource. -- data QSemN = QSemN !(MVar (Int, [(Int, MVar ())], [(Int, MVar ())])) - deriving Typeable -- The semaphore state (i, xs, ys): -- diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index f7779d6f9c..4608c2dd20 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash #-} -{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -104,7 +104,6 @@ import GHC.Show -- import GHC.Exception hiding ( Exception ) import GHC.Conc.Sync -import Data.Dynamic import Data.Either ----------------------------------------------------------------------------- @@ -297,7 +296,7 @@ bracketOnError before after thing = -- |A pattern match failed. The @String@ gives information about the -- source location of the pattern. -data PatternMatchFail = PatternMatchFail String deriving Typeable +data PatternMatchFail = PatternMatchFail String instance Show PatternMatchFail where showsPrec _ (PatternMatchFail err) = showString err @@ -311,7 +310,7 @@ instance Exception PatternMatchFail -- multiple constructors, where some fields are in one constructor -- but not another. The @String@ gives information about the source -- location of the record selector. -data RecSelError = RecSelError String deriving Typeable +data RecSelError = RecSelError String instance Show RecSelError where showsPrec _ (RecSelError err) = showString err @@ -323,7 +322,7 @@ instance Exception RecSelError -- |An uninitialised record field was used. The @String@ gives -- information about the source location where the record was -- constructed. -data RecConError = RecConError String deriving Typeable +data RecConError = RecConError String instance Show RecConError where showsPrec _ (RecConError err) = showString err @@ -337,7 +336,7 @@ instance Exception RecConError -- multiple constructors, where some fields are in one constructor -- but not another. The @String@ gives information about the source -- location of the record update. -data RecUpdError = RecUpdError String deriving Typeable +data RecUpdError = RecUpdError String instance Show RecUpdError where showsPrec _ (RecUpdError err) = showString err @@ -349,7 +348,7 @@ instance Exception RecUpdError -- |A class method without a definition (neither a default definition, -- nor a definition in the appropriate instance) was called. The -- @String@ gives information about which method it was. -data NoMethodError = NoMethodError String deriving Typeable +data NoMethodError = NoMethodError String instance Show NoMethodError where showsPrec _ (NoMethodError err) = showString err @@ -362,7 +361,7 @@ instance Exception NoMethodError -- guaranteed not to terminate. Note that there is no guarantee that -- the runtime system will notice whether any given computation is -- guaranteed to terminate or not. -data NonTermination = NonTermination deriving Typeable +data NonTermination = NonTermination instance Show NonTermination where showsPrec _ NonTermination = showString "<<loop>>" @@ -373,7 +372,7 @@ instance Exception NonTermination -- |Thrown when the program attempts to call @atomically@, from the @stm@ -- package, inside another call to @atomically@. -data NestedAtomically = NestedAtomically deriving Typeable +data NestedAtomically = NestedAtomically instance Show NestedAtomically where showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested" diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs index ecd8301954..88aa597db4 100644 --- a/libraries/base/Data/Complex.hs +++ b/libraries/base/Data/Complex.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- @@ -34,7 +34,6 @@ module Data.Complex ) where -import Data.Typeable import Data.Data (Data) import Foreign (Storable, castPtr, peek, poke, pokeElemOff, peekElemOff, sizeOf, alignment) @@ -52,7 +51,7 @@ infix 6 :+ data Complex a = !a :+ !a -- ^ forms a complex number from its real and imaginary -- rectangular components. - deriving (Eq, Show, Read, Data, Typeable) + deriving (Eq, Show, Read, Data) -- ----------------------------------------------------------------------------- -- Functions over Complex diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 7fe9c4d16f..c242566276 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds, StandaloneDeriving, - AutoDeriveTypeable, TypeOperators, GADTs, FlexibleInstances #-} + TypeOperators, GADTs, FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs index 50bea62e1a..e7daf4614e 100644 --- a/libraries/base/Data/Dynamic.hs +++ b/libraries/base/Data/Dynamic.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -68,7 +68,6 @@ import GHC.Exception of the object\'s type; useful for debugging. -} data Dynamic = Dynamic TypeRep Obj - deriving Typeable instance Show Dynamic where -- the instance just prints the type representation. diff --git a/libraries/base/Data/Either.hs b/libraries/base/Data/Either.hs index 99bc0d466a..d727e5219d 100644 --- a/libraries/base/Data/Either.hs +++ b/libraries/base/Data/Either.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, TypeOperators, UndecidableInstances #-} ----------------------------------------------------------------------------- @@ -31,7 +31,6 @@ import GHC.Base import GHC.Show import GHC.Read -import Data.Typeable import Data.Type.Equality -- $setup @@ -123,7 +122,7 @@ Left "parse error" -} data Either a b = Left a | Right b - deriving (Eq, Ord, Read, Show, Typeable) + deriving (Eq, Ord, Read, Show) instance Functor (Either a) where fmap _ (Left x) = Left x diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs index d67a5dc61e..150afb83c6 100644 --- a/libraries/base/Data/Fixed.hs +++ b/libraries/base/Data/Fixed.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE AutoDeriveTypeable #-} ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs index ac47922aef..59ecc7fdf5 100644 --- a/libraries/base/Data/Functor/Identity.hs +++ b/libraries/base/Data/Functor/Identity.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AutoDeriveTypeable #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE Trustworthy #-} diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs index 82c01603ca..c5a4d8bdf9 100644 --- a/libraries/base/Data/Monoid.hs +++ b/libraries/base/Data/Monoid.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-} diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 4cdc57de22..9285904660 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -3,7 +3,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-} diff --git a/libraries/base/Data/Unique.hs b/libraries/base/Data/Unique.hs index 74bac76ad0..2db9247572 100644 --- a/libraries/base/Data/Unique.hs +++ b/libraries/base/Data/Unique.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE MagicHash, AutoDeriveTypeable #-} +{-# LANGUAGE MagicHash #-} ----------------------------------------------------------------------------- -- | @@ -26,12 +26,11 @@ import System.IO.Unsafe (unsafePerformIO) import GHC.Base import GHC.Num -import Data.Typeable import Data.IORef -- | An abstract unique object. Objects of type 'Unique' may be -- compared for equality and ordering and hashed into 'Int'. -newtype Unique = Unique Integer deriving (Eq,Ord,Typeable) +newtype Unique = Unique Integer deriving (Eq,Ord) uniqSource :: IORef Integer uniqSource = unsafePerformIO (newIORef 0) diff --git a/libraries/base/Data/Version.hs b/libraries/base/Data/Version.hs index 1a14fd08f4..20060c48ba 100644 --- a/libraries/base/Data/Version.hs +++ b/libraries/base/Data/Version.hs @@ -1,5 +1,4 @@ {-# LANGUAGE Safe #-} -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- @@ -44,7 +43,6 @@ import Data.Int ( Int ) import Data.List import Data.Ord import Data.String ( String ) -import Data.Typeable ( Typeable ) import GHC.Read import GHC.Show import Text.ParserCombinators.ReadP @@ -93,7 +91,7 @@ data Version = -- The interpretation of the list of tags is entirely dependent -- on the entity that this version applies to. } - deriving (Read,Show,Typeable) + deriving (Read,Show) {-# DEPRECATED versionTags "See GHC ticket #2496" #-} -- TODO. Remove all references to versionTags in GHC 7.12 release. diff --git a/libraries/base/Data/Void.hs b/libraries/base/Data/Void.hs index 6bcb1b36a7..55ebd7e452 100644 --- a/libraries/base/Data/Void.hs +++ b/libraries/base/Data/Void.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyCase #-} diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs index abaf5c73d6..2b9939c6cc 100644 --- a/libraries/base/Foreign/C/Types.hs +++ b/libraries/base/Foreign/C/Types.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, GeneralizedNewtypeDeriving, - AutoDeriveTypeable, StandaloneDeriving #-} + StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} -- XXX -fno-warn-unused-binds stops us warning about unused constructors, -- but really we should just remove them if we don't want them @@ -73,7 +73,6 @@ import Foreign.Storable import Data.Bits ( Bits(..), FiniteBits(..) ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word64 ) -import Data.Typeable import GHC.Base import GHC.Float diff --git a/libraries/base/Foreign/Ptr.hs b/libraries/base/Foreign/Ptr.hs index e57da91a3c..efe580a70d 100644 --- a/libraries/base/Foreign/Ptr.hs +++ b/libraries/base/Foreign/Ptr.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, GeneralizedNewtypeDeriving, - AutoDeriveTypeable, StandaloneDeriving #-} + StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -58,7 +58,6 @@ import GHC.Show import GHC.Enum import Data.Bits -import Data.Typeable import Foreign.Storable ( Storable(..) ) -- | Release the storage associated with the given 'FunPtr', which diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index eb07137b76..1295982ddf 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -5,7 +5,6 @@ , MagicHash , UnboxedTuples , UnliftedFFITypes - , DeriveDataTypeable , StandaloneDeriving , RankNTypes #-} @@ -98,10 +97,6 @@ module GHC.Conc.Sync import Foreign import Foreign.C -#ifdef mingw32_HOST_OS -import Data.Typeable -#endif - #ifndef mingw32_HOST_OS import Data.Dynamic #endif @@ -128,7 +123,7 @@ infixr 0 `par`, `pseq` -- 'ThreadId', 'par', and 'fork' ----------------------------------------------------------------------------- -data ThreadId = ThreadId ThreadId# deriving( Typeable ) +data ThreadId = ThreadId ThreadId# -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. @@ -622,7 +617,6 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s -> -- |A monad supporting atomic memory transactions. newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #)) - deriving Typeable unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #)) unSTM (STM a) = a @@ -772,7 +766,6 @@ always i = alwaysSucceeds ( do v <- i -- |Shared memory locations that support atomic memory transactions. data TVar a = TVar (TVar# RealWorld a) - deriving Typeable instance Eq (TVar a) where (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#) diff --git a/libraries/base/GHC/Conc/Windows.hs b/libraries/base/GHC/Conc/Windows.hs index 7935a8a48d..b77945f1d7 100644 --- a/libraries/base/GHC/Conc/Windows.hs +++ b/libraries/base/GHC/Conc/Windows.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples, - AutoDeriveTypeable #-} +{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_HADDOCK not-home #-} @@ -280,7 +279,7 @@ data ConsoleEvent -- these are sent to Services only. | Logoff | Shutdown - deriving (Eq, Ord, Enum, Show, Read, Typeable) + deriving (Eq, Ord, Enum, Show, Read) start_console_handler :: Word32 -> IO () start_console_handler r = diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index b77d50a628..b82ae114e6 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -2,7 +2,6 @@ {-# LANGUAGE NoImplicitPrelude , ExistentialQuantification , MagicHash - , DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-} @@ -40,7 +39,6 @@ When an exception of type @e@ is thrown, behind the scenes it is encapsulated in a @SomeException@. -} data SomeException = forall e . Exception e => SomeException e - deriving Typeable instance Show SomeException where showsPrec p (SomeException e) = showsPrec p e @@ -161,7 +159,7 @@ throw e = raise# (toException e) -- |This is thrown when the user calls 'error'. The @String@ is the -- argument given to 'error'. newtype ErrorCall = ErrorCall String - deriving (Eq, Ord, Typeable) + deriving (Eq, Ord) instance Exception ErrorCall @@ -179,7 +177,7 @@ data ArithException | DivideByZero | Denormal | RatioZeroDenominator -- ^ @since 4.6.0.0 - deriving (Eq, Ord, Typeable) + deriving (Eq, Ord) divZeroException, overflowException, ratioZeroDenomException :: SomeException divZeroException = toException DivideByZero diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index 294267835e..ffc27d11eb 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE MagicHash, UnboxedTuples, AutoDeriveTypeable, TypeFamilies, +{-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, NoImplicitPrelude #-} ----------------------------------------------------------------------------- @@ -140,7 +140,7 @@ traceEvent = Debug.Trace.traceEventIO -- entire ghc package at runtime data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr - deriving( Data, Typeable, Eq ) + deriving( Data, Eq ) {- ********************************************************************** diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 448eaee76f..6e288483ea 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -5,7 +5,7 @@ , UnboxedTuples #-} {-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -46,7 +46,6 @@ module GHC.ForeignPtr import Foreign.Storable import Data.Foldable ( sequence_ ) -import Data.Typeable import GHC.Show import GHC.Base @@ -71,7 +70,6 @@ import GHC.Ptr ( Ptr(..), FunPtr(..) ) -- class 'Storable'. -- data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents - deriving Typeable -- we cache the Addr# in the ForeignPtr object, but attach -- the finalizer to the IORef (or the MutableByteArray# in -- the case of a MallocPtr). The aim of the representation diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index eed53626a7..b7e05b5606 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude, AutoDeriveTypeable, MagicHash, +{-# LANGUAGE NoImplicitPrelude, MagicHash, ExistentialQuantification #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} @@ -52,7 +52,7 @@ import GHC.Exception import GHC.IO.Handle.Types import Foreign.C.Types -import Data.Typeable ( Typeable, cast ) +import Data.Typeable ( cast ) -- ------------------------------------------------------------------------ -- Exception datatypes and operations @@ -60,7 +60,6 @@ import Data.Typeable ( Typeable, cast ) -- |The thread is blocked on an @MVar@, but there are no other references -- to the @MVar@ so it can't ever continue. data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar - deriving Typeable instance Exception BlockedIndefinitelyOnMVar @@ -75,7 +74,6 @@ blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar -- |The thread is waiting to retry an STM transaction, but there are no -- other references to any @TVar@s involved, so it can't ever continue. data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM - deriving Typeable instance Exception BlockedIndefinitelyOnSTM @@ -90,7 +88,6 @@ blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM -- |There are no runnable threads, so the program is deadlocked. -- The @Deadlock@ exception is raised in the main thread only. data Deadlock = Deadlock - deriving Typeable instance Exception Deadlock @@ -105,7 +102,6 @@ instance Show Deadlock where -- -- @since 4.8.0.0 data AllocationLimitExceeded = AllocationLimitExceeded - deriving Typeable instance Exception AllocationLimitExceeded where toException = asyncExceptionToException @@ -122,7 +118,6 @@ allocationLimitExceeded = toException AllocationLimitExceeded -- |'assert' was applied to 'False'. data AssertionFailed = AssertionFailed String - deriving Typeable instance Exception AssertionFailed @@ -135,7 +130,6 @@ instance Show AssertionFailed where -- -- @since 4.7.0.0 data SomeAsyncException = forall e . Exception e => SomeAsyncException e - deriving Typeable instance Show SomeAsyncException where show (SomeAsyncException e) = show e @@ -178,7 +172,7 @@ data AsyncException -- ^This exception is raised by default in the main thread of -- the program when the user requests to terminate the program -- via the usual mechanism(s) (e.g. Control-C in the console). - deriving (Eq, Ord, Typeable) + deriving (Eq, Ord) instance Exception AsyncException where toException = asyncExceptionToException @@ -192,7 +186,7 @@ data ArrayException | UndefinedElement String -- ^An attempt was made to evaluate an element of an -- array that had not been initialized. - deriving (Eq, Ord, Typeable) + deriving (Eq, Ord) instance Exception ArrayException @@ -231,7 +225,7 @@ data ExitCode -- The exact interpretation of the code is -- operating-system dependent. In particular, some values -- may be prohibited (e.g. 0 on a POSIX-compliant system). - deriving (Eq, Ord, Read, Show, Typeable) + deriving (Eq, Ord, Read, Show) instance Exception ExitCode @@ -267,7 +261,6 @@ data IOException ioe_errno :: Maybe CInt, -- errno leading to this error, if any. ioe_filename :: Maybe FilePath -- filename the error is related to. } - deriving Typeable instance Exception IOException diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 610c9ea949..edce50003d 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -2,7 +2,6 @@ {-# LANGUAGE CPP , NoImplicitPrelude , BangPatterns - , AutoDeriveTypeable #-} {-# OPTIONS_GHC -fno-warn-identities #-} -- Whether there are identities depends on the platform @@ -35,7 +34,6 @@ import GHC.Num import GHC.Real import GHC.Show import GHC.Enum -import Data.Typeable import GHC.IO import GHC.IO.IOMode @@ -84,7 +82,6 @@ data FD = FD { fdIsNonBlocking :: {-# UNPACK #-} !Int #endif } - deriving Typeable #ifdef mingw32_HOST_OS fdIsSocket :: FD -> Bool diff --git a/libraries/base/GHC/IO/Handle/Types.hs b/libraries/base/GHC/IO/Handle/Types.hs index 4187499317..c784c5c506 100644 --- a/libraries/base/GHC/IO/Handle/Types.hs +++ b/libraries/base/GHC/IO/Handle/Types.hs @@ -2,7 +2,6 @@ {-# LANGUAGE CPP , NoImplicitPrelude , ExistentialQuantification - , AutoDeriveTypeable #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} @@ -109,8 +108,6 @@ data Handle !(MVar Handle__) -- The read side !(MVar Handle__) -- The write side - deriving Typeable - -- NOTES: -- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be -- seekable. @@ -138,7 +135,6 @@ data Handle__ haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a -- duplex handle. } - deriving Typeable -- we keep a few spare buffers around in a handle to avoid allocating -- a new one for each hPutStr. These buffers are *guaranteed* to be the diff --git a/libraries/base/GHC/IOArray.hs b/libraries/base/GHC/IOArray.hs index 6c925d3b2f..f089cad933 100644 --- a/libraries/base/GHC/IOArray.hs +++ b/libraries/base/GHC/IOArray.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE NoImplicitPrelude, AutoDeriveTypeable, RoleAnnotations #-} +{-# LANGUAGE NoImplicitPrelude, RoleAnnotations #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} @@ -27,7 +27,6 @@ module GHC.IOArray ( import GHC.Base import GHC.IO import GHC.Arr -import Data.Typeable.Internal -- --------------------------------------------------------------------------- -- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad. @@ -39,7 +38,7 @@ import Data.Typeable.Internal -- -- -newtype IOArray i e = IOArray (STArray RealWorld i e) deriving( Typeable ) +newtype IOArray i e = IOArray (STArray RealWorld i e) -- index type should have a nominal role due to Ix class. See also #9220. type role IOArray nominal representational diff --git a/libraries/base/GHC/IORef.hs b/libraries/base/GHC/IORef.hs index 154c30cd8d..a0ed0823ed 100644 --- a/libraries/base/GHC/IORef.hs +++ b/libraries/base/GHC/IORef.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE NoImplicitPrelude, MagicHash, AutoDeriveTypeable #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} @@ -25,13 +25,12 @@ module GHC.IORef ( import GHC.Base import GHC.STRef import GHC.IO -import Data.Typeable.Internal( Typeable ) -- --------------------------------------------------------------------------- -- IORefs -- |A mutable variable in the 'IO' monad -newtype IORef a = IORef (STRef RealWorld a) deriving( Typeable ) +newtype IORef a = IORef (STRef RealWorld a) -- explicit instance because Haddock can't figure out a derived one instance Eq (IORef a) where diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs index f9d5bbecc1..c2bb9ab7e5 100644 --- a/libraries/base/GHC/Int.hs +++ b/libraries/base/GHC/Int.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples, - StandaloneDeriving, AutoDeriveTypeable, NegativeLiterals #-} + StandaloneDeriving, NegativeLiterals #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -39,8 +39,6 @@ import GHC.Read import GHC.Arr import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#) import GHC.Show -import Data.Typeable - ------------------------------------------------------------------------ -- type Int8 @@ -49,7 +47,7 @@ import Data.Typeable -- Int8 is represented in the same way as Int. Operations may assume -- and must ensure that it holds only values from its logical range. -data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# deriving (Eq, Ord, Typeable) +data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# deriving (Eq, Ord) -- ^ 8-bit signed integer type instance Show Int8 where @@ -210,7 +208,7 @@ instance FiniteBits Int8 where -- Int16 is represented in the same way as Int. Operations may assume -- and must ensure that it holds only values from its logical range. -data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# deriving (Eq, Ord, Typeable) +data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# deriving (Eq, Ord) -- ^ 16-bit signed integer type instance Show Int16 where @@ -376,7 +374,7 @@ instance FiniteBits Int16 where -- from its logical range. #endif -data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Eq, Ord, Typeable) +data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Eq, Ord) -- ^ 32-bit signed integer type instance Show Int32 where @@ -553,7 +551,7 @@ instance Ix Int32 where #if WORD_SIZE_IN_BITS < 64 -data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# deriving( Typeable ) +data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# -- ^ 64-bit signed integer type instance Eq Int64 where @@ -728,7 +726,7 @@ a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# -- Operations may assume and must ensure that it holds only values -- from its logical range. -data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# deriving (Eq, Ord, Typeable) +data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# deriving (Eq, Ord) -- ^ 64-bit signed integer type instance Show Int64 where diff --git a/libraries/base/GHC/MVar.hs b/libraries/base/GHC/MVar.hs index a5054cc8fe..911c024128 100644 --- a/libraries/base/GHC/MVar.hs +++ b/libraries/base/GHC/MVar.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, AutoDeriveTypeable #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} @@ -33,9 +33,8 @@ module GHC.MVar ( ) where import GHC.Base -import Data.Typeable -data MVar a = MVar (MVar# RealWorld a) deriving( Typeable ) +data MVar a = MVar (MVar# RealWorld a) {- ^ An 'MVar' (pronounced \"em-var\") is a synchronising variable, used for communication between concurrent threads. It can be thought of diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index 71e3498f2c..23296604c6 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} diff --git a/libraries/base/GHC/Stable.hs b/libraries/base/GHC/Stable.hs index 1f30194e65..4ccfd04877 100644 --- a/libraries/base/GHC/Stable.hs +++ b/libraries/base/GHC/Stable.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE NoImplicitPrelude - , DeriveDataTypeable , MagicHash , UnboxedTuples #-} @@ -31,7 +30,6 @@ module GHC.Stable ( import GHC.Ptr import GHC.Base -import Data.Typeable.Internal ----------------------------------------------------------------------------- -- Stable Pointers @@ -48,7 +46,6 @@ A value of type @StablePtr a@ is a stable pointer to a Haskell expression of type @a@. -} data {-# CTYPE "HsStablePtr" #-} StablePtr a = StablePtr (StablePtr# a) - deriving( Typeable ) -- | -- Create a stable pointer referring to the given Haskell value. diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index ab7998402f..302d027c0a 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ExistentialQuantification #-} @@ -41,7 +40,6 @@ module GHC.StaticPtr , staticPtrKeys ) where -import Data.Typeable (Typeable) import Foreign.C.Types (CInt(..)) import Foreign.Marshal (allocaArray, peekArray, withArray) import Foreign.Ptr (castPtr) @@ -52,7 +50,6 @@ import GHC.Fingerprint (Fingerprint(..)) -- | A reference to a value of type 'a'. data StaticPtr a = StaticPtr StaticKey StaticPtrInfo a - deriving Typeable -- | Dereferences a static pointer. deRefStaticPtr :: StaticPtr a -> a @@ -96,7 +93,7 @@ data StaticPtrInfo = StaticPtrInfo -- @(Line, Column)@ pair. , spInfoSrcLoc :: (Int, Int) } - deriving (Show, Typeable) + deriving (Show) -- | 'StaticPtrInfo' of the given 'StaticPtr'. staticPtrInfo :: StaticPtr a -> StaticPtrInfo diff --git a/libraries/base/GHC/Weak.hs b/libraries/base/GHC/Weak.hs index 77c93a5651..6d4d80eb72 100644 --- a/libraries/base/GHC/Weak.hs +++ b/libraries/base/GHC/Weak.hs @@ -3,7 +3,6 @@ , BangPatterns , MagicHash , UnboxedTuples - , DeriveDataTypeable , StandaloneDeriving #-} {-# OPTIONS_HADDOCK hide #-} @@ -31,7 +30,6 @@ module GHC.Weak ( ) where import GHC.Base -import Data.Typeable {-| A weak pointer object with a key and a value. The value has type @v@. @@ -91,7 +89,7 @@ finalizer to the box itself fails when the outer box is optimised away by the compiler. -} -data Weak v = Weak (Weak# v) deriving Typeable +data Weak v = Weak (Weak# v) -- | Establishes a weak pointer to @k@, with value @v@ and a finalizer. -- diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs index 56f815cf33..6967017780 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/System/Mem/StableName.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE MagicHash #-} #if !defined(__PARALLEL_HASKELL__) {-# LANGUAGE UnboxedTuples #-} @@ -38,8 +38,6 @@ module System.Mem.StableName ( eqStableName ) where -import Data.Typeable - import GHC.IO ( IO(..) ) import GHC.Base ( Int(..), StableName#, makeStableName# , eqStableName#, stableNameToInt# ) @@ -76,7 +74,6 @@ import GHC.Base ( Int(..), StableName#, makeStableName# -} data StableName a = StableName (StableName# a) - deriving Typeable -- | Makes a 'StableName' for an arbitrary object. The object passed as -- the first argument is not evaluated by 'makeStableName'. diff --git a/libraries/base/System/Posix/Types.hs b/libraries/base/System/Posix/Types.hs index 8b95699b27..c2ac65e7e0 100644 --- a/libraries/base/System/Posix/Types.hs +++ b/libraries/base/System/Posix/Types.hs @@ -4,7 +4,7 @@ , MagicHash , GeneralizedNewtypeDeriving #-} -{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -92,7 +92,6 @@ module System.Posix.Types ( import Foreign import Foreign.C -import Data.Typeable -- import Data.Bits import GHC.Base diff --git a/libraries/base/System/Timeout.hs b/libraries/base/System/Timeout.hs index 73b5910360..c20950f357 100644 --- a/libraries/base/System/Timeout.hs +++ b/libraries/base/System/Timeout.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} ------------------------------------------------------------------------------- -- | @@ -29,14 +29,13 @@ import Control.Exception (Exception(..), handleJust, bracket, uninterruptibleMask_, asyncExceptionToException, asyncExceptionFromException) -import Data.Typeable import Data.Unique (Unique, newUnique) -- An internal type that is thrown as a dynamic exception to -- interrupt the running IO computation when the timeout has -- expired. -newtype Timeout = Timeout Unique deriving (Eq, Typeable) +newtype Timeout = Timeout Unique deriving (Eq) instance Show Timeout where show _ = "<<timeout>>" diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index f133fbeb0e..3d6021f636 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -60,7 +60,6 @@ Flag integer-gmp2 Library default-language: Haskell2010 other-extensions: - AutoDeriveTypeable BangPatterns CApiFFI CPP diff --git a/libraries/base/include/CTypes.h b/libraries/base/include/CTypes.h index ec1813152f..d821d66b5b 100644 --- a/libraries/base/include/CTypes.h +++ b/libraries/base/include/CTypes.h @@ -16,7 +16,7 @@ -- // GHC can derive any class for a newtype, so we make use of that here... -#define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real,Typeable +#define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real #define INTEGRAL_CLASSES Bounded,Integral,Bits,FiniteBits #define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat diff --git a/libraries/base/tests/IO/T4144.hs b/libraries/base/tests/IO/T4144.hs index ca14363682..329601ca38 100644 --- a/libraries/base/tests/IO/T4144.hs +++ b/libraries/base/tests/IO/T4144.hs @@ -33,7 +33,6 @@ data BSIODevice = BSIODevice ByteString (MVar Int) -- Position - deriving Typeable newBsDevice :: ByteString -> IO BSIODevice newBsDevice bs = BSIODevice bs <$> newMVar 0 diff --git a/libraries/base/tests/foldableArray.hs b/libraries/base/tests/foldableArray.hs index 9c8757176f..c5699f240f 100644 --- a/libraries/base/tests/foldableArray.hs +++ b/libraries/base/tests/foldableArray.hs @@ -19,7 +19,7 @@ import qualified Data.List as L import qualified GHC.List as L #endif -data BadElementException = BadFirst | BadLast deriving (Show, Typeable, Eq) +data BadElementException = BadFirst | BadLast deriving (Show, Eq) instance Exception BadElementException newtype ForceDefault f a = ForceDefault (f a) |