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

Author: wz1000

ghcide/exe/Arguments.hs

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

ghcide/exe/Main.hs

@@ -142,6 +142,7 @@ main = withTelemetryLogger $ \telemetryLogger -> do
                 , optCheckParents = pure $ checkParents config
                 , optCheckProject = pure $ checkProject config
                 , optRunSubset = not argsConservativeChangeTracking
+                , optVerifyCoreFile = argsVerifyCoreFile
                 }
         , IDEMain.argsMonitoring = OpenTelemetry.monitoring <> EKG.monitoring logger argsMonitoringPort
         }

ghcide/ghcide.cabal

@@ -180,6 +180,7 @@ library
         Development.IDE.GHC.Compat.Units
         Development.IDE.GHC.Compat.Util
         Development.IDE.Core.Compile
+        Development.IDE.GHC.CoreFile
         Development.IDE.GHC.Dump
         Development.IDE.GHC.Error
         Development.IDE.GHC.ExactPrint

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

@@ -150,7 +150,7 @@ getModificationTimeImpl missingFileDiags file = do
 --   But interface files are private, in that only HLS writes them.
 --   So we implement watching ourselves, and bypass the need for alwaysRerun.
 isInterface :: NormalizedFilePath -> Bool
-isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot"]
+isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot", ".hie", ".hie-boot", ".core"]
 
 -- | Reset the GetModificationTime state of interface files
 resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> STM ()

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

@@ -768,6 +768,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
     Just session -> do
       linkableType <- getLinkableType f
       ver <- use_ GetModificationTime f
+      se@ShakeExtras{ideNc} <- getShakeExtras
       let m_old = case old of
             Shake.Succeeded (Just old_version) v -> Just (v, old_version)
             Shake.Stale _   (Just old_version) v -> Just (v, old_version)
@@ -778,7 +779,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
             , get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
             , regenerate = regenerateHiFile session f ms
             }
-      r <- loadInterface (hscEnv session) ms linkableType recompInfo
+      r <- loadInterface se (hscEnv session) ms linkableType recompInfo
       case r of
         (diags, Nothing) -> return (Nothing, (diags, Nothing))
         (diags, Just x) -> do
@@ -897,12 +898,13 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $
       linkableType <- getLinkableType f
       hsc <- hscEnv <$> use_ GhcSessionDeps f
       let compile = fmap ([],) $ use GenerateCore f
-      (diags, !hiFile) <- compileToObjCodeIfNeeded hsc linkableType compile tmr
+      se <- getShakeExtras
+      (diags, !hiFile) <- compileToObjCodeIfNeeded se hsc linkableType compile tmr
       let fp = hiFileFingerPrint <$> hiFile
       hiDiags <- case hiFile of
         Just hiFile
           | OnDisk <- status
-          , not (tmrDeferedError tmr) -> writeHiFileAction hsc hiFile
+          , not (tmrDeferedError tmr) -> liftIO $ writeHiFile se hsc hiFile
         _ -> pure []
       return (fp, (diags++hiDiags, hiFile))
     NotFOI -> do
@@ -961,8 +963,10 @@ regenerateHiFile sess f ms compNeeded = do
                 -- compile writes .o file
                 let compile = liftIO $ compileModule (RunSimplifier True) hsc (pm_mod_summary pm) $ tmrTypechecked tmr
 
+                se <- getShakeExtras
+
                 -- Bang pattern is important to avoid leaking 'tmr'
-                (diags'', !res) <- compileToObjCodeIfNeeded hsc compNeeded compile tmr
+                (diags'', !res) <- compileToObjCodeIfNeeded se hsc compNeeded compile tmr
 
                 -- Write hi file
                 hiDiags <- case res of
@@ -980,7 +984,7 @@ regenerateHiFile sess f ms compNeeded = do
                     -- We don't write the `.hi` file if there are defered errors, since we won't get
                     -- accurate diagnostics next time if we do
                     hiDiags <- if not $ tmrDeferedError tmr
-                               then writeHiFileAction hsc hiFile
+                               then liftIO $ writeHiFile se hsc hiFile
                                else pure []
 
                     pure (hiDiags <> gDiags <> concat wDiags)
@@ -990,18 +994,18 @@ regenerateHiFile sess f ms compNeeded = do
 
 
 -- | HscEnv should have deps included already
-compileToObjCodeIfNeeded :: HscEnv -> Maybe LinkableType -> Action (IdeResult ModGuts) -> TcModuleResult -> Action (IdeResult HiFileResult)
-compileToObjCodeIfNeeded hsc Nothing _ tmr = do
+compileToObjCodeIfNeeded :: ShakeExtras -> HscEnv -> Maybe LinkableType -> Action (IdeResult ModGuts) -> TcModuleResult -> Action (IdeResult HiFileResult)
+compileToObjCodeIfNeeded _ hsc Nothing _ tmr = do
   incrementRebuildCount
   res <- liftIO $ mkHiFileResultNoCompile hsc tmr
   pure ([], Just $! res)
-compileToObjCodeIfNeeded hsc (Just linkableType) getGuts tmr = do
+compileToObjCodeIfNeeded se hsc (Just linkableType) getGuts tmr = do
   incrementRebuildCount
   (diags, mguts) <- getGuts
   case mguts of
     Nothing -> pure (diags, Nothing)
     Just guts -> do
