Skip to content

Commit b6e819b

Browse files
wz1000wz1000
committed
improve memory usage of ExportsMap
Storing rendered names as `Text`, especially for parents, adds a lot of duplication to the ExportsMap. Instead we store the `OccName`s directly, which have hash-consed symbols due stored as `FastStrings` and render it out on demand (which is just decoding the UTF-8 FastString to UTF-16 text for text <2.0, and essentially free on text >2.0).
1 parent 52e4fcc commit b6e819b

File tree

4 files changed

+69
-57
lines changed

4 files changed

+69
-57
lines changed

‎ghcide/src/Development/IDE/GHC/Compat.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,8 @@ module Development.IDE.GHC.Compat(
4343
#endif
4444

4545
FastStringCompat,
46+
bytesFS,
47+
mkFastStringByteString,
4648
nodeInfo',
4749
getNodeIds,
4850
sourceNodeInfo,
@@ -206,6 +208,7 @@ import VarEnv (emptyInScopeSet,
206208
#endif
207209

208210
#if MIN_VERSION_ghc(9,0,0)
211+
import GHC.Data.FastString
209212
import GHC.Core
210213
import GHC.Data.StringBuffer
211214
import GHC.Driver.Session hiding (ExposePackage)
@@ -224,6 +227,7 @@ import GHC.Iface.Make (mkIfaceExports)
224227
import qualified GHC.SysTools.Tasks as SysTools
225228
import qualified GHC.Types.Avail as Avail
226229
#else
230+
import FastString
227231
import qualified Avail
228232
import DynFlags hiding (ExposePackage)
229233
import HscTypes

‎ghcide/src/Development/IDE/Plugin/Completions/Logic.hs‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -287,25 +287,26 @@ mkExtCompl label =
287287

288288

289289
fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
290-
fromIdentInfo doc IdentInfo{..} q = CI
290+
fromIdentInfo doc id@IdentInfo{..} q = CI
291291
{ compKind= occNameToComKind name
292-
, insertText=rendered
293-
, provenance = DefinedIn moduleNameText
294-
, label=rendered
295-
, typeText = Nothing
292+
, insertText=rend
293+
, provenance = DefinedIn mod
294+
, label=rend
296295
, isInfix=Nothing
297-
, isTypeCompl= not isDatacon && isUpper (T.head rendered)
296+
, isTypeCompl= not (isDatacon id) && isUpper (T.head rend)
298297
, additionalTextEdits= Just $
299298
ExtendImport
300299
{ doc,
301-
thingParent = parent,
302-
importName = moduleNameText,
300+
thingParent = occNameText <$> parent,
301+
importName = mod,
303302
importQual = q,
304-
newThing = rendered
303+
newThing = rend
305304
}
306305
, nameDetails = Nothing
307306
, isLocalCompletion = False
308307
}
308+
where rend = rendered id
309+
mod = moduleNameText id
309310

310311
cacheDataProducer :: Uri -> [ModuleName] -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> CachedCompletions
311312
cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports =

‎ghcide/src/Development/IDE/Types/Exports.hs‎

Lines changed: 45 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,10 @@ module Development.IDE.Types.Exports
55
(
66
IdentInfo(..),
77
ExportsMap(..),
8+
rendered,
9+
moduleNameText,
10+
occNameText,
11+
isDatacon,
812
createExportsMap,
913
createExportsMapMg,
1014
createExportsMapTc,
@@ -24,6 +28,7 @@ import Data.HashSet (HashSet)
2428
import qualified Data.HashSet as Set
2529
import Data.List (foldl', isSuffixOf)
2630
import Data.Text (Text, pack)
31+
import Data.Text.Encoding (decodeUtf8)
2732
import Development.IDE.GHC.Compat
2833
import Development.IDE.GHC.Orphans ()
2934
import Development.IDE.GHC.Util
@@ -61,55 +66,63 @@ instance Monoid ExportsMap where
6166
type IdentifierText = Text
6267
type ModuleNameText = Text
6368

69+
70+
rendered :: IdentInfo -> IdentifierText
71+
rendered = occNameText . name
72+
73+
-- | Render an identifier as imported or exported style.
74+
-- TODO: pattern synonymoccNameText :: OccName -> Text
75+
occNameText :: OccName -> IdentifierText
76+
occNameText name
77+
| isTcOcc name && isSymOcc name = "type " <> renderOcc
78+
| otherwise = renderOcc
79+
where
80+
renderOcc = decodeUtf8 . bytesFS . occNameFS $ name
81+
82+
moduleNameText :: IdentInfo -> ModuleNameText
83+
moduleNameText = moduleNameText' . identModuleName
84+
85+
moduleNameText' :: ModuleName -> ModuleNameText
86+
moduleNameText' = decodeUtf8 . bytesFS . moduleNameFS
87+
6488
data IdentInfo = IdentInfo
65-
{ name :: !OccName
66-
, rendered :: Text
67-
, parent :: !(Maybe Text)
68-
, isDatacon :: !Bool
69-
, moduleNameText :: !Text
89+
{ name :: !OccName
90+
, parent :: !(Maybe OccName)
91+
, identModuleName :: !ModuleName
7092
}
7193
deriving (Generic, Show)
7294
deriving anyclass Hashable
7395

96+
isDatacon :: IdentInfo -> Bool
97+
isDatacon = isDataOcc . name
98+
7499
instance Eq IdentInfo where
75100
a == b = name a == name b
76101
&& parent a == parent b
77-
&& isDatacon a == isDatacon b
78-
&& moduleNameText a == moduleNameText b
102+
&& identModuleName a == identModuleName b
79103

80104
instance NFData IdentInfo where
81105
rnf IdentInfo{..} =
82106
-- deliberately skip the rendered field
83-
rnf name `seq` rnf parent `seq` rnf isDatacon `seq` rnf moduleNameText
84-
85-
-- | Render an identifier as imported or exported style.
86-
-- TODO: pattern synonym
87-
renderIEWrapped :: Name -> Text
88-
renderIEWrapped n
89-
| isTcOcc occ && isSymOcc occ = "type " <> pack (printName n)
90-
| otherwise = pack $ printName n
91-
where
92-
occ = occName n
107+
rnf name `seq` rnf parent `seq` rnf identModuleName
93108

94-
mkIdentInfos :: Text -> AvailInfo -> [IdentInfo]
109+
mkIdentInfos :: ModuleName -> AvailInfo -> [IdentInfo]
95110
mkIdentInfos mod (AvailName n) =
96-
[IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
111+
[IdentInfo (nameOccName n) Nothing mod]
97112
mkIdentInfos mod (AvailFL fl) =
98-
[IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
113+
[IdentInfo (nameOccName n) Nothing mod]
99114
where
100115
n = flSelector fl
101116
mkIdentInfos mod (AvailTC parent (n:nn) flds)
102117
-- Following the GHC convention that parent == n if parent is exported
103118
| n == parent
104-
= [ IdentInfo (nameOccName n) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod
119+
= [ IdentInfo (nameOccName n) (Just $! nameOccName parent) mod
105120
| n <- nn ++ map flSelector flds
106121
] ++
107-
[ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
108-
where
109-
parentP = pack $ printName parent
122+
[ IdentInfo (nameOccName n) Nothing mod]
110123

111124
mkIdentInfos mod (AvailTC _ nn flds)
112-
= [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod
125+
= [ IdentInfo (nameOccName n) Nothing mod
113126
| n <- nn ++ map flSelector flds
114127
]
115128

@@ -160,25 +173,20 @@ createExportsMapHieDb withHieDb = do
160173
mods <- withHieDb getAllIndexedMods
161174
idents <- forM (filter (nonInternalModules . modInfoName . hieModInfo) mods) $ \m -> do
162175
let mn = modInfoName $ hieModInfo m
163-
mText = pack $ moduleNameString mn
164-
fmap (wrap . unwrap mText) <$> withHieDb (\hieDb -> getExportsForModule hieDb mn)
176+
fmap (wrap . unwrap mn) <$> withHieDb (\hieDb -> getExportsForModule hieDb mn)
165177
let exportsMap = Map.fromListWith (<>) (concat idents)
166-
return $ ExportsMap exportsMap $ buildModuleExportMap (concat idents)
178+
return $! ExportsMap exportsMap $ buildModuleExportMap (concat idents)
167179
where
168180
wrap identInfo = (rendered identInfo, Set.fromList [identInfo])
169181
-- unwrap :: ExportRow -> IdentInfo
170-
unwrap m ExportRow{..} = IdentInfo exportName n p exportIsDatacon m
171-
where
172-
n = pack (occNameString exportName)
173-
p = pack . occNameString <$> exportParent
182+
unwrap m ExportRow{..} = IdentInfo exportName exportParent m
174183

175184
unpackAvail :: ModuleName -> IfaceExport -> [(Text, Text, [IdentInfo])]
176185
unpackAvail mn
177-
| nonInternalModules mn = map f . mkIdentInfos mod
186+
| nonInternalModules mn = map f . mkIdentInfos mn
178187
| otherwise = const []
179188
where
180-
!mod = pack $ moduleNameString mn
181-
f id@IdentInfo {..} = (printOutputable name, moduleNameText,[id])
189+
f id@IdentInfo {..} = (printOutputable name, moduleNameText id,[id])
182190

183191

184192
identInfoToKeyVal :: IdentInfo -> (ModuleNameText, IdentInfo)
@@ -198,9 +206,9 @@ buildModuleExportMapFrom modIfaces = do
198206

199207
extractModuleExports :: ModIface -> (Text, HashSet IdentInfo)
200208
extractModuleExports modIFace = do
201-
let modName = pack $ moduleNameString $ moduleName $ mi_module modIFace
209+
let modName = moduleName $ mi_module modIFace
202210
let functionSet = Set.fromList $ concatMap (mkIdentInfos modName) $ mi_exports modIFace
203-
(modName, functionSet)
211+
(moduleNameText' modName, functionSet)
204212

205213
sortAndGroup :: [(ModuleNameText, IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo)
206214
sortAndGroup assocs = Map.fromListWith (<>) [(k, Set.fromList [v]) | (k, v) <- assocs]

‎plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs‎

Lines changed: 10 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ import Data.Maybe
3737
import Data.Ord (comparing)
3838
import qualified Data.Set as S
3939
import qualified Data.Text as T
40+
import qualified Data.Text.Encoding as T
4041
import qualified Data.Text.Utf16.Rope as Rope
4142
import Development.IDE.Core.Rules
4243
import Development.IDE.Core.RuleTypes
@@ -986,11 +987,9 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
986987
-- fallback to using GHC suggestion even though it is not always correct
987988
| otherwise
988989
= Just IdentInfo
989-
{ name = mkVarOcc $ T.unpack binding
990-
, rendered = binding
990+
{ name = mkVarOccFS $ mkFastStringByteString $ T.encodeUtf8 binding
991991
, parent = Nothing
992-
, isDatacon = False
993-
, moduleNameText = mod}
992+
, identModuleName = mkModuleNameFS $ mkFastStringByteString $ T.encodeUtf8 mod}
994993
#endif
995994

996995
data HidingMode
@@ -1390,18 +1389,18 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos
13901389
_message
13911390
"‘([^’]*)’ is not a \\(visible\\) method of class ‘([^’]*)’",
13921391
idents <-
1393-
maybe [] (Set.toList . Set.filter (\x -> parent x == Just className)) $
1392+
maybe [] (Set.toList . Set.filter (\x -> fmap occNameText (parent x) == Just className)) $
13941393
Map.lookup methodName $ getExportsMap packageExportsMap =
13951394
mconcat $ suggest <$> idents
13961395
| otherwise = []
13971396
where
1398-
suggest identInfo@IdentInfo {moduleNameText}
1397+
suggest identInfo
13991398
| importStyle <- NE.toList $ importStyles identInfo,
1400-
mImportDecl <- findImportDeclByModuleName (hsmodImports . unLoc . astA $ ps) (T.unpack moduleNameText) =
1399+
mImportDecl <- findImportDeclByModuleName (hsmodImports . unLoc . astA $ ps) (T.unpack moduleText) =
14011400
case mImportDecl of
14021401
-- extend
14031402
Just decl ->
1404-
[ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText,
1403+
[ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleText,
14051404
quickFixImportKind' "extend" style,
14061405
[Right $ uncurry extendImport (unImportStyle style) decl]
14071406
)
@@ -1412,12 +1411,13 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos
14121411
| Just (range, indent) <- newImportInsertRange ps fileContents
14131412
->
14141413
(\(kind, unNewImport -> x) -> (x, kind, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$>
1415-
[ (quickFixImportKind' "new" style, newUnqualImport moduleNameText rendered False)
1414+
[ (quickFixImportKind' "new" style, newUnqualImport moduleText rendered False)
14161415
| style <- importStyle,
14171416
let rendered = renderImportStyle style
14181417
]
1419-
<> [(quickFixImportKind "new.all", newImportAll moduleNameText)]
1418+
<> [(quickFixImportKind "new.all", newImportAll moduleText)]
14201419
| otherwise -> []
1420+
where moduleText = moduleNameText identInfo
14211421
#endif
14221422

14231423
suggestNewImport :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
@@ -1911,4 +1911,3 @@ matchRegExMultipleImports message = do
19111911
_ -> Nothing
19121912
imps <- regExImports imports
19131913
return (binding, imps)
1914-

0 commit comments

Comments
 (0)