Improve recompilation avoidance in the presence of TH

The old recompilation avoidance scheme performs quite poorly when code
generation is needed. We end up needed to recompile modules basically
any time anything in their transitive dependency closure changes.

Most versions of GHC we currently support don't have a working implementation of
code unloading for object code, and no version of GHC supports this on certain
platforms like Windows. This makes it completely infeasible for interactive
use, as symbols from previous compiles will shadow over all future compiles.

This means that we need to use bytecode when generating code for Template
Haskell. Unfortunately, we can't serialize bytecode, so we will always need
to recompile when the IDE starts. However, we can put in place a much tighter
recompilation avoidance scheme for subsequent compiles:

1. If the source file changes, then we always need to recompile
   a. For files of interest, we will get explicit `textDocument/change`
      events that will let us invalidate our build products
   b. For files we read from disk, we can detect source file changes
      by comparing the mtime of the source file with the build
      product (.hi/.o) file on disk.
2. If GHC's recompilation avoidance scheme based on interface file hashes
   says that we need to recompile, the we need to recompile.
3. If the file in question requires code generation then, we need to recompile
   if we don't have the appropriate kind of build products.
   a. If we already have the build products in memory, and the conditions
      1 and 2 hold, then we don't need to recompile
   b. If we are generating object code, then we can also search for it on
      disk and ensure it is up to date.
   Notably, we did _not_ previously re-use old bytecode from memory when
   hls-graph/shake decided to rebuild the 'HiFileResult' for some reason
4. If the file in question used Template Haskell on the previous compile,
   then we need to recompile if any `Linkable` in its transitive closure
   changed.
   This sounds bad, but it is possible to make some improvements.
   In particular, we only need to recompile if any of the `Linkable`s
   actually used during the previous compile change.

   How can we tell if a `Linkable` was actually used while running some
   TH?

   GHC provides a `hscCompileCoreExprHook` which lets us intercept bytecode
   as it is being compiled and linked. We can inspect the bytecode to see
   which `Linkable` dependencies it requires, and record this for use in
   recompilation checking.
   We record all the home package modules of the free names that occur in the
   bytecode. The `Linkable`s required are then the transitive closure of these
   modules in the home-package environment. This is the same scheme as used by
   GHC to find the correct things to link in before running bytecode.

   This works fine if we already have previous build products in memory, but
   what if we are reading an interface from disk? Well, we can smuggle in the
   necessary information (linkable `Module`s required as well as the time they
   were generated) using `Annotation`s, which provide a somewhat general purpose
   way to serialise arbitrary information along with interface files.

   Then when deciding whether to recompile, we need to check that the versions of
   the linkables used during a previous compile match whatever is currently in the
   HPT.

The changes that were made to `ghcide` in order to implement this scheme include:

1. Add `RuleWithOldValue` to define Rules which have access to the previous value.
   This is the magic bit that lets us re-use bytecode from previous compiles
2. `IsHiFileStable` rule was removed as we don't need it with this scheme in place.
3. Everything in the store is properly versioned with a `FileVersion`, not just
   FOIs.
4. The VFSHandle type was removed. Instead we now take a VFS snapshot on every
   restart, and use this snapshot for all the `Rules` in that build. This ensures
   that Rules see a consistent version of the VFS and also makes
   The `setVirtualFileContents` function was removed since it was not being used anywhere.
   If needed in the future, we can easily just modify the VFS using functions from
   `lsp`.
5. Fix a bug with the `DependencyInformation` calculation, were modules at the top
   of the hierarchy (no incoming edges) weren't being recorded properly

A possible future improvement is to use object-code on the first load (so we
have a warm cache) and use bytecode for subsequent compiles.

Author: wz1000

Diff for: ghcide/src/Development/IDE.hs

@@ -17,8 +17,7 @@ import           Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (.
                                                              isWorkspaceFile)
 import           Development.IDE.Core.OfInterest       as X (getFilesOfInterestUntracked)
 import           Development.IDE.Core.RuleTypes        as X
-import           Development.IDE.Core.Rules            as X (IsHiFileStable (..),
-                                                             getClientConfigAction,
+import           Development.IDE.Core.Rules            as X (getClientConfigAction,
                                                              getParsedModule)
 import           Development.IDE.Core.Service          as X (runAction)
 import           Development.IDE.Core.Shake            as X (FastResult (..),

Diff for: ghcide/src/Development/IDE/Core/Compile.hs

@@ -138,6 +138,9 @@ data TcModuleResult = TcModuleResult
     -- ^ Typechecked splice information
     , tmrDeferedError    :: !Bool
     -- ^ Did we defer any type errors for this module?
+    , tmrRuntimeModules  :: !(ModuleEnv UTCTime)
+        -- ^ Which modules did we need at runtime while compiling this file?
+        -- Used for recompilation checking in the presence of TH
     }
 instance Show TcModuleResult where
     show = show . pm_mod_summary . tmrParsed
@@ -158,13 +161,15 @@ data HiFileResult = HiFileResult
     -- ^ Fingerprint for the ModIface
     , hirLinkableFp :: ByteString
     -- ^ Fingerprint for the Linkable
+    , hirRuntimeModules :: !(ModuleEnv UTCTime)
+    -- ^ same as tmrRuntimeModules
     }
 
 hiFileFingerPrint :: HiFileResult -> ByteString
 hiFileFingerPrint HiFileResult{..} = hirIfaceFp <> hirLinkableFp
 
