1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE CPP #-}
3
4-- | Definitions for writing /plugins/ for GHC. Plugins can hook into
5-- several areas of the compiler. See the 'Plugin' type. These plugins
6-- include type-checker plugins, source plugins, and core-to-core plugins.
7
8module GHC.Driver.Plugins (
9      -- * Plugins
10      Plugin(..)
11    , defaultPlugin
12    , CommandLineOption
13      -- ** Recompilation checking
14    , purePlugin, impurePlugin, flagRecompile
15    , PluginRecompile(..)
16
17      -- * Plugin types
18      -- ** Frontend plugins
19    , FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction
20      -- ** Core plugins
21      -- | Core plugins allow plugins to register as a Core-to-Core pass.
22    , CorePlugin
23      -- ** Typechecker plugins
24      -- | Typechecker plugins allow plugins to provide evidence to the
25      -- typechecker.
26    , TcPlugin
27      -- ** Source plugins
28      -- | GHC offers a number of points where plugins can access and modify its
29      -- front-end (\"source\") representation. These include:
30      --
31      -- - access to the parser result with 'parsedResultAction'
32      -- - access to the renamed AST with 'renamedResultAction'
33      -- - access to the typechecked AST with 'typeCheckResultAction'
34      -- - access to the Template Haskell splices with 'spliceRunAction'
35      -- - access to loaded interface files with 'interfaceLoadAction'
36      --
37    , keepRenamedSource
38      -- ** Hole fit plugins
39      -- | hole fit plugins allow plugins to change the behavior of valid hole
40      -- fit suggestions
41    , HoleFitPluginR
42
43      -- * Internal
44    , PluginWithArgs(..), plugins, pluginRecompile'
45    , LoadedPlugin(..), lpModuleName
46    , StaticPlugin(..)
47    , mapPlugins, withPlugins, withPlugins_
48    ) where
49
50import GHC.Prelude
51
52import GHC.Driver.Env
53import GHC.Driver.Monad
54import GHC.Driver.Phases
55
56import GHC.Unit.Module
57import GHC.Unit.Module.ModIface
58import GHC.Unit.Module.ModSummary
59
60import qualified GHC.Tc.Types
61import GHC.Tc.Types ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports  )
62import GHC.Tc.Errors.Hole.FitTypes ( HoleFitPluginR )
63
64import GHC.Core.Opt.Monad ( CoreToDo, CoreM )
65import GHC.Hs
66import GHC.Utils.Fingerprint
67import GHC.Utils.Outputable (Outputable(..), text, (<+>))
68
69import Data.List (sort)
70
71--Qualified import so we can define a Semigroup instance
72-- but it doesn't clash with Outputable.<>
73import qualified Data.Semigroup
74
75import Control.Monad
76
77-- | Command line options gathered from the -PModule.Name:stuff syntax
78-- are given to you as this type
79type CommandLineOption = String
80
81-- | 'Plugin' is the compiler plugin data type. Try to avoid
82-- constructing one of these directly, and just modify some fields of
83-- 'defaultPlugin' instead: this is to try and preserve source-code
84-- compatibility when we add fields to this.
85--
86-- Nonetheless, this API is preliminary and highly likely to change in
87-- the future.
88data Plugin = Plugin {
89    installCoreToDos :: CorePlugin
90    -- ^ Modify the Core pipeline that will be used for compilation.
91    -- This is called as the Core pipeline is built for every module
92    -- being compiled, and plugins get the opportunity to modify the
93    -- pipeline in a nondeterministic order.
94  , tcPlugin :: TcPlugin
95    -- ^ An optional typechecker plugin, which may modify the
96    -- behaviour of the constraint solver.
97  , holeFitPlugin :: HoleFitPlugin
98    -- ^ An optional plugin to handle hole fits, which may re-order
99    --   or change the list of valid hole fits and refinement hole fits.
100
101  , driverPlugin :: [CommandLineOption] -> HscEnv -> IO HscEnv
102    -- ^ An optional plugin to update 'HscEnv', right after plugin loading. This
103    -- can be used to register hooks or tweak any field of 'DynFlags' before
104    -- doing actual work on a module.
105    --
106    --   @since 8.10.1
107
108  , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
109    -- ^ Specify how the plugin should affect recompilation.
110  , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
111                            -> Hsc HsParsedModule
112    -- ^ Modify the module when it is parsed. This is called by
113    -- "GHC.Driver.Main" when the parsing is successful.
114  , renamedResultAction :: [CommandLineOption] -> TcGblEnv
115                                -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
116    -- ^ Modify each group after it is renamed. This is called after each
117    -- `HsGroup` has been renamed.
118  , typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv
119                               -> TcM TcGblEnv
120    -- ^ Modify the module when it is type checked. This is called at the
121    -- very end of typechecking.
122  , spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc
123                         -> TcM (LHsExpr GhcTc)
124    -- ^ Modify the TH splice or quasiqoute before it is run.
125  , interfaceLoadAction :: forall lcl . [CommandLineOption] -> ModIface
126                                          -> IfM lcl ModIface
127    -- ^ Modify an interface that have been loaded. This is called by
128    -- "GHC.Iface.Load" when an interface is successfully loaded. Not applied to
129    -- the loading of the plugin interface. Tools that rely on information from
130    -- modules other than the currently compiled one should implement this
131    -- function.
132  }
133
134-- Note [Source plugins]
135-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
136-- The `Plugin` datatype have been extended by fields that allow access to the
137-- different inner representations that are generated during the compilation
138-- process. These fields are `parsedResultAction`, `renamedResultAction`,
139-- `typeCheckResultAction`, `spliceRunAction` and `interfaceLoadAction`.
140--
141-- The main purpose of these plugins is to help tool developers. They allow
142-- development tools to extract the information about the source code of a big
143-- Haskell project during the normal build procedure. In this case the plugin
144-- acts as the tools access point to the compiler that can be controlled by
145-- compiler flags. This is important because the manipulation of compiler flags
146-- is supported by most build environment.
147--
148-- For the full discussion, check the full proposal at:
149-- https://gitlab.haskell.org/ghc/ghc/wikis/extended-plugins-proposal
150
151data PluginWithArgs = PluginWithArgs
152  { paPlugin :: Plugin
153    -- ^ the actual callable plugin
154  , paArguments :: [CommandLineOption]
155    -- ^ command line arguments for the plugin
156  }
157
158-- | A plugin with its arguments. The result of loading the plugin.
159data LoadedPlugin = LoadedPlugin
160  { lpPlugin :: PluginWithArgs
161  -- ^ the actual plugin together with its commandline arguments
162  , lpModule :: ModIface
163  -- ^ the module containing the plugin
164  }
165
166-- | A static plugin with its arguments. For registering compiled-in plugins
167-- through the GHC API.
168data StaticPlugin = StaticPlugin
169  { spPlugin :: PluginWithArgs
170  -- ^ the actual plugin together with its commandline arguments
171  }
172
173lpModuleName :: LoadedPlugin -> ModuleName
174lpModuleName = moduleName . mi_module . lpModule
175
176pluginRecompile' :: PluginWithArgs -> IO PluginRecompile
177pluginRecompile' (PluginWithArgs plugin args) = pluginRecompile plugin args
178
179data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint
180
181instance Outputable PluginRecompile where
182  ppr ForceRecompile = text "ForceRecompile"
183  ppr NoForceRecompile = text "NoForceRecompile"
184  ppr (MaybeRecompile fp) = text "MaybeRecompile" <+> ppr fp
185
186instance Semigroup PluginRecompile where
187  ForceRecompile <> _ = ForceRecompile
188  NoForceRecompile <> r = r
189  MaybeRecompile fp <> NoForceRecompile   = MaybeRecompile fp
190  MaybeRecompile fp <> MaybeRecompile fp' = MaybeRecompile (fingerprintFingerprints [fp, fp'])
191  MaybeRecompile _fp <> ForceRecompile     = ForceRecompile
192
193instance Monoid PluginRecompile where
194  mempty = NoForceRecompile
195
196type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
197type TcPlugin = [CommandLineOption] -> Maybe GHC.Tc.Types.TcPlugin
198type HoleFitPlugin = [CommandLineOption] -> Maybe HoleFitPluginR
199
200purePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile
201purePlugin _args = return NoForceRecompile
202
203impurePlugin _args = return ForceRecompile
204
205flagRecompile =
206  return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort
207
208-- | Default plugin: does nothing at all, except for marking that safe
209-- inference has failed unless @-fplugin-trustworthy@ is passed. For
210-- compatibility reason you should base all your plugin definitions on this
211-- default value.
212defaultPlugin :: Plugin
213defaultPlugin = Plugin {
214        installCoreToDos      = const return
215      , tcPlugin              = const Nothing
216      , holeFitPlugin         = const Nothing
217      , driverPlugin          = const return
218      , pluginRecompile       = impurePlugin
219      , renamedResultAction   = \_ env grp -> return (env, grp)
220      , parsedResultAction    = \_ _ -> return
221      , typeCheckResultAction = \_ _ -> return
222      , spliceRunAction       = \_ -> return
223      , interfaceLoadAction   = \_ -> return
224    }
225
226
227-- | A renamer plugin which mades the renamed source available in
228-- a typechecker plugin.
229keepRenamedSource :: [CommandLineOption] -> TcGblEnv
230                  -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
231keepRenamedSource _ gbl_env group =
232  return (gbl_env { tcg_rn_decls = update (tcg_rn_decls gbl_env)
233                  , tcg_rn_exports = update_exports (tcg_rn_exports gbl_env) }, group)
234  where
235    update_exports Nothing = Just []
236    update_exports m = m
237
238    update Nothing = Just emptyRnGroup
239    update m       = m
240
241
242type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a
243type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()
244
245plugins :: HscEnv -> [PluginWithArgs]
246plugins hsc_env =
247  map lpPlugin (hsc_plugins hsc_env) ++
248  map spPlugin (hsc_static_plugins hsc_env)
249
250-- | Perform an operation by using all of the plugins in turn.
251withPlugins :: Monad m => HscEnv -> PluginOperation m a -> a -> m a
252withPlugins hsc_env transformation input = foldM go input (plugins hsc_env)
253  where
254    go arg (PluginWithArgs p opts) = transformation p opts arg
255
256mapPlugins :: HscEnv -> (Plugin -> [CommandLineOption] -> a) -> [a]
257mapPlugins hsc_env f = map (\(PluginWithArgs p opts) -> f p opts) (plugins hsc_env)
258
259-- | Perform a constant operation by using all of the plugins in turn.
260withPlugins_ :: Monad m => HscEnv -> ConstPluginOperation m a -> a -> m ()
261withPlugins_ hsc_env transformation input
262  = mapM_ (\(PluginWithArgs p opts) -> transformation p opts input)
263          (plugins hsc_env)
264
265type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc ()
266data FrontendPlugin = FrontendPlugin {
267      frontend :: FrontendPluginAction
268    }
269defaultFrontendPlugin :: FrontendPlugin
270defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () }
271