X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=5f1ce2d2722895bb5fd585a5b9fd3ad884190d19;hb=bb88e732b7383c10496c0f60c3bdea2c22362cc6;hp=10b390d27df91c54ccdaa405a7e147c6ce23b40f;hpb=cbb5beb0ecef58ae6e47fa62e144a0855644f50a;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 10b390d..5f1ce2d 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -1,64 +1,58 @@ -% + % (c) The University of Glasgow, 2000 % \section[HscTypes]{Types for the per-module compiler} \begin{code} module HscTypes ( - HscEnv(..), - GhciMode(..), + HscEnv(..), hscEPS, + GhciMode(..), isOneShot, - ModDetails(..), ModIface(..), + ModDetails(..), ModGuts(..), ModImports(..), ForeignStubs(..), - ParsedIface(..), IfaceDeprecs, HomePackageTable, HomeModInfo(..), emptyHomePackageTable, - ExternalPackageState(..), + ExternalPackageState(..), EpsStats(..), addEpsInStats, 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, + TyThing(..), tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId, TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv, - extendTypeEnvList, extendTypeEnvWithIds, + extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv, typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds, - ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..), - IsBootInterface, DeclsMap, - IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, + WhetherHasOrphans, IsBootInterface, Usage(..), + Dependencies(..), noDependencies, + InstPool, Gated, addInstsToPool, + RulePool, addRulesToPool, 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" @@ -67,45 +61,42 @@ module HscTypes ( 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(..), mkRdrUnqual, lookupGRE_RdrName ) +import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameModuleName ) 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, preludePackage ) +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 ) -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} @@ -119,16 +110,42 @@ import Time ( ClockTime ) 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: \begin{code} -data GhciMode = Batch | Interactive | OneShot +data GhciMode = Batch -- ghc --make Main + | Interactive -- ghc --interactive + | OneShot -- ghc Foo.hs + | IDE -- Visual Studio etc deriving Eq + +isOneShot :: GhciMode -> Bool +isOneShot OneShot = True +isOneShot _other = False \end{code} \begin{code} @@ -138,22 +155,23 @@ type PackageIfaceTable = ModuleEnv ModIface -- Domain = modules in the imported 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} -lookupIface :: HomePackageTable -> PackageIfaceTable -> Name -> Maybe ModIface +lookupIface :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface -- We often have two IfaceTables, and want to do a lookup -lookupIface hpt pit name +lookupIface hpt pit mod = case lookupModuleEnv hpt mod of Just mod_info -> Just (hm_iface mod_info) Nothing -> lookupModuleEnv pit mod - where - mod = nameModule name lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface -- We often have two IfaceTables, and want to do a lookup @@ -191,33 +209,58 @@ the declarations into a single indexed map in the @PersistentRenamerState@. \begin{code} data ModIface = ModIface { - mi_module :: !Module, mi_package :: !PackageName, -- Which package the module comes from - mi_version :: !VersionInfo, -- Module version number + 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_usages :: [ImportVersion Name], + mi_deps :: Dependencies, + -- This is consulted for directly-imported modules, + -- but not for anything else (hence lazy) + -- 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 :: IfaceDeprecs, + -- 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 @@ -229,8 +272,6 @@ data ModDetails md_rules :: ![IdCoreRule] -- Domain may include Ids from other modules } - - -- A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module -- being compiled right now. Once it is compiled, a ModIface and @@ -239,10 +280,11 @@ data ModDetails data ModGuts = ModGuts { mg_module :: !Module, - mg_exports :: !Avails, -- What it exports - mg_usages :: ![ImportVersion Name], -- What it imports, directly or otherwise - -- ...exactly as in ModIface - mg_dir_imps :: ![Module], -- Directly imported modules + 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], -- 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 @@ -300,72 +342,35 @@ data ForeignStubs = NoStubs [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 -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 \end{code} \begin{code} -emptyModIface :: Module -> ModIface -emptyModIface mod - = ModIface { mi_module = mod, - mi_package = preludePackage, -- XXX fully bogus - mi_version = initialVersionInfo, - mi_usages = [], +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_usages :: [ImportVersion 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} %* * %************************************************************************ @@ -373,10 +378,10 @@ data ParsedIface \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 @@ -391,67 +396,99 @@ data InteractiveContext 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 -> PrintUnqualified +-- 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') +-- +-- [Out of date] Also checks for built-in syntax, which is always 'in scope' +unQualInScope env mod occ + = case lookupGRE_RdrName (mkRdrUnqual occ) env of + [gre] -> nameModuleName (gre_name gre) == mod + other -> False +\end{code} + + +%************************************************************************ +%* * + TyThing +%* * +%************************************************************************ + +\begin{code} +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} %************************************************************************ %* * -\subsection{Type environment stuff} + 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 -extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv -extendTypeEnvList env things - = extendNameEnvList env [(getName thing, thing) | thing <- things] +lookupTypeEnv = lookupNameEnv -extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv -extendTypeEnvWithIds env ids - = extendNameEnvList env [(getName id, AnId id) | id <- ids] +-- Extend the type environment +extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv +extendTypeEnv env thing = extendNameEnv env (getName thing) thing + +extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv +extendTypeEnvList env things = foldl extendTypeEnv env things \end{code} \begin{code} @@ -462,6 +499,21 @@ lookupType hpt pte name 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} @@ -472,35 +524,33 @@ These types are defined here because they are mentioned in ModDetails, 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 @@ -515,13 +565,6 @@ plusDeprecs NoDeprecs d = d 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} @@ -539,8 +582,7 @@ data GenAvailInfo name = Avail name -- An ordinary identifier 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 @@ -567,26 +609,31 @@ pprAvail (Avail n) = ppr n \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} @@ -604,33 +651,37 @@ type WhetherHasOrphans = Bool -- * a transformation rule in a module other than the one defining -- the function in the head of the rule. -type IsBootInterface = Bool +type IsBootInterface = Bool -type ImportVersion name = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name) - -data WhatsImported name = NothingAtAll -- The module is below us in the - -- hierarchy, but we import nothing - -- Used for orphan modules, so they appear - -- in the usage list - - | Everything Version -- Used for modules from other packages; - -- we record only the module's version number - - | Specifically - Version -- Module version - (Maybe Version) -- Export-list version, if we depend on it - [(name,Version)] -- List guaranteed non-empty - Version -- Rules version - - deriving( Eq ) - -- 'Specifically' doesn't let you say "I imported f but none of the rules in +-- Dependency info about modules and packages below this one +-- in the import hierarchy. See TcRnTypes.ImportAvails for details. +-- +-- Invariant: the dependencies of a module M never includes M +-- Invariant: the lists are unordered, with no duplicates +data Dependencies + = Deps { dep_mods :: [(ModuleName,IsBootInterface)], -- Home-package module dependencies + dep_pkgs :: [PackageName], -- External package dependencies + dep_orphs :: [ModuleName] } -- Orphan modules (whether home or external pkg) + +noDependencies :: Dependencies +noDependencies = Deps [] [] [] + +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 -- So if the rules change, you'll recompile, even if you don't use them. -- This is easy to implement, and it's safer: you might not have used the rules last -- time round, but if someone has added a new rule you might need it this time -- The export list field is (Just v) if we depend on the export list: - -- we imported the module without saying exactly what we imported + -- i.e. 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. \end{code} @@ -638,22 +689,10 @@ data WhatsImported name = NothingAtAll -- The module is below us in the %************************************************************************ %* * -\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 @@ -661,6 +700,17 @@ type PackageInstEnv = InstEnv data ExternalPackageState = EPS { + eps_is_boot :: !(ModuleEnv (ModuleName, IsBootInterface)), + -- In OneShot mode (only), home-package modules accumulate in the + -- external package state, and are sucked in lazily. + -- For these home-pkg modules (only) we need to record which are + -- boot modules. We set this field after loading all the + -- explicitly-imported interfaces, but before doing anything else + -- + -- The ModuleName part is not necessary, but it's useful for + -- debug prints, and it's convenient because this field comes + -- direct from TcRnTypes.ImportAvails.imp_dep_mods + eps_PIT :: !PackageIfaceTable, -- The ModuleIFaces for modules in external packages -- whose interfaces we have opened @@ -674,11 +724,6 @@ data ExternalPackageState -- * Fixities -- * Deprecations - eps_imp_mods :: !ImportedModuleInfo, - -- Modules that we know something about, because they are mentioned - -- in interface files, BUT which we have not loaded yet. - -- No module is both in here and in the PIT - eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules eps_inst_env :: !PackageInstEnv, -- The total InstEnv accumulated from @@ -688,24 +733,24 @@ data ExternalPackageState -- Holding pens for stuff that has been read in from file, -- but not yet slurped into the renamer - eps_decls :: !DeclsMap, - -- 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 + 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 + + eps_stats :: !EpsStats } + +-- "In" means read from iface files +-- "Out" means actually sucked in and type-checked +data EpsStats = EpsStats { n_ifaces_in + , n_decls_in, n_decls_out + , n_rules_in, n_rules_out + , n_insts_in, n_insts_out :: !Int } \end{code} The NameCache makes sure that there is just one Unique assigned for @@ -730,41 +775,49 @@ data NameCache -- Ensures that one implicit parameter name gets one unique } -type OrigNameCache = FiniteMap (ModuleName,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) +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 +type Gated d = ([Name], (ModuleName, d)) -- The [Name] 'gate' the declaration; always non-empty + -- ModuleName records which iface file this + -- decl came from + +type RulePool = [Gated IfaceRule] + +addRulesToPool :: RulePool + -> [Gated IfaceRule] + -> RulePool +addRulesToPool rules new_rules = new_rules ++ rules + +------------------------- +addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats +-- Add stats for one newly-read interface +addEpsInStats stats n_decls n_insts n_rules + = stats { n_ifaces_in = n_ifaces_in stats + 1 + , n_decls_in = n_decls_in stats + n_decls + , n_insts_in = n_insts_in stats + n_insts + , n_rules_in = n_rules_in stats + n_rules } + +------------------------- +type InstPool = 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 -- the importing module. See "The gating story" in RnIfaces for details. + + +addInstsToPool :: InstPool -> [(Name, Gated IfaceInst)] -> InstPool +addInstsToPool insts new_insts + = foldr add insts new_insts + where + add :: (Name, Gated IfaceInst) -> NameEnv [Gated IfaceInst] -> NameEnv [Gated IfaceInst] + add (cls,new_inst) insts = extendNameEnv_C combine insts cls [new_inst] + where + combine old_insts _ = new_inst : old_insts \end{code} @@ -830,150 +883,4 @@ byteCodeOfObject (BCOs bc) = bc \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("at") <+> ppr loc) - | otherwise = empty -\end{code}