[Git][ghc/ghc][wip/fendor/linkable-usage] Record `LinkableUsage` instead of `Linkable` in `LoaderState`

16 Mar 2026

Hannes Siebenhandl pushed to branch wip/fendor/linkable-usage at Glasgow Haskell Compiler / GHC


Commits:
31a3cbc3 by fendor at 2026-03-16T14:56:24+01:00
Record `LinkableUsage` instead of `Linkable` in `LoaderState`

Retaining a ByteCode `Linkable` after it has been loaded retains its
`UnlinkedBCO`, keeping it alive for the remainder of the program.
This starts accumulating a lot of `UnlinkedBCO` and memory over time.
However, the `Linkable` is merely used to later record its usage in
`mkObjectUsage`, which  is used for recompilation checking.

However, this is incorrect, as the interface file and bytecode objects
could be in different states, e.g. the interface changes, but the
bytecode library hasn't changed so we don't need to recompile and vice
versa.

By computing a `Fingerprint` for the `ModuleByteCode`, and recording it
in the `LinkableUsage`, we know precisely whether the `ByteCode` object
on disk is outdated.

Thus, parts of this commit just makes sure that we efficiently compute a
`Fingerprint` for `ModuleByteCode` and store it in the on-disk
representation of `ModuleByteCode`.

We change the `LoaderState` to retain `LinkableUsage`, which is smaller
representation of a `Linkable`. This allows us to free the unneeded
fields of `Linkable` after linking them.

We declare the following memory invariants that this commit implements:

* No `LinkablePart` should be retained from `LoaderState`.
* `Linkable`s should be unloaded after they have been loaded.

These invariants are unfortunately tricky to automatically uphold, so we
are simply documenting our assumptions for now.

-------------------------
Metric Increase:
    MultiLayerModulesTH_OneShot
-------------------------

We allocate a bit more, but the peak number of bytes doesn't change.
While a bit unfortunate, accepting the metric increase.

We add multiple new performance measurements where we were able to
observe the desired memory invariants. Further, we add regression tests
to validate that the recompilation checker behaves more correct than
before.

- - - - -


25 changed files:

- + compiler/GHC/ByteCode/Binary.hs
- + compiler/GHC/ByteCode/Recomp/Binary.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Recomp/Types.hs
- compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Unit/Home/ModInfo.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Status.hs
- compiler/ghc.cabal.in
- ghc/GHCi/Leak.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout


Changes:

=====================================
compiler/GHC/ByteCode/Binary.hs
=====================================
@@ -0,0 +1,293 @@
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module GHC.ByteCode.Binary (
+  -- * ByteCode objects on disk and intermediate representations
+  OnDiskModuleByteCode(..),
+  BytecodeLibX(..),
+  BytecodeLib,
+  OnDiskBytecodeLib,
+  InterpreterLibrary(..),
+  InterpreterLibraryContents(..),
+  -- * Binary 'Name' serializers
+  BytecodeNameEnv(..),
+  addBinNameWriter,
+  addBinNameReader,
+) where
+
+import GHC.Prelude
+
+import GHC.ByteCode.Types
+import GHC.Data.FastString
+import GHC.Types.Name
+import GHC.Types.Name.Cache
+import GHC.Types.Name.Env
+import GHC.Types.SrcLoc
+import GHC.Unit.Types
+import GHC.Utils.Binary
+import GHC.Utils.Exception
+import GHC.Utils.Panic
+import GHC.Utils.Outputable
+import GHC.Utils.Fingerprint (Fingerprint)
+
+import Control.Monad
+import Data.Binary qualified as Binary
+import Data.ByteString (ByteString)
+import Data.Foldable
+import Data.IORef
+import Data.Proxy
+import Data.Word
+import System.IO.Unsafe (unsafeInterleaveIO)
+
+-- | The on-disk representation of a bytecode object for a specific module.
+--
+-- This is the representation which we serialise and write to disk.
+-- The difference from 'ModuleByteCode' is that the contents of the object files
+-- contained by 'ModuleByteCode' are stored in-memory rather than as file paths to
+-- temporary files.
+data OnDiskModuleByteCode = OnDiskModuleByteCode { odgbc_module :: Module
+                                                 , odgbc_hash :: Fingerprint
+                                                 , odgbc_compiled_byte_code :: CompiledByteCode
+                                                 , odgbc_foreign :: [ByteString]  -- ^ Contents of object files
+                                                 }
+
+type OnDiskBytecodeLib = BytecodeLibX (Maybe InterpreterLibraryContents)
+
+instance Outputable a => Outputable (BytecodeLibX a) where
+  ppr (BytecodeLib {..}) = vcat [
+    (text "BytecodeLib" <+> ppr bytecodeLibUnitId),
+    (text "Files" <+> ppr bytecodeLibFiles),
+    (text "Foreign" <+> ppr bytecodeLibForeign) ]
+
+type BytecodeLib = BytecodeLibX (Maybe InterpreterLibrary)
+
+-- | A bytecode library is a collection of CompiledByteCode objects and a .so file containing the combination of foreign stubs
+data BytecodeLibX a = BytecodeLib {
+    bytecodeLibUnitId :: UnitId,
+    bytecodeLibFiles :: [CompiledByteCode],
+    bytecodeLibForeign :: a -- A library file containing the combination of foreign stubs. (Ie arising from CApiFFI)
+}
+
+data InterpreterLibrary = InterpreterSharedObject { getSharedObjectFilePath :: FilePath, getSharedObjectDir :: FilePath, getSharedObjectLibName :: String }
+                         | InterpreterStaticObjects { getStaticObjects :: [FilePath] }
+
+
+instance Outputable InterpreterLibrary where
+  ppr (InterpreterSharedObject path dir name) = text "SharedObject" <+> text path <+> text dir <+> text name
+  ppr (InterpreterStaticObjects paths) = text "StaticObjects" <+> text (show paths)
+
+
+data InterpreterLibraryContents = InterpreterLibrarySharedContents { interpreterLibraryContents :: ByteString }
+                                | InterpreterLibraryStaticContents { interpreterLibraryStaticContents :: [ByteString] }
+
+instance Binary InterpreterLibraryContents where
+  get bh = do
+    t <- getByte bh
+    case t of
+      0 -> InterpreterLibrarySharedContents <$> get bh
+      1 -> InterpreterLibraryStaticContents <$> get bh
+      _ -> panic "Binary InterpreterLibraryContents: invalid byte"
+  put_ bh (InterpreterLibrarySharedContents contents) = do
+    putByte bh 0
+    put_ bh contents
+  put_ bh (InterpreterLibraryStaticContents contents) = do
+    putByte bh 1
+    put_ bh contents
+
+instance Binary OnDiskModuleByteCode where
+  get bh = do
+    odgbc_hash <- get bh
+    odgbc_module <- get bh
+    odgbc_compiled_byte_code <- get bh
+    odgbc_foreign <- get bh
+    pure OnDiskModuleByteCode {..}
+
+  put_ bh OnDiskModuleByteCode {..} = do
+    put_ bh odgbc_hash
+    put_ bh odgbc_module
+    put_ bh odgbc_compiled_byte_code
+    put_ bh odgbc_foreign
+
+instance Binary OnDiskBytecodeLib where
+  get bh = do
+    bytecodeLibUnitId <- get bh
+    bytecodeLibFiles <- get bh
+    bytecodeLibForeign <- get bh
+    pure BytecodeLib {..}
+
+  put_ bh BytecodeLib {..} = do
+    put_ bh bytecodeLibUnitId
+    put_ bh bytecodeLibFiles
+    put_ bh bytecodeLibForeign
+
+instance Binary CompiledByteCode where
+  get bh = do
+    bc_bcos <- get bh
+    bc_itbls_len <- get bh
+    bc_itbls <- replicateM bc_itbls_len $ do
+      nm <- getViaBinName bh
+      itbl <- get bh
+      pure (nm, itbl)
+    bc_strs_len <- get bh
+    bc_strs <-
+      replicateM bc_strs_len $ (,) <$> getViaBinName bh <*> get bh
+    bc_breaks <- get bh
+    bc_spt_entries <- get bh
+    return $
+      CompiledByteCode
+        { bc_bcos,
+          bc_itbls,
+          bc_strs,
+          bc_breaks,
+          bc_spt_entries
+        }
+
+  put_ bh CompiledByteCode {..} = do
+    put_ bh bc_bcos
+    put_ bh $ length bc_itbls
+    for_ bc_itbls $ \(nm, itbl) -> do
+      putViaBinName bh nm
+      put_ bh itbl
+    put_ bh $ length bc_strs
+    for_ bc_strs $ \(nm, str) -> putViaBinName bh nm *> put_ bh str
+    put_ bh bc_breaks
+    put_ bh bc_spt_entries
+
+instance Binary UnlinkedBCO where
+  get bh =
+    UnlinkedBCO
+      <$> getViaBinName bh
+      <*> get bh
+      <*> (Binary.decode <$> get bh)
+      <*> (Binary.decode <$> get bh)
+      <*> get bh
+      <*> get bh
+
+  put_ bh UnlinkedBCO {..} = do
+    putViaBinName bh unlinkedBCOName
+    put_ bh unlinkedBCOArity
+    put_ bh $ Binary.encode unlinkedBCOInstrs
+    put_ bh $ Binary.encode unlinkedBCOBitmap
+    put_ bh unlinkedBCOLits
+    put_ bh unlinkedBCOPtrs
+
+instance Binary BCOPtr where
+  get bh = do
+    t <- getByte bh
+    case t of
+      0 -> BCOPtrName <$> getViaBinName bh
+      1 -> BCOPtrPrimOp <$> get bh
+      2 -> BCOPtrBCO <$> get bh
+      3 -> BCOPtrBreakArray <$> get bh
+      _ -> panic "Binary BCOPtr: invalid byte"
+
+  put_ bh ptr = case ptr of
+    BCOPtrName nm -> putByte bh 0 *> putViaBinName bh nm
+    BCOPtrPrimOp op -> putByte bh 1 *> put_ bh op
+    BCOPtrBCO bco -> putByte bh 2 *> put_ bh bco
+    BCOPtrBreakArray info_mod -> putByte bh 3 *> put_ bh info_mod
+
+instance Binary BCONPtr where
+  get bh = do
+    t <- getByte bh
+    case t of
+      0 -> BCONPtrWord . fromIntegral <$> (get bh :: IO Word64)
+      1 -> BCONPtrLbl <$> get bh
+      2 -> BCONPtrItbl <$> getViaBinName bh
+      3 -> BCONPtrAddr <$> getViaBinName bh
+      4 -> BCONPtrStr <$> get bh
+      5 -> BCONPtrFS <$> get bh
+      6 -> BCONPtrFFIInfo <$> get bh
+      7 -> BCONPtrCostCentre <$> get bh
+      _ -> panic "Binary BCONPtr: invalid byte"
+
+  put_ bh ptr = case ptr of
+    BCONPtrWord lit -> putByte bh 0 *> put_ bh (fromIntegral lit :: Word64)
+    BCONPtrLbl sym -> putByte bh 1 *> put_ bh sym
+    BCONPtrItbl nm -> putByte bh 2 *> putViaBinName bh nm
+    BCONPtrAddr nm -> putByte bh 3 *> putViaBinName bh nm
+    BCONPtrStr str -> putByte bh 4 *> put_ bh str
+    BCONPtrFS fs -> putByte bh 5 *> put_ bh fs
+    BCONPtrFFIInfo ffi -> putByte bh 6 *> put_ bh ffi
+    BCONPtrCostCentre ibi -> putByte bh 7 *> put_ bh ibi
+
+newtype BinName = BinName {unBinName :: Name}
+
+getViaBinName :: ReadBinHandle -> IO Name
+getViaBinName bh = case findUserDataReader Proxy bh of
+  BinaryReader f -> unBinName <$> f bh
+
+putViaBinName :: WriteBinHandle -> Name -> IO ()
+putViaBinName bh nm = case findUserDataWriter Proxy bh of
+  BinaryWriter f -> f bh $ BinName nm
+
+-- | NameEnv for serialising Names in 'CompiledByteCode'.
+--
+-- See Note [Serializing Names in bytecode]
+
+data BytecodeNameEnv = ByteCodeNameEnv { _bytecode_next_id :: !Word64
+                                       , _bytecode_name_subst :: NameEnv Word64
+                                       }
+
+addBinNameWriter :: WriteBinHandle -> IO WriteBinHandle
+addBinNameWriter bh' = do
+  env_ref <- newIORef (ByteCodeNameEnv 0 emptyNameEnv)
+  evaluate
+    $ flip addWriterToUserData bh'
+    $ BinaryWriter
+    $ \bh (BinName nm) ->
+      if
+        | isExternalName nm -> do
+            putByte bh 0
+            put_ bh nm
+        | otherwise -> do
+            putByte bh 1
+            key <- getBinNameKey env_ref nm
+            -- Delimit the OccName from the deterministic counter to keep the
+            -- encoding injective, avoiding collisions like "foo1" vs "foo#1".
+            put_ bh (occNameFS (occName nm) `appendFS` mkFastString ('#' : show key))
+  where
+    -- Find a deterministic key for local names. This
+    getBinNameKey ref name = do
+      atomicModifyIORef ref (\b@(ByteCodeNameEnv next subst) ->
+        case lookupNameEnv subst name of
+          Just idx -> (b, idx)
+          Nothing  -> (ByteCodeNameEnv (next + 1) (extendNameEnv subst name next), next))
+
+addBinNameReader :: NameCache -> ReadBinHandle -> IO ReadBinHandle
+addBinNameReader nc bh' = do
+  env_ref <- newIORef emptyOccEnv
+  pure $ flip addReaderToUserData bh' $ BinaryReader $ \bh -> do
+    t <- getByte bh
+    case t of
+      0 -> do
+        nm <- get bh
+        pure $ BinName nm
+      1 -> do
+        occ <- mkVarOccFS <$> get bh
+        -- We don't want to get a new unique from the NameCache each time we
+        -- see a name.
+        nm' <- unsafeInterleaveIO $ do
+          u <- takeUniqFromNameCache nc
+          evaluate $ mkInternalName u occ noSrcSpan
+        fmap BinName $ atomicModifyIORef' env_ref $ \env ->
+          case lookupOccEnv env occ of
+            Just nm -> (env, nm)
+            _ -> nm' `seq` (extendOccEnv env occ nm', nm')
+      _ -> panic "Binary BinName: invalid byte"
+
+-- Note [Serializing Names in bytecode]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The bytecode related types contain various Names which we need to
+-- serialize. Unfortunately, we can't directly use the Binary instance
+-- of Name: it is only meant to be used for serializing external Names
+-- in BinIface logic, but bytecode does contain internal Names.
+--
+-- We also need to maintain the invariant that: any pair of internal
+-- Names with equal/different uniques must also be deserialized to
+-- have the same equality. Therefore when we write the names to the interface, we
+-- use an incrementing counter to give each local name it's own unique number. A substitution
+-- is maintained to give each occurence of the Name the same unique key. When the interface
+-- is read, a reverse mapping is used from these unique keys to a Name.
+--


