compiler: introduce DynFlags plugins

They have type '[CommandLineOpts] -> Maybe (DynFlags -> IO DynFlags)'.
All plugins that supply a non-Nothing 'dynflagsPlugin' will see their
updates applied to the current DynFlags right after the plugins are
loaded.

One use case for this is to superseede !1580 for registering hooks
from a plugin. Frontend/parser plugins were considered to achieve this
but they respectively conflict with how this plugin is going to be used
and don't allow overriding/modifying the DynFlags, which is how hooks have
to be registered.

This commit comes with a test, 'test-hook-plugin', that registers a "fake"
meta hook that replaces TH expressions with the 0 integer literal.

11 files changed, 205 insertions, 1 deletions

diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index ea09a8ceb5..c4d370cca0 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -69,8 +69,12 @@ initializePlugins hsc_env df
   = return df -- no need to reload plugins
   | otherwise
   = do loadedPlugins <- loadPlugins (hsc_env { hsc_dflags = df })
-       return $ df { cachedPlugins = loadedPlugins }
+       let df' = df { cachedPlugins = loadedPlugins }
+       df'' <- withPlugins df' runDflagsPlugin df'
+       return df''
+
   where argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst)
+        runDflagsPlugin p opts dynflags = dynflagsPlugin p opts dynflags
 
 loadPlugins :: HscEnv -> IO [LoadedPlugin]
 loadPlugins hsc_env
diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs
index 66eebb9f63..790acdc2fc 100644
--- a/compiler/main/Plugins.hs
+++ b/compiler/main/Plugins.hs
@@ -92,6 +92,13 @@ 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.
+    --
+    --   @since 8.10.1
   , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
     -- ^ Specify how the plugin should affect recompilation.
   , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
@@ -201,6 +208,7 @@ defaultPlugin = Plugin {
         installCoreToDos      = const return
       , tcPlugin              = const Nothing
       , holeFitPlugin         = const Nothing
+      , dynflagsPlugin        = const return
       , pluginRecompile       = impurePlugin
       , renamedResultAction   = \_ env grp -> return (env, grp)
       , parsedResultAction    = \_ _ -> return
diff --git a/docs/users_guide/8.10.1-notes.rst b/docs/users_guide/8.10.1-notes.rst
index eb06b02ac8..64c2da2e09 100644
--- a/docs/users_guide/8.10.1-notes.rst
+++ b/docs/users_guide/8.10.1-notes.rst
@@ -177,6 +177,12 @@ Compiler
   been patched to no longer have have the MAX_PATH limit.  Windows users should no longer
   have any issues with long path names.
 
+- Introduce ``DynFlags`` plugins, that allow users to modidy the ``DynFlags``
+  that GHC is going to use when processing a set of files, from plugins.
+  They can be used for applying tiny configuration changes, registering hooks
+  and much more. See the :ref:`user guide <dynflags_plugins>` for
+  more details as well as an example.
+
 GHCi
 ~~~~
 
diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst
index 0ed65d13b3..4dfb4e4504 100644
--- a/docs/users_guide/extending_ghc.rst
+++ b/docs/users_guide/extending_ghc.rst
@@ -367,6 +367,23 @@ cabal for instance,) you can then use it by just specifying
 ``-fplugin=DoNothing.Plugin`` on the command line, and during the
 compilation you should see GHC say 'Hello'.
 
+Running multiple plugins is also supported, by passing
+multiple ``-fplugin=...`` options. GHC will load the plugins
+in the order in which they are specified on the command line
+and, when appropriate, compose their effects in the same
+order. That is, if we had two Core plugins, ``Plugin1`` and
+``Plugin2``, each defining an ``install`` function like
+the one above, then GHC would first run ``Plugin1.install``
+on the default ``[CoreToDo]``, take the result and feed it to
+``Plugin2.install``. ``-fplugin=Plugin1 -fplugin=Plugin2``
+will update the Core pipeline by applying
+``Plugin1.install opts1 >=> Plugin2.install opts2`` (where
+``opts1`` and ``opts2`` are the options passed to each plugin
+using ``-fplugin-opt=...``). This is not specific to Core
+plugins but holds for all the types of plugins that can be
+composed or sequenced in some way: the first plugin to appear
+on the GHC command line will always act first.
+
 .. _core-plugins-in-more-detail:
 
 Core plugins in more detail
