Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 1931d4c

Browse files
Refactor dependency graph handling by introducing useTransDepModuleGraph and filterDependencyInformationReachable functions
1 parent 997a426 commit 1931d4c

File tree

4 files changed

+71
-21
lines changed

4 files changed

+71
-21
lines changed

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

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -262,9 +262,12 @@ typecheckParents :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePat
262262
typecheckParents recorder state nfp = void $ shakeEnqueue (shakeExtras state) parents
263263
where parents = mkDelayedAction "ParentTC" L.Debug (typecheckParentsAction recorder nfp)
264264

265+
266+
useReverseTransDeps :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])
267+
useReverseTransDeps file = transitiveReverseDependencies file <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file
265268
typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action ()
266269
typecheckParentsAction recorder nfp = do
267-
revs <- transitiveReverseDependencies nfp <$> useWithSeparateFingerprintRule_ GetModuleGraphTransReverseDepsFingerprintsGetModuleGraph nfp
270+
revs <- useReverseTransDeps nfp
268271
case revs of
269272
Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp
270273
Just rs -> do

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

Lines changed: 20 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module Development.IDE.Core.Rules(
1212
-- * Types
1313
IdeState, GetParsedModule(..), TransitiveDependencies(..),
1414
GhcSessionIO(..), GetClientSettings(..),
15+
useTransDepModuleGraph,
1516
-- * Functions
1617
runAction,
1718
toIdeResult,
@@ -472,7 +473,7 @@ rawDependencyInformation fs = do
472473
reportImportCyclesRule :: Recorder (WithPriority Log) -> Rules ()
473474
reportImportCyclesRule recorder =
474475
defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \ReportImportCycles file -> fmap (\errs -> if null errs then (Just "1",([], Just ())) else (Nothing, (errs, Nothing))) $ do
475-
DependencyInformation{..} <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprintsGetModuleGraph file
476+
DependencyInformation {depErrorNodes, depPathIdMap} <- useTransDepModuleGraph file
476477
case pathToId depPathIdMap file of
477478
-- The header of the file does not parse, so it can't be part of any import cycles.
478479
Nothing -> pure []
@@ -633,17 +634,17 @@ dependencyInfoForFiles fs = do
633634
(rawDepInfo, bm) <- rawDependencyInformation fs
634635
let (all_fs, _all_ids) = unzip $ HM.toList $ pathToIdMap $ rawPathIdMap rawDepInfo
635636
msrs <- uses GetModSummaryWithoutTimestamps all_fs
636-
let mss = map (fmap msrModSummary) msrs
637+
let mss = zip _all_ids $map (fmap msrModSummary) msrs
637638
let deps = map (\i -> IM.lookup (getFilePathId i) (rawImports rawDepInfo)) _all_ids
638-
nodeKeys = IM.fromList $ catMaybes $ zipWith (\fi mms -> (getFilePathId fi,) . NodeKey_Module . msKey <$> mms) _all_ids mss
639+
nodeKeys = IM.fromList $ catMaybes $ zipWith (\fi (_, mms) -> (getFilePathId fi,) . NodeKey_Module . msKey <$> mms) _all_ids mss
639640
mns = catMaybes $ zipWith go mss deps
640-
go (Just ms) (Just (Right (ModuleImports xs))) = Just $ ModuleNode this_dep_keys ms
641+
go (pid,Just ms) (Just (Right (ModuleImports xs))) = Just $ (pid, ModuleNode this_dep_keys ms)
641642
where this_dep_ids = mapMaybe snd xs
642643
this_dep_keys = mapMaybe (\fi -> IM.lookup (getFilePathId fi) nodeKeys) this_dep_ids
643-
go (Just ms) _ = Just $ ModuleNode [] ms
644+
go (pid, Just ms) _ = Just $ (pid, ModuleNode [] ms)
644645
go _ _ = Nothing
645-
mg = mkModuleGraph mns
646-
let shallowFingers = IntMap.fromList $ foldr' (\(i, m) acc -> case m of
646+
mg = IntMap.fromList $map (first getFilePathId) mns
647+
let shallowFingers = IntMap.fromList $! foldr' (\(i, m) acc -> case m of
647648
Just x -> (getFilePathId i,msrFingerprint x):acc
648649
Nothing -> acc) [] $ zip _all_ids msrs
649650
pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg shallowFingers)
@@ -663,7 +664,7 @@ typeCheckRuleDefinition hsc pm fp = do
663664
unlift <- askUnliftIO
664665
let dets = TypecheckHelpers
665666
{ getLinkables = unliftIO unlift . uses_ GetLinkable
666-
, getModuleGraph = unliftIO unlift $ useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprintsGetModuleGraph fp
667+
, getModuleGraph = unliftIO unlift $ useTransDepModuleGraph fp
667668
}
668669
addUsageDependencies $ liftIO $
669670
typecheckModule defer hsc dets pm
@@ -735,6 +736,11 @@ instance Default GhcSessionDepsConfig where
735736
{ fullModuleGraph = True
736737
}
737738