=====================================
compiler/GHC/ByteCode/Recomp/Binary.hs
=====================================
@@ -0,0 +1,34 @@
+module GHC.ByteCode.Recomp.Binary (
+  -- * Fingerprinting ByteCode objects
+  computeFingerprint,
+) where
+
+import GHC.Prelude
+
+import GHC.ByteCode.Binary (addBinNameWriter)
+import GHC.Iface.Binary
+import GHC.Iface.Recomp.Binary (putNameLiterally, fingerprintBinMem)
+import GHC.Types.Name
+import GHC.Utils.Fingerprint
+import GHC.Utils.Binary
+
+import System.IO.Unsafe
+
+-- | Create a 'Fingerprint' using the appropriate serializers
+-- for 'ModuleByteCode'.
+--
+computeFingerprint :: (Binary a)
+                   => (WriteBinHandle -> Name -> IO ())
+                   -> a
+                   -> Fingerprint
+computeFingerprint put_nonbinding_name a = unsafePerformIO $ do
+    bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block
+    bh' <- addBinNameWriter bh
+    putWithUserData QuietBinIFace NormalCompression bh' a
+    fingerprintBinMem bh'
+  where
+    set_user_data bh = setWriterUserData bh $ mkWriterUserData
+      [ mkSomeBinaryWriter $ mkWriter put_nonbinding_name
+      , mkSomeBinaryWriter $ simpleBindingNameWriter $ mkWriter putNameLiterally
+      , mkSomeBinaryWriter $ mkWriter putFS
+      ]


