cc97e1e · ghcide · git.iko.soy

git.iko.soy/ghcide

Speed up dependency information chasing (#2444)

Comparing FilePaths is really slow so by mapping them to Ints, we can speed up dependency chasing significantly. We might want to switch to doing some kind of global hash consing of file paths at the Shake level but for now, this seems like a nice improvement while not being too invasive. This is roughly an ~8s speedup on my testcase.

commitcc97e1e1be4598b2f0911d143d637bc7c4669720 authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org> dateWed 7 Aug 2019, 16:51 (7 years ago) parent6e0a519

2 files changed+159−64

compare with master

unifiedsplit

src/Development/IDE/Core/Rules.hs+48−23 src/Development/IDE/Import/DependencyInformation.hs+111−41

src/Development/IDE/Core/Rules.hs+48−23

@@ -36,10 +36,13 @@ import Development.IDE.Import.FindImports

3636import Development.IDE.Core.FileStore

3737import Development.IDE.Types.Diagnostics

3838import Development.IDE.Types.Location

39+import Data.Coerce

3940import Data.Either.Extra

4041import Data.Maybe

4142import Data.Foldable

42−import qualified Data.Map.Strict as Map

43+import qualified Data.IntMap.Strict as IntMap

44+import qualified Data.IntSet as IntSet

45+import Data.List

4346import qualified Data.Set as Set

4447import qualified Data.Text as T

4548import Development.IDE.GHC.Error

@@ -203,40 +206,62 @@ getLocatedImportsRule =

203206

204207-- | Given a target file path, construct the raw dependency results by following

205208-- imports recursively.

206−rawDependencyInformation :: NormalizedFilePath -> ExceptT [FileDiagnostic] Action RawDependencyInformation

207−rawDependencyInformation f = go (Set.singleton f) Map.empty

208− where go fs !modGraph =

209− case Set.minView fs of

210− Nothing -> pure $ RawDependencyInformation modGraph

211− Just (f, fs) -> do

212− importsOrErr <- lift $ use GetLocatedImports f

213− case importsOrErr of

214− Nothing ->

215− let modGraph' = Map.insert f (Left ModuleParseError) modGraph

216− in go fs modGraph'

217− Just (modImports, pkgImports) -> do

218− let newFiles = Set.fromList (mapMaybe snd modImports) Set.\\ Map.keysSet modGraph

219− modGraph' = Map.insert f (Right $ ModuleImports modImports pkgImports) modGraph

220− go (newFiles `Set.union` fs) modGraph'

209+rawDependencyInformation :: NormalizedFilePath -> Action RawDependencyInformation

210+rawDependencyInformation f = do

211+ let (initialId, initialMap) = getPathId f emptyPathIdMap

212+ go (IntSet.singleton $ getFilePathId initialId)

213+ (RawDependencyInformation IntMap.empty initialMap)

214+ where

215+ go fs rawDepInfo =

216+ case IntSet.minView fs of

217+ -- Queue is empty

218+ Nothing -> pure rawDepInfo

219+ -- Pop f from the queue and process it

220+ Just (f, fs) -> do

221+ let fId = FilePathId f

222+ importsOrErr <- use GetLocatedImports $ idToPath (rawPathIdMap rawDepInfo) fId

223+ case importsOrErr of

224+ Nothing ->

225+ -- File doesn’t parse

226+ let rawDepInfo' = insertImport fId (Left ModuleParseError) rawDepInfo

227+ in go fs rawDepInfo'

228+ Just (modImports, pkgImports) -> do

229+ let f :: PathIdMap -> (a, Maybe NormalizedFilePath) -> (PathIdMap, (a, Maybe FilePathId))

230+ f pathMap (imp, mbPath) = case mbPath of

231+ Nothing -> (pathMap, (imp, Nothing))

232+ Just path ->

233+ let (pathId, pathMap') = getPathId path pathMap

234+ in (pathMap', (imp, Just pathId))

235+ -- Convert paths in imports to ids and update the path map

236+ let (pathIdMap, modImports') = mapAccumL f (rawPathIdMap rawDepInfo) modImports

237+ -- Files that we haven’t seen before are added to the queue.

238+ let newFiles =

239+ IntSet.fromList (coerce $ mapMaybe snd modImports')

240+ IntSet.\\ IntMap.keysSet (rawImports rawDepInfo)

241+ let rawDepInfo' = insertImport fId (Right $ ModuleImports modImports' pkgImports) rawDepInfo

242+ go (newFiles `IntSet.union` fs) (rawDepInfo' { rawPathIdMap = pathIdMap })

221243

222244getDependencyInformationRule :: Rules ()

223245getDependencyInformationRule =

224− define $ \GetDependencyInformation file -> fmap toIdeResult $ runExceptT $ do

246+ define $ \GetDependencyInformation file -> do

225247 rawDepInfo <- rawDependencyInformation file

226− pure $ processDependencyInformation rawDepInfo

248+ pure ([], Just $ processDependencyInformation rawDepInfo)

227249

228250reportImportCyclesRule :: Rules ()

229251reportImportCyclesRule =

230252 define $ \ReportImportCycles file -> fmap (\errs -> if null errs then ([], Just ()) else (errs, Nothing)) $ do

231253 DependencyInformation{..} <- use_ GetDependencyInformation file

232− case Map.lookup file depErrorNodes of

254+ let fileId = pathToId depPathIdMap file

255+ case IntMap.lookup (getFilePathId fileId) depErrorNodes of

233256 Nothing -> pure []

234257 Just errs -> do

235− let cycles = mapMaybe (cycleErrorInFile file) (toList errs)

258+ let cycles = mapMaybe (cycleErrorInFile fileId) (toList errs)

236259 -- Convert cycles of files into cycles of module names

237260 forM cycles $ \(imp, files) -> do

238− modNames <- mapM getModuleName files

239− pure $ toDiag imp modNames

261+ modNames <- forM files $ \fileId -> do

262+ let file = idToPath depPathIdMap fileId

263+ getModuleName file

264+ pure $ toDiag imp $ sort modNames

240265 where cycleErrorInFile f (PartOfCycle imp fs)

241266 | f `elem` fs = Just (imp, fs)

242267 cycleErrorInFile _ _ = Nothing

@@ -261,7 +286,7 @@ getDependenciesRule :: Rules ()

261286getDependenciesRule =

262287 define $ \GetDependencies file -> do

263288 depInfo@DependencyInformation{..} <- use_ GetDependencyInformation file

264− let allFiles = Map.keys depModuleDeps <> Map.keys depErrorNodes

289+ let allFiles = reachableModules depInfo

265290 _ <- uses_ ReportImportCycles allFiles

266291 return ([], transitiveDeps depInfo file)

267292

src/Development/IDE/Import/DependencyInformation.hs+111−41

@@ -8,21 +8,36 @@ module Development.IDE.Import.DependencyInformation

88 , NodeError(..)

99 , ModuleParseError(..)

1010 , TransitiveDependencies(..)

11+ , FilePathId(..)

12+

13+ , PathIdMap

14+ , emptyPathIdMap

15+ , getPathId

16+ , insertImport

17+ , pathToId

18+ , idToPath

19+ , reachableModules

20+

1121 , processDependencyInformation

1222 , transitiveDeps

1323 ) where

1424

1525import Control.DeepSeq

1626import Data.Bifunctor

27+import Data.Coerce

1728import Data.List

1829import Development.IDE.GHC.Orphans()

1930import Data.Either

2031import Data.Graph

2132import Data.List.NonEmpty (NonEmpty(..), nonEmpty)

2233import qualified Data.List.NonEmpty as NonEmpty

34+import Data.IntMap (IntMap)

35+import qualified Data.IntMap.Strict as IntMap

36+import qualified Data.IntMap.Lazy as IntMapLazy

37+import Data.IntSet (IntSet)

38+import qualified Data.IntSet as IntSet

2339import Data.Map (Map)

2440import qualified Data.Map.Strict as MS

25−import qualified Data.Map.Lazy as ML

2641import Data.Maybe

2742import Data.Set (Set)

2843import qualified Data.Set as Set

@@ -37,32 +52,78 @@ import Module

3752

3853-- | The imports for a given module.

3954data ModuleImports = ModuleImports

40− { moduleImports :: ![(Located ModuleName, Maybe NormalizedFilePath)]

55+ { moduleImports :: ![(Located ModuleName, Maybe FilePathId)]

4156 -- ^ Imports of a module in the current package and the file path of

4257 -- that module on disk (if we found it)

4358 , packageImports :: !(Set InstalledUnitId)

4459 -- ^ Transitive package dependencies unioned for all imports.

4560 }

4661

62+-- | For processing dependency information, we need lots of maps and sets

63+-- of filepaths. Comparing Strings is really slow, so we work with IntMap/IntSet

64+-- instead and only convert at the edges

65+-- and

66+newtype FilePathId = FilePathId { getFilePathId :: Int }

67+ deriving (Show, NFData, Eq, Ord)

68+

69+data PathIdMap = PathIdMap

70+ { idToPathMap :: !(IntMap NormalizedFilePath)

71+ , pathToIdMap :: !(Map NormalizedFilePath FilePathId)

72+ }

73+ deriving (Show, Generic)

74+

75+instance NFData PathIdMap

76+

77+emptyPathIdMap :: PathIdMap

78+emptyPathIdMap = PathIdMap IntMap.empty MS.empty

79+

80+getPathId :: NormalizedFilePath -> PathIdMap -> (FilePathId, PathIdMap)

81+getPathId path m@PathIdMap{..} =

82+ case MS.lookup path pathToIdMap of

83+ Nothing ->

84+ let !newId = FilePathId $ MS.size pathToIdMap

85+ in (newId, insertPathId path newId m)

86+ Just id -> (id, m)

87+

88+insertPathId :: NormalizedFilePath -> FilePathId -> PathIdMap -> PathIdMap

89+insertPathId path id PathIdMap{..} =

90+ PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (MS.insert path id pathToIdMap)

91+

92+insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation

93+insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }

94+

95+pathToId :: PathIdMap -> NormalizedFilePath -> FilePathId

96+pathToId PathIdMap{pathToIdMap} path = pathToIdMap MS.! path

97+

98+idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath

99+idToPath PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id

100+

47101-- | Unprocessed results that we find by following imports recursively.

48−newtype RawDependencyInformation = RawDependencyInformation

49− { getRawDeps :: Map NormalizedFilePath (Either ModuleParseError ModuleImports)

102+data RawDependencyInformation = RawDependencyInformation

103+ { rawImports :: !(IntMap (Either ModuleParseError ModuleImports))

104+ , rawPathIdMap :: !PathIdMap

50105 }

51106

52−pkgDependencies :: RawDependencyInformation -> Map NormalizedFilePath (Set InstalledUnitId)

53−pkgDependencies (RawDependencyInformation m) = MS.map (either (const Set.empty) packageImports) m

107+pkgDependencies :: RawDependencyInformation -> IntMap (Set InstalledUnitId)

108+pkgDependencies RawDependencyInformation{..} =

109+ IntMap.map (either (const Set.empty) packageImports) rawImports

54110

55111data DependencyInformation =

56112 DependencyInformation

57− { depErrorNodes :: Map NormalizedFilePath (NonEmpty NodeError)

113+ { depErrorNodes :: !(IntMap (NonEmpty NodeError))

58114 -- ^ Nodes that cannot be processed correctly.

59− , depModuleDeps :: Map NormalizedFilePath (Set NormalizedFilePath)

115+ , depModuleDeps :: !(IntMap IntSet)

60116 -- ^ For a non-error node, this contains the set of module immediate dependencies

61117 -- in the same package.

62− , depPkgDeps :: Map NormalizedFilePath (Set InstalledUnitId)

118+ , depPkgDeps :: !(IntMap (Set InstalledUnitId))

63119 -- ^ For a non-error node, this contains the set of immediate pkg deps.

120+ , depPathIdMap :: !PathIdMap

64121 } deriving (Show, Generic)

65122

123+reachableModules :: DependencyInformation -> [NormalizedFilePath]

124+reachableModules DependencyInformation{..} =

125+ map (idToPath depPathIdMap . FilePathId) $ IntMap.keys depErrorNodes <> IntMap.keys depModuleDeps

126+

66127instance NFData DependencyInformation

67128

68129-- | This does not contain the actual parse error as that is already reported by GetParsedModule.

@@ -79,7 +140,7 @@ instance NFData LocateError

79140

80141-- | An error attached to a node in the dependency graph.

81142data NodeError

82− = PartOfCycle (Located ModuleName) [NormalizedFilePath]

143+ = PartOfCycle (Located ModuleName) [FilePathId]

83144 -- ^ This module is part of an import cycle. The module name corresponds

84145 -- to the import that enters the cycle starting from this module.

85146 -- The list of filepaths represents the elements

@@ -104,12 +165,12 @@ instance NFData NodeError where

104165-- `ErrorNode`. Otherwise it is a `SuccessNode`.

105166data NodeResult

106167 = ErrorNode (NonEmpty NodeError)

107− | SuccessNode [(Located ModuleName, NormalizedFilePath)]

168+ | SuccessNode [(Located ModuleName, FilePathId)]

108169 deriving Show

109170

110171partitionNodeResults

111172 :: [(a, NodeResult)]

112− -> ([(a, NonEmpty NodeError)], [(a, [(Located ModuleName, NormalizedFilePath)])])

173+ -> ([(a, NonEmpty NodeError)], [(a, [(Located ModuleName, FilePathId)])])

113174partitionNodeResults = partitionEithers . map f

114175 where f (a, ErrorNode errs) = Left (a, errs)

115176 f (a, SuccessNode imps) = Right (a, imps)

@@ -121,40 +182,41 @@ instance Semigroup NodeResult where

121182 SuccessNode a <> SuccessNode _ = SuccessNode a

122183

123184processDependencyInformation :: RawDependencyInformation -> DependencyInformation

124−processDependencyInformation rawResults =

185+processDependencyInformation rawDepInfo@RawDependencyInformation{..} =

125186 DependencyInformation

126− { depErrorNodes = MS.fromList errorNodes

187+ { depErrorNodes = IntMap.fromList errorNodes

127188 , depModuleDeps = moduleDeps

128− , depPkgDeps = pkgDependencies rawResults

189+ , depPkgDeps = pkgDependencies rawDepInfo

190+ , depPathIdMap = rawPathIdMap

129191 }

130− where resultGraph = buildResultGraph rawResults

131− (errorNodes, successNodes) = partitionNodeResults $ MS.toList resultGraph

132− successEdges :: [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])]

192+ where resultGraph = buildResultGraph rawImports

193+ (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph

194+ successEdges :: [(FilePathId, FilePathId, [FilePathId])]

133195 successEdges =

134− map (\(file, imports) -> (file, file, map snd imports)) successNodes

196+ map (\(file, imports) -> (FilePathId file, FilePathId file, map snd imports)) successNodes

135197 moduleDeps =

136− MS.fromList $ map (\(_, v, vs) -> (v, Set.fromList vs)) successEdges

198+ IntMap.fromList $ map (\(_, FilePathId v, vs) -> (v, IntSet.fromList $ coerce vs)) successEdges

137199

138200-- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows:

139201-- 1. Mark each node that is part of an import cycle as an error node.

140202-- 2. Mark each node that has a parse error as an error node.

141203-- 3. Mark each node whose immediate children could not be located as an error.

142204-- 4. Recursively propagate errors to parents if they are not already error nodes.

143−buildResultGraph :: RawDependencyInformation -> Map NormalizedFilePath NodeResult

205+buildResultGraph :: IntMap (Either ModuleParseError ModuleImports) -> IntMap NodeResult

144206buildResultGraph g = propagatedErrors

145207 where

146208 sccs = stronglyConnComp (graphEdges g)

147209 (_, cycles) = partitionSCC sccs

148− cycleErrors :: Map NormalizedFilePath NodeResult

149− cycleErrors = MS.unionsWith (<>) $ map errorsForCycle cycles

150− errorsForCycle :: [NormalizedFilePath] -> Map NormalizedFilePath NodeResult

210+ cycleErrors :: IntMap NodeResult

211+ cycleErrors = IntMap.unionsWith (<>) $ map errorsForCycle cycles

212+ errorsForCycle :: [FilePathId] -> IntMap NodeResult

151213 errorsForCycle files =

152− MS.fromListWith (<>) (concatMap (cycleErrorsForFile files) files)

153− cycleErrorsForFile :: [NormalizedFilePath] -> NormalizedFilePath -> [(NormalizedFilePath,NodeResult)]

214+ IntMap.fromListWith (<>) $ coerce $ concatMap (cycleErrorsForFile files) files

215+ cycleErrorsForFile :: [FilePathId] -> FilePathId -> [(FilePathId,NodeResult)]

154216 cycleErrorsForFile cycle f =

155217 let entryPoints = mapMaybe (findImport f) cycle

156218 in map (\imp -> (f, ErrorNode (PartOfCycle imp cycle :| []))) entryPoints

157− otherErrors = MS.map otherErrorsForFile (getRawDeps g)

219+ otherErrors = IntMap.map otherErrorsForFile g

158220 otherErrorsForFile :: Either ModuleParseError ModuleImports -> NodeResult

159221 otherErrorsForFile (Left err) = ErrorNode (ParseError err :| [])

160222 otherErrorsForFile (Right ModuleImports{moduleImports}) =

@@ -165,32 +227,32 @@ buildResultGraph g = propagatedErrors

165227 Nothing -> SuccessNode imports'

166228 Just errs' -> ErrorNode (NonEmpty.map FailedToLocateImport errs')

167229

168− unpropagatedErrors = MS.unionWith (<>) cycleErrors otherErrors

230+ unpropagatedErrors = IntMap.unionWith (<>) cycleErrors otherErrors

169231 -- The recursion here is fine since we use a lazy map and

170232 -- we only recurse on SuccessNodes. In particular, we do not recurse

171233 -- on nodes that are part of a cycle as they are already marked as

172234 -- error nodes.

173235 propagatedErrors =

174− ML.map propagate unpropagatedErrors

236+ IntMapLazy.map propagate unpropagatedErrors

175237 propagate :: NodeResult -> NodeResult

176238 propagate n@(ErrorNode _) = n

177239 propagate n@(SuccessNode imps) =

178− let results = map (\(imp, dep) -> (imp, propagatedErrors MS.! dep)) imps

240+ let results = map (\(imp, FilePathId dep) -> (imp, propagatedErrors IntMap.! dep)) imps

179241 (errs, _) = partitionNodeResults results

180242 in case nonEmpty errs of

181243 Nothing -> n

182244 Just errs' -> ErrorNode (NonEmpty.map (ParentOfErrorNode . fst) errs')

183− findImport :: NormalizedFilePath -> NormalizedFilePath -> Maybe (Located ModuleName)

184− findImport file importedFile =

185− case getRawDeps g MS.! file of

245+ findImport :: FilePathId -> FilePathId -> Maybe (Located ModuleName)

246+ findImport (FilePathId file) importedFile =

247+ case g IntMap.! file of

186248 Left _ -> error "Tried to call findImport on a module with a parse error"

187249 Right ModuleImports{moduleImports} ->

188250 fmap fst $ find (\(_, resolvedImp) -> resolvedImp == Just importedFile) moduleImports

189251

190−graphEdges :: RawDependencyInformation -> [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])]

252+graphEdges :: IntMap (Either ModuleParseError ModuleImports) -> [(FilePathId, FilePathId, [FilePathId])]

191253graphEdges g =

192− map (\(k, v) -> (k, k, deps v)) $ MS.toList $ getRawDeps g

193− where deps :: Either e ModuleImports -> [NormalizedFilePath]

254+ map (\(k, v) -> (FilePathId k, FilePathId k, deps v)) $ IntMap.toList g

255+ where deps :: Either e ModuleImports -> [FilePathId]

194256 deps (Left _) = []

195257 deps (Right ModuleImports{moduleImports}) = mapMaybe snd moduleImports

196258

@@ -200,12 +262,20 @@ partitionSCC (AcyclicSCC x:rest) = first (x:) $ partitionSCC rest

200262partitionSCC [] = ([], [])

201263

202264transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies

203−transitiveDeps DependencyInformation{..} f = do

204− reachableVs <- Set.delete f . Set.fromList . map (fst3 . fromVertex) . reachable g <$> toVertex f

205− let transitiveModuleDeps = filter (\v -> v `Set.member` reachableVs) $ map (fst3 . fromVertex) vs

206− let transitivePkgDeps = Set.toList $ Set.unions $ map (\f -> MS.findWithDefault Set.empty f depPkgDeps) (f : transitiveModuleDeps)

265+transitiveDeps DependencyInformation{..} file = do

266+ let !fileId = pathToId depPathIdMap file

267+ reachableVs <-

268+ IntSet.delete (getFilePathId fileId) .

269+ IntSet.fromList . map (fst3 . fromVertex) .

270+ reachable g <$> toVertex (getFilePathId fileId)

271+ let transitiveModuleDepIds = filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs

272+ let transitivePkgDeps =

273+ Set.toList $ Set.unions $

274+ map (\f -> IntMap.findWithDefault Set.empty f depPkgDeps) $

275+ getFilePathId fileId : transitiveModuleDepIds

276+ let transitiveModuleDeps = map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds

207277 pure TransitiveDependencies {..}

208− where (g, fromVertex, toVertex) = graphFromEdges (map (\(f, fs) -> (f, f, Set.toList fs)) $ MS.toList depModuleDeps)

278+ where (g, fromVertex, toVertex) = graphFromEdges (map (\(f, fs) -> (f, f, IntSet.toList fs)) $ IntMap.toList depModuleDeps)

209279 vs = topSort g

210280

211281data TransitiveDependencies = TransitiveDependencies