Improve caching granularity by using partial fingerprints of ModuleGraph haskell#4594

Previously, we shared a single ModuleGraph across all files. Any change
to an import header would invalidate the cache for all rules that
depended on the ModuleGraph, causing redundant rebuilds and slowing down
compilation (see haskell#4443).

We now continue to build and share the full ModuleGraph, but only compute
partial fingerprints for it. Compilation rules now depend only on the
relevant fingerprinted subset, assuming that use sites do not depend on
parts excluded from the fingerprint. This reduces unnecessary
recompilation and improves caching precision.

Key changes:
- Added fingerprint rules for partial ModuleGraph views:
  - GetModuleGraphTransDepsFingerprints
  - GetModuleGraphTransReverseDepsFingerprints
  - GetModuleGraphImmediateReverseDepsFingerprints
- Introduced useWithSeparateFingerprintRule and useWithSeparateFingerprintRule_
- Updated rules that use GetModuleGraph to use the new fingerprint rules

This improves incremental compilation performance by avoiding full graph
invalidations when only a small part changes.

Author: soulomoon

ghcide/src/Development/IDE/Core/FileStore.hs

@@ -264,7 +264,7 @@ typecheckParents recorder state nfp = void $ shakeEnqueue (shakeExtras state) pa
 
 typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action ()
 typecheckParentsAction recorder nfp = do
-    revs <- transitiveReverseDependencies nfp <$> useNoFile_ GetModuleGraph
+    revs <- transitiveReverseDependencies nfp <$> useWithSeparateFingerprintRule_ GetModuleGraphTransReverseDepsFingerprints GetModuleGraph nfp
     case revs of
       Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp
       Just rs -> do

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -74,6 +74,12 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule
 
 type instance RuleResult GetModuleGraph = DependencyInformation
 
+-- | it only compute the fingerprint of the module graph for a file and its dependencies
+-- we need this to trigger recompilation when the sub module graph for a file changes
+type instance RuleResult GetModuleGraphTransDepsFingerprints = Fingerprint
+type instance RuleResult GetModuleGraphTransReverseDepsFingerprints = Fingerprint
+type instance RuleResult GetModuleGraphImmediateReverseDepsFingerprints = Fingerprint
+
 data GetKnownTargets = GetKnownTargets
   deriving (Show, Generic, Eq, Ord)
 instance Hashable GetKnownTargets
@@ -417,6 +423,21 @@ data GetModuleGraph = GetModuleGraph
 instance Hashable GetModuleGraph
 instance NFData   GetModuleGraph
 
+data GetModuleGraphTransDepsFingerprints = GetModuleGraphTransDepsFingerprints
+    deriving (Eq, Show, Generic)
+instance Hashable GetModuleGraphTransDepsFingerprints
+instance NFData   GetModuleGraphTransDepsFingerprints
+
+data GetModuleGraphTransReverseDepsFingerprints = GetModuleGraphTransReverseDepsFingerprints
+    deriving (Eq, Show, Generic)
+instance Hashable GetModuleGraphTransReverseDepsFingerprints
+instance NFData   GetModuleGraphTransReverseDepsFingerprints
+
+data GetModuleGraphImmediateReverseDepsFingerprints = GetModuleGraphImmediateReverseDepsFingerprints
+    deriving (Eq, Show, Generic)
+instance Hashable GetModuleGraphImmediateReverseDepsFingerprints
+instance NFData   GetModuleGraphImmediateReverseDepsFingerprints
+
 data ReportImportCycles = ReportImportCycles
     deriving (Eq, Show, Generic)
 instance Hashable ReportImportCycles

ghcide/src/Development/IDE/Core/Rules.hs

@@ -472,7 +472,7 @@ rawDependencyInformation fs = do
 reportImportCyclesRule :: Recorder (WithPriority Log) -> Rules ()
 reportImportCyclesRule recorder =
     defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \ReportImportCycles file -> fmap (\errs -> if null errs then (Just "1",([], Just ())) else (Nothing, (errs, Nothing))) $ do
-        DependencyInformation{..} <- useNoFile_ GetModuleGraph
+        DependencyInformation{..} <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file
         case pathToId depPathIdMap file of
           -- The header of the file does not parse, so it can't be part of any import cycles.
           Nothing -> pure []
@@ -608,7 +608,7 @@ typeCheckRule recorder = define (cmapWithPrio LogShake recorder) $ \TypeCheck fi
     -- very expensive.
     when (foi == NotFOI) $
       logWith recorder Logger.Warning $ LogTypecheckedFOI file
-    typeCheckRuleDefinition hsc pm
+    typeCheckRuleDefinition hsc pm file
 
 knownFilesRule :: Recorder (WithPriority Log) -> Rules ()
 knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetKnownTargets -> do
@@ -643,7 +643,10 @@ dependencyInfoForFiles fs = do
       go (Just ms) _ = Just $ ModuleNode [] ms
       go _ _ = Nothing
       mg = mkModuleGraph mns
-  pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg)
+  let shallowFingers = IntMap.fromList $ foldr' (\(i, m) acc -> case m of
+                                        Just x -> (getFilePathId i,msrFingerprint x):acc
+                                        Nothing -> acc) [] $ zip _all_ids msrs
+  pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg shallowFingers)
 
 -- This is factored out so it can be directly called from the GetModIface
 -- rule. Directly calling this rule means that on the initial load we can