=====================================
compiler/GHC/ByteCode/Serialize.hs
=====================================
@@ -2,11 +2,11 @@
 {-# LANGUAGE RecordWildCards #-}
 -- Orphans are here since the Binary instances use an ad-hoc means of serialising
 -- names which we don't want to pollute the rest of the codebase with.
-{-# OPTIONS_GHC -Wno-orphans #-}
 {- | This module implements the serialization of bytecode objects to and from disk.
 -}
 module GHC.ByteCode.Serialize
-  ( writeBinByteCode, readBinByteCode, ModuleByteCode(..)
+  ( writeBinByteCode, readBinByteCode
+  , ModuleByteCode(..)
   , BytecodeLibX(..)
   , BytecodeLib
   , OnDiskBytecodeLib
@@ -14,41 +14,34 @@ module GHC.ByteCode.Serialize
   , InterpreterLibraryContents(..)
   , writeBytecodeLib
   , readBytecodeLib
+  , mkModuleByteCode
+  , fingerprintModuleByteCodeContents
   , decodeOnDiskModuleByteCode
   , decodeOnDiskBytecodeLib
   )
 where
 
-import Control.Monad
-import Data.Binary qualified as Binary
-import Data.Foldable
-import Data.IORef
-import Data.Proxy
-import Data.Word
+import GHC.Prelude
+
+import GHC.ByteCode.Binary
 import GHC.ByteCode.Types
-import GHC.Data.FastString
+import GHC.ByteCode.Recomp.Binary (computeFingerprint)
+import Data.ByteString (ByteString)
 import GHC.Driver.Env
+import GHC.Driver.DynFlags
 import GHC.Iface.Binary
-import GHC.Prelude
-import GHC.Types.Name
-import GHC.Types.Name.Cache
-import GHC.Types.SrcLoc
+import GHC.Iface.Recomp.Binary (putNameLiterally)
+import GHC.Linker.Types
+import GHC.Unit.Types
 import GHC.Utils.Binary
-import GHC.Utils.Exception
-import GHC.Utils.Panic
 import GHC.Utils.TmpFs
-import System.FilePath
-import GHC.Unit.Types
-import GHC.Driver.DynFlags
-import System.Directory
-import Data.ByteString (ByteString)
+import GHC.Utils.Logger
+import GHC.Utils.Fingerprint (Fingerprint)
+
 import qualified Data.ByteString as BS
 import Data.Traversable
-import GHC.Utils.Logger
-import GHC.Linker.Types
-import System.IO.Unsafe (unsafeInterleaveIO)
-import GHC.Utils.Outputable
-import GHC.Types.Name.Env
+import System.Directory
+import System.FilePath
 
 {- Note [Overview of persistent bytecode]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -88,74 +81,6 @@ See Note [Recompilation avoidance with bytecode objects]
 
 -}

--- | The on-disk representation of a bytecode object for a specific module.
---
--- This is the representation which we serialise and write to disk.
--- The difference from 'ModuleByteCode' is that the contents of the object files
--- contained by 'ModuleByteCode' are stored in-memory rather than as file paths to
--- temporary files.
-data OnDiskModuleByteCode = OnDiskModuleByteCode { odgbc_module :: Module
-                                                 , odgbc_compiled_byte_code :: CompiledByteCode
-                                                 , odgbc_foreign :: [ByteString]  -- ^ Contents of object files
-                                                 }
-
-type OnDiskBytecodeLib = BytecodeLibX (Maybe InterpreterLibraryContents)
-
-instance Outputable a => Outputable (BytecodeLibX a) where
-  ppr (BytecodeLib {..}) = vcat [
-    (text "BytecodeLib" <+> ppr bytecodeLibUnitId),
-    (text "Files" <+> ppr bytecodeLibFiles),
-    (text "Foreign" <+> ppr bytecodeLibForeign) ]
-
-type BytecodeLib = BytecodeLibX (Maybe InterpreterLibrary)
-
--- | A bytecode library is a collection of CompiledByteCode objects and a .so file containing the combination of foreign stubs
-data BytecodeLibX a = BytecodeLib {
-    bytecodeLibUnitId :: UnitId,
-    bytecodeLibFiles :: [CompiledByteCode],
-    bytecodeLibForeign :: a -- A library file containing the combination of foreign stubs. (Ie arising from CApiFFI)
-}
-
-data InterpreterLibrary = InterpreterSharedObject { getSharedObjectFilePath :: FilePath, getSharedObjectDir :: FilePath, getSharedObjectLibName :: String }
-                         | InterpreterStaticObjects { getStaticObjects :: [FilePath] }
-
-
-instance Outputable InterpreterLibrary where
-  ppr (InterpreterSharedObject path dir name) = text "SharedObject" <+> text path <+> text dir <+> text name
-  ppr (InterpreterStaticObjects paths) = text "StaticObjects" <+> text (show paths)
-
-
-data InterpreterLibraryContents = InterpreterLibrarySharedContents { interpreterLibraryContents :: ByteString }
-                                | InterpreterLibraryStaticContents { interpreterLibraryStaticContents :: [ByteString] }
-
-instance Binary InterpreterLibraryContents where
-  get bh = do
-    t <- getByte bh
-    case t of
-      0 -> InterpreterLibrarySharedContents <$> get bh
-      1 -> InterpreterLibraryStaticContents <$> get bh
-      _ -> panic "Binary InterpreterLibraryContents: invalid byte"
-  put_ bh (InterpreterLibrarySharedContents contents) = do
-    putByte bh 0
-    put_ bh contents
-  put_ bh (InterpreterLibraryStaticContents contents) = do
-    putByte bh 1
-    put_ bh contents
-
-instance Binary OnDiskBytecodeLib where
-  get bh = do
-    bytecodeLibUnitId <- get bh
-    bytecodeLibFiles <- get bh
-    bytecodeLibForeign <- get bh
-    pure BytecodeLib {..}
-
-  put_ bh BytecodeLib {..} = do
-    put_ bh bytecodeLibUnitId
-    put_ bh bytecodeLibFiles
-    put_ bh bytecodeLibForeign
-
-
-
 writeBytecodeLib :: BytecodeLib -> FilePath -> IO ()
 writeBytecodeLib lib path = do
   odbco <- encodeBytecodeLib lib
@@ -168,22 +93,10 @@ writeBytecodeLib lib path = do
 readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib
 readBytecodeLib hsc_env path = do
   bh' <- readBinMem path
-  bh <- addBinNameReader hsc_env bh'
+  bh <- addBinNameReader (hsc_NC hsc_env) bh'
   res <- getWithUserData (hsc_NC hsc_env) bh
   pure res
 
-instance Binary OnDiskModuleByteCode where
-  get bh = do
-    odgbc_module <- get bh
-    odgbc_compiled_byte_code <- get bh
-    odgbc_foreign <- get bh
-    pure OnDiskModuleByteCode {..}
-
-  put_ bh OnDiskModuleByteCode {..} = do
-    put_ bh odgbc_module
-    put_ bh odgbc_compiled_byte_code
-    put_ bh odgbc_foreign
-
 -- | Convert an 'OnDiskModuleByteCode' to an 'ModuleByteCode'.
 -- 'OnDiskModuleByteCode' is the representation which we read from a file,
 -- the 'ModuleByteCode' is the representation which is manipulated by program logic.
@@ -198,7 +111,8 @@ decodeOnDiskModuleByteCode hsc_env odbco = do
   pure $ ModuleByteCode {
     gbc_module = odgbc_module odbco,
     gbc_compiled_byte_code = odgbc_compiled_byte_code odbco,
-    gbc_foreign_files = foreign_files
+    gbc_foreign_files = foreign_files,
+    gbc_hash = odgbc_hash odbco
    }
 
 decodeOnDiskBytecodeLib :: HscEnv -> OnDiskBytecodeLib -> IO BytecodeLib
@@ -257,7 +171,8 @@ encodeOnDiskModuleByteCode bco = do
   pure $ OnDiskModuleByteCode {
     odgbc_module = gbc_module bco,
     odgbc_compiled_byte_code = gbc_compiled_byte_code bco,
-    odgbc_foreign = foreign_contents
+    odgbc_foreign = foreign_contents,
+    odgbc_hash = gbc_hash bco
    }
 
 -- | Read a 'ModuleByteCode' from a file.
@@ -269,7 +184,7 @@ readBinByteCode hsc_env f = do
 readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode
 readOnDiskModuleByteCode hsc_env f = do
   bh' <- readBinMem f
-  bh <- addBinNameReader hsc_env bh'
+  bh <- addBinNameReader (hsc_NC hsc_env) bh'
   getWithUserData (hsc_NC hsc_env) bh
 
 -- | Write a 'ModuleByteCode' to a file.
@@ -282,169 +197,12 @@ writeBinByteCode f cbc = do
   putWithUserData QuietBinIFace NormalCompression bh odbco
   writeBinMem bh f
 
-instance Binary CompiledByteCode where
-  get bh = do
-    bc_bcos <- get bh
-    bc_itbls_len <- get bh
-    bc_itbls <- replicateM bc_itbls_len $ do
-      nm <- getViaBinName bh
-      itbl <- get bh
-      pure (nm, itbl)
-    bc_strs_len <- get bh
-    bc_strs <-
-      replicateM bc_strs_len $ (,) <$> getViaBinName bh <*> get bh
-    bc_breaks <- get bh
-    bc_spt_entries <- get bh
-    return $
-      CompiledByteCode
-        { bc_bcos,
-          bc_itbls,
-          bc_strs,
-          bc_breaks,
-          bc_spt_entries
-        }
-
-  put_ bh CompiledByteCode {..} = do
-    put_ bh bc_bcos
-    put_ bh $ length bc_itbls
-    for_ bc_itbls $ \(nm, itbl) -> do
-      putViaBinName bh nm
-      put_ bh itbl
-    put_ bh $ length bc_strs
-    for_ bc_strs $ \(nm, str) -> putViaBinName bh nm *> put_ bh str
-    put_ bh bc_breaks
-    put_ bh bc_spt_entries
-
-instance Binary UnlinkedBCO where
-  get bh =
-    UnlinkedBCO
-      <$> getViaBinName bh
-      <*> get bh
-      <*> (Binary.decode <$> get bh)
-      <*> (Binary.decode <$> get bh)
-      <*> get bh
-      <*> get bh
-
-  put_ bh UnlinkedBCO {..} = do
-    putViaBinName bh unlinkedBCOName
-    put_ bh unlinkedBCOArity
-    put_ bh $ Binary.encode unlinkedBCOInstrs
-    put_ bh $ Binary.encode unlinkedBCOBitmap
-    put_ bh unlinkedBCOLits
-    put_ bh unlinkedBCOPtrs
+mkModuleByteCode :: Module -> CompiledByteCode -> [FilePath] -> IO ModuleByteCode
+mkModuleByteCode modl cbc foreign_files = do
+  !bcos_hash <- fingerprintModuleByteCodeContents modl cbc foreign_files
+  return $! ModuleByteCode modl cbc foreign_files bcos_hash
 
-instance Binary BCOPtr where
-  get bh = do
-    t <- getByte bh
-    case t of
-      0 -> BCOPtrName <$> getViaBinName bh
-      1 -> BCOPtrPrimOp <$> get bh
-      2 -> BCOPtrBCO <$> get bh
-      3 -> BCOPtrBreakArray <$> get bh
-      _ -> panic "Binary BCOPtr: invalid byte"
-
-  put_ bh ptr = case ptr of
-    BCOPtrName nm -> putByte bh 0 *> putViaBinName bh nm
-    BCOPtrPrimOp op -> putByte bh 1 *> put_ bh op
-    BCOPtrBCO bco -> putByte bh 2 *> put_ bh bco
-    BCOPtrBreakArray info_mod -> putByte bh 3 *> put_ bh info_mod
-
-instance Binary BCONPtr where
-  get bh = do
-    t <- getByte bh
-    case t of
-      0 -> BCONPtrWord . fromIntegral <$> (get bh :: IO Word64)
-      1 -> BCONPtrLbl <$> get bh
-      2 -> BCONPtrItbl <$> getViaBinName bh
-      3 -> BCONPtrAddr <$> getViaBinName bh
-      4 -> BCONPtrStr <$> get bh
-      5 -> BCONPtrFS <$> get bh
-      6 -> BCONPtrFFIInfo <$> get bh
-      7 -> BCONPtrCostCentre <$> get bh
-      _ -> panic "Binary BCONPtr: invalid byte"
-
-  put_ bh ptr = case ptr of
-    BCONPtrWord lit -> putByte bh 0 *> put_ bh (fromIntegral lit :: Word64)
-    BCONPtrLbl sym -> putByte bh 1 *> put_ bh sym
-    BCONPtrItbl nm -> putByte bh 2 *> putViaBinName bh nm
-    BCONPtrAddr nm -> putByte bh 3 *> putViaBinName bh nm
-    BCONPtrStr str -> putByte bh 4 *> put_ bh str
-    BCONPtrFS fs -> putByte bh 5 *> put_ bh fs
-    BCONPtrFFIInfo ffi -> putByte bh 6 *> put_ bh ffi
-    BCONPtrCostCentre ibi -> putByte bh 7 *> put_ bh ibi
-
-newtype BinName = BinName {unBinName :: Name}
-
-getViaBinName :: ReadBinHandle -> IO Name
-getViaBinName bh = case findUserDataReader Proxy bh of
-  BinaryReader f -> unBinName <$> f bh
-
-putViaBinName :: WriteBinHandle -> Name -> IO ()
-putViaBinName bh nm = case findUserDataWriter Proxy bh of
-  BinaryWriter f -> f bh $ BinName nm
-
-data BytecodeNameEnv = ByteCodeNameEnv { _bytecode_next_id :: !Word64
-                                       , _bytecode_name_subst :: NameEnv Word64
-                                       }
-
-addBinNameWriter :: WriteBinHandle -> IO WriteBinHandle
-addBinNameWriter bh' = do
-  env_ref <- newIORef (ByteCodeNameEnv 0 emptyNameEnv)
-  evaluate
-    $ flip addWriterToUserData bh'
-    $ BinaryWriter
-    $ \bh (BinName nm) ->
-      if
-        | isExternalName nm -> do
-            putByte bh 0
-            put_ bh nm
-        | otherwise -> do
-            putByte bh 1
-            key <- getBinNameKey env_ref nm
-            -- Delimit the OccName from the deterministic counter to keep the
-            -- encoding injective, avoiding collisions like "foo1" vs "foo#1".
-            put_ bh (occNameFS (occName nm) `appendFS` mkFastString ('#' : show key))
-  where
-    -- Find a deterministic key for local names. This
-    getBinNameKey ref name = do
-      atomicModifyIORef ref (\b@(ByteCodeNameEnv next subst) ->
-        case lookupNameEnv subst name of
-          Just idx -> (b, idx)
-          Nothing  -> (ByteCodeNameEnv (next + 1) (extendNameEnv subst name next), next))
-
-addBinNameReader :: HscEnv -> ReadBinHandle -> IO ReadBinHandle
-addBinNameReader HscEnv {..} bh' = do
-  env_ref <- newIORef emptyOccEnv
-  pure $ flip addReaderToUserData bh' $ BinaryReader $ \bh -> do
-    t <- getByte bh
-    case t of
-      0 -> do
-        nm <- get bh
-        pure $ BinName nm
-      1 -> do
-        occ <- mkVarOccFS <$> get bh
-        -- We don't want to get a new unique from the NameCache each time we
-        -- see a name.
-        nm' <- unsafeInterleaveIO $ do
-          u <- takeUniqFromNameCache hsc_NC
-          evaluate $ mkInternalName u occ noSrcSpan
-        fmap BinName $ atomicModifyIORef' env_ref $ \env ->
-          case lookupOccEnv env occ of
-            Just nm -> (env, nm)
-            _ -> nm' `seq` (extendOccEnv env occ nm', nm')
-      _ -> panic "Binary BinName: invalid byte"
-
--- Note [Serializing Names in bytecode]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- The bytecode related types contain various Names which we need to
--- serialize. Unfortunately, we can't directly use the Binary instance
--- of Name: it is only meant to be used for serializing external Names
--- in BinIface logic, but bytecode does contain internal Names.
---
--- We also need to maintain the invariant that: any pair of internal
--- Names with equal/different uniques must also be deserialized to
--- have the same equality. Therefore when we write the names to the interface, we
--- use an incrementing counter to give each local name it's own unique number. A substitution
--- is maintained to give each occurence of the Name the same unique key. When the interface
--- is read, a reverse mapping is used from these unique keys to a Name.
---
+fingerprintModuleByteCodeContents :: Module -> CompiledByteCode -> [FilePath] -> IO Fingerprint
+fingerprintModuleByteCodeContents modl cbc foreign_files = do
+  foreign_contents <- readObjectFiles foreign_files
+  pure $ computeFingerprint putNameLiterally (modl, cbc, foreign_contents)


=====================================
compiler/GHC/Driver/Hooks.hs
=====================================
@@ -137,7 +137,7 @@ data Hooks = Hooks
   , tcForeignExportsHook   :: !(Maybe ([LForeignDecl GhcRn]
             -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)))
   , hscFrontendHook        :: !(Maybe (ModSummary -> Hsc FrontendResult))
-  , hscCompileCoreExprHook :: !(Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)))
+  , hscCompileCoreExprHook :: !(Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [LinkableUsage], PkgsLoaded)))
   , ghcPrimIfaceHook       :: !(Maybe ModIface)
   , runPhaseHook           :: !(Maybe PhaseHook)
   , runMetaHook            :: !(Maybe (MetaHook TcM))