739+
useTransDepModuleGraph :: NormalizedFilePath -> Action DependencyInformation
740+
useTransDepModuleGraph file = filterDependencyInformationReachable file <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file
741+
useImmediateDepsModuleGraph :: NormalizedFilePath -> Action (Maybe DependencyInformation)
742+
useImmediateDepsModuleGraph file = useWithSeparateFingerprintRule GetModuleGraphTransDepsFingerprints GetModuleGraph file
743+
738744
-- | Note [GhcSessionDeps]
739745
-- ~~~~~~~~~~~~~~~~~~~~~
740746
-- For a file 'Foo', GhcSessionDeps "Foo.hs" results in an HscEnv which includes
@@ -760,10 +766,10 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
760766
depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps
761767
ifaces <- uses_ GetModIface deps
762768
let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces
763-
de <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprintsGetModuleGraph file
764-
mg <- do
769+
de <- useTransDepModuleGraph file
770+
mg <- mkModuleGraph <$>do
765771
if fullModuleGraph
766-
then return $ depModuleGraph de
772+
then return $ IntMap.elems $depModuleGraph de
767773
else do
768774
let mgs = map hsc_mod_graph depSessions
769775
-- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph
@@ -775,7 +781,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
775781
let module_graph_nodes =
776782
nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)
777783
liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes
778-
return $ mkModuleGraph module_graph_nodes
784+
return module_graph_nodes
779785
session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions
780786

781787
-- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new
@@ -805,7 +811,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
805811
, old_value = m_old
806812
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
807813
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs
808-
, get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprintsGetModuleGraph f
814+
, get_module_graph = useTransDepModuleGraph f
809815
, regenerate = regenerateHiFile session f ms
810816
}
811817
hsc_env' <- setFileCacheHook (hscEnv session)
@@ -1139,7 +1145,7 @@ needsCompilationRule file
11391145
| "boot" `isSuffixOf` fromNormalizedFilePath file =
11401146
pure (Just $ encodeLinkableType Nothing, Just Nothing)
11411147
needsCompilationRule file = do
1142-
graph <- useWithSeparateFingerprintRule GetModuleGraphImmediateReverseDepsFingerprintsGetModuleGraph file
1148+
graph <- useImmediateDepsModuleGraph file
11431149
res <- case graph of
11441150
-- Treat as False if some reverse dependency header fails to parse
11451151
Nothing -> pure Nothing

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

Lines changed: 45 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44

55
module Development.IDE.Import.DependencyInformation
66
( DependencyInformation(..)
7+
, filterDependencyInformationReachable
78
, ModuleImports(..)
89
, RawDependencyInformation(..)
910
, NodeError(..)
@@ -137,6 +138,26 @@ data RawDependencyInformation = RawDependencyInformation
137138
, rawModuleMap :: !(FilePathIdMap ShowableModule)
138139
} deriving Show
139140

141+
filterFilePathIdMap :: (IntMap.Key -> Bool) -> FilePathIdMap a -> FilePathIdMap a
142+
filterFilePathIdMap p = IntMap.filterWithKey (\k _ -> p k)
143+
144+
filterDependencyInformationReachable :: NormalizedFilePath -> DependencyInformation -> DependencyInformation
145+
filterDependencyInformationReachable fileId depInfo@DependencyInformation{..} =
146+
let reachableIds = transitiveDepIds depInfo fileId
147+
curId = getFilePathId <$> lookupPathToId depPathIdMap fileId
148+
isReachable k = IntSet.member k reachableIds || Just k == curId
149+
filterMap = filterFilePathIdMap isReachable
150+
rawModDeps = filterMap depModules
151+
in depInfo {
152+
depErrorNodes = filterMap depErrorNodes
153+
, depModules = rawModDeps
154+
, depModuleDeps = filterMap depModuleDeps
155+
, depReverseModuleDeps = filterMap depReverseModuleDeps
156+
, depBootMap = filterMap depBootMap
157+
, depModuleGraph = filterMap depModuleGraph
158+
, depModuleFiles = ShowableModuleEnv $ mkModuleEnv $ map (\(i,sm) -> (showableModule sm, FilePathId i)) $ IntMap.toList rawModDeps
159+
}
160+
140161
data DependencyInformation =
141162
DependencyInformation
142163
{ depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError))
@@ -153,7 +174,7 @@ data DependencyInformation =
153174
-- ^ Map from hs-boot file to the corresponding hs file
154175
, depModuleFiles :: !(ShowableModuleEnv FilePathId)
155176
-- ^ Map from Module to the corresponding non-boot hs file
156-
, depModuleGraph :: !ModuleGraph
177+
, depModuleGraph :: !(FilePathIdMapModuleGraphNode)
157178
, depTransDepsFingerprints :: !(FilePathIdMap Fingerprint)
158179
-- ^ Map from Module to fingerprint of the transitive dependencies of the module.
159180
, depTransReverseDepsFingerprints :: !(FilePathIdMap Fingerprint)
@@ -187,7 +208,10 @@ reachableModules DependencyInformation{..} =
187208
map (idToPath depPathIdMap . FilePathId) $ IntMap.keys depErrorNodes <> IntMap.keys depModuleDeps
188209

