X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=045c17fdb9138a214c75ae045a7a7e299fa79165;hb=2db3c4308e8d1ba14b502b9ccb9bee3fd3bd145e;hp=5bd9e1630b1506c1ed06dd9f0fb05c283d05aef8;hpb=61fae1d3fb61c5f53c3fbcb94afe7c548ad31591;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 5bd9e16..045c17f 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -7,13 +7,13 @@ module HscTypes ( GhciMode(..), - ModuleLocation(..), + ModuleLocation(..), showModMsg, ModDetails(..), ModIface(..), HomeSymbolTable, emptySymbolTable, PackageTypeEnv, HomeIfaceTable, PackageIfaceTable, emptyIfaceTable, - lookupIface, lookupIfaceByModName, + lookupIface, lookupIfaceByModName, moduleNameToModule, emptyModIface, InteractiveContext(..), @@ -21,6 +21,7 @@ module HscTypes ( IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts, VersionInfo(..), initialVersionInfo, lookupVersion, + FixityEnv, lookupFixity, collectFixities, TyThing(..), isTyClThing, implicitTyThingIds, @@ -34,6 +35,7 @@ module HscTypes ( NameSupply(..), OrigNameCache, OrigIParamCache, Avails, AvailEnv, emptyAvailEnv, GenAvailInfo(..), AvailInfo, RdrAvailInfo, + ExportItem, RdrExportItem, PersistentCompilerState(..), Deprecations(..), lookupDeprec, @@ -53,37 +55,37 @@ module HscTypes ( #include "HsVersions.h" -import RdrName ( RdrName, RdrNameEnv, addListToRdrEnv, emptyRdrEnv, +import RdrName ( RdrName, RdrNameEnv, addListToRdrEnv, mkRdrUnqual, rdrEnvToList ) import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc ) import NameEnv import OccName ( OccName ) -import Module ( Module, ModuleName, ModuleEnv, - lookupModuleEnv, lookupModuleEnvByName, emptyModuleEnv - ) +import Module import InstEnv ( InstEnv, ClsInstEnv, DFunId ) import Rules ( RuleBase ) import CoreSyn ( CoreBind ) import Id ( Id ) import Class ( Class, classSelIds ) -import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable ) -import DataCon ( dataConId, dataConWrapId ) +import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe ) +import DataCon ( dataConWorkId, dataConWrapId ) -import BasicTypes ( Version, initialVersion, Fixity, IPName ) +import BasicTypes ( Version, initialVersion, Fixity, defaultFixity, IPName ) -import HsSyn ( DeprecTxt, tyClDeclName, ifaceRuleDeclName ) +import HsSyn ( DeprecTxt, TyClDecl, tyClDeclName, ifaceRuleDeclName, + tyClDeclNames ) import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl ) import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl ) import CoreSyn ( IdCoreRule ) -import FiniteMap ( FiniteMap ) +import FiniteMap import Bag ( Bag ) -import Maybes ( seqMaybe, orElse ) +import Maybes ( seqMaybe, orElse, expectJust ) import Outputable import SrcLoc ( SrcLoc, isGoodSrcLoc ) import Util ( thenCmp, sortLt ) import UniqSupply ( UniqSupply ) +import Maybe ( fromJust ) \end{code} %************************************************************************ @@ -116,6 +118,18 @@ data ModuleLocation instance Outputable ModuleLocation where ppr = text . show + +-- Probably doesn't really belong here, but used in HscMain and InteractiveUI. + +showModMsg :: Bool -> Module -> ModuleLocation -> String +showModMsg use_object mod location = + mod_str ++ replicate (max 0 (16 - length mod_str)) ' ' + ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", " + ++ (if use_object + then expectJust "showModMsg" (ml_obj_file location) + else "interpreted") + ++ " )" + where mod_str = moduleUserString mod \end{code} For a module in another package, the hs_file and obj_file @@ -135,32 +149,45 @@ where the object file will reside if/when it is created. A @ModIface@ plus a @ModDetails@ summarises everything we know about a compiled module. The @ModIface@ is the stuff *before* linking, -and can be written out to an interface file. The @ModDetails@ is after -linking; it is the "linked" form of the mi_decls field. +and can be written out to an interface file. (The @ModDetails@ is after +linking; it is the "linked" form of the mi_decls field.) + +When we *read* an interface file, we also construct a @ModIface@ from it, +except that the mi_decls part is empty; when reading we consolidate +the declarations into a single indexed map in the @PersistentRenamerState@. \begin{code} data ModIface = ModIface { - mi_module :: !Module, -- Complete with package info + mi_module :: !Module, + mi_package :: !PackageName, -- Which package the module comes from mi_version :: !VersionInfo, -- Module version number + mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans + -- NOT STRICT! we fill this field with _|_ sometimes + mi_boot :: !IsBootInterface, -- read from an hi-boot file? - mi_usages :: ![ImportVersion Name], + mi_usages :: [ImportVersion Name], -- Usages; kept sorted so that it's easy to decide -- whether to write a new iface file (changing usages -- doesn't affect the version of this module) + -- NOT STRICT! we read this field lazilly from the interface file - mi_exports :: ![(ModuleName,Avails)], + mi_exports :: ![ExportItem], -- What it exports Kept sorted by (mod,occ), to make -- version comparisons easier - mi_globals :: !GlobalRdrEnv, -- Its top level environment + mi_globals :: !(Maybe GlobalRdrEnv), + -- Its top level environment or Nothing if we read this + -- interface from a file. - mi_fixities :: !(NameEnv Fixity), -- Fixities - mi_deprecs :: !Deprecations, -- Deprecations + mi_fixities :: !FixityEnv, -- Fixities + mi_deprecs :: Deprecations, -- Deprecations + -- 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 } data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted @@ -226,13 +253,14 @@ data ModDetails emptyModIface :: Module -> ModIface emptyModIface mod = ModIface { mi_module = mod, + mi_package = preludePackage, -- XXX fully bogus mi_version = initialVersionInfo, mi_usages = [], mi_orphan = False, mi_boot = False, mi_exports = [], mi_fixities = emptyNameEnv, - mi_globals = emptyRdrEnv, + mi_globals = Nothing, mi_deprecs = NoDeprecs, mi_decls = panic "emptyModIface: decls" } @@ -270,6 +298,14 @@ lookupIfaceByModName :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> May -- We often have two IfaceTables, and want to do a lookup lookupIfaceByModName hit pit mod = lookupModuleEnvByName hit mod `seqMaybe` lookupModuleEnvByName pit mod + +-- Use instead of Finder.findModule if possible: this way doesn't +-- require filesystem operations, and it is guaranteed not to fail +-- when the IfaceTables are properly populated (i.e. after the renamer). +moduleNameToModule :: HomeIfaceTable -> PackageIfaceTable -> ModuleName + -> Module +moduleNameToModule hit pit mod + = mi_module (fromJust (lookupIfaceByModName hit pit mod)) \end{code} @@ -282,10 +318,19 @@ lookupIfaceByModName hit pit mod \begin{code} data InteractiveContext = InteractiveContext { - ic_module :: Module, -- The current module in which - -- the user is sitting + ic_toplev_scope :: [Module], -- Include the "top-level" scope of + -- these modules + + ic_exports :: [Module], -- Include just the exports of these + -- modules - ic_rn_env :: LocalRdrEnv, -- Lexical context for variables bound + ic_rn_gbl_env :: GlobalRdrEnv, -- The cached GlobalRdrEnv, built from + -- ic_toplev_scope and ic_exports + + ic_print_unqual :: PrintUnqualified, + -- cached PrintUnqualified, as above + + ic_rn_local_env :: LocalRdrEnv, -- Lexical context for variables bound -- during interaction ic_type_env :: TypeEnv -- Ditto for types @@ -339,14 +384,14 @@ implicitTyThingIds things go (AClass cl) = classSelIds cl go (ATyCon tc) = tyConGenIds tc ++ tyConSelIds tc ++ - [ n | dc <- tyConDataConsIfAvailable 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 = [dataConId dc, dataConWrapId dc] + | otherwise = [dataConWorkId dc, dataConWrapId dc] \end{code} @@ -445,11 +490,14 @@ 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 AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it emptyAvailEnv :: AvailEnv emptyAvailEnv = emptyNameEnv - + instance Outputable n => Outputable (GenAvailInfo n) where ppr = pprAvail @@ -461,10 +509,24 @@ pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of pprAvail (Avail n) = ppr n \end{code} +\begin{code} +type FixityEnv = NameEnv Fixity + +lookupFixity :: FixityEnv -> Name -> Fixity +lookupFixity env n = lookupNameEnv env n `orElse` defaultFixity + +collectFixities :: FixityEnv -> [TyClDecl Name pat] -> [(Name,Fixity)] +collectFixities env decls + = [ (n, fix) + | d <- decls, (n,_) <- tyClDeclNames d, + Just fix <- [lookupNameEnv env n] + ] +\end{code} + %************************************************************************ %* * -\subsection{ModIface} +\subsection{WhatsImported} %* * %************************************************************************ @@ -514,6 +576,24 @@ type IsExported = Name -> Bool -- True for names that are exported from this mo %* * %************************************************************************ +The @PersistentCompilerState@ persists across successive calls to the +compiler. + + * A ModIface for each non-home-package module + + * An accumulated TypeEnv from all the modules in imported packages + + * An accumulated InstEnv from all the modules in imported packages + The point is that we don't want to keep recreating it whenever + we compile a new module. The InstEnv component of pcPST is empty. + (This means we might "see" instances that we shouldn't "really" see; + but the Haskell Report is vague on what is meant to be visible, + so we just take the easy road here.) + + * Ditto for rules + + * The persistent renamer state + \begin{code} data PersistentCompilerState = PCS { @@ -532,24 +612,12 @@ data PersistentCompilerState } \end{code} -The @PersistentRenamerState@ persists across successive calls to the -compiler. -It contains: +The persistent renamer state contains: + * A name supply, which deals with allocating unique names to (Module,OccName) original names, - * An accumulated TypeEnv from all the modules in imported packages - - * An accumulated InstEnv from all the modules in imported packages - The point is that we don't want to keep recreating it whenever - we compile a new module. The InstEnv component of pcPST is empty. - (This means we might "see" instances that we shouldn't "really" see; - but the Haskell Report is vague on what is meant to be visible, - so we just take the easy road here.) - - * Ditto for rules - * A "holding pen" for declarations that have been read out of interface files but not yet sucked in, renamed, and typechecked @@ -561,6 +629,9 @@ type PackageInstEnv = InstEnv data PersistentRenamerState = PRS { prsOrig :: !NameSupply, prsImpMods :: !ImportedModuleInfo, + + -- Holding pens for stuff that has been read in + -- but not yet slurped into the renamer prsDecls :: !DeclsMap, prsInsts :: !IfaceInsts, prsRules :: !IfaceRules