@@ -145,7 +145,7 @@ data Hooks = Hooks
                                          -> HomePackageTable -> IO SuccessFlag))
   , runRnSpliceHook        :: !(Maybe (HsUntypedSplice GhcRn -> RnM (HsUntypedSplice GhcRn)))
   , getValueSafelyHook     :: !(Maybe (HscEnv -> Name -> Type
-                                         -> IO (Either Type (HValue, [Linkable], PkgsLoaded))))
+                                         -> IO (Either Type (HValue, [LinkableUsage], PkgsLoaded))))
   , createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle))
   , stgToCmmHook           :: !(Maybe (StgToCmmConfig -> InfoTableProvMap -> [TyCon] -> CollectedCCs
                                  -> [CgStgTopBinding] -> CgStream CmmGroup ModuleLFInfos))


=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -301,8 +301,7 @@ import GHC.Cmm.Config (CmmConfig)
 import Data.Bifunctor
 import qualified GHC.Unit.Home.Graph as HUG
 import GHC.Unit.Home.PackageTable
-
-import GHC.ByteCode.Serialize
+import qualified GHC.ByteCode.Serialize as ByteCode
 
 {- **********************************************************************
 %*                                                                      *
@@ -866,7 +865,7 @@ hscRecompStatus
            | otherwise -> do
                -- Check the status of all the linkable types we might need.
                -- 1. The in-memory linkable we had at hand.
-               bc_in_memory_linkable <- checkByteCodeInMemory hsc_env mod_summary (homeMod_bytecode old_linkable)
+               bc_in_memory_linkable <- checkByteCodeInMemory hsc_env mod_summary (homeModLinkableByteCode old_linkable)
                -- 2. The bytecode object file
                bc_obj_linkable <- checkByteCodeFromObject hsc_env mod_summary
                -- 3. Bytecode from an interface's whole core bindings.
@@ -1013,7 +1012,7 @@ checkByteCodeFromObject hsc_env mod_sum = do
           -- Don't force this if we reuse the linkable already loaded into memory, but we have to check
           -- that the one we have on disk would be suitable as well.
           linkable <- unsafeInterleaveIO $ do
-            bco <- readBinByteCode hsc_env obj_fn
+            bco <- ByteCode.readBinByteCode hsc_env obj_fn
             return $ mkModuleByteCodeLinkable obj_date bco
           return $ UpToDateItem linkable
     _ -> return $ outOfDateItemBecause MissingBytecode Nothing
@@ -1098,7 +1097,7 @@ loadIfaceByteCodeLazy ::
   ModIface ->
   ModLocation ->
   TypeEnv ->
-  IO (Maybe Linkable)
+  IO (Maybe (LinkableWith ModuleByteCode))
 loadIfaceByteCodeLazy hsc_env iface location type_env =
   case iface_core_bindings iface location of
     Nothing -> return Nothing
@@ -1106,8 +1105,9 @@ loadIfaceByteCodeLazy hsc_env iface location type_env =
       Just <$> compile wcb
   where
     compile decls = do
-      bco <- unsafeInterleaveIO $ compileWholeCoreBindings hsc_env type_env decls
-      linkable $ NE.singleton (DotGBC bco)
+      bco <- unsafeInterleaveIO $ do
+          compileWholeCoreBindings hsc_env type_env decls
+      linkable bco
 
     linkable parts = do
       if_time <- modificationTimeIfExists (ml_hi_file_ospath location)
@@ -1148,14 +1148,14 @@ initWholeCoreBindings hsc_env iface details (RecompLinkables bc o) = do
   where
     type_env = md_types details
 
-    go :: RecompBytecodeLinkable -> IO (Maybe Linkable)
+    go :: RecompBytecodeLinkable -> IO (Maybe (LinkableWith ModuleByteCode))
     go (NormalLinkable l) = pure l
     go (WholeCoreBindingsLinkable wcbl) =
       fmap Just $ for wcbl $ \wcb -> do
         add_iface_to_hpt iface details hsc_env
-        bco <- unsafeInterleaveIO $
-                       compileWholeCoreBindings hsc_env type_env wcb
-        pure $ NE.singleton (DotGBC bco)
+        bco <- unsafeInterleaveIO $ do
+            compileWholeCoreBindings hsc_env type_env wcb
+        pure bco
 
 -- | Hydrate interface Core bindings and compile them to bytecode.
 --
@@ -2217,7 +2217,7 @@ generateAndWriteByteCode hsc_env cgguts mod_location = do
   -- See Note [-fwrite-byte-code is not the default]
   when (gopt Opt_WriteByteCode dflags) $ do
     let bc_path = ml_bytecode_file mod_location
-    writeBinByteCode bc_path comp_bc
+    ByteCode.writeBinByteCode bc_path comp_bc
   return comp_bc
 
 {-
@@ -2232,20 +2232,20 @@ make user's opt into writing the files.
 -}
 
 -- | Generate a 'ModuleByteCode' and write it to disk if `-fwrite-byte-code` is enabled.
-generateAndWriteByteCodeLinkable :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO Linkable
+generateAndWriteByteCodeLinkable :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO (LinkableWith ModuleByteCode)
 generateAndWriteByteCodeLinkable hsc_env cgguts mod_location = do
   bco_object <- generateAndWriteByteCode hsc_env cgguts mod_location
   -- Either, get the same time as the .gbc file if it exists, or just the current time.
   -- It's important the time of the linkable matches the time of the .gbc file for recompilation
   -- checking.
   bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file_ospath mod_location)
-  return $ mkModuleByteCodeLinkable bco_time bco_object
+  return $ mkOnlyModuleByteCodeLinkable bco_time bco_object
 
 mkModuleByteCode :: HscEnv -> Module -> ModLocation -> CgInteractiveGuts -> IO ModuleByteCode
 mkModuleByteCode hsc_env mod mod_location cgguts = do
   bcos <- hscGenerateByteCode hsc_env cgguts mod_location
   objs <- outputAndCompileForeign hsc_env mod mod_location (cgi_foreign_files cgguts) (cgi_foreign cgguts)
-  return $! ModuleByteCode mod bcos objs
+  ByteCode.mkModuleByteCode mod bcos objs
 
 -- | Generate a fresh 'ModuleByteCode' for a given module but do not write it to disk.
 generateFreshByteCodeLinkable :: HscEnv
@@ -2767,13 +2767,13 @@ hscTidy hsc_env guts = do
 %*                                                                      *
 %********************************************************************* -}
 
-hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
+hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [LinkableUsage], PkgsLoaded)
 hscCompileCoreExpr hsc_env loc expr =
   case hscCompileCoreExprHook (hsc_hooks hsc_env) of
       Nothing -> hscCompileCoreExpr' hsc_env loc expr
       Just h  -> h                   hsc_env loc expr
 
-hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
+hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [LinkableUsage], PkgsLoaded)
 hscCompileCoreExpr' hsc_env srcspan ds_expr = do
   {- Simplify it -}
   -- Question: should we call SimpleOpt.simpleOptExpr here instead?
@@ -2859,8 +2859,9 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do
 
       {- load it -}
       bco_time <- getCurrentTime
+      !mbc <- ByteCode.mkModuleByteCode this_mod bcos []
       (mods_needed, units_needed) <- loadDecls interp hsc_env srcspan $
-        Linkable bco_time this_mod $ NE.singleton $ DotGBC (ModuleByteCode this_mod bcos [])
+        Linkable bco_time this_mod $ NE.singleton (DotGBC mbc)
       -- Get the foreign reference to the name we should have just loaded.
       mhvs <- lookupFromLoadedEnv interp (idName binding_id)
       {- Get the HValue for the root -}
@@ -2876,7 +2877,7 @@ jsCodeGen
   -> Module
   -> [(CgStgTopBinding,IdSet)]
   -> Id
-  -> IO (ForeignHValue, [Linkable], PkgsLoaded)
+  -> IO (ForeignHValue, [LinkableUsage], PkgsLoaded)
 jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do
   let logger           = hsc_logger hsc_env
       tmpfs            = hsc_tmpfs hsc_env


=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -430,7 +430,7 @@ link' hsc_env batch_attempt_linking mHscMessager hpt
                 let obj_files = concatMap linkableObjs linkables
                 in action obj_files
             linkBytecodeLinkable action =
-              checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink checkBytecodeLibraryLinkingNeeded homeMod_bytecode $ \linkables ->
+              checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink checkBytecodeLibraryLinkingNeeded homeModLinkableByteCode $ \linkables ->
                 let bytecode = concatMap linkableModuleByteCodes linkables
                 in action bytecode
 


=====================================
compiler/GHC/Driver/Plugins.hs
=====================================
@@ -342,7 +342,7 @@ data Plugins = Plugins
       -- The purpose of this field is to cache the plugins so they
       -- don't have to be loaded each time they are needed.  See
       -- 'GHC.Runtime.Loader.initializePlugins'.
-  , loadedPluginDeps :: !([Linkable], PkgsLoaded)
+  , loadedPluginDeps :: !([LinkableUsage], PkgsLoaded)
   -- ^ The object files required by the loaded plugins
   -- See Note [Plugin dependencies]
   }


=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -7,8 +7,6 @@ module GHC.HsToCore.Usage (
 
 import GHC.Prelude
 
-import GHC.Driver.Env
-
 import GHC.Tc.Types
 
 import GHC.Iface.Load
@@ -27,7 +25,6 @@ import GHC.Types.Unique.Set
 
 import GHC.Unit
 import GHC.Unit.Env
-import GHC.Unit.External
 import GHC.Unit.Module.Imported
 import GHC.Unit.Module.ModIface
 import GHC.Unit.Module.Deps
@@ -35,18 +32,17 @@ import GHC.Unit.Module.Deps
 import GHC.Data.Maybe
 import GHC.Data.FastString
 
-import Data.IORef
 import Data.List (sortBy)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import qualified Data.List.NonEmpty as NE
 
 import GHC.Linker.Types
 import GHC.Unit.Finder
 import GHC.Types.Unique.DFM
 import GHC.Driver.Plugins
 import qualified GHC.Unit.Home.Graph as HUG
+import qualified Data.List.NonEmpty as NE
 
 {- Note [Module self-dependency]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -75,19 +71,17 @@ data UsageConfig = UsageConfig
 
 mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv
             -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet
-            -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded
+            -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [LinkableUsage] -> PkgsLoaded
             -> IfG [Usage]
 mkUsageInfo uc plugins fc unit_env
   this_mod dir_imp_mods imp_decls used_names
   dependent_files dependent_dirs merged needed_links needed_pkgs
   = do
-    eps <- liftIO $ readIORef (euc_eps (ue_eps unit_env))
     file_hashes <- liftIO $ mapM getFileHash dependent_files
     dirs_hashes <- liftIO $ mapM getDirHash dependent_dirs
     let hu = ue_unsafeHomeUnit unit_env
-        hug = ue_home_unit_graph unit_env
     -- Dependencies on object files due to TH and plugins
-    object_usages <- liftIO $ mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs
+    object_usages <- liftIO $ mkObjectUsage plugins fc needed_links needed_pkgs
     let all_home_ids = HUG.allUnits (ue_home_unit_graph unit_env)
     mod_usages <- mk_mod_usage_info uc hu all_home_ids this_mod
                                        dir_imp_mods imp_decls used_names
@@ -176,44 +170,39 @@ For bytecode objects there are also two forms of dependencies.
 1. The existence of the .gbc file for the module you are currently compiling.
 2. The usage of bytecode to evaluate TH splices (similar to Note [Object File Dependencies])
 
-In situation (2), we would ideally want to record the hash of the `CompiledByteCode` which
-was used when evaluating the TH splice. This was a bit tricky to implement so it's tracked as a future
-improvement to the recompilation checking for bytecode objects.
-
-For now, the interface hash is used as a proxy to determine if the BCO will have changed
-for a module or not. This is similar to how the recompilation checking for the legacy
-`-fwrite-if-simplified-core` code path which generated bytecode from core bindings used to work.
-
+In both cases, we record the hash of the 'CompiledByteCode' which was used when evaluating
+the TH splice.
 -}
 
 
 
 -- | Find object files corresponding to the transitive closure of given home
 -- modules and direct object files for pkg dependencies
-mkObjectUsage :: PackageIfaceTable -> Plugins -> FinderCache -> HomeUnitGraph-> [Linkable] -> PkgsLoaded -> IO [Usage]
-mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do
+mkObjectUsage :: Plugins -> FinderCache -> [LinkableUsage] -> PkgsLoaded -> IO [Usage]
+mkObjectUsage plugins fc th_links_needed th_pkgs_needed = do
       let ls = ordNubOn linkableModule (th_links_needed ++ plugins_links_needed)
           ds = concatMap loaded_pkg_hs_objs $ eltsUDFM (plusUDFM th_pkgs_needed plugin_pkgs_needed) -- TODO possibly record loaded_pkg_non_hs_objs as well
           (plugins_links_needed, plugin_pkgs_needed) = loadedPluginDeps plugins
       concat <$> sequence (map linkableToUsage ls ++ map librarySpecToUsage ds)
   where
-    linkableToUsage (Linkable _ m uls) = mapM (partToUsage m) (NE.toList uls)
+    linkableToUsage (Linkable _ _m parts) = traverse partToUsage (NE.toList parts)
 
     msg m = moduleNameString (moduleName m) ++ "[TH] changed"
 
-    fing mmsg fn = UsageFile (mkFastString fn) <$> lookupFileCache fc fn <*> pure mmsg
+    partToUsage link_usage =
+      case link_usage of
+        FileLinkablePartUsage{flu_file, flu_module} -> do
+          fing (Just $ msg flu_module) flu_file
 
-    partToUsage m part =
-      case linkablePartPath part of
-        Just fn -> fing (Just (msg m)) fn
-        Nothing ->  do
-          -- This should only happen for home package things but oneshot puts
-          -- home package ifaces in the PIT.
-          miface <- lookupIfaceByModule hug pit m
-          case miface of
-            Nothing -> pprPanic "linkableToUsage" (ppr m)
-            Just iface ->
-              return $ UsageHomeModuleInterface (moduleName m) (toUnitId $ moduleUnit m) (mi_iface_hash iface)
+        ByteCodeLinkablePartUsage{bclu_module, bclu_hash} ->
+          pure $
+            UsageHomeModuleBytecode
+              { usg_mod_name = moduleName bclu_module
+              , usg_unit_id = toUnitId $ moduleUnit bclu_module
+              , usg_bytecode_hash = bclu_hash
+              }
+
+    fing mmsg fn = UsageFile (mkFastString fn) <$> lookupFileCache fc fn <*> pure mmsg
 
     librarySpecToUsage :: LibrarySpec -> IO [Usage]
     librarySpecToUsage (Objects os) = traverse (fing Nothing) os


=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -88,6 +88,10 @@ import GHC.Iface.Errors.Ppr
 import Data.Functor
 import Data.Bifunctor (first)
 import GHC.Types.PkgQual
+import GHC.ByteCode.Serialize (ModuleByteCode, gbc_hash)
+import GHC.Unit.Home.Graph (lookupHugByModule)
+import GHC.Unit.Home.ModInfo (HomeModLinkable(..), HomeModInfo (..))
+import GHC.Linker.Types (linkableParts)
 
 {-
   -----------------------------------------------
@@ -190,6 +194,7 @@ data RecompReason
   | ModuleAdded (ImportLevel, UnitId, ModuleName)
   | ModuleChangedRaw ModuleName
   | ModuleChangedIface ModuleName
+  | ModuleChangedBytecode ModuleName
   | FileChanged FilePath
   | DirChanged FilePath
   | CustomReason String
@@ -225,6 +230,7 @@ instance Outputable RecompReason where
     ModuleChanged m          -> ppr m <+> text "changed"
     ModuleChangedRaw m       -> ppr m <+> text "changed (raw)"
     ModuleChangedIface m     -> ppr m <+> text "changed (interface)"
+    ModuleChangedBytecode m     -> ppr m <+> text "changed (bytecode)"
     ModuleRemoved (_st, _uid, m)   -> ppr m <+> text "removed"
     ModuleAdded (_st, _uid, m)     -> ppr m <+> text "added"
     FileChanged fp           -> text fp <+> text "changed"
@@ -718,6 +724,15 @@ needInterface mod continue
         Nothing -> return $ NeedsRecompile MustCompile
         Just iface -> liftIO $ continue iface
 
+needBytecode :: Module -> (ModuleByteCode -> IO RecompileRequired)
+             -> IfG RecompileRequired
+needBytecode mod continue
+  = do
+      mb_recomp <- tryGetBytecode mod
+      case mb_recomp of
+        Nothing -> return $ NeedsRecompile MustCompile
+        Just mbc -> liftIO $ continue mbc
+
 tryGetModIface :: String -> Module -> IfG (Maybe ModIface)
 tryGetModIface doc_msg mod
   = do  -- Load the imported interface if possible
@@ -739,6 +754,27 @@ tryGetModIface doc_msg mod
                   -- import and it's been deleted
       Succeeded iface -> pure $ Just iface
 
+tryGetBytecode :: Module -> IfG (Maybe ModuleByteCode)
+tryGetBytecode mod
+  = do  -- Load the imported bytecode if possible
+    logger <- getLogger
+    liftIO $ trace_hi_diffs logger (text "Checking bytecode hash for module" <+> ppr mod <+> ppr (moduleUnit mod))
+
+    mb_module_bytecode <- do
+      env <- getTopEnv
+      liftIO (lookupHugByModule mod (hsc_HUG env)) >>= \ case
+        Nothing -> pure Nothing
+        Just hmi ->
+          case homeMod_bytecode (hm_linkable hmi) of
+            Nothing -> pure Nothing
+            Just gbc_linkable -> pure $ Just $ linkableParts gbc_linkable
+
+    case mb_module_bytecode of
+      Nothing -> do
+        liftIO $ trace_hi_diffs logger (sep [text "Couldn't find bytecode for module", ppr mod])
+        return Nothing
+      Just module_bytecode -> pure $ Just module_bytecode
+
 -- | Given the usage information extracted from the old
 -- M.hi file for the module being compiled, figure out
 -- whether M needs to be recompiled.
@@ -760,14 +796,14 @@ checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_ha
   needInterface mod $ \iface -> do
     let reason = ModuleChangedRaw (moduleName mod)
     checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface)
-checkModUsage _  UsageHomeModuleInterface{ usg_mod_name = mod_name
+checkModUsage _  UsageHomeModuleBytecode{ usg_mod_name = mod_name
                                                  , usg_unit_id = uid
-                                                 , usg_iface_hash = old_mod_hash } = do
+                                                 , usg_bytecode_hash = old_bytecode_hash } = do
   let mod = mkModule (RealUnit (Definite uid)) mod_name
   logger <- getLogger
-  needInterface mod $ \iface -> do
-    let reason = ModuleChangedIface mod_name
-    checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash iface)
+  needBytecode mod $ \cbc -> do
+    let reason = ModuleChangedBytecode mod_name
+    checkBytecodeFingerprint logger reason old_bytecode_hash (gbc_hash cbc)
 
 checkModUsage _ UsageHomeModule{
                                 usg_mod_name = mod_name,
@@ -1032,19 +1068,18 @@ checkModuleFingerprint logger reason old_mod_hash new_mod_hash
   = out_of_date_hash logger reason (text "  Module fingerprint has changed")
                      old_mod_hash new_mod_hash
 
-checkIfaceFingerprint
+checkBytecodeFingerprint
   :: Logger
   -> RecompReason
   -> Fingerprint
   -> Fingerprint
   -> IO RecompileRequired
-checkIfaceFingerprint logger reason old_mod_hash new_mod_hash
-  | new_mod_hash == old_mod_hash
-  = up_to_date logger (text "Iface fingerprint unchanged")
-
+checkBytecodeFingerprint logger reason old_bytecode_hash new_bytecode_hash
+  | old_bytecode_hash == new_bytecode_hash
+  = up_to_date logger (text "Bytecode fingerprint unchanged")
   | otherwise
-  = out_of_date_hash logger reason (text "  Iface fingerprint has changed")
-                     old_mod_hash new_mod_hash
+  = out_of_date_hash logger reason (text "  Bytecode fingerprint has changed")
+                     old_bytecode_hash new_bytecode_hash
 
 ------------------------
 checkEntityUsage :: Logger


=====================================
compiler/GHC/Iface/Recomp/Types.hs
=====================================
@@ -146,10 +146,10 @@ pprUsage usage@UsageDirectory{}
           ppr (usg_dir_hash usage)]
 pprUsage usage@UsageMergedRequirement{}
   = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)]
-pprUsage usage@UsageHomeModuleInterface{}
-  = hsep [text "implementation", ppr (usg_mod_name usage)
+pprUsage usage@UsageHomeModuleBytecode{}
+  = hsep [text "Bytecode", ppr (usg_mod_name usage)
                                , ppr (usg_unit_id usage)
-                               , ppr (usg_iface_hash usage)]
+                               , ppr (usg_bytecode_hash usage)]
 
 pprUsageImport :: Outputable mod => mod -> Fingerprint -> IsSafeImport -> SDoc
 pprUsageImport mod hash safe
@@ -157,4 +157,4 @@ pprUsageImport mod hash safe
          , ppr hash ]
     where
         pp_safe | safe      = text "safe"
-                | otherwise = text " -/ "
\ No newline at end of file
+                | otherwise = text " -/ "


=====================================
compiler/GHC/Linker/ByteCode.hs
=====================================
@@ -31,7 +31,7 @@ linkBytecodeLib hsc_env gbcs = do
 
   on_disk_bcos <- mapM (readBinByteCode hsc_env) bytecodeObjects
 
-  let (all_cbcs, foreign_stubs) = unzip [ (bs, fs) | ModuleByteCode _m bs fs <- on_disk_bcos ++ gbcs]
+  let (all_cbcs, foreign_stubs) = unzip [ (bs, fs) | ModuleByteCode _m bs fs _hash <- on_disk_bcos ++ gbcs]
 
   interpreter_foreign_lib <- mkInterpreterLib hsc_env (concat foreign_stubs ++ objectFiles)
 