189210
instance NFData DependencyInformation
190-
211+
instance NFData ModuleGraphNode where
212+
rnf = rwhnf
213+
instance Show (ModuleGraphNode) where
214+
show (_) = "ModuleGraphNode"
191215
-- | This does not contain the actual parse error as that is already reported by GetParsedModule.
192216
data ModuleParseError = ModuleParseError
193217
deriving (Show, Generic)
@@ -243,7 +267,7 @@ instance Semigroup NodeResult where
243267
SuccessNode _ <> ErrorNode errs = ErrorNode errs
244268
SuccessNode a <> SuccessNode _ = SuccessNode a
245269

246-
processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> FilePathIdMap Fingerprint -> DependencyInformation
270+
processDependencyInformation :: RawDependencyInformation -> BootIdMap -> FilePathIdMapModuleGraphNode -> FilePathIdMap Fingerprint -> DependencyInformation
247271
processDependencyInformation RawDependencyInformation{..} rawBootMap mg shallowFingerMap =
248272
DependencyInformation
249273
{ depErrorNodes = IntMap.fromList errorNodes
@@ -359,6 +383,23 @@ immediateReverseDependencies file DependencyInformation{..} = do
359383
FilePathId cur_id <- lookupPathToId depPathIdMap file
360384
return $ map (idToPath depPathIdMap . FilePathId) (maybe mempty IntSet.toList (IntMap.lookup cur_id depReverseModuleDeps))
361385

386+
-- | returns all transitive dependencies ids
387+
transitiveDepIds :: DependencyInformation -> NormalizedFilePath -> IntSet.IntSet
388+
transitiveDepIds DependencyInformation{..} file = fromMaybe mempty $ do
389+
!fileId <- pathToId depPathIdMap file
390+
reachableVs <-
391+
-- Delete the starting node
392+
IntSet.delete (getFilePathId fileId) .
393+
IntSet.fromList . map (fst3 . fromVertex) .
394+
reachable g <$> toVertex (getFilePathId fileId)
395+
let transitiveModuleDepIds = IntSet.fromList $ filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs
396+
return transitiveModuleDepIds
397+
where
398+
(g, fromVertex, toVertex) = graphFromEdges edges
399+
edges = map (\(f, fs) -> (f, f, IntSet.toList fs ++ boot_edge f)) $ IntMap.toList depModuleDeps
400+
boot_edge f = [getFilePathId f' | Just f' <- [IntMap.lookup f depBootMap]]
401+
vs = vertices g
402+
362403
-- | returns all transitive dependencies in topological order.
363404
transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies
364405
transitiveDeps DependencyInformation{..} file = do
@@ -372,7 +413,7 @@ transitiveDeps DependencyInformation{..} file = do
372413
filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs
373414
let transitiveModuleDeps =
374415
map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds
375-
pure TransitiveDependencies {..}
416+
pure TransitiveDependencies {transitiveModuleDeps}
376417
where
377418
(g, fromVertex, toVertex) = graphFromEdges edges
378419
edges = map (\(f, fs) -> (f, f, IntSet.toList fs ++ boot_edge f)) $ IntMap.toList depModuleDeps

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ import qualified Data.Text as T
4343
import qualified Data.Text.Utf16.Rope.Mixed as Rope
4444
import Development.IDE.Core.FileStore (getUriContents, setSomethingModified)
4545
import Development.IDE.Core.Rules (IdeState,
46-
runAction)
46+
runAction, useTransDepModuleGraph)
4747
import Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)
4848
import Development.IDE.GHC.Compat hiding (typeKind,
4949
unitState)
@@ -253,7 +253,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do
253253
ms <- msrModSummary <$> use_ GetModSummary nfp
254254
deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp
255255

256-
linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprintsGetModuleGraph nfp <*> pure nfp
256+
linkables_needed <- transitiveDeps <$> useTransDepModuleGraph nfp <*> pure nfp
257257
linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)
258258
-- We unset the global rdr env in mi_globals when we generate interfaces
259259
-- See Note [Clearing mi_globals after generating an iface]

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /