on master help sign in
Speed up dependency chasing (#2383)

This PR moves as much work as possible to GetLocatedImports which contracry to GetDependencyInformation is shared between rules. It’s still slower than it should be and somewhat messy but at least it’s slightly faster and imho cleaner than before.

commit55f204b9a4979e11e86fa1625e910231c3cdb3a2 authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org> dateMon 5 Aug 2019, 09:31 (7 years ago) parent54fceea
3 files changed+29−37
src/Development/IDE/Core/RuleTypes.hs+6−4 src/Development/IDE/Core/Rules.hs+18−25 src/Development/IDE/Import/DependencyInformation.hs+5−8
src/Development/IDE/Core/RuleTypes.hs+6−4
@@ -12,14 +12,16 @@ module Development.IDE.Core.RuleTypes(
1212 ) where
1313
1414import Control.DeepSeq
15−import Development.IDE.Import.FindImports (Import(..))
1615import Development.IDE.Import.DependencyInformation
16+import Development.IDE.Types.Location
1717import Data.Hashable
1818import Data.Typeable
19+import qualified Data.Set as S
1920import Development.Shake hiding (Env, newCache)
2021import GHC.Generics (Generic)
2122
2223import GHC
24+import Module (InstalledUnitId)
2325import HscTypes (HomeModInfo)
2426import Development.IDE.GHC.Compat
2527
@@ -66,9 +68,9 @@ type instance RuleResult GenerateCore = CoreModule
6668-- | A GHC session that we reuse.
6769type instance RuleResult GhcSession = HscEnv
6870
69−-- | Resolve the imports in a module to the list of either external packages or absolute file paths
70−-- for modules in the same package.
71−type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe Import)]
71+-- | Resolve the imports in a module to the file path of a module
72+-- in the same package or the package id of another package.
73+type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe NormalizedFilePath)], S.Set InstalledUnitId)
7274
7375-- | This rule is used to report import cycles. It depends on GetDependencyInformation.
7476-- We cannot report the cycles directly from GetDependencyInformation since
src/Development/IDE/Core/Rules.hs+18−25
@@ -36,7 +36,6 @@ import Development.IDE.Import.FindImports
3636import Development.IDE.Core.FileStore
3737import Development.IDE.Types.Diagnostics
3838import Development.IDE.Types.Location
39−import Data.Bifunctor
4039import Data.Either.Extra
4140import Data.Maybe
4241import Data.Foldable
@@ -186,9 +185,20 @@ getLocatedImportsRule =
186185 env <- useNoFile_ GhcSession
187186 let dflags = addRelativeImport pm $ hsc_dflags env
188187 opt <- getIdeOptions
189− xs <- forM imports $ \(mbPkgName, modName) ->
190− (modName, ) <$> locateModule dflags (optExtensions opt) getFileExists modName mbPkgName
191− return (concat $ lefts $ map snd xs, Just $ map (second eitherToMaybe) xs)
188+ (diags, imports') <- fmap unzip $ forM imports $ \(mbPkgName, modName) -> do
189+ diagOrImp <- locateModule dflags (optExtensions opt) getFileExists modName mbPkgName
190+ case diagOrImp of
191+ Left diags -> pure (diags, Left (modName, Nothing))
192+ Right (FileImport path) -> pure ([], Left (modName, Just path))
193+ Right (PackageImport pkgId) -> liftIO $ do
194+ diagsOrPkgDeps <- computePackageDeps env pkgId
195+ case diagsOrPkgDeps of
196+ Left diags -> pure (diags, Right Nothing)
197+ Right pkgIds -> pure ([], Right $ Just $ pkgId : pkgIds)
198+ let (moduleImports, pkgImports) = partitionEithers imports'
199+ case sequence pkgImports of
200+ Nothing -> pure (concat diags, Nothing)
201+ Just pkgImports -> pure (concat diags, Just (moduleImports, Set.fromList $ concat pkgImports))
192202
193203
194204-- | Given a target file path, construct the raw dependency results by following
@@ -204,19 +214,10 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty
204214 Nothing ->
205215 let modGraph' = Map.insert f (Left ModuleParseError) modGraph
206216 in go fs modGraph' pkgs
207− Just imports -> do
208− packageState <- lift $ useNoFile_ GhcSession
209− modOrPkgImports <- forM imports $ \imp -> do
210− case imp of
211− (_modName, Just (PackageImport pkg)) -> do
212− pkgs <- ExceptT $ liftIO $ computePackageDeps packageState pkg
213− pure $ Right $ pkg:pkgs
214− (modName, Just (FileImport absFile)) -> pure $ Left (modName, Just absFile)
215− (modName, Nothing) -> pure $ Left (modName, Nothing)
216− let (modImports, pkgImports) = partitionEithers modOrPkgImports
217+ Just (modImports, pkgImports) -> do
217218 let newFiles = Set.fromList (mapMaybe snd modImports) Set.\\ Map.keysSet modGraph
218219 modGraph' = Map.insert f (Right modImports) modGraph
219− pkgs' = Map.insert f (Set.fromList $ concat pkgImports) pkgs
220+ pkgs' = Map.insert f pkgImports pkgs
220221 go (fs `Set.union` newFiles) modGraph' pkgs'
221222
222223getDependencyInformationRule :: Rules ()
@@ -270,9 +271,9 @@ getSpanInfoRule :: Rules ()
270271getSpanInfoRule =
271272 define $ \GetSpanInfo file -> do
272273 tc <- use_ TypeCheck file
273− imports <- use_ GetLocatedImports file
274+ (fileImports, _) <- use_ GetLocatedImports file
274275 packageState <- useNoFile_ GhcSession
275− x <- liftIO $ getSrcSpanInfos packageState (fileImports imports) tc
276+ x <- liftIO $ getSrcSpanInfos packageState fileImports tc
276277 return ([], Just x)
277278
278279-- Typechecks a module.
@@ -328,11 +329,3 @@ mainRule = do
328329
329330fileFromParsedModule :: ParsedModule -> NormalizedFilePath
330331fileFromParsedModule = toNormalizedFilePath . ms_hspp_file . pm_mod_summary
331−
332−fileImports ::
333− [(Located ModuleName, Maybe Import)]
334− -> [(Located ModuleName, Maybe NormalizedFilePath)]
335−fileImports = mapMaybe $ \case
336− (modName, Nothing) -> Just (modName, Nothing)
337− (modName, Just (FileImport absFile)) -> Just (modName, Just absFile)
338− (_modName, Just (PackageImport _pkg)) -> Nothing
src/Development/IDE/Import/DependencyInformation.hs+5−8
@@ -13,9 +13,9 @@ module Development.IDE.Import.DependencyInformation
1313
1414import Control.DeepSeq
1515import Data.Bifunctor
16+import Data.List
1617import Development.IDE.GHC.Orphans()
1718import Data.Either
18−import Data.Foldable
1919import Data.Graph
2020import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
2121import qualified Data.List.NonEmpty as NonEmpty
@@ -113,20 +113,17 @@ instance Semigroup NodeResult where
113113processDependencyInformation :: RawDependencyInformation -> DependencyInformation
114114processDependencyInformation rawResults =
115115 DependencyInformation
116− { depErrorNodes = MS.mapMaybe errorNode resultGraph
116+ { depErrorNodes = MS.fromList errorNodes
117117 , depModuleDeps = moduleDeps
118118 , depPkgDeps = pkgDependencies rawResults
119119 }
120120 where resultGraph = buildResultGraph rawResults
121+ (errorNodes, successNodes) = partitionNodeResults $ MS.toList resultGraph
121122 successEdges :: [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])]
122− successEdges = map (\(k,ks) -> (k,k,ks)) $ MS.toList $
123− MS.map (map snd) $ MS.mapMaybe successNode resultGraph
123+ successEdges =
124+ map (\(file, imports) -> (file, file, map snd imports)) successNodes
124125 moduleDeps =
125126 MS.fromList $ map (\(_, v, vs) -> (v, Set.fromList vs)) successEdges
126− errorNode (ErrorNode errs) = Just errs
127− errorNode _ = Nothing
128− successNode (SuccessNode fs) = Just fs
129− successNode _ = Nothing
130127
131128-- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows:
132129-- 1. Mark each node that is part of an import cycle as an error node.