Plugin dependency information is stored separately
authorChristiaan Baaij <christiaan.baaij@gmail.com>
Wed, 1 Aug 2018 18:21:22 +0000 (14:21 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 2 Aug 2018 02:42:22 +0000 (22:42 -0400)
We need to store the used plugins so that we recompile
a module when a plugin that it uses is recompiled.

However, storing the `ModuleName`s of the plugins used by a
module in the `dep_mods` field made the rest of GHC think
that they belong in the HPT, causing at least the issues
reported in #15234

We therefor store the `ModuleName`s of the plugins in a
new field, `dep_plgins`, which is only used the the
recompilation logic.

Reviewers: mpickering, bgamari

Reviewed By: mpickering, bgamari

Subscribers: alpmestan, rwbarton, thomie, carter

GHC Trac Issues: #15234

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

(cherry picked from commit 52065e95c6df89d0048c6e3f35d6cc26ce8246f9)

compiler/deSugar/Desugar.hs
compiler/deSugar/DsUsage.hs
compiler/iface/MkIface.hs
compiler/main/DynamicLoading.hs
compiler/main/HscTypes.hs
compiler/main/Plugins.hs
testsuite/tests/plugins/Makefile
testsuite/tests/plugins/all.T
testsuite/tests/plugins/plugin-recomp-change.stderr [new file with mode: 0644]
testsuite/tests/plugins/plugin-recomp/Common.hs
testsuite/tests/plugins/plugin-recomp/Makefile

index 583bc59..c1e728b 100644 (file)
@@ -170,12 +170,13 @@ deSugar hsc_env
               pluginModules =
                 map lpModule (plugins (hsc_dflags hsc_env))
         ; deps <- mkDependencies (thisInstalledUnitId (hsc_dflags hsc_env))
-                                 pluginModules tcg_env
+                                 (map mi_module pluginModules) tcg_env
 
         ; used_th <- readIORef tc_splice_used
         ; dep_files <- readIORef dependent_files
         ; safe_mode <- finalSafeMode dflags tcg_env
-        ; usages <- mkUsageInfo hsc_env mod (imp_mods imports) used_names dep_files merged
+        ; usages <- mkUsageInfo hsc_env mod (imp_mods imports) used_names
+                      dep_files merged pluginModules
         -- id_mod /= mod when we are processing an hsig, but hsigs
         -- never desugared and compiled (there's no code!)
         -- Consequently, this should hold for any ModGuts that make
index c8a0424..45d4dcf 100644 (file)
@@ -22,12 +22,16 @@ import UniqSet
 import UniqFM
 import Fingerprint
 import Maybes
+import Packages
+import Finder
 
 import Data.List
 import Data.IORef
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import System.Directory
+import System.FilePath
 
 {- Note [Module self-dependency]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -60,13 +64,11 @@ mkDependencies iuid pluginModules
                   })
  = do
       -- Template Haskell used?
-      let (mns, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]
-          plugin_dep_mods = map (,False) mns
+      let (dep_plgins, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]
           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
@@ -92,6 +94,7 @@ mkDependencies iuid pluginModules
       return Deps { dep_mods   = dep_mods,
                     dep_pkgs   = dep_pkgs',
                     dep_orphs  = dep_orphs,
+                    dep_plgins = dep_plgins,
                     dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
                     -- sort to get into canonical order
                     -- NB. remember to use lexicographic ordering
@@ -99,11 +102,14 @@ mkDependencies iuid pluginModules
 mkUsedNames :: TcGblEnv -> NameSet
 mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
 
-mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> [(Module, Fingerprint)] -> IO [Usage]
+mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath]
+            -> [(Module, Fingerprint)] -> [ModIface] -> IO [Usage]
 mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
+  pluginModules
   = do
     eps <- hscEPS hsc_env
     hashes <- mapM getFileHash dependent_files
+    plugin_usages <- mapM (mkPluginUsage hsc_env) pluginModules
     let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
                                        dir_imp_mods used_names
         usages = mod_usages ++ [ UsageFile { usg_file_path = f
@@ -114,11 +120,100 @@ mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
                                       usg_mod_hash = hash
                                     }
                                | (mod, hash) <- merged ]
+                            ++ concat plugin_usages
     usages `seqList` return usages
     -- seq the list of Usages returned: occasionally these
     -- don't get evaluated for a while and we can end up hanging on to
     -- the entire collection of Ifaces.
 
+{- Note [Plugin dependencies]
+Modules for which plugins were used in the compilation process, should be
+recompiled whenever one of those plugins changes. But how do we know if a
+plugin changed from the previous time a module was compiled?
+
+We could try storing the fingerprints of the interface files of plugins in
+the interface file of the module. And see if there are changes between
+compilation runs. However, this is pretty much a non-option because interface
+fingerprints of plugin modules are fairly stable, unless you compile plugins
+with optimisations turned on, and give basically all binders an INLINE pragma.
+
+So instead:
+
+  * For plugins that were build locally: we store the filepath and hash of the
+    object files of the module with the `plugin` binder, and the object files of
+    modules that are dependencies of the plugin module and belong to the same
+    `UnitId` as the plugin
+  * For plugins in an external package: we store the filepath and hash of
+    the dynamic library containing the plugin module.
+
+During recompilation we then compare the hashes of those files again to see
+if anything has changed.
+
+One issue with this approach is that object files are currently (GHC 8.6.1)
+not created fully deterministicly, which could sometimes induce accidental
+recompilation of a module for which plugins were used in the compile process.
+
+One way to improve this is to either:
+
+  * Have deterministic object file creation
+  * Create and store implementation hashes, which would be based on the Core
+    of the module and the implementation hashes of its dependencies, and then
+    compare implementation hashes for recompilation. Creation of implementation
+    hashes is however potentially expensive.
+-}
+mkPluginUsage :: HscEnv -> ModIface -> IO [Usage]
+mkPluginUsage hsc_env pluginModule
+  = case lookupPluginModuleWithSuggestions dflags pNm Nothing of
+    -- The plug is from an external package, we just look up the dylib that
+    -- contains the plugin
+    LookupFound _ pkg ->
+      let searchPaths = collectLibraryPaths dflags [pkg]
+          libs        = packageHsLibs dflags pkg
+          dynlibs     = [ searchPath </> mkHsSOName platform lib
+                        | searchPath <- searchPaths
+                        , lib <- libs
+                        ]
+      in  mapM hashFile (nub dynlibs)
+    _ -> do
+      foundM <- findPluginModule hsc_env pNm
+      case foundM of
+        -- The plugin was built locally, look up the object file containing
+        -- the `plugin` binder, and all object files belong to modules that are
+        -- transitive dependencies of the plugin that belong to the same package
+        Found ml _ -> do
+          pluginObject <- hashFile  (ml_obj_file ml)
+          depObjects   <- catMaybes <$> mapM lookupObjectFile deps
+          return (nub (pluginObject : depObjects))
+        _ -> pprPanic "mkPluginUsage: no object or dylib" (ppr pNm)
+  where
+    -- plugins are shared libraries, so add WayDyn to the dflags in order to get
+    -- the correct filenames and library paths; just in case the object that is
+    -- currently being build is not going to be linked dynamically
+    dflags   = addWay' WayDyn (hsc_dflags hsc_env)
+    platform = targetPlatform dflags
+    pNm      = moduleName (mi_module pluginModule)
+    pPkg     = moduleUnitId (mi_module pluginModule)
+    deps     = map fst (dep_mods (mi_deps pluginModule))
+
+    -- loopup object file for a plugin dependencies from the same package as the
+    -- the plugin
+    lookupObjectFile nm = do
+      foundM <- findImportedModule hsc_env nm Nothing
+      case foundM of
+        Found ml m
+          | moduleUnitId m == pPkg -> Just <$> hashFile (ml_obj_file ml)
+          | otherwise              -> return Nothing
+        _ -> pprPanic "mkPluginUsage: no object for dependency"
+                      (ppr pNm <+> ppr nm)
+
+    hashFile f = do
+      fExist <- doesFileExist f
+      if fExist
+         then do
+            h <- getFileHash f
+            return (UsageFile f h)
+         else pprPanic "mkPluginUsage: file not found" (ppr pNm <+> text f)
+
 mk_mod_usage_info :: PackageIfaceTable
               -> HscEnv
               -> Module
index 8091587..8381a59 100644 (file)
@@ -192,7 +192,7 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
                 map lpModule (plugins (hsc_dflags hsc_env))
           deps <- mkDependencies
                     (thisInstalledUnitId (hsc_dflags hsc_env))
-                    pluginModules tc_result
+                    (map mi_module pluginModules) tc_result
           let hpc_info = emptyHpcInfo other_hpc_info
           used_th <- readIORef tc_splice_used
           dep_files <- (readIORef dependent_files)
@@ -203,7 +203,8 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
           -- but if you pass that in here, we'll decide it's the local
           -- module and does not need to be recorded as a dependency.
           -- See Note [Identity versus semantic module]
-          usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names dep_files merged
+          usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names
+                      dep_files merged pluginModules
 
           let (doc_hdr', doc_map, arg_map) = extractDocs tc_result
 
@@ -791,7 +792,8 @@ sortDependencies d
  = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
           dep_pkgs   = sortBy (compare `on` fst) (dep_pkgs d),
           dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
-          dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
+          dep_finsts = sortBy stableModuleCmp (dep_finsts d),
+          dep_plgins = sortBy (compare `on` moduleNameFS) (dep_plgins d) }
 
 -- | Creates cached lookup for the 'mi_anns' field of ModIface
 -- Hackily, we use "module" as the OccName for any module-level annotations
@@ -1390,6 +1392,7 @@ checkDependencies hsc_env summary iface
  = checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
   where
    prev_dep_mods = dep_mods (mi_deps iface)
+   prev_dep_plgn = dep_plgins (mi_deps iface)
    prev_dep_pkgs = dep_pkgs (mi_deps iface)
 
    this_pkg = thisPackage (hsc_dflags hsc_env)
@@ -1400,7 +1403,7 @@ checkDependencies hsc_env summary iface
      case find_res of
         Found _ mod
           | pkg == this_pkg
-           -> if moduleName mod `notElem` map fst prev_dep_mods
+           -> if moduleName mod `notElem` map fst prev_dep_mods ++ prev_dep_plgn
                  then do traceHiDiffs $
                            text "imported module " <> quotes (ppr mod) <>
                            text " not among previous dependencies"
index 21fe359..764bf2d 100644 (file)
@@ -127,7 +127,7 @@ checkExternalInterpreter hsc_env =
   where
     dflags = hsc_dflags hsc_env
 
-loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, Module)
+loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface)
 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, mod) ->
