mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-09-11 16:56:14 +03:00
Two recompilation avoidance related bugs (#3452)
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.
This commit is contained in:
parent
2b6f603b6b
commit
00f4e61da6
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 #-}
|
||||
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user