718e338 · ghcide · git.iko.soy

git.iko.soy/ghcide

Move to creating a single HscEnv that we reuse in all GHC sessions rather than a fresh one each time (#1179)

commit718e3389c805c2b82783020bd3d779d16c1c3400 authorNeil Mitchell <35463327+neil-da@users.noreply.github.com> dateThu 16 May 2019, 13:17 (7 years ago) parent8158587

6 files changed+73−40

compare with master

unifiedsplit

src/Development/IDE/Functions/AtPoint.hs+2−2 src/Development/IDE/Functions/Compile.hs+29−12 src/Development/IDE/State/RuleTypes.hs+11−7 src/Development/IDE/State/Rules.hs+18−13 src/Development/IDE/Types/Options.hs+2−2 src/Development/IDE/UtilGHC.hs+11−4

src/Development/IDE/Functions/AtPoint.hs+2−2

@@ -41,7 +41,7 @@ import qualified Data.Text as T

4141-- | Locate the definition of the name at a given position.

4242gotoDefinition

4343 :: IdeOptions

44− -> PackageDynFlags

44+ -> HscEnv

4545 -> [SpanInfo]

4646 -> Position

4747 -> Action (Maybe Location)

@@ -86,7 +86,7 @@ atPoint tcs srcSpans pos = do

8686 Just name -> any (`isInfixOf` show name) ["==", "showsPrec"]

8787 Nothing -> False

8888

89−locationsAtPoint :: IdeOptions -> PackageDynFlags -> Position -> [SpanInfo] -> Action [Location]

89+locationsAtPoint :: IdeOptions -> HscEnv -> Position -> [SpanInfo] -> Action [Location]

9090locationsAtPoint IdeOptions{..} pkgState pos =

9191 fmap (map srcSpanToLocation) .

9292 mapMaybeM (getSpan . spaninfoSource) .

src/Development/IDE/Functions/Compile.hs+29−12

@@ -95,12 +95,12 @@ data LoadPackageResult = LoadPackageResult

9595getSrcSpanInfos

9696 :: IdeOptions

9797 -> ParsedModule

98− -> PackageDynFlags

98+ -> HscEnv

9999 -> [(Located ModuleName, Maybe FilePath)]

100100 -> TcModuleResult

101101 -> IO [SpanInfo]

102−getSrcSpanInfos opt mod packageState imports tc =

103− runGhcSession opt (Just mod) packageState

102+getSrcSpanInfos opt mod env imports tc =

103+ runGhcSession opt (Just mod) env

104104 . getSpanInfo imports

105105 $ tmrModule tc

106106

@@ -108,7 +108,7 @@ getSrcSpanInfos opt mod packageState imports tc =

108108-- | Given a string buffer, return a pre-processed @ParsedModule@.

109109parseModule

110110 :: IdeOptions

111− -> PackageDynFlags

111+ -> HscEnv

112112 -> FilePath

113113 -> (UTCTime, SB.StringBuffer)

114114 -> IO ([FileDiagnostic], Maybe ParsedModule)

@@ -118,7 +118,7 @@ parseModule opt@IdeOptions{..} packageState file =

118118 runGhcSessionExcept opt Nothing packageState . parseFileContents optPreprocessor file

119119

120120computePackageDeps ::

121− IdeOptions -> PackageDynFlags -> InstalledUnitId -> IO (Either [FileDiagnostic] [InstalledUnitId])

121+ IdeOptions -> HscEnv -> InstalledUnitId -> IO (Either [FileDiagnostic] [InstalledUnitId])

122122computePackageDeps opts packageState iuid =

123123 Ex.runExceptT $

124124 runGhcSessionExcept opts Nothing packageState $

@@ -138,7 +138,7 @@ getPackage dflags p =

138138typecheckModule

139139 :: IdeOptions

140140 -> ParsedModule

141− -> PackageDynFlags

141+ -> HscEnv

142142 -> UniqSupply

143143 -> [TcModuleResult]

144144 -> [LoadPackageResult]

@@ -157,7 +157,7 @@ typecheckModule opt mod packageState uniqSupply deps pkgs pm =

157157-- | Load a pkg and populate the name cache and external package state.

158158loadPackage ::

159159 IdeOptions

160− -> PackageDynFlags

160+ -> HscEnv

161161 -> UniqSupply

162162 -> [LoadPackageResult]

163163 -> InstalledUnitId

@@ -185,7 +185,7 @@ loadPackage opt packageState us lps p =

185185compileModule

186186 :: IdeOptions

187187 -> ParsedModule

188− -> PackageDynFlags

188+ -> HscEnv

189189 -> UniqSupply

190190 -> [TcModuleResult]

191191 -> [LoadPackageResult]

@@ -222,14 +222,14 @@ compileModule opt mod packageState uniqSupply deps pkgs tmr =

222222runGhcSessionExcept

223223 :: IdeOptions

224224 -> Maybe ParsedModule

225− -> PackageDynFlags

225+ -> HscEnv

226226 -> Ex.ExceptT e Ghc a

227227 -> Ex.ExceptT e IO a

228228runGhcSessionExcept opts mbMod pkg m =

229229 Ex.ExceptT $ runGhcSession opts mbMod pkg $ Ex.runExceptT m

230230

231231

232−getGhcDynFlags :: IdeOptions -> ParsedModule -> PackageDynFlags -> IO DynFlags

232+getGhcDynFlags :: IdeOptions -> ParsedModule -> HscEnv -> IO DynFlags

233233getGhcDynFlags opts mod pkg = runGhcSession opts (Just mod) pkg getSessionDynFlags

234234

235235-- | Evaluate a GHC session using a new environment constructed with

@@ -237,10 +237,27 @@ getGhcDynFlags opts mod pkg = runGhcSession opts (Just mod) pkg getSessionDynFla

237237runGhcSession

238238 :: IdeOptions

239239 -> Maybe ParsedModule

240− -> PackageDynFlags

240+ -> HscEnv

241241 -> Ghc a

242242 -> IO a

243−runGhcSession IdeOptions{..} = optRunGhcSession

243+runGhcSession IdeOptions{..} modu env act = runGhcEnv env $ do

244+ modifyDynFlags $ \x -> x{importPaths = maybe [] moduleImportPaths modu ++ importPaths x}

245+ act

246+

247+

248+moduleImportPaths :: GHC.ParsedModule -> [FilePath]

249+moduleImportPaths pm =

250+ maybe [] (\modRoot -> [modRoot]) mbModuleRoot

251+ where

252+ ms = GHC.pm_mod_summary pm

253+ file = GHC.ms_hspp_file ms

254+ mod' = GHC.ms_mod ms

255+ rootPathDir = takeDirectory file

256+ rootModDir = takeDirectory . moduleNameSlashes . GHC.moduleName $ mod'

257+ mbModuleRoot

258+ | rootModDir == "." = Just rootPathDir

259+ | otherwise = dropTrailingPathSeparator <$> stripSuffix rootModDir rootPathDir

260+

244261

245262-- When we make a fresh GHC environment, the OrigNameCache comes already partially

246263-- populated. So to be safe, we simply extend this one.

src/Development/IDE/State/RuleTypes.hs+11−7

@@ -15,7 +15,6 @@ module Development.IDE.State.RuleTypes(

1515import Control.DeepSeq

1616import Development.IDE.Functions.Compile (TcModuleResult, GhcModule, LoadPackageResult(..))

1717import qualified Development.IDE.Functions.Compile as Compile

18−import qualified Development.IDE.UtilGHC as Compile

1918import Development.IDE.Functions.FindImports (Import(..))

2019import Development.IDE.Functions.DependencyInformation

2120import Data.Hashable

@@ -61,9 +60,8 @@ type instance RuleResult GetSpanInfo = [SpanInfo]

6160-- | Convert to Core, requires TypeCheck*

6261type instance RuleResult GenerateCore = GhcModule

6362

64−-- | We capture the subset of `DynFlags` that is computed by package initialization in a rule to

65−-- make session initialization cheaper by reusing it.

66−type instance RuleResult LoadPackageState = Compile.PackageDynFlags

63+-- | A GHC session that we reuse.

64+type instance RuleResult GhcSession = HscEnv

6765

6866-- | Resolve the imports in a module to the list of either external packages or absolute file paths

6967-- for modules in the same package.

@@ -128,10 +126,10 @@ data GenerateCore = GenerateCore

128126instance Hashable GenerateCore

129127instance NFData GenerateCore

130128

131−data LoadPackageState = LoadPackageState

129+data GhcSession = GhcSession

132130 deriving (Eq, Show, Typeable, Generic)

133−instance Hashable LoadPackageState

134−instance NFData LoadPackageState

131+instance Hashable GhcSession

132+instance NFData GhcSession

135133

136134-- Note that we embed the filepath here instead of using the filepath associated with Shake keys.

137135-- Otherwise we will garbage collect the result since files in package dependencies will not be declared reachable.

@@ -161,6 +159,12 @@ instance Show ParsedModule where

161159instance NFData ModSummary where

162160 rnf = rwhnf

163161

162+instance Show HscEnv where

163+ show _ = "HscEnv"

164+

165+instance NFData HscEnv where

166+ rnf = rwhnf

167+

164168instance NFData ParsedModule where

165169 rnf = rwhnf

166170

src/Development/IDE/State/Rules.hs+18−13

@@ -35,6 +35,7 @@ import Development.IDE.State.FileStore

3535import Development.IDE.Types.Diagnostics as Base

3636import Data.Bifunctor

3737import Data.Either.Extra

38+import Development.IDE.UtilGHC

3839import Data.Maybe

3940import Data.Foldable

4041import qualified Data.Map.Strict as Map

@@ -46,6 +47,7 @@ import Development.IDE.Types.LSP as Compiler

4647import Development.IDE.State.RuleTypes

4748

4849import GHC

50+import HscTypes

4951import Development.IDE.Compat

5052import UniqSupply

5153import Module as M

@@ -153,7 +155,7 @@ getAtPointForFile file pos = do

153155getDefinitionForFile :: FilePath -> Position -> ExceptT [FileDiagnostic] Action (Maybe Location)

154156getDefinitionForFile file pos = do

155157 spans <- useE GetSpanInfo file

156− pkgState <- useE LoadPackageState ""

158+ pkgState <- useE GhcSession ""

157159 opts <- lift getOpts

158160 lift $ AtPoint.gotoDefinition opts pkgState spans pos

159161

@@ -177,7 +179,7 @@ getParsedModuleRule :: Rules ()

177179getParsedModuleRule =

178180 define $ \GetParsedModule file -> do

179181 contents <- getFileContents file

180− packageState <- use_ LoadPackageState ""

182+ packageState <- use_ GhcSession ""

181183 opt <- getOpts

182184 liftIO $ Compile.parseModule opt packageState file contents

183185

@@ -187,7 +189,7 @@ getLocatedImportsRule =

187189 pm <- use_ GetParsedModule file

188190 let ms = pm_mod_summary pm

189191 let imports = ms_textual_imps ms

190− packageState <- use_ LoadPackageState ""

192+ packageState <- use_ GhcSession ""

191193 opt <- getOpts

192194 dflags <- liftIO $ Compile.getGhcDynFlags opt pm packageState

193195 xs <- forM imports $ \(mbPkgName, modName) ->

@@ -209,7 +211,7 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty

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

210212 in go fs modGraph' pkgs

211213 Just imports -> do

212− packageState <- lift $ use_ LoadPackageState ""

214+ packageState <- lift $ use_ GhcSession ""

213215 opt <- lift getOpts

214216 modOrPkgImports <- forM imports $ \imp -> do

215217 case imp of

@@ -277,7 +279,7 @@ getSpanInfoRule =

277279 pm <- use_ GetParsedModule file

278280 tc <- use_ TypeCheck file

279281 imports <- use_ GetLocatedImports file

280− packageState <- use_ LoadPackageState ""

282+ packageState <- use_ GhcSession ""

281283 opt <- getOpts

282284 x <- liftIO $ Compile.getSrcSpanInfos opt pm packageState (fileImports imports) tc

283285 return ([], Just x)

@@ -292,7 +294,7 @@ typeCheckRule =

292294 tms <- uses_ TypeCheck (transitiveModuleDeps deps)

293295 setPriority PriorityTypeCheck

294296 us <- getUniqSupply

295− packageState <- use_ LoadPackageState ""

297+ packageState <- use_ GhcSession ""

296298 opt <- getOpts

297299 liftIO $ Compile.typecheckModule opt pm packageState us tms lps pm

298300

@@ -300,7 +302,7 @@ typeCheckRule =

300302loadPackageRule :: Rules ()

301303loadPackageRule =

302304 defineNoFile $ \(LoadPackage pkg) -> do

303− packageState <- use_ LoadPackageState ""

305+ packageState <- use_ GhcSession ""

304306 opt <- getOpts

305307 pkgs <- liftIO $ Compile.computePackageDeps opt packageState pkg

306308 case pkgs of

@@ -324,16 +326,19 @@ generateCoreRule =

324326 let pm = tm_parsed_module . Compile.tmrModule $ tm

325327 setPriority PriorityGenerateDalf

326328 us <- getUniqSupply

327− packageState <- use_ LoadPackageState ""

329+ packageState <- use_ GhcSession ""

328330 opt <- getOpts

329331 liftIO $ Compile.compileModule opt pm packageState us tms lps tm

330332

331−loadPackageStateRule :: Rules ()

332−loadPackageStateRule =

333− defineNoFile $ \LoadPackageState -> do

333+loadGhcSession :: Rules ()

334+loadGhcSession =

335+ defineNoFile $ \GhcSession -> do

334336 opts <- envOptions <$> getServiceEnv

335− liftIO $ Compile.generatePackageState

337+ env <- Compile.optGhcSession opts

338+ pkg <- liftIO $ Compile.generatePackageState

336339 (Compile.optPackageDbs opts) (Compile.optHideAllPkgs opts) (Compile.optPackageImports opts)

340+ return env{hsc_dflags = setPackageDynFlags pkg $ hsc_dflags env}

341+

337342

338343getHieFileRule :: Rules ()

339344getHieFileRule =

@@ -353,7 +358,7 @@ mainRule = do

353358 typeCheckRule

354359 getSpanInfoRule

355360 generateCoreRule

356− loadPackageStateRule

361+ loadGhcSession

357362 loadPackageRule

358363 getHieFileRule

359364

src/Development/IDE/Types/Options.hs+2−2

@@ -9,14 +9,14 @@ module Development.IDE.Types.Options

99 , IdePkgLocationOptions(..)

1010 ) where

1111

12−import Development.IDE.UtilGHC

12+import Development.Shake

1313import GHC hiding (parseModule, typecheckModule)

1414import GhcPlugins as GHC hiding (fst3, (<>))

1515

1616

1717data IdeOptions = IdeOptions

1818 { optPreprocessor :: GHC.ParsedSource -> ([(GHC.SrcSpan, String)], GHC.ParsedSource)

19− , optRunGhcSession :: forall a. Maybe ParsedModule -> PackageDynFlags -> Ghc a -> IO a

19+ , optGhcSession :: Action HscEnv

2020 -- ^ Setup a GHC session using a given package state. If a `ParsedModule` is supplied,

2121 -- the import path should be setup for that module.

2222 , optPkgLocationOpts :: IdePkgLocationOptions

src/Development/IDE/UtilGHC.hs+11−4

@@ -17,7 +17,8 @@ module Development.IDE.UtilGHC(

1717 setPackageDbs,

1818 fakeDynFlags,

1919 prettyPrint,

20− runGhcFast

20+ runGhcFast,

21+ runGhcEnv

2122 ) where

2223

2324import Config

@@ -89,20 +90,26 @@ getPackageDynFlags DynFlags{..} = PackageDynFlags

8990 , pdfThisUnitIdInsts = thisUnitIdInsts_

9091 }

9192

92−lookupPackageConfig :: UnitId -> PackageDynFlags -> Maybe PackageConfig

93−lookupPackageConfig unitId PackageDynFlags {..} =

93+lookupPackageConfig :: UnitId -> HscEnv -> Maybe PackageConfig

94+lookupPackageConfig unitId env =

9495 lookupPackage' False pkgConfigMap unitId

9596 where

9697 pkgConfigMap =

9798 -- For some weird reason, the GHC API does not provide a way to get the PackageConfigMap

9899 -- from PackageState so we have to wrap it in DynFlags first.

99− getPackageConfigMap fakeDynFlags { pkgState = pdfPkgState }

100+ getPackageConfigMap $ hsc_dflags env

100101

101102

102103

103104prettyPrint :: Outputable a => a -> String

104105prettyPrint = showSDoc fakeDynFlags . ppr

105106

107+runGhcEnv :: HscEnv -> Ghc a -> IO a

108+runGhcEnv env act = do

109+ ref <- newIORef env

110+ unGhc act $ Session ref

111+

112+

106113-- | Like 'runGhc' but much faster (400x), with less IO and no file dependency

107114runGhcFast :: Ghc a -> IO a

108115-- copied from GHC with the nasty bits dropped