Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
93b6e532
Commit
93b6e532
authored
Apr 24, 2011
by
Ian Lynagh
Browse files
Derive some Typeable instances
We were using the Typeable.hs macros, but for no good reason as far as I can tell.
parent
62b8059e
Changes
7
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/Module.lhs
View file @
93b6e532
...
...
@@ -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"
...
...
compiler/basicTypes/Name.lhs
View file @
93b6e532
...
...
@@ -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"
...
...
compiler/basicTypes/NameSet.lhs
View file @
93b6e532
...
...
@@ -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
...
...
compiler/basicTypes/OccName.lhs
View file @
93b6e532
...
...
@@ -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"
...
...
compiler/basicTypes/SrcLoc.lhs
View file @
93b6e532
...
...
@@ -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
...
...
compiler/basicTypes/Var.lhs
View file @
93b6e532
...
...
@@ -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"
...
...
compiler/utils/Bag.lhs
View file @
93b6e532
...
...
@@ -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))++")"
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment