From 55f204b9a4979e11e86fa1625e910231c3cdb3a2 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Mon, 5 Aug 2019 09:31:14 +0200 Subject: [PATCH] Speed up dependency chasing (#2383) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- src/Development/IDE/Core/RuleTypes.hs | 10 +++-- src/Development/IDE/Core/Rules.hs | 43 ++++++++----------- .../IDE/Import/DependencyInformation.hs | 13 +++--- 3 files changed, 29 insertions(+), 37 deletions(-) diff --git a/src/Development/IDE/Core/RuleTypes.hs b/src/Development/IDE/Core/RuleTypes.hs index 571f1b1e..15d59be1 100644 --- a/src/Development/IDE/Core/RuleTypes.hs +++ b/src/Development/IDE/Core/RuleTypes.hs @@ -12,14 +12,16 @@ module Development.IDE.Core.RuleTypes( ) where import Control.DeepSeq -import Development.IDE.Import.FindImports (Import(..)) import Development.IDE.Import.DependencyInformation +import Development.IDE.Types.Location import Data.Hashable import Data.Typeable +import qualified Data.Set as S import Development.Shake hiding (Env, newCache) import GHC.Generics (Generic) import GHC +import Module (InstalledUnitId) import HscTypes (HomeModInfo) import Development.IDE.GHC.Compat @@ -66,9 +68,9 @@ type instance RuleResult GenerateCore = CoreModule -- | A GHC session that we reuse. type instance RuleResult GhcSession = HscEnv --- | Resolve the imports in a module to the list of either external packages or absolute file paths --- for modules in the same package. -type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe Import)] +-- | Resolve the imports in a module to the file path of a module +-- in the same package or the package id of another package. +type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe NormalizedFilePath)], S.Set InstalledUnitId) -- | This rule is used to report import cycles. It depends on GetDependencyInformation. -- We cannot report the cycles directly from GetDependencyInformation since diff --git a/src/Development/IDE/Core/Rules.hs b/src/Development/IDE/Core/Rules.hs index 1ff2a008..fbcee332 100644 --- a/src/Development/IDE/Core/Rules.hs +++ b/src/Development/IDE/Core/Rules.hs @@ -36,7 +36,6 @@ import Development.IDE.Import.FindImports import Development.IDE.Core.FileStore import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location -import Data.Bifunctor import Data.Either.Extra import Data.Maybe import Data.Foldable @@ -186,9 +185,20 @@ getLocatedImportsRule = env <- useNoFile_ GhcSession let dflags = addRelativeImport pm $ hsc_dflags env opt <- getIdeOptions - xs <- forM imports $ \(mbPkgName, modName) -> - (modName, ) <$> locateModule dflags (optExtensions opt) getFileExists modName mbPkgName - return (concat $ lefts $ map snd xs, Just $ map (second eitherToMaybe) xs) + (diags, imports') <- fmap unzip $ forM imports $ \(mbPkgName, modName) -> do + diagOrImp <- locateModule dflags (optExtensions opt) getFileExists modName mbPkgName + case diagOrImp of + Left diags -> pure (diags, Left (modName, Nothing)) + Right (FileImport path) -> pure ([], Left (modName, Just path)) + Right (PackageImport pkgId) -> liftIO $ do + diagsOrPkgDeps <- computePackageDeps env pkgId + case diagsOrPkgDeps of + Left diags -> pure (diags, Right Nothing) + Right pkgIds -> pure ([], Right $ Just $ pkgId : pkgIds) + let (moduleImports, pkgImports) = partitionEithers imports' + case sequence pkgImports of + Nothing -> pure (concat diags, Nothing) + Just pkgImports -> pure (concat diags, Just (moduleImports, Set.fromList $ concat pkgImports)) -- | 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 Nothing -> let modGraph' = Map.insert f (Left ModuleParseError) modGraph in go fs modGraph' pkgs - Just imports -> do - packageState <- lift $ useNoFile_ GhcSession - modOrPkgImports <- forM imports $ \imp -> do - case imp of - (_modName, Just (PackageImport pkg)) -> do - pkgs <- ExceptT $ liftIO $ computePackageDeps packageState pkg - pure $ Right $ pkg:pkgs - (modName, Just (FileImport absFile)) -> pure $ Left (modName, Just absFile) - (modName, Nothing) -> pure $ Left (modName, Nothing) - let (modImports, pkgImports) = partitionEithers modOrPkgImports + Just (modImports, pkgImports) -> do let newFiles = Set.fromList (mapMaybe snd modImports) Set.\\ Map.keysSet modGraph modGraph' = Map.insert f (Right modImports) modGraph - pkgs' = Map.insert f (Set.fromList $ concat pkgImports) pkgs + pkgs' = Map.insert f pkgImports pkgs go (fs `Set.union` newFiles) modGraph' pkgs' getDependencyInformationRule :: Rules () @@ -270,9 +271,9 @@ getSpanInfoRule :: Rules () getSpanInfoRule = define $ \GetSpanInfo file -> do tc <- use_ TypeCheck file - imports <- use_ GetLocatedImports file + (fileImports, _) <- use_ GetLocatedImports file packageState <- useNoFile_ GhcSession - x <- liftIO $ getSrcSpanInfos packageState (fileImports imports) tc + x <- liftIO $ getSrcSpanInfos packageState fileImports tc return ([], Just x) -- Typechecks a module. @@ -328,11 +329,3 @@ mainRule = do fileFromParsedModule :: ParsedModule -> NormalizedFilePath fileFromParsedModule = toNormalizedFilePath . ms_hspp_file . pm_mod_summary - -fileImports :: - [(Located ModuleName, Maybe Import)] - -> [(Located ModuleName, Maybe NormalizedFilePath)] -fileImports = mapMaybe $ \case - (modName, Nothing) -> Just (modName, Nothing) - (modName, Just (FileImport absFile)) -> Just (modName, Just absFile) - (_modName, Just (PackageImport _pkg)) -> Nothing diff --git a/src/Development/IDE/Import/DependencyInformation.hs b/src/Development/IDE/Import/DependencyInformation.hs index 8b69098d..b1587361 100644 --- a/src/Development/IDE/Import/DependencyInformation.hs +++ b/src/Development/IDE/Import/DependencyInformation.hs @@ -13,9 +13,9 @@ module Development.IDE.Import.DependencyInformation import Control.DeepSeq import Data.Bifunctor +import Data.List import Development.IDE.GHC.Orphans() import Data.Either -import Data.Foldable import Data.Graph import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import qualified Data.List.NonEmpty as NonEmpty @@ -113,20 +113,17 @@ instance Semigroup NodeResult where processDependencyInformation :: RawDependencyInformation -> DependencyInformation processDependencyInformation rawResults = DependencyInformation - { depErrorNodes = MS.mapMaybe errorNode resultGraph + { depErrorNodes = MS.fromList errorNodes , depModuleDeps = moduleDeps , depPkgDeps = pkgDependencies rawResults } where resultGraph = buildResultGraph rawResults + (errorNodes, successNodes) = partitionNodeResults $ MS.toList resultGraph successEdges :: [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])] - successEdges = map (\(k,ks) -> (k,k,ks)) $ MS.toList $ - MS.map (map snd) $ MS.mapMaybe successNode resultGraph + successEdges = + map (\(file, imports) -> (file, file, map snd imports)) successNodes moduleDeps = MS.fromList $ map (\(_, v, vs) -> (v, Set.fromList vs)) successEdges - errorNode (ErrorNode errs) = Just errs - errorNode _ = Nothing - successNode (SuccessNode fs) = Just fs - successNode _ = Nothing -- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows: -- 1. Mark each node that is part of an import cycle as an error node.