Commit c2783ccf authored by lazac's avatar lazac Committed by Ben Gamari
Browse files

Extended the plugin system to run plugins on more representations

Extend GHC plugins to access parsed, type checked representation,
interfaces that are loaded. And splices that are evaluated. The goal is
to enable development tools to access the GHC representation in the
pre-existing build environment.

See the full proposal here:

Reviewers: goldfire, bgamari, ezyang, angerman, mpickering

Reviewed By: mpickering

Subscribers: ezyang, angerman, mpickering, ulysses4ever, rwbarton, thomie, carter

GHC Trac Issues: #14709

Differential Revision:
parent 72725668
......@@ -77,6 +77,7 @@ import Hooks
import FieldLabel
import RnModIface
import UniqDSet
import Plugins
import Control.Monad
import Control.Exception
......@@ -510,7 +511,9 @@ loadInterface doc_str mod from
(length new_eps_insts)
(length new_eps_rules) }
; return (Succeeded final_iface)
; -- invoke plugins
res <- withPlugins dflags interfaceLoadAction final_iface
; return (Succeeded res)
......@@ -85,6 +85,7 @@ module HscMain
import GhcPrelude
import Data.Data hiding (Fixity, TyCon)
import Data.Maybe ( isJust, fromMaybe )
import DynFlags (addPluginModuleName)
import Id
import GHCi ( addSptEntry )
......@@ -142,6 +143,8 @@ import Fingerprint ( Fingerprint )
import Hooks
import TcEnv
import PrelNames
import Plugins
import DynamicLoading ( initializePlugins )
import DynFlags
import ErrUtils
......@@ -169,7 +172,6 @@ import System.IO (fixIO)
import qualified Data.Map as Map
import qualified Data.Set as S
import Data.Set (Set)
import DynamicLoading (initializePlugins)
#include "HsVersions.h"
......@@ -375,7 +377,7 @@ hscParse' mod_summary
-- filter them out:
srcs2 <- liftIO $ filterM doesFileExist srcs1
return HsParsedModule {
let res = HsParsedModule {
hpm_module = rdr_module,
hpm_src_files = srcs2,
......@@ -384,6 +386,11 @@ hscParse' mod_summary
:(annotations_comments pst)))
-- apply parse transformation of plugins
let applyPluginAction p opts
= parsedResultAction p opts mod_summary
withPlugins dflags applyPluginAction res
-- XXX: should this really be a Maybe X? Check under which circumstances this
-- can become a Nothing and decide whether this should instead throw an
-- exception/signal an error.
......@@ -395,13 +402,7 @@ type RenamedStuff =
-- | If the renamed source has been kept, extract it. Dump it if requested.
extract_renamed_stuff :: TcGblEnv -> Hsc (TcGblEnv, RenamedStuff)
extract_renamed_stuff tc_result = do
-- This 'do' is in the Maybe monad!
let rn_info = do decl <- tcg_rn_decls tc_result
let imports = tcg_rn_imports tc_result
exports = tcg_rn_exports tc_result
doc_hdr = tcg_doc_hdr tc_result
return (decl,imports,exports,doc_hdr)
let rn_info = get_renamed_stuff tc_result
dflags <- getDynFlags
liftIO $ dumpIfSet_dyn dflags Opt_D_dump_rn_ast "Renamer" $
......@@ -409,15 +410,20 @@ extract_renamed_stuff tc_result = do
return (tc_result, rn_info)
-- | Extract the renamed information from TcGblEnv.
get_renamed_stuff :: TcGblEnv -> RenamedStuff
get_renamed_stuff tc_result
= fmap (\decls -> ( decls, tcg_rn_imports tc_result
, tcg_rn_exports tc_result, tcg_doc_hdr tc_result ) )
(tcg_rn_decls tc_result)
-- -----------------------------------------------------------------------------
-- | Rename and typecheck a module, additionally returning the renamed syntax
hscTypecheckRename :: HscEnv -> ModSummary -> HsParsedModule
-> IO (TcGblEnv, RenamedStuff)
hscTypecheckRename hsc_env mod_summary rdr_module = runHsc hsc_env $ do
tc_result <- hscTypecheck True mod_summary (Just rdr_module)
extract_renamed_stuff tc_result
tc_result <- hscTypecheck True mod_summary (Just rdr_module)
extract_renamed_stuff tc_result
hscTypecheck :: Bool -- ^ Keep renamed source?
-> ModSummary -> Maybe HsParsedModule
......@@ -460,39 +466,65 @@ tcRnModule' :: ModSummary -> Bool -> HsParsedModule
-> Hsc TcGblEnv
tcRnModule' sum save_rn_syntax mod = do
hsc_env <- getHscEnv
dflags <- getDynFlags
-- check if plugins need the renamed syntax
let plugin_needs_rn = any (isJust . renamedResultAction . lpPlugin)
(plugins dflags)
tcg_res <- {-# SCC "Typecheck-Rename" #-}
ioMsgMaybe $
tcRnModule hsc_env (ms_hsc_src sum) save_rn_syntax mod
tcRnModule hsc_env (ms_hsc_src sum)
(save_rn_syntax || plugin_needs_rn) mod
-- See Note [Safe Haskell Overlapping Instances Implementation]
-- although this is used for more than just that failure case.
(tcSafeOK, whyUnsafe) <- liftIO $ readIORef (tcg_safeInfer tcg_res)
dflags <- getDynFlags
let allSafeOK = safeInferred dflags && tcSafeOK
-- end of the safe haskell line, how to respond to user?
if not (safeHaskellOn dflags) || (safeInferOn dflags && not allSafeOK)
-- if safe Haskell off or safe infer failed, mark unsafe
then markUnsafeInfer tcg_res whyUnsafe
-- module (could be) safe, throw warning if needed
else do
tcg_res' <- hscCheckSafeImports tcg_res
safe <- liftIO $ fst <$> readIORef (tcg_safeInfer tcg_res')
when safe $ do
case wopt Opt_WarnSafe dflags of
True -> (logWarnings $ unitBag $
makeIntoWarning (Reason Opt_WarnSafe) $
mkPlainWarnMsg dflags (warnSafeOnLoc dflags) $
errSafe tcg_res')
False | safeHaskell dflags == Sf_Trustworthy &&
wopt Opt_WarnTrustworthySafe dflags ->
(logWarnings $ unitBag $
makeIntoWarning (Reason Opt_WarnTrustworthySafe) $
mkPlainWarnMsg dflags (trustworthyOnLoc dflags) $
errTwthySafe tcg_res')
False -> return ()
return tcg_res'
res <- if not (safeHaskellOn dflags)
|| (safeInferOn dflags && not allSafeOK)
-- if safe Haskell off or safe infer failed, mark unsafe
then markUnsafeInfer tcg_res whyUnsafe
-- module (could be) safe, throw warning if needed
else do
tcg_res' <- hscCheckSafeImports tcg_res
safe <- liftIO $ fst <$> readIORef (tcg_safeInfer tcg_res')
when safe $ do
case wopt Opt_WarnSafe dflags of
True -> (logWarnings $ unitBag $
makeIntoWarning (Reason Opt_WarnSafe) $
mkPlainWarnMsg dflags (warnSafeOnLoc dflags) $
errSafe tcg_res')
False | safeHaskell dflags == Sf_Trustworthy &&
wopt Opt_WarnTrustworthySafe dflags ->
(logWarnings $ unitBag $
makeIntoWarning (Reason Opt_WarnTrustworthySafe) $
mkPlainWarnMsg dflags (trustworthyOnLoc dflags) $
errTwthySafe tcg_res')
False -> return ()
return tcg_res'
-- apply plugins to the type checking result
let unsafeText = "Use of plugins makes the module unsafe"
pluginUnsafe = unitBag ( mkPlainWarnMsg dflags noSrcSpan
(Outputable.text unsafeText) )
case get_renamed_stuff res of
Just rn ->
withPlugins_ dflags
(\p opts -> (fromMaybe (\_ _ _ -> return ())
(renamedResultAction p)) opts sum)
Nothing -> return ()
res' <- withPlugins dflags
(\p opts -> typeCheckResultAction p opts sum
>=> flip markUnsafeInfer pluginUnsafe)
return res'
pprMod t = ppr $ moduleName $ tcg_mod t
errSafe t = quotes (pprMod t) <+> text "has been inferred as safe!"
{-# LANGUAGE RankNTypes #-}
module Plugins (
FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction,
Plugin(..), CommandLineOption, LoadedPlugin(..), lpModuleName,
defaultPlugin, withPlugins, withPlugins_
FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction
, Plugin(..), CommandLineOption, LoadedPlugin(..), lpModuleName
, defaultPlugin, withPlugins, withPlugins_
, PluginRecompile(..)
, purePlugin, impurePlugin, flagRecompile
) where
import GhcPrelude
import CoreMonad ( CoreToDo, CoreM )
import qualified TcRnTypes (TcPlugin)
import {-# SOURCE #-} CoreMonad ( CoreToDo, CoreM )
import qualified TcRnTypes
import TcRnTypes ( TcGblEnv, IfM, TcM )
import HsSyn
import DynFlags
import HscTypes
import GhcMonad
import DriverPhases
import Module ( ModuleName, Module(moduleName))
import Avail
import Fingerprint
import Data.List
import Outputable (Outputable(..), text, (<+>))
......@@ -50,14 +54,55 @@ data Plugin = Plugin {
-- behaviour of the constraint solver.
, pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
-- ^ Specify how the plugin should affect recompilation.
, parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
-> Hsc HsParsedModule
-- ^ Modify the module when it is parsed. This is called by
-- HscMain when the parsing is successful.
, renamedResultAction :: Maybe ([CommandLineOption] -> ModSummary
-> RenamedSource -> Hsc ())
-- ^ Installs a read-only pass that receives the renamed syntax tree as an
-- argument when type checking is successful.
, typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv
-> Hsc TcGblEnv
-- ^ Modify the module when it is type checked. This is called by
-- HscMain when the type checking is successful.
, spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc
-> TcM (LHsExpr GhcTc)
-- ^ Modify the TH splice or quasiqoute before it is run.
, interfaceLoadAction :: forall lcl . [CommandLineOption] -> ModIface
-> IfM lcl ModIface
-- ^ Modify an interface that have been loaded. This is called by
-- LoadIface when an interface is successfully loaded. Not applied to
-- the loading of the plugin interface. Tools that rely on information from
-- modules other than the currently compiled one should implement this
-- function.
-- Note [Source plugins]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The `Plugin` datatype have been extended by fields that allow access to the
-- different inner representations that are generated during the compilation
-- process. These fields are `parsedResultAction`, `needsRenamedSyntax` (for
-- controlling when renamed representation is kept during typechecking),
-- `typeCheckResultAction`, `spliceRunAction` and `interfaceLoadAction`.
-- The main purpose of these plugins is to help tool developers. They allow
-- development tools to extract the information about the source code of a big
-- Haskell project during the normal build procedure. In this case the plugin
-- acts as the tools access point to the compiler that can be controlled by
-- compiler flags. This is important because the manipulation of compiler flags
-- is supported by most build environment.
-- For the full discussion, check the full proposal at:
-- | A plugin with its arguments. The result of loading the plugin.
data LoadedPlugin = LoadedPlugin {
lpPlugin :: Plugin
-- ^ the actual callable plugin
, lpModule :: Module
-- ^ The module the plugin is defined in
-- ^ the module containing the plugin
, lpArguments :: [CommandLineOption]
-- ^ command line arguments for the plugin
......@@ -101,14 +146,22 @@ flagRecompile =
-- you should base all your plugin definitions on this default value.
defaultPlugin :: Plugin
defaultPlugin = Plugin {
installCoreToDos = const return
, tcPlugin = const Nothing
installCoreToDos = const return
, tcPlugin = const Nothing
, pluginRecompile = impurePlugin
, renamedResultAction = Nothing
, parsedResultAction = \_ _ -> return
, typeCheckResultAction = \_ _ -> return
, spliceRunAction = \_ -> return
, interfaceLoadAction = \_ -> return
type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a
type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()
type RenamedSource = ( HsGroup GhcRn, [LImportDecl GhcRn]
, Maybe [(LIE GhcRn, Avails)], Maybe LHsDocString )
-- | Perform an operation by using all of the plugins in turn.
withPlugins :: Monad m => DynFlags -> PluginOperation m a -> a -> m a
withPlugins df transformation input
-- Created this hs-boot file to remove circular dependencies from the use of
-- Plugins. Plugins needs CoreToDo and CoreM types to define core-to-core
-- transformations.
-- However CoreMonad does much more than defining these, and because Plugins are
-- activated in various modules, the imports become circular. To solve this I
-- extracted CoreToDo and CoreM into this file.
-- I needed to write the whole definition of these types, otherwise it created
-- a data-newtype conflict.
module CoreMonad ( CoreToDo, CoreM ) where
import GhcPrelude
import IOEnv ( IOEnv )
import UniqSupply ( UniqSupply )
newtype CoreState = CoreState {
cs_uniq_supply :: UniqSupply
type CoreIOEnv = IOEnv CoreReader
data CoreReader
newtype CoreWriter = CoreWriter {
cw_simpl_count :: SimplCount
data SimplCount
newtype CoreM a
= CoreM { unCoreM :: CoreState
-> CoreIOEnv (a, CoreState, CoreWriter) }
instance Monad CoreM
data CoreToDo
......@@ -112,6 +112,7 @@ import DynFlags
import Panic
import Lexeme
import qualified EnumSet
import Plugins
import qualified Language.Haskell.TH as TH
-- THSyntax gives access to internal functions and data types
......@@ -735,10 +736,13 @@ runMeta' show_code ppr_hs run_and_convert expr
-- in type-correct programs.
; failIfErrsM
-- run plugins
; hsc_env <- getTopEnv
; expr' <- withPlugins (hsc_dflags hsc_env) spliceRunAction expr
-- Desugar
; ds_expr <- initDsTc (dsLExpr expr)
; ds_expr <- initDsTc (dsLExpr expr')
-- Compile and link it; might fail if linking fails
; hsc_env <- getTopEnv
; src_span <- getSrcSpanM
; traceTc "About to run (desugared)" (ppr ds_expr)
; either_hval <- tryM $ liftIO $
......@@ -600,6 +600,209 @@ the plugin to create equality axioms for use in evidence terms, but GHC
does not check their consistency, and inconsistent axiom sets may lead
to segfaults or other runtime misbehaviour.
.. _source-plugins:
Source plugins
In additional to core and type checker plugins, you can install plugins that can
access different representations of the source code. The main purpose of these
plugins is to make it easier to implement development tools.
There are several different access points that you can use for defining plugins
that access the representations. All these fields receive the list of
``CommandLineOption`` strings that are passed to the compiler using the
``-fplugin-opt`` flags.
plugin :: Plugin
plugin = defaultPlugin {
parsedResultAction = parsed
, typeCheckResultAction = typechecked
, spliceRunAction = spliceRun
, interfaceLoadAction = interfaceLoad
, renamedResultAction = renamed
Parsed representation
When you want to define a plugin that uses the syntax tree of the source code,
you would like to override the ``parsedResultAction`` field. This access point
enables you to get access to information about the lexical tokens and comments
in the source code as well as the original syntax tree of the compiled module.
parsed :: [CommandLineOption] -> ModSummary -> HsParsedModule
-> Hsc HsParsedModule
The ``ModSummary`` contains useful
meta-information about the compiled module. The ``HsParsedModule`` contains the
lexical and syntactical information we mentioned before. The result that you
return will change the result of the parsing. If you don't want to change the
result, just return the ``HsParsedModule`` that you received as the argument.
Type checked representation
When you want to define a plugin that needs semantic information about the
source code, use the ``typeCheckResultAction`` field. For example, if your
plugin have to decide if two names are referencing the same definition or it has
to check the type of a function it is using semantic information. In this case
you need to access the renamed or type checked version of the syntax tree with
typechecked :: [CommandLineOption] -> ModSummary -> TcGblEnv -> Hsc TcGblEnv
By overriding the ``renamedResultAction`` field with a ``Just`` function, you
can request the compiler to keep the renamed syntax tree and give it to your
processing function. This is important because some parts of the renamed
syntax tree (for example, imports) are not found in the typechecked one.
The ``renamedResultAction`` is set to ``Nothing`` by default.
rename :: Maybe ([CommandLineOption] -> ModSummary -> Hsc ())
Evaluated code
When the compiler type checks the source code, :ref:`template-haskell` Splices
and :ref:`th-quasiquotation` will be replaced by the syntax tree fragments
generated from them. However for tools that operate on the source code the
code generator is usually more interesting than the generated code. For this
reason we included ``spliceRunAction``. This field is invoked on each expression
before they are evaluated. The input is type checked, so semantic information is
available for these syntax tree fragments. If you return a different expression
you can change the code that is generated.
spliceRun :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
However take care that the generated definitions are still in the input of
``typeCheckResultAction``. If your don't take care to filter the typechecked
input, the behavior of your tool might be inconsistent.
Interface files
Sometimes when you are writing a tool, knowing the source code is not enough,
you also have to know details about the modules that you import. In this case we
suggest using the ``interfaceLoadAction``. This will be called each time when
the code of an already compiled module is loaded. It will be invoked for modules
from installed packages and even modules that are installed with GHC. It will
NOT be invoked with your own modules.
interfaceLoad :: forall lcl . [CommandLineOption] -> ModIface
-> IfM lcl ModIface
In the ``ModIface`` datatype you can find lots of useful information, including
the exported definitions and type class instances.
Source plugin example
In this example, we inspect all available details of the compiled source code.
We don't change any of the representation, but write out the details to the
standard output. The pretty printed representation of the parsed, renamed and
type checked syntax tree will be in the output as well as the evaluated splices
and quasi quotes. The name of the interfaces that are loaded will also be
module SourcePlugin where
import Control.Monad.IO.Class
import Plugins
import HscTypes
import TcRnTypes
import HsExtension
import HsExpr
import Outputable
import HsDoc
plugin :: Plugin
plugin = defaultPlugin { parsedResultAction = parsedPlugin
, renamedResultAction = Just renamedAction
, typeCheckResultAction = typecheckPlugin
, spliceRunAction = metaPlugin
, interfaceLoadAction = interfaceLoadPlugin
parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedPlugin _ _ pm
= do liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDocUnsafe $ ppr $ hpm_module pm)
return pm
renamedAction :: [CommandLineOption] -> ModSummary
-> ( HsGroup GhcRn, [LImportDecl GhcRn]
, Maybe [(LIE GhcRn, Avails)], Maybe LHsDocString )
-> Hsc ()
renamedAction _ _ ( gr, _, _, _ )
= liftIO $ putStrLn "typeCheckPlugin (rn): " ++ (showSDocUnsafe $ ppr gr)
typecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> Hsc TcGblEnv
typecheckPlugin _ _ tc
= do liftIO $ putStrLn $ "typeCheckPlugin (rn): \n" ++ (showSDocUnsafe $ ppr $ tcg_rn_decls tc)
liftIO $ putStrLn $ "typeCheckPlugin (tc): \n" ++ (showSDocUnsafe $ ppr $ tcg_binds tc)
return tc
metaPlugin :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
metaPlugin _ meta
= do liftIO $ putStrLn $ "meta: " ++ (showSDocUnsafe $ ppr meta)
return meta
interfaceLoadPlugin :: [CommandLineOption] -> ModIface -> IfM lcl ModIface
interfaceLoadPlugin _ iface
= do liftIO $ putStrLn $ "interface loaded: " ++ (showSDocUnsafe $ ppr $ mi_module iface)
return iface
When you compile a simple module that contains Template Haskell splice
{-# LANGUAGE TemplateHaskell #-}
module A where
a = ()
$(return [])
with the compiler flags ``-fplugin SourcePlugin`` it will give the following
.. code-block:: none
module A where
a = ()
$(return [])
interface loaded: Prelude
interface loaded: GHC.Float
interface loaded: GHC.Base
interface loaded: Language.Haskell.TH.Lib.Internal
interface loaded: Language.Haskell.TH.Syntax
interface loaded: GHC.Types
meta: return []
interface loaded: GHC.Integer.Type
typeCheckPlugin (rn):
Just a = ()
typeCheckPlugin (tc):
{$trModule = Module (TrNameS "main"#) (TrNameS "A"#), a = ()}
.. _plugin_recompilation:
Controlling Recompilation
......@@ -21,6 +21,34 @@ plugins08:
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins08.hs -package-db simple-plugin/pkg.plugins08/local.package.conf
.PHONY: plugins09
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins09.hs -package-db simple-plugin/pkg.plugins09/local.package.conf -fplugin Simple.SourcePlugin -fplugin-opt Simple.SourcePlugin:a -fplugin-opt Simple.SourcePlugin:b -plugin-package simple-plugin
.PHONY: plugins10
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins10.hs QuasiQuotation.hs -package-db simple-plugin/pkg.plugins10/local.package.conf -fplugin Simple.SourcePlugin -plugin-package simple-plugin
.PHONY: plugins11
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins11.hs -package-db simple-plugin/pkg.plugins11/local.package.conf -plugin-package simple-plugin
.PHONY: plugins12
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins12.hs -package-db simple-plugin/pkg.plugins12/local.package.conf -plugin-package simple-plugin
.PHONY: plugins13
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins13.hs PluginFilteredExport.hs -package-db simple-plugin/pkg.plugins13/local.package.conf -plugin-package simple-plugin
.PHONY: plugins14
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins14.hs -package-db simple-plugin/pkg.plugins14/local.package.conf -plugin-package simple-plugin
.PHONY: plugins15
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins15.hs MetaRemoveHelper.hs -package-db simple-plugin/pkg.plugins15/local.package.conf -plugin-package simple-plugin
# -package (should work for backwards compatibility)