@@ -67,4 +67,4 @@ mkInterpreterLib hsc_env files =
           return $ Just (InterpreterSharedObject foreign_stub_lib_path foreign_stub_lib_dir foreign_stub_lib_name)
         Nothing -> pure Nothing
     False -> do
-      pure $ Just (InterpreterStaticObjects files)
\ No newline at end of file
+      pure $ Just (InterpreterStaticObjects files)


=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -63,7 +63,7 @@ data LinkDepsOpts = LinkDepsOpts
 
 data LinkDeps = LinkDeps
   { ldNeededLinkables :: [Linkable]
-  , ldAllLinkables    :: [Linkable]
+  , ldAllLinkables    :: [LinkableUsage]
   , ldUnits           :: [UnitId]
   , ldNeededUnits     :: UniqDSet UnitId
   }
@@ -126,7 +126,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
 
       return $ LinkDeps
         { ldNeededLinkables = lnks_needed
-        , ldAllLinkables    = links_got ++ lnks_needed
+        , ldAllLinkables    = links_got ++ mkLinkablesUsage lnks_needed
         , ldUnits           = pkgs_needed
         , ldNeededUnits     = pkgs_s
         }


=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -228,7 +228,7 @@ lookupFromLoadedEnv interp name = do
 -- | Load the module containing the given Name and get its associated 'HValue'.
 --
 -- Throws a 'ProgramError' if loading fails or the name cannot be found.
-loadName :: Interp -> HscEnv -> Name -> IO (ForeignHValue, [Linkable], PkgsLoaded)
+loadName :: Interp -> HscEnv -> Name -> IO (ForeignHValue, [LinkableUsage], PkgsLoaded)
 loadName interp hsc_env name = do
   initLoaderState interp hsc_env
   modifyLoaderState interp $ \pls0 -> do
@@ -258,7 +258,7 @@ loadDependencies
   -> LoaderState
   -> SrcSpan
   -> [Module]
-  -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required
+  -> IO (LoaderState, SuccessFlag, [LinkableUsage], PkgsLoaded) -- ^ returns the set of linkables required
 -- When called, the loader state must have been initialized (see `initLoaderState`)
 loadDependencies interp hsc_env pls span needed_mods = do
    let opts = initLinkDepsOpts hsc_env
@@ -645,7 +645,7 @@ initLinkDepsOpts hsc_env = opts
     dflags = hsc_dflags hsc_env
 
     ldLoadByteCode mod locn = do
-      bytecode_linkable <-  findBytecodeLinkableMaybe hsc_env mod locn
+      bytecode_linkable <-  findBytecodeLinkableMaybe hsc_env locn
       case bytecode_linkable of
         Nothing -> findWholeCoreBindings hsc_env mod
         Just bco -> return (Just bco)
@@ -659,19 +659,14 @@ findWholeCoreBindings hsc_env mod = do
       sequence (lookupModuleEnv eps_iface_bytecode mod)
 
 
-findBytecodeLinkableMaybe :: HscEnv -> Module -> ModLocation -> IO (Maybe Linkable)
-findBytecodeLinkableMaybe hsc_env mod locn = do
+findBytecodeLinkableMaybe :: HscEnv -> ModLocation -> IO (Maybe Linkable)
+findBytecodeLinkableMaybe hsc_env locn = do
   let bytecode_fn    = ml_bytecode_file locn
       bytecode_fn_os = ml_bytecode_file_ospath locn
   maybe_bytecode_time <- modificationTimeIfExists bytecode_fn_os
   case maybe_bytecode_time of
     Nothing -> return Nothing
     Just bytecode_time -> do
-      -- Also load the interface, for reasons to do with recompilation avoidance.
-      -- See Note [Recompilation avoidance with bytecode objects]
-      _ <- initIfaceLoad hsc_env $
-             loadInterface (text "get_reachable_nodes" <+> parens (ppr mod))
-                 mod ImportBySystem
       bco <- readBinByteCode hsc_env bytecode_fn
       return $ Just $ mkModuleByteCodeLinkable bytecode_time bco
 
@@ -723,7 +718,7 @@ get_reachable_nodes hsc_env mods
   ********************************************************************* -}
 
 -- | Load the dependencies of a linkable, and then load the linkable itself.
-loadDecls :: Interp -> HscEnv -> SrcSpan -> Linkable -> IO ([Linkable], PkgsLoaded)
+loadDecls :: Interp -> HscEnv -> SrcSpan -> Linkable -> IO ([LinkableUsage], PkgsLoaded)
 loadDecls interp hsc_env span linkable = do
     -- Initialise the linker (if it's not been done already)
     initLoaderState interp hsc_env
@@ -823,7 +818,7 @@ loadModuleLinkables interp hsc_env pls keep_spec linkables
     (objs, bcos) = partitionLinkables linkables
 
 
-linkableInSet :: Linkable -> LinkableSet -> Bool
+linkableInSet :: Linkable -> LinkableSet LinkableUsage -> Bool
 linkableInSet l objs_loaded =
   case lookupModuleEnv objs_loaded (linkableModule l) of
         Nothing -> False
@@ -952,17 +947,17 @@ dynLoadObjs interp hsc_env pls objs = do
                         then addWay WayProf
                         else id
 
-rmDupLinkables :: LinkableSet    -- Already loaded
-               -> [Linkable]    -- New linkables
-               -> (LinkableSet,  -- New loaded set (including new ones)
+rmDupLinkables :: LinkableSet LinkableUsage  -- ^ Already loaded
+               -> [Linkable]    -- ^ New linkables
+               -> (LinkableSet LinkableUsage,  -- New loaded set (including new ones)
                    [Linkable])  -- New linkables (excluding dups)
 rmDupLinkables already ls
   = go already [] ls
   where
-    go already extras [] = (already, extras)
-    go already extras (l:ls)
+    go !already extras [] = (already, extras)
+    go !already extras (l:ls)
         | linkableInSet l already = go already     extras     ls
-        | otherwise               = go (extendModuleEnv already (linkableModule l) l) (l:extras) ls
+        | otherwise               = go (extendModuleEnv already (linkableModule l) $! mkLinkableUsage l) (l:extras) ls
 
 {- **********************************************************************
 
@@ -1115,7 +1110,7 @@ unload_wkr interp pls@LoaderState{..}  = do
 
   -- If we unloaded any object files at all, we need to purge the cache
   -- of lookupSymbol results.
-  when (not (null (filter (not . null . linkableObjs) linkables_to_unload))) $
+  when (not (null (filter (not . null . linkableUsageObjs) linkables_to_unload))) $
     purgeLookupSymbolCache interp
 
   let !new_pls = pls { bco_loader_state = modifyHomePackageBytecodeState bco_loader_state $ \_ -> emptyBytecodeState,
@@ -1125,7 +1120,7 @@ unload_wkr interp pls@LoaderState{..}  = do
 
   return new_pls
   where
-    unloadObjs :: Linkable -> IO ()
+    unloadObjs :: LinkableUsage -> IO ()
     unloadObjs lnk
       | interpreterDynamic interp = return ()
         -- We don't do any cleanup when linking objects with the
@@ -1133,7 +1128,7 @@ unload_wkr interp pls@LoaderState{..}  = do
         -- not much benefit.
 
       | otherwise
-      = mapM_ (unloadObj interp) (linkableObjs lnk)
+      = mapM_ (unloadObj interp) (linkableUsageObjs lnk)
                 -- The components of a BCO linkable may contain
                 -- dot-o files (generated from C stubs).
                 --


=====================================
compiler/GHC/Linker/Types.hs
=====================================
@@ -49,6 +49,7 @@ module GHC.Linker.Types
    , WholeCoreBindingsLinkable
    , LinkableWith(..)
    , mkModuleByteCodeLinkable
+   , mkOnlyModuleByteCodeLinkable
    , LinkablePart(..)
    , LinkableObjectSort (..)
    , linkableIsNativeCodeOnly
@@ -67,6 +68,11 @@ module GHC.Linker.Types
    , linkableFilterNative
    , partitionLinkables
 
+   , LinkableUsage
+   , linkableUsageObjs
+   , mkLinkablesUsage
+   , mkLinkableUsage
+
    , ModuleByteCode(..)
    )
 where
@@ -78,26 +84,29 @@ import GHCi.BreakArray
 import GHCi.RemoteTypes
 import GHCi.Message            ( LoadedDLL )
 
+import qualified GHC.Data.OsPath as OsPath
+import qualified GHC.Data.FlatBag as FlatBag
+import GHC.Fingerprint (Fingerprint)
 import GHC.Stack.CCS
 import GHC.Types.Name.Env      ( NameEnv, emptyNameEnv, extendNameEnvList, lookupNameEnv )
 import GHC.Types.Name          ( Name )
 import GHC.Types.SptEntry
+import GHC.Types.Unique.DSet
+import GHC.Types.Unique.DFM
+import GHC.Unit.Module.Deps (LinkablePartUsage (..), linkablePartUsageObjectPaths)
+import GHC.Unit.Module.Env
+import GHC.Unit.Module.WholeCoreBindings
 
 import GHC.Utils.Outputable
 
+import Control.Applicative ((<|>))
 import Control.Concurrent.MVar
 import Data.Array
+import Data.Functor.Identity
 import Data.Time               ( UTCTime )
-import GHC.Unit.Module.Env
-import GHC.Types.Unique.DSet
-import GHC.Types.Unique.DFM
-import GHC.Unit.Module.WholeCoreBindings
 import Data.Maybe (mapMaybe)
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
 import qualified Data.List.NonEmpty as NE
-import Control.Applicative ((<|>))
-import Data.Functor.Identity
-
 
 {- **********************************************************************
 
@@ -172,10 +181,10 @@ data LoaderState = LoaderState
         -- ^ Information about bytecode objects we have loaded into the
         -- interpreter.
 
-    , bcos_loaded :: !LinkableSet
+    , bcos_loaded :: !(LinkableSet LinkableUsage)
         -- ^ The currently loaded interpreted modules (home package)
 
-    , objs_loaded :: !LinkableSet
+    , objs_loaded :: !(LinkableSet LinkableUsage)
         -- ^ And the currently-loaded compiled modules (home package)
 
     , pkgs_loaded :: !PkgsLoaded
@@ -384,15 +393,17 @@ type Linkable = LinkableWith (NonEmpty LinkablePart)
 
 type WholeCoreBindingsLinkable = LinkableWith WholeCoreBindings
 
-type LinkableSet = ModuleEnv Linkable
+type LinkableUsage = LinkableWith (NonEmpty LinkablePartUsage)
 
-mkLinkableSet :: [Linkable] -> LinkableSet
+type LinkableSet = ModuleEnv
+
+mkLinkableSet :: [Linkable] -> LinkableSet Linkable
 mkLinkableSet ls = mkModuleEnv [(linkableModule l, l) | l <- ls]
 
 -- | Union of LinkableSets.
 --
 -- In case of conflict, keep the most recent Linkable (as per linkableTime)
-unionLinkableSet :: LinkableSet -> LinkableSet -> LinkableSet
+unionLinkableSet :: LinkableSet (LinkableWith a) -> LinkableSet (LinkableWith a) -> LinkableSet (LinkableWith a)
 unionLinkableSet = plusModuleEnv_C go
   where
     go l1 l2
@@ -435,8 +446,9 @@ data LinkablePart
   | DotDLL FilePath
       -- ^ Dynamically linked library file (.so, .dll, .dylib)
 
-  | DotGBC ModuleByteCode
-    -- ^ A byte-code object, lives only in memory.
+  | DotGBC
+      -- ^ A byte-code object, lives only in memory.
+      ModuleByteCode
 
 
 -- | The in-memory representation of a bytecode object
@@ -444,14 +456,19 @@ data LinkablePart
 data ModuleByteCode = ModuleByteCode { gbc_module :: Module
                                       , gbc_compiled_byte_code :: CompiledByteCode
                                       , gbc_foreign_files :: [FilePath]  -- ^ Path to object files
+                                      , gbc_hash :: !Fingerprint
                                       }
 
 mkModuleByteCodeLinkable :: UTCTime -> ModuleByteCode -> Linkable
-mkModuleByteCodeLinkable linkable_time bco =
+mkModuleByteCodeLinkable linkable_time bco = do
   Linkable linkable_time (gbc_module bco) (pure (DotGBC bco))
 
+mkOnlyModuleByteCodeLinkable :: UTCTime -> ModuleByteCode -> LinkableWith ModuleByteCode
+mkOnlyModuleByteCodeLinkable linkable_time bco = do
+  Linkable linkable_time (gbc_module bco) bco
+
 instance Outputable ModuleByteCode where
-  ppr (ModuleByteCode mod _cbc _fos) = text "ModuleByteCode" <+> ppr mod
+  ppr (ModuleByteCode mod _cbc _fos _) = text "ModuleByteCode" <+> ppr mod
 
 instance Outputable LinkablePart where
   ppr (DotO path sort)   = text "DotO" <+> text path <+> pprSort sort
@@ -544,8 +561,8 @@ linkablePartObjectPaths = \case
 -- Contrary to linkableBCOs, this includes byte-code from LazyBCOs.
 linkablePartBCOs :: LinkablePart -> [CompiledByteCode]
 linkablePartBCOs = \case
-  DotGBC bco    -> [gbc_compiled_byte_code bco]
-  _           -> []
+  DotGBC bco -> [gbc_compiled_byte_code bco]
+  _          -> []
 
 linkableFilter :: (LinkablePart -> [LinkablePart]) -> Linkable -> Maybe Linkable
 linkableFilter f linkable = do
@@ -586,6 +603,59 @@ partitionLinkables linkables =
     mapMaybe linkableFilterByteCode linkables
   )
 
+-- | Turn a 'Linkable' into a 'LinkableUsage'.
+-- This stores much less information than 'Linkable' and allows us
+-- to free the fields of the 'Linkable'.
+--
+-- Each 'LinkablePartUsage' is fully evaluated to avoid retaining any reference
+-- to the original 'LinkablePart'.
+mkLinkableUsage :: Linkable -> LinkableUsage
+mkLinkableUsage lnk =
+  let
+    linkablesWithUsage = NE.map (go (linkableModule lnk)) (linkableParts lnk)
+    lnkUsage = lnk
+      { linkableParts =
+          -- We force the elements intentionally to whnf.
+          --
+          elemsToWhnf linkablesWithUsage `seq` linkablesWithUsage
+      }
+  in
+    linkableParts lnkUsage `seq` lnkUsage
+  where
+    -- Make sure 'LinkableUsagePart' is evaluated to whnf
+    elemsToWhnf :: NonEmpty a -> ()
+    elemsToWhnf = foldr seq ()
+
+
+    mkFileLinkablePartUsage m fp objs =
+      FileLinkablePartUsage
+        { flu_file = fp
+        , flu_module = m
+        , flu_linkable_objs =
+            FlatBag.fromList (strictGenericLength objs) [ OsPath.unsafeEncodeUtf obj | obj <- objs  ]
+        }
+
+    mkByteCodeLinkablePartUsage m fp objs =
+      ByteCodeLinkablePartUsage
+        { bclu_module = m
+        , bclu_hash = fp
+        , bclu_linkable_objs =
+            FlatBag.fromList (strictGenericLength objs) [ OsPath.unsafeEncodeUtf obj | obj <- objs  ]
+        }
+
+    go :: Module -> LinkablePart -> LinkablePartUsage
+    go m lnkPart = case lnkPart of
+      DotO fn _ -> mkFileLinkablePartUsage m fn (linkablePartObjectPaths lnkPart)
+      DotA fn -> mkFileLinkablePartUsage m fn (linkablePartObjectPaths lnkPart)
+      DotDLL fn -> mkFileLinkablePartUsage m fn (linkablePartObjectPaths lnkPart)
+      DotGBC mbc -> mkByteCodeLinkablePartUsage m (gbc_hash mbc) (linkablePartObjectPaths lnkPart)
+
+mkLinkablesUsage :: [Linkable] -> [LinkableUsage]
+mkLinkablesUsage linkables = map mkLinkableUsage linkables
+
+linkableUsageObjs :: LinkableUsage -> [FilePath]
+linkableUsageObjs lnkWithUsage = concatMap linkablePartUsageObjectPaths (linkableParts lnkWithUsage)
+
 {- **********************************************************************
 
                 Loading packages


=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -153,7 +153,7 @@ initializePlugins hsc_env
       ([]  , _ )  -> False -- some external plugin added
       (p:ps,s:ss) -> check_external_plugin p s && check_external_plugins ps ss
 
-loadPlugins :: HscEnv -> IO ([LoadedPlugin], [Linkable], PkgsLoaded)
+loadPlugins :: HscEnv -> IO ([LoadedPlugin], [LinkableUsage], PkgsLoaded)
 loadPlugins hsc_env
   = do { unless (null to_load) $
            checkExternalInterpreter hsc_env
@@ -173,7 +173,7 @@ loadPlugins hsc_env
     loadPlugin = loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName hsc_env
 
 
-loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded)
+loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [LinkableUsage], PkgsLoaded)
 loadFrontendPlugin hsc_env mod_name = do
     checkExternalInterpreter hsc_env
     (plugin, _iface, links, pkgs)
@@ -188,7 +188,7 @@ checkExternalInterpreter hsc_env = case interpInstance <$> hsc_interp hsc_env of
     -> throwIO (InstallationError "Plugins require -fno-external-interpreter")
   _ -> pure ()
 
-loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [Linkable], PkgsLoaded)
+loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [LinkableUsage], PkgsLoaded)
 loadPlugin' occ_name plugin_name hsc_env mod_name
   = do { let plugin_rdr_name = mkRdrQual mod_name occ_name
              dflags = hsc_dflags hsc_env
@@ -266,7 +266,7 @@ forceLoadTyCon hsc_env con_name = do
 -- * If the Name does not exist in the module
 -- * If the link failed
 
-getValueSafely :: HscEnv -> Name -> Type -> IO (Either Type (a, [Linkable], PkgsLoaded))
+getValueSafely :: HscEnv -> Name -> Type -> IO (Either Type (a, [LinkableUsage], PkgsLoaded))
 getValueSafely hsc_env val_name expected_type = do
   eith_hval <- case getValueSafelyHook hooks of
     Nothing -> getHValueSafely interp hsc_env val_name expected_type
@@ -281,7 +281,7 @@ getValueSafely hsc_env val_name expected_type = do
     logger = hsc_logger hsc_env
     hooks  = hsc_hooks hsc_env
 
-getHValueSafely :: Interp -> HscEnv -> Name -> Type -> IO (Either Type (HValue, [Linkable], PkgsLoaded))
+getHValueSafely :: Interp -> HscEnv -> Name -> Type -> IO (Either Type (HValue, [LinkableUsage], PkgsLoaded))
 getHValueSafely interp hsc_env val_name expected_type = do
     forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of getHValueSafely") val_name
     -- Now look up the names for the value and type constructor in the type environment


=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -562,7 +562,7 @@ data TcGblEnv
           -- is implicit rather than explicit, so we have to zap a
           -- mutable variable.
 
-        tcg_th_needed_deps :: TcRef ([Linkable], PkgsLoaded),
+        tcg_th_needed_deps :: TcRef ([LinkableUsage], PkgsLoaded),
           -- ^ The set of runtime dependencies required by this module
           -- See Note [Object File Dependencies]
 


=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -2259,7 +2259,7 @@ fillCoercionHole (CH { ch_ref = ref, ch_co_var = cv }) co
 recordThUse :: TcM ()
 recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True }
 
-recordThNeededRuntimeDeps :: [Linkable] -> PkgsLoaded -> TcM ()
+recordThNeededRuntimeDeps :: [LinkableUsage] -> PkgsLoaded -> TcM ()
 recordThNeededRuntimeDeps new_links new_pkgs
   = do { env <- getGblEnv
        ; updTcRef (tcg_th_needed_deps env) $ \(needed_links, needed_pkgs) ->


=====================================
compiler/GHC/Unit/Home/ModInfo.hs
=====================================
@@ -3,9 +3,11 @@
 module GHC.Unit.Home.ModInfo
    (
      HomeModInfo (..)
-   , HomeModLinkable (..)
    , homeModInfoObject
    , homeModInfoByteCode
+   , HomeModLinkable (..)
+   , homeModLinkableByteCode
+   , homeModLinkableObject
    , emptyHomeModInfoLinkable
    )
 where
@@ -15,9 +17,10 @@ import GHC.Prelude
 import GHC.Unit.Module.ModIface
 import GHC.Unit.Module.ModDetails
 
-import GHC.Linker.Types ( Linkable )
+import GHC.Linker.Types ( Linkable, LinkableWith, ModuleByteCode, LinkablePart (..) )
 
 import GHC.Utils.Outputable
+import qualified Data.List.NonEmpty as NE
 
 -- | Information about modules in the package being compiled
 data HomeModInfo = HomeModInfo
@@ -48,18 +51,24 @@ data HomeModInfo = HomeModInfo
    }
 
 homeModInfoByteCode :: HomeModInfo -> Maybe Linkable
-homeModInfoByteCode = homeMod_bytecode . hm_linkable
+homeModInfoByteCode = homeModLinkableByteCode . hm_linkable
 
 homeModInfoObject :: HomeModInfo -> Maybe Linkable
-homeModInfoObject = homeMod_object . hm_linkable
+homeModInfoObject = homeModLinkableObject . hm_linkable
 
 emptyHomeModInfoLinkable :: HomeModLinkable
 emptyHomeModInfoLinkable = HomeModLinkable Nothing Nothing
 
 -- See Note [Home module build products]
-data HomeModLinkable = HomeModLinkable { homeMod_bytecode :: !(Maybe Linkable)
+data HomeModLinkable = HomeModLinkable { homeMod_bytecode :: !(Maybe (LinkableWith ModuleByteCode))
                                        , homeMod_object   :: !(Maybe Linkable) }
 
+homeModLinkableByteCode :: HomeModLinkable -> Maybe Linkable
+homeModLinkableByteCode = fmap (fmap (NE.singleton . DotGBC)) . homeMod_bytecode
+
+homeModLinkableObject :: HomeModLinkable -> Maybe Linkable
+homeModLinkableObject = homeMod_object
+
 instance Outputable HomeModLinkable where
   ppr (HomeModLinkable l1 l2) = ppr l1 $$ ppr l2
 


=====================================
compiler/GHC/Unit/Module/Deps.hs
=====================================
@@ -22,16 +22,22 @@ module GHC.Unit.Module.Deps
    , ImportAvails (..)
    , IfaceImportLevel(..)
    , tcImportLevel
+   , LinkablePartUsage(..)
+   , linkablePartUsageObjectPaths
    )
 where
 
 import GHC.Prelude
 
 import GHC.Data.FastString
+import GHC.Data.FlatBag
+import GHC.Data.OsPath
+import qualified GHC.Data.OsPath as OsPath
 
 import GHC.Types.Avail
 import GHC.Types.SafeHaskell
 import GHC.Types.Name
+import GHC.Types.Name.Set
 import GHC.Types.Basic
 
 import GHC.Unit.Module.Imported
@@ -43,13 +49,12 @@ import GHC.Utils.Fingerprint
 import GHC.Utils.Binary
 import GHC.Utils.Outputable
 
+import Control.DeepSeq
+import Data.Bifunctor
+import qualified Data.Foldable as Foldable
 import Data.List (sortBy, sort, partition)
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Bifunctor
-import Control.DeepSeq
-import GHC.Types.Name.Set
-
 
 
 -- | Dependency information about ALL modules and packages below this one
@@ -372,12 +377,12 @@ data Usage
         -- we won't spot it here. If you do want to spot that, the caller
         -- should recursively add them to their useage.
   }
