X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscTypes.lhs;h=f9b996c16392b1a2e182e9987fea51f0ed81dbdb;hb=19519dc35bad5649226a9f7015eaabb154722e54;hp=5a0b167acedaaf84dc7fe3f24a3bd0ffbd99bf6b;hpb=ac80e0dececb68ed6385e3b34765fd8f9c019767;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 5a0b167..f9b996c 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -5,12 +5,20 @@ \begin{code} module HscTypes ( - HscEnv(..), hscEPS, - GhciMode(..), isOneShot, + -- * Sessions and compilation state + Session(..), HscEnv(..), hscEPS, + FinderCache, FinderCacheEntry, + Target(..), TargetId(..), pprTarget, pprTargetId, + ModuleGraph, emptyMG, - ModDetails(..), + ModDetails(..), emptyModDetails, ModGuts(..), ModImports(..), ForeignStubs(..), + ModSummary(..), showModMsg, isBootSummary, + msHsFilePath, msHiFilePath, msObjFilePath, + + HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases + HomePackageTable, HomeModInfo(..), emptyHomePackageTable, hptInstances, hptRules, @@ -79,9 +87,9 @@ import Type ( TyThing(..) ) import Class ( Class, classSelIds, classTyCon ) import TyCon ( TyCon, tyConSelIds, tyConDataCons ) import DataCon ( dataConImplicitIds ) -import Packages ( PackageIdH, PackageId ) -import CmdLineOpts ( DynFlags ) - +import Packages ( PackageIdH, PackageId, PackageConfig ) +import DynFlags ( DynFlags(..), isOneShot ) +import DriverPhases ( HscSource(..), isHsBoot, hscSourceString ) import BasicTypes ( Version, initialVersion, IPName, Fixity, defaultFixity, DeprecTxt ) @@ -89,13 +97,14 @@ import IfaceSyn ( IfaceInst, IfaceRule, IfaceDecl(ifName) ) import FiniteMap ( FiniteMap ) import CoreSyn ( IdCoreRule ) -import Maybes ( orElse, fromJust ) +import Maybes ( orElse, fromJust, expectJust ) import Outputable import SrcLoc ( SrcSpan ) import UniqSupply ( UniqSupply ) import FastString ( FastString ) import DATA_IOREF ( IORef, readIORef ) +import StringBuffer ( StringBuffer ) import Time ( ClockTime ) \end{code} @@ -106,14 +115,42 @@ import Time ( ClockTime ) %* * %************************************************************************ -The HscEnv gives the environment in which to compile a chunk of code. + +\begin{code} +-- | The Session is a handle to the complete state of a compilation +-- session. A compilation session consists of a set of modules +-- constituting the current program or library, the context for +-- interactive evaluation, and various caches. +newtype Session = Session (IORef HscEnv) +\end{code} + +HscEnv is like Session, except that some of the fields are immutable. +An HscEnv is used to compile a single module from plain Haskell source +code (after preprocessing) to either C, assembly or C--. Things like +the module graph don't change during a single compilation. + +Historical note: "hsc" used to be the name of the compiler binary, +when there was a separate driver and compiler. To compile a single +module, the driver would invoke hsc on the source code... so nowadays +we think of hsc as the layer of the compiler that deals with compiling +a single module. \begin{code} data HscEnv - = HscEnv { hsc_mode :: GhciMode, - hsc_dflags :: DynFlags, + = HscEnv { + hsc_dflags :: DynFlags, + -- The dynamic flag settings + + hsc_targets :: [Target], + -- The targets (or roots) of the current session - hsc_HPT :: HomePackageTable, + hsc_mod_graph :: ModuleGraph, + -- The module graph of the current session + + hsc_IC :: InteractiveContext, + -- The context for evaluating interactive statements + + hsc_HPT :: HomePackageTable, -- The home package table describes already-compiled -- home-packge modules, *excluding* the module we -- are compiling right now. @@ -131,42 +168,61 @@ data HscEnv -- 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 - hsc_EPS :: IORef ExternalPackageState, - hsc_NC :: IORef NameCache } + hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState), + hsc_NC :: {-# UNPACK #-} !(IORef NameCache), + -- These are side-effected by compiling to reflect + -- sucking in interface files. They cache the state of + -- external interface files, in effect. + + hsc_FC :: {-# UNPACK #-} !(IORef FinderCache) + -- The finder's cache. This caches the location of modules, + -- so we don't have to search the filesystem multiple times. + } hscEPS :: HscEnv -> IO ExternalPackageState hscEPS hsc_env = readIORef (hsc_EPS hsc_env) -\end{code} -The GhciMode is self-explanatory: +-- | A compilation target. +-- +-- A target may be supplied with the actual text of the +-- module. If so, use this instead of the file contents (this +-- is for use in an IDE where the file hasn't been saved by +-- the user yet). +data Target = Target TargetId (Maybe StringBuffer) -\begin{code} -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} +data TargetId + = TargetModule Module -- | A module name: search for the file + | TargetFile FilePath -- | A filename: parse it to find the module name. -\begin{code} -type HomePackageTable = ModuleEnv HomeModInfo -- Domain = modules in the home package -type PackageIfaceTable = ModuleEnv ModIface -- Domain = modules in the imported packages + +pprTarget :: Target -> SDoc +pprTarget (Target id _) = pprTargetId id + +pprTargetId (TargetModule m) = ppr m +pprTargetId (TargetFile f) = text f + +type FinderCache = ModuleEnv FinderCacheEntry +type FinderCacheEntry = (ModLocation, Maybe (PackageConfig,Bool)) + -- The finder's cache (see module Finder) + +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_globals :: Maybe GlobalRdrEnv, -- Its top level environment - -- Nothing <-> compiled module - hm_details :: ModDetails, - hm_linkable :: Linkable } + = HomeModInfo { hm_iface :: !ModIface, + hm_details :: !ModDetails, + hm_linkable :: !(Maybe Linkable) } + -- hm_linkable might be Nothing if: + -- a) this is an .hs-boot module + -- b) temporarily during compilation if we pruned away + -- the old linkable because it was out of date. + -- after a complete compilation (GHC.load), all hm_linkable + -- fields in the HPT will be Just. \end{code} Simple lookups in the symbol table. @@ -189,35 +245,22 @@ lookupIfaceByModule hpt pit mod \begin{code} -hptInstances :: HscEnv -> [(Module, IsBootInterface)] -> [DFunId] +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 deps - | isOneShot (hsc_mode hsc_env) = [] -- In one-shot mode, the HPT is empty - | otherwise - = let - hpt = hsc_HPT hsc_env - in - [ dfun - | -- Find each non-hi-boot module below me - (mod, False) <- deps - - -- Look it up in the HPT - , let mod_info = ASSERT2( mod `elemModuleEnv` hpt, ppr mod $$ vcat (map ppr_hm (moduleEnvElts hpt))) - fromJust (lookupModuleEnv hpt mod) - - -- And get its dfuns +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) ] - where - ppr_hm hm = ppr (mi_module (hm_iface hm)) 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) = [] + | isOneShot (ghcMode (hsc_dflags hsc_env)) = [] | otherwise = let hpt = hsc_HPT hsc_env @@ -291,6 +334,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 @@ -316,6 +364,10 @@ data ModDetails md_rules :: ![IdCoreRule] -- Domain may include Ids from other modules } +emptyModDetails = ModDetails { md_types = emptyTypeEnv, + md_insts = [], + md_rules = [] } + -- 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 @@ -324,6 +376,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 @@ -405,6 +458,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, @@ -422,10 +476,10 @@ emptyModIface pkg mod \begin{code} data InteractiveContext = InteractiveContext { - ic_toplev_scope :: [String], -- Include the "top-level" scope of + ic_toplev_scope :: [Module], -- Include the "top-level" scope of -- these modules - ic_exports :: [String], -- Include just the exports of these + ic_exports :: [Module], -- Include just the exports of these -- modules ic_rn_gbl_env :: GlobalRdrEnv, -- The cached GlobalRdrEnv, built from @@ -870,6 +924,85 @@ addInstsToPool insts new_insts %************************************************************************ %* * + The module graph and ModSummary type + A ModSummary is a node in the compilation manager's + dependency graph, and it's also passed to hscMain +%* * +%************************************************************************ + +A ModuleGraph contains all the nodes from the home package (only). +There will be a node for each source module, plus a node for each hi-boot +module. + +\begin{code} +type ModuleGraph = [ModSummary] -- The module graph, + -- NOT NECESSARILY IN TOPOLOGICAL ORDER + +emptyMG :: ModuleGraph +emptyMG = [] + +-- The nodes of the module graph are +-- EITHER a regular Haskell source module +-- OR a hi-boot source module + +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 source file + ms_obj_date :: Maybe ClockTime, -- Timestamp of object, maybe + 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) + +isBootSummary :: ModSummary -> Bool +isBootSummary ms = isHsBoot (ms_hsc_src 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} %* * %************************************************************************