From 2cfe4dbe9fc3adaba45fd2ac072b90ed9f127de2 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 12 Feb 2021 19:12:53 +0000 Subject: [PATCH 1/4] Drop package dependencies (not used anywhere) --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 7 ++--- ghcide/src/Development/IDE/Core/Rules.hs | 25 ++++++----------- .../IDE/Import/DependencyInformation.hs | 28 ++++--------------- .../src/Development/IDE/Import/FindImports.hs | 6 ++-- 4 files changed, 19 insertions(+), 47 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 2f7f817f8b..5abff60949 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -26,12 +26,10 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq) import Development.IDE.Types.KnownTargets import Data.Hashable import Data.Typeable -import qualified Data.Set as S import qualified Data.Map as M import Development.Shake import GHC.Generics (Generic) -import Module (InstalledUnitId) import HscTypes (ModGuts, hm_iface, HomeModInfo, hm_linkable) import Development.IDE.Spans.Common @@ -223,9 +221,8 @@ type instance RuleResult GhcSession = HscEnvEq -- | A GHC session preloaded with all the dependencies type instance RuleResult GhcSessionDeps = HscEnvEq --- | 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 ArtifactsLocation)], S.Set InstalledUnitId) +-- | Resolve the imports in a module to the file path of a module in the same package +type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe ArtifactsLocation)] -- | This rule is used to report import cycles. It depends on GetDependencyInformation. -- We cannot report the cycles directly from GetDependencyInformation since diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index fdece3ae2f..ba6abee866 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -83,7 +83,6 @@ import Development.IDE.Types.Location import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, writeHieFile, TargetModule, TargetFile) import Development.IDE.GHC.ExactPrint import Development.IDE.GHC.Util -import Data.Either.Extra import qualified Development.IDE.Types.Logger as L import Data.Maybe import Data.Foldable @@ -402,17 +401,11 @@ getLocatedImportsRule = (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetExists modName mbPkgName isSource 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)) + Left diags -> pure (diags, Just (modName, Nothing)) + Right (FileImport path) -> pure ([], Just (modName, Just path)) + Right PackageImport -> pure ([], Nothing) + let moduleImports = catMaybes imports' + pure (concat diags, Just moduleImports) type RawDepM a = StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action a @@ -454,7 +447,7 @@ rawDependencyInformation fs = do -- elements in the queue modifyRawDepInfo (insertImport fId (Left ModuleParseError)) return fId - Just (modImports, pkgImports) -> do + Just modImports -> do -- Get NFPs of the imports which have corresponding files -- Imports either come locally from a file or from a package. let (no_file, with_file) = splitImports modImports @@ -466,7 +459,7 @@ rawDependencyInformation fs = do let moduleImports' = map (,Nothing) no_file ++ zip mns (map Just fids) -- Insert into the map the information about this modules -- imports. - modifyRawDepInfo $ insertImport fId (Right $ ModuleImports moduleImports' pkgImports) + modifyRawDepInfo $ insertImport fId (Right $ ModuleImports moduleImports') return fId @@ -612,7 +605,7 @@ getHieAstRuleDefinition f hsc tmr = do getImportMapRule :: Rules () getImportMapRule = define $ \GetImportMap f -> do im <- use GetLocatedImports f - let mkImports (fileImports, _) = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactFilePath <$> mfp) fileImports + let mkImports fileImports = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactFilePath <$> mfp) fileImports pure ([], ImportMap . mkImports <$> im) -- | Ensure that go to definition doesn't block on startup @@ -857,7 +850,7 @@ isHiFileStableRule = defineEarlyCutoff $ \IsHiFileStable f -> do if modificationTime x < modificationTime modVersion then pure SourceModified else do - (fileImports, _) <- use_ GetLocatedImports f + fileImports <- use_ GetLocatedImports f let imports = fmap artifactFilePath . snd <$> fileImports deps <- uses_ IsHiFileStable (catMaybes imports) pure $ if all (== SourceUnmodifiedAndStable) deps diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index f4c0793a6d..8d70e3d5a9 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -46,8 +46,6 @@ import qualified Data.IntMap.Lazy as IntMapLazy import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import Data.Maybe -import Data.Set (Set) -import qualified Data.Set as Set import GHC.Generics (Generic) import Development.IDE.Types.Diagnostics @@ -55,15 +53,12 @@ import Development.IDE.Types.Location import Development.IDE.Import.FindImports (ArtifactsLocation(..)) import GHC -import Module -- | The imports for a given module. -data ModuleImports = ModuleImports - { moduleImports :: ![(Located ModuleName, Maybe FilePathId)] +newtype ModuleImports = ModuleImports + { moduleImports :: [(Located ModuleName, Maybe FilePathId)] -- ^ Imports of a module in the current package and the file path of -- that module on disk (if we found it) - , packageImports :: !(Set InstalledUnitId) - -- ^ Transitive package dependencies unioned for all imports. } deriving Show -- | For processing dependency information, we need lots of maps and sets of @@ -132,10 +127,6 @@ data RawDependencyInformation = RawDependencyInformation , rawBootMap :: !BootIdMap } deriving Show -pkgDependencies :: RawDependencyInformation -> FilePathIdMap (Set InstalledUnitId) -pkgDependencies RawDependencyInformation{..} = - IntMap.map (either (const Set.empty) packageImports) rawImports - data DependencyInformation = DependencyInformation { depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError)) @@ -146,8 +137,6 @@ data DependencyInformation = -- in the same package. , depReverseModuleDeps :: !(IntMap IntSet) -- ^ Contains a reverse mapping from a module to all those that immediately depend on it. - , depPkgDeps :: !(FilePathIdMap (Set InstalledUnitId)) - -- ^ For a non-error node, this contains the set of immediate pkg deps. , depPathIdMap :: !PathIdMap -- ^ Map from FilePath to FilePathId , depBootMap :: !BootIdMap @@ -222,13 +211,12 @@ instance Semigroup NodeResult where SuccessNode a <> SuccessNode _ = SuccessNode a processDependencyInformation :: RawDependencyInformation -> DependencyInformation -processDependencyInformation rawDepInfo@RawDependencyInformation{..} = +processDependencyInformation RawDependencyInformation{..} = DependencyInformation { depErrorNodes = IntMap.fromList errorNodes , depModuleDeps = moduleDeps , depReverseModuleDeps = reverseModuleDeps , depModuleNames = IntMap.fromList $ coerce moduleNames - , depPkgDeps = pkgDependencies rawDepInfo , depPathIdMap = rawPathIdMap , depBootMap = rawBootMap } @@ -248,8 +236,8 @@ processDependencyInformation rawDepInfo@RawDependencyInformation{..} = successEdges reverseModuleDeps = foldr (\(p, cs) res -> - let new = IntMap.fromList (map (, IntSet.singleton (coerce p)) (coerce cs)) - in IntMap.unionWith IntSet.union new res ) IntMap.empty successEdges + let new = IntMap.fromList (map (, IntSet.singleton (coerce p)) (coerce cs)) + in IntMap.unionWith IntSet.union new res ) IntMap.empty successEdges -- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows: @@ -345,10 +333,6 @@ transitiveDeps DependencyInformation{..} file = do reachable g <$> toVertex (getFilePathId fileId) let transitiveModuleDepIds = filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs - let transitivePkgDeps = - Set.toList $ Set.unions $ - map (\f -> IntMap.findWithDefault Set.empty f depPkgDeps) $ - getFilePathId fileId : transitiveModuleDepIds let transitiveModuleDeps = map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds let transitiveNamedModuleDeps = @@ -376,8 +360,6 @@ data TransitiveDependencies = TransitiveDependencies , transitiveNamedModuleDeps :: [NamedModuleDep] -- ^ Transitive module dependencies in topological order. -- The module itself is not included. - , transitivePkgDeps :: [InstalledUnitId] - -- ^ Transitive pkg dependencies in unspecified order. } deriving (Eq, Show, Generic) instance NFData TransitiveDependencies diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index ced69015be..b95ad2117a 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -37,7 +37,7 @@ import Data.List (isSuffixOf) data Import = FileImport !ArtifactsLocation - | PackageImport !M.InstalledUnitId + | PackageImport deriving (Show) data ArtifactsLocation = ArtifactsLocation @@ -55,7 +55,7 @@ isBootLocation = not . artifactIsSource instance NFData Import where rnf (FileImport x) = rnf x - rnf (PackageImport x) = rnf x + rnf PackageImport = () modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source @@ -137,7 +137,7 @@ locateModule dflags comp_info exts doesExist modName mbPkgName isSource = do lookupInPackageDB dfs = case lookupModuleWithSuggestions dfs (unLoc modName) mbPkgName of - LookupFound _m pkgConfig -> return $ Right $ PackageImport $ unitId pkgConfig + LookupFound _m _pkgConfig -> return $ Right PackageImport reason -> return $ Left $ notFoundErr dfs modName reason -- | Don't call this on a found module. From 05fb386efc83bf12176dc91ac38d1cc82cddff4c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 12 Feb 2021 20:25:01 +0000 Subject: [PATCH 2/4] expose FindImports module --- ghcide/ghcide.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 2510f04826..a459e09be0 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -157,6 +157,7 @@ library Development.IDE.GHC.Orphans Development.IDE.GHC.Util Development.IDE.Import.DependencyInformation + Development.IDE.Import.FindImports Development.IDE.LSP.HoverDefinition Development.IDE.LSP.LanguageServer Development.IDE.LSP.Outline @@ -201,7 +202,6 @@ library Development.IDE.Core.FileExists Development.IDE.GHC.CPP Development.IDE.GHC.Warnings - Development.IDE.Import.FindImports Development.IDE.LSP.Notifications Development.IDE.Plugin.CodeAction.PositionIndexed Development.IDE.Plugin.Completions.Logic From cfba02174966b4314866427c4be8757762b04447 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 13 Feb 2021 07:23:28 +0000 Subject: [PATCH 3/4] drop transitiveNamedModuleDeps (not used) --- .../Development/IDE/Import/DependencyInformation.hs | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 8d70e3d5a9..9432df2db3 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -335,11 +335,6 @@ transitiveDeps DependencyInformation{..} file = do filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs let transitiveModuleDeps = map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds - let transitiveNamedModuleDeps = - [ NamedModuleDep (idToPath depPathIdMap (FilePathId fid)) mn artifactModLocation - | (fid, ShowableModuleName mn) <- IntMap.toList depModuleNames - , let ArtifactsLocation{artifactModLocation} = idToPathMap depPathIdMap IntMap.! fid - ] pure TransitiveDependencies {..} where (g, fromVertex, toVertex) = graphFromEdges edges @@ -353,13 +348,10 @@ transitiveDeps DependencyInformation{..} file = do vs = topSort g -data TransitiveDependencies = TransitiveDependencies +newtype TransitiveDependencies = TransitiveDependencies { transitiveModuleDeps :: [NormalizedFilePath] -- ^ Transitive module dependencies in topological order. -- The module itself is not included. - , transitiveNamedModuleDeps :: [NamedModuleDep] - -- ^ Transitive module dependencies in topological order. - -- The module itself is not included. } deriving (Eq, Show, Generic) instance NFData TransitiveDependencies From 20491360a9228952f7c81be8bce0f0938df4b8a2 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 13 Feb 2021 06:59:00 +0000 Subject: [PATCH 4/4] 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 --- ghcide/src/Development/IDE/Core/Rules.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index ba6abee866..da7ad51605 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -420,19 +420,23 @@ execRawDepM act = -- imports recursively. rawDependencyInformation :: [NormalizedFilePath] -> Action RawDependencyInformation rawDependencyInformation fs = do - (rdi, ss) <- execRawDepM (mapM_ go fs) + (rdi, ss) <- execRawDepM (goPlural fs) let bm = IntMap.foldrWithKey (updateBootMap rdi) IntMap.empty ss return (rdi { rawBootMap = bm }) where + goPlural ff = do + mss <- lift $ (fmap.fmap) fst <$> uses GetModSummaryWithoutTimestamps ff + zipWithM go ff mss + go :: NormalizedFilePath -- ^ Current module being processed + -> Maybe ModSummary -- ^ ModSummary of the module -> StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action FilePathId - go f = do + go f msum = do -- First check to see if we have already processed the FilePath -- If we have, just return its Id but don't update any of the state. -- Otherwise, we need to process its imports. checkAlreadyProcessed f $ do - msum <- lift $ fmap fst <$> use GetModSummaryWithoutTimestamps f - let al = modSummaryToArtifactsLocation f msum + let al = modSummaryToArtifactsLocation f msum -- Get a fresh FilePathId for the new file fId <- getFreshFid al -- Adding an edge to the bootmap so we can make sure to @@ -454,7 +458,7 @@ rawDependencyInformation fs = do (mns, ls) = unzip with_file -- Recursively process all the imports we just learnt about -- and get back a list of their FilePathIds - fids <- mapM (go . artifactFilePath) ls + fids <- goPlural $ map artifactFilePath ls -- Associate together the ModuleName with the FilePathId let moduleImports' = map (,Nothing) no_file ++ zip mns (map Just fids) -- Insert into the map the information about this modules