\begin{code}
module HscTypes (
- ModuleLocation(..),
+ GhciMode(..),
+
+ ModuleLocation(..), showModMsg,
ModDetails(..), ModIface(..),
- HomeSymbolTable, PackageTypeEnv,
+ HomeSymbolTable, emptySymbolTable,
+ PackageTypeEnv,
HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
- lookupIface, lookupIfaceByModName,
+ lookupIface, lookupIfaceByModName, moduleNameToModule,
emptyModIface,
+ InteractiveContext(..),
+
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
- VersionInfo(..), initialVersionInfo,
+ VersionInfo(..), initialVersionInfo, lookupVersion,
+ FixityEnv, lookupFixity, collectFixities,
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, IsExported,
+ ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
+ PersistentRenamerState(..), IsBootInterface, DeclsMap,
+ IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, IsExported,
NameSupply(..), OrigNameCache, OrigIParamCache,
- AvailEnv, AvailInfo, GenAvailInfo(..),
+ Avails, AvailEnv, emptyAvailEnv,
+ GenAvailInfo(..), AvailInfo, RdrAvailInfo,
+ ExportItem, RdrExportItem,
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, getName, nameModule, nameSrcLoc )
-import Name -- Env
+import RdrName ( RdrName, RdrNameEnv, addListToRdrEnv,
+ mkRdrUnqual, rdrEnvToList )
+import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
+import NameEnv
import OccName ( OccName )
-import Module ( Module, ModuleName, ModuleEnv,
- lookupModuleEnv, lookupModuleEnvByName, emptyModuleEnv
- )
+import Module
import InstEnv ( InstEnv, ClsInstEnv, DFunId )
import Rules ( RuleBase )
+import CoreSyn ( CoreBind )
import Id ( Id )
import Class ( Class, classSelIds )
-import TyCon ( TyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
-import DataCon ( dataConId, dataConWrapId )
+import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
+import DataCon ( dataConWorkId, dataConWrapId )
-import BasicTypes ( Version, initialVersion, Fixity )
+import BasicTypes ( Version, initialVersion, Fixity, defaultFixity, IPName )
-import HsSyn ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
+import HsSyn ( DeprecTxt, TyClDecl, tyClDeclName, ifaceRuleDeclName,
+ tyClDeclNames )
import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
import CoreSyn ( IdCoreRule )
-import FiniteMap ( FiniteMap )
+import FiniteMap
import Bag ( Bag )
-import Maybes ( seqMaybe )
+import Maybes ( seqMaybe, orElse, expectJust )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
import Util ( thenCmp, sortLt )
import UniqSupply ( UniqSupply )
+import Maybe ( fromJust )
+\end{code}
+
+%************************************************************************
+%* *
+\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
instance Outputable ModuleLocation where
ppr = text . show
+
+-- Probably doesn't really belong here, but used in HscMain and InteractiveUI.
+
+showModMsg :: Bool -> Module -> ModuleLocation -> String
+showModMsg use_object mod location =
+ mod_str ++ replicate (max 0 (16 - length mod_str)) ' '
+ ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", "
+ ++ (if use_object
+ then expectJust "showModMsg" (ml_obj_file location)
+ else "interpreted")
+ ++ " )"
+ where mod_str = moduleUserString mod
\end{code}
For a module in another package, the hs_file and obj_file
A @ModIface@ plus a @ModDetails@ summarises everything we know
about a compiled module. The @ModIface@ is the stuff *before* linking,
-and can be written out to an interface file. The @ModDetails@ is after
-linking; it is the "linked" form of the mi_decls field.
+and can be written out to an interface file. (The @ModDetails@ is after
+linking; it is the "linked" form of the mi_decls field.)
+
+When we *read* an interface file, we also construct a @ModIface@ from it,
+except that the mi_decls part is empty; when reading we consolidate
+the declarations into a single indexed map in the @PersistentRenamerState@.
\begin{code}
data ModIface
= ModIface {
- mi_module :: Module, -- Complete with package info
- mi_version :: VersionInfo, -- Module version number
- mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
- mi_boot :: IsBootInterface, -- Whether this interface was read from an hi-boot file
+ mi_module :: !Module,
+ mi_package :: !PackageName, -- Which package the module comes from
+ mi_version :: !VersionInfo, -- Module version number
+
+ mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
+ -- NOT STRICT! we fill this field with _|_ sometimes
+
+ mi_boot :: !IsBootInterface, -- read from an hi-boot file?
- mi_usages :: [ImportVersion Name], -- Usages; kept sorted so that it's easy
- -- to decide whether to write a new iface file
- -- (changing usages doesn't affect the version of
- -- this module)
+ mi_usages :: ![ImportVersion Name],
+ -- Usages; kept sorted so that it's easy to decide
+ -- whether to write a new iface file (changing usages
+ -- doesn't affect the version of this module)
- mi_exports :: [(ModuleName,Avails)], -- What it exports
- -- Kept sorted by (mod,occ),
- -- to make version comparisons easier
+ mi_exports :: ![ExportItem],
+ -- What it exports Kept sorted by (mod,occ), to make
+ -- version comparisons easier
- mi_globals :: GlobalRdrEnv, -- Its top level environment
+ mi_globals :: !(Maybe GlobalRdrEnv),
+ -- Its top level environment or Nothing if we read this
+ -- interface from a file.
- mi_fixities :: NameEnv Fixity, -- Fixities
- mi_deprecs :: Deprecations, -- Deprecations
+ mi_fixities :: !FixityEnv, -- Fixities
+ mi_deprecs :: !Deprecations, -- Deprecations
- mi_decls :: IfaceDecls -- The RnDecls form of ModDetails
+ mi_decls :: IfaceDecls -- The RnDecls form of ModDetails
+ -- NOT STRICT! we fill this field with _|_ sometimes
}
data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted
data ModDetails
= ModDetails {
-- 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_types :: !TypeEnv,
+ md_insts :: ![DFunId], -- Dfun-ids for the instances in this module
+ 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,
+ mi_package = preludePackage, -- XXX fully bogus
mi_version = initialVersionInfo,
mi_usages = [],
mi_orphan = False,
mi_boot = False,
mi_exports = [],
mi_fixities = emptyNameEnv,
- mi_globals = emptyRdrEnv,
+ mi_globals = Nothing,
mi_deprecs = NoDeprecs,
mi_decls = panic "emptyModIface: decls"
}
type HomeSymbolTable = SymbolTable -- Domain = modules in the home package
+emptySymbolTable :: SymbolTable
+emptySymbolTable = emptyModuleEnv
+
emptyIfaceTable :: IfaceTable
emptyIfaceTable = emptyModuleEnv
\end{code}
-- We often have two IfaceTables, and want to do a lookup
lookupIfaceByModName hit pit mod
= lookupModuleEnvByName hit mod `seqMaybe` lookupModuleEnvByName pit mod
+
+-- Use instead of Finder.findModule if possible: this way doesn't
+-- require filesystem operations, and it is guaranteed not to fail
+-- when the IfaceTables are properly populated (i.e. after the renamer).
+moduleNameToModule :: HomeIfaceTable -> PackageIfaceTable -> ModuleName
+ -> Module
+moduleNameToModule hit pit mod
+ = mi_module (fromJust (lookupIfaceByModName hit pit mod))
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{The interactive context}
+%* *
+%************************************************************************
+
+\begin{code}
+data InteractiveContext
+ = InteractiveContext {
+ ic_toplev_scope :: [Module], -- Include the "top-level" scope of
+ -- these modules
+
+ ic_exports :: [Module], -- Include just the exports of these
+ -- modules
+
+ ic_rn_gbl_env :: GlobalRdrEnv, -- The cached GlobalRdrEnv, built from
+ -- ic_toplev_scope and ic_exports
+
+ ic_print_unqual :: PrintUnqualified,
+ -- cached PrintUnqualified, as above
+
+ ic_rn_local_env :: LocalRdrEnv, -- Lexical context for variables bound
+ -- during interaction
+
+ ic_type_env :: TypeEnv -- Ditto for types
+ }
\end{code}
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]
+
+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
go (AClass cl) = classSelIds cl
go (ATyCon tc) = tyConGenIds tc ++
tyConSelIds tc ++
- [ n | dc <- tyConDataConsIfAvailable tc,
- n <- [dataConId dc, dataConWrapId dc] ]
+ [ n | dc <- tyConDataCons_maybe tc `orElse` [],
+ 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 = [dataConWorkId 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}
-- 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}
deriving( Eq )
-- Equality used when deciding if the interface has changed
-type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it
-
+type RdrExportItem = (ModuleName, [RdrAvailInfo])
+type ExportItem = (ModuleName, [AvailInfo])
+
+type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it
+
+emptyAvailEnv :: AvailEnv
+emptyAvailEnv = emptyNameEnv
+
instance Outputable n => Outputable (GenAvailInfo n) where
ppr = pprAvail
pprAvail (Avail n) = ppr n
\end{code}
+\begin{code}
+type FixityEnv = NameEnv Fixity
+
+lookupFixity :: FixityEnv -> Name -> Fixity
+lookupFixity env n = lookupNameEnv env n `orElse` defaultFixity
+
+collectFixities :: FixityEnv -> [TyClDecl Name pat] -> [(Name,Fixity)]
+collectFixities env decls
+ = [ (n, fix)
+ | d <- decls, (n,_) <- tyClDeclNames d,
+ Just fix <- [lookupNameEnv env n]
+ ]
+\end{code}
+
%************************************************************************
%* *
%* *
%************************************************************************
+The @PersistentCompilerState@ persists across successive calls to the
+compiler.
+
+ * A ModIface for each non-home-package module
+
+ * An accumulated TypeEnv from all the modules in imported packages
+
+ * An accumulated InstEnv from all the modules in imported packages
+ The point is that we don't want to keep recreating it whenever
+ we compile a new module. The InstEnv component of pcPST is empty.
+ (This means we might "see" instances that we shouldn't "really" see;
+ but the Haskell Report is vague on what is meant to be visible,
+ so we just take the easy road here.)
+
+ * Ditto for rules
+
+ * The persistent renamer state
+
\begin{code}
data PersistentCompilerState
= PCS {
- pcs_PIT :: PackageIfaceTable, -- Domain = non-home-package modules
+ pcs_PIT :: !PackageIfaceTable, -- Domain = non-home-package modules
-- the mi_decls component is empty
- pcs_PTE :: PackageTypeEnv, -- Domain = non-home-package modules
+ pcs_PTE :: !PackageTypeEnv, -- Domain = non-home-package modules
-- except that the InstEnv components is empty
- pcs_insts :: PackageInstEnv, -- The total InstEnv accumulated from all
+ pcs_insts :: !PackageInstEnv, -- The total InstEnv accumulated from all
-- the non-home-package modules
- pcs_rules :: PackageRuleBase, -- Ditto RuleEnv
+ pcs_rules :: !PackageRuleBase, -- Ditto RuleEnv
- pcs_PRS :: PersistentRenamerState
+ pcs_PRS :: !PersistentRenamerState
}
-
\end{code}
-The @PersistentRenamerState@ persists across successive calls to the
-compiler.
-It contains:
+The persistent renamer state contains:
+
* A name supply, which deals with allocating unique names to
(Module,OccName) original names,
- * An accumulated TypeEnv from all the modules in imported packages
-
- * An accumulated InstEnv from all the modules in imported packages
- The point is that we don't want to keep recreating it whenever
- we compile a new module. The InstEnv component of pcPST is empty.
- (This means we might "see" instances that we shouldn't "really" see;
- but the Haskell Report is vague on what is meant to be visible,
- so we just take the easy road here.)
-
- * Ditto for rules
-
* A "holding pen" for declarations that have been read out of
interface files but not yet sucked in, renamed, and typechecked
type PackageInstEnv = InstEnv
data PersistentRenamerState
- = PRS { prsOrig :: NameSupply,
- prsDecls :: DeclsMap,
- prsInsts :: IfaceInsts,
- prsRules :: IfaceRules
+ = PRS { prsOrig :: !NameSupply,
+ prsImpMods :: !ImportedModuleInfo,
+
+ -- Holding pens for stuff that has been read in
+ -- but not yet slurped into the renamer
+ prsDecls :: !DeclsMap,
+ prsInsts :: !IfaceInsts,
+ prsRules :: !IfaceRules
}
\end{code}
}
type OrigNameCache = FiniteMap (ModuleName,OccName) Name
-type OrigIParamCache = FiniteMap OccName Name
+type OrigIParamCache = FiniteMap (IPName RdrName) (IPName 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