X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=4214c697fc6d658b8ff11420b18558ef98242ef3;hb=8f0c89cbbbad60c4f05356fcb9053b7ed0c18075;hp=9a6dfd19d65529d24801d58dd5c73777b5a006fc;hpb=b732f90c9e6b1c0177e04a5f84abac7f50cca4e4;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 9a6dfd1..4214c69 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -5,64 +5,173 @@ \begin{code} module HscTypes ( - ModDetails(..), GlobalSymbolTable, - HomeSymbolTable, PackageSymbolTable, + HscEnv(..), + GhciMode(..), - TyThing(..), lookupTypeEnv, lookupFixityEnv, + ModDetails(..), ModIface(..), + ModGuts(..), ModImports(..), ForeignStubs(..), + ParsedIface(..), IfaceDeprecs, + + HomePackageTable, HomeModInfo(..), emptyHomePackageTable, + + ExternalPackageState(..), + PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable, + lookupIface, lookupIfaceByModName, moduleNameToModule, + emptyModIface, + + InteractiveContext(..), emptyInteractiveContext, icPrintUnqual, + + IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts, + + VersionInfo(..), initialVersionInfo, lookupVersion, + FixityEnv, lookupFixity, collectFixities, emptyFixityEnv, + + TyThing(..), isTyClThing, implicitTyThingIds, + + TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv, + extendTypeEnvList, extendTypeEnvWithIds, + typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds, + + WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..), + Dependencies(..), noDependencies, + IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, + NameCache(..), OrigNameCache, OrigIParamCache, + Avails, availsToNameSet, availName, availNames, + GenAvailInfo(..), AvailInfo, RdrAvailInfo, + ExportItem, RdrExportItem, - WhetherHasOrphans, ImportVersion, ExportItem, - PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap, - IfaceInsts, IfaceRules, DeprecationEnv, OrigNameEnv, - AvailEnv, AvailInfo, GenAvailInfo(..), PersistentCompilerState(..), - InstEnv, ClsInstEnv, DFunId, + Deprecations(..), lookupDeprec, plusDeprecs, - GlobalRdrEnv, RdrAvailInfo, + InstEnv, ClsInstEnv, DFunId, + PackageInstEnv, PackageRuleBase, - CompResult(..), HscResult(..), + GlobalRdrEnv, GlobalRdrElt(..), emptyGlobalRdrEnv, pprGlobalRdrEnv, + LocalRdrEnv, extendLocalRdrEnv, isLocalGRE, unQualInScope, + + -- Linker stuff + Linkable(..), isObjectLinkable, + Unlinked(..), CompiledByteCode, + isObject, nameOfObject, isInterpretable, byteCodeOfObject, -- Provenance - Provenance(..), ImportReason(..), PrintUnqualified, + Provenance(..), ImportReason(..), pprNameProvenance, hasBetterProv ) where #include "HsVersions.h" -import Name ( Name, NameEnv, NamedThing, - unitNameEnv, extendNameEnv, plusNameEnv, - lookupNameEnv, emptyNameEnv, getName, nameModule, - nameSrcLoc ) -import Module ( Module, ModuleName, - extendModuleEnv, lookupModuleEnv ) -import Class ( Class ) +#ifdef GHCI +import ByteCodeAsm ( CompiledByteCode ) +#endif + +import RdrName ( RdrName, mkRdrUnqual, + RdrNameEnv, addListToRdrEnv, foldRdrEnv, isUnqual, + rdrEnvToList, emptyRdrEnv ) +import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc ) +import NameEnv +import NameSet import OccName ( OccName ) -import RdrName ( RdrNameEnv, emptyRdrEnv ) -import Outputable ( SDoc ) -import UniqFM ( UniqFM ) -import FiniteMap ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM ) -import Bag ( Bag ) +import Module +import InstEnv ( InstEnv, ClsInstEnv, DFunId ) +import Rules ( RuleBase ) +import CoreSyn ( CoreBind ) import Id ( Id ) -import VarEnv ( IdEnv, emptyVarEnv ) -import BasicTypes ( Version, Fixity, defaultFixity ) -import TyCon ( TyCon ) -import ErrUtils ( ErrMsg, WarnMsg ) -import CmLink ( Linkable ) -import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameHsDecl, - RdrNameDeprecation, RdrNameFixitySig ) -import InterpSyn ( UnlinkedIBind ) -import UniqSupply ( UniqSupply ) -import HsDecls ( DeprecTxt ) -import CoreSyn ( CoreRule ) -import NameSet ( NameSet ) -import Type ( Type ) -import VarSet ( TyVarSet ) -import Panic ( panic ) +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 CmdLineOpts ( DynFlags ) + +import BasicTypes ( Version, initialVersion, IPName, + Fixity, FixitySig(..), defaultFixity ) + +import HsSyn ( DeprecTxt, TyClDecl, InstDecl, RuleDecl, + tyClDeclName, ifaceRuleDeclName, tyClDeclNames, + instDeclDFun ) +import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl ) + +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 UniqSupply ( UniqSupply ) +import Maybe ( fromJust ) +import FastString ( FastString ) + +import Time ( ClockTime ) \end{code} + +%************************************************************************ +%* * +\subsection{Compilation environment} +%* * +%************************************************************************ + +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 } +\end{code} + +The GhciMode is self-explanatory: + +\begin{code} +data GhciMode = Batch | Interactive | OneShot + deriving Eq +\end{code} + +\begin{code} +type HomePackageTable = ModuleEnv HomeModInfo -- Domain = modules in the home package +type PackageIfaceTable = ModuleEnv ModIface -- Domain = modules in the imported packages + +emptyHomePackageTable = emptyModuleEnv +emptyPackageIfaceTable = emptyModuleEnv + +data HomeModInfo = HomeModInfo { hm_iface :: ModIface, + hm_details :: ModDetails, + hm_linkable :: Linkable } +\end{code} + +Simple lookups in the symbol table. + +\begin{code} +lookupIface :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface +-- We often have two IfaceTables, and want to do a lookup +lookupIface hpt pit mod + = case lookupModuleEnv hpt mod of + Just mod_info -> Just (hm_iface mod_info) + Nothing -> lookupModuleEnv pit mod + +lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface +-- We often have two IfaceTables, and want to do a lookup +lookupIfaceByModName hpt pit mod + = case lookupModuleEnvByName hpt mod of + Just mod_info -> Just (hm_iface mod_info) + Nothing -> lookupModuleEnvByName pit mod +\end{code} + +\begin{code} +-- 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 :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Module +moduleNameToModule hpt pit mod + = mi_module (fromJust (lookupIfaceByModName hpt pit mod)) +\end{code} + + %************************************************************************ %* * \subsection{Symbol tables and Module details} @@ -71,80 +180,230 @@ import SrcLoc ( SrcLoc, isGoodSrcLoc ) 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, + mi_package :: !PackageName, -- Which package the module comes from + mi_version :: !VersionInfo, -- Version info for everything in this module + 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 + + 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) + -- 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 + + 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.) + + mi_fixities :: !FixityEnv, -- Fixities + mi_deprecs :: Deprecations, -- Deprecations + -- NOT STRICT! we read this field lazilly from the interface file + + mi_decls :: IfaceDecls -- The RnDecls form of ModDetails + -- NOT STRICT! we fill this field with _|_ sometimes + } + +-- Should be able to construct ModDetails from mi_decls in ModIface data ModDetails = ModDetails { - md_module :: Module, -- Complete with package info - md_version :: VersionInfo, -- Module version number - md_orphan :: WhetherHasOrphans, -- Whether this module has orphans - md_usages :: [ImportVersion Name], -- Usages - - md_exports :: Avails, -- What it exports - md_globals :: GlobalRdrEnv, -- Its top level environment - - md_fixities :: NameEnv Fixity, -- Fixities - md_deprecs :: NameEnv DeprecTxt, -- Deprecations - -- 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 :: RuleEnv -- 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 } --- ModIFace is nearly the same as RnMonad.ParsedIface. --- Right now it's identical :) -data ModIFace - = ModIFace { - mi_mod :: Module, -- Complete with package info - mi_vers :: Version, -- Module version number - mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans - mi_usages :: [ImportVersion OccName], -- Usages - mi_exports :: [ExportItem], -- Exports - mi_insts :: [RdrNameInstDecl], -- Local instance declarations - mi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions - mi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, - -- with their version - mi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version - mi_deprecs :: [RdrNameDeprecation] -- Deprecations - } +-- 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 +-- ModDetails are extracted and the ModGuts is dicarded. + +data ModGuts + = ModGuts { + mg_module :: !Module, + mg_exports :: !Avails, -- 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_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment + mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in this module + mg_deprecs :: !Deprecations, -- Deprecations declared in the module + + mg_types :: !TypeEnv, + mg_insts :: ![DFunId], -- Instances + mg_rules :: ![IdCoreRule], -- Rules from this module + mg_binds :: ![CoreBind], -- Bindings for this module + mg_foreign :: !ForeignStubs + } +-- The ModGuts takes on several slightly different forms: +-- +-- After simplification, the following fields change slightly: +-- mg_rules Orphan rules only (local ones now attached to binds) +-- mg_binds With rules attached +-- +-- After CoreTidy, the following fields change slightly: +-- mg_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 +-- +-- mg_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 +-- +-- mg_rules All rules for exported things, substituted with final Ids +-- +-- mg_binds Tidied + + + +data ModImports + = ModImports { + imp_direct :: ![(Module,Bool)], -- Explicitly-imported modules + -- Boolean is true if we imported the whole + -- module (apart, perhaps, from hiding some) + imp_pkg_mods :: !ModuleSet, -- Non-home-package modules on which we depend, + -- directly or indirectly + imp_home_names :: !NameSet -- Home package things on which we depend, + -- directly or indirectly + } + +data ForeignStubs = NoStubs + | ForeignStubs + SDoc -- Header file prototypes for + -- "foreign exported" functions + SDoc -- C stubs to use when calling + -- "foreign exported" functions + [FastString] -- Headers that need to be included + -- into C code generated for 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} -emptyModDetails :: Module -> ModDetails -emptyModDetails mod - = ModDetails { md_module = mod, - md_exports = [], - md_globals = emptyRdrEnv, - md_fixities = emptyNameEnv, - md_deprecs = emptyNameEnv, - md_types = emptyNameEnv, - md_insts = [], - md_rules = emptyRuleEnv +emptyModIface :: Module -> ModIface +emptyModIface mod + = ModIface { mi_module = mod, + mi_package = basePackage, -- XXX fully bogus + mi_version = initialVersionInfo, + mi_usages = [], + mi_deps = noDependencies, + mi_orphan = False, + mi_boot = False, + mi_exports = [], + mi_fixities = emptyNameEnv, + mi_globals = Nothing, + mi_deprecs = NoDeprecs, + mi_decls = panic "emptyModIface: decls" } \end{code} -Symbol tables map modules to ModDetails: + +%************************************************************************ +%* * + Parsed interface files +%* * +%************************************************************************ + +A ParsedIface is exactly as read from an interface file. \begin{code} -type SymbolTable = ModuleEnv ModDetails -type HomeSymbolTable = SymbolTable -- Domain = modules in the home package -type PackageSymbolTable = SymbolTable -- Domain = modules in the some other package -type GlobalSymbolTable = SymbolTable -- Domain = all modules +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} -Simple lookups in the symbol table. + +%************************************************************************ +%* * +\subsection{The interactive context} +%* * +%************************************************************************ \begin{code} -lookupFixityEnv :: SymbolTable -> Name -> Maybe Fixity - -- Returns defaultFixity if there isn't an explicit fixity -lookupFixityEnv tbl name - = case lookupModuleEnv tbl (nameModule name) of - Nothing -> Nothing - Just details -> lookupNameEnv (md_fixities details) name +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_rn_local_env :: LocalRdrEnv, -- Lexical context for variables bound + -- during interaction + + ic_type_env :: TypeEnv -- Ditto for types + } + +emptyInteractiveContext + = InteractiveContext { ic_toplev_scope = [], + ic_exports = [], + ic_rn_gbl_env = emptyRdrEnv, + ic_rn_local_env = emptyRdrEnv, + ic_type_env = emptyTypeEnv } + +icPrintUnqual :: InteractiveContext -> PrintUnqualified +icPrintUnqual ictxt = unQualInScope (ic_rn_gbl_env ictxt) \end{code} @@ -155,55 +414,60 @@ lookupFixityEnv tbl name %************************************************************************ \begin{code} -type TypeEnv = NameEnv TyThing - -data TyThing = AnId Id - | ATyCon TyCon - | AClass Class - -instance NamedThing TyThing where - getName (AnId id) = getName id - getName (ATyCon tc) = getName tc - getName (AClass cl) = getName 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 <- 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} -lookupTypeEnv :: SymbolTable -> Name -> Maybe TyThing -lookupTypeEnv tbl name - = case lookupModuleEnv tbl (nameModule name) of - Just details -> lookupNameEnv (md_types details) name - Nothing -> Nothing +type TypeEnv = NameEnv TyThing +emptyTypeEnv = emptyNameEnv -groupTyThings :: [TyThing] -> FiniteMap Module TypeEnv - -- Finite map because we want the range too -groupTyThings things - = foldl add emptyFM things - where - add :: FiniteMap Module TypeEnv -> TyThing -> FiniteMap Module TypeEnv - add tbl thing = addToFM tbl mod new_env - where - name = getName thing - mod = nameModule name - new_env = case lookupFM tbl mod of - Nothing -> unitNameEnv name thing - Just env -> extendNameEnv env name thing +mkTypeEnv :: [TyThing] -> TypeEnv +mkTypeEnv things = extendTypeEnvList emptyTypeEnv things -extendTypeEnv :: SymbolTable -> FiniteMap Module TypeEnv -> SymbolTable -extendTypeEnv tbl things - = foldFM add tbl things - where - add mod type_env tbl - = panic "extendTypeEnv" --extendModuleEnv mod new_details - where - new_details - = case lookupModuleEnv tbl mod of - Nothing -> (emptyModDetails mod) {md_types = type_env} - Just details -> details {md_types = md_types details - `plusNameEnv` type_env} +extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv +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] \end{code} +\begin{code} +lookupType :: HomePackageTable -> PackageTypeEnv -> Name -> Maybe TyThing +lookupType hpt pte name + = case lookupModuleEnv hpt (nameModule name) of + Just details -> lookupNameEnv (md_types (hm_details details)) name + Nothing -> lookupNameEnv pte name +\end{code} %************************************************************************ %* * @@ -217,21 +481,54 @@ but they are mostly elaborated elsewhere \begin{code} data VersionInfo = VersionInfo { - modVers :: Version, - fixVers :: Version, - ruleVers :: Version, - declVers :: NameEnv Version + 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' } -type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation - -type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class -type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class -type DFunId = Id - -type RuleEnv = IdEnv [CoreRule] - -emptyRuleEnv = emptyVarEnv +initialVersionInfo :: VersionInfo +initialVersionInfo = VersionInfo { vers_module = initialVersion, + vers_exports = initialVersion, + vers_rules = initialVersion, + vers_decls = emptyNameEnv + } + +lookupVersion :: NameEnv Version -> Name -> Version +lookupVersion env name = lookupNameEnv env name `orElse` initialVersion + +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 + +lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt +lookupDeprec NoDeprecs name = Nothing +lookupDeprec (DeprecAll txt) name = Just txt +lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of + Just (_, txt) -> Just txt + Nothing -> Nothing + +plusDeprecs :: Deprecations -> Deprecations -> Deprecations +plusDeprecs d NoDeprecs = d +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} @@ -249,25 +546,64 @@ data GenAvailInfo name = Avail name -- An ordinary identifier 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]) + +availsToNameSet :: [AvailInfo] -> NameSet +availsToNameSet avails = foldl add emptyNameSet avails + where + add set avail = addListToNameSet set (availNames avail) + +availName :: GenAvailInfo name -> name +availName (Avail n) = n +availName (AvailTC n _) = n + +availNames :: GenAvailInfo name -> [name] +availNames (Avail n) = [n] +availNames (AvailTC n ns) = ns + +instance Outputable n => Outputable (GenAvailInfo n) where + ppr = pprAvail + +pprAvail :: Outputable n => GenAvailInfo n -> SDoc +pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of + [] -> empty + ns' -> braces (hsep (punctuate comma (map ppr ns'))) + +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 + +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] + ] \end{code} %************************************************************************ %* * -\subsection{ModIface} +\subsection{WhatsImported} %* * %************************************************************************ \begin{code} -type ExportItem = (ModuleName, [RdrAvailInfo]) - -type ImportVersion name = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name) - -type ModVersionInfo = (Version, -- Version of the whole module - Version, -- Version number for all fixity decls together - Version) -- ...ditto all rules together - type WhetherHasOrphans = Bool -- An "orphan" is -- * an instance decl in a module other than the defn module for @@ -275,27 +611,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 - -data WhatsImported name = NothingAtAll -- The module is below us in the - -- hierarchy, but we import nothing - - | Everything Version -- The module version - - | Specifically Version -- Module version - Version -- Fixity version - Version -- Rules version - [(name,Version)] -- List guaranteed non-empty - deriving( Eq ) - -- 'Specifically' doesn't let you say "I imported f but none of the fixities in - -- the module". If you use anything in the module you get its fixity and rule version - -- So if the fixities or rules change, you'll recompile, even if you don't use either. +type IsBootInterface = Bool + +-- 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 +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 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 + } 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 - -- 'Everything' means there was a "module M" in - -- this module's export list, so we just have to go by M's version, - -- not the list of (name,version) pairs + -- The export list field is (Just v) if we depend on the export list: + -- 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} @@ -305,48 +651,68 @@ data WhatsImported name = NothingAtAll -- The module is below us in the %* * %************************************************************************ +The @PersistentCompilerState@ persists across successive calls to the +compiler. + \begin{code} data PersistentCompilerState = PCS { - pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules - -- except that the InstEnv components is empty - pcs_insts :: InstEnv, -- The total InstEnv accumulated from all - -- the non-home-package modules - pcs_rules :: RuleEnv, -- Ditto RuleEnv - - pcs_PRS :: PersistentRenamerState + pcs_nc :: !NameCache, + pcs_EPS :: !ExternalPackageState } \end{code} -The @PersistentRenamerState@ persists across successive calls to the -compiler. - -It contains: - * A name supply, which deals with allocating unique names to - (Module,OccName) original names, - - * An accumulated InstEnv from all the modules in pcs_PST - 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 \begin{code} -data PersistentRenamerState - = PRS { prsOrig :: OrigNameEnv, - prsDecls :: DeclsMap, - prsInsts :: IfaceInsts, - prsRules :: IfaceRules - } +type PackageTypeEnv = TypeEnv +type PackageRuleBase = RuleBase +type PackageInstEnv = InstEnv + +data ExternalPackageState + = EPS { + eps_PIT :: !PackageIfaceTable, + -- The ModuleIFaces for modules in external packages + -- whose interfaces we have opened + -- The declarations in these interface files are held in + -- eps_decls, eps_insts, eps_rules (below), not in the + -- mi_decls fields of the iPIT. + -- What _is_ in the iPIT is: + -- * The Module + -- * Version info + -- * Its exports + -- * Fixities + -- * Deprecations + + eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules + + eps_inst_env :: !PackageInstEnv, -- The total InstEnv accumulated from + -- all the external-package modules + eps_rule_base :: !PackageRuleBase, -- Ditto RuleEnv + + + -- 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 + } \end{code} -The OrigNameEnv makes sure that there is just one Unique assigned for +The NameCache 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 @@ -359,72 +725,106 @@ encounter the occurrence, we may not know the details of the module, so we just store junk. Then when we find the binding site, we fix it up. \begin{code} -data OrigNameEnv - = Orig { origNames :: FiniteMap (ModuleName,OccName) Name, -- Ensures that one original name gets one unique - origIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique +data NameCache + = NameCache { nsUniqs :: UniqSupply, + -- Supply of uniques + nsNames :: OrigNameCache, + -- Ensures that one original name gets one unique + nsIPs :: OrigIParamCache + -- Ensures that one implicit parameter name gets one unique } -\end{code} +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) +\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, RdrNameHsDecl)) - -type IfaceInsts = Bag GatedDecl -type IfaceRules = Bag GatedDecl - -type GatedDecl = (NameSet, (Module, RdrNameHsDecl)) +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 + -- 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} %************************************************************************ %* * -\subsection{The result of compiling one module} +\subsection{Linkable stuff} %* * %************************************************************************ +This stuff is in here, rather than (say) in Linker.lhs, because the Linker.lhs +stuff is the *dynamic* linker, and isn't present in a stage-1 compiler + \begin{code} -data CompResult - = CompOK ModDetails -- new details (HST additions) - (Maybe (ModIFace, Linkable)) - -- summary and code; Nothing => compilation not reqd - -- (old summary and code are still valid) - PersistentCompilerState -- updated PCS - (Bag WarnMsg) -- warnings - - | CompErrs PersistentCompilerState -- updated PCS - (Bag ErrMsg) -- errors - (Bag WarnMsg) -- warnings - - --- The driver sits between 'compile' and 'hscMain', translating calls --- to the former into calls to the latter, and results from the latter --- into results from the former. It does things like preprocessing --- the .hs file if necessary, and compiling up the .stub_c files to --- generate Linkables. - -data HscResult - = HscOK ModDetails -- new details (HomeSymbolTable additions) - (Maybe ModIFace) -- new iface (if any compilation was done) - (Maybe String) -- generated stub_h filename (in /tmp) - (Maybe String) -- generated stub_c filename (in /tmp) - (Maybe [UnlinkedIBind]) -- interpreted code, if any - PersistentCompilerState -- updated PCS - (Bag WarnMsg) -- warnings - - | HscErrs PersistentCompilerState -- updated PCS - (Bag ErrMsg) -- errors - (Bag WarnMsg) -- warnings - --- These two are only here to avoid recursion between CmCompile and --- CompManager. They really ought to be in the latter. -type ModuleEnv a = UniqFM a -- Domain is Module - -type HomeModMap = FiniteMap ModuleName Module -- domain: home mods only -type HomeInterfaceTable = ModuleEnv ModIFace +data Linkable = LM { + linkableTime :: ClockTime, -- Time at which this linkable was built + -- (i.e. when the bytecodes were produced, + -- or the mod date on the files) + linkableModName :: ModuleName, -- Should be Module, but see below + linkableUnlinked :: [Unlinked] + } + +isObjectLinkable :: Linkable -> Bool +isObjectLinkable l = all isObject (linkableUnlinked l) + +instance Outputable Linkable where + ppr (LM when_made mod unlinkeds) + = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod) + $$ nest 3 (ppr unlinkeds) + +------------------------------------------- +data Unlinked + = DotO FilePath + | DotA FilePath + | DotDLL FilePath + | BCOs CompiledByteCode + +#ifndef GHCI +data CompiledByteCode = NoByteCode +#endif + +instance Outputable Unlinked where + ppr (DotO path) = text "DotO" <+> text path + ppr (DotA path) = text "DotA" <+> text path + ppr (DotDLL path) = text "DotDLL" <+> text path +#ifdef GHCI + ppr (BCOs bcos) = text "BCOs" <+> ppr bcos +#else + ppr (BCOs bcos) = text "No byte code" +#endif + +isObject (DotO _) = True +isObject (DotA _) = True +isObject (DotDLL _) = True +isObject _ = False + +isInterpretable = not . isObject + +nameOfObject (DotO fn) = fn +nameOfObject (DotA fn) = fn +nameOfObject (DotDLL fn) = fn + +byteCodeOfObject (BCOs bc) = bc \end{code} @@ -434,13 +834,75 @@ type HomeInterfaceTable = ModuleEnv ModIFace %* * %************************************************************************ +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 [(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 + +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. @@ -451,17 +913,29 @@ data Provenance | NonLocalDef -- Defined non-locally ImportReason - PrintUnqualified - -{- -Moved here from Name. -pp_prov (LocalDef _ Exported) = char 'x' -pp_prov (LocalDef _ NotExported) = char 'l' -pp_prov (NonLocalDef ImplicitImport _) = char 'j' -pp_prov (NonLocalDef (UserImport _ _ True ) _) = char 'I' -- Imported by name -pp_prov (NonLocalDef (UserImport _ _ False) _) = char 'i' -- Imported by .. -pp_prov SystemProv = char 's' --} + +-- 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 @@ -476,11 +950,6 @@ data ImportReason -- This info is used when warning of unused names. | ImplicitImport -- Imported implicitly for some other reason - - -type PrintUnqualified = Bool -- True <=> the unqualified name of this thing is - -- in scope in this module, so print it - -- unqualified in error messages \end{code} \begin{code} @@ -489,19 +958,20 @@ hasBetterProv :: Provenance -> Provenance -> Bool -- a local thing over an imported thing -- a user-imported thing over a non-user-imported thing -- an explicitly-imported thing over an implicitly imported thing -hasBetterProv LocalDef _ = True -hasBetterProv (NonLocalDef (UserImport _ _ True) _) _ = True -hasBetterProv (NonLocalDef (UserImport _ _ _ ) _) (NonLocalDef ImplicitImport _) = True -hasBetterProv _ _ = False +hasBetterProv LocalDef _ = True +hasBetterProv (NonLocalDef (UserImport _ _ _ )) (NonLocalDef ImplicitImport) = True +hasBetterProv _ _ = False -pprNameProvenance :: Name -> Provenance -> SDoc -pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name) -pprNameProvenance name (NonLocalDef why _) = sep [ppr_reason why, - nest 2 (parens (ppr_defn (nameSrcLoc name)))] +pprNameProvenance :: 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 = ptext SLIT("at") <+> ppr loc +ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc) | otherwise = empty \end{code}