-mkHiFileResult :: ModSummary -> HomeModInfo -> HiFileResult
-mkHiFileResult hirModSummary hirHomeMod = HiFileResult{..}
+mkHiFileResult :: ModSummary -> HomeModInfo -> ModuleEnv UTCTime -> HiFileResult
+mkHiFileResult hirModSummary hirHomeMod hirRuntimeModules = HiFileResult{..}
   where
     hirIfaceFp = fingerprintToBS . getModuleHash . hm_iface $ hirHomeMod -- will always be two bytes
     hirLinkableFp = case hm_linkable hirHomeMod of

Diff for: ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -30,7 +30,6 @@ module Development.IDE.Core.Rules(
     usePropertyAction,
     -- * Rules
     CompiledLinkables(..),
-    IsHiFileStable(..),
     getParsedModuleRule,
     getParsedModuleWithCommentsRule,
     getLocatedImportsRule,
@@ -42,7 +41,6 @@ module Development.IDE.Core.Rules(
     getModIfaceFromDiskRule,
     getModIfaceRule,
     getModSummaryRule,
-    isHiFileStableRule,
     getModuleGraphRule,
     knownFilesRule,
     getClientSettingsRule,
@@ -659,13 +657,11 @@ typeCheckRuleDefinition hsc pm = do
 
 -- | Get all the linkables stored in the graph, i.e. the ones we *do not* need to unload.
 -- Doesn't actually contain the code, since we don't need it to unload
-currentLinkables :: Action [Linkable]
+currentLinkables :: Action (ModuleEnv UTCTime)
 currentLinkables = do
     compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction
     hm <- liftIO $ readVar compiledLinkables
-    pure $ map go $ moduleEnvToList hm
-  where
-    go (mod, time) = LM time mod []
+    pure hm
 
 loadGhcSession :: GhcSessionDepsConfig -> Rules ()
 loadGhcSession ghcSessionDepsConfig = do
@@ -743,15 +739,25 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
 -- | Load a iface from disk, or generate it if there isn't one or it is out of date
 -- This rule also ensures that the `.hie` and `.o` (if needed) files are written out.
 getModIfaceFromDiskRule :: Rules ()
-getModIfaceFromDiskRule = defineEarlyCutoff $ Rule $ \GetModIfaceFromDisk f -> do
+getModIfaceFromDiskRule = defineEarlyCutoff $ RuleWithOldValue $ \GetModIfaceFromDisk f old -> do
   ms <- msrModSummary <$> use_ GetModSummary f
   mb_session <- use GhcSessionDeps f
   case mb_session of
     Nothing -> return (Nothing, ([], Nothing))
     Just session -> do
-      sourceModified <- use_ IsHiFileStable f
       linkableType <- getLinkableType f
-      r <- loadInterface (hscEnv session) ms sourceModified linkableType (regenerateHiFile session f ms)
+      ver <- use_ GetModificationTime f
+      let m_old = case old of
+            Shake.Succeeded (Just old_version) v -> Just (v, old_version)
+            Shake.Stale _   (Just old_version) v -> Just (v, old_version)
+            _ -> Nothing
+          recompInfo = RecompilationInfo
+            { source_version = ver
+            , old_value = m_old
+            , get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
+            , regenerate = regenerateHiFile session f ms
+            }
+      r <- loadInterface (hscEnv session) ms linkableType recompInfo
       case r of
         (diags, Nothing) -> return (Nothing, (diags, Nothing))
         (diags, Just x) -> do
@@ -802,31 +808,6 @@ getModIfaceFromDiskAndIndexRule =
 
   return (Just x)
 
-isHiFileStableRule :: Rules ()
-isHiFileStableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsHiFileStable f -> do
-    ms <- msrModSummary <$> use_ GetModSummaryWithoutTimestamps f
-    let hiFile = toNormalizedFilePath'
-                $ Compat.ml_hi_file $ ms_location ms
-    mbHiVersion <- use  GetModificationTime_{missingFileDiagnostics=False} hiFile
-    modVersion  <- use_ GetModificationTime f
-    sourceModified <- case mbHiVersion of
-        Nothing -> pure SourceModified
-        Just x ->
-            if modificationTime x < modificationTime modVersion
-                then pure SourceModified
-                else do
-                    fileImports <- use_ GetLocatedImports f
-                    let imports = fmap artifactFilePath . snd <$> fileImports
-                    deps <- uses_ IsHiFileStable (catMaybes imports)
-                    pure $ if all (== SourceUnmodifiedAndStable) deps
-                           then SourceUnmodifiedAndStable
-                           else SourceUnmodified
-    return (Just (summarize sourceModified), Just sourceModified)
-  where
-      summarize SourceModified            = BS.singleton 1
-      summarize SourceUnmodified          = BS.singleton 2
-      summarize SourceUnmodifiedAndStable = BS.singleton 3
-
 displayTHWarning :: LspT c IO ()
 displayTHWarning
   | not isWindows && not hostIsDynamic = do
@@ -1122,7 +1103,6 @@ mainRule RulesConfig{..} = do
     getModIfaceFromDiskAndIndexRule
     getModIfaceRule
     getModSummaryRule
-    isHiFileStableRule
     getModuleGraphRule
     knownFilesRule
     getClientSettingsRule
@@ -1144,13 +1124,3 @@ mainRule RulesConfig{..} = do
     persistentHieFileRule
     persistentDocMapRule
     persistentImportMapRule
-
--- | Given the path to a module src file, this rule returns True if the
--- corresponding `.hi` file is stable, that is, if it is newer
---   than the src file, and all its dependencies are stable too.
-data IsHiFileStable = IsHiFileStable
-    deriving (Eq, Show, Typeable, Generic)
-instance Hashable IsHiFileStable
-instance NFData   IsHiFileStable
-
-type instance RuleResult IsHiFileStable = SourceModified

Diff for: ghcide/src/Development/IDE/Core/Rules.hs

@@ -984,6 +984,7 @@ data RuleBody k v
     { newnessCheck :: BS.ByteString -> BS.ByteString -> Bool
     , build :: k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v)
     }
+  | RuleWithOldValue (k -> NormalizedFilePath -> Value v -> Action (Maybe BS.ByteString, IdeResult v))
 
 -- | Define a new Rule with early cutoff
 defineEarlyCutoff
@@ -995,13 +996,13 @@ defineEarlyCutoff (Rule op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteSt
     let diagnostics diags = do
             traceDiagnostics diags
             updateFileDiagnostics file (Key key) extras . map (\(_,y,z) -> (y,z)) $ diags
-    defineEarlyCutoff' diagnostics (==) key file old mode $ op key file
+    defineEarlyCutoff' diagnostics (==) key file old mode $ const $ op key file
 defineEarlyCutoff (RuleNoDiagnostics op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ \traceDiagnostics -> do
     ShakeExtras{logger} <- getShakeExtras
     let diagnostics diags = do
             traceDiagnostics diags
             mapM_ (\d -> liftIO $ logWarning logger $ showDiagnosticsColored [d]) diags
-    defineEarlyCutoff' diagnostics (==) key file old mode $ second (mempty,) <$> op key file
+    defineEarlyCutoff' diagnostics (==) key file old mode $ const $ second (mempty,) <$> op key file
 defineEarlyCutoff RuleWithCustomNewnessCheck{..} =
     addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode ->
         otTracedAction key file mode traceA $ \ traceDiagnostics -> do
@@ -1010,7 +1011,13 @@ defineEarlyCutoff RuleWithCustomNewnessCheck{..} =
                     mapM_ (\d -> liftIO $ logWarning logger $ showDiagnosticsColored [d]) diags
                     traceDiagnostics diags
             defineEarlyCutoff' diagnostics newnessCheck key file old mode $
-                second (mempty,) <$> build key file
+                const $ second (mempty,) <$> build key file
+defineEarlyCutoff (RuleWithOldValue op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ \traceDiagnostics -> do
+    extras <- getShakeExtras
+    let diagnostics diags = do
+            traceDiagnostics diags
+            updateFileDiagnostics file (Key key) extras . map (\(_,y,z) -> (y,z)) $ diags
+    defineEarlyCutoff' diagnostics (==) key file old mode $ op key file
 
 defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()
 defineNoFile f = defineNoDiagnostics $ \k file -> do
@@ -1031,7 +1038,7 @@ defineEarlyCutoff'
     -> NormalizedFilePath
     -> Maybe BS.ByteString
     -> RunMode
-    -> Action (Maybe BS.ByteString, IdeResult v)
+    -> (Value v -> Action (Maybe BS.ByteString, IdeResult v))
     -> Action (RunResult (A (RuleResult k)))
 defineEarlyCutoff' doDiagnostics cmp key file old mode action = do
     ShakeExtras{state, progress, dirtyKeys} <- getShakeExtras
@@ -1061,7 +1068,7 @@ defineEarlyCutoff' doDiagnostics cmp key file old mode action = do
                   Just (Failed b, _)        -> Failed b
 
                 (bs, (diags, res)) <- actionCatch
-                    (do v <- action; liftIO $ evaluate $ force v) $
+                    (do v <- action staleV; liftIO $ evaluate $ force v) $
                     \(e :: SomeException) -> do
                         pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))