From 9728d6c2b62f38f79c8833b1819200985fe173dc Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 14 Dec 2021 11:23:02 +0100 Subject: Give plugins a better interface (#17957) Plugins were directly fetched from HscEnv (hsc_static_plugins and hsc_plugins). The tight coupling of plugins and of HscEnv is undesirable and it's better to store them in a new Plugins datatype and to use it in the plugins' API (e.g. withPlugins, mapPlugins...). In the process, the interactive context (used by GHCi) got proper support for different static plugins than those used for loaded modules. Bump haddock submodule --- compiler/GHC/Driver/Env/Types.hs | 17 ++----------- compiler/GHC/Driver/Main.hs | 5 ++-- compiler/GHC/Driver/Plugins.hs | 50 +++++++++++++++++++++++++++---------- compiler/GHC/Driver/Plugins.hs-boot | 3 +++ 4 files changed, 44 insertions(+), 31 deletions(-) (limited to 'compiler/GHC/Driver') diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs index 0c58ac8855..b0fcc6fd64 100644 --- a/compiler/GHC/Driver/Env/Types.hs +++ b/compiler/GHC/Driver/Env/Types.hs @@ -85,21 +85,8 @@ data HscEnv -- ^ target code interpreter (if any) to use for TH and GHCi. -- See Note [Target code interpreter] - , 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. + , hsc_plugins :: !Plugins + -- ^ Plugins , hsc_unit_env :: UnitEnv -- ^ Unit environment (unit state, home unit, etc.). diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index c403b3e85a..39c1f7af4e 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -265,8 +265,7 @@ newHscEnv dflags = do , hsc_type_env_vars = emptyKnotVars , hsc_interp = Nothing , hsc_unit_env = unit_env - , hsc_plugins = [] - , hsc_static_plugins = [] + , hsc_plugins = emptyPlugins , hsc_hooks = emptyHooks , hsc_tmpfs = tmpfs } @@ -479,7 +478,7 @@ hscParse' mod_summary let applyPluginAction p opts = parsedResultAction p opts mod_summary hsc_env <- getHscEnv - withPlugins hsc_env applyPluginAction res + withPlugins (hsc_plugins hsc_env) applyPluginAction res checkBidirectionFormatChars :: PsLoc -> StringBuffer -> Maybe (NonEmpty (PsLoc, Char, String)) checkBidirectionFormatChars start_loc sb diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs index 83d41a6695..4fbbd5ce32 100644 --- a/compiler/GHC/Driver/Plugins.hs +++ b/compiler/GHC/Driver/Plugins.hs @@ -7,7 +7,9 @@ module GHC.Driver.Plugins ( -- * Plugins - Plugin(..) + Plugins (..) + , emptyPlugins + , Plugin(..) , defaultPlugin , CommandLineOption -- ** Recompilation checking @@ -45,7 +47,7 @@ module GHC.Driver.Plugins ( , HoleFitPluginR -- * Internal - , PluginWithArgs(..), plugins, pluginRecompile' + , PluginWithArgs(..), pluginsWithArgs, pluginRecompile' , LoadedPlugin(..), lpModuleName , StaticPlugin(..) , mapPlugins, withPlugins, withPlugins_ @@ -251,25 +253,47 @@ keepRenamedSource _ gbl_env group = type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m () -plugins :: HscEnv -> [PluginWithArgs] -plugins hsc_env = - map lpPlugin (hsc_plugins hsc_env) ++ - map spPlugin (hsc_static_plugins hsc_env) +data Plugins = Plugins + { 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. + + , loadedPlugins :: ![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'. + } + +emptyPlugins :: Plugins +emptyPlugins = Plugins [] [] + + +pluginsWithArgs :: Plugins -> [PluginWithArgs] +pluginsWithArgs plugins = + map lpPlugin (loadedPlugins plugins) ++ + map spPlugin (staticPlugins plugins) -- | Perform an operation by using all of the plugins in turn. -withPlugins :: Monad m => HscEnv -> PluginOperation m a -> a -> m a -withPlugins hsc_env transformation input = foldM go input (plugins hsc_env) +withPlugins :: Monad m => Plugins -> PluginOperation m a -> a -> m a +withPlugins plugins transformation input = foldM go input (pluginsWithArgs plugins) where go arg (PluginWithArgs p opts) = transformation p opts arg -mapPlugins :: HscEnv -> (Plugin -> [CommandLineOption] -> a) -> [a] -mapPlugins hsc_env f = map (\(PluginWithArgs p opts) -> f p opts) (plugins hsc_env) +mapPlugins :: Plugins -> (Plugin -> [CommandLineOption] -> a) -> [a] +mapPlugins plugins f = map (\(PluginWithArgs p opts) -> f p opts) (pluginsWithArgs plugins) -- | Perform a constant operation by using all of the plugins in turn. -withPlugins_ :: Monad m => HscEnv -> ConstPluginOperation m a -> a -> m () -withPlugins_ hsc_env transformation input +withPlugins_ :: Monad m => Plugins -> ConstPluginOperation m a -> a -> m () +withPlugins_ plugins transformation input = mapM_ (\(PluginWithArgs p opts) -> transformation p opts input) - (plugins hsc_env) + (pluginsWithArgs plugins) type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc () data FrontendPlugin = FrontendPlugin { diff --git a/compiler/GHC/Driver/Plugins.hs-boot b/compiler/GHC/Driver/Plugins.hs-boot index 7b5f8ca161..15b3657dd0 100644 --- a/compiler/GHC/Driver/Plugins.hs-boot +++ b/compiler/GHC/Driver/Plugins.hs-boot @@ -5,6 +5,9 @@ module GHC.Driver.Plugins where import GHC.Prelude () data Plugin +data Plugins + +emptyPlugins :: Plugins data LoadedPlugin data StaticPlugin -- cgit v1.2.1