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).

Author: wz1000

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

@@ -43,6 +43,8 @@ module Development.IDE.GHC.Compat(
 #endif
 
     FastStringCompat,
+    bytesFS,
+    mkFastStringByteString,
     nodeInfo',
     getNodeIds,
     sourceNodeInfo,
@@ -206,6 +208,7 @@ import           VarEnv                                (emptyInScopeSet,
 #endif
 
 #if MIN_VERSION_ghc(9,0,0)
+import           GHC.Data.FastString
 import           GHC.Core
 import           GHC.Data.StringBuffer
 import           GHC.Driver.Session                    hiding (ExposePackage)
@@ -224,6 +227,7 @@ import           GHC.Iface.Make                        (mkIfaceExports)
 import qualified GHC.SysTools.Tasks                    as SysTools
 import qualified GHC.Types.Avail                       as Avail
 #else
+import           FastString
 import qualified Avail
 import           DynFlags                              hiding (ExposePackage)
 import           HscTypes

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

@@ -284,24 +284,26 @@ mkExtCompl label =
 
 
 fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
-fromIdentInfo doc IdentInfo{..} q = CI
+fromIdentInfo doc id@IdentInfo{..} q = CI
   { compKind= occNameToComKind name
-  , insertText=rendered
-  , provenance = DefinedIn moduleNameText
-  , label=rendered
+  , insertText=rend
+  , provenance = DefinedIn mod
+  , label=rend
   , isInfix=Nothing
-  , isTypeCompl= not isDatacon && isUpper (T.head rendered)
+  , isTypeCompl= not (isDatacon id) && isUpper (T.head rend)
   , additionalTextEdits= Just $
         ExtendImport
           { doc,
-            thingParent = parent,
-            importName = moduleNameText,
+            thingParent = occNameText <$> parent,
+            importName = mod,
             importQual = q,
-            newThing = rendered
+            newThing = rend
           }
   , nameDetails = Nothing
   , isLocalCompletion = False
   }
+  where rend = rendered id
+        mod = moduleNameText id
 
 cacheDataProducer :: Uri -> [ModuleName] -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> CachedCompletions
 cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports =

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

@@ -5,6 +5,10 @@ module Development.IDE.Types.Exports
 (
     IdentInfo(..),
     ExportsMap(..),
+    rendered,
+    moduleNameText,
+    occNameText,
+    isDatacon,
     createExportsMap,
     createExportsMapMg,
     createExportsMapTc,
@@ -24,6 +28,7 @@ import           Data.HashSet                (HashSet)
 import qualified Data.HashSet                as Set
 import           Data.List                   (foldl', isSuffixOf)
 import           Data.Text                   (Text, pack)
+import           Data.Text.Encoding          (decodeUtf8)
 import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.Orphans ()
 import           Development.IDE.GHC.Util
@@ -61,55 +66,63 @@ instance Monoid ExportsMap where
 type IdentifierText = Text
 type ModuleNameText = Text
 
+
+rendered :: IdentInfo -> IdentifierText
+rendered = occNameText . name
+
+-- | Render an identifier as imported or exported style.
+-- TODO: pattern synonymoccNameText :: OccName -> Text
+occNameText :: OccName -> IdentifierText
+occNameText name
+  | isTcOcc name && isSymOcc name = "type " <> renderOcc
+  | otherwise = renderOcc
+  where
+    renderOcc = decodeUtf8 . bytesFS . occNameFS $ name
+
+moduleNameText :: IdentInfo -> ModuleNameText
+moduleNameText = moduleNameText' . identModuleName
+
+moduleNameText' :: ModuleName -> ModuleNameText
+moduleNameText' = decodeUtf8 . bytesFS . moduleNameFS
+
 data IdentInfo = IdentInfo
-    { name           :: !OccName
-    , rendered       :: Text
-    , parent         :: !(Maybe Text)
-    , isDatacon      :: !Bool
-    , moduleNameText :: !Text
+    { name            :: !OccName
+    , parent          :: !(Maybe OccName)
+    , identModuleName :: !ModuleName
     }
     deriving (Generic, Show)
     deriving anyclass Hashable
 
+isDatacon :: IdentInfo -> Bool
+isDatacon = isDataOcc . name
+
 instance Eq IdentInfo where
     a == b = name a == name b
           && parent a == parent b
-          && isDatacon a == isDatacon b
-          && moduleNameText a == moduleNameText b
+          && identModuleName a == identModuleName b
 
 instance NFData IdentInfo where
     rnf IdentInfo{..} =
         -- deliberately skip the rendered field
-        rnf name `seq` rnf parent `seq` rnf isDatacon `seq` rnf moduleNameText
-
--- | Render an identifier as imported or exported style.
--- TODO: pattern synonym
-renderIEWrapped :: Name -> Text
-renderIEWrapped n
-  | isTcOcc occ && isSymOcc occ = "type " <> pack (printName n)
-  | otherwise = pack $ printName n
-  where
-    occ = occName n
+        rnf name `seq` rnf parent `seq` rnf identModuleName
 
-mkIdentInfos :: Text -> AvailInfo -> [IdentInfo]
+mkIdentInfos :: ModuleName -> AvailInfo -> [IdentInfo]
 mkIdentInfos mod (AvailName n) =
-    [IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
+    [IdentInfo (nameOccName n) Nothing mod]
 mkIdentInfos mod (AvailFL fl) =
-    [IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
+    [IdentInfo (nameOccName n) Nothing mod]
     where
       n = flSelector fl
 mkIdentInfos mod (AvailTC parent (n:nn) flds)
     -- Following the GHC convention that parent == n if parent is exported
     | n == parent
-    = [ IdentInfo (nameOccName n) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod
+    = [ IdentInfo (nameOccName n) (Just $! nameOccName parent) mod
         | n <- nn ++ map flSelector flds
       ] ++
-      [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
-    where
-        parentP = pack $ printName parent
+      [ IdentInfo (nameOccName n) Nothing mod]
 
 mkIdentInfos mod (AvailTC _ nn flds)
-    = [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod
+    = [ IdentInfo (nameOccName n) Nothing mod
         | n <- nn ++ map flSelector flds
       ]
 
@@ -160,25 +173,20 @@ createExportsMapHieDb withHieDb = do
     mods <- withHieDb getAllIndexedMods
     idents <- forM (filter (nonInternalModules . modInfoName . hieModInfo) mods) $ \m -> do
         let mn = modInfoName $ hieModInfo m
-            mText = pack $ moduleNameString mn
-        fmap (wrap . unwrap mText) <$> withHieDb (\hieDb -> getExportsForModule hieDb mn)
+        fmap (wrap . unwrap mn) <$> withHieDb (\hieDb -> getExportsForModule hieDb mn)
     let exportsMap = Map.fromListWith (<>) (concat idents)
-    return $ ExportsMap exportsMap $ buildModuleExportMap (concat idents)
+    return $! ExportsMap exportsMap $ buildModuleExportMap (concat idents)
   where
     wrap identInfo = (rendered identInfo, Set.fromList [identInfo])
     -- unwrap :: ExportRow -> IdentInfo
-    unwrap m ExportRow{..} = IdentInfo exportName n p exportIsDatacon m
-      where
-          n = pack (occNameString exportName)
-          p = pack . occNameString <$> exportParent
+    unwrap m ExportRow{..} = IdentInfo exportName exportParent m
 
 unpackAvail :: ModuleName -> IfaceExport -> [(Text, Text, [IdentInfo])]
 unpackAvail mn
-  | nonInternalModules mn = map f . mkIdentInfos mod
+  | nonInternalModules mn = map f . mkIdentInfos mn
   | otherwise = const []
   where
-    !mod = pack $ moduleNameString mn
-    f id@IdentInfo {..} = (printOutputable name, moduleNameText,[id])
+    f id@IdentInfo {..} = (printOutputable name, moduleNameText id,[id])
 
 
 identInfoToKeyVal :: IdentInfo -> (ModuleNameText, IdentInfo)
@@ -198,9 +206,9 @@ buildModuleExportMapFrom modIfaces = do
 
 extractModuleExports :: ModIface -> (Text, HashSet IdentInfo)
 extractModuleExports modIFace = do
-  let modName = pack $ moduleNameString $ moduleName $ mi_module modIFace
+  let modName = moduleName $ mi_module modIFace
   let functionSet = Set.fromList $ concatMap (mkIdentInfos modName) $ mi_exports modIFace
-  (modName, functionSet)
+  (moduleNameText' modName, functionSet)
 
 sortAndGroup :: [(ModuleNameText, IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo)
 sortAndGroup assocs = Map.fromListWith (<>) [(k, Set.fromList [v]) | (k, v) <- assocs]

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

@@ -37,6 +37,7 @@ import           Data.Maybe
 import           Data.Ord                                          (comparing)
 import qualified Data.Set                                          as S
 import qualified Data.Text                                         as T
+import qualified Data.Text.Encoding                                as T
 import qualified Data.Text.Utf16.Rope                              as Rope
 import           Data.Tuple.Extra                                  (fst3)
 import           Development.IDE.Core.Rules
@@ -1048,11 +1049,9 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
             -- fallback to using GHC suggestion even though it is not always correct
           | otherwise
           = Just IdentInfo
-                { name = mkVarOcc $ T.unpack binding
-                , rendered = binding
+                { name = mkVarOccFS $ mkFastStringByteString $ T.encodeUtf8 binding
                 , parent = Nothing
-                , isDatacon = False
-                , moduleNameText = mod}
+                , identModuleName  = mkModuleNameFS $ mkFastStringByteString $ T.encodeUtf8 mod}
 #endif
 
 data HidingMode
@@ -1452,18 +1451,18 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos
         _message
         "‘([^’]*)’ is not a \\(visible\\) method of class ‘([^’]*)’",
     idents <-
-      maybe [] (Set.toList . Set.filter (\x -> parent x == Just className)) $
+      maybe [] (Set.toList . Set.filter (\x -> fmap occNameText (parent x) == Just className)) $
         Map.lookup methodName $ getExportsMap packageExportsMap =
     mconcat $ suggest <$> idents
   | otherwise = []
   where
-    suggest identInfo@IdentInfo {moduleNameText}
+    suggest identInfo
       | importStyle <- NE.toList $ importStyles identInfo,
-        mImportDecl <- findImportDeclByModuleName (hsmodImports . unLoc . astA $ ps) (T.unpack moduleNameText) =
+        mImportDecl <- findImportDeclByModuleName (hsmodImports . unLoc . astA $ ps) (T.unpack moduleText) =
         case mImportDecl of
           -- extend
           Just decl ->
-            [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText,
+            [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleText,
                 quickFixImportKind' "extend" style,
                 [Right $ uncurry extendImport (unImportStyle style) decl]
               )
@@ -1474,12 +1473,13 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos
             | Just (range, indent) <- newImportInsertRange ps fileContents
             ->
              (\(kind, unNewImport -> x) -> (x, kind, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$>
-            [ (quickFixImportKind' "new" style, newUnqualImport moduleNameText rendered False)
+            [ (quickFixImportKind' "new" style, newUnqualImport moduleText rendered False)
               | style <- importStyle,
                 let rendered = renderImportStyle style
             ]
-              <> [(quickFixImportKind "new.all", newImportAll moduleNameText)]
+              <> [(quickFixImportKind "new.all", newImportAll moduleText)]
             | otherwise -> []
+        where moduleText = moduleNameText identInfo
 #endif
 
 suggestNewImport :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
@@ -2039,16 +2039,18 @@ data ImportStyle
   deriving Show
 
 importStyles :: IdentInfo -> NonEmpty ImportStyle
-importStyles IdentInfo {parent, rendered, isDatacon}
-  | Just p <- parent
+importStyles i@IdentInfo {parent}
+  | Just p <- pr
     -- Constructors always have to be imported via their parent data type, but
     -- methods and associated type/data families can also be imported as
     -- top-level exports.
-  = ImportViaParent rendered p
-      :| [ImportTopLevel rendered | not isDatacon]
+  = ImportViaParent rend p
+      :| [ImportTopLevel rend | not (isDatacon i)]
       <> [ImportAllConstructors p]
   | otherwise
-  = ImportTopLevel rendered :| []
+  = ImportTopLevel rend :| []
+  where rend = rendered i
+        pr = occNameText <$> parent
 
 -- | Used for adding new imports
 renderImportStyle :: ImportStyle -> T.Text