Skip to content

Commit 4d431e9

Browse files
Clean dependency data structures and speed up GetDependencies (#1368)
* Drop package dependencies (not used anywhere) * expose FindImports module * drop transitiveNamedModuleDeps (not used) * Partially paralellize computation of rawDependencyInformation This only parallelizes the branching step, to truly parallelize the search it would be nice to use monad-par. Unfortunately I cannot find a monad transformer version of it that can be laid on top of the Action monad Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent 12b6a49 commit 4d431e9

File tree

5 files changed

+30
-62
lines changed

5 files changed

+30
-62
lines changed

ghcide/ghcide.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -164,6 +164,7 @@ library
164164
Development.IDE.GHC.Orphans
165165
Development.IDE.GHC.Util
166166
Development.IDE.Import.DependencyInformation
167+
Development.IDE.Import.FindImports
167168
Development.IDE.LSP.HoverDefinition
168169
Development.IDE.LSP.LanguageServer
169170
Development.IDE.LSP.Outline
@@ -207,7 +208,6 @@ library
207208
Development.IDE.Core.FileExists
208209
Development.IDE.GHC.CPP
209210
Development.IDE.GHC.Warnings
210-
Development.IDE.Import.FindImports
211211
Development.IDE.LSP.Notifications
212212
Development.IDE.Plugin.CodeAction.PositionIndexed
213213
Development.IDE.Plugin.Completions.Logic

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

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -26,12 +26,10 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq)
2626
import Development.IDE.Types.KnownTargets
2727
import Data.Hashable
2828
import Data.Typeable
29-
import qualified Data.Set as S
3029
import qualified Data.Map as M
3130
import Development.Shake
3231
import GHC.Generics (Generic)
3332

34-
import Module (InstalledUnitId)
3533
import HscTypes (ModGuts, hm_iface, HomeModInfo, hm_linkable)
3634

3735
import Development.IDE.Spans.Common
@@ -223,9 +221,8 @@ type instance RuleResult GhcSession = HscEnvEq
223221
-- | A GHC session preloaded with all the dependencies
224222
type instance RuleResult GhcSessionDeps = HscEnvEq
225223

226-
-- | Resolve the imports in a module to the file path of a module
227-
-- in the same package or the package id of another package.
228-
type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe ArtifactsLocation)], S.Set InstalledUnitId)
224+
-- | Resolve the imports in a module to the file path of a module in the same package
225+
type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe ArtifactsLocation)]
229226

230227
-- | This rule is used to report import cycles. It depends on GetDependencyInformation.
231228
-- We cannot report the cycles directly from GetDependencyInformation since

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

Lines changed: 18 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,6 @@ import Development.IDE.Types.Location
8282
import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, writeHieFile, TargetModule, TargetFile)
8383
import Development.IDE.GHC.ExactPrint
8484
import Development.IDE.GHC.Util
85-
import Data.Either.Extra
8685
import qualified Development.IDE.Types.Logger as L
8786
import Data.Maybe
8887
import Data.Foldable
@@ -402,17 +401,11 @@ getLocatedImportsRule =
402401
(diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
403402
diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetExists modName mbPkgName isSource
404403
case diagOrImp of
405-
Left diags -> pure (diags, Left (modName, Nothing))
406-
Right (FileImport path) -> pure ([], Left (modName, Just path))
407-
Right (PackageImport pkgId) -> liftIO $ do
408-
diagsOrPkgDeps <- computePackageDeps env pkgId
409-
case diagsOrPkgDeps of
410-
Left diags -> pure (diags, Right Nothing)
411-
Right pkgIds -> pure ([], Right $ Just $ pkgId : pkgIds)
412-
let (moduleImports, pkgImports) = partitionEithers imports'
413-
case sequence pkgImports of
414-
Nothing -> pure (concat diags, Nothing)
415-
Just pkgImports -> pure (concat diags, Just (moduleImports, Set.fromList $ concat pkgImports))
404+
Left diags -> pure (diags, Just (modName, Nothing))
405+
Right (FileImport path) -> pure ([], Just (modName, Just path))
406+
Right PackageImport -> pure ([], Nothing)
407+
let moduleImports = catMaybes imports'
408+
pure (concat diags, Just moduleImports)
416409

417410
type RawDepM a = StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action a
418411

@@ -427,19 +420,23 @@ execRawDepM act =
427420
-- imports recursively.
428421
rawDependencyInformation :: [NormalizedFilePath] -> Action RawDependencyInformation
429422
rawDependencyInformation fs = do
430-
(rdi, ss) <- execRawDepM (mapM_ go fs)
423+
(rdi, ss) <- execRawDepM (goPlural fs)
431424
let bm = IntMap.foldrWithKey (updateBootMap rdi) IntMap.empty ss
432425
return (rdi { rawBootMap = bm })
433426
where
427+
goPlural ff = do
428+
mss <- lift $ (fmap.fmap) fst <$> uses GetModSummaryWithoutTimestamps ff
429+
zipWithM go ff mss
430+
434431
go :: NormalizedFilePath -- ^ Current module being processed
432+
-> Maybe ModSummary -- ^ ModSummary of the module
435433
-> StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action FilePathId
436-
go f = do
434+
go f msum = do
437435
-- First check to see if we have already processed the FilePath
438436
-- If we have, just return its Id but don't update any of the state.
439437
-- Otherwise, we need to process its imports.
440438
checkAlreadyProcessed f $ do
441-
msum <- lift $ fmap fst <$> use GetModSummaryWithoutTimestamps f
442-
let al = modSummaryToArtifactsLocation f msum
439+
let al = modSummaryToArtifactsLocation f msum
443440
-- Get a fresh FilePathId for the new file
444441
fId <- getFreshFid al
445442
-- Adding an edge to the bootmap so we can make sure to
@@ -454,19 +451,19 @@ rawDependencyInformation fs = do
454451
-- elements in the queue
455452
modifyRawDepInfo (insertImport fId (Left ModuleParseError))
456453
return fId
457-
Just (modImports, pkgImports) -> do
454+
Just modImports -> do
458455
-- Get NFPs of the imports which have corresponding files
459456
-- Imports either come locally from a file or from a package.
460457
let (no_file, with_file) = splitImports modImports
461458
(mns, ls) = unzip with_file
462459
-- Recursively process all the imports we just learnt about
463460
-- and get back a list of their FilePathIds
464-
fids <- mapM (go . artifactFilePath) ls
461+
fids <- goPlural $ map artifactFilePath ls
465462
-- Associate together the ModuleName with the FilePathId
466463
let moduleImports' = map (,Nothing) no_file ++ zip mns (map Just fids)
467464
-- Insert into the map the information about this modules
468465
-- imports.
469-
modifyRawDepInfo $ insertImport fId (Right $ ModuleImports moduleImports' pkgImports)
466+
modifyRawDepInfo $ insertImport fId (Right $ ModuleImports moduleImports')
470467
return fId
471468

472469

@@ -612,7 +609,7 @@ getHieAstRuleDefinition f hsc tmr = do
612609
getImportMapRule :: Rules ()
613610
getImportMapRule = define $ \GetImportMap f -> do
614611
im <- use GetLocatedImports f
615-
let mkImports (fileImports, _) = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactFilePath <$> mfp) fileImports
612+
let mkImports fileImports = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactFilePath <$> mfp) fileImports
616613
pure ([], ImportMap . mkImports <$> im)
617614

618615
-- | Ensure that go to definition doesn't block on startup
@@ -857,7 +854,7 @@ isHiFileStableRule = defineEarlyCutoff $ \IsHiFileStable f -> do
857854
if modificationTime x < modificationTime modVersion
858855
then pure SourceModified
859856
else do
860-
(fileImports, _) <- use_ GetLocatedImports f
857+
fileImports <- use_ GetLocatedImports f
861858
let imports = fmap artifactFilePath . snd <$> fileImports
862859
deps <- uses_ IsHiFileStable (catMaybes imports)
863860
pure $ if all (== SourceUnmodifiedAndStable) deps

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

Lines changed: 6 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -46,24 +46,19 @@ import qualified Data.IntMap.Lazy as IntMapLazy
4646
import Data.IntSet (IntSet)
4747
import qualified Data.IntSet as IntSet
4848
import Data.Maybe
49-
import Data.Set (Set)
50-
import qualified Data.Set as Set
5149
import GHC.Generics (Generic)
5250

5351
import Development.IDE.Types.Diagnostics
5452
import Development.IDE.Types.Location
5553
import Development.IDE.Import.FindImports (ArtifactsLocation(..))
5654

5755
import GHC
58-
import Module
5956

6057
-- | The imports for a given module.
61-
data ModuleImports = ModuleImports
62-
{ moduleImports :: ![(Located ModuleName, Maybe FilePathId)]
58+
newtype ModuleImports = ModuleImports
59+
{ moduleImports :: [(Located ModuleName, Maybe FilePathId)]
6360
-- ^ Imports of a module in the current package and the file path of
6461
-- that module on disk (if we found it)
65-
, packageImports :: !(Set InstalledUnitId)
66-
-- ^ Transitive package dependencies unioned for all imports.
6762
} deriving Show
6863

6964
-- | For processing dependency information, we need lots of maps and sets of
@@ -132,10 +127,6 @@ data RawDependencyInformation = RawDependencyInformation
132127
, rawBootMap :: !BootIdMap
133128
} deriving Show
134129

135-
pkgDependencies :: RawDependencyInformation -> FilePathIdMap (Set InstalledUnitId)
136-
pkgDependencies RawDependencyInformation{..} =
137-
IntMap.map (either (const Set.empty) packageImports) rawImports
138-
139130
data DependencyInformation =
140131
DependencyInformation
141132
{ depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError))
@@ -146,8 +137,6 @@ data DependencyInformation =
146137
-- in the same package.
147138
, depReverseModuleDeps :: !(IntMap IntSet)
148139
-- ^ Contains a reverse mapping from a module to all those that immediately depend on it.
149-
, depPkgDeps :: !(FilePathIdMap (Set InstalledUnitId))
150-
-- ^ For a non-error node, this contains the set of immediate pkg deps.
151140
, depPathIdMap :: !PathIdMap
152141
-- ^ Map from FilePath to FilePathId
153142
, depBootMap :: !BootIdMap
@@ -222,13 +211,12 @@ instance Semigroup NodeResult where
222211
SuccessNode a <> SuccessNode _ = SuccessNode a
223212

224213
processDependencyInformation :: RawDependencyInformation -> DependencyInformation
225-
processDependencyInformation rawDepInfo@RawDependencyInformation{..} =
214+
processDependencyInformation RawDependencyInformation{..} =
226215
DependencyInformation
227216
{ depErrorNodes = IntMap.fromList errorNodes
228217
, depModuleDeps = moduleDeps
229218
, depReverseModuleDeps = reverseModuleDeps
230219
, depModuleNames = IntMap.fromList $ coerce moduleNames
231-
, depPkgDeps = pkgDependencies rawDepInfo
232220
, depPathIdMap = rawPathIdMap
233221
, depBootMap = rawBootMap
234222
}
@@ -248,8 +236,8 @@ processDependencyInformation rawDepInfo@RawDependencyInformation{..} =
248236
successEdges
249237
reverseModuleDeps =
250238
foldr (\(p, cs) res ->
251-
let new = IntMap.fromList (map (, IntSet.singleton (coerce p)) (coerce cs))
252-
in IntMap.unionWith IntSet.union new res ) IntMap.empty successEdges
239+
let new = IntMap.fromList (map (, IntSet.singleton (coerce p)) (coerce cs))
240+
in IntMap.unionWith IntSet.union new res ) IntMap.empty successEdges
253241

254242

255243
-- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows:
@@ -345,17 +333,8 @@ transitiveDeps DependencyInformation{..} file = do
345333
reachable g <$> toVertex (getFilePathId fileId)
346334
let transitiveModuleDepIds =
347335
filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs
348-
let transitivePkgDeps =
349-
Set.toList $ Set.unions $
350-
map (\f -> IntMap.findWithDefault Set.empty f depPkgDeps) $
351-
getFilePathId fileId : transitiveModuleDepIds
352336
let transitiveModuleDeps =
353337
map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds
354-
let transitiveNamedModuleDeps =
355-
[ NamedModuleDep (idToPath depPathIdMap (FilePathId fid)) mn artifactModLocation
356-
| (fid, ShowableModuleName mn) <- IntMap.toList depModuleNames
357-
, let ArtifactsLocation{artifactModLocation} = idToPathMap depPathIdMap IntMap.! fid
358-
]
359338
pure TransitiveDependencies {..}
360339
where
361340
(g, fromVertex, toVertex) = graphFromEdges edges
@@ -369,15 +348,10 @@ transitiveDeps DependencyInformation{..} file = do
369348

370349
vs = topSort g
371350

372-
data TransitiveDependencies = TransitiveDependencies
351+
newtype TransitiveDependencies = TransitiveDependencies
373352
{ transitiveModuleDeps :: [NormalizedFilePath]
374353
-- ^ Transitive module dependencies in topological order.
375354
-- The module itself is not included.
376-
, transitiveNamedModuleDeps :: [NamedModuleDep]
377-
-- ^ Transitive module dependencies in topological order.
378-
-- The module itself is not included.
379-
, transitivePkgDeps :: [InstalledUnitId]
380-
-- ^ Transitive pkg dependencies in unspecified order.
381355
} deriving (Eq, Show, Generic)
382356

383357
instance NFData TransitiveDependencies

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ import Data.List (isSuffixOf)
3737

3838
data Import
3939
= FileImport !ArtifactsLocation
40-
| PackageImport !M.InstalledUnitId
40+
| PackageImport
4141
deriving (Show)
4242

4343
data ArtifactsLocation = ArtifactsLocation
@@ -55,7 +55,7 @@ isBootLocation = not . artifactIsSource
5555

5656
instance NFData Import where
5757
rnf (FileImport x) = rnf x
58-
rnf (PackageImport x) = rnf x
58+
rnf PackageImport = ()
5959

6060
modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
6161
modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source
@@ -137,7 +137,7 @@ locateModule dflags comp_info exts doesExist modName mbPkgName isSource = do
137137

138138
lookupInPackageDB dfs =
139139
case lookupModuleWithSuggestions dfs (unLoc modName) mbPkgName of
140-
LookupFound _m pkgConfig -> return $ Right $ PackageImport $ unitId pkgConfig
140+
LookupFound _m _pkgConfig -> return $ Right PackageImport
141141
reason -> return $ Left $ notFoundErr dfs modName reason
142142

143143
-- | Don't call this on a found module.

0 commit comments

Comments
 (0)