-      (diags', !res) <- liftIO $ mkHiFileResultCompile hsc tmr guts linkableType
+      (diags', !res) <- liftIO $ mkHiFileResultCompile se hsc tmr guts linkableType
       pure (diags++diags', res)
 
 getClientSettingsRule :: Recorder (WithPriority Log) -> Rules ()
@@ -1039,6 +1043,9 @@ getLinkableType f = use_ NeedsCompilation f
 
 -- needsCompilationRule :: Rules ()
 needsCompilationRule :: NormalizedFilePath  -> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
+needsCompilationRule file 
+  | "boot" `isSuffixOf` (fromNormalizedFilePath file) = 
+    pure (Just $ encodeLinkableType Nothing, Just Nothing)
 needsCompilationRule file = do
   graph <- useNoFile GetModuleGraph
   res <- case graph of
@@ -1097,15 +1104,6 @@ computeLinkableTypeForDynFlags d
 newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) }
 instance IsIdeGlobal CompiledLinkables
 
-
-writeHiFileAction :: HscEnv -> HiFileResult -> Action [FileDiagnostic]
-writeHiFileAction hsc hiFile = do
-    extras <- getShakeExtras
-    let targetPath = Compat.ml_hi_file $ ms_location $ hirModSummary hiFile
-    liftIO $ do
-        atomically $ resetInterfaceStore extras $ toNormalizedFilePath' targetPath
-        writeHiFile hsc hiFile
-
 data RulesConfig = RulesConfig
     { -- | Disable import cycle checking for improved performance in large codebases
       checkForImportCycles :: Bool

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

@@ -79,6 +79,7 @@ module Development.IDE.GHC.Compat(
     tidyExpr,
     emptyTidyEnv,
     corePrepExpr,
+    corePrepPgm,
     lintInteractiveExpr,
     icInteractiveModule,
     HomePackageTable,
@@ -93,6 +94,12 @@ module Development.IDE.GHC.Compat(
     module UniqSet,
     module UniqDFM,
     getDependentMods,
+    diffBinds,
+    flattenBinds,
+    mkRnEnv2,
+    emptyInScopeSet,
+    Unfolding(..),
+    noUnfolding,
 #if MIN_VERSION_ghc(9,2,0)
     loadExpr,
     byteCodeGen,
@@ -122,11 +129,12 @@ import           GHC                                   hiding (HasSrcSpan,
                                                         lookupName, exprType)
 #if MIN_VERSION_ghc(9,0,0)
 import GHC.Driver.Hooks (hscCompileCoreExprHook)
-import GHC.Core (CoreExpr, CoreProgram)
+import GHC.Core (CoreExpr, CoreProgram, Unfolding(..), noUnfolding, flattenBinds)
 import qualified GHC.Core.Opt.Pipeline as GHC
 import GHC.Core.Tidy (tidyExpr)
-import GHC.Types.Var.Env (emptyTidyEnv)
+import GHC.Types.Var.Env (emptyTidyEnv, mkRnEnv2, emptyInScopeSet)
 import qualified GHC.CoreToStg.Prep as GHC
+import GHC.CoreToStg.Prep (corePrepPgm)
 import GHC.Core.Lint (lintInteractiveExpr)
 #if MIN_VERSION_ghc(9,2,0)
 import GHC.Unit.Home.ModInfo (lookupHpt, HomePackageTable)
@@ -146,11 +154,11 @@ import GHC.Types.Unique.Set as UniqSet
 import GHC.Types.Unique.DFM  as UniqDFM
 #else
 import Hooks (hscCompileCoreExprHook)
-import CoreSyn (CoreExpr)
+import CoreSyn (CoreExpr, flattenBinds, Unfolding(..), noUnfolding)
 import qualified SimplCore as GHC
 import CoreTidy (tidyExpr)
-import VarEnv (emptyTidyEnv)
-import CorePrep (corePrepExpr)
+import VarEnv (emptyTidyEnv, mkRnEnv2, emptyInScopeSet)
+import CorePrep (corePrepExpr, corePrepPgm)
 import CoreLint (lintInteractiveExpr)
 import ByteCodeGen (coreExprToBCOs)
 import HscTypes (icInteractiveModule, HomePackageTable, lookupHpt, Dependencies(dep_mods))
@@ -234,6 +242,8 @@ import GHC.ByteCode.Types
 import GHC.Linker.Loader (loadDecls)
 import GHC.Data.Maybe
 import GHC.CoreToStg
+import GHC.Core.Utils
+import GHC.Types.Var.Env
 #endif
 
 type ModIfaceAnnotation = Annotation

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

@@ -305,6 +305,7 @@ module Development.IDE.GHC.Compat.Core (
     -- * Panic
     PlainGhcException,
     panic,
+    panicDoc,
     -- * Other
     GHC.CoreModule(..),
     GHC.SafeHaskellMode(..),

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

@@ -6,7 +6,7 @@ module Development.IDE.GHC.Compat.Outputable (
     showSDoc,
     showSDocUnsafe,
     showSDocForUser,
-    ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest,
+    ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate,
     printSDocQualifiedUnsafe,
     printWithoutUniques,
     mkPrintUnqualified,