Whoops, *don't* reset the complete session in 'withLocalCallbacks'.

[ghc-hetmet.git] / compiler / main / HscTypes.lhs

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 76e28be..e79acf4 100644 (file)
--- 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,
@@ -293,6 +295,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 +444,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 +502,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
 
@@ -1982,8 +2040,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