From bdb19068d581114bacadb1c67bc2f4b8997e2c68 Mon Sep 17 00:00:00 2001 From: Elodie Lander Date: Tue, 27 Jun 2023 07:16:14 -0500 Subject: [PATCH 1/5] Remove extra call to newHscEnvEqWithImportPaths --- ghcide/src/Development/IDE/Core/Rules.hs | 27 +++----------------- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 2 +- 2 files changed, 4 insertions(+), 25 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index e94b7f23f2..6f3f2bf42e 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -100,6 +100,7 @@ import qualified Data.Text.Encoding as T import Data.Time (UTCTime (..)) import Data.Tuple.Extra import Data.Typeable (cast) +import qualified Data.Unique as Unique import Development.IDE.Core.Compile import Development.IDE.Core.FileExists hiding (LogShake, Log) import Development.IDE.Core.FileStore (getFileContents, @@ -771,35 +772,13 @@ ghcSessionDepsDefinition Bool -> GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq) ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do - let hsc = hscEnv env - mbdeps <- mapM(fmap artifactFilePath . snd) <$> use_ GetLocatedImports file case mbdeps of Nothing -> return Nothing Just deps -> do when checkForImportCycles $ void $ uses_ ReportImportCycles deps - ms <- msrModSummary <$> if fullModSummary - then use_ GetModSummary file - else use_ GetModSummaryWithoutTimestamps file - - depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps - ifaces <- uses_ GetModIface deps - let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces -#if MIN_VERSION_ghc(9,3,0) - -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph - -- also points to all the direct descendants of the current module. To get the keys for the descendants - -- we must get their `ModSummary`s - !final_deps <- do - dep_mss <- map msrModSummary <$> uses_ GetModSummaryWithoutTimestamps deps - -- Don't want to retain references to the entire ModSummary when just the key will do - return $!! map (NodeKey_Module . msKey) dep_mss - let moduleNode = (ms, final_deps) -#else - let moduleNode = ms -#endif - session' <- liftIO $ mergeEnvs hsc moduleNode inLoadOrder depSessions - - Just <$> liftIO (newHscEnvEqWithImportPaths (envImportPaths env) session' []) + let updateUnique newUnique = env { envUnique = newUnique } + Just . updateUnique <$> liftIO Unique.newUnique -- | Load a iface from disk, or generate it if there isn't one or it is out of date -- This rule also ensures that the `.hie` and `.o` (if needed) files are written out. diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index efb89b9716..58879a916b 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -1,5 +1,5 @@ module Development.IDE.Types.HscEnvEq -( HscEnvEq, +( HscEnvEq(envUnique), hscEnv, newHscEnvEq, hscEnvWithImportPaths, newHscEnvEqPreserveImportPaths, From b9a8454df9e20a7e3efe3472292cf24a62f7e64d Mon Sep 17 00:00:00 2001 From: Elodie Lander Date: Tue, 27 Jun 2023 07:27:17 -0500 Subject: [PATCH 2/5] Revert "Remove extra call to newHscEnvEqWithImportPaths" This reverts commit 376ada05d39a5a978049d79fb5631b152a4159ec. --- ghcide/src/Development/IDE/Core/Rules.hs | 27 +++++++++++++++++--- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 2 +- 2 files changed, 25 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 6f3f2bf42e..e94b7f23f2 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -100,7 +100,6 @@ import qualified Data.Text.Encoding as T import Data.Time (UTCTime (..)) import Data.Tuple.Extra import Data.Typeable (cast) -import qualified Data.Unique as Unique import Development.IDE.Core.Compile import Development.IDE.Core.FileExists hiding (LogShake, Log) import Development.IDE.Core.FileStore (getFileContents, @@ -772,13 +771,35 @@ ghcSessionDepsDefinition Bool -> GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq) ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do + let hsc = hscEnv env + mbdeps <- mapM(fmap artifactFilePath . snd) <$> use_ GetLocatedImports file case mbdeps of Nothing -> return Nothing Just deps -> do when checkForImportCycles $ void $ uses_ ReportImportCycles deps - let updateUnique newUnique = env { envUnique = newUnique } - Just . updateUnique <$> liftIO Unique.newUnique + ms <- msrModSummary <$> if fullModSummary + then use_ GetModSummary file + else use_ GetModSummaryWithoutTimestamps file + + depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps + ifaces <- uses_ GetModIface deps + let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces +#if MIN_VERSION_ghc(9,3,0) + -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph + -- also points to all the direct descendants of the current module. To get the keys for the descendants + -- we must get their `ModSummary`s + !final_deps <- do + dep_mss <- map msrModSummary <$> uses_ GetModSummaryWithoutTimestamps deps + -- Don't want to retain references to the entire ModSummary when just the key will do + return $!! map (NodeKey_Module . msKey) dep_mss + let moduleNode = (ms, final_deps) +#else + let moduleNode = ms +#endif + session' <- liftIO $ mergeEnvs hsc moduleNode inLoadOrder depSessions + + Just <$> liftIO (newHscEnvEqWithImportPaths (envImportPaths env) session' []) -- | Load a iface from disk, or generate it if there isn't one or it is out of date -- This rule also ensures that the `.hie` and `.o` (if needed) files are written out. diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index 58879a916b..efb89b9716 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -1,5 +1,5 @@ module Development.IDE.Types.HscEnvEq -( HscEnvEq(envUnique), +( HscEnvEq, hscEnv, newHscEnvEq, hscEnvWithImportPaths, newHscEnvEqPreserveImportPaths, From f570d5fb3149b6febf53e772b6cd56bcf4483708 Mon Sep 17 00:00:00 2001 From: Elodie Lander Date: Tue, 27 Jun 2023 07:38:07 -0500 Subject: [PATCH 3/5] Add updateHscEnvEq helper function --- ghcide/src/Development/IDE/Core/Rules.hs | 2 +- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index e94b7f23f2..d723dafe6b 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -799,7 +799,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do #endif session' <- liftIO $ mergeEnvs hsc moduleNode inLoadOrder depSessions - Just <$> liftIO (newHscEnvEqWithImportPaths (envImportPaths env) session' []) + Just <$> liftIO (updateHscEnvEq env session') -- | Load a iface from disk, or generate it if there isn't one or it is out of date -- This rule also ensures that the `.hie` and `.o` (if needed) files are written out. diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index efb89b9716..fe9b7b3e59 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -4,6 +4,7 @@ module Development.IDE.Types.HscEnvEq hscEnvWithImportPaths, newHscEnvEqPreserveImportPaths, newHscEnvEqWithImportPaths, + updateHscEnvEq, envImportPaths, envPackageExports, envVisibleModuleNames, @@ -51,6 +52,11 @@ data HscEnvEq = HscEnvEq -- If Nothing, 'listVisibleModuleNames' panic } +updateHscEnvEq :: HscEnvEq -> HscEnv -> IO HscEnvEq +updateHscEnvEq oldHscEnvEq newHscEnv = do + let update newUnique = oldHscEnvEq { envUnique = newUnique, hscEnv = newHscEnv } + update <$> Unique.newUnique + -- | Wrap an 'HscEnv' into an 'HscEnvEq'. newHscEnvEq :: FilePath -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq newHscEnvEq cradlePath hscEnv0 deps = do From 222b0508701045d371e4e06b695dfd4b82456771 Mon Sep 17 00:00:00 2001 From: Elodie Lander Date: Fri, 30 Jun 2023 05:50:57 -0500 Subject: [PATCH 4/5] Add comment to updateHscEnvEq call --- ghcide/src/Development/IDE/Core/Rules.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index d723dafe6b..109259df7b 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -799,6 +799,11 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do #endif session' <- liftIO $ mergeEnvs hsc moduleNode inLoadOrder depSessions + -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new + -- ExportsMap when it is called. We only need to create the ExportsMap once per + -- session, while `ghcSessionDepsDefinition` will be called for each file we need + -- to compile. `updateHscEnvEq` will refresh the HscEnv (session') and also + -- generate a new Unique. Just <$> liftIO (updateHscEnvEq env session') -- | Load a iface from disk, or generate it if there isn't one or it is out of date From 20ebcc19e0186c7dbe5b0ff726c6582b6b772031 Mon Sep 17 00:00:00 2001 From: Elodie Lander Date: Fri, 30 Jun 2023 06:42:36 -0500 Subject: [PATCH 5/5] Update HscEnvEq equality comment --- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index fe9b7b3e59..623e1da691 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -33,7 +33,8 @@ import System.Directory (makeAbsolute) import System.FilePath -- | An 'HscEnv' with equality. Two values are considered equal --- if they are created with the same call to 'newHscEnvEq'. +-- if they are created with the same call to 'newHscEnvEq' or +-- 'updateHscEnvEq'. data HscEnvEq = HscEnvEq { envUnique :: !Unique , hscEnv :: !HscEnv