@@ -1265,3 +1282,92 @@ were passed to it, and then exits.
 Provided you have compiled this plugin and registered it in a package,
 you can just use it by specifying ``--frontend DoNothing.FrontendPlugin``
 on the command line to GHC.
+
+.. _dynflags_plugins:
+
+DynFlags plugins
+~~~~~~~~~~~~~~~~
+
+A DynFlags plugin allows you to modify the ``DynFlags`` that GHC
+is going to use when processing a given (set of) file(s).
+``DynFlags`` is a record containing all sorts of configuration
+and command line data, from verbosity level to the integer library
+to use, including compiler hooks, plugins and pretty-printing options.
+DynFlags plugins allow plugin authors to update any of those values
+before GHC starts doing any actual work, effectively meaning that
+the updates specified by the plugin will be taken into account and
+influence GHC's behaviour.
+
+One of the motivating examples was the ability to register
+compiler hooks from a plugin. For example, one might want to modify
+the way Template Haskell code is executed. This is achievable by
+updating the ``hooks`` field of the ``DynFlags`` type, recording
+our custom "meta hook" in the right place. A simple application of
+this idea can be seen below:
+
+::
+
+    module DynFlagsPlugin (plugin) where
+
+    import BasicTypes
+    import GhcPlugins
+    import GHC.Hs.Expr
+    import GHC.Hs.Extension
+    import GHC.Hs.Lit
+    import Hooks
+    import TcRnMonad
+
+    plugin :: Plugin
+    plugin = defaultPlugin { dynflagsPlugin = hooksP }
+
+    hooksP :: [CommandLineOption] -> DynFlags -> IO DynFlags
+    hooksP opts dflags = return $ dflags
+      { hooks = (hooks dflags)
+        { runMetaHook = Just (fakeRunMeta opts) }
+      }
+
+    -- This meta hook doesn't actually care running code in splices,
+    -- it just replaces any expression splice with the "0"
+    -- integer literal, and errors out on all other types of
+    -- meta requests.
+    fakeRunMeta :: [CommandLineOption] -> MetaHook TcM
+    fakeRunMeta opts (MetaE r) _ = do
+      liftIO . putStrLn $ "Options = " ++ show opts
+      pure $ r zero
+
+      where zero :: LHsExpr GhcPs
+            zero = L noSrcSpan $ HsLit NoExtField $
+              HsInt NoExtField (mkIntegralLit (0 :: Int))
+
+    fakeRunMeta _ _ _ = error "fakeRunMeta: unimplemented"
+
+This simple plugin takes over the execution of Template Haskell code,
+replacing any expression splice it encounters by ``0`` (at type
+``Int``), and errors out on any other type of splice.
+
+Therefore, if we run GHC against the following code using the plugin
+from above:
+
+::
+
+    {-# OPTIONS -fplugin=DynFlagsPlugin #-}
+    {-# LANGUAGE TemplateHaskell #-}
+    module Main where
+
+    main :: IO ()
+    main = print $( [|1|] )
+
+This will not actually evaluate ``[|1|]``, but instead replace it
+with the ``0 :: Int`` literal.
+
+Just like the other types of plugins, you can write ``DynFlags`` plugins
+that can take and make use of some options that you can then specify
+using the ``-fplugin-opt`` flag. In the ``DynFlagsPlugin`` code from
+above, the said options would be available in the ``opts`` argument of
+``hooksP``.
+
+Finally, since those ``DynFlags`` updates happen after the plugins are loaded,
+you cannot from a ``DynFlags`` plugin register other plugins by just adding them
+to the ``plugins`` field of ``DynFlags``. In order to achieve this, you would
+have to load them yourself and store the result into the ``cachedPlugins``
+field of ``DynFlags``.
diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T
index 4ca732e3f5..1fec731289 100644
--- a/testsuite/tests/plugins/all.T
+++ b/testsuite/tests/plugins/all.T
@@ -217,3 +217,13 @@ test('test-hole-plugin',
       req_th
       ],
      compile, ['-fdefer-typed-holes'])
+test('test-hooks-plugin',
+     [extra_files(['hooks-plugin/']),
+      pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.hooks-plugin TOP={top}'),
+      # The following doesn't seem to work, even though it
+      # seems identical to the previous test...?
+      # extra_hc_opts('-package-db hooks-plugin/pkg.hooks-plugin/local.package.conf '+ config.plugin_way_flags),
+      req_th
+      ],
+     compile_and_run,
+     ['-package-db hooks-plugin/pkg.hooks-plugin/local.package.conf '+ config.plugin_way_flags])
diff --git a/testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs b/testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs
new file mode 100644
index 0000000000..04e066c22f
--- /dev/null
+++ b/testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs
@@ -0,0 +1,34 @@
+{-# OPTIONS_GHC -Wall #-}
+module Hooks.Plugin (plugin) where
+
+import BasicTypes
+import GhcPlugins
+import GHC.Hs.Expr
+import GHC.Hs.Extension
+import GHC.Hs.Lit
+import Hooks
+import TcRnMonad
+
+plugin :: Plugin
+plugin = defaultPlugin { dynflagsPlugin = hooksP }
+
+hooksP :: [CommandLineOption] -> DynFlags -> IO DynFlags
+hooksP opts dflags = return $ dflags
+  { hooks = (hooks dflags)
+    { runMetaHook = Just (fakeRunMeta opts) }
+  }
+
+-- This meta hook doesn't actually care running code in splices,
+-- it just replaces any expression splice with the "0"
+-- integer literal, and errors out on all other types of
+-- meta requests.
+fakeRunMeta :: [CommandLineOption] -> MetaHook TcM
+fakeRunMeta opts (MetaE r) _ = do
+  liftIO . putStrLn $ "Options = " ++ show opts
+  pure $ r zero
+
+  where zero :: LHsExpr GhcPs
+        zero = L noSrcSpan $ HsLit NoExtField $
+          HsInt NoExtField (mkIntegralLit (0 :: Int))
+
+fakeRunMeta _ _ _ = error "fakeRunMeta: unimplemented"
diff --git a/testsuite/tests/plugins/hooks-plugin/Makefile b/testsuite/tests/plugins/hooks-plugin/Makefile
new file mode 100644
index 0000000000..ef205569f9
--- /dev/null
+++ b/testsuite/tests/plugins/hooks-plugin/Makefile
@@ -0,0 +1,18 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean.%:
+	rm -rf pkg.$*
+
+HERE := $(abspath .)
+$(eval $(call canonicalise, HERE))
+
+package.%:
+	$(MAKE) -s --no-print-directory clean.$*
+	mkdir pkg.$*
+	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+	"$(GHC_PKG)" init pkg.$*/local.package.conf
+	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
+	pkg.$*/setup build --distdir pkg.$*/dist -v0
+	pkg.$*/setup install --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/hooks-plugin/Setup.hs b/testsuite/tests/plugins/hooks-plugin/Setup.hs
new file mode 100644
index 0000000000..9a994af677
--- /dev/null
+++ b/testsuite/tests/plugins/hooks-plugin/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal b/testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal
new file mode 100644
index 0000000000..3c1cf61184
--- /dev/null
+++ b/testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal
@@ -0,0 +1,9 @@
+cabal-version:       >=1.10
+name:                hooks-plugin
+version:             0.1
+build-type:          Simple
+
+library
+  exposed-modules:     Hooks.Plugin
+  build-depends:       base, ghc
+  default-language:    Haskell2010
diff --git a/testsuite/tests/plugins/test-hooks-plugin.hs b/testsuite/tests/plugins/test-hooks-plugin.hs
new file mode 100644
index 0000000000..bf324f9966
--- /dev/null
+++ b/testsuite/tests/plugins/test-hooks-plugin.hs
@@ -0,0 +1,6 @@
+{-# OPTIONS -fplugin=Hooks.Plugin #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+main :: IO ()
+main = print $( [|1|] )
diff --git a/testsuite/tests/plugins/test-hooks-plugin.stdout b/testsuite/tests/plugins/test-hooks-plugin.stdout
new file mode 100644
index 0000000000..c227083464
--- /dev/null
+++ b/testsuite/tests/plugins/test-hooks-plugin.stdout
@@ -0,0 +1 @@
+0
\ No newline at end of file