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