From ae6ea9b4b88f45e891305fe2062e0362af7348a4 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Fri, 13 Jan 2023 17:24:59 +0530 Subject: [PATCH] Two recompilation avoidance related bugs 1. Recompilation avoidance regresses in GHC 9.4 due to interactions between GHC and HLS's implementations. Avoid this by filtering out the information that causes the conflict See https://gitlab.haskell.org/ghc/ghc/-/issues/22744. 2. The recompilation avoidance info GHC stores in interfaces can blow up to be extremely large when deserialised from disk. See https://gitlab.haskell.org/ghc/ghc/-/issues/22744 Deduplicate these filepaths. --- .hlint.yaml | 1 + ghcide/src/Development/IDE/Core/Compile.hs | 33 +++++++++++++++++--- ghcide/src/Development/IDE/Core/FileStore.hs | 18 +++++++++++ ghcide/src/Development/IDE/GHC/Compat.hs | 6 ++-- 4 files changed, 52 insertions(+), 6 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index a04776b87f..17f0b0baa5 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -55,6 +55,7 @@ within: - Development.IDE.Core.Shake - Development.IDE.GHC.Util + - Development.IDE.Core.FileStore - Development.IDE.Plugin.CodeAction.Util - Development.IDE.Graph.Internal.Database - Development.IDE.Graph.Internal.Paths diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 82addbdf12..d491766cc2 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -70,7 +70,7 @@ import Data.Time (UTCTime (..)) import Data.Tuple.Extra (dupe) import Data.Unique as Unique import Debug.Trace -import Development.IDE.Core.FileStore (resetInterfaceStore) +import Development.IDE.Core.FileStore (resetInterfaceStore, shareFilePath) import Development.IDE.Core.Preprocessor import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake @@ -435,6 +435,30 @@ tcRnModule hsc_env tc_helpers pmod = do -- anywhere. So we zero it out. -- The field is not serialized or deserialised from disk, so we don't need to remove it -- while reading an iface from disk, only if we just generated an iface in memory +-- + + + +-- | See https://github.com/haskell/haskell-language-server/issues/3450 +-- GHC's recompilation avoidance in the presense of TH is less precise than +-- HLS. To avoid GHC from pessimising HLS, we filter out certain dependency information +-- that we track ourselves. See also Note [Recompilation avoidance in the presence of TH] +filterUsages :: [Usage] -> [Usage] +#if MIN_VERSION_ghc(9,3,0) +filterUsages = filter $ \case UsageHomeModuleInterface{} -> False + _ -> True +#else +filterUsages = id +#endif + +-- | Mitigation for https://gitlab.haskell.org/ghc/ghc/-/issues/22744 +shareUsages :: ModIface -> ModIface +shareUsages iface = iface {mi_usages = usages} + where usages = map go (mi_usages iface) + go usg@UsageFile{} = usg {usg_file_path = fp} + where !fp = shareFilePath (usg_file_path usg) + go usg = usg + mkHiFileResultNoCompile :: HscEnv -> TcModuleResult -> IO HiFileResult mkHiFileResultNoCompile session tcm = do @@ -444,7 +468,7 @@ mkHiFileResultNoCompile session tcm = do details <- makeSimpleDetails hsc_env_tmp tcGblEnv sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv iface' <- mkIfaceTc hsc_env_tmp sf details ms tcGblEnv - let iface = iface' { mi_globals = Nothing } -- See Note [Clearing mi_globals after generating an iface] + let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface] pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing mkHiFileResultCompile @@ -486,7 +510,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do let !partial_iface = force (mkPartialIface session details simplified_guts) final_iface' <- mkFullIface session partial_iface #endif - let final_iface = final_iface' {mi_globals = Nothing} -- See Note [Clearing mi_globals after generating an iface] + let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface] -- Write the core file now core_file <- case mguts of @@ -1462,7 +1486,8 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do regenerate linkableNeeded case (mb_checked_iface, recomp_iface_reqd) of - (Just iface, UpToDate) -> do + (Just iface', UpToDate) -> do + let iface = shareUsages iface' details <- liftIO $ mkDetailsFromIface sessionWithMsDynFlags iface -- parse the runtime dependencies from the annotations let runtime_deps diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 860ad11939..f3906ced6b 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -18,6 +18,7 @@ module Development.IDE.Core.FileStore( getModTime, isWatchSupported, registerFileWatches, + shareFilePath, Log(..) ) where @@ -28,6 +29,8 @@ import Control.Exception import Control.Monad.Extra import Control.Monad.IO.Class import qualified Data.ByteString as BS +import qualified Data.HashMap.Strict as HashMap +import Data.IORef import qualified Data.Text as T import qualified Data.Text.Utf16.Rope as Rope import Data.Time @@ -76,6 +79,7 @@ import qualified Language.LSP.Types as LSP import qualified Language.LSP.Types.Capabilities as LSP import Language.LSP.VFS import System.FilePath +import System.IO.Unsafe data Log = LogCouldNotIdentifyReverseDeps !NormalizedFilePath @@ -297,3 +301,17 @@ isWatchSupported = do , Just True <- _dynamicRegistration -> True | otherwise -> False + +filePathMap :: IORef (HashMap.HashMap FilePath FilePath) +filePathMap = unsafePerformIO $ newIORef HashMap.empty +{-# NOINLINE filePathMap #-} + +shareFilePath :: FilePath -> FilePath +shareFilePath k = unsafePerformIO $ do + atomicModifyIORef' filePathMap $ \km -> + let new_key = HashMap.lookup k km + in case new_key of + Just v -> (km, v) + Nothing -> (HashMap.insert k k km, k) +{-# NOINLINE shareFilePath #-} + diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 83195acd2a..49f2869a3b 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -43,6 +43,8 @@ module Development.IDE.GHC.Compat( myCoreToStgExpr, #endif + Usage(..), + FastStringCompat, bytesFS, mkFastStringByteString, @@ -167,9 +169,9 @@ import GHC.Runtime.Context (icInteractiveModule) import GHC.Unit.Home.ModInfo (HomePackageTable, lookupHpt) #if MIN_VERSION_ghc(9,3,0) -import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods)) +import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods), Usage(..)) #else -import GHC.Unit.Module.Deps (Dependencies(dep_mods)) +import GHC.Unit.Module.Deps (Dependencies(dep_mods), Usage(..)) #endif #else import GHC.CoreToByteCode (coreExprToBCOs)