-  | UsageHomeModuleInterface {
+  | UsageHomeModuleBytecode {
         usg_mod_name :: ModuleName
         -- ^ Name of the module
         , usg_unit_id :: UnitId
         -- ^ UnitId of the HomeUnit the module is from
-        , usg_iface_hash :: Fingerprint
+        , usg_bytecode_hash :: Fingerprint
         -- ^ The *interface* hash of the module, not the ABI hash.
         -- This changes when anything about the interface (and hence the
         -- module) has changed.
@@ -412,7 +417,7 @@ instance NFData Usage where
   rnf (UsageFile file hash label) = rnf file `seq` rnf hash `seq` rnf label `seq` ()
   rnf (UsageDirectory dir hash label) = rnf dir `seq` rnf hash `seq` rnf label `seq` ()
   rnf (UsageMergedRequirement mod hash) = rnf mod `seq` rnf hash `seq` ()
-  rnf (UsageHomeModuleInterface mod uid hash) = rnf mod `seq` rnf uid `seq` rnf hash `seq` ()
+  rnf (UsageHomeModuleBytecode mod uid hash) = rnf mod `seq` rnf uid `seq` rnf hash `seq` ()
 
 instance Binary Usage where
     put_ bh usg@UsagePackageModule{} = do
@@ -441,11 +446,11 @@ instance Binary Usage where
         put_ bh (usg_mod      usg)
         put_ bh (usg_mod_hash usg)
 
-    put_ bh usg@UsageHomeModuleInterface{} = do
+    put_ bh usg@UsageHomeModuleBytecode{} = do
         putByte bh 4
         put_ bh (usg_mod_name usg)
         put_ bh (usg_unit_id  usg)
-        put_ bh (usg_iface_hash usg)
+        put_ bh (usg_bytecode_hash usg)
 
     put_ bh usg@UsageDirectory{} = do
         putByte bh 5
@@ -483,7 +488,7 @@ instance Binary Usage where
             mod <- get bh
             uid <- get bh
             hash <- get bh
-            return UsageHomeModuleInterface { usg_mod_name = mod, usg_unit_id = uid, usg_iface_hash = hash }
+            return UsageHomeModuleBytecode { usg_mod_name = mod, usg_unit_id = uid, usg_bytecode_hash = hash }
           5 -> do
             dp    <- get bh
             hash  <- get bh
@@ -695,3 +700,33 @@ data ImportAvails
           -- ^ Family instance modules below us in the import tree (and maybe
           -- including us for imported modules)
       }
+
+-- | Record usage of a 'LinkablePart'.
+data LinkablePartUsage
+  = FileLinkablePartUsage
+    { flu_file :: !FilePath
+    , flu_module :: !Module
+    , flu_linkable_objs :: !(FlatBag OsPath)
+    }
+  | ByteCodeLinkablePartUsage
+    { bclu_module :: !Module
+    , bclu_hash :: !Fingerprint
+    , bclu_linkable_objs :: !(FlatBag OsPath)
+    }
+
+instance Outputable LinkablePartUsage where
+  ppr = \ case
+    FileLinkablePartUsage fp modl _objs ->
+      text "FileLinkableUsage" <+> text fp <+> ppr modl
+
+    ByteCodeLinkablePartUsage modl hash _objs ->
+      text "ByteCodeLinkableUsage" <+> ppr modl <+> ppr hash
+
+linkablePartUsageObjectPaths :: LinkablePartUsage -> [FilePath]
+linkablePartUsageObjectPaths lnkUsage =
+  map OsPath.unsafeDecodeUtf . Foldable.toList $ linkableUsageObjectOsPaths lnkUsage
+
+linkableUsageObjectOsPaths :: LinkablePartUsage -> FlatBag OsPath
+linkableUsageObjectOsPaths lnkUsage = case lnkUsage of
+  FileLinkablePartUsage{flu_linkable_objs} -> flu_linkable_objs
+  ByteCodeLinkablePartUsage{bclu_linkable_objs} -> bclu_linkable_objs


=====================================
compiler/GHC/Unit/Module/Status.hs
=====================================
@@ -18,11 +18,12 @@ import GHC.Unit.Home.ModInfo
 import GHC.Unit.Module.ModGuts
 import GHC.Unit.Module.ModIface
 
-import GHC.Linker.Types ( Linkable, WholeCoreBindingsLinkable, linkableIsNativeCodeOnly )
+import GHC.Linker.Types ( Linkable, WholeCoreBindingsLinkable, linkableIsNativeCodeOnly, ModuleByteCode, LinkableWith, linkableModuleByteCodes )
 
 import GHC.Utils.Fingerprint
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Stack.Types (HasCallStack)
 
 -- | Status of a module in incremental compilation
 data HscRecompStatus
@@ -59,7 +60,7 @@ data RecompLinkables = RecompLinkables { recompLinkables_bytecode :: !RecompByte
                                        , recompLinkables_object   :: !(Maybe Linkable) }
 
 data RecompBytecodeLinkable
-  = NormalLinkable !(Maybe Linkable)
+  = NormalLinkable !(Maybe (LinkableWith ModuleByteCode))
   | WholeCoreBindingsLinkable !WholeCoreBindingsLinkable
 
 instance Outputable HscRecompStatus where
@@ -86,8 +87,11 @@ safeCastHomeModLinkable (HomeModLinkable bc o) = RecompLinkables (NormalLinkable
 justBytecode :: Either Linkable WholeCoreBindingsLinkable -> RecompLinkables
 justBytecode = \case
   Left lm ->
+    let
+      mbc = expectSingletonGbcLinkable lm
+    in
     assertPpr (not (linkableIsNativeCodeOnly lm)) (ppr lm)
-      $ emptyRecompLinkables { recompLinkables_bytecode = NormalLinkable (Just lm) }
+      $ emptyRecompLinkables { recompLinkables_bytecode = NormalLinkable (Just mbc) }
   Right lm -> emptyRecompLinkables { recompLinkables_bytecode = WholeCoreBindingsLinkable lm }
 
 justObjects :: Linkable -> RecompLinkables
@@ -98,8 +102,17 @@ justObjects lm =
 bytecodeAndObjects :: Either Linkable WholeCoreBindingsLinkable -> Linkable -> RecompLinkables
 bytecodeAndObjects either_bc o = case either_bc of
   Left bc ->
-    assertPpr (not (linkableIsNativeCodeOnly bc) && linkableIsNativeCodeOnly o) (ppr bc $$ ppr o)
-      $ RecompLinkables (NormalLinkable (Just bc)) (Just o)
+    let
+      mbc = expectSingletonGbcLinkable bc
+    in
+      assertPpr (not (linkableIsNativeCodeOnly bc) && linkableIsNativeCodeOnly o) (ppr bc $$ ppr o)
+        $ RecompLinkables (NormalLinkable (Just mbc)) (Just o)
   Right bc ->
     assertPpr (linkableIsNativeCodeOnly o) (ppr o)
       $ RecompLinkables (WholeCoreBindingsLinkable bc) (Just o)
+
+expectSingletonGbcLinkable :: HasCallStack => Linkable -> LinkableWith ModuleByteCode
+expectSingletonGbcLinkable lm = case linkableModuleByteCodes lm of
+  [] -> pprPanic "Expected 1 ModuleByteCode in Linkable" (ppr lm)
+  [mbc] -> mbc <$ lm
+  _ -> pprPanic "Expected 1 in Linkable" (ppr lm)


=====================================
compiler/ghc.cabal.in
=====================================
@@ -210,10 +210,12 @@ Library
         GHC.Builtin.Uniques
         GHC.Builtin.Utils
         GHC.ByteCode.Asm
+        GHC.ByteCode.Binary
         GHC.ByteCode.Breakpoints
         GHC.ByteCode.InfoTable
         GHC.ByteCode.Instr
         GHC.ByteCode.Linker
+        GHC.ByteCode.Recomp.Binary
         GHC.ByteCode.Serialize
         GHC.ByteCode.Types
         GHC.Cmm


=====================================
ghc/GHCi/Leak.hs
=====================================
@@ -52,8 +52,11 @@ getLeakIndicators hsc_env =
       return $ LeakModIndicators{..}
   where
     mkWeakLinkables :: HomeModLinkable -> IO [Maybe (Weak Linkable)]
-    mkWeakLinkables (HomeModLinkable mbc mo) =
-      mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln) [mbc, mo]
+    mkWeakLinkables hml =
+      mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln)
+        [ homeModLinkableByteCode hml
+        , homeModLinkableObject hml
+        ]
 
 -- | Look at the LeakIndicators collected by an earlier call to
 -- `getLeakIndicators`, and print messasges if any of them are still


=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -60,6 +60,7 @@ GHC.Data.FastMutInt
 GHC.Data.FastString
 GHC.Data.FastString.Env
 GHC.Data.FiniteMap
+GHC.Data.FlatBag
 GHC.Data.Graph.Directed
 GHC.Data.Graph.Directed.Internal
 GHC.Data.Graph.UnVar


=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -61,6 +61,7 @@ GHC.Data.FastMutInt
 GHC.Data.FastString
 GHC.Data.FastString.Env
 GHC.Data.FiniteMap
+GHC.Data.FlatBag
 GHC.Data.Graph.Directed
 GHC.Data.Graph.Directed.Internal
 GHC.Data.Graph.Directed.Reachability


=====================================
testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
=====================================
@@ -3,6 +3,6 @@ GHCi, version 9.15.20260122: https://www.haskell.org/ghc/  :? for help
 [2 of 2] Compiling RecompTH         ( RecompTH.hs, interpreted )[recomp]
 Ok, two modules loaded.
 ghci> ghci> ghci> [1 of 2] Compiling Dep              ( Dep.hs, interpreted )[dep] [Source file changed]
-[2 of 2] Compiling RecompTH         ( RecompTH.hs, interpreted )[recomp] [Dep changed (interface)]
+[2 of 2] Compiling RecompTH         ( RecompTH.hs, interpreted )[recomp] [Dep changed (bytecode)]
 Ok, two modules reloaded.
 ghci> Leaving GHCi.



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31a3cbc3cf14831f506f1e52933e596d...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31a3cbc3cf14831f506f1e52933e596d...
You're receiving this email because of your account on gitlab.haskell.org.

    

Hannes Siebenhandl (＠fendor)

tags

participants (1)