+            Just (name, mod_iface) ->
 
      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, mod) } } }
+            Just plugin -> return (plugin, mod_iface) } } }
 
 
 -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used
@@ -258,7 +258,8 @@ lessUnsafeCoerce dflags context what = do
 -- being compiled.  This was introduced by 57d6798.
 --
 -- Need the module as well to record information in the interface file
-lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName -> IO (Maybe (Name, Module))
+lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName
+                                -> IO (Maybe (Name, ModIface))
 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
@@ -276,7 +277,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, mi_module iface))
+                        [gre] -> return (Just (gre_name gre, iface))
                         []    -> return Nothing
                         _     -> panic "lookupRdrNameInModule"
 
index 0ef1487..de56172 100644 (file)
@@ -2372,6 +2372,9 @@ data Dependencies
                         -- This is used by 'checkFamInstConsistency'.  This
                         -- does NOT include us, unlike 'imp_finsts'. See Note
                         -- [The type family instance consistency story].
+
+         , dep_plgins :: [ModuleName]
+                        -- ^ All the plugins used while compiling this module.
          }
   deriving( Eq )
         -- Equality used only for old/new comparison in MkIface.addFingerprints
@@ -2382,16 +2385,18 @@ instance Binary Dependencies where
                       put_ bh (dep_pkgs deps)
                       put_ bh (dep_orphs deps)
                       put_ bh (dep_finsts deps)
