-%
+
% (c) The University of Glasgow, 2000
%
\section[HscTypes]{Types for the per-module compiler}
\begin{code}
module HscTypes (
- HscEnv(..),
+ HscEnv(..), hscEPS,
GhciMode(..),
- ModDetails(..), ModIface(..),
+ ModDetails(..),
ModGuts(..), ModImports(..), ForeignStubs(..),
- ParsedIface(..), IfaceDeprecs,
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
- ExternalPackageState(..),
+ ExternalPackageState(..),
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
lookupIface, lookupIfaceByModName, moduleNameToModule,
emptyModIface,
- InteractiveContext(..), emptyInteractiveContext, icPrintUnqual,
+ InteractiveContext(..), emptyInteractiveContext,
+ icPrintUnqual, unQualInScope,
+
+ ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
+ emptyIfaceDepCache,
- IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
+ Deprecs(..), IfaceDeprecs,
- VersionInfo(..), initialVersionInfo, lookupVersion,
- FixityEnv, lookupFixity, collectFixities, emptyFixityEnv,
+ FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
- TyThing(..), isTyClThing, implicitTyThingIds,
+ implicitTyThings, isImplicitTyThing,
+ TyThing(..), tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
- extendTypeEnvList, extendTypeEnvWithIds,
+ extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
- WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..),
+ WhetherHasOrphans, IsBootInterface, Usage(..),
Dependencies(..), noDependencies,
- IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn,
+ Pool(..), emptyPool, DeclPool, InstPool,
+ Gated,
+ RulePool, RulePoolContents, addRuleToPool,
NameCache(..), OrigNameCache, OrigIParamCache,
Avails, availsToNameSet, availName, availNames,
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
- ExportItem, RdrExportItem,
+ IfaceExport,
- PersistentCompilerState(..),
+ Deprecations, DeprecTxt, lookupDeprec, plusDeprecs,
- Deprecations(..), lookupDeprec, plusDeprecs,
-
- InstEnv, ClsInstEnv, DFunId,
+ InstEnv, DFunId,
PackageInstEnv, PackageRuleBase,
- GlobalRdrEnv, GlobalRdrElt(..), emptyGlobalRdrEnv, pprGlobalRdrEnv,
- LocalRdrEnv, extendLocalRdrEnv, isLocalGRE, unQualInScope,
-
-- Linker stuff
Linkable(..), isObjectLinkable,
Unlinked(..), CompiledByteCode,
- isObject, nameOfObject, isInterpretable, byteCodeOfObject,
-
- -- Provenance
- Provenance(..), ImportReason(..),
- pprNameProvenance, hasBetterProv
-
+ isObject, nameOfObject, isInterpretable, byteCodeOfObject
) where
#include "HsVersions.h"
import ByteCodeAsm ( CompiledByteCode )
#endif
-import RdrName ( RdrName, mkRdrUnqual,
- RdrNameEnv, addListToRdrEnv, foldRdrEnv, isUnqual,
- rdrEnvToList, emptyRdrEnv )
-import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
+import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv,
+ LocalRdrEnv, emptyLocalRdrEnv,
+ GlobalRdrElt(..), unQualOK )
+import Name ( Name, NamedThing, getName, nameOccName, nameModule )
import NameEnv
import NameSet
-import OccName ( OccName )
+import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv,
+ extendOccEnv, foldOccEnv )
import Module
-import InstEnv ( InstEnv, ClsInstEnv, DFunId )
+import InstEnv ( InstEnv, DFunId )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
-import Id ( Id )
-import Class ( Class, classSelIds )
-import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
-import Type ( TyThing(..), isTyClThing )
-import DataCon ( dataConWorkId, dataConWrapId )
-import Packages ( PackageName, basePackage )
+import Id ( Id, isImplicitId )
+import Type ( TyThing(..) )
+
+import Class ( Class, classSelIds, classTyCon )
+import TyCon ( TyCon, isClassTyCon, tyConSelIds, tyConDataCons )
+import DataCon ( dataConImplicitIds )
+import Packages ( PackageName )
import CmdLineOpts ( DynFlags )
-import BasicTypes ( Version, initialVersion, IPName,
- Fixity, FixitySig(..), defaultFixity )
+import BasicTypes ( Version, initialVersion, IPName,
+ Fixity, defaultFixity, DeprecTxt )
-import HsSyn ( DeprecTxt, TyClDecl, InstDecl, RuleDecl,
- tyClDeclName, ifaceRuleDeclName, tyClDeclNames,
- instDeclDFun )
-import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
+import IfaceSyn ( IfaceInst, IfaceRule, IfaceDecl(ifName) )
+import FiniteMap ( FiniteMap )
import CoreSyn ( IdCoreRule )
import PrelNames ( isBuiltInSyntaxName )
-
-import FiniteMap
-import Bag ( Bag )
import Maybes ( orElse )
import Outputable
-import SrcLoc ( SrcLoc, isGoodSrcLoc )
-import Util ( thenCmp, sortLt )
+import SrcLoc ( SrcSpan )
import UniqSupply ( UniqSupply )
import Maybe ( fromJust )
import FastString ( FastString )
+import DATA_IOREF ( IORef, readIORef )
import Time ( ClockTime )
\end{code}
The HscEnv gives the environment in which to compile a chunk of code.
\begin{code}
-data HscEnv = HscEnv { hsc_mode :: GhciMode,
- hsc_dflags :: DynFlags,
- hsc_HPT :: HomePackageTable }
+data HscEnv
+ = HscEnv { hsc_mode :: GhciMode,
+ hsc_dflags :: DynFlags,
+
+ hsc_HPT :: HomePackageTable,
+ -- The home package table describes already-compiled
+ -- home-packge modules, *excluding* the module we
+ -- are compiling right now.
+ -- (In one-shot mode the current module is the only
+ -- home-package module, so hsc_HPT is empty. All other
+ -- modules count as "external-package" modules.)
+ -- hsc_HPT is not mutable because we only demand-load
+ -- external packages; the home package is eagerly
+ -- loaded by the compilation manager.
+
+ -- The next two are side-effected by compiling
+ -- to reflect sucking in interface files
+ hsc_EPS :: IORef ExternalPackageState,
+ hsc_NC :: IORef NameCache }
+
+hscEPS :: HscEnv -> IO ExternalPackageState
+hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
\end{code}
The GhciMode is self-explanatory:
emptyHomePackageTable = emptyModuleEnv
emptyPackageIfaceTable = emptyModuleEnv
-data HomeModInfo = HomeModInfo { hm_iface :: ModIface,
- hm_details :: ModDetails,
- hm_linkable :: Linkable }
+data HomeModInfo
+ = HomeModInfo { hm_iface :: ModIface,
+ hm_globals :: Maybe GlobalRdrEnv, -- Its top level environment
+ -- Nothing <-> compiled module
+ hm_details :: ModDetails,
+ hm_linkable :: Linkable }
\end{code}
Simple lookups in the symbol table.
\begin{code}
data ModIface
= ModIface {
- mi_module :: !Module,
mi_package :: !PackageName, -- Which package the module comes from
- mi_version :: !VersionInfo, -- Version info for everything in this module
+ mi_module :: !Module,
+ mi_mod_vers :: !Version, -- Module version: changes when anything changes
+
mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans
mi_boot :: !IsBootInterface, -- Read from an hi-boot file?
mi_deps :: Dependencies,
- -- This is consulted for directly-imported modules, but
- -- not for anything else
+ -- This is consulted for directly-imported modules,
+ -- but not for anything else (hence lazy)
- mi_usages :: [Usage 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 :: [Usage],
-- NOT STRICT! we read this field lazily from the interface file
-- It is *only* consulted by the recompilation checker
- mi_exports :: ![ExportItem],
- -- What it exports Kept sorted by (mod,occ), to make
- -- version comparisons easier
+ -- Exports
+ -- Kept sorted by (mod,occ), to make version comparisons easier
+ mi_exports :: ![IfaceExport],
+ mi_exp_vers :: !Version, -- Version number of export list
- mi_globals :: !(Maybe GlobalRdrEnv),
- -- Its top level environment or Nothing if we read this
- -- interface from an interface file. (We need the source
- -- file to figure out the top-level environment.)
+ -- Fixities
+ mi_fixities :: [(OccName,Fixity)],
+ -- NOT STRICT! we read this field lazily from the interface file
- mi_fixities :: !FixityEnv, -- Fixities
- mi_deprecs :: Deprecations, -- Deprecations
- -- NOT STRICT! we read this field lazilly from the interface file
+ -- Deprecations
+ mi_deprecs :: Deprecs [(OccName,DeprecTxt)],
+ -- NOT STRICT! we read this field lazily from the interface file
- mi_decls :: IfaceDecls -- The RnDecls form of ModDetails
- -- NOT STRICT! we fill this field with _|_ sometimes
+ -- Type, class and variable declarations
+ -- The version of an Id changes if its fixity or deprecations change
+ -- (as well as its type of course)
+ -- Ditto data constructors, class operations, except that
+ -- the version of the parent class/tycon changes
+ mi_decls :: [(Version,IfaceDecl)], -- Sorted
+
+ -- Instance declarations and rules
+ mi_insts :: [IfaceInst], -- Sorted
+ mi_rules :: [IfaceRule], -- Sorted
+ mi_rule_vers :: !Version, -- Version number for rules and instances combined
+
+ -- Cached environments for easy lookup
+ -- These are computed (lazily) from other fields
+ -- and are not put into the interface file
+ mi_dep_fn :: Name -> Maybe DeprecTxt, -- Cached lookup for mi_deprecs
+ mi_fix_fn :: OccName -> Fixity, -- Cached lookup for mi_fixities
+ mi_ver_fn :: OccName -> Maybe Version -- Cached lookup for mi_decls
+ -- The Nothing in mi_ver_fn means that the thing
+ -- isn't in decls. It's useful to know that when
+ -- seeing if we are up to date wrt the old interface
}
-- Should be able to construct ModDetails from mi_decls in ModIface
data ModGuts
= ModGuts {
mg_module :: !Module,
- mg_exports :: !Avails, -- What it exports
+ mg_exports :: !NameSet, -- What it exports
mg_deps :: !Dependencies, -- What is below it, directly or otherwise
mg_dir_imps :: ![Module], -- Directly-imported modules; used to
-- generate initialisation code
- mg_usages :: ![Usage Name], -- Version info for what it needed
+ mg_usages :: ![Usage], -- Version info for what it needed
mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment
mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in this module
[Id] -- Foreign-exported binders
-- we have to generate code to register these
-
-data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted
- dcl_rules :: [RenamedRuleDecl], -- Sorted
- dcl_insts :: [RenamedInstDecl] } -- Unsorted
-
-mkIfaceDecls :: [RenamedTyClDecl] -> [RenamedRuleDecl] -> [RenamedInstDecl] -> IfaceDecls
--- Sort to put them in canonical order for version comparison
-mkIfaceDecls tycls rules insts
- = IfaceDecls { dcl_tycl = sortLt lt_tycl tycls,
- dcl_rules = sortLt lt_rule rules,
- dcl_insts = sortLt lt_inst insts }
- where
- d1 `lt_tycl` d2 = tyClDeclName d1 < tyClDeclName d2
- r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2
- i1 `lt_inst` i2 = instDeclDFun i1 < instDeclDFun i2
\end{code}
\begin{code}
-emptyModIface :: Module -> ModIface
-emptyModIface mod
- = ModIface { mi_module = mod,
- mi_package = basePackage, -- XXX fully bogus
- mi_version = initialVersionInfo,
- mi_usages = [],
- mi_deps = noDependencies,
+emptyModIface :: PackageName -> ModuleName -> ModIface
+emptyModIface pkg mod
+ = ModIface { mi_package = pkg,
+ mi_module = mkModule pkg mod,
+ mi_mod_vers = initialVersion,
mi_orphan = False,
mi_boot = False,
+ mi_deps = noDependencies,
+ mi_usages = [],
mi_exports = [],
- mi_fixities = emptyNameEnv,
- mi_globals = Nothing,
+ mi_exp_vers = initialVersion,
+ mi_fixities = [],
mi_deprecs = NoDeprecs,
- mi_decls = panic "emptyModIface: decls"
+ mi_insts = [],
+ mi_rules = [],
+ mi_decls = [],
+ mi_rule_vers = initialVersion,
+ mi_dep_fn = emptyIfaceDepCache,
+ mi_fix_fn = emptyIfaceFixCache,
+ mi_ver_fn = emptyIfaceVerCache
}
\end{code}
%************************************************************************
%* *
- Parsed interface files
-%* *
-%************************************************************************
-
-A ParsedIface is exactly as read from an interface file.
-
-\begin{code}
-type IfaceDeprecs = Maybe (Either DeprecTxt [(RdrName,DeprecTxt)])
- -- Nothing => NoDeprecs
- -- Just (Left t) => DeprecAll
- -- Just (Right p) => DeprecSome
-
-data ParsedIface
- = ParsedIface {
- pi_mod :: ModuleName,
- pi_pkg :: PackageName,
- pi_vers :: Version, -- Module version number
- pi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
- pi_deps :: Dependencies, -- What it depends on
- pi_usages :: [Usage OccName], -- Usages
- pi_exports :: (Version, [RdrExportItem]), -- Exports
- pi_decls :: [(Version, TyClDecl RdrName)], -- Local definitions
- pi_fixity :: [FixitySig RdrName], -- Local fixity declarations,
- pi_insts :: [InstDecl RdrName], -- Local instance declarations
- pi_rules :: (Version, [RuleDecl RdrName]), -- Rules, with their version
- pi_deprecs :: IfaceDeprecs -- Deprecations
- }
-\end{code}
-
-
-%************************************************************************
-%* *
\subsection{The interactive context}
%* *
%************************************************************************
\begin{code}
data InteractiveContext
= InteractiveContext {
- ic_toplev_scope :: [Module], -- Include the "top-level" scope of
+ ic_toplev_scope :: [String], -- Include the "top-level" scope of
-- these modules
- ic_exports :: [Module], -- Include just the exports of these
+ ic_exports :: [String], -- Include just the exports of these
-- modules
ic_rn_gbl_env :: GlobalRdrEnv, -- The cached GlobalRdrEnv, built from
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
ic_exports = [],
- ic_rn_gbl_env = emptyRdrEnv,
- ic_rn_local_env = emptyRdrEnv,
+ ic_rn_gbl_env = emptyGlobalRdrEnv,
+ ic_rn_local_env = emptyLocalRdrEnv,
ic_type_env = emptyTypeEnv }
icPrintUnqual :: InteractiveContext -> PrintUnqualified
icPrintUnqual ictxt = unQualInScope (ic_rn_gbl_env ictxt)
\end{code}
+@unQualInScope@ returns a function that takes a @Name@ and tells whether
+its unqualified name is in scope. This is put as a boolean flag in
+the @Name@'s provenance to guide whether or not to print the name qualified
+in error messages.
+
+\begin{code}
+unQualInScope :: GlobalRdrEnv -> Name -> Bool
+-- True if 'f' is in scope, and has only one binding,
+-- and the thing it is bound to is the name we are looking for
+-- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
+--
+-- Also checks for built-in syntax, which is always 'in scope'
+--
+-- This fn is only efficient if the shared
+-- partial application is used a lot.
+unQualInScope env
+ = \n -> n `elemNameSet` unqual_names || isBuiltInSyntaxName n
+ where
+ unqual_names :: NameSet
+ unqual_names = foldOccEnv add emptyNameSet env
+ add [gre] unquals | unQualOK gre = addOneToNameSet unquals (gre_name gre)
+ add _ unquals = unquals
+\end{code}
+
%************************************************************************
%* *
-\subsection{Type environment stuff}
+ TyThing
%* *
%************************************************************************
\begin{code}
+isImplicitTyThing :: TyThing -> Bool
+isImplicitTyThing (ADataCon dc) = True
+isImplicitTyThing (AnId id) = isImplicitId id
+isImplicitTyThing (ATyCon tc) = isClassTyCon tc
+isImplicitTyThing other = False
+
+implicitTyThings :: TyThing -> [TyThing]
+implicitTyThings (AnId id) = []
+
+ -- For type constructors, add the data cons (and their extras),
+ -- and the selectors and generic-programming Ids too
+ --
+ -- Newtypes don't have a worker Id, so don't generate that?
+implicitTyThings (ATyCon tc) = map AnId (tyConSelIds tc) ++
+ concatMap (extras_plus . ADataCon) (tyConDataCons tc)
+
+ -- For classes, add the class TyCon too (and its extras)
+ -- and the class selector Ids
+implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++
+ extras_plus (ATyCon (classTyCon cl))
+
+
+ -- For data cons add the worker and wrapper (if any)
+implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
+
+extras_plus thing = thing : implicitTyThings thing
+
+extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
+extendTypeEnvWithIds env ids
+ = extendNameEnvList env [(getName id, AnId id) | id <- ids]
+\end{code}
+
+%************************************************************************
+%* *
+ TypeEnv
+%* *
+%************************************************************************
+
+\begin{code}
+type TypeEnv = NameEnv TyThing
+
+emptyTypeEnv :: TypeEnv
typeEnvElts :: TypeEnv -> [TyThing]
typeEnvClasses :: TypeEnv -> [Class]
typeEnvTyCons :: TypeEnv -> [TyCon]
typeEnvIds :: TypeEnv -> [Id]
+lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
+emptyTypeEnv = emptyNameEnv
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 <- 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}
-
-
-\begin{code}
-type TypeEnv = NameEnv TyThing
-
-emptyTypeEnv = emptyNameEnv
-
mkTypeEnv :: [TyThing] -> TypeEnv
mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
+lookupTypeEnv = lookupNameEnv
+
extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
+-- Extend the type environment
extendTypeEnvList env things
- = extendNameEnvList env [(getName thing, thing) | thing <- things]
-
-extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
-extendTypeEnvWithIds env ids
- = extendNameEnvList env [(getName id, AnId id) | id <- ids]
+ = foldl extend env things
+ where
+ extend env thing = extendNameEnv env (getName thing) thing
\end{code}
\begin{code}
Nothing -> lookupNameEnv pte name
\end{code}
+
+\begin{code}
+tyThingTyCon (ATyCon tc) = tc
+tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other)
+
+tyThingClass (AClass cls) = cls
+tyThingClass other = pprPanic "tyThingClass" (ppr other)
+
+tyThingDataCon (ADataCon dc) = dc
+tyThingDataCon other = pprPanic "tyThingDataCon" (ppr other)
+
+tyThingId (AnId id) = id
+tyThingId other = pprPanic "tyThingId" (ppr other)
+\end{code}
+
%************************************************************************
%* *
\subsection{Auxiliary types}
but they are mostly elaborated elsewhere
\begin{code}
-data VersionInfo
- = VersionInfo {
- vers_module :: Version, -- Changes when anything changes
- vers_exports :: Version, -- Changes when export list changes
- vers_rules :: Version, -- Changes when any rule changes
- vers_decls :: NameEnv Version
- -- Versions for "big" names only (not data constructors, class ops)
- -- 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'
- }
+mkIfaceVerCache :: [(Version,IfaceDecl)] -> OccName -> Maybe Version
+mkIfaceVerCache pairs
+ = \occ -> lookupOccEnv env occ
+ where
+ env = foldl add emptyOccEnv pairs
+ add env (v,d) = extendOccEnv env (ifName d) v
+
+emptyIfaceVerCache :: OccName -> Maybe Version
+emptyIfaceVerCache occ = Nothing
-initialVersionInfo :: VersionInfo
-initialVersionInfo = VersionInfo { vers_module = initialVersion,
- vers_exports = initialVersion,
- vers_rules = initialVersion,
- vers_decls = emptyNameEnv
- }
+------------------ Deprecations -------------------------
+data Deprecs a
+ = NoDeprecs
+ | DeprecAll DeprecTxt -- Whole module deprecated
+ | DeprecSome a -- Some specific things deprecated
+ deriving( Eq )
-lookupVersion :: NameEnv Version -> Name -> Version
-lookupVersion env name = lookupNameEnv env name `orElse` initialVersion
+type IfaceDeprecs = Deprecs [(OccName,DeprecTxt)]
+type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt))
-data Deprecations = NoDeprecs
- | DeprecAll DeprecTxt -- Whole module deprecated
- | DeprecSome (NameEnv (Name,DeprecTxt)) -- Some things deprecated
- -- Just "big" names
- -- We keep the Name in the range, so we can print them out
+mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
+mkIfaceDepCache NoDeprecs = \n -> Nothing
+mkIfaceDepCache (DeprecAll t) = \n -> Just t
+mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
+
+emptyIfaceDepCache :: Name -> Maybe DeprecTxt
+emptyIfaceDepCache n = Nothing
lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt
lookupDeprec NoDeprecs name = Nothing
plusDeprecs d (DeprecAll t) = DeprecAll t
plusDeprecs (DeprecAll t) d = DeprecAll t
plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
-
-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 RdrExportItem = (ModuleName, [RdrAvailInfo])
-type ExportItem = (ModuleName, [AvailInfo])
+type IfaceExport = (ModuleName, [GenAvailInfo OccName])
availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet avails = foldl add emptyNameSet avails
\end{code}
\begin{code}
-type FixityEnv = NameEnv (FixitySig Name)
- -- We keep the whole fixity sig so that we
- -- can report line-number info when there is a duplicate
- -- fixity declaration
+mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Fixity
+mkIfaceFixCache pairs
+ = \n -> lookupOccEnv env n `orElse` defaultFixity
+ where
+ env = mkOccEnv pairs
+
+emptyIfaceFixCache :: OccName -> Fixity
+emptyIfaceFixCache n = defaultFixity
+
+-- This fixity environment is for source code only
+type FixityEnv = NameEnv FixItem
+
+-- We keep the OccName in the range so that we can generate an interface from it
+data FixItem = FixItem OccName Fixity SrcSpan
+
+instance Outputable FixItem where
+ ppr (FixItem occ fix loc) = ppr fix <+> ppr occ <+> parens (ppr loc)
emptyFixityEnv :: FixityEnv
emptyFixityEnv = emptyNameEnv
lookupFixity :: FixityEnv -> Name -> Fixity
lookupFixity env n = case lookupNameEnv env n of
- Just (FixitySig _ fix _) -> fix
- Nothing -> defaultFixity
-
-collectFixities :: FixityEnv -> [TyClDecl Name] -> [FixitySig Name]
--- Collect fixities for the specified declarations
-collectFixities env decls
- = [ fix
- | d <- decls, (n,_) <- tyClDeclNames d,
- Just fix <- [lookupNameEnv env n]
- ]
+ Just (FixItem _ fix _) -> fix
+ Nothing -> defaultFixity
\end{code}
noDependencies :: Dependencies
noDependencies = Deps [] [] []
-data Usage name
- = Usage { usg_name :: ModuleName, -- Name of the module
- usg_mod :: Version, -- Module version
- usg_exports :: Maybe Version, -- Export-list version, if we depend on it
- usg_entities :: [(name,Version)], -- Sorted by occurrence name
- usg_rules :: Version -- Rules version
+data Usage
+ = Usage { usg_name :: ModuleName, -- Name of the module
+ usg_mod :: Version, -- Module version
+ usg_entities :: [(OccName,Version)], -- Sorted by occurrence name
+ usg_exports :: Maybe Version, -- Export-list version, if we depend on it
+ usg_rules :: Version -- Orphan-rules version (for non-orphan
+ -- modules this will always be initialVersion)
} deriving( Eq )
-- This type doesn't let you say "I imported f but none of the rules in
-- the module". If you use anything in the module you get its rule version
%************************************************************************
%* *
-\subsection{The persistent compiler state}
+ The External Package State
%* *
%************************************************************************
-The @PersistentCompilerState@ persists across successive calls to the
-compiler.
-
-\begin{code}
-data PersistentCompilerState
- = PCS {
- pcs_nc :: !NameCache,
- pcs_EPS :: !ExternalPackageState
- }
-\end{code}
-
-
\begin{code}
type PackageTypeEnv = TypeEnv
type PackageRuleBase = RuleBase
-- Holding pens for stuff that has been read in from file,
-- but not yet slurped into the renamer
- eps_decls :: !DeclsMap,
+ eps_decls :: !DeclPool,
-- A single, global map of Names to unslurped decls
- eps_insts :: !IfaceInsts,
- -- The as-yet un-slurped instance decls; this bag is depleted when we
- -- slurp an instance decl so that we don't slurp the same one twice.
- -- Each is 'gated' by the names that must be available before
- -- this instance decl is needed.
- eps_rules :: !IfaceRules,
- -- Similar to instance decls, only for rules
-
- eps_inst_gates :: !NameSet -- Gates for instance decls
- -- The instance gates must accumulate across
- -- all invocations of the renamer;
- -- see "the gating story" in RnIfaces.lhs
- -- These names should all be from other packages;
- -- for the home package we have all the instance
- -- declarations anyhow
+ -- Decls move from here to eps_PTE
+
+ eps_insts :: !InstPool,
+ -- The as-yet un-slurped instance decls
+ -- Decls move from here to eps_inst_env
+ -- Each instance is 'gated' by the names that must be
+ -- available before this instance decl is needed.
+
+ eps_rules :: !RulePool
+ -- The as-yet un-slurped rules
}
\end{code}
-- Ensures that one implicit parameter name gets one unique
}
-type OrigNameCache = ModuleEnv (Module, OccNameCache)
- -- Maps a module *name* to a Module,
- -- plus the OccNameEnv fot that module
-type OccNameCache = FiniteMap OccName Name
- -- Maps the OccName to a Name
- -- A FiniteMap because OccNames have a Namespace/Faststring pair
-
-type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name)
+type OrigNameCache = ModuleEnv (OccEnv Name)
+type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
\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
-for the 'main' Name.
-
\begin{code}
-type DeclsMap = (NameEnv (AvailInfo, Bool, (Module, TyClDecl RdrName)), Int)
- -- The Int says how many have been sucked in
-
-type IfaceInsts = GatedDecls (InstDecl RdrName)
-type IfaceRules = GatedDecls (RuleDecl RdrName)
-
-type GatedDecls d = (Bag (GatedDecl d), Int) -- The Int says how many have been sucked in
-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
+data Pool p = Pool p -- The pool itself
+ Int -- Number of decls slurped into the map
+ Int -- Number of decls slurped out of the map
+
+emptyPool p = Pool p 0 0
+
+instance Outputable p => Outputable (Pool p) where
+ ppr (Pool p n_in n_out) -- Debug printing only
+ = vcat [ptext SLIT("Pool") <+> int n_in <+> int n_out,
+ nest 2 (ppr p)]
+
+type DeclPool = Pool (NameEnv IfaceDecl) -- Keyed by the "main thing" of the decl
+
+-------------------------
+type Gated d = ([Name], (ModuleName, d)) -- The [Name] 'gate' the declaration
+ -- ModuleName records which iface file this
+ -- decl came from
+
+type RulePool = Pool RulePoolContents
+type RulePoolContents = [Gated IfaceRule]
+
+addRuleToPool :: RulePoolContents
+ -> (ModuleName, IfaceRule)
+ -> [Name] -- Free vars of rule; always non-empty
+ -> RulePoolContents
+addRuleToPool rules rule fvs = (fvs,rule) : rules
+
+-------------------------
+type InstPool = Pool (NameEnv [Gated IfaceInst])
+ -- The key of the Pool is the Class
+ -- The Names are the TyCons in the instance head
-- 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
\end{code}
-%************************************************************************
-%* *
-\subsection{Provenance and export info}
-%* *
-%************************************************************************
-
-A LocalRdrEnv is used for local bindings (let, where, lambda, case)
-Also used in
-
-\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 [GlobalRdrElt]
- -- The list is because there may be name clashes
- -- These only get reported on lookup, not on construction
-
-emptyGlobalRdrEnv = emptyRdrEnv
-
-data GlobalRdrElt
- = GRE { gre_name :: Name,
- gre_parent :: Name, -- Name of the "parent" structure
- -- * the tycon of a data con
- -- * the class of a class op
- -- For others it's just the same as gre_name
- gre_prov :: Provenance, -- Why it's in scope
- gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
- }
-
-instance Outputable GlobalRdrElt where
- ppr gre = ppr (gre_name gre) <+>
- parens (hsep [text "parent:" <+> ppr (gre_parent gre) <> comma,
- pprNameProvenance gre])
-pprGlobalRdrEnv env
- = vcat (map pp (rdrEnvToList env))
- where
- pp (rn, gres) = ppr rn <> colon <+>
- vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
- | gre <- gres]
-
-isLocalGRE :: GlobalRdrElt -> Bool
-isLocalGRE (GRE {gre_prov = LocalDef}) = True
-isLocalGRE other = False
-\end{code}
-
-@unQualInScope@ returns a function that takes a @Name@ and tells whether
-its unqualified name is in scope. This is put as a boolean flag in
-the @Name@'s provenance to guide whether or not to print the name qualified
-in error messages.
-\begin{code}
-unQualInScope :: GlobalRdrEnv -> Name -> Bool
--- True if 'f' is in scope, and has only one binding,
--- and the thing it is bound to is the name we are looking for
--- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
---
--- Also checks for built-in syntax, which is always 'in scope'
---
--- This fn is only efficient if the shared
--- partial application is used a lot.
-unQualInScope env
- = \n -> n `elemNameSet` unqual_names || isBuiltInSyntaxName n
- where
- unqual_names :: NameSet
- unqual_names = foldRdrEnv add emptyNameSet env
- add rdr_name [gre] unquals | isUnqual rdr_name = addOneToNameSet unquals (gre_name gre)
- add _ _ unquals = unquals
-\end{code}
-
-The "provenance" of something says how it came to be in scope.
-
-\begin{code}
-data Provenance
- = LocalDef -- Defined locally
-
- | NonLocalDef -- Defined non-locally
- ImportReason
-
--- Just used for grouping error messages (in RnEnv.warnUnusedBinds)
-instance Eq Provenance where
- p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
-
-instance Eq ImportReason where
- p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
-
-instance Ord Provenance where
- compare LocalDef LocalDef = EQ
- compare LocalDef (NonLocalDef _) = LT
- compare (NonLocalDef _) LocalDef = GT
-
- compare (NonLocalDef reason1) (NonLocalDef reason2)
- = compare reason1 reason2
-
-instance Ord ImportReason where
- compare ImplicitImport ImplicitImport = EQ
- compare ImplicitImport (UserImport _ _ _) = LT
- compare (UserImport _ _ _) ImplicitImport = GT
- compare (UserImport m1 loc1 _) (UserImport m2 loc2 _)
- = (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
-
-
-data ImportReason
- = UserImport Module SrcLoc Bool -- Imported from module M on line L
- -- Note the M may well not be the defining module
- -- for this thing!
- -- The Bool is true iff the thing was named *explicitly* in the import spec,
- -- rather than being imported as part of a group; e.g.
- -- import B
- -- import C( T(..) )
- -- Here, everything imported by B, and the constructors of T
- -- are not named explicitly; only T is named explicitly.
- -- This info is used when warning of unused names.
-
- | ImplicitImport -- Imported implicitly for some other reason
-\end{code}
-
-\begin{code}
-hasBetterProv :: Provenance -> Provenance -> Bool
--- Choose
--- 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 _ _ _ )) (NonLocalDef ImplicitImport) = True
-hasBetterProv _ _ = False
-
-pprNameProvenance :: GlobalRdrElt -> SDoc
-pprNameProvenance (GRE {gre_name = name, gre_prov = prov})
- = case prov of
- LocalDef -> ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
- NonLocalDef why -> sep [ppr_reason why,
- 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 = parens (ptext SLIT("defined at") <+> ppr loc)
- | otherwise = empty
-\end{code}
projects / ghc-hetmet.git / blobdiff