GitLab

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

 +{-# 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

 +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.
 . The existence of the .gbc file for the module you are currently compiling.
 . 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 }
 -> 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.