[Git][ghc/ghc][wip/fendor/linkable-usage] Record `LinkableUsage` instead of `Linkable` in `LoaderState`
by Hannes Siebenhandl (＠fendor) 16 Mar '26
by Hannes Siebenhandl (＠fendor) 16 Mar '26
16 Mar '26
Hannes Siebenhandl pushed to branch wip/fendor/linkable-usage at Glasgow Haskell Compiler / GHC
Commits:
5e882bb0 by fendor at 2026-03-16T15:21:35+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 DotGBC in Linkable" (ppr lm)
+ [mbc] -> mbc <$ lm
+ _ -> pprPanic "Expected 1 DotGBC 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/5e882bb069388d3b6525bddf5d5d269…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e882bb069388d3b6525bddf5d5d269…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/bump-submodules-2603] 5 commits: Configure: Fix check for --target support in stage0 CC
by Cheng Shao (＠TerrorJack) 16 Mar '26
by Cheng Shao (＠TerrorJack) 16 Mar '26
16 Mar '26
Cheng Shao pushed to branch wip/bump-submodules-2603 at Glasgow Haskell Compiler / GHC
Commits:
43638643 by Andreas Klebinger at 2026-03-15T18:15:48-04:00
Configure: Fix check for --target support in stage0 CC
The check FP_PROG_CC_LINKER_TARGET used $CC unconditionally to check for
--target support. However this fails for the stage0 config where the C
compiler used is not $CC but $CC_STAGE0.
Since we already pass the compiler under test into the macro I simply
changed it to use that instead.
Fixes #26999
- - - - -
18fd0df6 by Simon Hengel at 2026-03-15T18:16:33-04:00
Fix typo in recursive_do.rst
- - - - -
ab10d72d by Cheng Shao at 2026-03-16T14:06:11+00:00
hadrian: add thLift/thQuasiquoter to toolTargets
This commit adds missing `thLift`/`thQuasiquoter` to hadrian
`toolTargets` to keep in sync with `stage0packages`. This is now
required when os-string/filepath is updated to include them as
dependencies.
- - - - -
e1cd5fad by Cheng Shao at 2026-03-16T14:06:11+00:00
libraries: bump os-string submodule to 2.0.10
- - - - -
ff440778 by Cheng Shao at 2026-03-16T14:06:11+00:00
libraries: bump filepath submodule to 1.5.5.0
- - - - -
5 changed files:
- docs/users_guide/exts/recursive_do.rst
- hadrian/src/Rules/ToolArgs.hs
- libraries/filepath
- libraries/os-string
- m4/fp_prog_cc_linker_target.m4
Changes:
=====================================
docs/users_guide/exts/recursive_do.rst
=====================================
@@ -56,7 +56,7 @@ or equivalently
As you can guess ``justOnes`` will evaluate to ``Just [-1,-1,-1,...``.
-GHC's implementation the mdo-notation closely follows the original
+GHC's implementation of the mdo-notation closely follows the original
translation as described in the paper `A recursive do for
Haskell <https://leventerkok.github.io/papers/recdo.pdf>`__, which
in turn is based on the work `Value Recursion in Monadic
=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -153,6 +153,9 @@ toolTargets = [ cabalSyntax
, filepath
, fileio
, osString
+ -- os-string/filepath now depend on them
+ , thLift
+ , thQuasiquoter
-- , ghc -- # depends on ghc library
-- , runGhc -- # depends on ghc library
, ghcBoot
@@ -200,4 +203,3 @@ dirMap = do
cd <- readContextData c
ids <- liftIO $ mapM canonicalizePath [pkgPath p </> i | i <- srcDirs cd]
return $ map (,(p, modules cd ++ otherModules cd)) ids
-
=====================================
libraries/filepath
=====================================
@@ -1 +1 @@
-Subproject commit cbcd0ccf92f47e6c10fb9cc513a7b26facfc19fe
+Subproject commit baac7d7e76449f76fc6785e77206edb5530b6bfb
=====================================
libraries/os-string
=====================================
@@ -1 +1 @@
-Subproject commit c08666bf7bf528e607fc1eacc20032ec59e69df3
+Subproject commit 71f66e1af2288867becaa567dfb10c1d791b0343
=====================================
m4/fp_prog_cc_linker_target.m4
=====================================
@@ -8,7 +8,7 @@
# a linker
AC_DEFUN([FP_PROG_CC_LINKER_TARGET],
[
- AC_MSG_CHECKING([whether $CC used as a linker understands --target])
+ AC_MSG_CHECKING([whether $1 used as a linker understands --target])
echo 'int foo() { return 0; }' > conftest1.c
echo 'int main() { return 0; }' > conftest2.c
@@ -20,7 +20,7 @@ AC_DEFUN([FP_PROG_CC_LINKER_TARGET],
# See Note [Don't pass --target to emscripten toolchain] in GHC.Toolchain.Program
CONF_CC_SUPPORTS_TARGET=NO
AC_MSG_RESULT([no])
- elif "$CC" $$3 --target=$LlvmTarget -o conftest conftest1.o conftest2.o;
+ elif "$1" $$3 --target=$LlvmTarget -o conftest conftest1.o conftest2.o;
then
$3="--target=$LlvmTarget $$3"
AC_MSG_RESULT([yes])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b6ace16cff80e9b548519ee658bdb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b6ace16cff80e9b548519ee658bdb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/linkable-usage] Record `LinkableUsage` instead of `Linkable` in `LoaderState`
by Hannes Siebenhandl (＠fendor) 16 Mar '26
by Hannes Siebenhandl (＠fendor) 16 Mar '26
16 Mar '26
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/31a3cbc3cf14831f506f1e52933e596…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31a3cbc3cf14831f506f1e52933e596…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T26989 at Glasgow Haskell Compiler / GHC
Commits:
45fcde34 by Simon Peyton Jones at 2026-03-16T13:27:08+00:00
Improve knownCon
Eliminate simplInVar
Just a refactoring to simplify the code
- - - - -
1 changed file:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -2265,19 +2265,6 @@ Some programs have a /lot/ of data constructors in the source program
valuable.
-}
-simplInVar :: SimplEnv -> InVar -> SimplM OutExpr
--- Look up an InVar in the environment
-simplInVar env var
- -- Why $! ? See Note [Bangs in the Simplifier]
- | isTyVar var = return $! Type $! (substTyVar env var)
- | isCoVar var = return $! Coercion $! (substCoVar env var)
- | otherwise
- = case substId env var of
- ContEx tvs cvs ids e -> let env' = setSubstEnv env tvs cvs ids
- in simplExpr env' e
- DoneId var1 -> return (Var var1)
- DoneEx e _ -> return e
-
simplInId :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr)
simplInId env var cont
| Just dc <- isDataConWorkId_maybe var
@@ -2644,7 +2631,7 @@ See Note [No free join points in arityType] in GHC.Core.Opt.Arity
tryRules :: Bool -- True <=> args are already simplified
-> SimplEnv -> [CoreRule]
- -> OutId -> [CoreExpr]
+ -> OutId -> [OutExpr]
-> SimplM (Maybe (FullArgCount, CoreExpr))
tryRules args_are_simplified env rules fn args
@@ -3070,25 +3057,6 @@ may be a result of 'seq' so we *definitely* don't want to drop those.
I don't really know how to improve this situation.
-Note [FloatBinds from constructor wrappers]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If we have FloatBinds coming from the constructor wrapper
-(as in Note [exprIsConApp_maybe on data constructors with wrappers]),
-we cannot float past them. We'd need to float the FloatBind
-together with the simplify floats, unfortunately the
-simplifier doesn't have case-floats. The simplest thing we can
-do is to wrap all the floats here. The next iteration of the
-simplifier will take care of all these cases and lets.
-
-Given data T = MkT !Bool, this allows us to simplify
-case $WMkT b of { MkT x -> f x }
-to
-case b of { b' -> f b' }.
-
-We could try and be more clever (like maybe wfloats only contain
-let binders, so we could float them). But the need for the
-extra complication is not clear.
-
Note [Do not duplicate constructor applications]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this (#20125)
@@ -3133,7 +3101,7 @@ rebuildCase env scrut case_bndr alts cont
= do { tick (KnownBranch case_bndr)
; case findAlt (LitAlt lit) alts of
Nothing -> missingAlt env case_bndr alts cont
- Just (Alt _ bs rhs) -> simple_rhs env [] scrut bs rhs }
+ Just (Alt _ bs rhs) -> simple_rhs env scrut bs rhs }
| Just (in_scope', wfloats, con, ty_args, other_args)
<- exprIsConApp_maybe (getUnfoldingInRuleMatch env) scrut
@@ -3141,58 +3109,26 @@ rebuildCase env scrut case_bndr alts cont
-- as well as when it's an explicit constructor application
, let env0 = setInScopeSet env in_scope'
= do { tick (KnownBranch case_bndr)
- ; let scaled_wfloats = map scale_float wfloats
- -- case_bndr_unf: see Note [Do not duplicate constructor applications]
+ ; let -- case_bndr_unf: see Note [Do not duplicate constructor applications]
case_bndr_rhs | exprIsTrivial scrut = scrut
| otherwise = con_app
con_app = Var (dataConWorkId con) `mkTyApps` ty_args
`mkApps` other_args
- ; case findAlt (DataAlt con) alts of
+ ; wrapDataConFloats env wfloats case_bndr cont $
+ case findAlt (DataAlt con) alts of
Nothing -> missingAlt env0 case_bndr alts cont
- Just (Alt DEFAULT bs rhs) -> simple_rhs env0 scaled_wfloats case_bndr_rhs bs rhs
- Just (Alt _ bs rhs) -> knownCon env0 scrut scaled_wfloats con ty_args
+ Just (Alt DEFAULT bs rhs) -> simple_rhs env0 case_bndr_rhs bs rhs
+ Just (Alt _ bs rhs) -> knownCon env0 scrut con
other_args case_bndr bs rhs cont
}
where
- simple_rhs env wfloats case_bndr_rhs bs rhs =
+ simple_rhs env case_bndr_rhs bs rhs =
assert (null bs) $
do { (floats1, env') <- simplAuxBind "rebuildCase" env case_bndr case_bndr_rhs
-- scrut is a constructor application,
-- hence satisfies let-can-float invariant
; (floats2, expr') <- simplExprF env' rhs cont
- ; case wfloats of
- [] -> return (floats1 `addFloats` floats2, expr')
- _ -> return
- -- See Note [FloatBinds from constructor wrappers]
- ( emptyFloats env,
- GHC.Core.Make.wrapFloats wfloats $
- wrapFloats (floats1 `addFloats` floats2) expr' )}
-
- -- This scales case floats by the multiplicity of the continuation hole (see
- -- Note [Scaling in case-of-case]). Let floats are _not_ scaled, because
- -- they are aliases anyway.
- scale_float (GHC.Core.Make.FloatCase scrut case_bndr con vars) =
- let
- scale_id id = scaleVarBy holeScaling id
- in
- GHC.Core.Make.FloatCase scrut (scale_id case_bndr) con (map scale_id vars)
- scale_float f = f
-
- holeScaling = contHoleScaling cont `mkMultMul` idMult case_bndr
- -- We are in the following situation
- -- case[p] case[q] u of { D x -> C v } of { C x -> w }
- -- And we are producing case[??] u of { D x -> w[x\v]}
- --
- -- What should the multiplicity `??` be? In order to preserve the usage of
- -- variables in `u`, it needs to be `pq`.
- --
- -- As an illustration, consider the following
- -- case[Many] case[1] of { C x -> C x } of { C x -> (x, x) }
- -- Where C :: A %1 -> T is linear
- -- If we were to produce a case[1], like the inner case, we would get
- -- case[1] of { C x -> (x, x) }
- -- Which is ill-typed with respect to linearity. So it needs to be a
- -- case[Many].
+ ; return (floats1 `addFloats` floats2, expr') }
--------------------------------------------------
-- 2. Eliminate the case if scrutinee is evaluated
@@ -3740,29 +3676,81 @@ and then
f (h v)
All this should happen in one sweep.
+
+Note [FloatBinds from constructor wrappers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we have FloatBinds coming from the constructor wrapper
+(as in Note [exprIsConApp_maybe on data constructors with wrappers]),
+we cannot float past them. We'd need to float the FloatBind
+together with the simplify floats, unfortunately the
+simplifier doesn't have case-floats. The simplest thing we can
+do is to wrap all the floats here. The next iteration of the
+simplifier will take care of all these cases and lets.
+
+Given data T = MkT !Bool, this allows us to simplify
+case $WMkT b of { MkT x -> f x }
+to
+case b of { b' -> f b' }.
+
+We could try and be more clever (like maybe wfloats only contain
+let binders, so we could float them). But the need for the
+extra complication is not clear.
-}
+wrapDataConFloats :: SimplEnv -> [FloatBind] -> InId -> SimplCont
+ -> SimplM (SimplFloats, OutExpr)
+ -> SimplM (SimplFloats, OutExpr)
+-- See Note [FloatBinds from constructor wrappers]
+wrapDataConFloats env wfloats case_bndr cont thing_inside
+ | null wfloats
+ = thing_inside
+ | otherwise
+ = do { (floats, expr) <- thing_inside
+ ; return ( emptyFloats env
+ , GHC.Core.Make.wrapFloats (map scale_float wfloats) $
+ wrapFloats floats expr ) }
+ where
+ -- scale_float scales case-floats by the multiplicity of the continuation hole
+ -- (see Note [Scaling in case-of-case]).
+ -- Let floats are _not_ scaled, because they are aliases anyway.
+ scale_float (GHC.Core.Make.FloatCase scrut case_bndr con vars)
+ = GHC.Core.Make.FloatCase scrut (scale_id case_bndr) con (map scale_id vars)
+ scale_float flt(a)(GHC.Core.Make.FloatLet {})
+ = flt
+
+ scale_id id = scaleVarBy holeScaling id
+
+ holeScaling = contHoleScaling cont `mkMultMul` idMult case_bndr
+ -- We are in the following situation
+ -- case[p] case[q] u of { D x -> C v } of { C x -> w }
+ -- And we are producing case[??] u of { D x -> w[x\v]}
+ --
+ -- What should the multiplicity `??` be? In order to preserve the usage of
+ -- variables in `u`, it needs to be `pq`.
+ --
+ -- As an illustration, consider the following
+ -- case[Many] case[1] of { C x -> C x } of { C x -> (x, x) }
+ -- Where C :: A %1 -> T is linear
+ -- If we were to produce a case[1], like the inner case, we would get
+ -- case[1] of { C x -> (x, x) }
+ -- Which is ill-typed with respect to linearity. So it needs to be a
+ -- case[Many].
+
+
knownCon :: SimplEnv
- -> OutExpr -- The scrutinee
- -> [FloatBind] -> DataCon -> [OutType] -> [OutExpr] -- The scrutinee (in pieces)
- -> InId -> [InBndr] -> InExpr -- The alternative
+ -> OutExpr -- The scrutinee
+ -> DataCon -> [OutExpr] -- The scrutinee (in pieces)
+ -> InId -> [InBndr] -> InExpr -- The alternative
-> SimplCont
-> SimplM (SimplFloats, OutExpr)
-knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont
- = do { (floats1, env1) <- bind_args env bs dc_args
+knownCon env scrut dc dc_args case_bndr alt_bndrs rhs cont
+ = do { (floats1, env1) <- bind_args env alt_bndrs dc_args
; (floats2, env2) <- bind_case_bndr env1
; (floats3, expr') <- simplExprF env2 rhs cont
- ; case dc_floats of
- [] ->
- return (floats1 `addFloats` floats2 `addFloats` floats3, expr')
- _ ->
- return ( emptyFloats env
- -- See Note [FloatBinds from constructor wrappers]
- , GHC.Core.Make.wrapFloats dc_floats $
- wrapFloats (floats1 `addFloats` floats2 `addFloats` floats3) expr') }
+ ; return (floats1 `addFloats` floats2 `addFloats` floats3, expr') }
where
- zap_occ = zapBndrOccInfo (isDeadBinder bndr) -- bndr is an InId
+ zap_occ = zapBndrOccInfo (isDeadBinder case_bndr) -- case_bndr is an InId
-- Ugh!
bind_args env' [] _ = return (emptyFloats env', env')
@@ -3787,28 +3775,32 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont
; return (floats1 `addFloats` floats2, env3) }
bind_args _ _ _ =
- pprPanic "bind_args" $ ppr dc $$ ppr bs $$ ppr dc_args $$
+ pprPanic "bind_args" $ ppr dc $$ ppr alt_bndrs $$ ppr dc_args $$
text "scrut:" <+> ppr scrut
- -- It's useful to bind bndr to scrut, rather than to a fresh
+ -- It's useful to bind case_bndr to scrut, rather than to a fresh
-- binding x = Con arg1 .. argn
-- because very often the scrut is a variable, so we avoid
-- creating, and then subsequently eliminating, a let-binding
-- BUT, if scrut is a not a variable, we must be careful
-- about duplicating the arg redexes; in that case, make
-- a new con-app from the args
+ con_app :: InExpr
+ con_app = mkConApp2 dc (tyConAppArgs (idType case_bndr)) alt_bndrs
+
bind_case_bndr env
- | isDeadBinder bndr = return (emptyFloats env, env)
- | exprIsTrivial scrut = return (emptyFloats env
- , extendIdSubst env bndr (DoneEx scrut NotJoinPoint))
- -- See Note [Do not duplicate constructor applications]
- | otherwise = do { dc_args <- mapM (simplInVar env) bs
- -- dc_ty_args are already OutTypes,
- -- but bs are InBndrs
- ; let con_app = Var (dataConWorkId dc)
- `mkTyApps` dc_ty_args
- `mkApps` dc_args
- ; simplAuxBind "case-bndr" env bndr con_app }
+ | exprIsTrivial scrut
+ = -- See Note [Do not duplicate constructor applications]
+ return ( emptyFloats env
+ , extendIdSubst env case_bndr (DoneEx scrut NotJoinPoint))
+
+ | Just env' <- preInlineUnconditionally env NotTopLevel case_bndr con_app env
+ = return (emptyFloats env', env')
+
+ | otherwise
+ = do { (env1, case_bndr1) <- simplNonRecBndr env case_bndr
+ ; simplLazyBind NotTopLevel NonRecursive
+ (case_bndr,env) (case_bndr1,env1) (con_app,env) }
-------------------
missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45fcde34e41e178082d41705ff7971b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45fcde34e41e178082d41705ff7971b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/VeryMilkyJoe/no-mod-loc-pat] 89 commits: wasm: add /assets endpoint to serve user-specified assets
by Jana Chadt (＠VeryMilkyJoe) 16 Mar '26
by Jana Chadt (＠VeryMilkyJoe) 16 Mar '26
16 Mar '26
Jana Chadt pushed to branch wip/VeryMilkyJoe/no-mod-loc-pat at Glasgow Haskell Compiler / GHC
Commits:
c951fef1 by Cheng Shao at 2026-02-25T20:58:28+00:00
wasm: add /assets endpoint to serve user-specified assets
This patch adds an `/assets` endpoint to the wasm dyld http server, so
that users can also fetch assets from the same host with sensible
default MIME types, without needing a separate http server for assets
that also introduces CORS headaches:
- A `-fghci-browser-assets-dir` driver flag is added to specify the
assets root directory (defaults to `$PWD`)
- The dyld http server fetches `mime-db` on demand and uses it as
source of truth for mime types.
Closes #26951.
- - - - -
dde22f97 by Sylvain Henry at 2026-02-26T13:14:03-05:00
Fix -fcheck-prim-bounds for non constant args (#26958)
Previously we were only checking bounds for constant (literal)
arguments!
I've refactored the code to simplify the generation of out-of-line Cmm
code for the primop composed of some inline code + some call to an
external Cmm function.
- - - - -
bd3eba86 by Vladislav Zavialov at 2026-02-27T05:48:01-05:00
Check for negative type literals in the type checker (#26861)
GHC disallows negative type literals (e.g., -1), as tested by T8306 and
T8412. This check is currently performed in the renamer:
rnHsTyLit tyLit@(HsNumTy x i) = do
when (i < 0) $
addErr $ TcRnNegativeNumTypeLiteral tyLit
However, this check can be bypassed using RequiredTypeArguments
(see the new test case T26861). Prior to this patch, such programs
caused the compiler to hang instead of reporting a proper error.
This patch addresses the issue by adding an equivalent check in
the type checker, namely in tcHsType.
The diff is deliberately minimal to facilitate backporting. A more
comprehensive rework of HsTyLit is planned for a separate commit.
- - - - -
faf14e0c by Vladislav Zavialov at 2026-02-27T05:48:45-05:00
Consistent pretty-printing of HsString, HsIsString, HsStrTy
Factor out a helper to pretty-print string literals, thus fixing newline
handling for overloaded string literals and type literals.
Test cases: T26860ppr T26860ppr_overloaded T26860ppr_tylit
Follow up to ddf1434ff9bb08cfef3c93f23de6b83ec698aa27
- - - - -
f108a972 by Arnaud Spiwack at 2026-02-27T12:53:01-05:00
Make list comprehension completely non-linear
Fixes #25081
From the note:
The usefulness of list comprehension in conjunction with linear types is dubious.
After all, statements are made to be run many times, for instance in
```haskell
[u | y <- [0,1], stmts]
```
both `u` and `stmts` are going to be run several times.
In principle, though, there are some position in a monad comprehension
expression which could be considered linear. We could try and make it so that
these positions are considered linear by the typechecker, but in practice the
desugarer doesn't take enough care to ensure that these are indeed desugared to
linear sites. We tried in the past, and it turned out that we'd miss a
desugaring corner case (#25772).
Until there's a demand for this very specific improvement, let's instead be
conservative, and consider list comprehension to be completely non-linear.
- - - - -
ae799cab by Simon Jakobi at 2026-02-27T12:53:54-05:00
PmAltConSet: Use Data.Set instead of Data.Map
...to store `PmLit`s.
The Map was only used to map keys to themselves.
Changing the Map to a Set saves a Word of memory per entry.
Resolves #26756.
- - - - -
dcd7819c by Vladislav Zavialov at 2026-02-27T18:46:03-05:00
Drop HsTyLit in favor of HsLit (#26862, #25121)
This patch is a small step towards unification of HsExpr and HsType,
taking care of literals (HsLit) and type literals (HsTyLit).
Additionally, it improves error messages for unsupported type literals,
such as unboxed or fractional literals (test cases: T26862, T26862_th).
Changes to the AST:
* Use HsLit where HsTyLit was previously used
* Use HsChar where HsCharTy was previously used
* Use HsString where HsStrTy was previously used
* Use HsNatural (NEW) where HsNumTy was previously used
* Use HsDouble (NEW) to represent unsupported fractional type literals
Changes to logic:
* Parse unboxed and fractional type literals (to be rejected later)
* Drop the check for negative literals in the renamer (rnHsTyLit)
in favor of checking in the type checker (tc_hs_lit_ty)
* Check for invalid type literals in TH (repTyLit) and report
unrepresentable literals with ThUnsupportedTyLit
* Allow negative type literals in TH (numTyLit). This is fine as
these will be taken care of at splice time (test case: T8306_th)
- - - - -
c927954f by Vladislav Zavialov at 2026-02-27T18:46:50-05:00
Increase test coverage of diagnostics
Add test cases for the previously untested diagnostics:
[GHC-01239] PsErrIfInFunAppExpr
[GHC-04807] PsErrProcInFunAppExpr
[GHC-08195] PsErrInvalidRecordCon
[GHC-16863] PsErrUnsupportedBoxedSumPat
[GHC-18910] PsErrSemiColonsInCondCmd
[GHC-24737] PsErrInvalidWhereBindInPatSynDecl
[GHC-25037] PsErrCaseInFunAppExpr
[GHC-25078] PsErrPrecedenceOutOfRange
[GHC-28021] PsErrRecordSyntaxInPatSynDecl
[GHC-35827] TcRnNonOverloadedSpecialisePragma
[GHC-40845] PsErrUnpackDataCon
[GHC-45106] PsErrInvalidInfixHole
[GHC-50396] PsErrInvalidRuleActivationMarker
[GHC-63930] MultiWayIfWithoutAlts
[GHC-65536] PsErrNoSingleWhereBindInPatSynDecl
[GHC-67630] PsErrMDoInFunAppExpr
[GHC-70526] PsErrLetCmdInFunAppCmd
[GHC-77808] PsErrDoCmdInFunAppCmd
[GHC-86934] ClassPE
[GHC-90355] PsErrLetInFunAppExpr
[GHC-91745] CasesExprWithoutAlts
[GHC-92971] PsErrCaseCmdInFunAppCmd
[GHC-95644] PsErrBangPatWithoutSpace
[GHC-97005] PsErrIfCmdInFunAppCmd
Remove unused error constructors:
[GHC-44524] PsErrExpectedHyphen
[GHC-91382] TcRnIllegalKindSignature
- - - - -
3a9470fd by Torsten Schmits at 2026-02-27T18:47:34-05:00
Avoid expensive computation for debug logging in `mergeDatabases` when log level is low
This computed and traversed a set intersection for every single
dependency unconditionally.
- - - - -
ea4c2cbd by Brandon Chinn at 2026-02-27T16:22:38-08:00
Implement QualifiedStrings (#26503)
See Note [Implementation of QualifiedStrings]
- - - - -
08bc245b by sheaf at 2026-03-01T11:11:54-05:00
Clean up join points, casts & ticks
This commit shores up the logic dealing with casts and ticks occurring
in between a join point binding and a jump.
Fixes #26642 #26929 #26693
Makes progress on #14610 #26157 #26422
Changes:
- Remove 'GHC.Types.Tickish.TickishScoping' in favour of simpler
predicates 'tickishHasNoScope'/'tickishHasSoftScope', as things were
before commit 993975d3. This makes the code easier to read and
document (fewer indirections).
- Introduce 'canCollectArgsThroughTick' for consistent handling of
ticks around PrimOps and other 'Id's that cannot be eta-reduced.
See overhauled Note [Ticks and mandatory eta expansion].
- New Note [JoinId vs TailCallInfo] in GHC.Core.SimpleOpt that explains
robustness of JoinId vs fragility of TailCallInfo.
- Allow casts/non-soft-scoped ticks to occur in between a join point
binder and a jump, but only in Core Prep.
See Note [Join points, casts, and ticks] and
Note [Join points, casts, and ticks... in Core Prep]
in GHC.Core.Opt.Simplify.Iteration.
Also update Core Lint to account for this.
See Note [Linting join points with casts or ticks] in GHC.Core.Lint.
- Update 'GHC.Core.Utils.mergeCaseAlts' to avoid pushing a cast in
between a join point binding and its jumps. This fixes #26642.
See the new (MC5) and (MC6) in Note [Merge Nested Cases].
- Update float out to properly handle source note ticks. They are now
properly floated out instead of being discarded.
This increases the number of ticks in certain tests with -g.
Test cases: T26642 and TrickyJoins.
Metric increase due to more source note ticks with -g:
-------------------------
Metric Increase:
libdir
size_hello_artifact
size_hello_unicode
-------------------------
- - - - -
476c4cdf by Sean D. Gillespie at 2026-03-02T10:14:37-05:00
Add SIMD absolute value on x86 and LLVM
On x86, absolute value of 32 bits or less is implemented with
PABSB/PABSW/PABSD if SSSE3 is available. Otherwise, there is a fallback
for SSE2. For 64 bit integers it uses VPABSQ, required by AVX-512VL,
with fallbacks for SSE4.2 and SSE2.
There is no dedicated instruction for floating point absolute value on
x86, so it is simulated using bitwise AND.
Absolute value for signed integers and floats are implemented by the
"llvm.abs/llvm.fabs" standard library intrinsics. This implementation
uses MachOps constructors, unlike non-vector floating point absolute
value, which uses CallishMachOps.
- - - - -
709448c0 by Sean D. Gillespie at 2026-03-02T10:14:46-05:00
Add SIMD floating point square root
On x86, this is implemented with the SQRTPS and SQRTPD instructions. On
LLVM, it uses the sqrt library intrinstic.
- - - - -
0deadf66 by Sean D. Gillespie at 2026-03-02T10:14:47-05:00
Improve error message for SIMD on aarch64
When encountering vector literals on aarch64, previously it would
throw:
<no location info>: error:
panic! (the 'impossible' happened)
GHC version 9.15.20251219:
getRegister' (CmmLit:CmmVec):
Now it is more consistent with the other vector operations:
<no location info>: error:
sorry! (unimplemented feature or known bug)
GHC version 9.15.20251219:
SIMD operations on AArch64 currently require the LLVM backend
- - - - -
7d64031b by Vladislav Zavialov at 2026-03-03T11:09:28-05:00
Replace maybeAddSpace with spaceIfSingleQuote
Simplify pretty-printing of HsTypes by using spaceIfSingleQuote.
This allows us to drop the unwieldy lhsTypeHasLeadingPromotionQuote
helper function.
Follow-up to 178c1fd830c78377ef5d338406a41e1d8eb5f0da
- - - - -
598db847 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00
Correct `hIsReadable` and `hIsWritable` for duplex handles
This contribution implements CLC proposal #371. It changes `hIsReadable`
and `hIsWritable` such that they always throw a respective exception
when encountering a closed or semi-closed handle, not just in the case
of a file handle.
- - - - -
b90201e5 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00
Document `SemiClosedHandle`
- - - - -
c9df72b5 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00
Tell users what “semi-closed” means for duplex handles
- - - - -
a8aa1868 by Ilias Tsitsimpis at 2026-03-06T06:26:29-05:00
Fix determinism of linker arguments
The switch from Data.Map to UniqMap in 3b5be05ac29 introduced
non-determinism in the order of packages passed to the linker.
This resulted in non-reproducible builds where the DT_NEEDED entries in
dynamic libraries were ordered differently across builds.
Fix the regression by explicitly sorting the package list derived from
UniqMap.
Fixes #26838
- - - - -
9b64ad3a by Matthew Pickering at 2026-03-06T06:27:16-05:00
determinism: Use a deterministic renaming when writing bytecode files
Now when writing the bytecode file, a counter and substitution are used
to provide deterministic keys to local variables (rather than relying on
uniques). This change ensures that `.gbc` are produced
deterministically.
Fixes #26499
- - - - -
d29800e0 by Teo Camarasu at 2026-03-06T06:28:46-05:00
ghc-internal: delete Version hs-boot loop
Version has a Read instance which needs Unicode but part of the Unicode interface is the unicode version. This is easy to resolve. We simply don't re-export the version from the Unicode module.
Resolves #26940
- - - - -
ad25af90 by Sylvain Henry at 2026-03-06T06:30:33-05:00
Linker: implement support for COMMON symbols (#6107)
Add some support for COMMON symbols. We don't support common symbols
having different sizes where the larger one is allocated after the
smaller one. The linker will fail with an appropriate error message if
it happens.
- - - - -
3b59f158 by Cheng Shao at 2026-03-06T06:31:16-05:00
compiler: fix redundant import of GHC.Hs.Lit
This patch removes a redundant import of `GHC.Hs.Lit` which causes a
ghc build failure with validate flavours when bootstrapping from 9.14.
Fixes #26972.
- - - - -
148d36f3 by Cheng Shao at 2026-03-06T06:32:01-05:00
compiler: avoid unneeded traversals in GHC.Unit.State
Following !15591, this patch avoids unneeded traversals in
`reportCycles`/`reportUnusable` when log verbosity is below given
threshold. Also applies `logVerbAtLeast` when appropriate.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
7e31367c by Cheng Shao at 2026-03-06T06:32:46-05:00
ghc-internal: fix redundant import in GHC.Internal.Event.Windows.ManagedThreadPool
This patch fixes redundant import in
`GHC.Internal.Event.Windows.ManagedThreadPool` that causes a
compilation error when building windows target with validate flavours
and bootstrapping from 9.14. Fixes #26976.
- - - - -
fc8b8e27 by sheaf at 2026-03-06T06:33:28-05:00
System.Info.fullCompilerVersion: add 'since' annot
Fixes #26973
- - - - -
c8238375 by Sylvain Henry at 2026-03-06T06:34:23-05:00
Hadrian: deprecate --bignum and automatically enable +native_bignum for JS
Deprecate --bignum=... to select the bignum backend. It's only used to
select the native backend, and this can be done with the +native_bignum
flavour transformer.
Additionally, we automatically enable +native_bignum for the JS target
because the GMP backend isn't supported.
- - - - -
a3ac7074 by Sylvain Henry at 2026-03-06T06:35:17-05:00
JS: fix putEnum/fromEnum (#24593)
Don't go through Word16 when serializing Enums.
- - - - -
0b36e96c by Andreas Klebinger at 2026-03-06T06:35:58-05:00
Docs: Document -fworker-wrapper-cbv default setting.
Fixes #26841
- - - - -
eca445e7 by mangoiv at 2026-03-07T05:02:36-05:00
drop deb9/10 from CI, add deb13
debian 9 and 10 are end of life, hence we drop them
from our CI, but we do add debian 13. Jobs that were
previously run on 9 and 10 run on 13, too, jobs that
were run on 10, are run on 11 now. Jobs that were
previously run on debian 12 are run on debian 13 now.
This MR also updates hadrian's bootstrap plans for that
reason.
Metric Decrease:
T9872d
- - - - -
12f8b829 by Luite Stegeman at 2026-03-07T05:03:33-05:00
Fix GHC.Internal.Prim haddock
Haddock used to parse Haskell source to generate documentation,
but switched to using interface files instead. This broke documentation
of the GHC.Internal.Prim module, since it's a wired-in interface that
didn't provide a document structure.
This patch adds the missing document structure and updates genprimopcode
to make the section headers and descriptions available.
fixes #26954
- - - - -
f87e5e57 by Luite Stegeman at 2026-03-07T05:03:33-05:00
Remove obsolete --make-haskell-source from genprimopcode
Now that haddock uses the wired-in interface for GHC.Internal.Prim,
the generated Haskell source file is no longer needed. Remove the
--make-haskell-source code generator from genprimopcode and replace
the generated GHC/Internal/Prim.hs with a minimal static source file.
- - - - -
4a7ddc7b by Sylvain Henry at 2026-03-07T05:04:59-05:00
JS: fix linking of exposed but non-preload units (#24886)
Units exposed in the unit database but not explicitly passed on the
command-line were not considered by the JS linker. This isn't an issue
for cabal which passes every unit explicitly but it is an issue when
using GHC directly (cf T24886 test).
- - - - -
689aafcd by mangoiv at 2026-03-07T05:05:52-05:00
testsuite: double foundation timeout multiplier
The runtime timeout in the foundation test was regularly hit by code
generated by the wasm backend - we increase the timout since the high
runtime is expected on the wasm backend for this rather complex test.
Resolves #26938
- - - - -
a46a1bb1 by Cheng Shao at 2026-03-09T04:50:30-04:00
compiler: add myCapabilityExpr to GHC.Cmm.Utils
This commit adds `myCapabilityExpr` to `GHC.Cmm.Utils` which is
computed from `BaseReg`. It's convenient for codegen logic where one
needs to pass the current Capability's pointer.
- - - - -
4afc65b1 by Cheng Shao at 2026-03-09T04:50:30-04:00
compiler: lower tryPutMVar# into a ccall directly
This patch addresses an old TODO of `stg_tryPutMVarzh` by removing it
completely and making the compiler lower `tryPutMVar#` into a ccall to
`performTryPutMVar` directly, without landing into an intermediate C
or Cmm function. `performTryPutMVar` is promoted to a public RTS
function with default visibility, and the compiler lowering logic
takes into account the C ABI of `performTryPutMVar` and converts from
C Bool to primop's `Int#` result properly.
- - - - -
9e3d6a58 by Simon Hengel at 2026-03-09T04:51:15-04:00
Don't use #line in haddocks
This confuses the parser. Haddock output is unaffected by this change.
(read: this still produces the same documentation)
- - - - -
f4e8fec2 by Wolfgang Jeltsch at 2026-03-09T04:52:01-04:00
Remove in-package dependencies on `GHC.Internal.System.IO`
This contribution eliminates all dependencies on
`GHC.Internal.System.IO` from within `ghc-internal`. It comprises the
following changes:
* Make `GHC.Internal.Fingerprint` independent of I/O support
* Tighten the dependencies of `GHC.Internal.Data.Version`
* Tighten the dependencies of `GHC.Internal.TH.Monad`
* Tighten the dependencies of `GHCi.Helpers`
* Move some code that needs `System.IO` to `template-haskell`
* Move the `GHC.ResponseFile` implementation into `base`
* Move the `System.Exit` implementation into `base`
* Move the `System.IO.OS` implementation into `base`
Metric Decrease:
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
- - - - -
91df4c82 by Sylvain Henry at 2026-03-09T04:53:20-04:00
T18832: fix Windows CI failure by dropping removeDirectoryRecursive
On Windows, open file handles prevent deletion. After killThread, the
closer thread may not have called hClose yet, causing removeDirectoryRecursive
to fail with "permission denied". The test harness cleans up the run
directory anyway, so the call is redundant.
- - - - -
d7fe9671 by Cheng Shao at 2026-03-09T04:54:04-04:00
compiler: fix redundant import in GHC.StgToJS.Object
This patch fixes a redundant import in GHC.StgToJS.Object that causes
a build failure when compiling head from 9.14 with validate flavours.
Fixes #26991.
- - - - -
0bfd29c3 by Cheng Shao at 2026-03-09T04:54:46-04:00
wasm: fix `Illegal foreign declaration` failure when ghci loads modules with JSFFI exports
This patch fixes a wasm ghci error when loading modules with JSFFI
exports; the `backendValidityOfCExport` check in `tcCheckFEType`
should only makes sense and should be performed when not checking the
JavaScript calling convention; otherwise, when the calling convention
is JavaScript, the codegen logic should be trusted to backends that
actually make use of it. Fixes #26998.
- - - - -
e659610c by Duncan Coutts at 2026-03-09T12:08:35-04:00
Apply NOINLINE pragmas to generated Typeable bindings
For context, see the existing Note [Grand plan for Typeable]
and the Note [NOINLINE on generated Typeable bindings] added in the
subsequent commit.
This is about reducing the number of exported top level names and
unfoldings, which reduces interface file sizes and reduces the number of
global/dynamic linker symbols.
Also accept the changed test output and metric decreases.
Tests that record the phase output for type checking or for simplifier
end up with different output: the generated bindings now have an
Inline [~] annotation, and many top level names are now local rather
than module-prefixed for export.
Also accept the numerous metric decreases in compile_time/bytes
allocated, and a few in compile_time/max_bytes_used.
There's also one instance of a decrease in runtime/max_bytes_used but
it's a ghci-way test and so presumably the reason is that it loads
smaller .hi files and/or links fewer symbols.
-------------------------
Metric Decrease:
CoOpt_Singletons
MultiLayerModulesTH_OneShot
MultilineStringsPerf
T10421
T10547
T12150
T12227
T12234
T12425
T13035
T13056
T13253
T13253-spj
T15304
T15703
T16875
T17836b
T17977b
T18140
T18223
T18282
T18304
T18698a
T18698b
T18730
T18923
T20049
T21839c
T24471
T24582
T24984
T3064
T4029
T5030
T5642
T5837
T6048
T9020
T9198
T9961
TcPlugin_RewritePerf
WWRec
hard_hole_fits
mhu-perf
-------------------------
- - - - -
67df5161 by Duncan Coutts at 2026-03-09T12:08:35-04:00
Add documentation Note [NOINLINE on generated Typeable bindings]
and refer to it from the code and existing documentation.
- - - - -
c4ad6167 by Duncan Coutts at 2026-03-09T12:08:35-04:00
Switch existing note to "named wrinkle" style, (GPT1)..(GPT7)
GPT = Grand plan for Typeable
- - - - -
dc84f8e2 by Cheng Shao at 2026-03-09T12:09:21-04:00
ci: only build deb13 for validate pipeline aarch64-linux jobs
This patch drops the redundant aarch64-linux deb12 job from validate pipelines
and only keeps deb13; it's still built in nightly/release pipelines. Closes #27004.
- - - - -
23a50772 by Rajkumar Natarajan at 2026-03-10T14:11:37-04:00
chore: Merge GHC.Internal.TH.Quote into GHC.Internal.TH.Monad
Move the QuasiQuoter datatype from GHC.Internal.TH.Quote to
GHC.Internal.TH.Monad and delete the Quote module.
Update submodule template-haskell-quasiquoter to use the merged
upstream version that imports from the correct module.
Co-authored-by: Cursor <cursoragent(a)cursor.com>
- - - - -
a2bb6fc3 by Simon Jakobi at 2026-03-10T14:12:23-04:00
Add regression test for #16122
- - - - -
604e1180 by Cheng Shao at 2026-03-11T15:00:42-04:00
hadrian: remove the broken bench flavour
This patch removes the bench flavour from hadrian which has been
broken for years and not used for actual benchmarking (for which
`perf`/`release` is used instead). Closes #26825.
- - - - -
c3e64915 by Simon Jakobi at 2026-03-11T15:01:31-04:00
Add regression test for #18186
The original TypeInType language extension is replaced with
DataKinds+PolyKinds for compatibility.
Closes #18186.
- - - - -
664996c7 by Andreas Klebinger at 2026-03-11T15:02:16-04:00
Bump nofib submodule.
We accrued a number of nofib fixes we want to have here.
- - - - -
517cf64e by Simon Jakobi at 2026-03-11T15:03:03-04:00
Add regression test for #15907
Closes #15907.
- - - - -
fff362cf by Simon Jakobi at 2026-03-11T15:03:49-04:00
Ensure T14272 is run in optasm way
Closes #16539.
- - - - -
ec81ec2c by Simon Jakobi at 2026-03-11T15:03:49-04:00
Add regression test for #24632
Closes #24632.
- - - - -
cefec47b by Simon Jakobi at 2026-03-11T15:03:50-04:00
Fix module name of T9675: T6975 -> T9675
- - - - -
d3690ae8 by Andreas Klebinger at 2026-03-11T15:04:31-04:00
User guide: Clarify phase control on INLINEABLE[foo] pragmas.
Fixes #26851
- - - - -
e7054934 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #12694
Closes #12694.
- - - - -
4756d9f6 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #16275
Closes #16275.
- - - - -
34b7e2c1 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #14908
Closes #14908.
- - - - -
4243db3d by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #14151
Closes #14151.
- - - - -
0e9f1453 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #12640
Closes #12640.
- - - - -
ae606c7f by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #15588
Closes #15588.
- - - - -
5a38ce4e by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #9445
Closes #9445.
- - - - -
d054b467 by Cheng Shao at 2026-03-11T15:05:59-04:00
compiler: implement string interning logic for BCONPtrFS
This patch adds a `FastStringEnv`-based cache of `MallocStrings`
requests to `Interp`, so that when we load bytecode with many
breakpoints that share the same module names & unit ids, we reuse the
allocated remote pointers instead of issuing duplicte `MallocStrings`
requests and bloating the C heap. Closes #26995.
- - - - -
b85a0293 by Simon Jakobi at 2026-03-11T15:06:41-04:00
Add perf test for #1216
Closes #1216.
- - - - -
cd7f7420 by Sylvain Henry at 2026-03-11T15:07:58-04:00
JS: check that tuple constructors are linked (#23709)
Test js-mk_tup was failing before because tuple constructors weren't
linked in. It's no longer an issue after the linker fixes.
- - - - -
d57f01a4 by Matthew Pickering at 2026-03-11T15:08:40-04:00
testsuite: Add test for foreign import prim with unboxed tuple return
This commit just adds a test that foreign import prim works with unboxed
sums.
- - - - -
23d111ce by Matthew Pickering at 2026-03-11T15:08:41-04:00
Return a valid pointer in advanceStackFrameLocationzh
When there is no next stack chunk, `advanceStackFrameLocationzh` used to
return NULL in the pointer-typed StackSnapshot# result slot.
Even though the caller treats that case as "no next frame", the result is
still materialized in a GC-visible pointer slot. If a GC observes the raw
NULL there, stack decoding can crash.
Fix this by ensuring the dead pointer slot contains a valid closure
pointer. Also make the optional result explicit by returning an unboxed
sum instead of a tuple with a separate tag.
Fixes #27009
- - - - -
4c58a3ae by Cheng Shao at 2026-03-11T15:09:22-04:00
hadrian: build profiled dynamic objects with -dynamic-too
This patch enables hadrian to build profiled dynamic objects with
`-dynamic-too`, addressing a build parallelism bottleneck in release
pipelines. Closes #27010.
- - - - -
870243e4 by Zubin Duggal at 2026-03-12T17:33:28+05:30
DmdAnal: Take stable unfoldings into account when determining argument demands
Previously, demand analysis only looked at the RHS to compute argument demands.
If the optimised RHS discarded uses of an argument that the stable unfolding
still needed, it would be incorrectly marked absent. Worker/wrapper would then
replace it with LitRubbish, and inlining the stable unfolding would use the
rubbish value, causing a segfault.
To fix, we introduce addUnfoldingDemands which analyses the stable unfolding
with dmdAnal and combines its DmdType with the RHS's via the new `maxDmdType`
which combines the demands of the stable unfolding with the rhs, so we can avoid
any situation where we give an absent demand to something which is still used
by the stable unfolding.
Fixes #26416.
- - - - -
669d09f9 by Cheng Shao at 2026-03-13T15:06:07-04:00
hadrian: remove redundant library/rts ways definitions from stock flavours
This patch removes redundant library/rts ways definitions from stock
flavours in hadrian; they can be replaced by applying appropriate
filters on `defaultFlavour`.
- - - - -
a27dc081 by Teo Camarasu at 2026-03-13T15:06:51-04:00
ghc-internal: move bits Weak of finalizer interface to base
We move parts of the Weak finalizer interface to `base` only the parts
that the RTS needs to know about are kept in `ghc-internal`.
This lets us then prune our imports somewhat and get rid of some SOURCE imports.
Resolves #26985
- - - - -
6eef855b by Sylvain Henry at 2026-03-13T15:08:18-04:00
Stg/Unarise: constant-folding during unarisation (#25650)
When building an unboxed sum from a literal argument, mkUbxSum
previously emitted a runtime cast via `case primop [lit] of var -> ...`.
This wrapper prevented GHC from recognising the result as a static
StgRhsCon, causing top-level closures to be allocated as thunks instead
of being statically allocated.
Fix: try to perform the numeric literal cast at compile time using
mkLitNumberWrap (wrapping semantics). If successful, return the cast
literal directly with an identity wrapper (no case expression). The
runtime cast path is kept as fallback for non-literal arguments.
Test: codeGen/should_compile/T25650
- - - - -
905f8723 by Simon Jakobi at 2026-03-13T15:09:09-04:00
Add regression test for #2057
Test that GHC stops after an interface-file error instead of
continuing into the linker.
The test constructs a stale package dependency on purpose. `pkgB` is compiled
against one version of package `A`, then the same unit id is replaced by an
incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
finds an unfolding that still mentions the old `A`, and should fail while
loading interfaces.
Closes #2057.
Assisted-by: Codex
- - - - -
a13245a9 by Sylvain Henry at 2026-03-13T15:10:06-04:00
JS: fix recompilation avoidance (#23013)
- we were checking the mtime of the *.jsexe directory, not of a file
- we were not computing the PkgsLoaded at all
- - - - -
07442653 by Cheng Shao at 2026-03-13T15:10:51-04:00
hadrian: bump index state & bootstrap plans
This patch bumps hadrian index state & bootstrap plans:
- The updated index state allows bootstrapping from 9.14 without cabal
allow-newer hacks
- The updated bootstrap plans all contain shake-0.19.9 containing
important bugfix, allowing a subsequent patch to bump shake bound to
ensure the bugfix is included
- ghc 9.14.1 bootstrap plan is added
- - - - -
fdc1dbad by Cheng Shao at 2026-03-13T15:10:51-04:00
ci: add ghc 9.14.1 to bootstrap matrix
This patch adds ghc 9.14.1 to bootstrap matrix, so that we test
bootstrapping from ghc 9.14.1.
- - - - -
91916079 by Sylvain Henry at 2026-03-13T15:11:43-04:00
T17912: wait for opener thread to block before killing it (#24739)
Instead of a fixed 1000ms delay, poll threadStatus until the opener
thread is in BlockedOnForeignCall, ensuring killThread only fires once
the thread is provably inside the blocking open() syscall. This prevents
the test from accidentally passing on Windows due to scheduling races.
- - - - -
baa4ebb4 by Cheng Shao at 2026-03-13T15:12:26-04:00
template-haskell: fix redundant import in Language.Haskell.TH.Quote
This patch fixes a redundant import in `Language.Haskell.TH.Quote`
that causes a ghc build failure when bootstrapping from 9.14 with
validate flavours. Fixes #27014.
- - - - -
02e68a86 by Brandon Simmons at 2026-03-13T15:13:19-04:00
Add a cumulative gc_sync_elapsed_ns counter to GHC.Internal.Stats
This makes it possible to get an accurate view of time spent in sync
phase when using prometheus-style sampling. Previously this was only
available for the most recent GC.
This intentionally leaves GHC.Stats API unchanged since it is marked as
deprecated, and API changes there require CLC approval.
Fixes #26944
- - - - -
a18fa3c1 by Cheng Shao at 2026-03-14T05:12:14-04:00
configure: make $LLVMAS default to $CC when $CcLlvmBackend is YES
This patch changes the $LLVMAS detection logic in configure so that
when it's not manually specified by the user, it defaults to $CC if
$CcLlvmBackend is YES. It's a more sensible default than auto-detected
clang from the environment, especially when cross-compiling, $CC as
the cross target's LLVM assembler is more compatible with the use case
than the system-wide clang. Fixes #26769.
- - - - -
3774086e by Matthew Pickering at 2026-03-14T05:13:00-04:00
exceptions: annotate onException continuation with WhileHandling
Before this patch, an exception thrown in the `onException` handler
would loose track of where the original exception was thrown.
```
import Control.Exception
main :: IO ()
main = failingAction `onException` failingCleanup
where
failingAction = throwIO (ErrorCall "outer failure")
failingCleanup = throwIO (ErrorCall "cleanup failure")
```
would report
```
T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
cleanup failure
HasCallStack backtrace:
throwIO, called at T28399.hs:<line>:<column> in <package-id>:Main
```
notice that the "outer failure" exception is not present in the error
message.
With this patch, any exception thrown is in the handler is annotated
with WhileHandling. The resulting message looks like
```
T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
cleanup failure
While handling outer failure
HasCallStack backtrace:
throwIO, called at T28399.hs:7:22 in main:Main
```
CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/397
Fixes #26759
- - - - -
63ae8eb3 by Andreas Klebinger at 2026-03-14T05:13:43-04:00
Fix missing profiling header for origin_thunk frame.
Fixes #27007
- - - - -
213d2c0e by Cheng Shao at 2026-03-14T05:14:28-04:00
ci: fix ci-images revision
The current ci-images revision was a commit on the WIP branch of
https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/183, and
it's not on the current ci-images master branch. This patch fixes the
image revision to use the current tip of ci-images master.
- - - - -
fc2b083f by Andreas Klebinger at 2026-03-14T05:15:14-04:00
Revert "hadrian/build-cabal: Better respect and utilize -j"
This reverts commit eab3dbba79650e6046efca79133b4c0a5257613d.
While it's neat this currently isn't well supported on all platforms.
It's time will come, but for now I'm reverting this to avoid issues for
users on slightly unconvential platforms.
This will be tracked at #26977.
- - - - -
12a706cf by Cheng Shao at 2026-03-14T16:37:54-04:00
base: fix redundant imports in GHC.Internal.Weak.Finalize
This patch fixes redundant imports in GHC.Internal.Weak.Finalize that
causes a regression in bootstrapping head from 9.14 with validate
flavours. Fixes #27026.
- - - - -
b5d39cad by Matthew Pickering at 2026-03-14T16:38:37-04:00
Use explicit syntax rather than pure
- - - - -
43638643 by Andreas Klebinger at 2026-03-15T18:15:48-04:00
Configure: Fix check for --target support in stage0 CC
The check FP_PROG_CC_LINKER_TARGET used $CC unconditionally to check for
--target support. However this fails for the stage0 config where the C
compiler used is not $CC but $CC_STAGE0.
Since we already pass the compiler under test into the macro I simply
changed it to use that instead.
Fixes #26999
- - - - -
18fd0df6 by Simon Hengel at 2026-03-15T18:16:33-04:00
Fix typo in recursive_do.rst
- - - - -
d6c9a439 by VeryMilkyJoe at 2026-03-16T13:48:46+01:00
Remove backwards compatibility pattern synonym `ModLocation`
Fixes #24932
- - - - -
495 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC.hs
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/Cmm/Node.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/FloatIn.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/String.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- + compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Runtime/Interpreter/JS.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Runtime/Interpreter/Wasm.hs
- compiler/GHC/Stg/Pipeline.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Object.hs
- compiler/GHC/StgToJS/Prim.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/SourceText.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Utils/Error.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Pat.hs
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- configure.ac
- distrib/configure.ac.in
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/exts/pragmas.rst
- + docs/users_guide/exts/qualified_strings.rst
- docs/users_guide/exts/recursive_do.rst
- docs/users_guide/exts/rewrite_rules.rst
- docs/users_guide/using-optimisation.rst
- docs/users_guide/wasm.rst
- hadrian/README.md
- hadrian/bootstrap/generate_bootstrap_plans
- hadrian/bootstrap/plan-9_10_1.json
- hadrian/bootstrap/plan-9_10_2.json
- + hadrian/bootstrap/plan-9_10_3.json
- hadrian/bootstrap/plan-9_12_1.json
- hadrian/bootstrap/plan-9_12_2.json
- + hadrian/bootstrap/plan-9_14_1.json
- hadrian/bootstrap/plan-bootstrap-9_10_1.json
- hadrian/bootstrap/plan-bootstrap-9_10_2.json
- + hadrian/bootstrap/plan-bootstrap-9_10_3.json
- hadrian/bootstrap/plan-bootstrap-9_12_1.json
- hadrian/bootstrap/plan-bootstrap-9_12_2.json
- + hadrian/bootstrap/plan-bootstrap-9_14_1.json
- hadrian/build-cabal
- hadrian/cabal.project
- + hadrian/cabal.project.local
- hadrian/doc/flavours.md
- hadrian/hadrian.cabal
- hadrian/src/CommandLine.hs
- hadrian/src/Main.hs
- hadrian/src/Rules/Compile.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/GenPrimopCode.hs
- hadrian/src/Settings/Builders/Ghc.hs
- − hadrian/src/Settings/Flavours/Benchmark.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Flavours/Quick.hs
- hadrian/src/Settings/Flavours/QuickCross.hs
- hadrian/src/Settings/Flavours/Quickest.hs
- libraries/base/changelog.md
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Exts.hs
- libraries/base/src/GHC/Fingerprint.hs
- libraries/base/src/GHC/ResponseFile.hs
- libraries/base/src/GHC/Stats.hs
- libraries/base/src/GHC/Unicode.hs
- libraries/base/src/GHC/Weak.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- − libraries/base/src/GHC/Weak/Finalizehs
- libraries/base/src/System/Exit.hs
- libraries/base/src/System/IO/OS.hs
- libraries/base/src/System/Info.hs
- libraries/base/src/System/Mem/Weak.hs
- libraries/base/tests/IO/T17912.hs
- libraries/base/tests/IO/T18832.hs
- libraries/base/tests/IO/all.T
- libraries/ghc-boot-th/GHC/Boot/TH/Quote.hs
- libraries/ghc-experimental/CHANGELOG.md
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-internal/CHANGELOG.md
- libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/ghc-internal.cabal.in
- − libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Version.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- − libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- + libraries/ghc-internal/src/GHC/Internal/Prim.hs
- − libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- − libraries/ghc-internal/src/GHC/Internal/System/Exit.hs
- − libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- − libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Weak.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- libraries/template-haskell-quasiquoter
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- m4/fp_prog_cc_linker_target.m4
- nofib
- rts/Linker.c
- rts/LinkerInternals.h
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/Stats.c
- rts/StgMiscClosures.cmm
- rts/Threads.c
- rts/Threads.h
- rts/include/RtsAPI.h
- rts/include/rts/Threads.h
- rts/include/stg/MiscClosures.h
- rts/linker/Elf.c
- rts/linker/MachO.c
- rts/linker/PEi386.c
- testsuite/.gitignore
- testsuite/driver/perf_notes.py
- testsuite/tests/annotations/should_run/all.T
- testsuite/tests/codeGen/should_compile/Makefile
- + testsuite/tests/codeGen/should_compile/T25650.hs
- + testsuite/tests/codeGen/should_compile/T25650.stdout-ws-32
- + testsuite/tests/codeGen/should_compile/T25650.stdout-ws-64
- testsuite/tests/codeGen/should_compile/all.T
- testsuite/tests/codeGen/should_compile/debug.stdout
- + testsuite/tests/codeGen/should_fail/T26958.hs
- testsuite/tests/codeGen/should_fail/all.T
- + testsuite/tests/corelint/T15907.hs
- + testsuite/tests/corelint/T15907A.hs
- testsuite/tests/corelint/all.T
- testsuite/tests/deSugar/should_compile/T16615.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- + testsuite/tests/dependent/should_fail/SelfDepCls.hs
- + testsuite/tests/dependent/should_fail/SelfDepCls.stderr
- + testsuite/tests/dependent/should_fail/T15588.hs
- + testsuite/tests/dependent/should_fail/T15588.stderr
- testsuite/tests/dependent/should_fail/all.T
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/dmdanal/should_compile/T16029.stdout
- testsuite/tests/dmdanal/should_compile/T18894.stderr
- + testsuite/tests/dmdanal/should_run/M1.hs
- + testsuite/tests/dmdanal/should_run/T26416.hs
- + testsuite/tests/dmdanal/should_run/T26416.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/dmdanal/sigs/T21081.stderr
- − testsuite/tests/driver/OneShotTH.stdout-javascript-unknown-ghcjs
- + testsuite/tests/driver/T2057/Makefile
- + testsuite/tests/driver/T2057/README.md
- + testsuite/tests/driver/T2057/T2057.stderr
- + testsuite/tests/driver/T2057/all.T
- + testsuite/tests/driver/T2057/app/Main.hs
- + testsuite/tests/driver/T2057/pkgA1/A.hs
- + testsuite/tests/driver/T2057/pkgA1/pkg.conf
- + testsuite/tests/driver/T2057/pkgA2/A.hs
- + testsuite/tests/driver/T2057/pkgA2/pkg.conf
- + testsuite/tests/driver/T2057/pkgB/B.hs
- + testsuite/tests/driver/T2057/pkgB/pkg.conf
- + testsuite/tests/driver/T20604/T20604.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/T20604/all.T
- testsuite/tests/driver/T4437.hs
- testsuite/tests/driver/all.T
- testsuite/tests/driver/fat-iface/fat010.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/recomp011/all.T
- testsuite/tests/driver/recompHash/recompHash.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/recompNoTH/recompNoTH.stdout-javascript-unknown-ghcjs
- − testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs
- + testsuite/tests/exceptions/T26759.hs
- + testsuite/tests/exceptions/T26759.stderr
- + testsuite/tests/exceptions/T26759a.hs
- + testsuite/tests/exceptions/T26759a.stderr
- + testsuite/tests/exceptions/T26759a.stdout
- testsuite/tests/exceptions/all.T
- testsuite/tests/ffi/should_compile/all.T
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum.hs
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum.stdout
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum_cmm.cmm
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/ghc-api/annotations-literals/literals.stdout
- testsuite/tests/ghc-api/annotations-literals/parsed.hs
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- + testsuite/tests/ghci-wasm/T26998.hs
- testsuite/tests/ghci-wasm/all.T
- + testsuite/tests/ghci/scripts/T24632.hs
- + testsuite/tests/ghci/scripts/T24632.script
- + testsuite/tests/ghci/scripts/T24632.stdout
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- + testsuite/tests/javascript/T24886.hs
- + testsuite/tests/javascript/T24886.stderr
- + testsuite/tests/javascript/T24886.stdout
- testsuite/tests/javascript/all.T
- testsuite/tests/javascript/js-mk_tup.hs
- testsuite/tests/javascript/js-mk_tup.stdout
- − testsuite/tests/linear/should_compile/LinearListComprehension.hs
- testsuite/tests/linear/should_compile/all.T
- testsuite/tests/linear/should_fail/T25081.hs
- testsuite/tests/linear/should_fail/T25081.stderr
- testsuite/tests/linters/Makefile
- testsuite/tests/module/all.T
- + testsuite/tests/module/mod70b.hs
- + testsuite/tests/module/mod70b.stderr
- testsuite/tests/numeric/should_compile/T14170.stdout
- testsuite/tests/numeric/should_compile/T14465.stdout
- testsuite/tests/numeric/should_compile/T7116.stdout
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/overloadedrecflds/should_run/all.T
- + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.hs
- + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.stderr
- testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.hs
- testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.stderr
- + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.hs
- + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.stderr
- + testsuite/tests/parser/should_fail/T26860ppr_overloaded.hs
- + testsuite/tests/parser/should_fail/T26860ppr_overloaded.stderr
- + testsuite/tests/parser/should_fail/T26860ppr_tylit.hs
- + testsuite/tests/parser/should_fail/T26860ppr_tylit.stderr
- testsuite/tests/parser/should_fail/all.T
- + testsuite/tests/parser/should_fail/badRuleMarker.hs
- + testsuite/tests/parser/should_fail/badRuleMarker.stderr
- + testsuite/tests/parser/should_fail/patFail010.hs
- + testsuite/tests/parser/should_fail/patFail010.stderr
- + testsuite/tests/parser/should_fail/patFail011.hs
- + testsuite/tests/parser/should_fail/patFail011.stderr
- + testsuite/tests/parser/should_fail/precOutOfRange.hs
- + testsuite/tests/parser/should_fail/precOutOfRange.stderr
- + testsuite/tests/parser/should_fail/unpack_data_con.hs
- + testsuite/tests/parser/should_fail/unpack_data_con.stderr
- testsuite/tests/patsyn/should_fail/T10426.stderr
- testsuite/tests/patsyn/should_fail/all.T
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.stderr
- testsuite/tests/perf/compiler/T9675.hs
- + testsuite/tests/perf/should_run/T1216.hs
- + testsuite/tests/perf/should_run/T1216.stdout
- testsuite/tests/perf/should_run/all.T
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/pmcheck/should_compile/T11303.hs
- + testsuite/tests/polykinds/T18186.hs
- + testsuite/tests/polykinds/T18186.stderr
- testsuite/tests/polykinds/all.T
- + testsuite/tests/qualified-strings/Makefile
- + testsuite/tests/qualified-strings/should_compile/Example/Length.hs
- + testsuite/tests/qualified-strings/should_compile/all.T
- + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.hs
- + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.stderr
- + testsuite/tests/qualified-strings/should_fail/Example/Length.hs
- + testsuite/tests/qualified-strings/should_fail/Makefile
- + testsuite/tests/qualified-strings/should_fail/all.T
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr
- + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.stderr
- + testsuite/tests/qualified-strings/should_run/Example/ByteStringAscii.hs
- + testsuite/tests/qualified-strings/should_run/Example/ByteStringUtf8.hs
- + testsuite/tests/qualified-strings/should_run/Example/Text.hs
- + testsuite/tests/qualified-strings/should_run/Makefile
- + testsuite/tests/qualified-strings/should_run/all.T
- + testsuite/tests/qualified-strings/should_run/qstrings_expr.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_expr.stdout
- + testsuite/tests/qualified-strings/should_run/qstrings_pat.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_pat.stdout
- + testsuite/tests/qualified-strings/should_run/qstrings_th.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_th.stdout
- testsuite/tests/quasiquotation/qq005/test.T
- testsuite/tests/quasiquotation/qq006/test.T
- testsuite/tests/quotes/QQError.stderr
- testsuite/tests/roles/should_compile/Roles1.stderr
- testsuite/tests/roles/should_compile/Roles13.stderr
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles2.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/rts/linker/Makefile
- + testsuite/tests/rts/linker/T6107.hs
- + testsuite/tests/rts/linker/T6107.stdout
- + testsuite/tests/rts/linker/T6107_sym1.s
- + testsuite/tests/rts/linker/T6107_sym2.s
- testsuite/tests/rts/linker/all.T
- testsuite/tests/saks/should_compile/all.T
- testsuite/tests/showIface/all.T
- testsuite/tests/simd/should_run/doublex2_arith.hs
- testsuite/tests/simd/should_run/doublex2_arith.stdout
- testsuite/tests/simd/should_run/doublex2_arith_baseline.hs
- testsuite/tests/simd/should_run/doublex2_arith_baseline.stdout
- testsuite/tests/simd/should_run/floatx4_arith.hs
- testsuite/tests/simd/should_run/floatx4_arith.stdout
- testsuite/tests/simd/should_run/floatx4_arith_baseline.hs
- testsuite/tests/simd/should_run/floatx4_arith_baseline.stdout
- testsuite/tests/simd/should_run/int16x8_arith.hs
- testsuite/tests/simd/should_run/int16x8_arith.stdout
- testsuite/tests/simd/should_run/int16x8_arith_baseline.hs
- testsuite/tests/simd/should_run/int16x8_arith_baseline.stdout
- testsuite/tests/simd/should_run/int32x4_arith.hs
- testsuite/tests/simd/should_run/int32x4_arith.stdout
- testsuite/tests/simd/should_run/int32x4_arith_baseline.hs
- testsuite/tests/simd/should_run/int32x4_arith_baseline.stdout
- testsuite/tests/simd/should_run/int64x2_arith.hs
- testsuite/tests/simd/should_run/int64x2_arith.stdout
- testsuite/tests/simd/should_run/int64x2_arith_baseline.hs
- testsuite/tests/simd/should_run/int64x2_arith_baseline.stdout
- testsuite/tests/simd/should_run/int8x16_arith.hs
- testsuite/tests/simd/should_run/int8x16_arith.stdout
- testsuite/tests/simd/should_run/int8x16_arith_baseline.hs
- testsuite/tests/simd/should_run/int8x16_arith_baseline.stdout
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- + testsuite/tests/simplCore/should_compile/T12640.hs
- + testsuite/tests/simplCore/should_compile/T12640.stderr
- + testsuite/tests/simplCore/should_compile/T14908.hs
- + testsuite/tests/simplCore/should_compile/T14908_Deps.hs
- + testsuite/tests/simplCore/should_compile/T16122.hs
- + testsuite/tests/simplCore/should_compile/T16122.stderr
- + testsuite/tests/simplCore/should_compile/T26642.hs
- testsuite/tests/simplCore/should_compile/T3717.stderr
- testsuite/tests/simplCore/should_compile/T3772.stdout
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/T4930.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplCore/should_compile/T8274.stdout
- testsuite/tests/simplCore/should_compile/T9400.stderr
- + testsuite/tests/simplCore/should_compile/T9445.hs
- + testsuite/tests/simplCore/should_compile/TrickyJoins.hs
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_compile/noinline01.stderr
- testsuite/tests/simplCore/should_compile/par01.stderr
- testsuite/tests/th/QQTopError.stderr
- + testsuite/tests/th/T26862_th.script
- + testsuite/tests/th/T26862_th.stderr
- + testsuite/tests/th/T8306_th.script
- + testsuite/tests/th/T8306_th.stderr
- + testsuite/tests/th/T8306_th.stdout
- testsuite/tests/th/T8412.stderr
- + testsuite/tests/th/TH_EmptyLamCases.hs
- + testsuite/tests/th/TH_EmptyLamCases.stderr
- + testsuite/tests/th/TH_EmptyMultiIf.hs
- + testsuite/tests/th/TH_EmptyMultiIf.stderr
- testsuite/tests/th/TH_Roles2.stderr
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/T13032.stderr
- + testsuite/tests/typecheck/should_compile/T14151.hs
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/typecheck/should_fail/T12694.hs
- + testsuite/tests/typecheck/should_fail/T12694.stderr
- + testsuite/tests/typecheck/should_fail/T16275.stderr
- + testsuite/tests/typecheck/should_fail/T16275A.hs
- + testsuite/tests/typecheck/should_fail/T16275B.hs
- + testsuite/tests/typecheck/should_fail/T16275B.hs-boot
- + testsuite/tests/typecheck/should_fail/T26861.hs
- + testsuite/tests/typecheck/should_fail/T26861.stderr
- + testsuite/tests/typecheck/should_fail/T26862.hs
- + testsuite/tests/typecheck/should_fail/T26862.stderr
- testsuite/tests/typecheck/should_fail/T8306.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/unboxedsums/all.T
- + testsuite/tests/unboxedsums/unboxedsums4p.hs
- + testsuite/tests/unboxedsums/unboxedsums4p.stderr
- testsuite/tests/vdq-rta/should_compile/all.T
- + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.hs
- + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.stderr
- testsuite/tests/warnings/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/genprimopcode/Main.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/jsffi/dyld.mjs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f30bcf60a840004a0d8fc292c8b2f9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f30bcf60a840004a0d8fc292c8b2f9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/VeryMilkyJoe/no-mod-loc-pat] Remove backwards compatibility pattern synonym `ModLocation`
by Jana Chadt (＠VeryMilkyJoe) 16 Mar '26
by Jana Chadt (＠VeryMilkyJoe) 16 Mar '26
16 Mar '26
Jana Chadt pushed to branch wip/VeryMilkyJoe/no-mod-loc-pat at Glasgow Haskell Compiler / GHC
Commits:
f30bcf60 by VeryMilkyJoe at 2026-03-16T13:46:20+01:00
Remove backwards compatibility pattern synonym `ModLocation`
Fixes #24932
- - - - -
9 changed files:
- compiler/GHC.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/ghc.cabal.in
- + hadrian/cabal.project.local
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -79,7 +79,13 @@ module GHC (
ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
- pattern ModLocation,
+ ml_hs_file,
+ ml_hi_file,
+ ml_dyn_hi_file,
+ ml_obj_file,
+ ml_dyn_obj_file,
+ ml_hie_file,
+ ml_bytecode_file,
getModSummary,
getModuleGraph,
isLoaded,
@@ -457,6 +463,7 @@ import System.Environment ( getEnv, getProgName )
import System.Exit ( exitWith, ExitCode(..) )
import System.FilePath
import System.IO.Error ( isDoesNotExistError )
+import GHC.Data.OsPath (OsPath)
#if defined(HAVE_INTERNAL_INTERPRETER)
import Foreign.C
@@ -1575,7 +1582,7 @@ pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
-- a module by using 'getModSummary'
--
-- XXX: Explain pre-conditions
-getModuleSourceAndFlags :: ModSummary -> IO (String, StringBuffer, DynFlags)
+getModuleSourceAndFlags :: ModSummary -> IO (FilePath, StringBuffer, DynFlags)
getModuleSourceAndFlags m = do
case ml_hs_file $ ms_location m of
Nothing -> throwIO $ mkApiErr (ms_hspp_opts m) (text "No source available for module " <+> ppr (ms_mod m))
=====================================
compiler/GHC/CoreToStg/AddImplicitBinds.hs
=====================================
@@ -10,7 +10,7 @@ import GHC.Prelude
import GHC.CoreToStg.Prep( CorePrepPgmConfig(..) )
-import GHC.Unit( ModLocation(..) )
+import GHC.Unit( ModLocation(..), ml_hs_file )
import GHC.Core
import GHC.Core.DataCon( DataCon, dataConWorkId, dataConWrapId )
=====================================
compiler/GHC/Data/StringBuffer.hs
=====================================
@@ -56,17 +56,19 @@ module GHC.Data.StringBuffer
import GHC.Prelude
import GHC.Data.FastString
+import GHC.Data.OsPath (OsPath)
+import GHC.Fingerprint
import GHC.Utils.Encoding
+import GHC.Utils.Exception (bracket_)
import GHC.Utils.IO.Unsafe
import GHC.Utils.Panic.Plain
-import GHC.Utils.Exception ( bracket_ )
-import GHC.Fingerprint
import Data.Maybe
+import GHC.IO.Encoding.Failure (CodingFailureMode (IgnoreCodingFailure))
+import GHC.IO.Encoding.UTF8 (mkUTF8)
+import System.File.OsPath qualified as FileIO
import System.IO
-import System.IO.Unsafe ( unsafePerformIO )
-import GHC.IO.Encoding.UTF8 ( mkUTF8 )
-import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) )
+import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString as BS
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -2,22 +2,19 @@
{-# LANGUAGE ViewPatterns #-}
-- | Module location
module GHC.Unit.Module.Location
- ( ModLocation
- ( ..
- , ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- )
- , pattern ModLocation
+ ( ModLocation(..)
, addBootSuffix
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
, mkFileSrcSpan
+ , ml_hs_file
+ , ml_hi_file
+ , ml_dyn_hi_file
+ , ml_obj_file
+ , ml_dyn_obj_file
+ , ml_hie_file
+ , ml_bytecode_file
)
where
@@ -128,33 +125,30 @@ mkFileSrcSpan mod_loc
-- Helpers for backwards compatibility
-- ----------------------------------------------------------------------------
-{-# COMPLETE ModLocation #-}
-
-pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
-pattern ModLocation
- { ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- } <- OsPathModLocation
- { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file)
- , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file)
- , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file)
- , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file)
- , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file)
- , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file)
- , ml_bytecode_file_ospath = (unsafeDecodeUtf -> ml_bytecode_file)
- } where
- ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_file ml_bytecode_file
- = OsPathModLocation
- { ml_hs_file_ospath = fmap unsafeEncodeUtf ml_hs_file
- , ml_hi_file_ospath = unsafeEncodeUtf ml_hi_file
- , ml_dyn_hi_file_ospath = unsafeEncodeUtf ml_dyn_hi_file
- , ml_obj_file_ospath = unsafeEncodeUtf ml_obj_file
- , ml_dyn_obj_file_ospath = unsafeEncodeUtf ml_dyn_obj_file
- , ml_hie_file_ospath = unsafeEncodeUtf ml_hie_file
- , ml_bytecode_file_ospath = unsafeEncodeUtf ml_bytecode_file
- }
+ml_hs_file :: ModLocation -> Maybe FilePath
+{-# INLINE ml_hs_file #-}
+ml_hs_file = fmap unsafeDecodeUtf . ml_hs_file_ospath
+
+ml_hi_file :: ModLocation -> FilePath
+{-# INLINE ml_hi_file #-}
+ml_hi_file = unsafeDecodeUtf . ml_hi_file_ospath
+
+ml_dyn_hi_file :: ModLocation -> FilePath
+{-# INLINE ml_dyn_hi_file #-}
+ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ospath
+
+ml_obj_file :: ModLocation -> FilePath
+{-# INLINE ml_obj_file #-}
+ml_obj_file = unsafeDecodeUtf . ml_obj_file_ospath
+
+ml_dyn_obj_file :: ModLocation -> FilePath
+{-# INLINE ml_dyn_obj_file #-}
+ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ospath
+
+ml_hie_file :: ModLocation -> FilePath
+{-# INLINE ml_hie_file #-}
+ml_hie_file = unsafeDecodeUtf . ml_hie_file_ospath
+
+ml_bytecode_file :: ModLocation -> FilePath
+{-# INLINE ml_bytecode_file #-}
+ml_bytecode_file = unsafeDecodeUtf . ml_bytecode_file_ospath
=====================================
compiler/GHC/Unit/Module/ModSummary.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Types.PkgQual
import GHC.Types.Basic
import GHC.Data.Maybe
-import GHC.Data.OsPath (OsPath)
+import GHC.Data.OsPath ( OsPath )
import GHC.Data.StringBuffer ( StringBuffer )
import GHC.Utils.Fingerprint
=====================================
compiler/ghc.cabal.in
=====================================
@@ -125,6 +125,7 @@ Library
containers >= 0.6.2.1 && < 0.9,
array >= 0.1 && < 0.6,
filepath >= 1.5 && < 1.6,
+ file-io >= 0.1.5 && < 0.3,
os-string >= 2.0.1 && < 2.1,
hpc >= 0.6 && < 0.8,
transformers >= 0.5 && < 0.7,
=====================================
hadrian/cabal.project.local
=====================================
@@ -0,0 +1,2 @@
+ignore-project: False
+with-compiler: ghc-9.10.3
=====================================
testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
=====================================
@@ -31,7 +31,7 @@ convertToFixed (ModuleNodeCompile ms) =
-- with the module summary information
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing }
-- | Load a module graph and report the result
=====================================
testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
=====================================
@@ -29,7 +29,7 @@ convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
convertToFixed (ModuleNodeCompile ms) =
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing }
-- | Test a module graph and report if it matches expected invariant violations
testModuleGraph :: String -> ModuleGraph -> [ModuleGraphInvariantError] -> Ghc ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f30bcf60a840004a0d8fc292c8b2f9f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f30bcf60a840004a0d8fc292c8b2f9f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/ipe-interpreter-test
by Matthew Pickering (＠mpickering) 16 Mar '26
by Matthew Pickering (＠mpickering) 16 Mar '26
16 Mar '26
Matthew Pickering pushed new branch wip/ipe-interpreter-test at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ipe-interpreter-test
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/linkable-usage] 2 commits: Add linkable testsuite
by Hannes Siebenhandl (＠fendor) 16 Mar '26
by Hannes Siebenhandl (＠fendor) 16 Mar '26
16 Mar '26
Hannes Siebenhandl pushed to branch wip/fendor/linkable-usage at Glasgow Haskell Compiler / GHC
Commits:
784c12fe by fendor at 2026-03-16T13:00:29+01:00
Add linkable testsuite
- - - - -
afc6706e by fendor at 2026-03-16T13:00:29+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.
- - - - -
41 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/Utils/Binary.hs
- compiler/ghc.cabal.in
- ghc/GHCi/Leak.hs
- + testsuite/tests/bytecode/TLinkable/BCOTemplate.hs
- + testsuite/tests/bytecode/TLinkable/LinkableUsage01.stderr
- + testsuite/tests/bytecode/TLinkable/Makefile
- + testsuite/tests/bytecode/TLinkable/all.T
- + testsuite/tests/bytecode/TLinkable/genLinkables.sh
- + testsuite/tests/bytecode/TLinkable/linkable_recomp.stderr
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
- + testsuite/tests/driver/recomp022/A1.hs
- + testsuite/tests/driver/recomp022/A2.hs
- + testsuite/tests/driver/recomp022/A3.hs
- + testsuite/tests/driver/recomp022/B.hs
- + testsuite/tests/driver/recomp022/C.hs
- + testsuite/tests/driver/recomp022/Makefile
- + testsuite/tests/driver/recomp022/all.T
- + testsuite/tests/driver/recomp022/recomp022a.stdout
- + testsuite/tests/driver/recomp022/recomp022b.stdout
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6826eb62f901533c9a5e58072464f4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6826eb62f901533c9a5e58072464f4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
16 Mar '26
Magnus pushed new branch wip/mangoiv/ci-drop-ubuntu-18-20 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mangoiv/ci-drop-ubuntu-18-20
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base] Add stub documentation
by Simon Peyton Jones (＠simonpj) 16 Mar '26
by Simon Peyton Jones (＠simonpj) 16 Mar '26
16 Mar '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
9c64f63d by Simon Peyton Jones at 2026-03-16T10:38:01+00:00
Add stub documentation
Need to properly document
ImplicitKnownKeyNames
DefinesKnownKeyNames
- - - - -
1 changed file:
- docs/users_guide/exts/rebindable_syntax.rst
Changes:
=====================================
docs/users_guide/exts/rebindable_syntax.rst
=====================================
@@ -78,6 +78,16 @@ not the Prelude versions:
- An overloaded label "``#foo``" means "``fromLabel @"foo"``", rather than
"``GHC.OverloadedLabels.fromLabel @"foo"``" (see :ref:`overloaded-labels`).
+.. extension:: ImplicitKnownKeyNames
+ :shortdesc: Use module ``KnownKeyNames`` to find known-key names
+
+ ToDo: needs proper documentation
+
+.. extension:: DefinesKnownKeyNames
+ :shortdesc: This modules defines one or more known-key names
+
+ ToDo: needs proper documentation
+
:extension:`RebindableSyntax` implies :extension:`NoImplicitPrelude`.
In all cases (apart from arrow notation), the static semantics should be
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c64f63da0af76070679ff94c28b6ed…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c64f63da0af76070679ff94c28b6ed…
You're receiving this email because of your account on gitlab.haskell.org.
1
0