VersionInfo(..), initialVersionInfo,
- TyThing(..), isTyClThing,
+ TyThing(..), isTyClThing, implicitTyThingIds,
TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList,
typeEnvClasses, typeEnvTyCons,
- WhetherHasOrphans, ImportVersion, WhatsImported(..),
+ ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
- IfaceInsts, IfaceRules, GatedDecl,
- OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
+ IfaceInsts, IfaceRules, GatedDecl, IsExported,
+ NameSupply(..), OrigNameCache, OrigIParamCache,
AvailEnv, AvailInfo, GenAvailInfo(..),
PersistentCompilerState(..),
InstEnv, ClsInstEnv, DFunId,
PackageInstEnv, PackageRuleBase,
- GlobalRdrEnv, RdrAvailInfo,
+ GlobalRdrEnv, RdrAvailInfo, pprGlobalRdrEnv,
-- Provenance
- Provenance(..), ImportReason(..), PrintUnqualified,
+ Provenance(..), ImportReason(..),
pprNameProvenance, hasBetterProv
) where
#include "HsVersions.h"
-import RdrName ( RdrNameEnv, emptyRdrEnv )
-import Name ( Name, NamedThing, isLocallyDefined,
- getName, nameModule, nameSrcLoc )
+import RdrName ( RdrNameEnv, emptyRdrEnv, rdrEnvToList )
+import Name ( Name, NamedThing, getName, nameModule, nameSrcLoc )
import Name -- Env
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
import InstEnv ( InstEnv, ClsInstEnv, DFunId )
import Rules ( RuleBase )
import Id ( Id )
-import Class ( Class )
-import TyCon ( TyCon )
+import Class ( Class, classSelIds )
+import TyCon ( TyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
+import DataCon ( dataConId, dataConWrapId )
import BasicTypes ( Version, initialVersion, Fixity )
dcl_rules = sortLt lt_rule rules,
dcl_insts = insts }
where
- d1 `lt_tycl` d2 = nameOccName (tyClDeclName d1) < nameOccName (tyClDeclName d2)
- r1 `lt_rule` r2 = nameOccName (ifaceRuleDeclName r1) < nameOccName (ifaceRuleDeclName r2)
-
- -- I wanted to sort just by the Name, but there's a problem: we are comparing
- -- the old version of an interface with the new version. The latter will use
- -- local names like 'lvl23' that were constructed not by the renamer but by
- -- the simplifier. So the unqiues aren't going to line up.
- --
- -- It's ok to compare by OccName because this comparison only drives the
- -- computation of new version numbers.
- --
- -- Better solutions: Compare in a way that is insensitive to the name used
- -- for local things. This would decrease the wobbles due
- -- to 'lvl23' changing to 'lvl24'.
- --
- -- NB: there's a related comparision on MkIface.diffDecls!
-
-
+ d1 `lt_tycl` d2 = tyClDeclName d1 < tyClDeclName d2
+ r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2
-- typechecker should only look at this, not ModIface
Simple lookups in the symbol table.
\begin{code}
-lookupIface :: HomeIfaceTable -> PackageIfaceTable
- -> Module -> Name -- The module is to use for locally-defined names
- -> Maybe ModIface
+lookupIface :: HomeIfaceTable -> PackageIfaceTable -> Name -> Maybe ModIface
-- We often have two IfaceTables, and want to do a lookup
-lookupIface hit pit this_mod name
- | isLocallyDefined name = lookupModuleEnv hit this_mod
- | otherwise = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
+lookupIface hit pit name
+ = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
where
mod = nameModule name
-lookupIfaceByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
--- We often have two Symbol- or IfaceTables, and want to do a lookup
-lookupIfaceByModName ht pt mod
- = lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod
+lookupIfaceByModName :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
+-- We often have two IfaceTables, and want to do a lookup
+lookupIfaceByModName hit pit mod
+ = lookupModuleEnvByName hit mod `seqMaybe` lookupModuleEnvByName pit mod
\end{code}
getName (ATyCon tc) = getName tc
getName (AClass cl) = getName cl
+instance Outputable TyThing where
+ ppr (AnId id) = ptext SLIT("AnId") <+> ppr id
+ ppr (ATyCon tc) = ptext SLIT("ATyCon") <+> ppr tc
+ ppr (AClass cl) = ptext SLIT("AClass") <+> ppr cl
+
typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
typeEnvTyCons env = [tc | ATyCon tc <- nameEnvElts env]
+implicitTyThingIds :: [TyThing] -> [Id]
+-- Add the implicit data cons and selectors etc
+implicitTyThingIds things
+ = concat (map go things)
+ where
+ go (AnId f) = []
+ go (AClass cl) = classSelIds cl
+ go (ATyCon tc) = tyConGenIds tc ++
+ tyConSelIds tc ++
+ [ n | dc <- tyConDataConsIfAvailable tc,
+ n <- [dataConId dc, dataConWrapId dc] ]
+ -- Synonyms return empty list of constructors and selectors
\end{code}
\begin{code}
lookupType :: HomeSymbolTable -> PackageTypeEnv -> Name -> Maybe TyThing
lookupType hst pte name
- = ASSERT2( not (isLocallyDefined name), ppr name )
- case lookupModuleEnv hst (nameModule name) of
+ = case lookupModuleEnv hst (nameModule name) of
Just details -> lookupNameEnv (md_types details) name
Nothing -> lookupNameEnv pte name
\end{code}
-- we imported the module without saying exactly what we imported
-- We need to recompile if the module exports changes, because we might
-- now have a name clash in the importing module.
+
+type IsExported = Name -> Bool -- True for names that are exported from this module
\end{code}
type PackageInstEnv = InstEnv
data PersistentRenamerState
- = PRS { prsOrig :: OrigNameEnv,
- prsDecls :: DeclsMap,
- prsInsts :: IfaceInsts,
- prsRules :: IfaceRules,
- prsNS :: UniqSupply
+ = PRS { prsOrig :: NameSupply,
+ prsImpMods :: ImportedModuleInfo,
+ prsDecls :: DeclsMap,
+ prsInsts :: IfaceInsts,
+ prsRules :: IfaceRules
}
\end{code}
-The OrigNameEnv makes sure that there is just one Unique assigned for
+The NameSupply makes sure that there is just one Unique assigned for
each original name; i.e. (module-name, occ-name) pair. The Name is
always stored as a Global, and has the SrcLoc of its binding location.
Actually that's not quite right. When we first encounter the original
we just store junk. Then when we find the binding site, we fix it up.
\begin{code}
-data OrigNameEnv
- = Orig { origNames :: OrigNameNameEnv,
+data NameSupply
+ = NameSupply { nsUniqs :: UniqSupply,
+ -- Supply of uniques
+ nsNames :: OrigNameCache,
-- Ensures that one original name gets one unique
- origIParam :: OrigNameIParamEnv
+ nsIPs :: OrigIParamCache
-- Ensures that one implicit parameter name gets one unique
}
-type OrigNameNameEnv = FiniteMap (ModuleName,OccName) Name
-type OrigNameIParamEnv = FiniteMap OccName Name
+type OrigNameCache = FiniteMap (ModuleName,OccName) Name
+type OrigIParamCache = FiniteMap OccName Name
\end{code}
+@ImportedModuleInfo@ contains info ONLY about modules that have not yet
+been loaded into the iPIT. These modules are mentioned in interfaces we've
+already read, so we know a tiny bit about them, but we havn't yet looked
+at the interface file for the module itself. It needs to persist across
+invocations of the renamer, at least from Rename.checkOldIface to Rename.renameSource.
+And there's no harm in it persisting across multiple compilations.
+
+\begin{code}
+type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface)
+\end{code}
A DeclsMap contains a binding for each Name in the declaration
including the constructors of a type decl etc. The Bool is True just
type GlobalRdrEnv = RdrNameEnv [(Name,Provenance)] -- The list is because there may be name clashes
-- These only get reported on lookup,
-- not on construction
+
+pprGlobalRdrEnv env
+ = vcat (map pp (rdrEnvToList env))
+ where
+ pp (rn, nps) = ppr rn <> colon <+>
+ vcat [ppr n <+> pprNameProvenance n p | (n,p) <- nps]
\end{code}
The "provenance" of something says how it came to be in scope.
| NonLocalDef -- Defined non-locally
ImportReason
- PrintUnqualified
-- Just used for grouping error messages (in RnEnv.warnUnusedBinds)
instance Eq Provenance where
instance Ord Provenance where
compare LocalDef LocalDef = EQ
- compare LocalDef (NonLocalDef _ _) = LT
- compare (NonLocalDef _ _) LocalDef = GT
+ compare LocalDef (NonLocalDef _) = LT
+ compare (NonLocalDef _) LocalDef = GT
- compare (NonLocalDef reason1 _) (NonLocalDef reason2 _)
+ compare (NonLocalDef reason1) (NonLocalDef reason2)
= compare reason1 reason2
instance Ord ImportReason where
-- This info is used when warning of unused names.
| ImplicitImport -- Imported implicitly for some other reason
-
-
-type PrintUnqualified = Bool -- True <=> the unqualified name of this thing is
- -- in scope in this module, so print it
- -- unqualified in error messages
\end{code}
\begin{code}
-- a local thing over an imported thing
-- a user-imported thing over a non-user-imported thing
-- an explicitly-imported thing over an implicitly imported thing
-hasBetterProv LocalDef _ = True
-hasBetterProv (NonLocalDef (UserImport _ _ True) _) _ = True
-hasBetterProv (NonLocalDef (UserImport _ _ _ ) _) (NonLocalDef ImplicitImport _) = True
-hasBetterProv _ _ = False
+hasBetterProv LocalDef _ = True
+hasBetterProv (NonLocalDef (UserImport _ _ _ )) (NonLocalDef ImplicitImport) = True
+hasBetterProv _ _ = False
pprNameProvenance :: Name -> Provenance -> SDoc
-pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
-pprNameProvenance name (NonLocalDef why _) = sep [ppr_reason why,
- nest 2 (parens (ppr_defn (nameSrcLoc name)))]
+pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
+pprNameProvenance name (NonLocalDef why) = sep [ppr_reason why,
+ nest 2 (parens (ppr_defn (nameSrcLoc name)))]
ppr_reason ImplicitImport = ptext SLIT("implicitly imported")
ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc