Performance improvements for GetSpanInfo (#681)

* Performance improvements

getSpanInfo was naively calling getDocumentations multiple times on the same
name. Fixed by deduplicating these calls.

getDocumentations is implemented on top of InteractiveEval.getDocs, which does
a lot of Ghc setup internally and is very inefficient. Fixed by introducing a
batch version of getDocs and batching all the calls in getSpanInfo

name          | success | samples | startup | setup | experiment | maxResidency
------------- | ------- | ------- | ------- | ----- | ---------- | ------------
edit (before) | True    | 10      | 6.94s   | 0.00s | 6.57s      | 177MB
edit (after)  | True    | 10      | 6.44s   | 0.00s | 4.38s      | 174MB

* More performance improvements

Played the deduplication trick on lookupName, which is slow for the same reasons
as getDocs. Batching made a smaller difference in my measurements, so did
not implement it

* Fix redundant constraints

* Skip the GHCi code paths for documentation

We don't use the interactive module, so there's no reason to go through the GHCi
code paths. Moreover, they apparently cause problems with ghc-lib.

* Skip the GHCi paths for lookupName

* Correctly load the module interface

* Compatibility with GHC 8.4 and 8.6

* Fix ghc-lib build

Author: pepeiborra

src/Development/IDE/Core/Compile.hs

@@ -26,6 +26,8 @@ module Development.IDE.Core.Compile
   , loadDepModule
   , loadModuleHome
   , setupFinderCache
+  , getDocsBatch
+  , lookupName
   ) where
 
 import Development.IDE.Core.RuleTypes
@@ -41,10 +43,10 @@ import Development.IDE.Types.Options
 import Development.IDE.Types.Location
 
 #if MIN_GHC_API_VERSION(8,6,0)
-import           DynamicLoading (initializePlugins)
+import DynamicLoading (initializePlugins)
+import LoadIface (loadModuleInterface)
 #endif
 
-import           GHC hiding (parseModule, typecheckModule)
 import qualified Parser
 import           Lexer
 #if MIN_GHC_API_VERSION(8,10,0)
@@ -53,6 +55,7 @@ import ErrUtils
 #endif
 
 import           Finder
+import           Development.IDE.GHC.Compat hiding (parseModule, typecheckModule)
 import qualified Development.IDE.GHC.Compat     as GHC
 import qualified Development.IDE.GHC.Compat     as Compat
 import           GhcMonad
@@ -61,7 +64,7 @@ import qualified HeaderInfo                     as Hdr
 import           HscMain                        (hscInteractive, hscSimplify)
 import           MkIface
 import           StringBuffer                   as SB
-import           TcRnMonad (initIfaceLoad, tcg_th_coreplugins)
+import           TcRnMonad (tct_id, TcTyThing(AGlobal, ATcId), initTc, initIfaceLoad, tcg_th_coreplugins)
 import           TcIface                        (typecheckIface)
 import           TidyPgm
 
@@ -81,6 +84,7 @@ import           System.IO.Extra
 import Control.DeepSeq (rnf)
 import Control.Exception (evaluate)
 import Exception (ExceptionMonad)
+import TcEnv (tcLookup)
 
 
 -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
@@ -621,3 +625,58 @@ loadInterface session ms sourceMod regen = do
             | not (mi_used_th x) || SourceUnmodifiedAndStable == sourceMod
             -> return ([], Just $ HiFileResult ms x)
           (_reason, _) -> regen