+                      put_ bh (dep_plgins deps)
 
     get bh = do ms <- get bh
                 ps <- get bh
                 os <- get bh
                 fis <- get bh
+                pl <- get bh
                 return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
-                               dep_finsts = fis })
+                               dep_finsts = fis, dep_plgins = pl })
 
 noDependencies :: Dependencies
-noDependencies = Deps [] [] [] []
+noDependencies = Deps [] [] [] [] []
 
 -- | Records modules for which changes may force recompilation of this module
 -- See wiki: http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
index 0e2ab32..8ead643 100644 (file)
@@ -99,14 +99,14 @@ data Plugin = Plugin {
 data LoadedPlugin = LoadedPlugin {
     lpPlugin :: Plugin
     -- ^ the actual callable plugin
-  , lpModule :: Module
+  , lpModule :: ModIface
     -- ^ the module containing the plugin
   , lpArguments :: [CommandLineOption]
     -- ^ command line arguments for the plugin
   }
 
 lpModuleName :: LoadedPlugin -> ModuleName
-lpModuleName = moduleName . lpModule
+lpModuleName = moduleName . mi_module . lpModule
 
 
 data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint
index 6c823cc..688ac04 100644 (file)
@@ -105,3 +105,10 @@ 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: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
+
+# Should recompile the module because the plugin changed
+.PHONY: plugin-recomp-change
+plugin-recomp-change:
+       "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin
+       "$(MAKE)" -s --no-print-directory -C plugin-recomp package.plugins01 TOP=$(TOP) RUN=-DRUN2
+       "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin
index 34b1162..22aba75 100644 (file)
@@ -128,3 +128,9 @@ test('plugin-recomp-flags',
       pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}')
       ],
      run_command, ['$MAKE -s --no-print-directory plugin-recomp-flags'])
+
+test('plugin-recomp-change',
+     [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-change'])
diff --git a/testsuite/tests/plugins/plugin-recomp-change.stderr b/testsuite/tests/plugins/plugin-recomp-change.stderr
new file mode 100644 (file)
index 0000000..91747c8
--- /dev/null
@@ -0,0 +1,6 @@
+Simple Plugin Passes Queried
+Got options:
+Simple Plugin Pass Run
+Simple Plugin Passes Queried
+Got options:
+Simple Plugin Pass Run 2
index dc49025..ce4f824 100644 (file)
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Common where
 
 import GhcPlugins
@@ -13,5 +14,9 @@ install options todos = do
 
 mainPass :: ModGuts -> CoreM ModGuts
 mainPass guts = do
+#if defined(RUN2)
+    putMsgS "Simple Plugin Pass Run 2"
+#else
     putMsgS "Simple Plugin Pass Run"
+#endif
     return guts
index ae5c24e..db2df8d 100644 (file)
@@ -1,4 +1,5 @@
 TOP=../../..
+RUN=-DRUN1
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/test.mk
 
@@ -12,9 +13,9 @@ 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 configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --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