Skip to content

Commit 70b9ba3

Browse files
committed
Serialize core to core files
Add a `.hi.core` file format to which we serialize out compiled core after generating it. This core is then read back in on subsequent runs and compiled to bytecode. This greatly speeds up startup times when we need compilation, as we can simply read bytecode off the disk instead of having to recompile a lot of modules This is based off Fat Interface files in GHC: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7502 - Also add --verify-core-file to do roundtrip testing of core-files - Use closed world assumption for core and .hie files
1 parent 8c47d6c commit 70b9ba3

File tree

17 files changed

+497
-97
lines changed

17 files changed

+497
-97
lines changed

ghcide/exe/Arguments.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ data Arguments = Arguments
1515
,argsOTMemoryProfiling :: Bool
1616
,argsTesting :: Bool
1717
,argsDisableKick :: Bool
18+
,argsVerifyCoreFile :: Bool
1819
,argsThreads :: Int
1920
,argsVerbose :: Bool
2021
,argsCommand :: Command
@@ -37,6 +38,7 @@ arguments plugins = Arguments
3738
<*> switch (long "ot-memory-profiling" <> help "Record OpenTelemetry info to the eventlog. Needs the -l RTS flag to have an effect")
3839
<*> switch (long "test" <> help "Enable additional lsp messages used by the testsuite")
3940
<*> switch (long "test-no-kick" <> help "Disable kick. Useful for testing cancellation")
41+
<*> switch (long "verify-core-file" <> help "Verify core trips by roundtripping after serialization. Slow, only useful for testing purposes")
4042
<*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault)
4143
<*> switch (short 'd' <> long "verbose" <> help "Include internal events in logging output")
4244
<*> (commandP plugins <|> lspCommand <|> checkCommand)

ghcide/exe/Main.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -142,6 +142,7 @@ main = withTelemetryLogger $ \telemetryLogger -> do
142142
, optCheckParents = pure $ checkParents config
143143
, optCheckProject = pure $ checkProject config
144144
, optRunSubset = not argsConservativeChangeTracking
145+
, optVerifyCoreFile = argsVerifyCoreFile
145146
}
146147
, IDEMain.argsMonitoring = OpenTelemetry.monitoring <> EKG.monitoring logger argsMonitoringPort
147148
}

ghcide/ghcide.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -180,6 +180,7 @@ library
180180
Development.IDE.GHC.Compat.Units
181181
Development.IDE.GHC.Compat.Util
182182
Development.IDE.Core.Compile
183+
Development.IDE.GHC.CoreFile
183184
Development.IDE.GHC.Dump
184185
Development.IDE.GHC.Error
185186
Development.IDE.GHC.ExactPrint

ghcide/src/Development/IDE/Core/Compile.hs

Lines changed: 183 additions & 67 deletions
Large diffs are not rendered by default.

ghcide/src/Development/IDE/Core/FileStore.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -150,7 +150,7 @@ getModificationTimeImpl missingFileDiags file = do
150150
-- But interface files are private, in that only HLS writes them.
151151
-- So we implement watching ourselves, and bypass the need for alwaysRerun.
152152
isInterface :: NormalizedFilePath -> Bool
153-
isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot"]
153+
isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot", ".hie", ".hie-boot", ".core"]
154154

155155
-- | Reset the GetModificationTime state of interface files
156156
resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> STM ()

ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 16 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -768,6 +768,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
768768
Just session -> do
769769
linkableType <- getLinkableType f
770770
ver <- use_ GetModificationTime f
771+
se@ShakeExtras{ideNc} <- getShakeExtras
771772
let m_old = case old of
772773
Shake.Succeeded (Just old_version) v -> Just (v, old_version)
773774
Shake.Stale _ (Just old_version) v -> Just (v, old_version)
@@ -778,7 +779,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
778779
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
779780
, regenerate = regenerateHiFile session f ms
780781
}
781-
r <- loadInterface (hscEnv session) ms linkableType recompInfo
782+
r <- loadInterface se (hscEnv session) ms linkableType recompInfo
782783
case r of
783784
(diags, Nothing) -> return (Nothing, (diags, Nothing))
784785
(diags, Just x) -> do
@@ -897,12 +898,13 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $
897898
linkableType <- getLinkableType f
898899
hsc <- hscEnv <$> use_ GhcSessionDeps f
899900
let compile = fmap ([],) $ use GenerateCore f
900-
(diags, !hiFile) <- compileToObjCodeIfNeeded hsc linkableType compile tmr
901+
se <- getShakeExtras
902+
(diags, !hiFile) <- compileToObjCodeIfNeeded se hsc linkableType compile tmr
901903
let fp = hiFileFingerPrint <$> hiFile
902904
hiDiags <- case hiFile of
903905
Just hiFile
904906
| OnDisk <- status
905-
, not (tmrDeferedError tmr) -> writeHiFileAction hsc hiFile
907+
, not (tmrDeferedError tmr) -> liftIO $ writeHiFile se hsc hiFile
906908
_ -> pure []
907909
return (fp, (diags++hiDiags, hiFile))
908910
NotFOI -> do
@@ -961,8 +963,10 @@ regenerateHiFile sess f ms compNeeded = do
961963
-- compile writes .o file
962964
let compile = liftIO $ compileModule (RunSimplifier True) hsc (pm_mod_summary pm) $ tmrTypechecked tmr
963965

