Rework plugin initialisation points

In general this patch pushes plugin initialisation points to earlier in
the pipeline. As plugins can modify the `HscEnv`, it's imperative that
the plugins are initialised as soon as possible and used thereafter.

For example, there are some new tests which modify hsc_logger and other
hooks which failed to fire before (and now do)

One consequence of this change is that the error for specifying the
usage of a HPT plugin from the command line has changed, because it's
now attempted to be loaded at initialisation rather than causing a
cyclic module import.

Closes #21279

Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com>

4 files changed, 25 insertions, 14 deletions

diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index c047056ea6..2cc762b9cd 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -694,6 +694,9 @@ data WorkerLimit
 -- produced by calling 'depanal'.
 load' :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
 load' mhmi_cache how_much mHscMessage mod_graph = do
+    -- In normal usage plugins are initialised already by ghc/Main.hs this is protective
+    -- for any client who might interact with GHC via load'.
+    initializeSessionPlugins
     modifySession $ \hsc_env -> hsc_env { hsc_mod_graph = mod_graph }
     guessOutputFile
     hsc_env <- getSession
@@ -2852,13 +2855,11 @@ label_self thread_name = do
 runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO ()
 -- Don't even initialise plugins if there are no pipelines
 runPipelines _ _ _ [] = return ()
-runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do
+runPipelines n_job hsc_env mHscMessager all_pipelines = do
   liftIO $ label_self "main --make thread"
-
-  plugins_hsc_env <- initializePlugins orig_hsc_env
   case n_job of
-    NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines
-    _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines
+    NumProcessorsLimit n | n <= 1 -> runSeqPipelines hsc_env mHscMessager all_pipelines
+    _n -> runParPipelines n_job hsc_env mHscMessager all_pipelines
 
 runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO ()
 runSeqPipelines plugin_hsc_env mHscMessager all_pipelines =
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index e539c3fcbf..f709ad801c 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -244,6 +244,7 @@ compileOne' mHscMessage
              addFilesToClean tmpfs TFL_GhcSession $
                  [ml_obj_file $ ms_location summary]
 
+   -- Initialise plugins here for any plugins enabled locally for a module.
    plugin_hsc_env <- initializePlugins hsc_env
    let pipe_env = mkPipeEnv NoStop input_fn Nothing pipelineOutput
    status <- hscRecompStatus mHscMessage plugin_hsc_env upd_summary
@@ -526,7 +527,11 @@ findHSLib platform ws dirs lib = do
 -- Compile files in one-shot mode.
 
 oneShot :: HscEnv -> StopPhase -> [(String, Maybe Phase)] -> IO ()
-oneShot hsc_env stop_phase srcs = do
+oneShot orig_hsc_env stop_phase srcs = do
+  -- In oneshot mode, initialise plugins specified on command line
+  -- we also initialise in ghc/Main but this might be used as an entry point by API clients who
+  -- should initialise their own plugins but may not.
+  hsc_env <- initializePlugins orig_hsc_env
   o_files <- mapMaybeM (compileFile hsc_env stop_phase) srcs
   case stop_phase of
     StopPreprocess -> return ()
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 75f33834e2..7694975e80 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -62,7 +62,6 @@ import GHC.Parser.Header
 import GHC.Data.StringBuffer
 import GHC.Types.SourceError
 import GHC.Unit.Finder
-import GHC.Runtime.Loader
 import Data.IORef
 import GHC.Types.Name.Env
 import GHC.Platform.Ways
@@ -82,6 +81,7 @@ import GHC.StgToJS.Linker.Linker (embedJsFile)
 
 import Language.Haskell.Syntax.Module.Name
 import GHC.Unit.Home.ModInfo
+import GHC.Runtime.Loader (initializePlugins)
 
 newtype HookedUse a = HookedUse { runHookedUse :: (Hooks, PhaseHook) -> IO a }
   deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via (ReaderT (Hooks, PhaseHook) IO)
@@ -724,9 +724,11 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
       new_includes = addImplicitQuoteInclude paths [current_dir]
       paths = includePaths dflags0
       dflags = dflags0 { includePaths = new_includes }
-      hsc_env = hscSetFlags dflags hsc_env0
-
+      hsc_env1 = hscSetFlags dflags hsc_env0
 
+  -- Initialise plugins as the flags passed into runHscPhase might have local plugins just
+  -- specific to this module.
+  hsc_env <- initializePlugins hsc_env1
 
   -- gather the imports and module name
   (hspp_buf,mod_name,imps,src_imps, ghc_prim_imp) <- do
@@ -786,18 +788,17 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
   -- run the compiler!
   let msg :: Messager
       msg hsc_env _ what _ = oneShotMsg (hsc_logger hsc_env) what
-  plugin_hsc_env' <- initializePlugins hsc_env
 
   -- Need to set the knot-tying mutable variable for interface
   -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.
   -- See also Note [hsc_type_env_var hack]
   type_env_var <- newIORef emptyNameEnv
-  let plugin_hsc_env = plugin_hsc_env' { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) }
+  let hsc_env' = hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) }
 
-  status <- hscRecompStatus (Just msg) plugin_hsc_env mod_summary
+  status <- hscRecompStatus (Just msg) hsc_env' mod_summary
                         Nothing emptyHomeModInfoLinkable (1, 1)
 
-  return (plugin_hsc_env, mod_summary, status)
+  return (hsc_env', mod_summary, status)
 
 -- | Calculate the ModLocation from the provided DynFlags. This function is only used
 -- in one-shot mode and therefore takes into account the effect of -o/-ohi flags
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 29f61fe591..3349ed0020 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -2,7 +2,7 @@
 
 -- | Dynamically lookup up values from modules and loading them.
 module GHC.Runtime.Loader (
-        initializePlugins,
+        initializePlugins, initializeSessionPlugins,
         -- * Loading plugins
         loadFrontendPlugin,
 
@@ -74,7 +74,11 @@ import Unsafe.Coerce     ( unsafeCoerce )
 import GHC.Linker.Types
 import Data.List (unzip4)
 import GHC.Iface.Errors.Ppr
+import GHC.Driver.Monad
 
+-- | Initialise plugins specified by the current DynFlags and update the session.
+initializeSessionPlugins :: GhcMonad m => m ()
+initializeSessionPlugins = getSession >>= liftIO . initializePlugins >>= setSession
 
 -- | Loads the plugins specified in the pluginModNames field of the dynamic
 -- flags. Should be called after command line arguments are parsed, but before