@@ -652,14 +655,15 @@ dependencyInfoForFiles fs = do
 typeCheckRuleDefinition
     :: HscEnv
     -> ParsedModule
+    -> NormalizedFilePath
     -> Action (IdeResult TcModuleResult)
-typeCheckRuleDefinition hsc pm = do
+typeCheckRuleDefinition hsc pm fp = do
   IdeOptions { optDefer = defer } <- getIdeOptions
 
   unlift <- askUnliftIO
   let dets = TypecheckHelpers
            { getLinkables = unliftIO unlift . uses_ GetLinkable
-           , getModuleGraph = unliftIO unlift $ useNoFile_ GetModuleGraph
+           , getModuleGraph = unliftIO unlift $ useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph fp
            }
   addUsageDependencies $ liftIO $
     typecheckModule defer hsc dets pm
@@ -756,9 +760,10 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
             depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps
             ifaces <- uses_ GetModIface deps
             let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces
+            de <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file
             mg <- do
               if fullModuleGraph
-              then depModuleGraph <$> useNoFile_ GetModuleGraph
+              then return $ depModuleGraph de
               else do
                 let mgs = map hsc_mod_graph depSessions
                 -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph
@@ -771,7 +776,6 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
                       nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)
                 liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes
                 return $ mkModuleGraph module_graph_nodes
-            de <- useNoFile_ GetModuleGraph
             session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions
 
             -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new
@@ -801,7 +805,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
             , old_value = m_old
             , get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
             , get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs
-            , get_module_graph = useNoFile_ GetModuleGraph
+            , get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f
             , regenerate = regenerateHiFile session f ms
             }
       hsc_env' <- setFileCacheHook (hscEnv session)
@@ -977,7 +981,7 @@ regenerateHiFile sess f ms compNeeded = do
         Just pm -> do
             -- Invoke typechecking directly to update it without incurring a dependency
             -- on the parsed module and the typecheck rules
