From 824c50868d31e805667fe10c3c906c68484c980e Mon Sep 17 00:00:00 2001 From: soulomoon Date: Tue, 20 May 2025 02:56:40 +0800 Subject: [PATCH 01/10] compute deps fingerprint only --- ghcide/src/Development/IDE/Core/FileStore.hs | 2 +- ghcide/src/Development/IDE/Core/RuleTypes.hs | 8 +++ ghcide/src/Development/IDE/Core/Rules.hs | 29 +++++++--- .../IDE/Import/DependencyInformation.hs | 58 +++++++++++++++---- .../src/Ide/Plugin/Eval/Handlers.hs | 4 +- 5 files changed, 79 insertions(+), 22 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 3de21e175d..ed494e8711 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/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 <$> use_ GetFileModuleGraph nfp case revs of Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp Just rs -> do diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index c4f88de047..64aa86e108 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -74,6 +74,9 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule type instance RuleResult GetModuleGraph = DependencyInformation +-- same as DependencyInformation but only rebuilds if the target file deps changes +type instance RuleResult GetFileModuleGraph = DependencyInformation + data GetKnownTargets = GetKnownTargets deriving (Show, Generic, Eq, Ord) instance Hashable GetKnownTargets @@ -417,6 +420,11 @@ data GetModuleGraph = GetModuleGraph instance Hashable GetModuleGraph instance NFData GetModuleGraph +data GetFileModuleGraph = GetFileModuleGraph + deriving (Eq, Show, Generic) +instance Hashable GetFileModuleGraph +instance NFData GetFileModuleGraph + data ReportImportCycles = ReportImportCycles deriving (Eq, Show, Generic) instance Hashable ReportImportCycles diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 74eddf55f1..5118078fec 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/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{..} <- use_ GetFileModuleGraph 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 @@ -628,6 +628,12 @@ getModuleGraphRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake rec fs <- toKnownFiles <$> useNoFile_ GetKnownTargets dependencyInfoForFiles (HashSet.toList fs) +getModuleGraphSingleFileRule :: Recorder (WithPriority Log) -> Rules () +getModuleGraphSingleFileRule recorder = + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetFileModuleGraph file -> do + di <- useNoFile_ GetModuleGraph + return (fingerprintToBS <$> lookupFingerprint file di, ([], Just di)) + dependencyInfoForFiles :: [NormalizedFilePath] -> Action (BS.ByteString, DependencyInformation) dependencyInfoForFiles fs = do (rawDepInfo, bm) <- rawDependencyInformation fs @@ -643,7 +649,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 +661,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 $ use_ GetFileModuleGraph fp } addUsageDependencies $ liftIO $ typecheckModule defer hsc dets pm @@ -758,7 +768,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces mg <- do if fullModuleGraph - then depModuleGraph <$> useNoFile_ GetModuleGraph + then depModuleGraph <$> use_ GetFileModuleGraph file 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 +781,7 @@ 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 + de <- use_ GetFileModuleGraph file session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new @@ -801,7 +811,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 = use_ GetFileModuleGraph f , regenerate = regenerateHiFile session f ms } hsc_env' <- setFileCacheHook (hscEnv session) @@ -977,7 +987,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 @@ -1226,6 +1236,7 @@ mainRule recorder RulesConfig{..} = do getModIfaceRule recorder getModSummaryRule templateHaskellWarning recorder getModuleGraphRule recorder + getModuleGraphSingleFileRule recorder getFileHashRule recorder knownFilesRule recorder getClientSettingsRule recorder diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index d6e0f5614c..85d96e0f1e 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/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,31 @@ 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 + -- ^ Map from Module to the + , depModuleFingerprints :: !(FilePathIdMap Fingerprint) } deriving (Show, Generic) +lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> Maybe Fingerprint +lookupFingerprint fileId DependencyInformation {..} = + do + FilePathId cur_id <- lookupPathToId depPathIdMap fileId + IntMap.lookup cur_id depModuleFingerprints + newtype ShowableModule = ShowableModule {showableModule :: Module} deriving NFData @@ -228,8 +239,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 +250,7 @@ processDependencyInformation RawDependencyInformation{..} rawBootMap mg = , depBootMap = rawBootMap , depModuleFiles = ShowableModuleEnv reverseModuleMap , depModuleGraph = mg + , depModuleFingerprints = buildAccFingerFilePathIdMap moduleDeps shallowFingerMap } where resultGraph = buildResultGraph rawImports (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph @@ -398,3 +410,29 @@ instance NFData NamedModuleDep where instance Show NamedModuleDep where show NamedModuleDep{..} = show nmdFilePath + +-- | Build a map from file path to fingerprint. The fingerprint is built +-- from the fingerprints of the file and all its dependencies. +-- This is used to determine if a file has changed and needs to be reloaded. +buildAccFingerFilePathIdMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint +buildAccFingerFilePathIdMap 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) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index cc80e91f77..20e5de5091 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -46,7 +46,7 @@ import Development.IDE.Core.Rules (IdeState, runAction) import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod), TypeCheck (..), - tmrTypechecked) + tmrTypechecked, GetFileModuleGraph(..)) import Development.IDE.Core.Shake (useNoFile_, use_, uses_) import Development.IDE.GHC.Compat hiding (typeKind, @@ -256,7 +256,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do ms <- msrModSummary <$> use_ GetModSummary nfp deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp - linkables_needed <- transitiveDeps <$> useNoFile_ GetModuleGraph <*> pure nfp + linkables_needed <- transitiveDeps <$> use_ GetFileModuleGraph nfp <*> pure nfp linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed) -- We unset the global rdr env in mi_globals when we generate interfaces -- See Note [Clearing mi_globals after generating an iface] From 4cc1c37e12c62728f1fbb8105032bc0e8d908e62 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Sun, 25 May 2025 02:23:29 +0800 Subject: [PATCH 02/10] Refactor comments for clarity and update rule usage in needsCompilationRule --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 2 +- ghcide/src/Development/IDE/Core/Rules.hs | 2 +- ghcide/src/Development/IDE/Import/DependencyInformation.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 64aa86e108..a77600643c 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -74,7 +74,7 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule type instance RuleResult GetModuleGraph = DependencyInformation --- same as DependencyInformation but only rebuilds if the target file deps changes +-- same as GetModuleGraph but only rebuilds if the target file deps changes type instance RuleResult GetFileModuleGraph = DependencyInformation data GetKnownTargets = GetKnownTargets diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 5118078fec..3417c16eaa 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -1145,7 +1145,7 @@ needsCompilationRule file | "boot" `isSuffixOf` fromNormalizedFilePath file = pure (Just $ encodeLinkableType Nothing, Just Nothing) needsCompilationRule file = do - graph <- useNoFile GetModuleGraph + graph <- use GetFileModuleGraph file res <- case graph of -- Treat as False if some reverse dependency header fails to parse Nothing -> pure Nothing diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 85d96e0f1e..72baa9ed9a 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -411,8 +411,8 @@ instance NFData NamedModuleDep where instance Show NamedModuleDep where show NamedModuleDep{..} = show nmdFilePath --- | Build a map from file path to fingerprint. The fingerprint is built --- from the fingerprints of the file and all its dependencies. +-- | 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. buildAccFingerFilePathIdMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint buildAccFingerFilePathIdMap modulesDeps shallowFingers = go keys IntMap.empty From 8afa778f6e9ad78bbefd3aba9a83bc78d6968c46 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Mon, 26 May 2025 19:13:45 +0800 Subject: [PATCH 03/10] Refactor imports in Handlers.hs for clarity and organization --- .../src/Ide/Plugin/Eval/Handlers.hs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index 20e5de5091..737d6ff630 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -41,14 +41,10 @@ import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Utf16.Rope.Mixed as Rope -import Development.IDE.Core.FileStore (getUriContents) +import Development.IDE.Core.FileStore (getUriContents, setSomethingModified) import Development.IDE.Core.Rules (IdeState, runAction) -import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod), - TypeCheck (..), - tmrTypechecked, GetFileModuleGraph(..)) -import Development.IDE.Core.Shake (useNoFile_, use_, - uses_) +import Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified)) import Development.IDE.GHC.Compat hiding (typeKind, unitState) import Development.IDE.GHC.Compat.Util (OverridingBool (..)) @@ -76,17 +72,18 @@ import GHC (ClsInst, import Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable), GetModSummary (GetModSummary), - GetModuleGraph (GetModuleGraph), + GetFileModuleGraph (GetFileModuleGraph), GhcSessionDeps (GhcSessionDeps), - ModSummaryResult (msrModSummary)) -import Development.IDE.Core.Shake (VFSModified (VFSUnmodified)) + ModSummaryResult (msrModSummary), + LinkableResult (linkableHomeMod), + TypeCheck (..), + tmrTypechecked, GetFileModuleGraph(..)) import qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule)) import qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc) import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) import Data.List.Extra (unsnoc) -import Development.IDE.Core.FileStore (setSomethingModified) import Development.IDE.Core.PluginUtils import Development.IDE.Types.Shake (toKey) import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) From bebead5d2b51d80e87810a0a6909a3da16a6d3f2 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 29 May 2025 00:40:50 +0800 Subject: [PATCH 04/10] maximize sharing by creating a finger print rule and query result from GetModuleGraph --- ghcide/src/Development/IDE/Core/FileStore.hs | 2 +- ghcide/src/Development/IDE/Core/RuleTypes.hs | 11 ++++++----- ghcide/src/Development/IDE/Core/Rules.hs | 16 ++++++++-------- ghcide/src/Development/IDE/Core/Shake.hs | 19 +++++++++++++++++++ .../src/Ide/Plugin/Eval/Handlers.hs | 8 ++++---- 5 files changed, 38 insertions(+), 18 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index ed494e8711..c108d97462 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/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 <$> use_ GetFileModuleGraph nfp + revs <- transitiveReverseDependencies nfp <$> useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph nfp case revs of Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp Just rs -> do diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index a77600643c..3f56dd3c3d 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -74,8 +74,9 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule type instance RuleResult GetModuleGraph = DependencyInformation --- same as GetModuleGraph but only rebuilds if the target file deps changes -type instance RuleResult GetFileModuleGraph = 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 GetFileModuleGraphFingerprint = Fingerprint data GetKnownTargets = GetKnownTargets deriving (Show, Generic, Eq, Ord) @@ -420,10 +421,10 @@ data GetModuleGraph = GetModuleGraph instance Hashable GetModuleGraph instance NFData GetModuleGraph -data GetFileModuleGraph = GetFileModuleGraph +data GetFileModuleGraphFingerprint = GetFileModuleGraphFingerprint deriving (Eq, Show, Generic) -instance Hashable GetFileModuleGraph -instance NFData GetFileModuleGraph +instance Hashable GetFileModuleGraphFingerprint +instance NFData GetFileModuleGraphFingerprint data ReportImportCycles = ReportImportCycles deriving (Eq, Show, Generic) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 3417c16eaa..c36e737165 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/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{..} <- use_ GetFileModuleGraph file + DependencyInformation{..} <- useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint 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 [] @@ -630,9 +630,9 @@ getModuleGraphRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake rec getModuleGraphSingleFileRule :: Recorder (WithPriority Log) -> Rules () getModuleGraphSingleFileRule recorder = - defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetFileModuleGraph file -> do + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetFileModuleGraphFingerprint file -> do di <- useNoFile_ GetModuleGraph - return (fingerprintToBS <$> lookupFingerprint file di, ([], Just di)) + return $ lookupFingerprint file di dependencyInfoForFiles :: [NormalizedFilePath] -> Action (BS.ByteString, DependencyInformation) dependencyInfoForFiles fs = do @@ -669,7 +669,7 @@ typeCheckRuleDefinition hsc pm fp = do unlift <- askUnliftIO let dets = TypecheckHelpers { getLinkables = unliftIO unlift . uses_ GetLinkable - , getModuleGraph = unliftIO unlift $ use_ GetFileModuleGraph fp + , getModuleGraph = unliftIO unlift $ useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph fp } addUsageDependencies $ liftIO $ typecheckModule defer hsc dets pm @@ -768,7 +768,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces mg <- do if fullModuleGraph - then depModuleGraph <$> use_ GetFileModuleGraph file + then depModuleGraph <$> useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph file 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 @@ -781,7 +781,7 @@ 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 <- use_ GetFileModuleGraph file + de <- useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph file session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new @@ -811,7 +811,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 = use_ GetFileModuleGraph f + , get_module_graph = useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph f , regenerate = regenerateHiFile session f ms } hsc_env' <- setFileCacheHook (hscEnv session) @@ -1145,7 +1145,7 @@ needsCompilationRule file | "boot" `isSuffixOf` fromNormalizedFilePath file = pure (Just $ encodeLinkableType Nothing, Just Nothing) needsCompilationRule file = do - graph <- use GetFileModuleGraph file + graph <- useWithSeparateFingerprintRule GetFileModuleGraphFingerprint GetModuleGraph file res <- case graph of -- Treat as False if some reverse dependency header fails to parse Nothing -> pure Nothing diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 97150339d0..cfcc6e0fe7 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/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 = diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index 737d6ff630..fab346834a 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -44,7 +44,7 @@ import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE.Core.FileStore (getUriContents, setSomethingModified) import Development.IDE.Core.Rules (IdeState, runAction) -import Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified)) +import Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_) import Development.IDE.GHC.Compat hiding (typeKind, unitState) import Development.IDE.GHC.Compat.Util (OverridingBool (..)) @@ -72,12 +72,12 @@ import GHC (ClsInst, import Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable), GetModSummary (GetModSummary), - GetFileModuleGraph (GetFileModuleGraph), + GetFileModuleGraphFingerprint (GetFileModuleGraphFingerprint), GhcSessionDeps (GhcSessionDeps), ModSummaryResult (msrModSummary), LinkableResult (linkableHomeMod), TypeCheck (..), - tmrTypechecked, GetFileModuleGraph(..)) + tmrTypechecked, GetFileModuleGraphFingerprint(..), GetModuleGraph(..)) import qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule)) import qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc) import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) @@ -253,7 +253,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do ms <- msrModSummary <$> use_ GetModSummary nfp deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp - linkables_needed <- transitiveDeps <$> use_ GetFileModuleGraph nfp <*> pure nfp + linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph nfp <*> pure nfp linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed) -- We unset the global rdr env in mi_globals when we generate interfaces -- See Note [Clearing mi_globals after generating an iface] From 4ec8a6ff1de59d798f7b8ac5d036d42f9f53c710 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 29 May 2025 00:58:40 +0800 Subject: [PATCH 05/10] avoid fingerprint nothing to fail in useWithSeparateFingerprintRule --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index cfcc6e0fe7..6fc9a4d00e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1155,7 +1155,7 @@ useWithSeparateFingerprintRule :: (IdeRule k v, IdeRule k1 Fingerprint) => k1 -> k -> NormalizedFilePath -> Action (Maybe v) useWithSeparateFingerprintRule fingerKey key file = do - _ <- use_ fingerKey file + _ <- use fingerKey file useWithoutDependency key emptyFilePath -- we use separate fingerprint rules to trigger the rebuild of the rule From e87f1d1affd845cb2db724bb6ea4b98428f51261 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 29 May 2025 02:06:57 +0800 Subject: [PATCH 06/10] add fingerprints rules for module graph: GetModuleGraphTransDepsFingerprints,GetModuleGraphTransReverseDepsFingerprints,GetModuleGraphImmediateReverseDepsFingerprints. --- ghcide/src/Development/IDE/Core/FileStore.hs | 2 +- ghcide/src/Development/IDE/Core/RuleTypes.hs | 20 +++++++-- ghcide/src/Development/IDE/Core/Rules.hs | 28 ++++++------ .../IDE/Import/DependencyInformation.hs | 44 +++++++++++++++---- .../src/Ide/Plugin/Eval/Handlers.hs | 6 +-- 5 files changed, 71 insertions(+), 29 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index c108d97462..7dad386ece 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/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 <$> useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph nfp + revs <- transitiveReverseDependencies nfp <$> useWithSeparateFingerprintRule_ GetModuleGraphTransReverseDepsFingerprints GetModuleGraph nfp case revs of Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp Just rs -> do diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 3f56dd3c3d..43b80be119 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -76,7 +76,9 @@ 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 GetFileModuleGraphFingerprint = Fingerprint +type instance RuleResult GetModuleGraphTransDepsFingerprints = Fingerprint +type instance RuleResult GetModuleGraphTransReverseDepsFingerprints = Fingerprint +type instance RuleResult GetModuleGraphImmediateReverseDepsFingerprints = Fingerprint data GetKnownTargets = GetKnownTargets deriving (Show, Generic, Eq, Ord) @@ -421,10 +423,20 @@ data GetModuleGraph = GetModuleGraph instance Hashable GetModuleGraph instance NFData GetModuleGraph -data GetFileModuleGraphFingerprint = GetFileModuleGraphFingerprint +data GetModuleGraphTransDepsFingerprints = GetModuleGraphTransDepsFingerprints deriving (Eq, Show, Generic) -instance Hashable GetFileModuleGraphFingerprint -instance NFData GetFileModuleGraphFingerprint +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) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index c36e737165..2a531343da 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/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{..} <- useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph file + 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 [] @@ -628,12 +628,6 @@ getModuleGraphRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake rec fs <- toKnownFiles <$> useNoFile_ GetKnownTargets dependencyInfoForFiles (HashSet.toList fs) -getModuleGraphSingleFileRule :: Recorder (WithPriority Log) -> Rules () -getModuleGraphSingleFileRule recorder = - defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetFileModuleGraphFingerprint file -> do - di <- useNoFile_ GetModuleGraph - return $ lookupFingerprint file di - dependencyInfoForFiles :: [NormalizedFilePath] -> Action (BS.ByteString, DependencyInformation) dependencyInfoForFiles fs = do (rawDepInfo, bm) <- rawDependencyInformation fs @@ -669,7 +663,7 @@ typeCheckRuleDefinition hsc pm fp = do unlift <- askUnliftIO let dets = TypecheckHelpers { getLinkables = unliftIO unlift . uses_ GetLinkable - , getModuleGraph = unliftIO unlift $ useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph fp + , getModuleGraph = unliftIO unlift $ useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph fp } addUsageDependencies $ liftIO $ typecheckModule defer hsc dets pm @@ -768,7 +762,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces mg <- do if fullModuleGraph - then depModuleGraph <$> useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph file + then depModuleGraph <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file 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 @@ -781,7 +775,7 @@ 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 <- useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph file + de <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new @@ -811,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 = useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph f + , get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f , regenerate = regenerateHiFile session f ms } hsc_env' <- setFileCacheHook (hscEnv session) @@ -1145,7 +1139,7 @@ needsCompilationRule file | "boot" `isSuffixOf` fromNormalizedFilePath file = pure (Just $ encodeLinkableType Nothing, Just Nothing) needsCompilationRule file = do - graph <- useWithSeparateFingerprintRule GetFileModuleGraphFingerprint GetModuleGraph file + graph <- useWithSeparateFingerprintRule GetModuleGraphImmediateReverseDepsFingerprints GetModuleGraph file res <- case graph of -- Treat as False if some reverse dependency header fails to parse Nothing -> pure Nothing @@ -1236,7 +1230,6 @@ mainRule recorder RulesConfig{..} = do getModIfaceRule recorder getModSummaryRule templateHaskellWarning recorder getModuleGraphRule recorder - getModuleGraphSingleFileRule recorder getFileHashRule recorder knownFilesRule recorder getClientSettingsRule recorder @@ -1258,6 +1251,15 @@ mainRule recorder RulesConfig{..} = do persistentDocMapRule persistentImportMapRule getLinkableRule recorder + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetModuleGraphTransDepsFingerprints file -> do + di <- useNoFile_ GetModuleGraph + return $ lookupFingerprint file di (depTransDepsFingerprints di) + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetModuleGraphTransReverseDepsFingerprints file -> do + di <- useNoFile_ GetModuleGraph + return $ lookupFingerprint file di (depTransReverseDepsFingerprints di) + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetModuleGraphImmediateReverseDepsFingerprints file -> do + di <- useNoFile_ GetModuleGraph + return $ lookupFingerprint file di (depImmediateReverseDepsFingerprints di) -- | Get HieFile for haskell file on NormalizedFilePath getHieFile :: NormalizedFilePath -> Action (Maybe HieFile) diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 72baa9ed9a..a9ceac6e0a 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -154,15 +154,19 @@ data DependencyInformation = , depModuleFiles :: !(ShowableModuleEnv FilePathId) -- ^ Map from Module to the corresponding non-boot hs file , depModuleGraph :: !ModuleGraph - -- ^ Map from Module to the - , depModuleFingerprints :: !(FilePathIdMap Fingerprint) + -- ^ Map from Module to fingerprint of the transitive dependencies of the module. + , depTransDepsFingerprints :: !(FilePathIdMap Fingerprint) + -- ^ Map from FilePathId to the fingerprint of the transitive reverse dependencies of the module. + , depTransReverseDepsFingerprints :: !(FilePathIdMap Fingerprint) + -- ^ Map from FilePathId to the fingerprint of the immediate reverse dependencies of the module. + , depImmediateReverseDepsFingerprints :: !(FilePathIdMap Fingerprint) } deriving (Show, Generic) -lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> Maybe Fingerprint -lookupFingerprint fileId DependencyInformation {..} = +lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> FilePathIdMap Fingerprint -> Maybe Fingerprint +lookupFingerprint fileId DependencyInformation {..} depFingerprintMap = do FilePathId cur_id <- lookupPathToId depPathIdMap fileId - IntMap.lookup cur_id depModuleFingerprints + IntMap.lookup cur_id depFingerprintMap newtype ShowableModule = ShowableModule {showableModule :: Module} @@ -250,7 +254,9 @@ processDependencyInformation RawDependencyInformation{..} rawBootMap mg shallowF , depBootMap = rawBootMap , depModuleFiles = ShowableModuleEnv reverseModuleMap , depModuleGraph = mg - , depModuleFingerprints = buildAccFingerFilePathIdMap moduleDeps shallowFingerMap + , depTransDepsFingerprints = buildTransDepsFingerprintMap moduleDeps shallowFingerMap + , depTransReverseDepsFingerprints = buildTransDepsFingerprintMap reverseModuleDeps shallowFingerMap + , depImmediateReverseDepsFingerprints = buildImmediateDepsFingerprintMap reverseModuleDeps shallowFingerMap } where resultGraph = buildResultGraph rawImports (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph @@ -411,11 +417,33 @@ instance NFData NamedModuleDep where instance Show NamedModuleDep where show NamedModuleDep{..} = show nmdFilePath + +buildImmediateDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint +buildImmediateDepsFingerprintMap 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 + -- combine the fingerprints of the dependencies with the current key + combinedFingerprints = Util.fingerprintFingerprints $ map (shallowFingers IntMap.!) (k:deps) + in -- add the combined fingerprints to the accumulator + go ks (IntMap.insert k combinedFingerprints acc) + -- | 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. -buildAccFingerFilePathIdMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint -buildAccFingerFilePathIdMap modulesDeps shallowFingers = go keys IntMap.empty +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 diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index fab346834a..1f19b5b476 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -72,12 +72,12 @@ import GHC (ClsInst, import Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable), GetModSummary (GetModSummary), - GetFileModuleGraphFingerprint (GetFileModuleGraphFingerprint), + GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints), GhcSessionDeps (GhcSessionDeps), ModSummaryResult (msrModSummary), LinkableResult (linkableHomeMod), TypeCheck (..), - tmrTypechecked, GetFileModuleGraphFingerprint(..), GetModuleGraph(..)) + tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..)) import qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule)) import qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc) import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) @@ -253,7 +253,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do ms <- msrModSummary <$> use_ GetModSummary nfp deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp - linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetFileModuleGraphFingerprint GetModuleGraph nfp <*> pure nfp + linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed) -- We unset the global rdr env in mi_globals when we generate interfaces -- See Note [Clearing mi_globals after generating an iface] From 5f58042fc1fa66181bcc7acbf76e83f0eeca3f70 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 29 May 2025 02:22:10 +0800 Subject: [PATCH 07/10] fix comment --- ghcide/src/Development/IDE/Import/DependencyInformation.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index a9ceac6e0a..71dcd72953 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -154,12 +154,12 @@ data DependencyInformation = , depModuleFiles :: !(ShowableModuleEnv FilePathId) -- ^ Map from Module to the corresponding non-boot hs file , depModuleGraph :: !ModuleGraph - -- ^ Map from Module to fingerprint of the transitive dependencies of the module. , depTransDepsFingerprints :: !(FilePathIdMap Fingerprint) - -- ^ Map from FilePathId to the fingerprint of the transitive reverse dependencies of the module. + -- ^ Map from Module to fingerprint of the transitive dependencies of the module. , depTransReverseDepsFingerprints :: !(FilePathIdMap Fingerprint) - -- ^ Map from FilePathId to the fingerprint of the immediate reverse dependencies of the module. + -- ^ 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 From be60d4d758286ded019bcbcd59051b24488955d0 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 29 May 2025 02:25:27 +0800 Subject: [PATCH 08/10] small refactor --- ghcide/src/Development/IDE/Core/Rules.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 2a531343da..5a9abd5682 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -760,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 <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file + 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 @@ -775,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 <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new From a1fc61c6d9febf3343daa927c3637a72287c950e Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 29 May 2025 03:19:23 +0800 Subject: [PATCH 09/10] optimize buildImmediateDepsFingerprintMap --- .../IDE/Import/DependencyInformation.hs | 31 +++++++------------ 1 file changed, 12 insertions(+), 19 deletions(-) diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 71dcd72953..471cf52eab 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -419,25 +419,18 @@ instance Show NamedModuleDep where buildImmediateDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint -buildImmediateDepsFingerprintMap 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 - -- combine the fingerprints of the dependencies with the current key - combinedFingerprints = Util.fingerprintFingerprints $ map (shallowFingers IntMap.!) (k:deps) - in -- add the combined fingerprints to the accumulator - go ks (IntMap.insert k combinedFingerprints acc) +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. From 2a63484221ceb6788f3418a42fb8a7cf939daece Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 29 May 2025 04:47:52 +0800 Subject: [PATCH 10/10] use customize finger --- ghcide/src/Development/IDE/Core/Rules.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 5a9abd5682..83acfc7ed6 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -1251,15 +1251,19 @@ mainRule recorder RulesConfig{..} = do persistentDocMapRule persistentImportMapRule getLinkableRule recorder - defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetModuleGraphTransDepsFingerprints file -> do + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransDepsFingerprints file -> do di <- useNoFile_ GetModuleGraph - return $ lookupFingerprint file di (depTransDepsFingerprints di) - defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetModuleGraphTransReverseDepsFingerprints file -> do + let finger = lookupFingerprint file di (depTransDepsFingerprints di) + return (fingerprintToBS <$> finger, ([], finger)) + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransReverseDepsFingerprints file -> do di <- useNoFile_ GetModuleGraph - return $ lookupFingerprint file di (depTransReverseDepsFingerprints di) - defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetModuleGraphImmediateReverseDepsFingerprints file -> do + let finger = lookupFingerprint file di (depTransReverseDepsFingerprints di) + return (fingerprintToBS <$> finger, ([], finger)) + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphImmediateReverseDepsFingerprints file -> do di <- useNoFile_ GetModuleGraph - return $ lookupFingerprint file di (depImmediateReverseDepsFingerprints di) + let finger = lookupFingerprint file di (depImmediateReverseDepsFingerprints di) + return (fingerprintToBS <$> finger, ([], finger)) + -- | Get HieFile for haskell file on NormalizedFilePath getHieFile :: NormalizedFilePath -> Action (Maybe HieFile)