Skip to content

Commit

Permalink
Two recompilation avoidance related bugs
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
wz1000 committed Jan 25, 2023
1 parent ddc67b2 commit c918470
Show file tree
Hide file tree
Showing 2 changed files with 46 additions and 5 deletions.
45 changes: 42 additions & 3 deletions ghcide/src/Development/IDE/Core/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -102,6 +102,7 @@ import qualified Language.LSP.Types as LSP
import System.Directory
import System.FilePath
import System.IO.Extra (fixIO, newTempFileWithin)
import System.IO.Unsafe
import Unsafe.Coerce

#if MIN_VERSION_ghc(9,0,1)
Expand Down Expand Up @@ -435,6 +436,43 @@ 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

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 #-}


mkHiFileResultNoCompile :: HscEnv -> TcModuleResult -> IO HiFileResult
mkHiFileResultNoCompile session tcm = do
Expand All @@ -444,7 +482,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
Expand Down Expand Up @@ -486,7 +524,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
Expand Down Expand Up @@ -1462,7 +1500,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
Expand Down
6 changes: 4 additions & 2 deletions ghcide/src/Development/IDE/GHC/Compat.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,8 @@ module Development.IDE.GHC.Compat(
myCoreToStgExpr,
#endif

Usage(..),

FastStringCompat,
bytesFS,
mkFastStringByteString,
Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit c918470

Please sign in to comment.