-            (diags', mtmr) <- typeCheckRuleDefinition hsc pm
+            (diags', mtmr) <- typeCheckRuleDefinition hsc pm f
             case mtmr of
               Nothing -> pure (diags', Nothing)
               Just tmr -> do
@@ -1135,7 +1139,7 @@ needsCompilationRule file
   | "boot" `isSuffixOf` fromNormalizedFilePath file =
     pure (Just $ encodeLinkableType Nothing, Just Nothing)
 needsCompilationRule file = do
-  graph <- useNoFile GetModuleGraph
+  graph <- useWithSeparateFingerprintRule GetModuleGraphImmediateReverseDepsFingerprints GetModuleGraph file
   res <- case graph of
     -- Treat as False if some reverse dependency header fails to parse
     Nothing -> pure Nothing
@@ -1247,6 +1251,19 @@ mainRule recorder RulesConfig{..} = do
     persistentDocMapRule
     persistentImportMapRule
     getLinkableRule recorder
+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransDepsFingerprints file -> do
+        di <- useNoFile_ GetModuleGraph
+        let finger = lookupFingerprint file di (depTransDepsFingerprints di)
+        return (fingerprintToBS <$> finger, ([], finger))
+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransReverseDepsFingerprints file -> do
+        di <- useNoFile_ GetModuleGraph
+        let finger = lookupFingerprint file di (depTransReverseDepsFingerprints di)
+        return (fingerprintToBS <$> finger, ([], finger))
+    defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphImmediateReverseDepsFingerprints file -> do
+        di <- useNoFile_ GetModuleGraph
+        let finger = lookupFingerprint file di (depImmediateReverseDepsFingerprints di)
+        return (fingerprintToBS <$> finger, ([], finger))
+
 
 -- | Get HieFile for haskell file on NormalizedFilePath
 getHieFile :: NormalizedFilePath -> Action (Maybe HieFile)

ghcide/src/Development/IDE/Core/Shake.hs

@@ -31,6 +31,8 @@ module Development.IDE.Core.Shake(
     shakeEnqueue,
     newSession,
     use, useNoFile, uses, useWithStaleFast, useWithStaleFast', delayedAction,
+    useWithSeparateFingerprintRule,
+    useWithSeparateFingerprintRule_,
     FastResult(..),
     use_, useNoFile_, uses_,
     useWithStale, usesWithStale,
@@ -1148,6 +1150,23 @@ usesWithStale key files = do
     -- whether the rule succeeded or not.
     traverse (lastValue key) files
 
+-- we use separate fingerprint rules to trigger the rebuild of the rule
+useWithSeparateFingerprintRule
+    :: (IdeRule k v, IdeRule k1 Fingerprint)
+    => k1 -> k -> NormalizedFilePath -> Action (Maybe v)
+useWithSeparateFingerprintRule fingerKey key file = do
+    _ <- use fingerKey file
+    useWithoutDependency key emptyFilePath
+
+-- we use separate fingerprint rules to trigger the rebuild of the rule
+useWithSeparateFingerprintRule_
+    :: (IdeRule k v, IdeRule k1 Fingerprint)
+    => k1 -> k -> NormalizedFilePath -> Action v
+useWithSeparateFingerprintRule_ fingerKey key file = do
+    useWithSeparateFingerprintRule fingerKey key file >>= \case
+        Just v -> return v
+        Nothing -> liftIO $ throwIO $ BadDependency (show key)
+
 useWithoutDependency :: IdeRule k v
     => k -> NormalizedFilePath -> Action (Maybe v)
 useWithoutDependency key file =

ghcide/src/Development/IDE/Import/DependencyInformation.hs

@@ -29,6 +29,7 @@ module Development.IDE.Import.DependencyInformation
   , lookupModuleFile
   , BootIdMap
   , insertBootId
+  , lookupFingerprint
   ) where
 
 import           Control.DeepSeq
@@ -49,6 +50,8 @@ import qualified Data.List.NonEmpty                 as NonEmpty
 import           Data.Maybe
 import           Data.Tuple.Extra                   hiding (first, second)
 import           Development.IDE.GHC.Compat
+import           Development.IDE.GHC.Compat.Util    (Fingerprint)
+import qualified Development.IDE.GHC.Compat.Util    as Util
 import           Development.IDE.GHC.Orphans        ()
 import           Development.IDE.Import.FindImports (ArtifactsLocation (..))
 import           Development.IDE.Types.Diagnostics
@@ -136,23 +139,35 @@ data RawDependencyInformation = RawDependencyInformation
 
 data DependencyInformation =
   DependencyInformation
-    { depErrorNodes        :: !(FilePathIdMap (NonEmpty NodeError))
+    { depErrorNodes         :: !(FilePathIdMap (NonEmpty NodeError))
     -- ^ Nodes that cannot be processed correctly.
-    , depModules           :: !(FilePathIdMap ShowableModule)
-    , depModuleDeps        :: !(FilePathIdMap FilePathIdSet)
+    , depModules            :: !(FilePathIdMap ShowableModule)
+    , depModuleDeps         :: !(FilePathIdMap FilePathIdSet)
     -- ^ For a non-error node, this contains the set of module immediate dependencies
     -- in the same package.
-    , depReverseModuleDeps :: !(IntMap IntSet)
+    , depReverseModuleDeps  :: !(IntMap IntSet)
     -- ^ Contains a reverse mapping from a module to all those that immediately depend on it.
-    , depPathIdMap         :: !PathIdMap
+    , depPathIdMap          :: !PathIdMap
     -- ^ Map from FilePath to FilePathId
-    , depBootMap           :: !BootIdMap
+    , depBootMap            :: !BootIdMap
     -- ^ Map from hs-boot file to the corresponding hs file
-    , depModuleFiles       :: !(ShowableModuleEnv FilePathId)
+    , depModuleFiles        :: !(ShowableModuleEnv FilePathId)
     -- ^ Map from Module to the corresponding non-boot hs file
-    , depModuleGraph       :: !ModuleGraph
+    , depModuleGraph        :: !ModuleGraph
+    , depTransDepsFingerprints :: !(FilePathIdMap Fingerprint)
+    -- ^ Map from Module to fingerprint of the transitive dependencies of the module.
+    , depTransReverseDepsFingerprints :: !(FilePathIdMap Fingerprint)
+    -- ^ Map from FilePathId to the fingerprint of the transitive reverse dependencies of the module.
+    , depImmediateReverseDepsFingerprints :: !(FilePathIdMap Fingerprint)
+    -- ^ Map from FilePathId to the fingerprint of the immediate reverse dependencies of the module.
     } deriving (Show, Generic)
 
+lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> FilePathIdMap Fingerprint -> Maybe Fingerprint
+lookupFingerprint fileId DependencyInformation {..} depFingerprintMap =
+  do
+    FilePathId cur_id <- lookupPathToId depPathIdMap fileId
+    IntMap.lookup cur_id depFingerprintMap
+
 newtype ShowableModule =
   ShowableModule {showableModule :: Module}
   deriving NFData
@@ -228,8 +243,8 @@ instance Semigroup NodeResult where
    SuccessNode _ <> ErrorNode errs   = ErrorNode errs
    SuccessNode a <> SuccessNode _    = SuccessNode a
 
-processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> DependencyInformation
-processDependencyInformation RawDependencyInformation{..} rawBootMap mg =
+processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> FilePathIdMap Fingerprint -> DependencyInformation
+processDependencyInformation RawDependencyInformation{..} rawBootMap mg shallowFingerMap =
   DependencyInformation
     { depErrorNodes = IntMap.fromList errorNodes
     , depModuleDeps = moduleDeps
@@ -239,6 +254,9 @@ processDependencyInformation RawDependencyInformation{..} rawBootMap mg =
     , depBootMap = rawBootMap
     , depModuleFiles = ShowableModuleEnv reverseModuleMap
     , depModuleGraph = mg
+    , depTransDepsFingerprints = buildTransDepsFingerprintMap moduleDeps shallowFingerMap
+    , depTransReverseDepsFingerprints = buildTransDepsFingerprintMap reverseModuleDeps shallowFingerMap
+    , depImmediateReverseDepsFingerprints = buildImmediateDepsFingerprintMap reverseModuleDeps shallowFingerMap
     }
   where resultGraph = buildResultGraph rawImports
         (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph
@@ -398,3 +416,44 @@ instance NFData NamedModuleDep where
 
 instance Show NamedModuleDep where
   show NamedModuleDep{..} = show nmdFilePath
+
+
+buildImmediateDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint
+buildImmediateDepsFingerprintMap modulesDeps shallowFingers =
+  IntMap.fromList
+    $ map
+      ( \k ->
+          ( k,
+            Util.fingerprintFingerprints $
+              map
+                (shallowFingers IntMap.!)
+                (k : IntSet.toList (IntMap.findWithDefault IntSet.empty k modulesDeps))
+          )
+      )
+    $ IntMap.keys shallowFingers
+
+-- | Build a map from file path to its full fingerprint.
+-- The fingerprint is depend on both the fingerprints of the file and all its dependencies.
+-- This is used to determine if a file has changed and needs to be reloaded.
+buildTransDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint
+buildTransDepsFingerprintMap modulesDeps shallowFingers = go keys IntMap.empty
+  where
+    keys = IntMap.keys shallowFingers
+    go :: [IntSet.Key] -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint
+    go keys acc =
+      case keys of
+        [] -> acc
+        k : ks ->
+          if IntMap.member k acc
+            -- already in the map, so we can skip
+            then go ks acc
+            -- not in the map, so we need to add it
+            else
+              let -- get the dependencies of the current key
+                  deps = IntSet.toList $ IntMap.findWithDefault IntSet.empty k modulesDeps
+                  -- add fingerprints of the dependencies to the accumulator
+                  depFingerprints = go deps acc
+                  -- combine the fingerprints of the dependencies with the current key
+                  combinedFingerprints = Util.fingerprintFingerprints $ shallowFingers IntMap.! k : map (depFingerprints IntMap.!) deps
+               in -- add the combined fingerprints to the accumulator
+                  go ks (IntMap.insert k combinedFingerprints depFingerprints)