X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=26267c0ef6c9066e4f8477733e071aded4b84c57;hb=caa7c91dd13a69110a55d68b61967f8239de15ce;hp=3ce9eb9c940f95afbccb2b79266620613253d977;hpb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 3ce9eb9..26267c0 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -11,7 +11,13 @@ module HscTypes ( ModDetails(..), ModGuts(..), ModImports(..), ForeignStubs(..), + ModSummary(..), showModMsg, + msHsFilePath, msHiFilePath, msObjFilePath, + + HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases + HomePackageTable, HomeModInfo(..), emptyHomePackageTable, + hptInstances, hptRules, ExternalPackageState(..), EpsStats(..), addEpsInStats, PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable, @@ -21,7 +27,7 @@ module HscTypes ( icPrintUnqual, unQualInScope, ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache, - IfacePackage(..), emptyIfaceDepCache, + emptyIfaceDepCache, Deprecs(..), IfaceDeprecs, @@ -78,9 +84,9 @@ import Type ( TyThing(..) ) import Class ( Class, classSelIds, classTyCon ) import TyCon ( TyCon, tyConSelIds, tyConDataCons ) import DataCon ( dataConImplicitIds ) -import Packages ( PackageId ) +import Packages ( PackageIdH, PackageId ) import CmdLineOpts ( DynFlags ) - +import DriverPhases ( HscSource(..), isHsBoot, hscSourceString ) import BasicTypes ( Version, initialVersion, IPName, Fixity, defaultFixity, DeprecTxt ) @@ -88,14 +94,14 @@ import IfaceSyn ( IfaceInst, IfaceRule, IfaceDecl(ifName) ) import FiniteMap ( FiniteMap ) import CoreSyn ( IdCoreRule ) -import Maybes ( orElse ) +import Maybes ( orElse, fromJust, expectJust ) import Outputable import SrcLoc ( SrcSpan ) import UniqSupply ( UniqSupply ) -import Maybe ( fromJust ) import FastString ( FastString ) import DATA_IOREF ( IORef, readIORef ) +import StringBuffer ( StringBuffer ) import Time ( ClockTime ) \end{code} @@ -126,6 +132,10 @@ data HscEnv -- hsc_HPT is not mutable because we only demand-load -- external packages; the home package is eagerly -- loaded, module by module, by the compilation manager. + -- + -- The HPT may contain modules compiled earlier by --make + -- but not actually below the current module in the dependency + -- graph. (This changes a previous invariant: changed Jan 05.) -- The next two are side-effected by compiling -- to reflect sucking in interface files @@ -159,8 +169,6 @@ emptyPackageIfaceTable = emptyModuleEnv 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} @@ -183,6 +191,41 @@ lookupIfaceByModule hpt pit mod Nothing -> lookupModuleEnv pit mod \end{code} + +\begin{code} +hptInstances :: HscEnv -> (Module -> Bool) -> [DFunId] +-- Find all the instance declarations that are in modules imported +-- by this one, directly or indirectly, and are in the Home Package Table +-- This ensures that we don't see instances from modules --make compiled +-- before this one, but which are not below this one +hptInstances hsc_env want_this_module + = [ dfun + | mod_info <- moduleEnvElts (hsc_HPT hsc_env) + , want_this_module (mi_module (hm_iface mod_info)) + , dfun <- md_insts (hm_details mod_info) ] + +hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [IdCoreRule] +-- Get rules from modules "below" this one (in the dependency sense) +-- C.f Inst.hptInstances +hptRules hsc_env deps + | isOneShot (hsc_mode hsc_env) = [] + | otherwise + = let + hpt = hsc_HPT hsc_env + in + [ rule + | -- Find each non-hi-boot module below me + (mod, False) <- deps + + -- Look it up in the HPT + , let mod_info = ASSERT( mod `elemModuleEnv` hpt ) + fromJust (lookupModuleEnv hpt mod) + + -- And get its dfuns + , rule <- md_rules (hm_details mod_info) ] +\end{code} + + %************************************************************************ %* * \subsection{Symbol tables and Module details} @@ -201,7 +244,7 @@ the declarations into a single indexed map in the @PersistentRenamerState@. \begin{code} data ModIface = ModIface { - mi_package :: !IfacePackage, -- Which package the module comes from + mi_package :: !PackageIdH, -- Which package the module comes from mi_module :: !Module, mi_mod_vers :: !Version, -- Module version: changes when anything changes @@ -239,6 +282,11 @@ data ModIface -- the version of the parent class/tycon changes mi_decls :: [(Version,IfaceDecl)], -- Sorted + 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.) + -- Instance declarations and rules mi_insts :: [IfaceInst], -- Sorted mi_rules :: [IfaceRule], -- Sorted @@ -255,8 +303,6 @@ data ModIface -- seeing if we are up to date wrt the old interface } -data IfacePackage = ThisPackage | ExternalPackage PackageId - -- Should be able to construct ModDetails from mi_decls in ModIface data ModDetails = ModDetails { @@ -274,6 +320,7 @@ data ModDetails data ModGuts = ModGuts { mg_module :: !Module, + mg_boot :: IsBootInterface, -- Whether it's an hs-boot module 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 @@ -339,7 +386,7 @@ data ForeignStubs = NoStubs \end{code} \begin{code} -emptyModIface :: IfacePackage -> Module -> ModIface +emptyModIface :: PackageIdH -> Module -> ModIface emptyModIface pkg mod = ModIface { mi_package = pkg, mi_module = mod, @@ -355,6 +402,7 @@ emptyModIface pkg mod mi_insts = [], mi_rules = [], mi_decls = [], + mi_globals = Nothing, mi_rule_vers = initialVersion, mi_dep_fn = emptyIfaceDepCache, mi_fix_fn = emptyIfaceFixCache, @@ -776,9 +824,10 @@ type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name) \end{code} \begin{code} -type Gated d = ([Name], (Module, d)) -- The [Name] 'gate' the declaration; always non-empty - -- Module records which iface file this - -- decl came from +type Gated d = ([Name], (Module, SDoc, d)) + -- The [Name] 'gate' the declaration; always non-empty + -- Module records which module this decl belongs to + -- SDoc records the pathname of the file, or similar err-ctxt info type RulePool = [Gated IfaceRule] @@ -819,6 +868,72 @@ addInstsToPool insts new_insts %************************************************************************ %* * + The ModSummary type + A ModSummary is a node in the compilation manager's + dependency graph, and it's also passed to hscMain +%* * +%************************************************************************ + +The nodes of the module graph are + EITHER a regular Haskell source module + OR a hi-boot source module + +\begin{code} +data ModSummary + = ModSummary { + ms_mod :: Module, -- Name of the module + ms_hsc_src :: HscSource, -- Source is Haskell, hs-boot, external core + ms_location :: ModLocation, -- Location + ms_hs_date :: ClockTime, -- Timestamp of summarised file + ms_srcimps :: [Module], -- Source imports + ms_imps :: [Module], -- Non-source imports + ms_hspp_file :: Maybe FilePath, -- Filename of preprocessed source, + -- once we have preprocessed it. + ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe. + } + +-- The ModLocation contains both the original source filename and the +-- filename of the cleaned-up source file after all preprocessing has been +-- done. The point is that the summariser will have to cpp/unlit/whatever +-- all files anyway, and there's no point in doing this twice -- just +-- park the result in a temp file, put the name of it in the location, +-- and let @compile@ read from that file on the way back up. + +-- The ModLocation is stable over successive up-sweeps in GHCi, wheres +-- the ms_hs_date and imports can, of course, change + +msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath +msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms)) +msHiFilePath ms = ml_hi_file (ms_location ms) +msObjFilePath ms = ml_obj_file (ms_location ms) + + +instance Outputable ModSummary where + ppr ms + = sep [text "ModSummary {", + nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)), + text "ms_mod =" <+> ppr (ms_mod ms) + <> text (hscSourceString (ms_hsc_src ms)) <> comma, + text "ms_imps =" <+> ppr (ms_imps ms), + text "ms_srcimps =" <+> ppr (ms_srcimps ms)]), + char '}' + ] + +showModMsg :: Bool -> ModSummary -> String +showModMsg use_object mod_summary + = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '), + char '(', text (msHsFilePath mod_summary) <> comma, + if use_object then text (msObjFilePath mod_summary) + else text "interpreted", + char ')']) + where + mod = ms_mod mod_summary + mod_str = moduleUserString mod ++ hscSourceString (ms_hsc_src mod_summary) +\end{code} + + +%************************************************************************ +%* * \subsection{Linkable stuff} %* * %************************************************************************