Commit 9a4607c3 authored by Thomas Schilling's avatar Thomas Schilling

Use a per-session data structure for callbacks. Make 'WarnErrLogger'

part of it.

Part of the GHC API essentially represents a compilation framework.
The difference of a *framework* as opposed to a *library* is that the
overall structure of the functionality is pre-defined but certain
details can be customised via callbacks.  (Also known as the Hollywood
Principle: "Don't call us, we'll call you.")

This patch introduces a per-session data structure that contains all
the callbacks instead of adding lots of small function arguments
whenever we want to give the user more control over certain parts of
the API.  This should also help with future changes: Adding a new
callback doesn't break old code since code that doesn't know about the
new callback will use the (hopefully sane) default implementation.

Overall, however, we should try and keep the number of callbacks small
and well-defined (and provide useful defaults) and use simple library
routines for the rest.
parent 41fd4136
......@@ -17,7 +17,7 @@ module GHC (
gcatch, gbracket, gfinally,
clearWarnings, getWarnings, hasWarnings,
printExceptionAndWarnings, printWarnings,
handleSourceError,
handleSourceError, defaultCallbacks, GhcApiCallbacks(..),
-- * Flags and settings
DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
......@@ -467,10 +467,17 @@ initGhcMonad mb_top_dir = do
dflags0 <- liftIO $ initDynFlags defaultDynFlags
dflags <- liftIO $ initSysTools mb_top_dir dflags0
env <- liftIO $ newHscEnv dflags
env <- liftIO $ newHscEnv defaultCallbacks dflags
setSession env
clearWarnings
defaultCallbacks :: GhcApiCallbacks
defaultCallbacks =
GhcApiCallbacks {
reportModuleCompilationResult =
\_ mb_err -> defaultWarnErrLogger mb_err
}
-- -----------------------------------------------------------------------------
-- Flags & settings
......@@ -664,8 +671,9 @@ data LoadHowMuch
-- the actual compilation starts (e.g., during dependency analysis).
--
load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
load how_much =
loadWithLogger defaultWarnErrLogger how_much
load how_much = do
mod_graph <- depanal [] False
load2 how_much mod_graph
-- | A function called to log warnings and errors.
type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
......@@ -691,12 +699,13 @@ loadWithLogger logger how_much = do
-- even if we don't get a fully successful upsweep, the full module
-- graph is still retained in the Session. We can tell which modules
-- were successfully loaded by inspecting the Session's HPT.
mod_graph <- depanal [] False
load2 how_much mod_graph logger
withLocalCallbacks (\cbs -> cbs { reportModuleCompilationResult =
\_ -> logger }) $
load how_much
load2 :: GhcMonad m => LoadHowMuch -> [ModSummary] -> WarnErrLogger
load2 :: GhcMonad m => LoadHowMuch -> [ModSummary]
-> m SuccessFlag
load2 how_much mod_graph logger = do
load2 how_much mod_graph = do
guessOutputFile
hsc_env <- getSession
......@@ -823,8 +832,7 @@ load2 how_much mod_graph logger = do
liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
2 (ppr mg))
(upsweep_ok, hsc_env1, modsUpswept)
<- upsweep logger
(hsc_env { hsc_HPT = emptyHomePackageTable })
<- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
pruned_hpt stable_mods cleanup mg
-- Make modsDone be the summaries for each home module now
......@@ -1433,8 +1441,7 @@ findPartiallyCompletedCycles modsDone theGraph
upsweep
:: GhcMonad m =>
WarnErrLogger -- ^ Called to print warnings and errors.
-> HscEnv -- ^ Includes initially-empty HPT
HscEnv -- ^ Includes initially-empty HPT
-> HomePackageTable -- ^ HPT from last time round (pruned)
-> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
-> IO () -- ^ How to clean up unwanted tmp files
......@@ -1443,7 +1450,7 @@ upsweep
HscEnv, -- With an updated HPT
[ModSummary]) -- Mods which succeeded
upsweep logger hsc_env old_hpt stable_mods cleanup sccs = do
upsweep hsc_env old_hpt stable_mods cleanup sccs = do
(res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
return (res, hsc_env, reverse done)
where
......@@ -1462,13 +1469,14 @@ upsweep logger hsc_env old_hpt stable_mods cleanup sccs = do
= do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
-- show (map (moduleUserString.moduleName.mi_module.hm_iface)
-- (moduleEnvElts (hsc_HPT hsc_env)))
let logger = reportModuleCompilationResult (hsc_callbacks hsc_env)
mb_mod_info
<- handleSourceError
(\err -> do logger (Just err); return Nothing) $ do
(\err -> do logger mod (Just err); return Nothing) $ do
mod_info <- upsweep_mod hsc_env old_hpt stable_mods
mod mod_index nmods
logger Nothing -- log warnings
logger mod Nothing -- log warnings
return (Just mod_info)
liftIO cleanup -- Remove unwanted tmp files between compilations
......
......@@ -125,8 +125,8 @@ import Data.IORef
%************************************************************************
\begin{code}
newHscEnv :: DynFlags -> IO HscEnv
newHscEnv dflags
newHscEnv :: GhcApiCallbacks -> DynFlags -> IO HscEnv
newHscEnv callbacks dflags
= do { eps_var <- newIORef initExternalPackageState
; us <- mkSplitUniqSupply 'r'
; nc_var <- newIORef (initNameCache us knownKeyNames)
......@@ -134,6 +134,7 @@ newHscEnv dflags
; mlc_var <- newIORef emptyModuleEnv
; optFuel <- initOptFuelState
; return (HscEnv { hsc_dflags = dflags,
hsc_callbacks = callbacks,
hsc_targets = [],
hsc_mod_graph = [],
hsc_IC = emptyInteractiveContext,
......
......@@ -23,6 +23,8 @@ module HscTypes (
FinderCache, FindResult(..), ModLocationCache,
Target(..), TargetId(..), pprTarget, pprTargetId,
ModuleGraph, emptyMG,
-- ** Callbacks
GhcApiCallbacks(..), withLocalCallbacks,
-- * Information about modules
ModDetails(..), emptyModDetails,
......@@ -442,7 +444,49 @@ 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
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.
......@@ -457,6 +501,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
......
......@@ -16,7 +16,8 @@ module Main (main) where
import qualified GHC
import GHC ( DynFlags(..), HscTarget(..),
GhcMode(..), GhcLink(..),
LoadHowMuch(..), dopt, DynFlag(..) )
LoadHowMuch(..), dopt, DynFlag(..),
defaultCallbacks )
import CmdLineParser
-- Implementations of the various modes (--show-iface, mkdependHS. etc.)
......@@ -515,7 +516,7 @@ doMake srcs = do
doShowIface :: DynFlags -> FilePath -> IO ()
doShowIface dflags file = do
hsc_env <- newHscEnv dflags
hsc_env <- newHscEnv defaultCallbacks dflags
showIface hsc_env file
-- ---------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment