git.iko.soy/ghcide
on master help sign in
Cache NormalizedFilePath in ArtifactLocation (#445)
3ca4005Pepe Iborra
src/Development/IDE/Core/Rules.hs+4−2
compare with master
unifiedsplit
@@ -177,7 +177,8 @@ getLocatedImportsRule =
177-- imports recursively.
177-- imports recursively.
178rawDependencyInformation :: NormalizedFilePath -> Action RawDependencyInformation
178rawDependencyInformation :: NormalizedFilePath -> Action RawDependencyInformation
179rawDependencyInformation f = do
179rawDependencyInformation f = do
180− let (initialId, initialMap) = getPathId (ArtifactsLocation $ ModLocation (Just $ fromNormalizedFilePath f) "" "") emptyPathIdMap
180+ let initialArtifact = ArtifactsLocation f (ModLocation (Just $ fromNormalizedFilePath f) "" "")
181+ (initialId, initialMap) = getPathId initialArtifact emptyPathIdMap
181 go (IntSet.singleton $ getFilePathId initialId)
182 go (IntSet.singleton $ getFilePathId initialId)
182 (RawDependencyInformation IntMap.empty initialMap)
183 (RawDependencyInformation IntMap.empty initialMap)
183 where
184 where
@@ -270,7 +271,8 @@ getSpanInfoRule =
270 parsedDeps <- mapMaybe (fmap fst) <$> usesWithStale GetParsedModule (transitiveModuleDeps deps)
271 parsedDeps <- mapMaybe (fmap fst) <$> usesWithStale GetParsedModule (transitiveModuleDeps deps)
271 (fileImports, _) <- use_ GetLocatedImports file
272 (fileImports, _) <- use_ GetLocatedImports file
272 packageState <- hscEnv <$> use_ GhcSession file
273 packageState <- hscEnv <$> use_ GhcSession file
274+ let imports = second (fmap artifactFilePath) <$> fileImports
273− x <- liftIO $ getSrcSpanInfos packageState (fmap (second (fmap modLocationToNormalizedFilePath)) fileImports) tc parsedDeps
275+ x <- liftIO $ getSrcSpanInfos packageState imports tc parsedDeps
274 return ([], Just x)
276 return ([], Just x)
275
277
276-- Typechecks a module.
278-- Typechecks a module.
src/Development/IDE/Import/DependencyInformation.hs+5−13
@@ -18,7 +18,6 @@ module Development.IDE.Import.DependencyInformation
18 , pathToId
18 , pathToId
19 , idToPath
19 , idToPath
20 , reachableModules
20 , reachableModules
21− , modLocationToNormalizedFilePath
22 , processDependencyInformation
21 , processDependencyInformation
23 , transitiveDeps
22 , transitiveDeps
24 ) where
23 ) where
@@ -76,19 +75,12 @@ data PathIdMap = PathIdMap
76
75
77instance NFData PathIdMap
76instance NFData PathIdMap
78
77
79−modLocationToNormalizedFilePath :: ArtifactsLocation -> NormalizedFilePath
80−modLocationToNormalizedFilePath (ArtifactsLocation loc) =
81− case ml_hs_file loc of
82− Just filePath -> toNormalizedFilePath filePath
83− -- Since we craete all 'ModLocation' values via 'mkHomeModLocation'
84− Nothing -> error "Has something changed in mkHomeModLocation?"
85−
86emptyPathIdMap :: PathIdMap
78emptyPathIdMap :: PathIdMap
87emptyPathIdMap = PathIdMap IntMap.empty HMS.empty
79emptyPathIdMap = PathIdMap IntMap.empty HMS.empty
88
80
89getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
81getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
90getPathId path m@PathIdMap{..} =
82getPathId path m@PathIdMap{..} =
91− case HMS.lookup (modLocationToNormalizedFilePath path) pathToIdMap of
83+ case HMS.lookup (artifactFilePath path) pathToIdMap of
92 Nothing ->
84 Nothing ->
93 let !newId = FilePathId $ HMS.size pathToIdMap
85 let !newId = FilePathId $ HMS.size pathToIdMap
94 in (newId, insertPathId path newId m)
86 in (newId, insertPathId path newId m)
@@ -96,7 +88,7 @@ getPathId path m@PathIdMap{..} =
96
88
97insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
89insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
98insertPathId path id PathIdMap{..} =
90insertPathId path id PathIdMap{..} =
99− PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (HMS.insert (modLocationToNormalizedFilePath path) id pathToIdMap)
91+ PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (HMS.insert (artifactFilePath path) id pathToIdMap)
100
92
101insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation
93insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation
102insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }
94insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }
@@ -105,7 +97,7 @@ pathToId :: PathIdMap -> NormalizedFilePath -> FilePathId
105pathToId PathIdMap{pathToIdMap} path = pathToIdMap HMS.! path
97pathToId PathIdMap{pathToIdMap} path = pathToIdMap HMS.! path
106
98
107idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath
99idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath
108−idToPath pathIdMap filePathId = modLocationToNormalizedFilePath $ idToModLocation pathIdMap filePathId
100+idToPath pathIdMap filePathId = artifactFilePath $ idToModLocation pathIdMap filePathId
109
101
110idToModLocation :: PathIdMap -> FilePathId -> ArtifactsLocation
102idToModLocation :: PathIdMap -> FilePathId -> ArtifactsLocation
111idToModLocation PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id
103idToModLocation PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id
@@ -305,9 +297,9 @@ transitiveDeps DependencyInformation{..} file = do
305 let transitiveModuleDeps =
297 let transitiveModuleDeps =
306 map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds
298 map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds
307 let transitiveNamedModuleDeps =
299 let transitiveNamedModuleDeps =
308− [ NamedModuleDep (idToPath depPathIdMap (FilePathId fid)) mn ml
300+ [ NamedModuleDep (idToPath depPathIdMap (FilePathId fid)) mn artifactModLocation
309 | (fid, ShowableModuleName mn) <- IntMap.toList depModuleNames
301 | (fid, ShowableModuleName mn) <- IntMap.toList depModuleNames
310− , let ArtifactsLocation ml = idToPathMap depPathIdMap IntMap.! fid
302+ , let ArtifactsLocation{artifactModLocation} = idToPathMap depPathIdMap IntMap.! fid
311 ]
303 ]
312 pure TransitiveDependencies {..}
304 pure TransitiveDependencies {..}
313 where
305 where
src/Development/IDE/Import/FindImports.hs+6−3
@@ -34,11 +34,14 @@ data Import
34 | PackageImport !M.InstalledUnitId
34 | PackageImport !M.InstalledUnitId
35 deriving (Show)
35 deriving (Show)
36
36
37−newtype ArtifactsLocation = ArtifactsLocation ModLocation
37+data ArtifactsLocation = ArtifactsLocation
38+ { artifactFilePath :: !NormalizedFilePath
39+ , artifactModLocation :: !ModLocation
40+ }
38 deriving (Show)
41 deriving (Show)
39
42
40instance NFData ArtifactsLocation where
43instance NFData ArtifactsLocation where
41− rnf = const ()
44+ rnf ArtifactsLocation{..} = rnf artifactFilePath `seq` rwhnf artifactModLocation
42
45
43instance NFData Import where
46instance NFData Import where
44 rnf (FileImport x) = rnf x
47 rnf (FileImport x) = rnf x
@@ -94,7 +97,7 @@ locateModule dflags exts doesExist modName mbPkgName isSource = do
94 where
97 where
95 toModLocation file = liftIO $ do
98 toModLocation file = liftIO $ do
96 loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file)
99 loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file)
97− return $ Right $ FileImport $ ArtifactsLocation loc
100+ return $ Right $ FileImport $ ArtifactsLocation file loc
98
101
99
102
100 lookupInPackageDB dfs =
103 lookupInPackageDB dfs =