966+
se <- getShakeExtras
967+
964968
-- Bang pattern is important to avoid leaking 'tmr'
965-
(diags'', !res) <- compileToObjCodeIfNeeded hsc compNeeded compile tmr
969+
(diags'', !res) <- compileToObjCodeIfNeeded se hsc compNeeded compile tmr
966970

967971
-- Write hi file
968972
hiDiags <- case res of
@@ -980,7 +984,7 @@ regenerateHiFile sess f ms compNeeded = do
980984
-- We don't write the `.hi` file if there are defered errors, since we won't get
981985
-- accurate diagnostics next time if we do
982986
hiDiags <- if not $ tmrDeferedError tmr
983-
then writeHiFileAction hsc hiFile
987+
then liftIO $ writeHiFile se hsc hiFile
984988
else pure []
985989

986990
pure (hiDiags <> gDiags <> concat wDiags)
@@ -990,18 +994,18 @@ regenerateHiFile sess f ms compNeeded = do
990994

991995

992996
-- | HscEnv should have deps included already
993-
compileToObjCodeIfNeeded :: HscEnv -> Maybe LinkableType -> Action (IdeResult ModGuts) -> TcModuleResult -> Action (IdeResult HiFileResult)
994-
compileToObjCodeIfNeeded hsc Nothing _ tmr = do
997+
compileToObjCodeIfNeeded :: ShakeExtras -> HscEnv -> Maybe LinkableType -> Action (IdeResult ModGuts) -> TcModuleResult -> Action (IdeResult HiFileResult)
998+
compileToObjCodeIfNeeded _ hsc Nothing _ tmr = do
995999
incrementRebuildCount
9961000
res <- liftIO $ mkHiFileResultNoCompile hsc tmr
9971001
pure ([], Just $! res)
998-
compileToObjCodeIfNeeded hsc (Just linkableType) getGuts tmr = do
1002+
compileToObjCodeIfNeeded se hsc (Just linkableType) getGuts tmr = do
9991003
incrementRebuildCount
10001004
(diags, mguts) <- getGuts
10011005
case mguts of
10021006
Nothing -> pure (diags, Nothing)
10031007
Just guts -> do
1004-
(diags', !res) <- liftIO $ mkHiFileResultCompile hsc tmr guts linkableType
1008+
(diags', !res) <- liftIO $ mkHiFileResultCompile se hsc tmr guts linkableType
10051009
pure (diags++diags', res)
10061010

10071011
getClientSettingsRule :: Recorder (WithPriority Log) -> Rules ()
@@ -1039,6 +1043,9 @@ getLinkableType f = use_ NeedsCompilation f
10391043

10401044
-- needsCompilationRule :: Rules ()
10411045
needsCompilationRule :: NormalizedFilePath -> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
1046+
needsCompilationRule file
1047+
| "boot" `isSuffixOf` (fromNormalizedFilePath file) =
1048+
pure (Just $ encodeLinkableType Nothing, Just Nothing)
10421049
needsCompilationRule file = do
10431050
graph <- useNoFile GetModuleGraph
10441051
res <- case graph of
@@ -1097,15 +1104,6 @@ computeLinkableTypeForDynFlags d
10971104
newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) }
10981105
instance IsIdeGlobal CompiledLinkables
10991106

1100-
1101-
writeHiFileAction :: HscEnv -> HiFileResult -> Action [FileDiagnostic]
1102-
writeHiFileAction hsc hiFile = do
1103-
extras <- getShakeExtras
1104-
let targetPath = Compat.ml_hi_file $ ms_location $ hirModSummary hiFile
1105-
liftIO $ do
1106-
atomically $ resetInterfaceStore extras $ toNormalizedFilePath' targetPath
1107-
writeHiFile hsc hiFile
1108-
11091107
data RulesConfig = RulesConfig
11101108
{ -- | Disable import cycle checking for improved performance in large codebases
11111109
checkForImportCycles :: Bool

ghcide/src/Development/IDE/GHC/Compat.hs

Lines changed: 15 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -79,6 +79,7 @@ module Development.IDE.GHC.Compat(
7979
tidyExpr,
8080
emptyTidyEnv,
8181
corePrepExpr,
82+
corePrepPgm,
8283
lintInteractiveExpr,
8384
icInteractiveModule,
8485
HomePackageTable,
@@ -93,6 +94,12 @@ module Development.IDE.GHC.Compat(
9394
module UniqSet,
9495
module UniqDFM,
9596
getDependentMods,
97+
diffBinds,
98+
flattenBinds,
99+
mkRnEnv2,
100+
emptyInScopeSet,
101+
Unfolding(..),
102+
noUnfolding,
96103
#if MIN_VERSION_ghc(9,2,0)
97104
loadExpr,
98105
byteCodeGen,
@@ -122,11 +129,12 @@ import GHC hiding (HasSrcSpan,
122129
lookupName, exprType)
123130
#if MIN_VERSION_ghc(9,0,0)
124131
import GHC.Driver.Hooks (hscCompileCoreExprHook)
125-
import GHC.Core (CoreExpr, CoreProgram)
132+
import GHC.Core (CoreExpr, CoreProgram, Unfolding(..), noUnfolding, flattenBinds)
126133
import qualified GHC.Core.Opt.Pipeline as GHC
127134
import GHC.Core.Tidy (tidyExpr)
128-
import GHC.Types.Var.Env (emptyTidyEnv)
135+
import GHC.Types.Var.Env (emptyTidyEnv, mkRnEnv2, emptyInScopeSet)
129136
import qualified GHC.CoreToStg.Prep as GHC
137+
import GHC.CoreToStg.Prep (corePrepPgm)
130138
import GHC.Core.Lint (lintInteractiveExpr)
131139
#if MIN_VERSION_ghc(9,2,0)
132140
import GHC.Unit.Home.ModInfo (lookupHpt, HomePackageTable)
@@ -146,11 +154,11 @@ import GHC.Types.Unique.Set as UniqSet
146154
import GHC.Types.Unique.DFM as UniqDFM
147155
#else
148156
import Hooks (hscCompileCoreExprHook)
149-
import CoreSyn (CoreExpr)
157+
import CoreSyn (CoreExpr, flattenBinds, Unfolding(..), noUnfolding)
150158
import qualified SimplCore as GHC
151159
import CoreTidy (tidyExpr)
152-
import VarEnv (emptyTidyEnv)
153-
import CorePrep (corePrepExpr)
160+
import VarEnv (emptyTidyEnv, mkRnEnv2, emptyInScopeSet)
161+
import CorePrep (corePrepExpr, corePrepPgm)
154162
import CoreLint (lintInteractiveExpr)
155163
import ByteCodeGen (coreExprToBCOs)
156164
import HscTypes (icInteractiveModule, HomePackageTable, lookupHpt, Dependencies(dep_mods))
@@ -234,6 +242,8 @@ import GHC.ByteCode.Types
234242
import GHC.Linker.Loader (loadDecls)
235243
import GHC.Data.Maybe
236244
import GHC.CoreToStg
245+
import GHC.Core.Utils
246+
import GHC.Types.Var.Env
237247
#endif
238248

239249
type ModIfaceAnnotation = Annotation

ghcide/src/Development/IDE/GHC/Compat/Core.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -305,6 +305,7 @@ module Development.IDE.GHC.Compat.Core (
305305
-- * Panic
306306
PlainGhcException,
307307
panic,
308+
panicDoc,
308309
-- * Other
309310
GHC.CoreModule(..),
310311
GHC.SafeHaskellMode(..),

ghcide/src/Development/IDE/GHC/Compat/Outputable.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ module Development.IDE.GHC.Compat.Outputable (
66
showSDoc,
77
showSDocUnsafe,
88
showSDocForUser,
9-
ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest,
9+
ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate,
1010
printSDocQualifiedUnsafe,
1111
printWithoutUniques,
1212
mkPrintUnqualified,

0 commit comments

Comments
 (0)