\begin{code}
module HscTypes (
+ GhciMode(..),
+
ModuleLocation(..),
ModDetails(..), ModIface(..),
- HomeSymbolTable, PackageTypeEnv,
+ HomeSymbolTable, emptySymbolTable,
+ PackageTypeEnv,
HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
lookupIface, lookupIfaceByModName,
emptyModIface,
+ InteractiveContext(..),
+
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
- VersionInfo(..), initialVersionInfo,
+ VersionInfo(..), initialVersionInfo, lookupVersion,
- TyThing(..), isTyClThing,
+ TyThing(..), isTyClThing, implicitTyThingIds,
- TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList,
- typeEnvClasses, typeEnvTyCons,
+ TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
+ extendTypeEnvList, extendTypeEnvWithIds,
+ typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
- WhetherHasOrphans, ImportVersion, WhatsImported(..),
- PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
- IfaceInsts, IfaceRules, GatedDecl,
- OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
- AvailEnv, AvailInfo, GenAvailInfo(..),
+ ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
+ PersistentRenamerState(..), IsBootInterface, DeclsMap,
+ IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, IsExported,
+ NameSupply(..), OrigNameCache, OrigIParamCache,
+ Avails, AvailEnv, GenAvailInfo(..), AvailInfo, RdrAvailInfo,
PersistentCompilerState(..),
Deprecations(..), lookupDeprec,
InstEnv, ClsInstEnv, DFunId,
PackageInstEnv, PackageRuleBase,
- GlobalRdrEnv, RdrAvailInfo, pprGlobalRdrEnv,
+ GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv,
+ LocalRdrEnv, extendLocalRdrEnv,
+
-- Provenance
Provenance(..), ImportReason(..),
#include "HsVersions.h"
-import RdrName ( RdrNameEnv, emptyRdrEnv, rdrEnvToList )
-import Name ( Name, NamedThing, isLocallyDefined,
- getName, nameModule, nameSrcLoc )
-import Name -- Env
+import RdrName ( RdrNameEnv, addListToRdrEnv, emptyRdrEnv, mkRdrUnqual, rdrEnvToList )
+import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
+import NameEnv
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
lookupModuleEnv, lookupModuleEnvByName, emptyModuleEnv
)
import InstEnv ( InstEnv, ClsInstEnv, DFunId )
import Rules ( RuleBase )
+import CoreSyn ( CoreBind )
import Id ( Id )
-import Class ( Class )
-import TyCon ( TyCon )
+import Class ( Class, classSelIds )
+import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
+import DataCon ( dataConId, dataConWrapId )
import BasicTypes ( Version, initialVersion, Fixity )
import FiniteMap ( FiniteMap )
import Bag ( Bag )
-import Maybes ( seqMaybe )
+import Maybes ( seqMaybe, orElse )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
import Util ( thenCmp, sortLt )
%************************************************************************
%* *
+\subsection{Which mode we're in
+%* *
+%************************************************************************
+
+\begin{code}
+data GhciMode = Batch | Interactive | OneShot
+ deriving Eq
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection{Module locations}
%* *
%************************************************************************
= ModuleLocation {
ml_hs_file :: Maybe FilePath,
ml_hspp_file :: Maybe FilePath, -- path of preprocessed source
- ml_hi_file :: Maybe FilePath,
+ ml_hi_file :: FilePath,
ml_obj_file :: Maybe FilePath
}
deriving Show
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
-- The next three fields are created by the typechecker
md_types :: TypeEnv,
md_insts :: [DFunId], -- Dfun-ids for the instances in this module
- md_rules :: [IdCoreRule] -- Domain may include Ids from other modules
+ md_rules :: [IdCoreRule], -- Domain may include Ids from other modules
+ md_binds :: [CoreBind]
}
+
+-- The ModDetails takes on several slightly different forms:
+--
+-- After typecheck + desugar
+-- md_types Contains TyCons, Classes, and implicit Ids
+-- md_insts All instances from this module (incl derived ones)
+-- md_rules All rules from this module
+-- md_binds Desugared bindings
+--
+-- After simplification
+-- md_types Same as after typecheck
+-- md_insts Ditto
+-- md_rules Orphan rules only (local ones now attached to binds)
+-- md_binds With rules attached
+--
+-- After CoreTidy
+-- md_types Now contains Ids as well, replete with final IdInfo
+-- The Ids are only the ones that are visible from
+-- importing modules. Without -O that means only
+-- exported Ids, but with -O importing modules may
+-- see ids mentioned in unfoldings of exported Ids
+--
+-- md_insts Same DFunIds as before, but with final IdInfo,
+-- and the unique might have changed; remember that
+-- CoreTidy links up the uniques of old and new versions
+--
+-- md_rules All rules for exported things, substituted with final Ids
+--
+-- md_binds Tidied
+--
+-- Passed back to compilation manager
+-- Just as after CoreTidy, but with md_binds nuked
+
\end{code}
\begin{code}
-emptyModDetails :: ModDetails
-emptyModDetails
- = ModDetails { md_types = emptyTypeEnv,
- md_insts = [],
- md_rules = []
- }
-
emptyModIface :: Module -> ModIface
emptyModIface mod
= ModIface { mi_module = mod,
type HomeSymbolTable = SymbolTable -- Domain = modules in the home package
+emptySymbolTable :: SymbolTable
+emptySymbolTable = emptyModuleEnv
+
emptyIfaceTable :: IfaceTable
emptyIfaceTable = emptyModuleEnv
\end{code}
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}
+
+
+%************************************************************************
+%* *
+\subsection{The interactive context}
+%* *
+%************************************************************************
+
+\begin{code}
+data InteractiveContext
+ = InteractiveContext {
+ ic_module :: Module, -- The current module in which
+ -- the user is sitting
+
+ ic_rn_env :: LocalRdrEnv, -- Lexical context for variables bound
+ -- during interaction
+
+ ic_type_env :: TypeEnv -- Ditto for types
+ }
\end{code}
getName (ATyCon tc) = getName tc
getName (AClass cl) = getName cl
-typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
-typeEnvTyCons env = [tc | ATyCon tc <- nameEnvElts env]
+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
+
+typeEnvElts :: TypeEnv -> [TyThing]
+typeEnvClasses :: TypeEnv -> [Class]
+typeEnvTyCons :: TypeEnv -> [TyCon]
+typeEnvIds :: TypeEnv -> [Id]
+
+typeEnvElts env = nameEnvElts env
+typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
+typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
+typeEnvIds env = [id | AnId id <- typeEnvElts 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 <- implicitConIds tc dc]
+ -- Synonyms return empty list of constructors and selectors
+
+ implicitConIds tc dc -- Newtypes have a constructor wrapper,
+ -- but no worker
+ | isNewTyCon tc = [dataConWrapId dc]
+ | otherwise = [dataConId dc, dataConWrapId dc]
\end{code}
extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList env things
- = foldl add_thing env things
- where
- add_thing :: TypeEnv -> TyThing -> TypeEnv
- add_thing env thing = extendNameEnv env (getName thing) thing
+ = extendNameEnvList env [(getName thing, thing) | thing <- things]
+
+extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
+extendTypeEnvWithIds env ids
+ = extendNameEnvList env [(getName id, AnId id) | id <- ids]
\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}
-- The version of an Id changes if its fixity changes
-- Ditto data constructors, class operations, except that the version of
-- the parent class/tycon changes
+ --
+ -- If a name isn't in the map, it means 'initialVersion'
}
initialVersionInfo :: VersionInfo
initialVersionInfo = VersionInfo { vers_module = initialVersion,
vers_exports = initialVersion,
vers_rules = initialVersion,
- vers_decls = emptyNameEnv }
+ vers_decls = emptyNameEnv
+ }
+
+lookupVersion :: NameEnv Version -> Name -> Version
+lookupVersion env name = lookupNameEnv env name `orElse` initialVersion
data Deprecations = NoDeprecs
| DeprecAll DeprecTxt -- Whole module deprecated
lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of
Just (_, txt) -> Just txt
Nothing -> Nothing
+
+instance Eq Deprecations where
+ -- Used when checking whether we need write a new interface
+ NoDeprecs == NoDeprecs = True
+ (DeprecAll t1) == (DeprecAll t2) = t1 == t2
+ (DeprecSome e1) == (DeprecSome e2) = nameEnvElts e1 == nameEnvElts e2
+ d1 == d2 = False
\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}
pcs_PRS :: PersistentRenamerState
}
-
\end{code}
The @PersistentRenamerState@ persists across successive calls to the
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 IfaceRules = GatedDecls RdrNameRuleDecl
type GatedDecls d = (Bag (GatedDecl d), Int) -- The Int says how many have been sucked in
-type GatedDecl d = ([Name], (Module, d))
+type GatedDecl d = (GateFn, (Module, d))
+type GateFn = (Name -> Bool) -> Bool -- Returns True <=> gate is open
+ -- The (Name -> Bool) fn returns True for visible Names
+ -- For example, suppose this is in an interface file
+ -- instance C T where ...
+ -- We want to slurp this decl if both C and T are "visible" in
+ -- the importing module. See "The gating story" in RnIfaces for details.
\end{code}
%* *
%************************************************************************
+A LocalRdrEnv is used for local bindings (let, where, lambda, case)
+
+\begin{code}
+type LocalRdrEnv = RdrNameEnv Name
+
+extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
+extendLocalRdrEnv env names
+ = addListToRdrEnv env [(mkRdrUnqual (nameOccName n), n) | n <- names]
+\end{code}
+
The GlobalRdrEnv gives maps RdrNames to Names. There is a separate
one for each module, corresponding to that module's top-level scope.
\begin{code}
-type GlobalRdrEnv = RdrNameEnv [(Name,Provenance)] -- The list is because there may be name clashes
- -- These only get reported on lookup,
- -- not on construction
+type GlobalRdrEnv = RdrNameEnv [GlobalRdrElt]
+ -- The list is because there may be name clashes
+ -- These only get reported on lookup, not on construction
+
+data GlobalRdrElt = GRE Name Provenance (Maybe DeprecTxt)
+ -- The Maybe DeprecTxt tells whether this name is deprecated
pprGlobalRdrEnv env
= vcat (map pp (rdrEnvToList env))
where
pp (rn, nps) = ppr rn <> colon <+>
- vcat [ppr n <+> pprNameProvenance n p | (n,p) <- nps]
+ vcat [ppr n <+> pprNameProvenance n p | (GRE n p _) <- nps]
\end{code}
The "provenance" of something says how it came to be in scope.
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)))]
+ nest 2 (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
-ppr_defn loc | isGoodSrcLoc loc = ptext SLIT("at") <+> ppr loc
+ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("at") <+> ppr loc)
| otherwise = empty
\end{code}
projects / ghc-hetmet.git / blobdiff