Implement "An API for deciding whether plugins should cause recompilation"

This patch implements the API proposed as pull request #108 for plugin
authors to influence the recompilation checker.

It adds a new field to a plugin which computes a `FingerPrint`. This is
recorded in interface files and if it changes then we recompile the
module. There are also helper functions such as `purePlugin` and
`impurePlugin` for constructing plugins which have simple recompilation
semantics but in general, an author can compute a hash as they wish.

Fixes #12567 and #7414

https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/002
2-plugin-recompilation.rst

Reviewers: bgamari, ggreif

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #7414, #12567

Differential Revision: https://phabricator.haskell.org/D4366

1 files changed, 68 insertions, 2 deletions

diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index bb19a9ef13..3375abd6e5 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