X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=c1e6f34b16f2794f64a1dc3ef22affaff09f181d;hb=527f52a72acf214994921ad36de92f934e9632da;hp=76e28be6d488dca9dcc85cba788d710574d8c554;hpb=1246293616fc45787ecaed13aa31a2555510f7e3;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 76e28be..c1e6f34 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -18,11 +18,13 @@ module HscTypes ( handleFlagWarnings, -- * Sessions and compilation state - Session(..), withSession, modifySession, + Session(..), withSession, modifySession, withTempSession, HscEnv(..), hscEPS, FinderCache, FindResult(..), ModLocationCache, Target(..), TargetId(..), pprTarget, pprTargetId, ModuleGraph, emptyMG, + -- ** Callbacks + GhcApiCallbacks(..), withLocalCallbacks, -- * Information about modules ModDetails(..), emptyModDetails, @@ -109,6 +111,7 @@ import ByteCodeAsm ( CompiledByteCode ) import {-# SOURCE #-} InteractiveEval ( Resume ) #endif +import HsSyn import RdrName import Name import NameEnv @@ -293,6 +296,16 @@ modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m () modifySession f = do h <- getSession setSession $! f h +withSavedSession :: GhcMonad m => m a -> m a +withSavedSession m = do + saved_session <- getSession + m `gfinally` setSession saved_session + +-- | Call an action with a temporarily modified Session. +withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a +withTempSession f m = + withSavedSession $ modifySession f >> m + -- | A minimal implementation of a 'GhcMonad'. If you need a custom monad, -- e.g., to maintain additional state consider wrapping this monad or using -- 'GhcT'. @@ -432,7 +445,50 @@ mkFlagWarning (L loc warn) \end{code} \begin{code} --- | HscEnv is like 'Session', except that some of the fields are immutable. +-- | These functions are called in various places of the GHC API. +-- +-- API clients can override any of these callbacks to change GHC's default +-- behaviour. +data GhcApiCallbacks + = GhcApiCallbacks { + + -- | Called by 'load' after the compilating of each module. + -- + -- The default implementation simply prints all warnings and errors to + -- @stderr@. Don't forget to call 'clearWarnings' when implementing your + -- own call. + -- + -- The first argument is the module that was compiled. + -- + -- The second argument is @Nothing@ if no errors occured, but there may + -- have been warnings. If it is @Just err@ at least one error has + -- occured. If 'srcErrorMessages' is empty, compilation failed due to + -- @-Werror@. + reportModuleCompilationResult :: GhcMonad m => + ModSummary -> Maybe SourceError + -> m () + } + +-- | Temporarily modify the callbacks. After the action is executed all +-- callbacks are reset (not, however, any other modifications to the session +-- state.) +withLocalCallbacks :: GhcMonad m => + (GhcApiCallbacks -> GhcApiCallbacks) + -> m a -> m a +withLocalCallbacks f m = do + hsc_env <- getSession + let cb0 = hsc_callbacks hsc_env + let cb' = f cb0 + setSession (hsc_env { hsc_callbacks = cb' `seq` cb' }) + r <- m + hsc_env' <- getSession + setSession (hsc_env' { hsc_callbacks = cb0 }) + return r + +\end{code} + +\begin{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. @@ -447,6 +503,9 @@ data HscEnv hsc_dflags :: DynFlags, -- ^ The dynamic flag settings + hsc_callbacks :: GhcApiCallbacks, + -- ^ Callbacks for the GHC API. + hsc_targets :: [Target], -- ^ The targets (or roots) of the current session @@ -741,14 +800,12 @@ data FindResult -- ^ The requested package was not found | FoundMultiple [PackageId] -- ^ _Error_: both in multiple packages - | PackageHidden PackageId - -- ^ For an explicit source import, the package containing the module is - -- not exposed. - | ModuleHidden PackageId - -- ^ For an explicit source import, the package containing the module is - -- exposed, but the module itself is hidden. - | NotFound [FilePath] (Maybe PackageId) - -- ^ The module was not found, the specified places were searched + | NotFound [FilePath] (Maybe PackageId) [PackageId] [PackageId] + -- ^ The module was not found, including either + -- * the specified places were searched + -- * the package that this module should have been in + -- * list of packages in which the module was hidden, + -- * list of hidden packages containing this module | NotFoundInPackage PackageId -- ^ The module was not found in this package @@ -785,11 +842,10 @@ data ModIface mi_boot :: !IsBootInterface, -- ^ Read from an hi-boot file? mi_deps :: Dependencies, - -- ^ The dependencies of the module, consulted for directly - -- imported modules only - - -- This is consulted for directly-imported modules, - -- but not for anything else (hence lazy) + -- ^ The dependencies of the module. This is + -- consulted for directly-imported modules, but not + -- for anything else (hence lazy) + mi_usages :: [Usage], -- ^ Usages; kept sorted so that it's easy to decide -- whether to write a new iface file (changing usages @@ -1090,6 +1146,8 @@ data InteractiveContext #ifdef GHCI , ic_resume :: [Resume] -- ^ The stack of breakpoint contexts #endif + + , ic_cwd :: Maybe FilePath -- virtual CWD of the program } @@ -1103,6 +1161,7 @@ emptyInteractiveContext #ifdef GHCI , ic_resume = [] #endif + , ic_cwd = Nothing } icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified @@ -1234,14 +1293,13 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod) implicitTyThings :: TyThing -> [TyThing] -- For data and newtype declarations: -implicitTyThings (ATyCon tc) = - -- fields (names of selectors) - map AnId (tyConSelIds tc) ++ - -- (possibly) implicit coercion and family coercion - -- depending on whether it's a newtype or a family instance or both +implicitTyThings (ATyCon tc) + = -- fields (names of selectors) + -- (possibly) implicit coercion and family coercion + -- depending on whether it's a newtype or a family instance or both implicitCoTyCon tc ++ - -- for each data constructor in order, - -- the contructor, worker, and (possibly) wrapper + -- for each data constructor in order, + -- the contructor, worker, and (possibly) wrapper concatMap (extras_plus . ADataCon) (tyConDataCons tc) implicitTyThings (AClass cl) @@ -1795,7 +1853,8 @@ type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name) -- There will be a node for each source module, plus a node for each hi-boot -- module. -- --- The graph is not necessarily stored in topologically-sorted order. +-- The graph is not necessarily stored in topologically-sorted order. Use +-- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this. type ModuleGraph = [ModSummary] emptyMG :: ModuleGraph @@ -1815,8 +1874,8 @@ data ModSummary ms_location :: ModLocation, -- ^ Location of the various files belonging to the module ms_hs_date :: ClockTime, -- ^ Timestamp of source file ms_obj_date :: Maybe ClockTime, -- ^ Timestamp of object, if we have one - ms_srcimps :: [Located ModuleName], -- ^ Source imports of the module - ms_imps :: [Located ModuleName], -- ^ Non-source imports of the module + ms_srcimps :: [Located (ImportDecl RdrName)], -- ^ Source imports of the module + ms_imps :: [Located (ImportDecl RdrName)], -- ^ Non-source imports of the module ms_hspp_file :: FilePath, -- ^ Filename of preprocessed source file ms_hspp_opts :: DynFlags, -- ^ Cached flags from @OPTIONS@, @INCLUDE@ -- and @LANGUAGE@ pragmas in the modules source code @@ -1982,8 +2041,14 @@ data Linkable = LM { -- (i.e. when the bytecodes were produced, -- or the mod date on the files) linkableModule :: Module, -- ^ The linkable module itself - linkableUnlinked :: [Unlinked] -- ^ Those files and chunks of code we have - -- yet to link + linkableUnlinked :: [Unlinked] + -- ^ Those files and chunks of code we have yet to link. + -- + -- INVARIANT: A valid linkable always has at least one 'Unlinked' item. + -- If this list is empty, the Linkable represents a fake linkable, which + -- is generated in HscNothing mode to avoid recompiling modules. + -- + -- XXX: Do items get removed from this list when they get linked? } isObjectLinkable :: Linkable -> Bool