+
+-- | Non-interactive, batch version of 'InteractiveEval.getDocs'.
+--   The interactive paths create problems in ghc-lib builds
+--- and leads to fun errors like "Cannot continue after interface file error".
+getDocsBatch :: GhcMonad m
+        => Module  -- ^ a moudle where the names are in scope
+        -> [Name]
+        -> m [Either String (Maybe HsDocString, Map.Map Int HsDocString)]
+getDocsBatch _mod _names =
+#if MIN_GHC_API_VERSION(8,6,0)
+  withSession $ \hsc_env -> liftIO $ do
+    ((_warns,errs), res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ forM _names $ \name ->
+        case nameModule_maybe name of
+            Nothing -> return (Left $ NameHasNoModule name)
+            Just mod -> do
+             ModIface { mi_doc_hdr = mb_doc_hdr
+                      , mi_decl_docs = DeclDocMap dmap
+                      , mi_arg_docs = ArgDocMap amap
+                      } <- loadModuleInterface "getModuleInterface" mod
+             if isNothing mb_doc_hdr && Map.null dmap && Map.null amap
+               then pure (Left (NoDocsInIface mod $ compiled name))
+               else pure (Right ( Map.lookup name dmap
+                                , Map.findWithDefault Map.empty name amap))
+    case res of
+        Just x -> return $ map (first prettyPrint) x
+        Nothing -> throwErrors errs
+  where
+    throwErrors = liftIO . throwIO . mkSrcErr
+    compiled n =
+      -- TODO: Find a more direct indicator.
+      case nameSrcLoc n of
+        RealSrcLoc {} -> False
+        UnhelpfulLoc {} -> True
+#else
+    return []
+#endif
+
+fakeSpan :: RealSrcSpan
+fakeSpan = realSrcLocSpan $ mkRealSrcLoc (fsLit "<ghcide>") 1 1
+
+-- | Non-interactive, batch version of 'InteractiveEval.lookupNames'.
+--   The interactive paths create problems in ghc-lib builds
+--- and leads to fun errors like "Cannot continue after interface file error".
+lookupName :: GhcMonad m
+           => Module -- ^ A module where the Names are in scope
+           -> Name
+           -> m (Maybe TyThing)
+lookupName mod name = withSession $ \hsc_env -> liftIO $ do
+    (_messages, res) <- initTc hsc_env HsSrcFile False mod fakeSpan $ do
+        tcthing <- tcLookup name
+        case tcthing of
+            AGlobal thing    -> return thing
+            ATcId{tct_id=id} -> return (AnId id)
+            _ -> panic "tcRnLookupName'"
+    return res

src/Development/IDE/GHC/Compat.hs

@@ -83,6 +83,7 @@ import GHC hiding (
       VarPat,
       ModLocation,
       HasSrcSpan,
+      lookupName,
       getLoc
 #if MIN_GHC_API_VERSION(8,6,0)
     , getConArgs

src/Development/IDE/GHC/Util.hs

@@ -27,7 +27,7 @@ module Development.IDE.GHC.Util(
     readFileUtf8,
     hDuplicateTo',
     setHieDir,
-    dontWriteHieFiles
+    dontWriteHieFiles,
     ) where
 
 import Control.Concurrent

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

@@ -36,6 +36,7 @@ import Coercion
 import Language.Haskell.LSP.Types
 import Language.Haskell.LSP.Types.Capabilities
 import qualified Language.Haskell.LSP.VFS as VFS
+import Development.IDE.Core.Compile
 import Development.IDE.Plugin.Completions.Types
 import Development.IDE.Spans.Documentation
 import Development.IDE.GHC.Compat as GHC
@@ -230,7 +231,8 @@ cacheDataProducer :: HscEnv -> TypecheckedModule -> [ParsedModule] -> IO CachedC
 cacheDataProducer packageState tm deps = do
   let parsedMod = tm_parsed_module tm
       dflags = hsc_dflags packageState
-      curMod = moduleName $ ms_mod $ pm_mod_summary parsedMod
+      curMod = ms_mod $ pm_mod_summary parsedMod
+      curModName = moduleName curMod
       Just (_,limports,_,_) = tm_renamed_source tm
 
       iDeclToModName :: ImportDecl name -> ModuleName
@@ -263,11 +265,11 @@ cacheDataProducer packageState tm deps = do
         case lookupTypeEnv typeEnv n of
           Just tt -> case safeTyThingId tt of
             Just var -> (\x -> ([x],mempty)) <$> varToCompl var
-            Nothing -> (\x -> ([x],mempty)) <$> toCompItem curMod n
-          Nothing -> (\x -> ([x],mempty)) <$> toCompItem curMod n
+            Nothing -> (\x -> ([x],mempty)) <$> toCompItem curMod curModName n
+          Nothing -> (\x -> ([x],mempty)) <$> toCompItem curMod curModName n
       getComplsForOne (GRE n _ False prov) =
         flip foldMapM (map is_decl prov) $ \spec -> do
-          compItem <- toCompItem (is_mod spec) n
+          compItem <- toCompItem curMod (is_mod spec) n
           let unqual
                 | is_qual spec = []
                 | otherwise = [compItem]
@@ -282,21 +284,15 @@ cacheDataProducer packageState tm deps = do
       varToCompl var = do
         let typ = Just $ varType var
             name = Var.varName var
-        docs <- evalGhcEnv packageState $ getDocumentationTryGhc (tm_parsed_module tm : deps) name
-        return $ mkNameCompItem name curMod typ Nothing docs
-
-      toCompItem :: ModuleName -> Name -> IO CompItem
-      toCompItem mn n = do
-        docs <- evalGhcEnv packageState $ getDocumentationTryGhc (tm_parsed_module tm : deps) n
--- lookupName uses runInteractiveHsc, i.e., GHCi stuff which does not work with GHCi
--- and leads to fun errors like "Cannot continue after interface file error".
-#ifdef GHC_LIB
-        let ty = Right Nothing
-#else
+        docs <- evalGhcEnv packageState $ getDocumentationTryGhc curMod (tm_parsed_module tm : deps) name
+        return $ mkNameCompItem name curModName typ Nothing docs
+
+      toCompItem :: Module -> ModuleName -> Name -> IO CompItem
+      toCompItem m mn n = do
+        docs <- evalGhcEnv packageState $ getDocumentationTryGhc curMod (tm_parsed_module tm : deps) n
         ty <- evalGhcEnv packageState $ catchSrcErrors "completion" $ do
-                name' <- lookupName n
+                name' <- lookupName m n
                 return $ name' >>= safeTyThingType
-#endif
         return $ mkNameCompItem n mn (either (const Nothing) id ty) Nothing docs
 
   (unquals,quals) <- getCompls rdrElts