Commit ecfd0278 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Move Plugins into HscEnv (#17957)

Loaded plugins have nothing to do in DynFlags so this patch moves them
into HscEnv (session state).

"DynFlags plugins" become "Driver plugins" to still be able to register
static plugins.

Bump haddock submodule
parent 53ad67ea
......@@ -313,6 +313,7 @@ import GHC.Driver.Monad
import GHC.Driver.Ppr
import GHC.ByteCode.Types
import GHC.Runtime.Loader
import GHC.Runtime.Eval
import GHC.Runtime.Eval.Types
import GHC.Runtime.Interpreter
......@@ -729,6 +730,8 @@ getProgramDynFlags :: GhcMonad m => m DynFlags
getProgramDynFlags = getSessionDynFlags
-- | Set the 'DynFlags' used to evaluate interactive expressions.
-- Also initialise (load) plugins.
--
-- Note: this cannot be used for changes to packages. Use
-- 'setSessionDynFlags', or 'setProgramDynFlags' and then copy the
-- 'unitState' into the interactive @DynFlags@.
......@@ -736,7 +739,22 @@ setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
setInteractiveDynFlags dflags = do
dflags' <- checkNewDynFlags dflags
dflags'' <- checkNewInteractiveDynFlags dflags'
modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags'' }}
modifySessionM $ \hsc_env0 -> do
let ic0 = hsc_IC hsc_env0
-- Initialise (load) plugins in the interactive environment with the new
-- DynFlags
plugin_env <- liftIO $ initializePlugins $ mkInteractiveHscEnv $
hsc_env0 { hsc_IC = ic0 { ic_dflags = dflags'' }}
-- Update both plugins cache and DynFlags in the interactive context.
return $ hsc_env0
{ hsc_IC = ic0
{ ic_plugins = hsc_plugins plugin_env
, ic_dflags = hsc_dflags plugin_env
}
}
-- | Get the 'DynFlags' used to evaluate interactive expressions.
getInteractiveDynFlags :: GhcMonad m => m DynFlags
......
......@@ -97,9 +97,8 @@ core2core hsc_env guts@(ModGuts { mg_module = mod
; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_mask mod
orph_mods print_unqual loc $
do { hsc_env' <- getHscEnv
; dflags' <- liftIO $ initializePlugins hsc_env'
(hsc_dflags hsc_env')
; all_passes <- withPlugins dflags'
; hsc_env'' <- liftIO $ initializePlugins hsc_env'
; all_passes <- withPlugins hsc_env''
installCoreToDos
builtin_passes
; runCorePasses all_passes guts }
......
......@@ -26,7 +26,7 @@ import GHC.Prelude
import GHC.Driver.Ppr
import GHC.Driver.Session
import GHC.Unit.Finder.Types
import {-# SOURCE #-} GHC.Driver.Plugins
import GHC.Runtime.Context
import GHC.Runtime.Interpreter.Types (Interp)
......@@ -39,6 +39,7 @@ import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.Deps
import GHC.Unit.Home.ModInfo
import GHC.Unit.External
import GHC.Unit.Finder.Types
import GHC.Core ( CoreRule )
import GHC.Core.FamInstEnv
......@@ -94,14 +95,17 @@ runHsc hsc_env (Hsc hsc) = do
printOrThrowWarnings (hsc_dflags hsc_env) w
return a
-- | Switches in the DynFlags and Plugins from the InteractiveContext
mkInteractiveHscEnv :: HscEnv -> HscEnv
mkInteractiveHscEnv hsc_env = hsc_env{ hsc_dflags = interactive_dflags }
where
interactive_dflags = ic_dflags (hsc_IC hsc_env)
mkInteractiveHscEnv hsc_env =
let ic = hsc_IC hsc_env
in hsc_env { hsc_dflags = ic_dflags ic
, hsc_plugins = ic_plugins ic
}
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
-- A variant of runHsc that switches in the DynFlags from the
-- | A variant of runHsc that switches in the DynFlags and Plugins from the
-- InteractiveContext before running the Hsc computation.
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env)
-- | HscEnv is like 'GHC.Driver.Monad.Session', except that some of the fields are immutable.
......@@ -178,6 +182,21 @@ data HscEnv
, hsc_home_unit :: !HomeUnit
-- ^ Home-unit
, hsc_plugins :: ![LoadedPlugin]
-- ^ plugins dynamically loaded after processing arguments. What
-- will be loaded here is directed by DynFlags.pluginModNames.
-- Arguments are loaded from DynFlags.pluginModNameOpts.
--
-- The purpose of this field is to cache the plugins so they
-- don't have to be loaded each time they are needed. See
-- 'GHC.Runtime.Loader.initializePlugins'.
, hsc_static_plugins :: ![StaticPlugin]
-- ^ static plugins which do not need dynamic loading. These plugins are
-- intended to be added by GHC API users directly to this list.
--
-- To add dynamically loaded plugins through the GHC API see
-- 'addPluginModuleName' instead.
}
{-
......
......@@ -241,18 +241,20 @@ newHscEnv dflags = do
nc_var <- newIORef (initNameCache us knownKeyNames)
fc_var <- newIORef emptyInstalledModuleEnv
emptyLoader <- uninitializedLoader
return HscEnv { hsc_dflags = dflags
, hsc_targets = []
, hsc_mod_graph = emptyMG
, hsc_IC = emptyInteractiveContext dflags
, hsc_HPT = emptyHomePackageTable
, hsc_EPS = eps_var
, hsc_NC = nc_var
, hsc_FC = fc_var
, hsc_type_env_var = Nothing
, hsc_interp = Nothing
, hsc_loader = emptyLoader
, hsc_home_unit = home_unit
return HscEnv { hsc_dflags = dflags
, hsc_targets = []
, hsc_mod_graph = emptyMG
, hsc_IC = emptyInteractiveContext dflags
, hsc_HPT = emptyHomePackageTable
, hsc_EPS = eps_var
, hsc_NC = nc_var
, hsc_FC = fc_var
, hsc_type_env_var = Nothing
, hsc_interp = Nothing
, hsc_loader = emptyLoader
, hsc_home_unit = home_unit
, hsc_plugins = []
, hsc_static_plugins = []
}
-- -----------------------------------------------------------------------------
......@@ -454,7 +456,8 @@ hscParse' mod_summary
-- apply parse transformation of plugins
let applyPluginAction p opts
= parsedResultAction p opts mod_summary
withPlugins dflags applyPluginAction res
hsc_env <- getHscEnv
withPlugins hsc_env applyPluginAction res
-- -----------------------------------------------------------------------------
......@@ -764,12 +767,11 @@ hscIncrementalCompile :: Bool
-> SourceModified
-> Maybe ModIface
-> (Int,Int)
-> IO (HscStatus, DynFlags)
-> IO (HscStatus, HscEnv)
hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
mHscMessage hsc_env' mod_summary source_modified mb_old_iface mod_index
= do
dflags <- initializePlugins hsc_env' (hsc_dflags hsc_env')
let hsc_env'' = hsc_env' { hsc_dflags = dflags }
hsc_env'' <- initializePlugins hsc_env'
-- One-shot mode needs a knot-tying mutable variable for interface
-- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.
......@@ -804,14 +806,14 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
-- any further typechecking. It's much more useful
-- in make mode, since this HMI will go into the HPT.
genModDetails hsc_env' iface
return (HscUpToDate iface details, dflags)
return (HscUpToDate iface details, hsc_env')
-- We finished type checking. (mb_old_hash is the hash of
-- the interface that existed on disk; it's possible we had
-- to retypecheck but the resulting interface is exactly
-- the same.)
Right (FrontendTypecheck tc_result, mb_old_hash) -> do
status <- finish mod_summary tc_result mb_old_hash
return (status, dflags)
return (status, hsc_env)
-- Runs the post-typechecking frontend (desugar and simplify). We want to
-- generate most of the interface as late as possible. This gets us up-to-date
......
......@@ -16,7 +16,8 @@ module GHC.Driver.Monad (
reflectGhc, reifyGhc,
getSessionDynFlags,
liftIO,
Session(..), withSession, modifySession, withTempSession,
Session(..), withSession, modifySession, modifySessionM,
withTempSession,
-- ** Warnings
logWarnings, printException,
......@@ -73,6 +74,13 @@ modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession f = do h <- getSession
setSession $! f h
-- | Set the current session to the result of applying the current session to
-- the argument.
modifySessionM :: GhcMonad m => (HscEnv -> m HscEnv) -> m ()
modifySessionM f = do h <- getSession
h' <- f h
setSession $! h'
withSavedSession :: GhcMonad m => m a -> m a
withSavedSession m = do
saved_session <- getSession
......
......@@ -197,10 +197,12 @@ compileOne' m_tc_result mHscMessage
debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp)
-- Run the pipeline up to codeGen (so everything up to, but not including, STG)
(status, plugin_dflags) <- hscIncrementalCompile
(status, plugin_hsc_env) <- hscIncrementalCompile
always_do_basic_recompilation_check
m_tc_result mHscMessage
hsc_env summary source_modified mb_old_iface (mod_index, nmods)
-- Use an HscEnv updated with the plugin info
let hsc_env' = plugin_hsc_env
let flags = hsc_dflags hsc_env0
in do unless (gopt Opt_KeepHiFiles flags) $
......@@ -210,10 +212,6 @@ compileOne' m_tc_result mHscMessage
addFilesToClean flags TFL_GhcSession $
[ml_obj_file $ ms_location summary]
-- Use an HscEnv with DynFlags updated with the plugin info (returned from
-- hscIncrementalCompile)
let hsc_env' = hsc_env{ hsc_dflags = plugin_dflags }
case (status, bcknd) of
(HscUpToDate iface hmi_details, _) ->
-- TODO recomp014 triggers this assert. What's going on?!
......@@ -1259,12 +1257,15 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
-- run the compiler!
let msg hsc_env _ what _ = oneShotMsg hsc_env what
(result, plugin_dflags) <-
(result, plugin_hsc_env) <-
liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
mod_summary source_unchanged Nothing (1,1)
-- In the rest of the pipeline use the dflags with plugin info
setDynFlags plugin_dflags
-- In the rest of the pipeline use the loaded plugins
setPlugins (hsc_plugins plugin_hsc_env)
(hsc_static_plugins plugin_hsc_env)
-- "driver" plugins may have modified the DynFlags so we update them
setDynFlags (hsc_dflags plugin_hsc_env)
return (HscOut src_flavour mod_name result,
panic "HscOut doesn't have an input filename")
......
......@@ -7,7 +7,7 @@ module GHC.Driver.Pipeline.Monad (
, PhasePlus(..)
, PipeEnv(..), PipeState(..), PipelineOutput(..)
, getPipeEnv, getPipeState, setDynFlags, setModLocation, setForeignOs, setIface
, pipeStateDynFlags, pipeStateModIface
, pipeStateDynFlags, pipeStateModIface, setPlugins
) where
import GHC.Prelude
......@@ -18,6 +18,7 @@ import GHC.Utils.Outputable
import GHC.Driver.Session
import GHC.Driver.Phases
import GHC.Driver.Env
import GHC.Driver.Plugins
import GHC.SysTools.FileCleanup (TempFileLifetime)
......@@ -69,9 +70,9 @@ data PipeEnv = PipeEnv {
-- PipeState: information that might change during a pipeline run
data PipeState = PipeState {
hsc_env :: HscEnv,
-- ^ only the DynFlags change in the HscEnv. The DynFlags change
-- at various points, for example when we read the OPTIONS_GHC
-- pragmas in the Cpp phase.
-- ^ only the DynFlags and the Plugins change in the HscEnv. The
-- DynFlags change at various points, for example when we read the
-- OPTIONS_GHC pragmas in the Cpp phase.
maybe_loc :: Maybe ModLocation,
-- ^ the ModLocation. This is discovered during compilation,
-- in the Hsc phase where we read the module header.
......@@ -117,6 +118,11 @@ setDynFlags :: DynFlags -> CompPipeline ()
setDynFlags dflags = P $ \_env state ->
return (state{hsc_env= (hsc_env state){ hsc_dflags = dflags }}, ())
setPlugins :: [LoadedPlugin] -> [StaticPlugin] -> CompPipeline ()
setPlugins dyn static = P $ \_env state ->
let hsc_env' = (hsc_env state){ hsc_plugins = dyn, hsc_static_plugins = static }
in return (state{hsc_env = hsc_env'}, ())
setModLocation :: ModLocation -> CompPipeline ()
setModLocation loc = P $ \_env state ->
return (state{ maybe_loc = Just loc }, ())
......
......@@ -50,7 +50,6 @@ module GHC.Driver.Plugins (
import GHC.Prelude
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Driver.Monad
import GHC.Driver.Phases
......@@ -98,13 +97,14 @@ data Plugin = Plugin {
, holeFitPlugin :: HoleFitPlugin
-- ^ An optional plugin to handle hole fits, which may re-order
-- or change the list of valid hole fits and refinement hole fits.
, dynflagsPlugin :: [CommandLineOption] -> DynFlags -> IO DynFlags
-- ^ An optional plugin to update 'DynFlags', right after
-- plugin loading. This can be used to register hooks
-- or tweak any field of 'DynFlags' before doing
-- actual work on a module.
, driverPlugin :: [CommandLineOption] -> HscEnv -> IO HscEnv
-- ^ An optional plugin to update 'HscEnv', right after plugin loading. This
-- can be used to register hooks or tweak any field of 'DynFlags' before
-- doing actual work on a module.
--
-- @since 8.10.1
, pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
-- ^ Specify how the plugin should affect recompilation.
, parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
......@@ -214,7 +214,7 @@ defaultPlugin = Plugin {
installCoreToDos = const return
, tcPlugin = const Nothing
, holeFitPlugin = const Nothing
, dynflagsPlugin = const return
, driverPlugin = const return
, pluginRecompile = impurePlugin
, renamedResultAction = \_ env grp -> return (env, grp)
, parsedResultAction = \_ _ -> return
......@@ -242,25 +242,25 @@ keepRenamedSource _ gbl_env group =
type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a
type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()
plugins :: DynFlags -> [PluginWithArgs]
plugins df =
map lpPlugin (cachedPlugins df) ++
map spPlugin (staticPlugins df)
plugins :: HscEnv -> [PluginWithArgs]
plugins hsc_env =
map lpPlugin (hsc_plugins hsc_env) ++
map spPlugin (hsc_static_plugins hsc_env)
-- | Perform an operation by using all of the plugins in turn.
withPlugins :: Monad m => DynFlags -> PluginOperation m a -> a -> m a
withPlugins df transformation input = foldM go input (plugins df)
withPlugins :: Monad m => HscEnv -> PluginOperation m a -> a -> m a
withPlugins hsc_env transformation input = foldM go input (plugins hsc_env)
where
go arg (PluginWithArgs p opts) = transformation p opts arg
mapPlugins :: DynFlags -> (Plugin -> [CommandLineOption] -> a) -> [a]
mapPlugins df f = map (\(PluginWithArgs p opts) -> f p opts) (plugins df)
mapPlugins :: HscEnv -> (Plugin -> [CommandLineOption] -> a) -> [a]
mapPlugins hsc_env f = map (\(PluginWithArgs p opts) -> f p opts) (plugins hsc_env)
-- | Perform a constant operation by using all of the plugins in turn.
withPlugins_ :: Monad m => DynFlags -> ConstPluginOperation m a -> a -> m ()
withPlugins_ df transformation input
withPlugins_ :: Monad m => HscEnv -> ConstPluginOperation m a -> a -> m ()
withPlugins_ hsc_env transformation input
= mapM_ (\(PluginWithArgs p opts) -> transformation p opts input)
(plugins df)
(plugins hsc_env)
type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc ()
data FrontendPlugin = FrontendPlugin {
......
......@@ -235,9 +235,8 @@ import GHC.Unit.Home
import GHC.Unit.Types
import GHC.Unit.Parser
import GHC.Unit.Module
import {-# SOURCE #-} GHC.Driver.Plugins
import {-# SOURCE #-} GHC.Driver.Hooks
import GHC.Builtin.Names ( mAIN_NAME )
import {-# SOURCE #-} GHC.Driver.Hooks
import {-# SOURCE #-} GHC.Unit.State (UnitState, emptyUnitState, UnitDatabase)
import GHC.Driver.Phases ( Phase(..), phaseInputExt )
import GHC.Driver.Flags
......@@ -561,18 +560,6 @@ data DynFlags = DynFlags {
frontendPluginOpts :: [String],
-- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse*
-- order that they're specified on the command line.
cachedPlugins :: [LoadedPlugin],
-- ^ plugins dynamically loaded after processing arguments. What will be
-- loaded here is directed by pluginModNames. Arguments are loaded from
-- pluginModNameOpts. The purpose of this field is to cache the plugins so
-- they don't have to be loaded each time they are needed. See
-- 'GHC.Runtime.Loader.initializePlugins'.
staticPlugins :: [StaticPlugin],
-- ^ static plugins which do not need dynamic loading. These plugins are
-- intended to be added by GHC API users directly to this list.
--
-- To add dynamically loaded plugins through the GHC API see
-- 'addPluginModuleName' instead.
-- GHC API hooks
hooks :: Hooks,
......@@ -1220,8 +1207,6 @@ defaultDynFlags mySettings llvmConfig =
pluginModNames = [],
pluginModNameOpts = [],
frontendPluginOpts = [],
cachedPlugins = [],
staticPlugins = [],
hooks = emptyHooks,
outputFile_ = Nothing,
......@@ -1878,7 +1863,7 @@ clearPluginModuleNames :: DynFlags -> DynFlags
clearPluginModuleNames d =
d { pluginModNames = []
, pluginModNameOpts = []
, cachedPlugins = [] }
}
addPluginModuleNameOption :: String -> DynFlags -> DynFlags
addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, option) : (pluginModNameOpts d) }
......
......@@ -198,7 +198,7 @@ deSugar hsc_env
; endPassIO hsc_env print_unqual CoreDesugarOpt ds_binds ds_rules_for_imps
; let used_names = mkUsedNames tcg_env
pluginModules = map lpModule (cachedPlugins (hsc_dflags hsc_env))
pluginModules = map lpModule (hsc_plugins hsc_env)
home_unit = hsc_home_unit hsc_env
; deps <- mkDependencies (homeUnitId home_unit)
(map mi_module pluginModules) tcg_env
......
......@@ -433,7 +433,6 @@ loadInterface doc_str mod from
; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
-- Check whether we have the interface already
; dflags <- getDynFlags
; hsc_env <- getTopEnv
; let home_unit = hsc_home_unit hsc_env
; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
......@@ -551,7 +550,7 @@ loadInterface doc_str mod from
; -- invoke plugins with *full* interface, not final_iface, to ensure
-- that plugins have access to declarations, etc.
res <- withPlugins dflags (\p -> interfaceLoadAction p) iface
res <- withPlugins hsc_env (\p -> interfaceLoadAction p) iface
; return (Succeeded res)
}}}}
......
......@@ -193,7 +193,7 @@ mkIfaceTc hsc_env safe_mode mod_details
}
= do
let used_names = mkUsedNames tc_result
let pluginModules = map lpModule (cachedPlugins (hsc_dflags hsc_env))
let pluginModules = map lpModule (hsc_plugins hsc_env)
let home_unit = hsc_home_unit hsc_env
deps <- mkDependencies (homeUnitId home_unit)
(map mi_module pluginModules) tc_result
......
......@@ -276,16 +276,16 @@ checkVersions hsc_env mod_summary iface
-- | Check if any plugins are requesting recompilation
checkPlugins :: HscEnv -> ModIface -> IfG RecompileRequired
checkPlugins hsc iface = liftIO $ do
new_fingerprint <- fingerprintPlugins hsc
checkPlugins hsc_env iface = liftIO $ do
new_fingerprint <- fingerprintPlugins hsc_env
let old_fingerprint = mi_plugin_hash (mi_final_exts iface)
pr <- mconcat <$> mapM pluginRecompile' (plugins (hsc_dflags hsc))
pr <- mconcat <$> mapM pluginRecompile' (plugins hsc_env)
return $
pluginRecompileToRecompileRequired old_fingerprint new_fingerprint pr
fingerprintPlugins :: HscEnv -> IO Fingerprint
fingerprintPlugins hsc_env =
fingerprintPlugins' $ plugins (hsc_dflags hsc_env)
fingerprintPlugins' $ plugins hsc_env
fingerprintPlugins' :: [PluginWithArgs] -> IO Fingerprint
fingerprintPlugins' plugins = do
......
......@@ -18,6 +18,7 @@ import GHC.Prelude
import GHC.Hs
import GHC.Driver.Session
import {-# SOURCE #-} GHC.Driver.Plugins
import GHC.Runtime.Eval.Types ( Resume )
......@@ -240,8 +241,12 @@ data InteractiveContext
-- ^ The function that is used for printing results
-- of expressions in ghci and -e mode.
ic_cwd :: Maybe FilePath
-- virtual CWD of the program
ic_cwd :: Maybe FilePath,
-- ^ virtual CWD of the program
ic_plugins :: ![LoadedPlugin]
-- ^ Cache of loaded plugins. We store them here to avoid having to
-- load them everytime we switch to the interctive context.
}
data InteractiveImport
......@@ -270,7 +275,9 @@ emptyInteractiveContext dflags
ic_int_print = printName, -- System.IO.print by default
ic_default = Nothing,
ic_resume = [],
ic_cwd = Nothing }
ic_cwd = Nothing,
ic_plugins = []
}
icInteractiveModule :: InteractiveContext -> Module
icInteractiveModule (InteractiveContext { ic_mod_index = index })
......
......@@ -218,11 +218,9 @@ execStmt' stmt stmt_text ExecOptions{..} = do
-- Turn off -fwarn-unused-local-binds when running a statement, to hide
-- warnings about the implicit bindings we introduce.
-- (This is basically `mkInteractiveHscEnv hsc_env`, except we unset
-- -wwarn-unused-local-binds)
let ic = hsc_IC hsc_env -- use the interactive dflags
idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds
hsc_env' = mkInteractiveHscEnv (hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } })
hsc_env' = mkInteractiveHscEnv (hsc_env{ hsc_IC = ic{ ic_dflags = idflags' }})
r <- liftIO $ hscParsedStmt hsc_env' stmt
......
......@@ -69,21 +69,22 @@ import Unsafe.Coerce ( unsafeCoerce )
-- flags. Should be called after command line arguments are parsed, but before
-- actual compilation starts. Idempotent operation. Should be re-called if
-- pluginModNames or pluginModNameOpts changes.
initializePlugins :: HscEnv -> DynFlags -> IO DynFlags
initializePlugins hsc_env df
| map lpModuleName (cachedPlugins df)
== pluginModNames df -- plugins not changed
&& all (\p -> paArguments (lpPlugin p)
== argumentsForPlugin p (pluginModNameOpts df))
(cachedPlugins df) -- arguments not changed
= return df -- no need to reload plugins
initializePlugins :: HscEnv -> IO HscEnv
initializePlugins hsc_env
-- plugins not changed
| map lpModuleName (hsc_plugins hsc_env) == pluginModNames dflags
-- arguments not changed
, all same_args (hsc_plugins hsc_env)
= return hsc_env -- no need to reload plugins
| otherwise
= do loadedPlugins <- loadPlugins (hsc_env { hsc_dflags = df })
let df' = df { cachedPlugins = loadedPlugins }
withPlugins df' runDflagsPlugin df'
where argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst)
runDflagsPlugin p opts dynflags = dynflagsPlugin p opts dynflags
= do loaded_plugins <- loadPlugins hsc_env
let hsc_env' = hsc_env { hsc_plugins = loaded_plugins }
withPlugins hsc_env' driverPlugin hsc_env'
where
plugin_args = pluginModNameOpts dflags
same_args p = paArguments (lpPlugin p) == argumentsForPlugin p plugin_args
argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst)
dflags = hsc_dflags hsc_env
loadPlugins :: HscEnv -> IO [LoadedPlugin]
loadPlugins hsc_env
......
......@@ -932,7 +932,7 @@ runMeta' show_code ppr_hs run_and_convert expr
-- run plugins
; hsc_env <- getTopEnv
; expr' <- withPlugins (hsc_dflags hsc_env) spliceRunAction expr
; expr' <- withPlugins hsc_env spliceRunAction expr
-- Desugar
; ds_expr <- initDsTc (dsLExpr expr')
......
......@@ -326,7 +326,7 @@ tcRnModuleTcRnM hsc_env mod_sum
reportUnusedNames tcg_env hsc_src
; -- add extra source files to tcg_dependent_files
addDependentFiles src_files
; tcg_env <- runTypecheckerPlugin mod_sum hsc_env tcg_env
; tcg_env <- runTypecheckerPlugin mod_sum tcg_env
; -- Dump output and return
tcDump tcg_env
; return tcg_env }
......@@ -3034,10 +3034,10 @@ Type Checker Plugins
withTcPlugins :: HscEnv -> TcM a -> TcM a
withTcPlugins hsc_env m =
do let plugins = getTcPlugins (hsc_dflags hsc_env)
case plugins of
[] -> m -- Common fast case
_ -> do ev_binds_var <- newTcEvBinds
case getTcPlugins hsc_env of
[] -> m -- Common fast case
plugins -> do
ev_binds_var <- newTcEvBinds
(solvers,stops) <- unzip `fmap` mapM (startPlugin ev_binds_var) plugins
-- This ensures that tcPluginStop is called even if a type
-- error occurs during compilation (Fix of #10078)
......@@ -3052,13 +3052,13 @@ withTcPlugins hsc_env m =
do s <- runTcPluginM start ev_binds_var
return (solve s, stop s)
getTcPlugins :: DynFlags -> [GHC.Tc.Utils.Monad.TcPlugin]
getTcPlugins dflags = catMaybes $ mapPlugins dflags (\p args -> tcPlugin p args)
getTcPlugins :: HscEnv -> [GHC.Tc.Utils.Monad.TcPlugin]
getTcPlugins hsc_env = catMaybes $ mapPlugins hsc_env (\p args -> tcPlugin p args)
withHoleFitPlugins :: HscEnv -> TcM a -> TcM a
withHoleFitPlugins hsc_env m =
case (getHfPlugins (hsc_dflags hsc_env)) of
case getHfPlugins hsc_env of
[] -> m -- Common fast case
plugins -> do (plugins,stops) <- unzip `fmap` mapM startPlugin plugins
-- This ensures that hfPluginStop is called even if a type
......@@ -3074,18 +3074,19 @@ withHoleFitPlugins hsc_env m =
do ref <- init
return (plugin ref, stop ref)
getHfPlugins :: DynFlags -> [HoleFitPluginR]
getHfPlugins dflags =
catMaybes $ mapPlugins dflags (\p args -> holeFitPlugin p args)
getHfPlugins :: HscEnv -> [HoleFitPluginR]
getHfPlugins hsc_env =
catMaybes $ mapPlugins hsc_env (\p args -> holeFitPlugin p args)
runRenamerPlugin :: TcGblEnv
-> HsGroup GhcRn
-> TcM (TcGblEnv, HsGroup GhcRn)
runRenamerPlugin gbl_env hs_group = do
dflags <- getDynFlags
withPlugins dflags
(\p opts (e, g) -> ( mark_plugin_unsafe dflags >> renamedResultAction p opts e g))