diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index e8ce029b04b61e9f8174751b683d74167801d193..ce12a5631acfd2500dc1b7e3f1163fd14f1fa463 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -66,6 +66,7 @@ import OrdList
import Data.List
import Data.IORef
import Control.Monad( when )
+import Plugins ( LoadedPlugin(..) )
{-
************************************************************************
@@ -169,7 +170,10 @@ deSugar hsc_env
; endPassIO hsc_env print_unqual CoreDesugarOpt ds_binds ds_rules_for_imps
; let used_names = mkUsedNames tcg_env
- ; deps <- mkDependencies tcg_env
+ pluginModules =
+ map lpModule (plugins (hsc_dflags hsc_env))
+ ; deps <- mkDependencies (thisInstalledUnitId (hsc_dflags hsc_env))
+ pluginModules tcg_env
; used_th <- readIORef tc_splice_used
; dep_files <- readIORef dependent_files
diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs
index 2eebca818fe065e315b375d31ad36d9042e8caa8..c8a04247cc00aab7522a837315577b9905ba9dce 100644
--- a/compiler/deSugar/DsUsage.hs
+++ b/compiler/deSugar/DsUsage.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
module DsUsage (
-- * Dependency/fingerprinting code (used by MkIface)
@@ -49,17 +50,23 @@ its dep_orphs. This was the cause of Trac #14128.
-- | Extract information from the rename and typecheck phases to produce
-- a dependencies information for the module being compiled.
-mkDependencies :: TcGblEnv -> IO Dependencies
-mkDependencies
- TcGblEnv{ tcg_mod = mod,
+--
+-- The first argument is additional dependencies from plugins
+mkDependencies :: InstalledUnitId -> [Module] -> TcGblEnv -> IO Dependencies
+mkDependencies iuid pluginModules
+ (TcGblEnv{ tcg_mod = mod,
tcg_imports = imports,
tcg_th_used = th_var
- }
+ })
= do
-- Template Haskell used?
+ let (mns, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]
+ plugin_dep_mods = map (,False) mns
+ plugin_dep_pkgs = filter (/= iuid) (map (toInstalledUnitId . moduleUnitId) ms)
th_used <- readIORef th_var
let dep_mods = modDepsElts (delFromUFM (imp_dep_mods imports)
(moduleName mod))
+ ++ plugin_dep_mods
-- M.hi-boot can be in the imp_dep_mods, but we must remove
-- it before recording the modules on which this one depends!
-- (We want to retain M.hi-boot in imp_dep_mods so that
@@ -71,8 +78,10 @@ mkDependencies
-- We must also remove self-references from imp_orphs. See
-- Note [Module self-dependency]
- pkgs | th_used = Set.insert (toInstalledUnitId thUnitId) (imp_dep_pkgs imports)
- | otherwise = imp_dep_pkgs imports
+ raw_pkgs = foldr Set.insert (imp_dep_pkgs imports) plugin_dep_pkgs
+
+ pkgs | th_used = Set.insert (toInstalledUnitId thUnitId) raw_pkgs
+ | otherwise = raw_pkgs
-- Set the packages required to be Safe according to Safe Haskell.
-- See Note [RnNames . Tracking Trust Transitively]
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 8f0e958b483c823427d472f312a814f2d6a4f2cd..0845208a3264450bfc3c6b1becdc83c91267ddb7 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -1073,6 +1073,7 @@ pprModIface iface
, nest 2 (text "flag hash:" <+> ppr (mi_flag_hash iface))
, nest 2 (text "opt_hash:" <+> ppr (mi_opt_hash iface))
, nest 2 (text "hpc_hash:" <+> ppr (mi_hpc_hash iface))
+ , nest 2 (text "plugin_hash:" <+> ppr (mi_plugin_hash iface))
, nest 2 (text "sig of:" <+> ppr (mi_sig_of iface))
, nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
, nest 2 (text "where")
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index bb19a9ef13edfb52e84d1a61718b2a0325103ac2..3375abd6e5ed77bae2c1a15546a7d0bb91d62457 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -118,6 +118,12 @@ import Data.Ord
import Data.IORef
import System.Directory
import System.FilePath
+import Plugins ( PluginRecompile(..), Plugin(..), LoadedPlugin(..))
+#if __GLASGOW_HASKELL__ < 840
+--Qualified import so we can define a Semigroup instance
+-- but it doesn't clash with Outputable.<>
+import qualified Data.Semigroup
+#endif
{-
************************************************************************
@@ -177,7 +183,11 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
}
= do
let used_names = mkUsedNames tc_result
- deps <- mkDependencies tc_result
+ let pluginModules =
+ map lpModule (plugins (hsc_dflags hsc_env))
+ deps <- mkDependencies
+ (thisInstalledUnitId (hsc_dflags hsc_env))
+ pluginModules tc_result
let hpc_info = emptyHpcInfo other_hpc_info
used_th <- readIORef tc_splice_used
dep_files <- (readIORef dependent_files)
@@ -196,6 +206,7 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
(imp_trust_own_pkg imports) safe_mode usages mod_details
+
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> HscSource
-> Bool -> Dependencies -> GlobalRdrEnv
-> NameEnv FixItem -> Warnings -> HpcInfo
@@ -283,6 +294,7 @@ mkIface_ hsc_env maybe_old_fingerprint
mi_opt_hash = fingerprint0,
mi_hpc_hash = fingerprint0,
mi_exp_hash = fingerprint0,
+ mi_plugin_hash = fingerprint0,
mi_used_th = used_th,
mi_orphan_hash = fingerprint0,
mi_orphan = False, -- Always set by addFingerprints, but
@@ -667,6 +679,8 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
hpc_hash <- fingerprintHpcFlags dflags putNameLiterally
+ plugin_hash <- fingerprintPlugins hsc_env
+
-- the ABI hash depends on:
-- - decls
-- - export list
@@ -704,6 +718,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
mi_flag_hash = flag_hash,
mi_opt_hash = opt_hash,
mi_hpc_hash = hpc_hash,
+ mi_plugin_hash = plugin_hash,
mi_orphan = not ( all ifRuleAuto orph_rules
-- See Note [Orphans and auto-generated rules]
&& null orph_insts
@@ -1093,6 +1108,16 @@ data RecompileRequired
-- to force recompilation; the String says what (one-line summary)
deriving Eq
+instance Semigroup RecompileRequired where
+ UpToDate <> r = r
+ mc <> _ = mc
+
+instance Monoid RecompileRequired where
+ mempty = UpToDate
+#if __GLASGOW_HASKELL__ < 840
+ mappend = (Data.Semigroup.<>)
+#endif
+
recompileRequired :: RecompileRequired -> Bool
recompileRequired UpToDate = False
recompileRequired _ = True
@@ -1219,6 +1244,9 @@ checkVersions hsc_env mod_summary iface
; if recompileRequired recomp then return (recomp, Nothing) else do {
; recomp <- checkDependencies hsc_env mod_summary iface
; if recompileRequired recomp then return (recomp, Just iface) else do {
+ ; recomp <- checkPlugins hsc_env iface
+ ; if recompileRequired recomp then return (recomp, Nothing) else do {
+
-- Source code unchanged and no errors yet... carry on
--
@@ -1236,13 +1264,51 @@ checkVersions hsc_env mod_summary iface
; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
; return (recomp, Just iface)
- }}}}}}}}
+ }}}}}}}}}
where
this_pkg = thisPackage (hsc_dflags hsc_env)
-- This is a bit of a hack really
mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
mod_deps = mkModDeps (dep_mods (mi_deps iface))
+-- | Check if any plugins are requesting recompilation
+checkPlugins :: HscEnv -> ModIface -> IfG RecompileRequired
+checkPlugins hsc iface = liftIO $ do
+ -- [(ModuleName, Plugin, [Opts])]
+ let old_fingerprint = mi_plugin_hash iface
+ loaded_plugins = plugins (hsc_dflags hsc)
+ res <- mconcat <$> mapM checkPlugin loaded_plugins
+ return (pluginRecompileToRecompileRequired old_fingerprint res)
+
+fingerprintPlugins :: HscEnv -> IO Fingerprint
+fingerprintPlugins hsc_env = do
+ fingerprintPlugins' (plugins (hsc_dflags hsc_env))
+
+fingerprintPlugins' :: [LoadedPlugin] -> IO Fingerprint
+fingerprintPlugins' plugins = do
+ res <- mconcat <$> mapM checkPlugin plugins
+ return $ case res of
+ NoForceRecompile -> fingerprintString "NoForceRecompile"
+ ForceRecompile -> fingerprintString "ForceRecompile"
+ -- is the chance of collision worth worrying about?
+ -- An alternative is to fingerprintFingerprints [fingerprintString
+ -- "maybeRecompile", fp]
+ (MaybeRecompile fp) -> fp
+
+
+
+checkPlugin :: LoadedPlugin -> IO PluginRecompile
+checkPlugin (LoadedPlugin plugin _ opts) = pluginRecompile plugin opts
+
+pluginRecompileToRecompileRequired :: Fingerprint -> PluginRecompile -> RecompileRequired
+pluginRecompileToRecompileRequired old_fp pr =
+ case pr of
+ NoForceRecompile -> UpToDate
+ ForceRecompile -> RecompBecause "Plugin forced recompilation"
+ MaybeRecompile fp -> if fp == old_fp then UpToDate
+ else RecompBecause "Plugin fingerprint changed"
+
+
-- | Check if an hsig file needs recompilation because its
-- implementing module has changed.
checkHsig :: ModSummary -> ModIface -> IfG RecompileRequired
diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index 90a099f9a700b37f80d5b771428f3a470ca3178f..21fe359d3cb98fbc34a2f38d4d42cc2aacd095e8 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -105,17 +105,17 @@ loadPlugins hsc_env
dflags = hsc_dflags hsc_env
to_load = pluginModNames dflags
- attachOptions mod_nm plug = LoadedPlugin plug mod_nm (reverse options)
+ attachOptions mod_nm (plug, mod) = LoadedPlugin plug mod (reverse options)
where
options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
, opt_mod_nm == mod_nm ]
-
loadPlugin = loadPlugin' (mkVarOcc "plugin") pluginTyConName hsc_env
+
loadFrontendPlugin :: HscEnv -> ModuleName -> IO FrontendPlugin
loadFrontendPlugin hsc_env mod_name = do
checkExternalInterpreter hsc_env
- loadPlugin' (mkVarOcc "frontendPlugin") frontendPluginTyConName
+ fst <$> loadPlugin' (mkVarOcc "frontendPlugin") frontendPluginTyConName
hsc_env mod_name
-- #14335
@@ -127,7 +127,7 @@ checkExternalInterpreter hsc_env =
where
dflags = hsc_dflags hsc_env
-loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO a
+loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, Module)
loadPlugin' occ_name plugin_name hsc_env mod_name
= do { let plugin_rdr_name = mkRdrQual mod_name occ_name
dflags = hsc_dflags hsc_env
@@ -139,7 +139,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
[ text "The module", ppr mod_name
, text "did not export the plugin name"
, ppr plugin_rdr_name ]) ;
- Just name ->
+ Just (name, mod) ->
do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name
; mb_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
@@ -149,7 +149,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
[ text "The value", ppr name
, text "did not have the type"
, ppr pluginTyConName, text "as required"])
- Just plugin -> return plugin } } }
+ Just plugin -> return (plugin, mod) } } }
-- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used
@@ -256,7 +256,9 @@ lessUnsafeCoerce dflags context what = do
-- loaded very partially: just enough that it can be used, without its
-- rules and instances affecting (and being linked from!) the module
-- being compiled. This was introduced by 57d6798.
-lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName -> IO (Maybe Name)
+--
+-- Need the module as well to record information in the interface file
+lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName -> IO (Maybe (Name, Module))
lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
-- First find the package the module resides in by searching exposed packages and home modules
found_module <- findPluginModule hsc_env mod_name
@@ -274,7 +276,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
imp_spec = ImpSpec decl_spec ImpAll
env = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) (mi_exports iface))
case lookupGRE_RdrName rdr_name env of
- [gre] -> return (Just (gre_name gre))
+ [gre] -> return (Just (gre_name gre, mi_module iface))
[] -> return Nothing
_ -> panic "lookupRdrNameInModule"
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index d62b5929d7d66f2563ca5783c220d60e96749d76..e17e2794b433d7deddf9958c83818ba83d98e25a 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -861,6 +861,7 @@ data ModIface
-- excluding optimisation flags
mi_opt_hash :: !Fingerprint, -- ^ Hash of optimisation flags
mi_hpc_hash :: !Fingerprint, -- ^ Hash of hpc flags
+ mi_plugin_hash :: !Fingerprint, -- ^ Hash of plugins
mi_orphan :: !WhetherHasOrphans, -- ^ Whether this module has orphans
mi_finsts :: !WhetherHasFamInst,
@@ -1023,6 +1024,7 @@ instance Binary ModIface where
mi_flag_hash = flag_hash,
mi_opt_hash = opt_hash,
mi_hpc_hash = hpc_hash,
+ mi_plugin_hash = plugin_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_deps = deps,
@@ -1051,6 +1053,7 @@ instance Binary ModIface where
put_ bh flag_hash
put_ bh opt_hash
put_ bh hpc_hash
+ put_ bh plugin_hash
put_ bh orphan
put_ bh hasFamInsts
lazyPut bh deps
@@ -1081,6 +1084,7 @@ instance Binary ModIface where
flag_hash <- get bh
opt_hash <- get bh
hpc_hash <- get bh
+ plugin_hash <- get bh
orphan <- get bh
hasFamInsts <- get bh
deps <- lazyGet bh
@@ -1110,6 +1114,7 @@ instance Binary ModIface where
mi_flag_hash = flag_hash,
mi_opt_hash = opt_hash,
mi_hpc_hash = hpc_hash,
+ mi_plugin_hash = plugin_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_deps = deps,
@@ -1149,6 +1154,7 @@ emptyModIface mod
mi_flag_hash = fingerprint0,
mi_opt_hash = fingerprint0,
mi_hpc_hash = fingerprint0,
+ mi_plugin_hash = fingerprint0,
mi_orphan = False,
mi_finsts = False,
mi_hsc_src = HsSrcFile,
diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs
index cd391a3c7b386422b3e9cb6b78bf1e4eb65111ce..85c5d07882627166a11eea0a256798b75b5cfba2 100644
--- a/compiler/main/Plugins.hs
+++ b/compiler/main/Plugins.hs
@@ -1,18 +1,30 @@
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP #-}
module Plugins (
FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction,
- Plugin(..), CommandLineOption, LoadedPlugin(..),
+ Plugin(..), CommandLineOption, LoadedPlugin(..), lpModuleName,
defaultPlugin, withPlugins, withPlugins_
+ , PluginRecompile(..)
+ , purePlugin, impurePlugin, flagRecompile
) where
import GhcPrelude
import CoreMonad ( CoreToDo, CoreM )
-import TcRnTypes ( TcPlugin)
+import qualified TcRnTypes (TcPlugin)
import DynFlags
import GhcMonad
import DriverPhases
-import Module ( ModuleName )
+import Module ( ModuleName, Module(moduleName))
+import Fingerprint
+import Data.List
+import Outputable (Outputable(..), text, (<+>))
+
+#if __GLASGOW_HASKELL__ < 840
+--Qualified import so we can define a Semigroup instance
+-- but it doesn't clash with Outputable.<>
+import qualified Data.Semigroup
+#endif
import Control.Monad
@@ -28,32 +40,70 @@ type CommandLineOption = String
-- Nonetheless, this API is preliminary and highly likely to change in
-- the future.
data Plugin = Plugin {
- installCoreToDos :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
+ installCoreToDos :: CorePlugin
-- ^ Modify the Core pipeline that will be used for compilation.
-- This is called as the Core pipeline is built for every module
-- being compiled, and plugins get the opportunity to modify the
-- pipeline in a nondeterministic order.
- , tcPlugin :: [CommandLineOption] -> Maybe TcPlugin
+ , tcPlugin :: TcPlugin
-- ^ An optional typechecker plugin, which may modify the
-- behaviour of the constraint solver.
+ , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
+ -- ^ Specify how the plugin should affect recompilation.
}
-- | A plugin with its arguments. The result of loading the plugin.
data LoadedPlugin = LoadedPlugin {
lpPlugin :: Plugin
-- ^ the actual callable plugin
- , lpModuleName :: ModuleName
- -- ^ the qualified name of the module containing the plugin
+ , lpModule :: Module
+ -- ^ The module the plugin is defined in
, lpArguments :: [CommandLineOption]
-- ^ command line arguments for the plugin
}
+lpModuleName :: LoadedPlugin -> ModuleName
+lpModuleName = moduleName . lpModule
+
+
+data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint
+
+instance Outputable PluginRecompile where
+ ppr ForceRecompile = text "ForceRecompile"
+ ppr NoForceRecompile = text "NoForceRecompile"
+ ppr (MaybeRecompile fp) = text "MaybeRecompile" <+> ppr fp
+
+instance Semigroup PluginRecompile where
+ ForceRecompile <> _ = ForceRecompile
+ NoForceRecompile <> r = r
+ MaybeRecompile fp <> NoForceRecompile = MaybeRecompile fp
+ MaybeRecompile fp <> MaybeRecompile fp' = MaybeRecompile (fingerprintFingerprints [fp, fp'])
+ MaybeRecompile _fp <> ForceRecompile = ForceRecompile
+
+instance Monoid PluginRecompile where
+ mempty = NoForceRecompile
+#if __GLASGOW_HASKELL__ < 840
+ mappend = (Data.Semigroup.<>)
+#endif
+
+type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
+type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin
+
+purePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile
+purePlugin _args = return NoForceRecompile
+
+impurePlugin _args = return ForceRecompile
+
+flagRecompile =
+ return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort
+
-- | Default plugin: does nothing at all! For compatibility reasons
-- you should base all your plugin definitions on this default value.
defaultPlugin :: Plugin
defaultPlugin = Plugin {
installCoreToDos = const return
, tcPlugin = const Nothing
+ , pluginRecompile = impurePlugin
}
type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a
diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs
index a9be6c1f50072a6b7b0a40d7624ab6e4bd03e705..e5b449b51628efcb39edb0b5531f9c203df8d89c 100644
--- a/compiler/simplCore/CoreMonad.hs
+++ b/compiler/simplCore/CoreMonad.hs
@@ -14,7 +14,7 @@ module CoreMonad (
pprPassDetails,
-- * Plugins
- PluginPass, bindsOnlyPass,
+ CorePluginPass, bindsOnlyPass,
-- * Counting
SimplCount, doSimplTick, doFreeSimplTick, simplCountN,
@@ -108,7 +108,7 @@ data CoreToDo -- These are diff core-to-core passes,
= CoreDoSimplify -- The core-to-core simplifier.
Int -- Max iterations
SimplMode
- | CoreDoPluginPass String PluginPass
+ | CoreDoPluginPass String CorePluginPass
| CoreDoFloatInwards
| CoreDoFloatOutwards FloatOutSwitches
| CoreLiberateCase
@@ -239,7 +239,7 @@ runMaybe Nothing _ = CoreDoNothing
-}
-- | A description of the plugin pass itself
-type PluginPass = ModGuts -> CoreM ModGuts
+type CorePluginPass = ModGuts -> CoreM ModGuts
bindsOnlyPass :: (CoreProgram -> CoreM CoreProgram) -> ModGuts -> CoreM ModGuts
bindsOnlyPass pass guts
diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs
index fe6d44625a24714b89ac4f4936b8263cc60ddd78..70a13cc110caa6f85d6ef05f704f3a780ed97678 100644
--- a/compiler/simplCore/SimplCore.hs
+++ b/compiler/simplCore/SimplCore.hs
@@ -52,7 +52,7 @@ import Vectorise ( vectorise )
import SrcLoc
import Util
import Module
-import Plugins ( withPlugins,installCoreToDos )
+import Plugins ( withPlugins, installCoreToDos )
import DynamicLoading -- ( initializePlugins )
import Maybes
@@ -86,7 +86,8 @@ core2core hsc_env guts@(ModGuts { mg_module = mod
; dflags' <- liftIO $ initializePlugins hsc_env'
(hsc_dflags hsc_env')
; all_passes <- withPlugins dflags'
- installCoreToDos builtin_passes
+ installCoreToDos
+ builtin_passes
; runCorePasses all_passes guts }
; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst
index 12043a0542885fae829e5f3a037753ca1157512b..d8eaab9419ca6d91546e6e4656c056f7585bb215 100644
--- a/docs/users_guide/extending_ghc.rst
+++ b/docs/users_guide/extending_ghc.rst
@@ -600,6 +600,63 @@ 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.
+.. _plugin_recompilation:
+
+Controlling Recompilation
+~~~~~~~~~~~~~~~~~~~~~~~~~
+
+By default, modules compiled with plugins are always recompiled even if the source file is
+unchanged. This most conservative option is taken due to the ability of plugins
+to perform arbitrary IO actions. In order to control the recompilation behaviour
+you can modify the ``pluginRecompile`` field in ``Plugin``. ::
+
+ plugin :: Plugin
+ plugin = defaultPlugin {
+ installCoreToDos = install,
+ pluginRecompile = purePlugin
+ }
+
+By inspecting the example ``plugin`` defined above, we can see that it is pure. This
+means that if the two modules have the same fingerprint then the plugin
+will always return the same result. Declaring a plugin as pure means that
+the plugin will never cause a module to be recompiled.
+
+In general, the ``pluginRecompile`` field has the following type::
+
+ pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
+
+The ``PluginRecompile`` data type is an enumeration determining how the plugin
+should affect recompilation. ::
+ data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint
+
+A plugin which declares itself impure using ``ForceRecompile`` will always
+trigger a recompilation of the current module. ``NoForceRecompile`` is used
+for "pure" plugins which don't need to be rerun unless a module would ordinarily
+be recompiled. ``MaybeRecompile`` computes a ``Fingerprint`` and if this ``Fingerprint``
+is different to a previously computed ``Fingerprint`` for the plugin, then
+we recompile the module.
+
+As such, ``purePlugin`` is defined as a function which always returns ``NoForceRecompile``. ::
+
+ purePlugin :: [CommandLineOption] -> IO PluginRecompile
+ purePlugin _ = return NoForceRecompile
+
+Users can use the same functions that GHC uses internally to compute fingerprints.
+The `GHC.Fingerprint
+<https://hackage.haskell.org/package/base-4.10.1.0/docs/GHC-Fingerprint.html>`_ module provides useful functions for constructing fingerprints. For example, combining
+together ``fingerprintFingerprints`` and ``fingerprintString`` provides an easy to
+to naively fingerprint the arguments to a plugin. ::
+
+ pluginFlagRecompile :: [CommandLineOption] -> IO PluginRecompile
+ pluginFlagRecompile =
+ return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort
+
+``defaultPlugin`` defines ``pluginRecompile`` to be ``impurePlugin`` which
+is the most conservative and backwards compatible option. ::
+
+ impurePlugin :: [CommandLineOption] -> IO PluginRecompile
+ impurePlugin _ = return ForceRecompile
+
.. _frontend_plugins:
Frontend plugins
diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile
index 1ff8d40e8b688630797700b2b53c9af7d9470124..3e983fded6dbf1ff02edd070e265366cbd205975 100644
--- a/testsuite/tests/plugins/Makefile
+++ b/testsuite/tests/plugins/Makefile
@@ -50,5 +50,30 @@ T11244:
.PHONY: T12567a
T12567a:
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567a.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 1>&2
- "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567a.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 2>&1 | grep "T12567a.hs, T12567a.o" 1>&2
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567a.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 1>&2
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567b.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 1>&2
+
+.PHONY: T14335
+T14335:
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -fexternal-interpreter --make -v0 plugins01.hs -package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin -fplugin-opt Simple.Plugin:Irrelevant_Option -hide-all-plugin-packages -plugin-package simple-plugin
+ ./plugins01
+
+# Shouldn't recompile the module
+.PHONY: plugin-recomp-pure
+plugin-recomp-pure:
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin
+
+# Should recompile the module
+.PHONY: plugin-recomp-impure
+plugin-recomp-impure:
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin ImpurePlugin
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin ImpurePlugin
+
+# Should not recompile the module the first time but should the second time
+.PHONY: plugin-recomp-flags
+plugin-recomp-flags:
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:0
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:0
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:1
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:1
diff --git a/testsuite/tests/plugins/T12567a.stderr b/testsuite/tests/plugins/T12567a.stderr
index aee35e3528467702d35e5890d6714b0a6649454b..efc75384e610ed5b1c8b1eb5220ddafbef15baa0 100644
--- a/testsuite/tests/plugins/T12567a.stderr
+++ b/testsuite/tests/plugins/T12567a.stderr
@@ -2,9 +2,4 @@
Simple Plugin Passes Queried
Got options:
Simple Plugin Pass Run
-[1 of 1] Compiling T12567a ( T12567a.hs, T12567a.o ) [Simple.Plugin changed]
-[1 of 2] Compiling T12567a ( T12567a.hs, T12567a.o ) [Simple.Plugin changed]
-Simple Plugin Passes Queried
-Got options:
-Simple Plugin Pass Run
[2 of 2] Compiling T12567b ( T12567b.hs, T12567b.o )
diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T
index 57866371b305e58bddeb4c270454d89cf55a7a27..94d0e2d053d12678de718099b04b2b556725633f 100644
--- a/testsuite/tests/plugins/all.T
+++ b/testsuite/tests/plugins/all.T
@@ -74,3 +74,21 @@ test('T14335',
compile_fail,
['-package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin \
-fexternal-interpreter -package simple-plugin ' + config.plugin_way_flags])
+
+test('plugin-recomp-pure',
+ [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']),
+ pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}')
+ ],
+ run_command, ['$MAKE -s --no-print-directory plugin-recomp-pure'])
+
+test('plugin-recomp-impure',
+ [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']),
+ pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}')
+ ],
+ run_command, ['$MAKE -s --no-print-directory plugin-recomp-impure'])
+
+test('plugin-recomp-flags',
+ [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']),
+ pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}')
+ ],
+ run_command, ['$MAKE -s --no-print-directory plugin-recomp-flags'])
diff --git a/testsuite/tests/plugins/plugin-recomp-flags.stderr b/testsuite/tests/plugins/plugin-recomp-flags.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..a7f0da692a6d81e6679ecbe98a1ad89014054d9e
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp-flags.stderr
@@ -0,0 +1,6 @@
+Simple Plugin Passes Queried
+Got options: 0
+Simple Plugin Pass Run
+Simple Plugin Passes Queried
+Got options: 1
+Simple Plugin Pass Run
diff --git a/testsuite/tests/plugins/plugin-recomp-flags.stdout b/testsuite/tests/plugins/plugin-recomp-flags.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..342fa3e0f8b06641a8a4c444fecd32003d65e216
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp-flags.stdout
@@ -0,0 +1,4 @@
+[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o )
+Linking plugin-recomp-test ...
+[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o ) [Plugin fingerprint changed]
+Linking plugin-recomp-test ...
diff --git a/testsuite/tests/plugins/plugin-recomp-impure.stderr b/testsuite/tests/plugins/plugin-recomp-impure.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..a1edc3bda551102075661b447f34490cbaaea61f
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp-impure.stderr
@@ -0,0 +1,6 @@
+Simple Plugin Passes Queried
+Got options:
+Simple Plugin Pass Run
+Simple Plugin Passes Queried
+Got options:
+Simple Plugin Pass Run
diff --git a/testsuite/tests/plugins/plugin-recomp-impure.stdout b/testsuite/tests/plugins/plugin-recomp-impure.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..d282cfea8f6eb727c5fbdb23fd251fb0b05c50de
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp-impure.stdout
@@ -0,0 +1,4 @@
+[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o )
+Linking plugin-recomp-test ...
+[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o ) [Plugin forced recompilation]
+Linking plugin-recomp-test ...
diff --git a/testsuite/tests/plugins/plugin-recomp-pure.stderr b/testsuite/tests/plugins/plugin-recomp-pure.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..84e15cfa914e2211bcd2e26364a39fd5ce8c5193
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp-pure.stderr
@@ -0,0 +1,3 @@
+Simple Plugin Passes Queried
+Got options:
+Simple Plugin Pass Run
diff --git a/testsuite/tests/plugins/plugin-recomp-pure.stdout b/testsuite/tests/plugins/plugin-recomp-pure.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..a6828318a05afedc0f60f3b97b7ee22d945541aa
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp-pure.stdout
@@ -0,0 +1,2 @@
+[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o )
+Linking plugin-recomp-test ...
diff --git a/testsuite/tests/plugins/plugin-recomp-test.hs b/testsuite/tests/plugins/plugin-recomp-test.hs
new file mode 100644
index 0000000000000000000000000000000000000000..2cc84a9eaca0517417212766609ed469a16d6682
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp-test.hs
@@ -0,0 +1,8 @@
+-- Intended to test that the plugins have basic functionality --
+-- * Can modify the program
+-- * Get to see command line options
+module Main where
+
+main = do
+ putStrLn "Program Started"
+ putStrLn "Program Ended"
diff --git a/testsuite/tests/plugins/plugin-recomp/Common.hs b/testsuite/tests/plugins/plugin-recomp/Common.hs
new file mode 100644
index 0000000000000000000000000000000000000000..dc49025c60b2e77f980fa8d43cbb8808bd64a5dd
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp/Common.hs
@@ -0,0 +1,17 @@
+module Common where
+
+import GhcPlugins
+
+install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
+install options todos = do
+ putMsgS $ "Simple Plugin Passes Queried"
+ putMsgS $ "Got options: " ++ unwords options
+
+ -- Create some actual passes to continue the test.
+ return $ CoreDoPluginPass "Main pass" mainPass
+ : todos
+
+mainPass :: ModGuts -> CoreM ModGuts
+mainPass guts = do
+ putMsgS "Simple Plugin Pass Run"
+ return guts
diff --git a/testsuite/tests/plugins/plugin-recomp/FingerprintPlugin.hs b/testsuite/tests/plugins/plugin-recomp/FingerprintPlugin.hs
new file mode 100644
index 0000000000000000000000000000000000000000..584962470adab769b58e8de89cf6ecc944a4ee4d
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp/FingerprintPlugin.hs
@@ -0,0 +1,10 @@
+module FingerprintPlugin where
+
+import GhcPlugins
+import Common
+
+plugin :: Plugin
+plugin = defaultPlugin {
+ installCoreToDos = install,
+ pluginRecompile = flagRecompile
+ }
diff --git a/testsuite/tests/plugins/plugin-recomp/ImpurePlugin.hs b/testsuite/tests/plugins/plugin-recomp/ImpurePlugin.hs
new file mode 100644
index 0000000000000000000000000000000000000000..0ccb626a159bff179d63c2219f2dcbcc9a11894c
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp/ImpurePlugin.hs
@@ -0,0 +1,10 @@
+module ImpurePlugin where
+
+import GhcPlugins
+import Common
+
+plugin :: Plugin
+plugin = defaultPlugin {
+ installCoreToDos = install,
+ pluginRecompile = impurePlugin
+ }
diff --git a/testsuite/tests/plugins/plugin-recomp/LICENSE b/testsuite/tests/plugins/plugin-recomp/LICENSE
new file mode 100644
index 0000000000000000000000000000000000000000..6297f71b3fdb05b1f3fe09b4c325704ac06d26ce
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp/LICENSE
@@ -0,0 +1,10 @@
+Copyright (c) 2008, Max Bolingbroke
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+ * Neither the name of Max Bolingbroke nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/testsuite/tests/plugins/plugin-recomp/Makefile b/testsuite/tests/plugins/plugin-recomp/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..ae5c24e87f9534eb81e8069334689a389393c8f8
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp/Makefile
@@ -0,0 +1,20 @@
+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/plugin-recomp/PurePlugin.hs b/testsuite/tests/plugins/plugin-recomp/PurePlugin.hs
new file mode 100644
index 0000000000000000000000000000000000000000..c106aa3400737ea37774b9574cb6a22c17391e54
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp/PurePlugin.hs
@@ -0,0 +1,10 @@
+module PurePlugin where
+
+import GhcPlugins
+import Common
+
+plugin :: Plugin
+plugin = defaultPlugin {
+ installCoreToDos = install,
+ pluginRecompile = purePlugin
+ }
diff --git a/testsuite/tests/plugins/plugin-recomp/Setup.hs b/testsuite/tests/plugins/plugin-recomp/Setup.hs
new file mode 100644
index 0000000000000000000000000000000000000000..e8ef27dbba9992f80d9271a60892aadc63c9ef36
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/testsuite/tests/plugins/plugin-recomp/plugin-recomp.cabal b/testsuite/tests/plugins/plugin-recomp/plugin-recomp.cabal
new file mode 100644
index 0000000000000000000000000000000000000000..dabaf72e03ed8bbc1cb92460c722277d24e45272
--- /dev/null
+++ b/testsuite/tests/plugins/plugin-recomp/plugin-recomp.cabal
@@ -0,0 +1,20 @@
+Name: plugin-recompilation
+Version: 0.1
+Synopsis: Testing plugin recompilation
+Cabal-Version: >= 1.2
+Build-Type: Simple
+License: BSD3
+License-File: LICENSE
+Author: Matthew Pickering
+Homepage: http://blog.omega-prime.co.uk
+
+Library
+ Extensions: CPP
+ Build-Depends:
+ base,
+ ghc >= 6.11
+ Exposed-Modules:
+ PurePlugin
+ ImpurePlugin
+ FingerprintPlugin
+ Common
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs
index e8c2435849749f1b1728cfc482208cfc8d6d52d6..94cb74b1515af9efec2203015c0b17a970105ae0 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs
@@ -16,14 +16,15 @@ import qualified Language.Haskell.TH as TH
plugin :: Plugin
plugin = defaultPlugin {
- installCoreToDos = install
+ installCoreToDos = install,
+ pluginRecompile = purePlugin
}
install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install options todos = do
putMsgS $ "Simple Plugin Passes Queried"
putMsgS $ "Got options: " ++ unwords options
-
+
-- Create some actual passes to continue the test.
return $ CoreDoPluginPass "Main pass" mainPass
: todos
@@ -36,7 +37,7 @@ findNameBind target (NonRec b e) = findNameBndr target b
findNameBind target (Rec bes) = mconcat (map (findNameBndr target . fst) bes)
findNameBndr :: String -> CoreBndr -> First Name
-findNameBndr target b
+findNameBndr target b
= if getOccString (varName b) == target
then First (Just (varName b))
else First Nothing