lookupIface, lookupIfaceByModName,
emptyModIface,
- IfaceDecls(..),
+ IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
VersionInfo(..), initialVersionInfo,
- TyThing(..), isTyClThing,
+ TyThing(..), isTyClThing, implicitTyThingIds,
TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList,
typeEnvClasses, typeEnvTyCons,
WhetherHasOrphans, ImportVersion, WhatsImported(..),
PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
- IfaceInsts, IfaceRules, GatedDecl,
+ IfaceInsts, IfaceRules, GatedDecl, IsExported,
OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
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 )
-import HsSyn ( DeprecTxt )
+import HsSyn ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
import Maybes ( seqMaybe )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
-import Util ( thenCmp )
+import Util ( thenCmp, sortLt )
import UniqSupply ( UniqSupply )
\end{code}
dcl_rules :: [RenamedRuleDecl], -- Sorted
dcl_insts :: [RenamedInstDecl] } -- Unsorted
+mkIfaceDecls :: [RenamedTyClDecl] -> [RenamedRuleDecl] -> [RenamedInstDecl] -> IfaceDecls
+mkIfaceDecls tycls rules insts
+ = IfaceDecls { dcl_tycl = sortLt lt_tycl tycls,
+ dcl_rules = sortLt lt_rule rules,
+ dcl_insts = insts }
+ where
+ d1 `lt_tycl` d2 = tyClDeclName d1 < tyClDeclName d2
+ r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2
+
+
-- typechecker should only look at this, not ModIface
-- Should be able to construct ModDetails from mi_decls in ModIface
data ModDetails
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}
= PRS { prsOrig :: OrigNameEnv,
prsDecls :: DeclsMap,
prsInsts :: IfaceInsts,
- prsRules :: IfaceRules,
- prsNS :: UniqSupply
+ prsRules :: IfaceRules
}
\end{code}
\begin{code}
data OrigNameEnv
- = Orig { origNames :: OrigNameNameEnv,
+ = Orig { origNS :: UniqSupply,
+ -- Supply of uniques
+ origNames :: OrigNameNameEnv,
-- Ensures that one original name gets one unique
origIParam :: OrigNameIParamEnv
-- Ensures that one implicit parameter name gets one unique
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
projects / ghc-hetmet.git / blobdiff