diff options
-rw-r--r-- | compiler/basicTypes/DataCon.lhs | 5 | ||||
-rw-r--r-- | compiler/basicTypes/NameSet.lhs | 18 | ||||
-rw-r--r-- | compiler/main/HscTypes.lhs | 21 | ||||
-rw-r--r-- | compiler/types/Class.lhs | 5 | ||||
-rw-r--r-- | compiler/types/TyCon.lhs | 9 | ||||
-rw-r--r-- | compiler/utils/Panic.lhs | 10 | ||||
-rw-r--r-- | compiler/utils/UniqFM.lhs | 3 |
7 files changed, 17 insertions, 54 deletions
diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index 312ae943a8..6e02ed9f0a 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -56,6 +56,7 @@ import FastString import Module import qualified Data.Data as Data +import qualified Data.Typeable import Data.Char import Data.Word \end{code} @@ -374,6 +375,7 @@ data DataCon -- Used for Template Haskell and 'deriving' only -- The actual fixity is stored elsewhere } + deriving Data.Typeable.Typeable -- | Contains the Ids of the data constructor functions data DataConIds @@ -456,9 +458,6 @@ instance Outputable DataCon where instance Show DataCon where showsPrec p con = showsPrecSDoc p (ppr con) -instance Data.Typeable DataCon where - typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") [] - instance Data.Data DataCon where -- don't traverse? toConstr _ = abstractConstr "DataCon" diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs index bef9e928fd..ebb5b9fd86 100644 --- a/compiler/basicTypes/NameSet.lhs +++ b/compiler/basicTypes/NameSet.lhs @@ -34,9 +34,6 @@ module NameSet ( import Name import UniqSet -import Util - -import Data.Data \end{code} %************************************************************************ @@ -48,20 +45,7 @@ import Data.Data \begin{code} type NameSet = UniqSet Name --- TODO: These Data/Typeable instances look very dubious. Surely either --- UniqFM should have the instances, or this should be a newtype? - -nameSetTc :: TyCon -nameSetTc = mkTyCon "NameSet" -instance Typeable NameSet where { typeOf _ = mkTyConApp nameSetTc [] } - -instance Data NameSet where - gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly - toConstr _ = abstractConstr "NameSet" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNoRepType "NameSet" - -emptyNameSet :: NameSet +emptyNameSet :: NameSet unitNameSet :: Name -> NameSet addListToNameSet :: NameSet -> [Name] -> NameSet addOneToNameSet :: NameSet -> Name -> NameSet diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 7f43414111..69fc3e3807 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -147,8 +147,6 @@ import FastString import StringBuffer ( StringBuffer ) import Fingerprint import MonadUtils -import Data.Dynamic ( Typeable ) -import qualified Data.Dynamic as Dyn import Bag import ErrUtils @@ -161,6 +159,7 @@ import Data.Map (Map) import Data.Word import Control.Monad ( mplus, guard, liftM, when ) import Exception +import Data.Typeable ( Typeable ) -- ----------------------------------------------------------------------------- -- Source Errors @@ -191,18 +190,13 @@ throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err -- -- See 'printExceptionAndWarnings' for more information on what to take care -- of when writing a custom error handler. -data SourceError = SourceError ErrorMessages +newtype SourceError = SourceError ErrorMessages + deriving Typeable instance Show SourceError where show (SourceError msgs) = unlines . map show . bagToList $ msgs -- ToDo: is there some nicer way to print this? -sourceErrorTc :: Dyn.TyCon -sourceErrorTc = Dyn.mkTyCon "SourceError" -{-# NOINLINE sourceErrorTc #-} -instance Typeable SourceError where - typeOf _ = Dyn.mkTyConApp sourceErrorTc [] - instance Exception SourceError mkSrcErr = SourceError @@ -219,17 +213,12 @@ handleSourceError handler act = srcErrorMessages (SourceError msgs) = msgs -- | XXX: what exactly is an API error? -data GhcApiError = GhcApiError SDoc +newtype GhcApiError = GhcApiError SDoc + deriving Typeable instance Show GhcApiError where show (GhcApiError msg) = showSDoc msg -ghcApiErrorTc :: Dyn.TyCon -ghcApiErrorTc = Dyn.mkTyCon "GhcApiError" -{-# NOINLINE ghcApiErrorTc #-} -instance Typeable GhcApiError where - typeOf _ = Dyn.mkTyConApp ghcApiErrorTc [] - instance Exception GhcApiError mkApiErr = GhcApiError diff --git a/compiler/types/Class.lhs b/compiler/types/Class.lhs index 8f8ff3bd5a..6489a2fdac 100644 --- a/compiler/types/Class.lhs +++ b/compiler/types/Class.lhs @@ -33,6 +33,7 @@ import Util import Outputable import FastString +import Data.Typeable hiding (TyCon) import qualified Data.Data as Data \end{code} @@ -69,6 +70,7 @@ data Class classTyCon :: TyCon -- The data type constructor for -- dictionaries of this class } + deriving Typeable type FunDep a = ([a],[a]) -- e.g. class C a b c | a b -> c, a c -> b where... -- Here fun-deps are [([a,b],[c]), ([a,c],[b])] @@ -214,9 +216,6 @@ pprFundeps fds = hsep (ptext (sLit "|") : punctuate comma (map pprFunDep fds)) pprFunDep :: Outputable a => FunDep a -> SDoc pprFunDep (us, vs) = hsep [interppSP us, ptext (sLit "->"), interppSP vs] -instance Data.Typeable Class where - typeOf _ = Data.mkTyConApp (Data.mkTyCon "Class") [] - instance Data.Data Class where -- don't traverse? toConstr _ = abstractConstr "Class" diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 915207621f..895dd3a7f3 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -96,6 +96,7 @@ import FastString import Constants import Util import qualified Data.Data as Data +import Data.Typeable hiding (TyCon) \end{code} ----------------------------------------------- @@ -416,6 +417,7 @@ data TyCon tyConUnique :: Unique, tyConName :: Name } + deriving Typeable -- | Names of the fields in an algebraic record type type FieldLabel = Name @@ -685,6 +687,7 @@ data CoAxiom , co_ax_lhs :: Type -- left-hand side of the equality , co_ax_rhs :: Type -- right-hand side of the equality } + deriving Typeable coAxiomArity :: CoAxiom -> Arity coAxiomArity ax = length (co_ax_tvs ax) @@ -1380,9 +1383,6 @@ instance Outputable TyCon where instance NamedThing TyCon where getName = tyConName -instance Data.Typeable TyCon where - typeOf _ = Data.mkTyConApp (Data.mkTyCon "TyCon") [] - instance Data.Data TyCon where -- don't traverse? toConstr _ = abstractConstr "TyCon" @@ -1410,9 +1410,6 @@ instance Outputable CoAxiom where instance NamedThing CoAxiom where getName = co_ax_name -instance Data.Typeable CoAxiom where - typeOf _ = Data.mkTyConApp (Data.mkTyCon "CoAxiom") [] - instance Data.Data CoAxiom where -- don't traverse? toConstr _ = abstractConstr "CoAxiom" diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index d430df695e..1fd815604c 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -78,7 +78,7 @@ data GhcException -- | An error in the user's code, probably. | ProgramError String - deriving Eq + deriving (Typeable, Eq) instance Exception GhcException @@ -87,9 +87,6 @@ instance Show GhcException where showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e showsPrec _ e = showString progName . showString ": " . showGhcException e -instance Typeable GhcException where - typeOf _ = mkTyConApp ghcExceptionTc [] - -- | The name of this GHC. progName :: String @@ -154,11 +151,6 @@ handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a handleGhcException = ghandle -ghcExceptionTc :: TyCon -ghcExceptionTc = mkTyCon "GhcException" -{-# NOINLINE ghcExceptionTc #-} - - -- | Panics and asserts. panic, sorry, pgmError :: String -> a panic x = throwGhcException (Panic x) diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs index 9c9fdc9bc4..7cbc3dbcfb 100644 --- a/compiler/utils/UniqFM.lhs +++ b/compiler/utils/UniqFM.lhs @@ -67,6 +67,8 @@ import Compiler.Hoopl hiding (Unique) import Data.Function (on) import qualified Data.IntMap as M import qualified Data.Foldable as Foldable +import Data.Typeable +import Data.Data \end{code} %************************************************************************ @@ -164,6 +166,7 @@ ufmToList :: UniqFM elt -> [(Unique, elt)] \begin{code} newtype UniqFM ele = UFM { unUFM :: M.IntMap ele } + deriving (Typeable,Data) instance Eq ele => Eq (UniqFM ele) where (==) = (==) `on` unUFM |