Derive some Typeable instances

We were using the Typeable.hs macros, but for no good reason as
far as I can tell.

diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index c4bdba2..03f541e 100644 (file)
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -155,6 +155,7 @@ addBootSuffixLocn locn
 \begin{code}
 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
 newtype ModuleName = ModuleName FastString
+    deriving Typeable
 
 instance Uniquable ModuleName where
   getUnique (ModuleName nm) = getUnique nm
@@ -175,8 +176,6 @@ instance Binary ModuleName where
   put_ bh (ModuleName fs) = put_ bh fs
   get bh = do fs <- get bh; return (ModuleName fs)
 
-INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
-
 instance Data ModuleName where
   -- don't traverse?
   toConstr _   = abstractConstr "ModuleName"
@@ -224,7 +223,7 @@ data Module = Module {
    modulePackageId :: !PackageId,  -- pkg-1.0
    moduleName      :: !ModuleName  -- A.B.C
   }
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Typeable)
 
 instance Uniquable Module where
   getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
@@ -236,8 +235,6 @@ instance Binary Module where
   put_ bh (Module p n) = put_ bh p >> put_ bh n
   get bh = do p <- get bh; n <- get bh; return (Module p n)
 
-INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
-
 instance Data Module where
   -- don't traverse?
   toConstr _   = abstractConstr "Module"
@@ -280,7 +277,7 @@ pprPackagePrefix p mod = getPprStyle doc
 
 \begin{code}
 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
-newtype PackageId = PId FastString deriving( Eq )
+newtype PackageId = PId FastString deriving( Eq, Typeable )
     -- here to avoid module loops with PackageConfig
 
 instance Uniquable PackageId where
@@ -291,8 +288,6 @@ instance Uniquable PackageId where
 instance Ord PackageId where
   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 
-INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
-
 instance Data PackageId where
   -- don't traverse?
   toConstr _   = abstractConstr "PackageId"

diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs
index 70cf298..f2ae963 100644 (file)
--- a/compiler/basicTypes/Name.lhs
+++ b/compiler/basicTypes/Name.lhs
@@ -106,6 +106,7 @@ data Name = Name {
 --(note later when changing Int# -> FastInt: is that still true about UNPACK?)
                n_loc  :: !SrcSpan      -- Definition site
            }
+    deriving Typeable
 
 -- NOTE: we make the n_loc field strict to eliminate some potential
 -- (and real!) space leaks, due to the fact that we don't look at
@@ -363,8 +364,6 @@ instance Uniquable Name where
 instance NamedThing Name where
     getName n = n
 
-INSTANCE_TYPEABLE0(Name,nameTc,"Name")
-
 instance Data Name where
   -- don't traverse?
   toConstr _   = abstractConstr "Name"

diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs
index e2acaf7..a20d8ab 100644 (file)
--- a/compiler/basicTypes/NameSet.lhs
+++ b/compiler/basicTypes/NameSet.lhs
@@ -48,7 +48,12 @@ import Data.Data
 \begin{code}
 type NameSet = UniqSet Name
 
-INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet")
+-- 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

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index f02ae8d..5489ea7 100644 (file)
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -209,6 +209,7 @@ data OccName = OccName
     { occNameSpace  :: !NameSpace
     , occNameFS     :: !FastString
     }
+    deriving Typeable
 \end{code}
 
 
@@ -221,8 +222,6 @@ instance Ord OccName where
     compare (OccName sp1 s1) (OccName sp2 s2) 
        = (s1  `compare` s2) `thenCmp` (sp1 `compare` sp2)
 
-INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName")
-
 instance Data OccName where
   -- don't traverse?
   toConstr _   = abstractConstr "OccName"

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 5dcdabe..d2cbd7f 100644 (file)
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -185,8 +185,6 @@ instance Outputable SrcLoc where
 
     ppr (UnhelpfulLoc s)  = ftext s
 
-INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")
-
 instance Data SrcSpan where
   -- don't traverse?
   toConstr _   = abstractConstr "SrcSpan"
@@ -237,10 +235,10 @@ data SrcSpan
                                -- also used to indicate an empty span
 
 #ifdef DEBUG
-  deriving (Eq, Show)  -- Show is used by Lexer.x, becuase we
-                       -- derive Show for Token
+  deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we
+                                -- derive Show for Token
 #else
-  deriving Eq
+  deriving (Eq, Typeable)
 #endif
 
 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty

diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs
index ec83494..bca185f 100644 (file)
--- a/compiler/basicTypes/Var.lhs
+++ b/compiler/basicTypes/Var.lhs
@@ -155,6 +155,7 @@ data Var
        idScope    :: IdScope,
        id_details :: IdDetails,        -- Stable, doesn't change
        id_info    :: IdInfo }          -- Unstable, updated by simplifier
+    deriving Typeable
 
 data IdScope   -- See Note [GlobalId/LocalId]
   = GlobalId 
@@ -216,8 +217,6 @@ instance Ord Var where
     a >         b = realUnique a >#  realUnique b
     a `compare` b = varUnique a `compare` varUnique b
 
-INSTANCE_TYPEABLE0(Var,varTc,"Var")
-
 instance Data Var where
   -- don't traverse?
   toConstr _   = abstractConstr "Var"

diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs
index 097a112..700878a 100644 (file)
--- a/compiler/utils/Bag.lhs
+++ b/compiler/utils/Bag.lhs
@@ -41,6 +41,7 @@ data Bag a
   | UnitBag a
   | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty
   | ListBag [a]             -- INVARIANT: the list is non-empty
+    deriving Typeable
 
 emptyBag :: Bag a
 emptyBag = EmptyBag
@@ -262,8 +263,6 @@ bagToList b = foldrBag (:) [] b
 instance (Outputable a) => Outputable (Bag a) where
     ppr bag = braces (pprWithCommas ppr (bagToList bag))
 
-INSTANCE_TYPEABLE1(Bag,bagTc,"Bag")
-
 instance Data a => Data (Bag a) where
   gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly
   toConstr _   = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")"