[Git][ghc/ghc][master] 2 commits: Make mkCast assertion a bit clearer
by Marge Bot (＠marge-bot) 04 Sep '25
by Marge Bot (＠marge-bot) 04 Sep '25
04 Sep '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
138a6e34 by sheaf at 2025-09-04T19:22:46-04:00
Make mkCast assertion a bit clearer
This commit changes the assertion message that gets printed when one
calls mkCast with a coercion whose kind does not match the type of the
inner expression. I always found the assertion message a bit confusing,
as it didn't clearly state what exactly was the error.
- - - - -
9d626be1 by sheaf at 2025-09-04T19:22:46-04:00
Simplifier/rules: fix mistakes in Notes & comments
- - - - -
4 changed files:
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Utils.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -65,8 +65,9 @@ simplifyExpr :: Logger
-> SimplifyExprOpts
-> CoreExpr
-> IO CoreExpr
--- simplifyExpr is called by the driver to simplify an
--- expression typed in at the interactive prompt
+-- ^ Simplify an expression using 'simplExprGently'.
+--
+-- See 'simplExprGently' for details.
simplifyExpr logger euc opts expr
= withTiming logger (text "Simplify [expr]") (const ()) $
do { eps <- eucEPS euc ;
@@ -94,23 +95,17 @@ simplifyExpr logger euc opts expr
}
simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
--- Simplifies an expression
--- does occurrence analysis, then simplification
--- and repeats (twice currently) because one pass
--- alone leaves tons of crud.
--- Used (a) for user expressions typed in at the interactive prompt
--- (b) the LHS and RHS of a RULE
--- (c) Template Haskell splices
+-- ^ Simplifies an expression by doing occurrence analysis, then simplification,
+-- and repeating (twice currently), because one pass alone leaves tons of crud.
+--
+-- Used only:
+--
+-- 1. for user expressions typed in at the interactive prompt (see 'GHC.Driver.Main.hscStmt'),
+-- 2. for Template Haskell splices (see 'GHC.Tc.Gen.Splice.runMeta').
--
-- The name 'Gently' suggests that the SimplMode is InitialPhase,
--- and in fact that is so.... but the 'Gently' in simplExprGently doesn't
--- enforce that; it just simplifies the expression twice
-
--- It's important that simplExprGently does eta reduction; see
--- Note [Simplify rule LHS] above. The
--- simplifier does indeed do eta reduction (it's in GHC.Core.Opt.Simplify.completeLam)
--- but only if -O is on.
-
+-- and in fact that is so.... but the 'Gently' in 'simplExprGently' doesn't
+-- enforce that; it just simplifies the expression twice.
simplExprGently env expr = do
expr1 <- simplExpr env (occurAnalyseExpr expr)
simplExpr env (occurAnalyseExpr expr1)
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -2324,9 +2324,9 @@ Wrinkles:
e |> Refl
or
e |> g1 |> g2
- because both of these will be optimised by Simplify.simplRule. In the
- former case such optimisation benign, because the rule will match more
- terms; but in the latter we may lose a binding of 'g1' or 'g2', and
+ because both of these will be optimised by GHC.Core.Opt.Simplify.Iteration.simplRules.
+ In the former case such optimisation is benign, because the rule will match
+ more terms; but in the latter we may lose a binding of 'g1' or 'g2', and
end up with a rule LHS that doesn't bind the template variables
(#10602).
=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -850,7 +850,7 @@ bound on the LHS:
RULE forall (c :: a~b). f (x |> c) = e
Now, if that binding is inlined, so that a=b=Int, we'd get
RULE forall (c :: Int~Int). f (x |> c) = e
- and now when we simplify the LHS (Simplify.simplRule) we
+ and now when we simplify the LHS (GHC.Core.Opt.Simplify.Iteration.simplRules),
optCoercion (look at the CoVarCo case) will turn that 'c' into Refl:
RULE forall (c :: Int~Int). f (x |> <Int>) = e
and then perhaps drop it altogether. Now 'c' is unbound.
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -275,11 +275,13 @@ mkCast expr co
= assertPpr (coercionRole co == Representational)
(text "coercion" <+> ppr co <+> text "passed to mkCast"
<+> ppr expr <+> text "has wrong role" <+> ppr (coercionRole co)) $
- warnPprTrace (not (coercionLKind co `eqType` exprType expr))
- "Trying to coerce" (text "(" <> ppr expr
- $$ text "::" <+> ppr (exprType expr) <> text ")"
- $$ ppr co $$ ppr (coercionType co)
- $$ callStackDoc) $
+ warnPprTrace (not (coercionLKind co `eqType` exprType expr)) "Bad cast"
+ (vcat [ text "Coercion LHS kind does not match enclosed expression type"
+ , text "co:" <+> ppr co
+ , text "coercionLKind:" <+> ppr (coercionLKind co)
+ , text "exprType:" <+> ppr (exprType expr)
+ , text "expr:" <+> ppr expr
+ , callStackDoc ]) $
case expr of
Cast expr co2 -> mkCast expr (mkTransCo co2 co)
Tick t expr -> Tick t (mkCast expr co)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46bb9a7985557818ee2a031f6a0fde…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46bb9a7985557818ee2a031f6a0fde…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 2 commits: hadrian: Pass lib & include directories to ghc `Setup configure`
by Marge Bot (＠marge-bot) 04 Sep '25
by Marge Bot (＠marge-bot) 04 Sep '25
04 Sep '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
41a448e5 by Ben Gamari at 2025-09-04T19:21:43-04:00
hadrian: Pass lib & include directories to ghc `Setup configure`
- - - - -
46bb9a79 by Ben Gamari at 2025-09-04T19:21:44-04:00
rts/IPE: Fix compilation when zstd is enabled
This was broken by the refactoring undertaken in
c80dd91c0bf6ac034f0c592f16c548b9408a8481.
Closes #26312.
- - - - -
2 changed files:
- hadrian/src/Settings/Packages.hs
- rts/IPE.c
Changes:
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -36,6 +36,8 @@ packageArgs = do
cursesLibraryDir <- getSetting CursesLibDir
ffiIncludeDir <- getSetting FfiIncludeDir
ffiLibraryDir <- getSetting FfiLibDir
+ libzstdIncludeDir <- getSetting LibZstdIncludeDir
+ libzstdLibraryDir <- getSetting LibZstdLibDir
stageVersion <- readVersion <$> (expr $ ghcVersionStage stage)
mconcat
@@ -74,7 +76,9 @@ packageArgs = do
, builder (Cabal Setup) ? mconcat
[ arg "--disable-library-for-ghci"
, anyTargetOs [OSOpenBSD] ? arg "--ld-options=-E"
- , compilerStageOption ghcProfiled ? arg "--ghc-pkg-option=--force" ]
+ , compilerStageOption ghcProfiled ? arg "--ghc-pkg-option=--force"
+ , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir
+ ]
, builder (Cabal Flags) ? mconcat
-- For the ghc library, internal-interpreter only makes
=====================================
rts/IPE.c
=====================================
@@ -313,38 +313,41 @@ void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node) {
barf("An IPE buffer list node has been compressed, but the "
"decompression library (zstd) is not available.");
#else
+ // Decompress string table
size_t compressed_sz = ZSTD_findFrameCompressedSize(
- node->string_table,
+ node->string_table_block->string_table,
node->string_table_size
);
- char *decompressed_strings = stgMallocBytes(
- node->string_table_size,
+ IpeStringTableBlock *decompressed_strings = stgMallocBytes(
+ sizeof(IpeStringTableBlock) + node->string_table_size,
"updateIpeMap: decompressed_strings"
);
+ decompressed_strings->magic = IPE_MAGIC_WORD;
ZSTD_decompress(
- decompressed_strings,
+ decompressed_strings->string_table,
node->string_table_size,
- node->string_table,
+ node->string_table_block->string_table,
compressed_sz
);
- node->string_table = (const char *) decompressed_strings;
+ node->string_table_block = decompressed_strings;
// Decompress the IPE data
compressed_sz = ZSTD_findFrameCompressedSize(
- node->entries,
+ node->entries_block->entries,
node->entries_size
);
- void *decompressed_entries = stgMallocBytes(
- node->entries_size,
+ IpeBufferEntryBlock *decompressed_entries = stgMallocBytes(
+ sizeof(IpeBufferEntryBlock) + node->entries_size,
"updateIpeMap: decompressed_entries"
);
+ decompressed_entries->magic = IPE_MAGIC_WORD;
ZSTD_decompress(
- decompressed_entries,
+ decompressed_entries->entries,
node->entries_size,
- node->entries,
+ node->entries_block->entries,
compressed_sz
);
- node->entries = decompressed_entries;
+ node->entries_block = decompressed_entries;
#endif // HAVE_LIBZSTD == 0
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdf82fd2bc70f21d9c8a9d535afab4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdf82fd2bc70f21d9c8a9d535afab4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/backports-9.14] debugger: Uniquely identify breakpoints by internal id
by Ben Gamari (＠bgamari) 04 Sep '25
by Ben Gamari (＠bgamari) 04 Sep '25
04 Sep '25
Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
Commits:
ba0dd3db by Rodrigo Mesquita at 2025-09-04T15:47:01-04:00
debugger: Uniquely identify breakpoints by internal id
Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.
- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
the source of a module by using the Tick index. A Tick index can index
into ModBreaks.modBreaks_xxx to fetch source-level information about
where that tick originated.
- When a user specifies e.g. a line breakpoint using :break, we'll reverse
engineer what a Tick index for that line
- We update the `BreakArray` of that module (got from the
LoaderState) at that tick index to `breakOn`.
- A BCO we can stop at is headed by a BRK_FUN instruction. This
instruction stores in an operand the `tick index` it is associated
to. We look it up in the associated `BreakArray` (also an operand)
and check wheter it was set to `breakOn`.
- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
`InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
-- the information we gathered during code generation about the
existing breakpoint *ocurrences*.
- Note that with optimisation there may be many occurrences of the
same source-tick-breakpoint across different modules. The
`ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
shared. See Note [Breakpoint identifiers] about this.
- Note that besides the tick ids, info ids are also stored in
`BRK_FUN` so the break handler can refer to the associated
`CgBreakInfo`.
In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:
- An InternalBreakpointId should uniquely identify a breakpoint just
from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
not the tick-level id.
So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
BreakpointId
That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).
Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).
Se also the new Note [ModBreaks vs InternalModBreaks]
On i386-linux:
-------------------------
Metric Decrease:
interpreter_steplocal
-------------------------
(cherry picked from commit 083e40f1ea7fa13faac282456c357a8541e8e6bd)
- - - - -
20 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -841,24 +841,18 @@ assembleI platform i = case i of
W8 -> emit_ bci_OP_INDEX_ADDR_08 []
_ -> unsupported_width
- BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
+ BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
+ p1 <- ptr $ BCOPtrBreakArray info_mod
let -- cast that checks that round-tripping through Word16 doesn't change the value
toW16 x = let r = fromIntegral x :: Word16
in if fromIntegral r == x
then r
else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- p1 <- ptr $ BCOPtrBreakArray tick_mod
- tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
- info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
- tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
- info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
- np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
- emit_ bci_BRK_FUN [ Op p1
- , Op tick_addr, Op info_addr
- , Op tick_unitid_addr, Op info_unitid_addr
- , SmallOp (toW16 tickx), SmallOp (toW16 infox)
- , Op np
- ]
+ info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
+ info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
+ np <- lit1 $ BCONPtrCostCentre ibi
+ emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
+ , SmallOp (toW16 infox), Op np ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -7,23 +7,23 @@
-- 'InternalModBreaks', and is uniquely identified at runtime by an
-- 'InternalBreakpointId'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.ByteCode.Breakpoints
( -- * Internal Mod Breaks
InternalModBreaks(..), CgBreakInfo(..)
- , mkInternalModBreaks
+ , mkInternalModBreaks, imodBreaks_module
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
-- * Operations
- , toBreakpointId
-- ** Internal-level operations
- , getInternalBreak, addInternalBreak
+ , getInternalBreak
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
+ , getBreakSourceId
-- * Utils
, seqInternalModBreaks
@@ -47,6 +47,31 @@ import GHC.Utils.Panic
import Data.Array
{-
+Note [ModBreaks vs InternalModBreaks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'ModBreaks' and 'BreakpointId's must not to be confused with
+'InternalModBreaks' and 'InternalBreakId's.
+
+'ModBreaks' is constructed once during HsToCore from the information attached
+to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
+can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
+within the list of breakpoint information for a given module's 'ModBreaks'.
+
+'InternalModBreaks' are constructed during bytecode generation and are indexed
+by a 'InternalBreakpointId'. They contain all the information relevant to a
+breakpoint for code generation that can be accessed during runtime execution
+(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
+are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
+instruction receives 'InternalBreakpointId' as an argument.
+
+We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
+to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
+
+Notably, 'InternalModBreaks' can contain entries for so-called internal
+breakpoints, which do not necessarily have a source-level location attached to
+it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
+introduce breakpoints during code generation for features such as stepping-out.
+
Note [Breakpoint identifiers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before optimization a breakpoint is identified uniquely with a tick module
@@ -64,6 +89,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
we store it alongside the occurrence module (*info module*) in the
'InternalBreakpointId' datatype. This is the index that we use at runtime to
identify a breakpoint.
+
+When the internal breakpoint has a matching tick-level breakpoint we can fetch
+the related tick-level information by first looking up a mapping
+@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@.
-}
--------------------------------------------------------------------------------
@@ -78,19 +107,11 @@ type BreakInfoIndex = Int
-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
-- See Note [Breakpoint identifiers]
data InternalBreakpointId = InternalBreakpointId
- { ibi_tick_mod :: !Module -- ^ Breakpoint tick module
- , ibi_tick_index :: !Int -- ^ Breakpoint tick index
- , ibi_info_mod :: !Module -- ^ Breakpoint tick module
- , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
+ { ibi_info_mod :: !Module -- ^ Breakpoint info module
+ , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint info index
}
deriving (Eq, Ord)
-toBreakpointId :: InternalBreakpointId -> BreakpointId
-toBreakpointId ibi = BreakpointId
- { bi_tick_mod = ibi_tick_mod ibi
- , bi_tick_index = ibi_tick_index ibi
- }
-
--------------------------------------------------------------------------------
-- * Internal Mod Breaks
--------------------------------------------------------------------------------
@@ -107,18 +128,34 @@ data InternalModBreaks = InternalModBreaks
-- 'InternalBreakpointId'.
, imodBreaks_modBreaks :: !ModBreaks
- -- ^ Store the original ModBreaks for this module, unchanged.
- -- Allows us to query about source-level breakpoint information using
- -- an internal breakpoint id.
+ -- ^ Store the ModBreaks for this module
+ --
+ -- Recall Note [Breakpoint identifiers]: for some module A, an
+ -- *occurrence* of a breakpoint in A may have been inlined from some
+ -- breakpoint *defined* in module B.
+ --
+ -- This 'ModBreaks' contains information regarding all the breakpoints
+ -- defined in the module this 'InternalModBreaks' corresponds to. It
+ -- /does not/ necessarily have information regarding all the breakpoint
+ -- occurrences registered in 'imodBreaks_breakInfo'. Some of those
+ -- occurrences may refer breakpoints inlined from other modules.
}
--- | Construct an 'InternalModBreaks'
+-- | Construct an 'InternalModBreaks'.
+--
+-- INVARIANT: The given 'ModBreaks' correspond to the same module as this
+-- 'InternalModBreaks' module (the first argument) and its breakpoint infos
+-- (the @IntMap CgBreakInfo@ argument)
mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
mkInternalModBreaks mod im mbs =
assertPpr (mod == modBreaks_module mbs)
(text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
InternalModBreaks im mbs
+-- | Get the module to which these 'InternalModBreaks' correspond
+imodBreaks_module :: InternalModBreaks -> Module
+imodBreaks_module = modBreaks_module . imodBreaks_modBreaks
+
-- | Information about a breakpoint that we know at code-generation time
-- In order to be used, this needs to be hydrated relative to the current HscEnv by
-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
@@ -128,20 +165,22 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
+ , cgb_tick_id :: !BreakpointId
+ -- ^ This field records the original breakpoint tick identifier for this
+ -- internal breakpoint info. It is used to convert a breakpoint
+ -- *occurrence* index ('InternalBreakpointId') into a *definition* index
+ -- ('BreakpointId').
+ --
+ -- The modules of breakpoint occurrence and breakpoint definition are not
+ -- necessarily the same: See Note [Breakpoint identifiers].
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
-getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imodBreaks_breakInfo imbs IM.! info_ix
-
--- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
-addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
-addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
+getInternalBreak (InternalBreakpointId mod ix) imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imodBreaks_breakInfo imbs IM.! ix
-- | Assert that the module in the 'InternalBreakpointId' and in
-- 'InternalModBreaks' match.
@@ -155,27 +194,56 @@ assert_modules_match ibi_mod imbs_mod =
-- Tick-level Breakpoint information
--------------------------------------------------------------------------------
+-- | Get the source module and tick index for this breakpoint
+-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in cgb_tick_id cgb
+
-- | Get the source span for this breakpoint
-getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
+getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
getBreakLoc = getBreakXXX modBreaks_locs
-- | Get the vars for this breakpoint
-getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName]
+getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
getBreakVars = getBreakXXX modBreaks_vars
-- | Get the decls for this breakpoint
-getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
+getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
getBreakDecls = getBreakXXX modBreaks_decls
-- | Get the decls for this breakpoint
-getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
getBreakCCS = getBreakXXX modBreaks_ccs
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
-getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
- assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
- view (imodBreaks_modBreaks imbs) ! tick_id
+--
+-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the
+-- *occurrence* module) doesn't necessarily match the module where the
+-- tick breakpoint was defined with the relevant 'ModBreaks'.
+--
+-- When the tick module is the same as the internal module, we use the stored
+-- 'ModBreaks'. When the tick module is different, we need to look up the
+-- 'ModBreaks' in the HUG for that other module.
+--
+-- To avoid cyclic dependencies, we instead receive a function that looks up
+-- the 'ModBreaks' given a 'Module'
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ case cgb_tick_id cgb of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == ibi_mod
+ -> do
+ let these_mbs = imodBreaks_modBreaks imbs
+ return $ view these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- lookupModule bi_tick_mod
+ return $ view other_mbs ! bi_tick_index
--------------------------------------------------------------------------------
-- Instances
@@ -190,7 +258,8 @@ seqInternalModBreaks InternalModBreaks{..} =
seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_tyvars `seq`
rnf cgb_vars `seq`
- rnf cgb_resty
+ rnf cgb_resty `seq`
+ rnf cgb_tick_id
instance Outputable InternalBreakpointId where
ppr InternalBreakpointId{..} =
@@ -203,4 +272,5 @@ instance NFData InternalBreakpointId where
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
parens (ppr (cgb_vars info) <+>
- ppr (cgb_resty info))
+ ppr (cgb_resty info) <+>
+ ppr (cgb_tick_id info))
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -454,9 +454,8 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
+ ppr (BRK_FUN (InternalBreakpointId info_mod infox))
= text "BRK_FUN" <+> text "<breakarray>"
- <+> ppr tick_mod <+> ppr tickx
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -98,9 +98,9 @@ lookupLiteral interp pkgs_loaded le lb ptr = case ptr of
BCONPtrFFIInfo (FFIInfo {..}) -> do
RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
pure $ fromIntegral p
- BCONPtrCostCentre BreakpointId{..}
+ BCONPtrCostCentre InternalBreakpointId{..}
| interpreterProfiled interp -> do
- case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of
+ case expectJust (lookupModuleEnv (ccs_env lb) ibi_info_mod) ! ibi_info_index of
RemotePtr p -> pure $ fromIntegral p
| otherwise ->
case toRemotePtr nullPtr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -285,7 +285,7 @@ data BCONPtr
-- | A libffi ffi_cif function prototype.
| BCONPtrFFIInfo !FFIInfo
-- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
- | BCONPtrCostCentre !BreakpointId
+ | BCONPtrCostCentre !InternalBreakpointId
instance NFData BCONPtr where
rnf x = x `seq` ()
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
-dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
, cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
, cgb_resty = toIfaceType tick_ty
+ , cgb_tick_id = bid
}
{- Note [Inlining and hs-boot files]
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -12,7 +12,7 @@
-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
( -- * ModBreaks
mkModBreaks, ModBreaks(..)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -124,7 +124,9 @@ import GHC.Utils.Exception
import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
import GHC.Driver.Downsweep
import qualified GHC.Runtime.Interpreter as GHCi
-import Data.Array.Base (numElements)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map.Strict as M
+import Foreign.Ptr (nullPtr)
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1666,10 +1668,10 @@ allocateBreakArrays ::
IO (ModuleEnv (ForeignRef BreakArray))
allocateBreakArrays interp =
foldlM
- ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
+ ( \be0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks {..}} -> do
-- If no BreakArray is assigned to this module yet, create one
if not $ elemModuleEnv modBreaks_module be0 then do
- let count = numElements modBreaks_locs
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
breakArray <- GHCi.newBreakArray interp count
evaluate $ extendModuleEnv be0 modBreaks_module breakArray
else
@@ -1679,29 +1681,51 @@ allocateBreakArrays interp =
-- | Given a list of 'InternalModBreaks' collected from a list
-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
-- enabled.
+--
+-- Note that the resulting arrays are indexed by 'BreakInfoIndex' (internal
+-- breakpoint index), not by tick index
allocateCCS ::
Interp ->
- ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
+ ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)) ->
[InternalModBreaks] ->
- IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
+ IO (ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)))
allocateCCS interp ce mbss
- | interpreterProfiled interp =
- foldlM
- ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
- ccs <-
+ | interpreterProfiled interp = do
+ -- 1. Create a mapping from source BreakpointId to CostCentre ptr
+ ccss <- M.unions <$> mapM
+ ( \InternalModBreaks{imodBreaks_modBreaks=ModBreaks{..}} -> do
+ ccs <- {- one ccs ptr per tick index -}
mkCostCentres
interp
(moduleNameString $ moduleName modBreaks_module)
(elems modBreaks_ccs)
- if not $ elemModuleEnv modBreaks_module ce0 then do
- evaluate $
- extendModuleEnv ce0 modBreaks_module $
- listArray
- (0, length ccs - 1)
- ccs
+ return $ M.fromList $
+ zipWith (\el ix -> (BreakpointId modBreaks_module ix, el)) ccs [0..]
+ )
+ mbss
+ -- 2. Create an array with one element for every InternalBreakpointId,
+ -- where every element has the CCS for the corresponding BreakpointId
+ foldlM
+ (\ce0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks{..}} -> do
+ if not $ elemModuleEnv modBreaks_module ce then do
+ let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
+ let ccs = IM.map
+ (\info ->
+ fromMaybe (toRemotePtr nullPtr)
+ (M.lookup (cgb_tick_id info) ccss)
+ )
+ imodBreaks_breakInfo
+ assertPpr (count == length ccs)
+ (text "expected CgBreakInfo map to have one entry per valid ix") $
+ evaluate $
+ extendModuleEnv ce0 modBreaks_module $
+ listArray
+ (0, count)
+ (IM.elems ccs)
else
return ce0
)
ce
mbss
+
| otherwise = pure ce
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -31,6 +31,9 @@ import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
+import qualified Data.IntMap.Strict as IntMap
+import qualified GHC.Unit.Home.Graph as HUG
+import qualified GHC.Unit.Home.PackageTable as HPT
--------------------------------------------------------------------------------
-- Finding Module breakpoints
@@ -213,6 +216,47 @@ getModBreak m = do
mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
+--------------------------------------------------------------------------------
+-- Mapping source-level BreakpointIds to IBI occurrences
+-- (See Note [Breakpoint identifiers])
+--------------------------------------------------------------------------------
+
+-- | A source-level breakpoint may have been inlined into many occurrences, now
+-- referred by 'InternalBreakpointId'. When a breakpoint is set on a certain
+-- source breakpoint, it means all *ocurrences* of that breakpoint across
+-- modules should be stopped at -- hence we keep a trie from BreakpointId to
+-- the list of internal break ids using it.
+-- See also Note [Breakpoint identifiers]
+type BreakpointOccurrences = ModuleEnv (IntMap.IntMap [InternalBreakpointId])
+
+-- | Lookup all InternalBreakpointIds matching the given BreakpointId
+-- Nothing if BreakpointId not in map
+lookupBreakpointOccurrences :: BreakpointOccurrences -> BreakpointId -> Maybe [InternalBreakpointId]
+lookupBreakpointOccurrences bmp (BreakpointId md tick) =
+ lookupModuleEnv bmp md >>= IntMap.lookup tick
+
+-- | Construct a mapping from Source 'BreakpointId's to 'InternalBreakpointId's from the given list of 'ModInfo's
+mkBreakpointOccurrences :: forall m. GhcMonad m => m BreakpointOccurrences
+mkBreakpointOccurrences = do
+ hug <- hsc_HUG <$> getSession
+ liftIO $ foldr go (pure emptyModuleEnv) hug
+ where
+ go :: HUG.HomeUnitEnv -> IO BreakpointOccurrences -> IO BreakpointOccurrences
+ go hue mbmp = do
+ bmp <- mbmp
+ ibrkss <- HPT.concatHpt (\hmi -> maybeToList (getModBreaks hmi))
+ (HUG.homeUnitEnv_hpt hue)
+ return $ foldr addBreakToMap bmp ibrkss
+
+ addBreakToMap :: InternalModBreaks -> BreakpointOccurrences -> BreakpointOccurrences
+ addBreakToMap ibrks bmp0 = do
+ let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
+ IntMap.foldrWithKey (\info_ix cgi bmp -> do
+ let ibi = InternalBreakpointId imod info_ix
+ let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
+ extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ ) bmp0 (imodBreaks_breakInfo ibrks)
+
--------------------------------------------------------------------------------
-- Getting current breakpoint information
--------------------------------------------------------------------------------
@@ -235,9 +279,15 @@ getCurrentBreakSpan = do
getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
resumes <- getResumeContext
- return $ case resumes of
- [] -> Nothing
+ hug <- hsc_HUG <$> getSession
+ liftIO $ case resumes of
+ [] -> pure Nothing
(r:_) -> case resumeHistoryIx r of
- 0 -> ibi_tick_mod <$> resumeBreakpointId r
- ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
+ 0 -> case resumeBreakpointId r of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ brks <- readIModBreaks hug ibi
+ return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ ix ->
+ Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -18,7 +18,7 @@ module GHC.Runtime.Eval (
abandon, abandonAll,
getResumeContext,
getHistorySpan,
- getModBreaks, readModBreaks,
+ getModBreaks, readIModBreaks, readIModModBreaks,
getHistoryModule,
setupBreakpoint,
back, forward,
@@ -147,14 +147,17 @@ getResumeContext = withSession (return . ic_resume . hsc_IC)
mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History
mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
-getHistoryModule :: History -> Module
-getHistoryModule = ibi_tick_mod . historyBreakpointId
+getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
+getHistoryModule hug hist = do
+ let ibi = historyBreakpointId hist
+ brks <- readIModBreaks hug ibi
+ return $ bi_tick_mod $ getBreakSourceId ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
let ibi = historyBreakpointId hist
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -162,8 +165,8 @@ getHistorySpan hug hist = do
-- for each tick.
findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
findEnclosingDecls hug ibi = do
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakDecls ibi brks
+ brks <- readIModBreaks hug ibi
+ getBreakDecls (readIModModBreaks hug) ibi brks
-- | Update fixity environment in the current interactive context.
updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -350,15 +353,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
let ibi = evalBreakpointToId eval_break
let hug = hsc_HUG hsc_env
- tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
- let
- span = getBreakLoc ibi tick_brks
- decl = intercalate "." $ getBreakDecls ibi tick_brks
+ info_brks <- liftIO $ readIModBreaks hug ibi
+ span <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
+ decl <- liftIO $ intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
bactive <- liftIO $ do
- breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
- breakpointStatus interp breakArray (ibi_tick_index ibi)
+ breakArray <- getBreakArray interp ibi info_brks
+ breakpointStatus interp breakArray (ibi_info_index ibi)
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -446,7 +448,7 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
+ (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
_ -> return ()
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
@@ -462,17 +464,18 @@ resumeExec step mbCnt
| otherwise -> pure prevHistoryLst
handleRunStatus step expr bindings final_ids status =<< hist'
-setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157
-setupBreakpoint interp bi cnt = do
+setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157
+setupBreakpoint interp ibi cnt = do
hug <- hsc_HUG <$> getSession
- modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
- breakArray <- liftIO $ getBreakArray interp bi modBreaks
- liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
+ liftIO $ do
+ modBreaks <- readIModBreaks hug ibi
+ breakArray <- getBreakArray interp ibi modBreaks
+ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
-getBreakArray :: Interp -> BreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
-getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
+getBreakArray :: Interp -> InternalBreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
+getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
breaks0 <- linked_breaks . fromMaybe (panic "Loader not initialised") <$> getLoaderState interp
- case lookupModuleEnv (breakarray_env breaks0) bi_tick_mod of
+ case lookupModuleEnv (breakarray_env breaks0) ibi_info_mod of
Just ba -> return ba
Nothing -> do
modifyLoaderState interp $ \ld_st -> do
@@ -483,13 +486,12 @@ getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs]
let ld_st' = ld_st { linked_breaks = lb{breakarray_env = ba_env} }
- let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env bi_tick_mod
+ let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env ibi_info_mod
return
( ld_st'
, ba
)
-
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
back n = moveHist (+n)
@@ -517,8 +519,9 @@ moveHist fn = do
span <- case mb_info of
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just ibi -> liftIO $ do
- brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ let hug = hsc_HUG hsc_env
+ brks <- readIModBreaks hug ibi
+ getBreakLoc (readIModModBreaks hug) ibi brks
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
let ic = hsc_IC hsc_env1
@@ -579,11 +582,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
-- of the breakpoint and the free variables of the expression.
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
let hug = hsc_HUG hsc_env
- info_brks <- readModBreaks hug (ibi_info_mod ibi)
- tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
- let info = getInternalBreak ibi (info_brks)
+ info_brks <- readIModBreaks hug ibi
+ let info = getInternalBreak ibi info_brks
interp = hscInterp hsc_env
- occs = getBreakVars ibi tick_brks
+ occs <- getBreakVars (readIModModBreaks hug) ibi info_brks
-- Rehydrate to understand the breakpoint info relative to the current environment.
-- This design is critical to preventing leaks (#22530)
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -27,7 +27,9 @@ module GHC.Runtime.Interpreter
, getClosure
, whereFrom
, getModBreaks
- , readModBreaks
+ , readIModBreaks
+ , readIModBreaksMaybe
+ , readIModModBreaks
, seqHValue
, evalBreakpointToId
@@ -92,7 +94,6 @@ import GHC.Utils.Fingerprint
import GHC.Unit.Module
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
@@ -411,15 +412,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
evalBreakpointToId eval_break =
let
mkUnitId u = fsToUnit $ mkFastStringShortByteString u
-
toModule u n = mkModule (mkUnitId u) (mkModuleName n)
- tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
- infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
in
InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
+ { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
, ibi_info_index = eb_info_index eval_break
}
@@ -440,17 +436,18 @@ handleSeqHValueStatus interp unit_env eval_status =
-- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
Just break -> do
- let bi = evalBreakpointToId break
+ let ibi = evalBreakpointToId break
+ hug = ue_home_unit_graph unit_env
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
- mb_modbreaks <- getModBreaks . expectJust <$>
- lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
+ mb_modbreaks <- readIModBreaksMaybe hug (ibi_info_mod ibi)
case mb_modbreaks of
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
+ Just modbreaks -> put . brackets . ppr =<<
+ getBreakLoc (readIModModBreaks hug) ibi modbreaks
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -745,10 +742,18 @@ getModBreaks hmi
| otherwise
= Nothing -- probably object code
--- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
--- from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
-readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
+-- | Read the 'InternalModBreaks' of the given home 'Module' (via
+-- 'InternalBreakpointId') from the 'HomeUnitGraph'.
+readIModBreaks :: HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
+readIModBreaks hug ibi = expectJust <$> readIModBreaksMaybe hug (ibi_info_mod ibi)
+
+-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
+readIModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks)
+readIModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+
+-- | Read the 'ModBreaks' from the given module's 'InternalModBreaks'
+readIModModBreaks :: HUG.HomeUnitGraph -> Module -> IO ModBreaks
+readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaksMaybe hug mod
-- -----------------------------------------------------------------------------
-- Misc utils
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.Cmm.Utils
import GHC.Platform
import GHC.Platform.Profile
-import GHC.Runtime.Interpreter
import GHCi.FFI
import GHC.Types.Basic
import GHC.Utils.Outputable
@@ -64,6 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
+import GHC.Runtime.Interpreter ( interpreterProfiled )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -79,7 +79,6 @@ import Control.Monad
import Data.Char
import GHC.Unit.Module
-import qualified GHC.Unit.Home.Graph as HUG
import Data.Coerce (coerce)
#if MIN_VERSION_rts(1,0,3)
@@ -394,65 +393,28 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
- hsc_env <- getHscEnv
- current_mod <- getCurrentModule
mb_current_mod_breaks <- getCurrentModBreaks
case mb_current_mod_breaks of
-- if we're not generating ModBreaks for this module for some reason, we
-- can't store breakpoint occurrence information.
Nothing -> pure code
- Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
- Nothing -> pure code
- Just ModBreaks{modBreaks_module = tick_mod} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
+ Just current_mod_breaks -> do
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+ let info_mod = modBreaks_module current_mod_breaks
+ infox <- newBreakInfo breakInfo
- let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
- return $ breakInstr `consOL` code
+ let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
+ return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
--- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
--- from which the breakpoint originates.
--- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
--- to refer to pointers in GHCi's address space.
--- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
--- 'GHC.HsToCore.deSugar'.
---
--- Breakpoints might be disabled because we're in TH, because
--- @-fno-break-points@ was specified, or because a module was reloaded without
--- reinitializing 'ModBreaks'.
---
--- If the module stored in the breakpoint is the currently processed module, use
--- the 'ModBreaks' from the state.
--- If that is 'Nothing', consider breakpoints to be disabled and skip the
--- instruction.
---
--- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
--- If the module doesn't exist there, or if the 'ModBreaks' value is
--- uninitialized, skip the instruction (i.e. return Nothing).
-break_info ::
- HscEnv ->
- Module ->
- Module ->
- Maybe ModBreaks ->
- BcM (Maybe ModBreaks)
-break_info hsc_env mod current_mod current_mod_breaks
- | mod == current_mod
- = pure current_mod_breaks
- | otherwise
- = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
- Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
- Nothing -> pure Nothing
-
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
getVarOffSets platform depth env = map getOffSet
where
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -68,7 +68,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
Resume, SingleStep, Ghc,
GetDocsFailure(..), pushLogHookM,
getModuleGraph, handleSourceError,
- InternalBreakpointId(..) )
+ BreakpointId(..) )
import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
@@ -546,6 +546,7 @@ interactiveUI config srcs maybe_exprs = do
break_ctr = 0,
breaks = IntMap.empty,
tickarrays = emptyModuleEnv,
+ internalBreaks = emptyModuleEnv,
ghci_commands = availableCommands config,
ghci_macros = [],
last_command = Nothing,
@@ -1616,13 +1617,15 @@ toBreakIdAndLocation :: GhciMonad m
toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
st <- getGHCiState
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug inf
+ let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == ibi_tick_mod inf,
- breakTick loc == ibi_tick_index inf ]
+ breakId loc == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
- printForUser $ pprStopped res
+ printForUser =<< pprStopped res
-- printTypeOfNames session names
let namesSorted = sortBy compareNames names
tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
@@ -3804,22 +3807,32 @@ showBkptTable = do
showContext :: GHC.GhcMonad m => m ()
showContext = do
resumes <- GHC.getResumeContext
- printForUser $ vcat (map pp_resume (reverse resumes))
+ docs <- mapM pp_resume (reverse resumes)
+ printForUser $ vcat docs
where
- pp_resume res =
- text "--> " <> text (GHC.resumeStmt res)
- $$ nest 2 (pprStopped res)
-
-pprStopped :: GHC.Resume -> SDoc
-pprStopped res =
- text "Stopped in"
- <+> ((case mb_mod_name of
- Nothing -> empty
- Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
- <> text (GHC.resumeDecl res))
- <> char ',' <+> ppr (GHC.resumeSpan res)
- where
- mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
+ pp_resume res = do
+ stopped <- pprStopped res
+ return $
+ text "--> " <> text (GHC.resumeStmt res)
+ $$ nest 2 stopped
+
+pprStopped :: GHC.GhcMonad m => GHC.Resume -> m SDoc
+pprStopped res = do
+ let mibi = GHC.resumeBreakpointId res
+ mb_mod_name <- case mibi of
+ Nothing -> pure Nothing
+ Just ibi -> do
+ hug <- hsc_HUG <$> GHC.getSession
+ brks <- liftIO $ readIModBreaks hug ibi
+ return $ Just $ moduleName $
+ bi_tick_mod $ getBreakSourceId ibi brks
+ return $
+ text "Stopped in"
+ <+> ((case mb_mod_name of
+ Nothing -> empty
+ Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
+ <> text (GHC.resumeDecl res))
+ <> char ',' <+> ppr (GHC.resumeSpan res)
showUnits :: GHC.GhcMonad m => m ()
showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4373,12 +4386,8 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
result <- ignoreSwitch (words argLine)
case result of
Left sdoc -> printForUser sdoc
- Right (loc, count) -> do
- let bi = GHC.BreakpointId
- { bi_tick_mod = breakModule loc
- , bi_tick_index = breakTick loc
- }
- setupBreakpoint bi count
+ Right (loc, count) -> do
+ setupBreakpoint (breakId loc) count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4395,10 +4404,13 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
-setupBreakpoint loc count = do
+setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m ()
+setupBreakpoint bi count = do
hsc_env <- GHC.getSession
- GHC.setupBreakpoint (hscInterp hsc_env) loc count
+ -- Trigger all internal breaks that match this source break id
+ internal_break_ids <- getInternalBreaksOf bi
+ forM_ internal_break_ids $ \ibi -> do
+ GHC.setupBreakpoint (hscInterp hsc_env) ibi count
backCmd :: GhciMonad m => String -> m ()
backCmd arg
@@ -4489,20 +4501,20 @@ findBreakAndSet md lookupTickTree = do
some -> mapM_ breakAt some
where
breakAt (tick, pan) = do
- setBreakFlag md tick True
- (alreadySet, nm) <-
- recordBreak $ BreakLocation
- { breakModule = md
- , breakLoc = RealSrcSpan pan Strict.Nothing
- , breakTick = tick
- , onBreakCmd = ""
- , breakEnabled = True
- }
- printForUser $
- text "Breakpoint " <> ppr nm <>
- if alreadySet
- then text " was already set at " <> ppr pan
- else text " activated at " <> ppr pan
+ let bi = BreakpointId md tick
+ setBreakFlag bi True
+ (alreadySet, nm) <-
+ recordBreak $ BreakLocation
+ { breakLoc = RealSrcSpan pan Strict.Nothing
+ , breakId = bi
+ , onBreakCmd = ""
+ , breakEnabled = True
+ }
+ printForUser $
+ text "Breakpoint " <> ppr nm <>
+ if alreadySet
+ then text " was already set at " <> ppr pan
+ else text " activated at " <> ppr pan
-- For now, use ANSI bold on terminals that we know support it.
-- Otherwise, we add a line of carets under the active expression instead.
@@ -4749,14 +4761,32 @@ turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff onOff loc
| onOff == breakEnabled loc = return loc
| otherwise = do
- setBreakFlag (breakModule loc) (breakTick loc) onOff
+ setBreakFlag (breakId loc) onOff
return loc { breakEnabled = onOff }
-setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag md ix enaDisa = do
+setBreakFlag :: GhciMonad m => GHC.BreakpointId -> Bool -> m ()
+setBreakFlag (BreakpointId md ix) enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (BreakpointId md ix) $ enaDisaToCount enaDisa
+
+-- --------------------------------------------------------------------------
+-- Find matching Internal Breakpoints
+
+-- | Find all the internal breakpoints that use the given source-level breakpoint id
+getInternalBreaksOf :: GhciMonad m => BreakpointId -> m [InternalBreakpointId]
+getInternalBreaksOf bi = do
+ st <- getGHCiState
+ let ibrks = internalBreaks st
+ case lookupBreakpointOccurrences ibrks bi of
+ Just bs -> return bs
+ Nothing -> do
+ -- Refresh the internal breakpoints map
+ bs <- mkBreakpointOccurrences
+ setGHCiState st{internalBreaks = bs}
+ return $
+ fromMaybe [] {- still not found after refresh -} $
+ lookupBreakpointOccurrences bs bi
-- ---------------------------------------------------------------------------
-- User code exception handling
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -100,6 +100,14 @@ data GHCiState = GHCiState
-- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
-- so that we don't rebuild it each time the user sets
-- a breakpoint.
+
+ internalBreaks :: BreakpointOccurrences,
+ -- ^ Keep a mapping from the source-level 'BreakpointId' to the
+ -- occurrences of that breakpoint across modules.
+ -- When we want to stop at a source 'BreakpointId', we essentially
+ -- trigger a breakpoint for all 'InternalBreakpointId's matching
+ -- the same source-id.
+
ghci_commands :: [Command],
-- ^ available ghci commands
ghci_macros :: [Command],
@@ -238,16 +246,15 @@ data LocalConfigBehaviour
data BreakLocation
= BreakLocation
- { breakModule :: !GHC.Module
- , breakLoc :: !SrcSpan
- , breakTick :: {-# UNPACK #-} !Int
+ { breakLoc :: !SrcSpan
+ , breakId :: !GHC.BreakpointId
+ -- ^ The 'BreakpointId' uniquely identifies a source-level breakpoint
, breakEnabled:: !Bool
, onBreakCmd :: String
}
instance Eq BreakLocation where
- loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
- breakTick loc1 == breakTick loc2
+ loc1 == loc2 = breakId loc1 == breakId loc2
prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
prettyLocations locs =
@@ -256,7 +263,7 @@ prettyLocations locs =
False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
instance Outputable BreakLocation where
- ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
+ ppr loc = (ppr $ GHC.bi_tick_mod $ breakId loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
if null (onBreakCmd loc)
then empty
else doubleQuotes (text (onBreakCmd loc))
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
--------------------------------------------------------------------------------
type BreakpointCallback
- = Addr# -- pointer to the breakpoint tick module name
- -> Addr# -- pointer to the breakpoint tick module unit id
- -> Int# -- breakpoint tick index
- -> Addr# -- pointer to the breakpoint info module name
+ = Addr# -- pointer to the breakpoint info module name
-> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -418,10 +418,7 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
+ { eb_info_mod :: String -- ^ Breakpoint info module
, eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
, eb_info_index :: Int -- ^ Breakpoint info index
}
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -345,7 +345,7 @@ withBreakAction opts breakMVar statusMVar mtid act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
+ onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -358,11 +358,9 @@ withBreakAction opts breakMVar statusMVar mtid act
if is_exception
then pure Nothing
else do
- tick_mod <- peekCString (Ptr tick_mod#)
- tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
- pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
+ pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -409,8 +407,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
=====================================
rts/Disassembler.c
=====================================
@@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc )
switch (instr & 0xff) {
- case bci_BRK_FUN:
- debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
- debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
+ case bci_BRK_FUN: {
+ W_ p1, info_mod, info_unit_id, info_wix, np;
+ p1 = BCO_GET_LARGE_ARG;
+ info_mod = BCO_GET_LARGE_ARG;
+ info_unit_id = BCO_GET_LARGE_ARG;
+ info_wix = BCO_NEXT;
+ np = BCO_GET_LARGE_ARG;
+ debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] );
+ debugBelch("%" FMT_Word, literals[info_mod] );
+ debugBelch("%" FMT_Word, literals[info_unit_id] );
+ debugBelch("%" FMT_Word, info_wix );
+ CostCentre* cc = (CostCentre*)literals[np];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 6;
- break;
+ break; }
case bci_BRK_ALTS:
debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
break;
=====================================
rts/Exception.cmm
=====================================
@@ -535,23 +535,17 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(17);
- Sp(16) = exception;
- Sp(15) = stg_raise_ret_info;
- Sp(14) = exception;
- Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(12) = stg_ap_ppv_info;
- Sp(11) = 0;
- Sp(10) = stg_ap_n_info;
- Sp(9) = 0;
- Sp(8) = stg_ap_n_info;
- Sp(7) = 0;
- Sp(6) = stg_ap_n_info;
- Sp(5) = 0;
- Sp(4) = stg_ap_n_info;
- Sp(3) = 0;
- Sp(2) = stg_ap_n_info;
- Sp(1) = 0;
+ Sp = Sp - WDS(11);
+ Sp(10) = exception;
+ Sp(9) = stg_raise_ret_info;
+ Sp(8) = exception;
+ Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(6) = stg_ap_ppv_info;
+ Sp(5) = 0;
+ Sp(4) = stg_ap_n_info;
+ Sp(3) = 0;
+ Sp(2) = stg_ap_n_info;
+ Sp(1) = 0;
R1 = ioAction;
jump RET_LBL(stg_ap_n) [R1];
}
=====================================
rts/Interpreter.c
=====================================
@@ -619,8 +619,6 @@ interpretBCO (Capability* cap)
*/
if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
- StgBCO* bco;
- StgWord16* bco_instrs;
StgHalfWord type;
/* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
@@ -640,28 +638,33 @@ interpretBCO (Capability* cap)
ASSERT(type == RET_BCO || type == STOP_FRAME);
if (type == RET_BCO) {
- bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
+ StgBCO* bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
- bco_instrs = (StgWord16*)(bco->instrs->payload);
+
+ StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
+ StgWord16 bci = instrs[0];
/* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
* instruction in a BCO */
- if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
- int brk_array, tick_index;
- StgArrBytes *breakPoints;
- StgPtr* ptrs;
+ if ((bci & 0xFF) == bci_BRK_FUN) {
+ // Define rest of variables used by BCO_* Macros
+ int bciPtr = 0;
+
+ W_ arg1_brk_array, arg4_info_index;
+ arg1_brk_array = BCO_GET_LARGE_ARG;
+ /* info_mod_name = */ BCO_GET_LARGE_ARG;
+ /* info_mod_id = */ BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
- ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
- brk_array = bco_instrs[1];
- tick_index = bco_instrs[6];
+ StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
+ StgArrBytes* breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
- breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
// ACTIVATE the breakpoint by tick index
- ((StgInt*)breakPoints->payload)[tick_index] = 0;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = 0;
}
- else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
+ else if ((bci & 0xFF) == bci_BRK_ALTS) {
// ACTIVATE BRK_ALTS by setting its only argument to ON
- bco_instrs[1] = 1;
+ instrs[1] = 1;
}
// else: if there is no BRK instruction perhaps we should keep
// traversing; that said, the continuation should always have a BRK
@@ -1454,9 +1457,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
+ W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
#if defined(PROFILING)
- int arg8_cc;
+ W_ arg5_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break, stop_next_breakpoint;
@@ -1471,14 +1474,11 @@ run_BCO:
int size_words;
arg1_brk_array = BCO_GET_LARGE_ARG;
- arg2_tick_mod = BCO_GET_LARGE_ARG;
- arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_mod_id = BCO_GET_LARGE_ARG;
- arg5_info_mod_id = BCO_GET_LARGE_ARG;
- arg6_tick_index = BCO_NEXT;
- arg7_info_index = BCO_NEXT;
+ arg2_info_mod_name = BCO_GET_LARGE_ARG;
+ arg3_info_mod_id = BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg8_cc = BCO_GET_LARGE_ARG;
+ arg5_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1498,7 +1498,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg8_cc));
+ (CostCentre*)BCO_LIT(arg5_cc));
#endif
// if we are returning from a break then skip this section
@@ -1509,11 +1509,11 @@ run_BCO:
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
else if (stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1547,10 +1547,7 @@ run_BCO:
// Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
- // ioAction :: Addr# -- the breakpoint tick module
- // -> Addr# -- the breakpoint tick module unit id
- // -> Int# -- the breakpoint tick index
- // -> Addr# -- the breakpoint info module
+ // ioAction :: Addr# -- the breakpoint info module
// -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
@@ -1560,23 +1557,17 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(19);
- SpW(18) = (W_)obj;
- SpW(17) = (W_)&stg_apply_interp_info;
- SpW(16) = (W_)new_aps;
- SpW(15) = (W_)False_closure; // True <=> an exception
- SpW(14) = (W_)&stg_ap_ppv_info;
- SpW(13) = (W_)arg7_info_index;
- SpW(12) = (W_)&stg_ap_n_info;
- SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
- SpW(10) = (W_)&stg_ap_n_info;
- SpW(9) = (W_)BCO_LIT(arg3_info_mod);
- SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)arg6_tick_index;
+ Sp_subW(13);
+ SpW(12) = (W_)obj;
+ SpW(11) = (W_)&stg_apply_interp_info;
+ SpW(10) = (W_)new_aps;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
+ SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
- SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
+ SpW(3) = (W_)BCO_LIT(arg2_info_mod_name);
SpW(2) = (W_)&stg_ap_n_info;
SpW(1) = (W_)ioAction;
SpW(0) = (W_)&stg_enter_info;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba0dd3dbc9d915c00a331706e28c482…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba0dd3dbc9d915c00a331706e28c482…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/backports-9.14] Driver: substitute virtual Prim module in --make mode too
by Ben Gamari (＠bgamari) 04 Sep '25
by Ben Gamari (＠bgamari) 04 Sep '25
04 Sep '25
Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
Commits:
208763ab by Sylvain Henry at 2025-09-04T15:43:11-04:00
Driver: substitute virtual Prim module in --make mode too
When we build ghc-internal with --make (e.g. with cabal-install), we
need to be careful to substitute the virtual interface file for
GHC.Internal.Prim:
- after code generation (we generate code for an empty module, so we get
an empty interface)
- when we try to reload its .hi file
(cherry picked from commit 6c78de2d6506bbbd9952ef884bdb60df8f8cf9f8)
- - - - -
11 changed files:
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- + testsuite/tests/driver/make-prim/GHC/Internal/Prim.hs
- + testsuite/tests/driver/make-prim/Makefile
- + testsuite/tests/driver/make-prim/Test.hs
- + testsuite/tests/driver/make-prim/Test2.hs
- + testsuite/tests/driver/make-prim/all.T
Changes:
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -519,7 +519,7 @@ loopFixedModule key loc done = do
-- part of the compiler.
lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
Just iface -> return (M.Succeeded iface)
- Nothing -> readIface (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
+ Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
case read_result of
M.Succeeded iface -> do
-- Computer information about this node
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1299,7 +1299,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
-- when compiling gHC_PRIM without generating code (e.g. with
-- Haddock), we still want the virtual interface in the cache
if ms_mod summary == gHC_PRIM
- then return $ HscUpdate (getGhcPrimIface hsc_env)
+ then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env))
else return $ HscUpdate iface
@@ -1314,7 +1314,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
-- when compiling gHC_PRIM without generating code (e.g. with
-- Haddock), we still want the virtual interface in the cache
if ms_mod summary == gHC_PRIM
- then return $ HscUpdate (getGhcPrimIface hsc_env)
+ then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env))
else return $ HscUpdate iface
{-
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1616,7 +1616,7 @@ executeCompileNode k n !old_hmi hug mrehydrate_mods mni = do
executeCompileNodeFixed hsc_env MakeEnv{diag_wrapper, env_messager} mod loc =
wrapAction diag_wrapper hsc_env $ do
forM_ env_messager $ \hscMessage -> hscMessage hsc_env (k, n) UpToDate (ModuleNode [] (ModuleNodeFixed mod loc))
- read_result <- readIface (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule mod) (ml_hi_file loc)
+ read_result <- readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule mod) (ml_hi_file loc)
case read_result of
M.Failed interface_err ->
let mn = mnkModuleName mod
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -44,6 +44,7 @@ module GHC.Driver.Pipeline (
import GHC.Prelude
+import GHC.Builtin.Names
import GHC.Platform
@@ -91,6 +92,7 @@ import GHC.Data.StringBuffer ( hPutStringBuffer )
import GHC.Data.Maybe ( expectJust )
import GHC.Iface.Make ( mkFullIface )
+import GHC.Iface.Load ( getGhcPrimIface )
import GHC.Runtime.Loader ( initializePlugins )
@@ -819,7 +821,13 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do
let !linkable = Linkable part_time (ms_mod mod_sum) (NE.singleton (DotO final_object ModuleObject))
-- Add the object linkable to the potential bytecode linkable which was generated in HscBackend.
return (mlinkable { homeMod_object = Just linkable })
- return (miface, final_linkable)
+
+ -- when building ghc-internal with --make (e.g. with cabal-install), we want
+ -- the virtual interface for gHC_PRIM in the cache, not the empty one.
+ let miface_final
+ | ms_mod mod_sum == gHC_PRIM = getGhcPrimIface (hsc_hooks hsc_env)
+ | otherwise = miface
+ return (miface_final, final_linkable)
asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile)
asPipeline use_cpp pipe_env hsc_env location input_fn =
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -895,6 +895,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
mhome_unit = hsc_home_unit_maybe hsc_env
dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
+ hooks = hsc_hooks hsc_env
trace_if logger (sep [hsep [text "Reading",
@@ -905,59 +906,51 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
ppr mod <> semi],
nest 4 (text "reason:" <+> doc_str)])
- -- Check for GHC.Prim, and return its static interface
- -- See Note [GHC.Prim] in primops.txt.pp.
- -- TODO: make this check a function
- if mod `installedModuleEq` gHC_PRIM
- then do
- let iface = getGhcPrimIface hsc_env
- return (Succeeded (iface, panic "GHC.Prim ModLocation (findAndReadIface)"))
- else do
- -- Look for the file
- mb_found <- liftIO (findExactModule hsc_env mod hi_boot_file)
- case mb_found of
- InstalledFound loc -> do
- -- See Note [Home module load error]
- if HUG.memberHugUnitId (moduleUnit mod) (hsc_HUG hsc_env)
- && not (isOneShot (ghcMode dflags))
- then return (Failed (HomeModError mod loc))
- else do
- r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
- case r of
- Failed err
- -> return (Failed $ BadIfaceFile err)
- Succeeded (iface,_fp)
- -> do
- r2 <- load_dynamic_too_maybe logger name_cache unit_state
- (setDynamicNow dflags) wanted_mod
- iface loc
- case r2 of
- Failed sdoc -> return (Failed sdoc)
- Succeeded {} -> return $ Succeeded (iface, loc)
- err -> do
- trace_if logger (text "...not found")
- return $ Failed $ cannotFindInterface
- unit_state
- mhome_unit
- profile
- (moduleName mod)
- err
+ -- Look for the file
+ mb_found <- liftIO (findExactModule hsc_env mod hi_boot_file)
+ case mb_found of
+ InstalledFound loc -> do
+ -- See Note [Home module load error]
+ if HUG.memberHugUnitId (moduleUnit mod) (hsc_HUG hsc_env)
+ && not (isOneShot (ghcMode dflags))
+ then return (Failed (HomeModError mod loc))
+ else do
+ r <- read_file hooks logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
+ case r of
+ Failed err
+ -> return (Failed $ BadIfaceFile err)
+ Succeeded (iface,_fp)
+ -> do
+ r2 <- load_dynamic_too_maybe hooks logger name_cache unit_state
+ (setDynamicNow dflags) wanted_mod
+ iface loc
+ case r2 of
+ Failed sdoc -> return (Failed sdoc)
+ Succeeded {} -> return $ Succeeded (iface, loc)
+ err -> do
+ trace_if logger (text "...not found")
+ return $ Failed $ cannotFindInterface
+ unit_state
+ mhome_unit
+ profile
+ (moduleName mod)
+ err
-- | Check if we need to try the dynamic interface for -dynamic-too
-load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags
+load_dynamic_too_maybe :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
-> Module -> ModIface -> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
-load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc
+load_dynamic_too_maybe hooks logger name_cache unit_state dflags wanted_mod iface loc
-- Indefinite interfaces are ALWAYS non-dynamic.
| not (moduleIsDefinite (mi_module iface)) = return (Succeeded ())
- | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc
+ | gopt Opt_BuildDynamicToo dflags = load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc
| otherwise = return (Succeeded ())
-load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags
+load_dynamic_too :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
-> Module -> ModIface -> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
-load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
- read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
+load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc = do
+ read_file hooks logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
Succeeded (dynIface, _)
| mi_mod_hash iface == mi_mod_hash dynIface
-> return (Succeeded ())
@@ -971,10 +964,10 @@ load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
-read_file :: Logger -> NameCache -> UnitState -> DynFlags
+read_file :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
-> Module -> FilePath
-> IO (MaybeErr ReadInterfaceError (ModIface, FilePath))
-read_file logger name_cache unit_state dflags wanted_mod file_path = do
+read_file hooks logger name_cache unit_state dflags wanted_mod file_path = do
-- Figure out what is recorded in mi_module. If this is
-- a fully definite interface, it'll match exactly, but
@@ -985,7 +978,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do
(_, Just indef_mod) ->
instModuleToModule unit_state
(uninstantiateInstantiatedModule indef_mod)
- read_result <- readIface logger dflags name_cache wanted_mod' file_path
+ read_result <- readIface hooks logger dflags name_cache wanted_mod' file_path
case read_result of
Failed err -> return (Failed err)
Succeeded iface -> return (Succeeded (iface, file_path))
@@ -1012,13 +1005,14 @@ flagsToIfCompression dflags
-- Failed err <=> file not found, or unreadable, or illegible
-- Succeeded iface <=> successfully found and parsed
readIface
- :: Logger
+ :: Hooks
+ -> Logger
-> DynFlags
-> NameCache
-> Module
-> FilePath
-> IO (MaybeErr ReadInterfaceError ModIface)
-readIface logger dflags name_cache wanted_mod file_path = do
+readIface hooks logger dflags name_cache wanted_mod file_path = do
trace_if logger (text "readIFace" <+> text file_path)
let profile = targetProfile dflags
res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path
@@ -1028,9 +1022,14 @@ readIface logger dflags name_cache wanted_mod file_path = do
-- critical for correctness of recompilation checking
-- (it lets us tell when -this-unit-id has changed.)
| wanted_mod == actual_mod
- -> return (Succeeded iface)
+ -> return (Succeeded final_iface)
| otherwise -> return (Failed err)
where
+ final_iface
+ -- Check for GHC.Prim, and return its static interface
+ -- See Note [GHC.Prim] in primops.txt.pp.
+ | wanted_mod == gHC_PRIM = getGhcPrimIface hooks
+ | otherwise = iface
actual_mod = mi_module iface
err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod
@@ -1245,8 +1244,8 @@ instance Outputable WhereFrom where
-- This is a helper function that takes into account the hook allowing ghc-prim
-- interface to be extended via the ghc-api. Afaik it was introduced for GHCJS
-- so that it can add its own primitive types.
-getGhcPrimIface :: HscEnv -> ModIface
-getGhcPrimIface hsc_env =
- case ghcPrimIfaceHook (hsc_hooks hsc_env) of
+getGhcPrimIface :: Hooks -> ModIface
+getGhcPrimIface hooks =
+ case ghcPrimIfaceHook hooks of
Nothing -> ghcPrimIface
Just h -> h
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -304,7 +304,7 @@ check_old_iface hsc_env mod_summary maybe_iface
loadIface read_dflags iface_path = do
let ncu = hsc_NC hsc_env
- read_result <- readIface logger read_dflags ncu (ms_mod mod_summary) iface_path
+ read_result <- readIface (hsc_hooks hsc_env) logger read_dflags ncu (ms_mod mod_summary) iface_path
case read_result of
Failed err -> do
let msg = readInterfaceErrorDiagnostic err
=====================================
testsuite/tests/driver/make-prim/GHC/Internal/Prim.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Internal.Prim where
+
+
=====================================
testsuite/tests/driver/make-prim/Makefile
=====================================
@@ -0,0 +1,11 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+make-prim:
+ # build once to test the substitution of the virtual interface in --make
+ # mode with codegen
+ "$(TEST_HC)" $(TEST_HC_OPTS) --make Test.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0
+ # build a different module (Test2) in --make mode to test the reloading
+ # of the GHC.Internal.Prim interface
+ "$(TEST_HC)" $(TEST_HC_OPTS) --make Test2.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0
=====================================
testsuite/tests/driver/make-prim/Test.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Test where
+
+import GHC.Internal.Prim
+
+foo :: Int# -> Int#
+foo = notI#
=====================================
testsuite/tests/driver/make-prim/Test2.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Test2 where
+
+import GHC.Internal.Prim
+
+foo :: Int# -> Int#
+foo = notI#
=====================================
testsuite/tests/driver/make-prim/all.T
=====================================
@@ -0,0 +1 @@
+test('make-prim', [extra_files(['Test.hs','Test2.hs', 'GHC', 'GHC/Internal', 'GHC/Internal/Prim.hs'])], makefile_test, ['make-prim'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/208763abb678e61551ed4d750e4af99…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/208763abb678e61551ed4d750e4af99…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Ben Gamari pushed new branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.14
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Ben Gamari deleted branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][ghc-9.14] 18 commits: Take more care in zonkEqTypes on AppTy/AppTy
by Ben Gamari (＠bgamari) 04 Sep '25
by Ben Gamari (＠bgamari) 04 Sep '25
04 Sep '25
Ben Gamari pushed to branch ghc-9.14 at Glasgow Haskell Compiler / GHC
Commits:
d5dab939 by Simon Peyton Jones at 2025-09-02T15:03:52-04:00
Take more care in zonkEqTypes on AppTy/AppTy
This patch fixes #26256.
See Note [zonkEqTypes and the PKTI] in GHC.Tc.Solver.Equality
(cherry picked from commit 18036d5205ac648bb245217519fed2fd931a9982)
- - - - -
5c994363 by Andreas Klebinger at 2025-09-02T15:04:00-04:00
Make unexpected LLVM versions a warning rather than an error.
Typically a newer LLVM version *will* work so erroring out if
a user uses a newer LLVM version is too aggressive.
Fixes #25915
(cherry picked from commit 50842f83f467ff54dd22470559a7af79d2025c03)
- - - - -
dbe870cd by Reed Mullanix at 2025-09-02T15:04:56-04:00
ghc-internal: Fix naturalAndNot for NB/NS case
When the first argument to `naturalAndNot` is larger than a `Word` and the second is `Word`-sized, `naturalAndNot` will truncate the
result:
```
>>> naturalAndNot ((2 ^ 65) .|. (2 ^ 3)) (2 ^ 3)
0
```
In contrast, `naturalAndNot` does not truncate when both arguments are larger than a `Word`, so this appears to be a bug.
Luckily, the fix is pretty easy: we just need to call `bigNatAndNotWord#` instead of truncating.
Fixes #26230
(cherry picked from commit a766286fe759251eceb304c54ba52841c2a51f86)
- - - - -
ceb55a1f by Zubin Duggal at 2025-09-02T15:05:08-04:00
testsuite: Be more permissive when filtering out GNU_PROPERTY_TYPE linker warnings
The warning text is slightly different with ld.bfd.
Fixes #26249
(cherry picked from commit 51c701fef034e2062809eed5de3a51bb0a4243ba)
- - - - -
a85edeb7 by Teo Camarasu at 2025-09-02T15:05:18-04:00
rts: ensure MessageBlackHole.link is always a valid closure
We turn a MessageBlackHole into an StgInd in wakeBlockingQueue().
Therefore it's important that the link field, which becomes the
indirection field, always points to a valid closure.
It's unclear whether it's currently possible for the previous behaviour
to lead to a crash, but it's good to be consistent about this invariant nonetheless.
Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at>
(cherry picked from commit a8b2fbae6bcf20bc2f3fe58803096d2a9c5fc43d)
- - - - -
2fded9af by Teo Camarasu at 2025-09-02T15:05:23-04:00
rts: spin if we see a WHITEHOLE in messageBlackHole
When a BLACKHOLE gets cancelled in raiseAsync, we indirect to a THUNK.
GC can then shortcut this, replacing our BLACKHOLE with a fresh THUNK.
This THUNK is not guaranteed to have a valid indirectee field.
If at the same time, a message intended for the previous BLACKHOLE is
processed and concurrently we BLACKHOLE the THUNK, thus temporarily
turning it into a WHITEHOLE, we can get a segfault, since we look at the
undefined indirectee field of the THUNK
The fix is simple: spin if we see a WHITEHOLE, and it will soon be
replaced with a valid BLACKHOLE.
Resolves #26205
(cherry picked from commit 4021181ee0860aca2054883a531f3312361cc701)
- - - - -
addff92e by Cheng Shao at 2025-09-02T15:07:22-04:00
hadrian: enforce have_llvm=False for wasm32/js
This patch fixes hadrian to always pass have_llvm=False to the
testsuite driver for wasm32/js targets. These targets don't really
support the LLVM backend, and the optllvm test way doesn't work. We
used to special-case wasm32/js to avoid auto-adding optllvm way in
testsuite/config/ghc, but this is still problematic if someone writes
a new LLVM-related test and uses something like when(have_llvm(),
extra_ways(["optllvm"])). So better just enforce have_llvm=False for
these targets here.
(cherry picked from commit 1cdc6f46c4168dd92a8f5ea0c398b67fc59449a9)
- - - - -
73364af4 by fendor at 2025-09-02T15:07:38-04:00
rts: Strip lower three bits when hashing Word instead of lower eight bits
(cherry picked from commit 58e46da9dad572b95b4e354d0a0ed25ce9af5d02)
- - - - -
ba8b5927 by Cheng Shao at 2025-09-02T15:07:46-04:00
libffi: update to 3.5.2
Bumps libffi submodule.
(cherry picked from commit 45dbfa23f508f221b6aeb667783a928511a7654e)
- - - - -
d4aeb662 by Simon Peyton Jones at 2025-09-02T15:07:53-04:00
Take yet more care with reporting redundant constraints
This small patch fixes #25992, which relates to reporting redundant
constraints on default-method declarations.
See (TRC5) in Note [Tracking redundant constraints]
(cherry picked from commit f4bac60722ac990d349bdffa3e4fcfcaf6d8f11b)
- - - - -
802372b1 by Vekhir -- at 2025-09-02T15:08:20-04:00
Bump Cabal dependency
(cherry picked from commit 276f8ea8d369b202549a2e30be9b88a95a329083)
- - - - -
893652db by Simon Peyton Jones at 2025-09-02T15:08:30-04:00
Start with empty inerts in shortcut solving
When short-cut solving we were starting with an inert set that had
unsolved Wanteds. This caused an infinite loop (#26314), because a
typechecker plugin kept being given that unsolved Wanted.
It's better just to start with an empty inert set
(cherry picked from commit ccda188d726804e4154de9318c72c5a656f3b015)
- - - - -
2a888147 by fendor at 2025-09-02T15:08:42-04:00
Remove deprecated functions from the ghci package
(cherry picked from commit f0a19d744e339189cfd63b52585e16043ed4997a)
- - - - -
b8b09969 by fendor at 2025-09-02T15:09:26-04:00
base: Remove unstable heap representation details from GHC.Exts
(cherry picked from commit ebeb991b7c81a5e5f5c09aba9a4af0f85e656253)
- - - - -
79cf7742 by Cheng Shao at 2025-09-02T15:10:28-04:00
wasm: ensure setKeepCAFs() is called in ghci
This patch is a critical bugfix for #26106, see comment and linked
issue for details.
(cherry picked from commit 10f06163d9adcb3b6e6438f1524faaca3bf6c3b2)
- - - - -
65325218 by Simon Peyton Jones at 2025-09-02T15:10:44-04:00
Comments only
(cherry picked from commit 00478944861fe3ab146d759898ea0285484d8387)
- - - - -
ca12f880 by Simon Peyton Jones at 2025-09-02T15:10:44-04:00
Type-family occurs check in unification
The occurs check in `GHC.Core.Unify.uVarOrFam` was inadequate in dealing
with type families.
Better now. See Note [The occurs check in the Core unifier].
As I did this I realised that the whole apartness thing is trickier than I
thought: see the new Note [Shortcomings of the apartness test]
(cherry picked from commit a78845896d7f5b692372c137fd7a73bcdf94eddb)
- - - - -
f6a086c3 by Simon Peyton Jones at 2025-09-04T10:34:26-04:00
Fix a long standing bug in the coercion optimiser
We were mis-optimising ForAllCo, leading to #26345
Part of the poblem was the tricky tower of abstractions leading to
the dreadful
GHC.Core.TyCo.Subst.substForAllCoTyVarBndrUsing
This function was serving two masters: regular substitution, but also
coercion optimsation. So tricky was it that it did so wrong.
In this MR I locate all the fancy footwork for coercion optimisation
in GHC.Core.Coercion.Opt, where it belongs. That leaves substitution
free to be much simpler.
(cherry picked from commit fb9cc8825f37b1d7f1bc19d5a5c1425c7613e81a)
Metric Decrease:
CoOpt_Read
- - - - -
44 changed files:
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/TyCo/Compare.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Unify.hs
- hadrian/hadrian.cabal
- hadrian/src/Settings/Builders/RunTest.hs
- libffi-tarballs
- libraries/base/changelog.md
- libraries/base/src/GHC/Exts.hs
- libraries/ghc-bignum/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/TH.hs
- libraries/ghci/ghci.cabal.in
- rts/Hash.c
- rts/Messages.c
- rts/StgMiscClosures.cmm
- rts/Updates.h
- testsuite/config/ghc
- testsuite/driver/testlib.py
- − testsuite/tests/module/T21752.stderr
- + testsuite/tests/numeric/should_run/T26230.hs
- + testsuite/tests/numeric/should_run/T26230.stdout
- testsuite/tests/numeric/should_run/all.T
- + testsuite/tests/partial-sigs/should_compile/T26256.hs
- + testsuite/tests/partial-sigs/should_compile/T26256.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/T25992a.hs
- + testsuite/tests/typecheck/should_compile/T26256a.hs
- + testsuite/tests/typecheck/should_compile/T26345.hs
- + testsuite/tests/typecheck/should_compile/T26346.hs
- + testsuite/tests/typecheck/should_compile/T26358.hs
- testsuite/tests/typecheck/should_compile/all.T
- 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/5f9c0b626a05313c01ce68f6defe8c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5f9c0b626a05313c01ce68f6defe8c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Add Control.Monad.thenM and Control.Applicative.thenA
by Marge Bot (＠marge-bot) 04 Sep '25
by Marge Bot (＠marge-bot) 04 Sep '25
04 Sep '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8b2c72c0 by L0neGamer at 2025-09-04T06:32:03-04:00
Add Control.Monad.thenM and Control.Applicative.thenA
- - - - -
39e1b7cb by Teo Camarasu at 2025-09-04T06:32:46-04:00
ghc-internal: invert dependency of GHC.Internal.TH.Syntax on Data.Data
This means that Data.Data no longer blocks building TH.Syntax, which
allows greater parallelism in our builds.
We move the Data.Data.Data instances to Data.Data. Quasi depends on
Data.Data for one of its methods, so,
we split the Quasi/Q, etc definition out of GHC.Internal.TH.Syntax
into its own module. This has the added benefit of splitting up this
quite large module.
Previously TH.Syntax was a bottleneck when compiling ghc-internal. Now
it is less of a bottle-neck and is also slightly quicker to
compile (since it no longer contains these instances) at the cost of
making Data.Data slightly more expensive to compile.
TH.Lift which depends on TH.Syntax can also compile quicker and no
longer blocks ghc-internal finishing to compile.
Resolves #26217
-------------------------
Metric Decrease:
MultiLayerModulesTH_OneShot
T13253
T21839c
T24471
Metric Increase:
T12227
-------------------------
- - - - -
bdf82fd2 by Teo Camarasu at 2025-09-04T06:32:46-04:00
compiler: delete unused names in Builtins.Names.TH
returnQ and bindQ are no longer used in the compiler.
There was also a very old comment that referred to them that I have modernized
- - - - -
12952b49 by Ben Gamari at 2025-09-04T11:11:02-04:00
hadrian: Pass lib & include directories to ghc `Setup configure`
- - - - -
65b20357 by Ben Gamari at 2025-09-04T11:11:03-04:00
rts/IPE: Fix compilation when zstd is enabled
This was broken by the refactoring undertaken in
c80dd91c0bf6ac034f0c592f16c548b9408a8481.
Closes #26312.
- - - - -
0f35d855 by sheaf at 2025-09-04T11:11:15-04:00
Make mkCast assertion a bit clearer
This commit changes the assertion message that gets printed when one
calls mkCast with a coercion whose kind does not match the type of the
inner expression. I always found the assertion message a bit confusing,
as it didn't clearly state what exactly was the error.
- - - - -
e07a72f7 by sheaf at 2025-09-04T11:11:15-04:00
Simplifier/rules: fix mistakes in Notes & comments
- - - - -
49 changed files:
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Data/IOEnv.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs-boot
- compiler/GHC/Tc/Types/TH.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/changelog.md
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Control/Monad.hs
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/Data/Fixed.hs
- + libraries/ghc-boot-th/GHC/Boot/TH/Monad.hs
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.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/TH/Syntax.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/TH.hs
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- rts/IPE.c
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/deriving/should_compile/drv-empty-data.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/splice-imports/SI29.stderr
- testsuite/tests/th/T11452.stderr
- testsuite/tests/th/T15321.stderr
- testsuite/tests/th/T7276.stderr
- testsuite/tests/th/TH_NestedSplicesFail3.stderr
- testsuite/tests/th/TH_NestedSplicesFail4.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec47211087532100409bd868e01c26…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec47211087532100409bd868e01c26…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/backports-9.14] Fix a long standing bug in the coercion optimiser
by Ben Gamari (＠bgamari) 04 Sep '25
by Ben Gamari (＠bgamari) 04 Sep '25
04 Sep '25
Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
Commits:
f6a086c3 by Simon Peyton Jones at 2025-09-04T10:34:26-04:00
Fix a long standing bug in the coercion optimiser
We were mis-optimising ForAllCo, leading to #26345
Part of the poblem was the tricky tower of abstractions leading to
the dreadful
GHC.Core.TyCo.Subst.substForAllCoTyVarBndrUsing
This function was serving two masters: regular substitution, but also
coercion optimsation. So tricky was it that it did so wrong.
In this MR I locate all the fancy footwork for coercion optimisation
in GHC.Core.Coercion.Opt, where it belongs. That leaves substitution
free to be much simpler.
(cherry picked from commit fb9cc8825f37b1d7f1bc19d5a5c1425c7613e81a)
Metric Decrease:
CoOpt_Read
- - - - -
6 changed files:
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/Type.hs
- + testsuite/tests/typecheck/should_compile/T26345.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Coercion.hs
=====================================
@@ -93,9 +93,10 @@ module GHC.Core.Coercion (
liftCoSubst, liftCoSubstTyVar, liftCoSubstWith, liftCoSubstWithEx,
emptyLiftingContext, extendLiftingContext, extendLiftingContextAndInScope,
liftCoSubstVarBndrUsing, isMappedByLC, extendLiftingContextCvSubst,
+ updateLCSubst,
mkSubstLiftingContext, liftingContextSubst, zapLiftingContext,
- substForAllCoBndrUsingLC, lcLookupCoVar, lcInScopeSet,
+ lcLookupCoVar, lcInScopeSet,
LiftCoEnv, LiftingContext(..), liftEnvSubstLeft, liftEnvSubstRight,
substRightCo, substLeftCo, swapLiftCoEnv, lcSubstLeft, lcSubstRight,
@@ -2136,15 +2137,11 @@ extendLiftingContextEx lc@(LC subst env) ((v,ty):rest)
zapLiftingContext :: LiftingContext -> LiftingContext
zapLiftingContext (LC subst _) = LC (zapSubst subst) emptyVarEnv
--- | Like 'substForAllCoBndr', but works on a lifting context
-substForAllCoBndrUsingLC :: SwapFlag
- -> (Coercion -> Coercion)
- -> LiftingContext -> TyCoVar -> Coercion
- -> (LiftingContext, TyCoVar, Coercion)
-substForAllCoBndrUsingLC sym sco (LC subst lc_env) tv co
- = (LC subst' lc_env, tv', co')
+updateLCSubst :: LiftingContext -> (Subst -> (Subst, a)) -> (LiftingContext, a)
+-- Lift a Subst-update function over LiftingContext
+updateLCSubst (LC subst lc_env) upd = (LC subst' lc_env, res)
where
- (subst', tv', co') = substForAllCoBndrUsing sym sco subst tv co
+ (subst', res) = upd subst
-- | The \"lifting\" operation which substitutes coercions for type
-- variables in a type to produce a coercion.
=====================================
compiler/GHC/Core/Coercion/Opt.hs
=====================================
@@ -358,12 +358,12 @@ opt_co4' env sym rep r (AppCo co1 co2)
(opt_co4 env sym False Nominal co2)
opt_co4' env sym rep r (ForAllCo { fco_tcv = tv, fco_visL = visL, fco_visR = visR
- , fco_kind = k_co, fco_body = co })
- = case optForAllCoBndr env sym tv k_co of
- (env', tv', k_co') -> mkForAllCo tv' visL' visR' k_co' $
- opt_co4 env' sym rep r co
+ , fco_kind = k_co, fco_body = co })
+ = mkForAllCo tv' visL' visR' k_co' $
+ opt_co4 env' sym rep r co
-- Use the "mk" functions to check for nested Refls
where
+ !(env', tv', k_co') = optForAllCoBndr env sym tv k_co
!(visL', visR') = swapSym sym (visL, visR)
opt_co4' env sym rep r (FunCo _r afl afr cow co1 co2)
@@ -1401,10 +1401,68 @@ and these two imply
-}
+{- Note [Optimising ForAllCo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If sym=NotSwapped, optimising ForAllCo is relatively easy:
+ opt env (ForAllCo tcv kco bodyco)
+ = ForAllCo tcv' (opt env kco) (opt env' bodyco)
+ where
+ (env', tcv') = substBndr env tcv
+
+Just apply the substitution to the kind of the binder, deal with
+shadowing etc, and recurse. Remember in (ForAllCo tcv kco bodyco)
+ varKind tcv = coercionLKind kco
+
+But if sym=Swapped, things are trickier. Here is an identity that helps:
+ Sym (ForAllCo (tv:k1) (kco:k1~k2) bodyco)
+ = ForAllCo (tv:k2) (Sym kco : k2~k1)
+ (Sym (bodyco[tv:->tv:k2 |> Sym kco]))
+
+* We re-type tv:k1 to become tv:k2.
+* We push Sym into kco
+* We push Sym into bodyco
+* BUT we must /also/ remember to replace all occurrences of
+ of tv:k1 in bodyco by (tv:k2 |> Sym kco)
+ This mirrors what happens in the typing rule for ForAllCo
+ See Note [ForAllCo] in GHC.Core.TyCo.Rep
+
+-}
optForAllCoBndr :: LiftingContext -> SwapFlag
- -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion)
-optForAllCoBndr env sym
- = substForAllCoBndrUsingLC sym (opt_co4 env sym False Nominal) env
+ -> TyCoVar -> Coercion
+ -> (LiftingContext, TyCoVar, Coercion)
+-- See Note [Optimising ForAllCo]
+optForAllCoBndr env sym tcv kco
+ = (env', tcv', kco')
+ where
+ kco' = opt_co4 env sym False Nominal kco -- Push sym into kco
+ (env', tcv') = updateLCSubst env upd_subst
+
+ upd_subst :: Subst -> (Subst, TyCoVar)
+ upd_subst subst
+ | isTyVar tcv = upd_subst_tv subst
+ | otherwise = upd_subst_cv subst
+
+ upd_subst_tv subst
+ | notSwapped sym || isReflCo kco' = (subst1, tv1)
+ | otherwise = (subst2, tv2)
+ where
+ -- subst1,tv1: apply the substitution to the binder and its kind
+ -- NB: varKind tv = coercionLKind kco
+ (subst1, tv1) = substTyVarBndr subst tcv
+ -- In the Swapped case, we re-kind the type variable, AND
+ -- override the substitution for the original variable to the
+ -- re-kinded one, suitably casted
+ tv2 = tv1 `setTyVarKind` coercionLKind kco'
+ subst2 = (extendTvSubst subst1 tcv (mkTyVarTy tv2 `CastTy` kco'))
+ `extendSubstInScope` tv2
+
+ upd_subst_cv subst -- ToDo: probably not right yet
+ | notSwapped sym || isReflCo kco' = (subst1, cv1)
+ | otherwise = (subst2, cv2)
+ where
+ (subst1, cv1) = substCoVarBndr subst tcv
+ cv2 = cv1 `setTyVarKind` coercionLKind kco'
+ subst2 = subst1 `extendSubstInScope` cv2
{- **********************************************************************
=====================================
compiler/GHC/Core/TyCo/Subst.hs
=====================================
@@ -60,7 +60,7 @@ import {-# SOURCE #-} GHC.Core.Coercion
, mkAxiomCo, mkAppCo, mkGReflCo
, mkInstCo, mkLRCo, mkTyConAppCo
, mkCoercionType
- , coercionKind, coercionLKind, coVarTypesRole )
+ , coercionLKind, coVarTypesRole )
import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprTyVar )
import {-# SOURCE #-} GHC.Core.Ppr ( ) -- instance Outputable CoreExpr
import {-# SOURCE #-} GHC.Core ( CoreExpr )
@@ -68,12 +68,10 @@ import {-# SOURCE #-} GHC.Core ( CoreExpr )
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.FVs
-import GHC.Types.Basic( SwapFlag(..), isSwapped, pickSwap, notSwapped )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
-import GHC.Data.Pair
import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.Misc
import GHC.Types.Unique.Supply
@@ -922,7 +920,7 @@ substDCoVarSet subst cvs = coVarsOfCosDSet $ map (substCoVar subst) $
substForAllCoBndr :: Subst -> TyCoVar -> KindCoercion
-> (Subst, TyCoVar, Coercion)
substForAllCoBndr subst
- = substForAllCoBndrUsing NotSwapped (substCo subst) subst
+ = substForAllCoBndrUsing (substCo subst) subst
-- | Like 'substForAllCoBndr', but disables sanity checks.
-- The problems that the sanity checks in substCo catch are described in
@@ -932,33 +930,26 @@ substForAllCoBndr subst
substForAllCoBndrUnchecked :: Subst -> TyCoVar -> KindCoercion
-> (Subst, TyCoVar, Coercion)
substForAllCoBndrUnchecked subst
- = substForAllCoBndrUsing NotSwapped (substCoUnchecked subst) subst
+ = substForAllCoBndrUsing (substCoUnchecked subst) subst
-- See Note [Sym and ForAllCo]
-substForAllCoBndrUsing :: SwapFlag -- Apply sym to binder?
- -> (Coercion -> Coercion) -- transformation to kind co
+substForAllCoBndrUsing :: (Coercion -> Coercion) -- transformation to kind co
-> Subst -> TyCoVar -> KindCoercion
-> (Subst, TyCoVar, KindCoercion)
-substForAllCoBndrUsing sym sco subst old_var
- | isTyVar old_var = substForAllCoTyVarBndrUsing sym sco subst old_var
- | otherwise = substForAllCoCoVarBndrUsing sym sco subst old_var
+substForAllCoBndrUsing sco subst old_var
+ | isTyVar old_var = substForAllCoTyVarBndrUsing sco subst old_var
+ | otherwise = substForAllCoCoVarBndrUsing sco subst old_var
-substForAllCoTyVarBndrUsing :: SwapFlag -- Apply sym to binder?
- -> (Coercion -> Coercion) -- transformation to kind co
+substForAllCoTyVarBndrUsing :: (Coercion -> Coercion) -- transformation to kind co
-> Subst -> TyVar -> KindCoercion
-> (Subst, TyVar, KindCoercion)
-substForAllCoTyVarBndrUsing sym sco (Subst in_scope idenv tenv cenv) old_var old_kind_co
+substForAllCoTyVarBndrUsing sco (Subst in_scope idenv tenv cenv) old_var old_kind_co
= assert (isTyVar old_var )
( Subst (in_scope `extendInScopeSet` new_var) idenv new_env cenv
, new_var, new_kind_co )
where
- new_env | no_change, notSwapped sym
- = delVarEnv tenv old_var
- | isSwapped sym
- = extendVarEnv tenv old_var $
- TyVarTy new_var `CastTy` new_kind_co
- | otherwise
- = extendVarEnv tenv old_var (TyVarTy new_var)
+ new_env | no_change = delVarEnv tenv old_var
+ | otherwise = extendVarEnv tenv old_var (TyVarTy new_var)
no_kind_change = noFreeVarsOfCo old_kind_co
no_change = no_kind_change && (new_var == old_var)
@@ -974,20 +965,17 @@ substForAllCoTyVarBndrUsing sym sco (Subst in_scope idenv tenv cenv) old_var old
new_var = uniqAway in_scope (setTyVarKind old_var new_ki1)
-substForAllCoCoVarBndrUsing :: SwapFlag -- Apply sym to binder?
- -> (Coercion -> Coercion) -- transformation to kind co
+substForAllCoCoVarBndrUsing :: (Coercion -> Coercion) -- transformation to kind co
-> Subst -> CoVar -> KindCoercion
-> (Subst, CoVar, KindCoercion)
-substForAllCoCoVarBndrUsing sym sco (Subst in_scope idenv tenv cenv)
+substForAllCoCoVarBndrUsing sco (Subst in_scope idenv tenv cenv)
old_var old_kind_co
= assert (isCoVar old_var )
( Subst (in_scope `extendInScopeSet` new_var) idenv tenv new_cenv
, new_var, new_kind_co )
where
- new_cenv | no_change, notSwapped sym
- = delVarEnv cenv old_var
- | otherwise
- = extendVarEnv cenv old_var (mkCoVarCo new_var)
+ new_cenv | no_change = delVarEnv cenv old_var
+ | otherwise = extendVarEnv cenv old_var (mkCoVarCo new_var)
no_kind_change = noFreeVarsOfCo old_kind_co
no_change = no_kind_change && (new_var == old_var)
@@ -995,10 +983,8 @@ substForAllCoCoVarBndrUsing sym sco (Subst in_scope idenv tenv cenv)
new_kind_co | no_kind_change = old_kind_co
| otherwise = sco old_kind_co
- Pair h1 h2 = coercionKind new_kind_co
-
- new_var = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type
- new_var_type = pickSwap sym h1 h2
+ new_ki1 = coercionLKind new_kind_co
+ new_var = uniqAway in_scope $ mkCoVar (varName old_var) new_ki1
substCoVar :: Subst -> CoVar -> Coercion
substCoVar (Subst _ _ _ cenv) cv
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -559,11 +559,7 @@ expandTypeSynonyms ty
go_co _ (HoleCo h)
= pprPanic "expandTypeSynonyms hit a hole" (ppr h)
- -- the "False" and "const" are to accommodate the type of
- -- substForAllCoBndrUsing, which is general enough to
- -- handle coercion optimization (which sometimes swaps the
- -- order of a coercion)
- go_cobndr subst = substForAllCoBndrUsing NotSwapped (go_co subst) subst
+ go_cobndr subst = substForAllCoBndrUsing (go_co subst) subst
{- Notes on type synonyms
~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
testsuite/tests/typecheck/should_compile/T26345.hs
=====================================
@@ -0,0 +1,57 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeAbstractions #-}
+{-# LANGUAGE TypeFamilies #-}
+module Bug where
+
+import Data.Kind (Constraint, Type)
+
+type Sing :: k -> Type
+type family Sing @k
+
+type Tuple0 :: Type
+data Tuple0 = MkTuple0
+
+type STuple0 :: Tuple0 -> Type
+data STuple0 z where
+ SMkTuple0 :: STuple0 MkTuple0
+type instance Sing @Tuple0 = STuple0
+
+type U1 :: Type
+data U1 = MkU1
+
+type SU1 :: U1 -> Type
+data SU1 z where
+ SMkU1 :: SU1 MkU1
+type instance Sing @U1 = SU1
+
+type Generic :: Type -> Constraint
+class Generic a where
+ type Rep a :: Type
+
+type PGeneric :: Type -> Constraint
+class PGeneric a where
+ type PFrom (x :: a) :: Rep a
+
+type SGeneric :: Type -> Constraint
+class SGeneric a where
+ sFrom :: forall (x :: a). Sing x -> Sing (PFrom x)
+
+instance SGeneric Tuple0 where
+ sFrom SMkTuple0 = SMkU1
+
+instance Generic Tuple0 where
+ type Rep Tuple0 = U1
+
+instance PGeneric Tuple0 where
+ type PFrom MkTuple0 = MkU1
+
+type SDecide :: Type -> Constraint
+class SDecide a where
+ sDecide :: forall (x :: a) (y :: a). Sing x -> Sing y -> Bool
+
+instance SDecide U1 where
+ sDecide SMkU1 SMkU1 = True
+
+sDecideDefault :: Sing MkTuple0 -> Sing MkTuple0 -> Bool
+sDecideDefault s1 s2 = sDecide (sFrom s1) (sFrom s2)
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -945,3 +945,5 @@ test('T26256a', normal, compile, [''])
test('T25992a', normal, compile, [''])
test('T26346', normal, compile, [''])
test('T26358', expect_broken(26358), compile, [''])
+test('T26345', normal, compile, [''])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6a086c355eb027cc40a2b9645eedd3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6a086c355eb027cc40a2b9645eedd3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/9.12.3-backports] 40 commits: fetch_gitlab: Ensure we copy users_guide.pdf and Haddock.pdf to the release docs directory
by Zubin (＠wz1000) 04 Sep '25
by Zubin (＠wz1000) 04 Sep '25
04 Sep '25
Zubin pushed to branch wip/9.12.3-backports at Glasgow Haskell Compiler / GHC
Commits:
14d75bd1 by Zubin Duggal at 2025-09-04T17:54:57+05:30
fetch_gitlab: Ensure we copy users_guide.pdf and Haddock.pdf to the release docs directory
Fixes #24093
(cherry picked from commit 9fa590a6e27545995cdcf419ed7a6504e6668b18)
- - - - -
0088037f by sheaf at 2025-09-04T17:54:57+05:30
Use mkTrAppChecked in ds_ev_typeable
This change avoids violating the invariant of mkTrApp according to which
the argument should not be a fully saturated function type.
This ensures we don't return false negatives for type equality
involving function types.
Fixes #25998
(cherry picked from commit 9c6d2b1bf54310b6d9755aa2ba67fbe38feeac51)
- - - - -
0b1f3bf6 by Ben Gamari at 2025-09-04T17:54:57+05:30
Reapply "Division by constants optimization"
This reverts commit eb2859af981415ed6bf08fcf4d8f19811bf95494.
(cherry picked from commit f0499c94071c11d31d5afc996431cf4b909dbd76)
- - - - -
632623d7 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/linker: Don't fail due to RTLD_NOW
In !12264 we started using the NativeObj machinery introduced some time
ago for loading of shared objects. One of the side-effects of this
change is shared objects are now loaded eagerly (i.e. with `RTLD_NOW`).
This is needed by NativeObj to ensure full visibility of the mappings of
the loaded object, which is in turn needed for safe shared object
unloading.
Unfortunately, this change subtly regressed, causing compilation
failures in some programs. Specifically, shared objects which refer to
undefined symbols (e.g. which may be usually provided by either the
executable image or libraries loaded via `dlopen`) will fail to load
with eager binding. This is problematic as GHC loads all package
dependencies while, e.g., evaluating TemplateHaskell splices. This
results in compilation failures in programs depending upon (but not
using at compile-time) packages with undefined symbol references.
To mitigate this NativeObj now first attempts to load an object via
eager binding, reverting to lazy binding (and disabling unloading) on
failure.
See Note [Don't fail due to RTLD_NOW].
Fixes #25943.
(cherry picked from commit 715d2a8550418d342bea767e1a4b0c7695966463)
(cherry picked from commit a9de3b73ebb6f29eeae7d170a0210f5bedeb8d85)
- - - - -
ce4c8735 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/linker: Factor out ProddableBlocks machinery
(cherry picked from commit 2921131cfa185c8e0ec48ddce2c994615493ca0a)
(cherry picked from commit 7d7e096504cd35272df9727b92dcbe7d94927ac8)
- - - - -
3ee32ef9 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/linker: Improve efficiency of proddable blocks structure
Previously the linker's "proddable blocks" check relied on a simple
linked list of spans. This resulted in extremely poor complexity while
linking objects with lots of small sections (e.g. objects built with
split sections).
Rework the mechanism to instead use a simple interval set implemented
via binary search.
Fixes #26009.
(cherry picked from commit e6e69dba996f47e21391f023010f5b138dc1df9c)
(cherry picked from commit b388ca86b5e56636a1862987ec1b1d3deefedc9e)
- - - - -
bf2d27b5 by Ben Gamari at 2025-09-04T17:54:57+05:30
testsuite: Add simple functional test for ProddableBlockSet
(cherry picked from commit 915902fc09ff4b00cf676c40d31dbbbf7d1cb7d7)
(cherry picked from commit dc4c540ddd39fb99b18630aebd2849ac29a4cd73)
- - - - -
553dcd51 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/linker/PEi386: Drop check for LOAD_LIBRARY_SEARCH_*_DIRS
The `LOAD_LIBRARY_SEARCH_USER_DIRS` and
`LOAD_LIBRARY_SEARCH_DEFAULT_DIRS` were introduced in Windows Vista and
have been available every since. As we no longer support Windows XP we
can drop this check.
Addresses #26009.
(cherry picked from commit 1f38e2739fbbae3cbe925320fa70965004aaaca5)
(cherry picked from commit 10cfa8946b76a914fb3ecd4df62d32160b64151a)
- - - - -
754f5c06 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/linker/PEi386: Clean up code style
(cherry picked from commit facf379b0f1c0d1cbc3c1896cce603c89e837481)
(cherry picked from commit 92793b3799525f46373d9696c7e91c0d14860fa8)
- - - - -
002ac0bf by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/Hash: Factor out hashBuffer
This is a useful helper which can be used for non-strings as well.
(cherry picked from commit 827961b9a724d8b2dd848222f980efc2de3996e3)
(cherry picked from commit a8c1ecb0d45050491496c0d04cc022a294a075b1)
- - - - -
338c6066 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/linker/PEi386: Fix incorrect use of break in nested for
Previously the happy path of PEi386 used `break` in a double-`for` loop
resulting in redundant calls to `LoadLibraryEx`.
Fixes #26052.
(cherry picked from commit 6fbb05cf8a999628476d0d7274f30ef45e4d3932)
(cherry picked from commit 36a8bd2b7ceb0622e0aca2bed9cee7162076379c)
- - - - -
c3471809 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts: Correctly mark const arguments
(cherry picked from commit 320d7dd3e8de62f970d23ac1d27c665093d22aaa)
(cherry picked from commit 3a389cacefaffb3293f6b5f2ed5b20f2dbb9b4e3)
- - - - -
b79b3668 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/linker/PEi386: Don't repeatedly load DLLs
Previously every DLL-imported symbol would result in a call to
`LoadLibraryEx`. This ended up constituting over 40% of the runtime of
`ghc --interactive -e 42` on Windows. Avoid this by maintaining a
hash-set of loaded DLL names, skipping the call if we have already
loaded the requested DLL.
Addresses #26009.
(cherry picked from commit e6b0067bfa49b42bf4599af8d6a3c97878302624)
(cherry picked from commit b24be9b90adcf3fb9ee0c6b7e120b4bf1e77f072)
- - - - -
3ebc4f8d by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/linker: Expand comment describing ProddableBlockSet
(cherry picked from commit 9631a12c0b89529c3d1147d0770ec6b9023cdb17)
(cherry picked from commit 6ad664de0a4ab3e1747d318aabb5035ce7c74fcd)
- - - - -
ca493586 by Cheng Shao at 2025-09-04T17:54:57+05:30
rts: fix rts_clearMemory logic when sanity checks are enabled
This commit fixes an RTS assertion failure when invoking
rts_clearMemory with +RTS -DS. -DS implies -DZ which asserts that free
blocks contain 0xaa as the designated garbage value. Also adds the
sanity way to rts_clearMemory test to prevent future regression.
Closes #26011.
ChatGPT Codex automatically diagnosed the issue and proposed the
initial patch in a single shot, given a GHC checkout and the following
prompt:
---
Someone is reporting the following error when attempting to use `rts_clearMemory` with the RTS option `-DS`:
```
test.wasm: internal error: ASSERTION FAILED: file rts/sm/Storage.c, line 1216
(GHC version 9.12.2.20250327 for wasm32_unknown_wasi)
Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug
```
What's the culprit? How do I look into this issue?
---
I manually reviewed & revised the patch, tested and submitted it.
(cherry picked from commit 86406f48659a5ab61ce1fd2a2d427faba2dcdb09)
- - - - -
280f87fe by kwxm at 2025-09-04T17:54:57+05:30
Fix bugs in `integerRecipMod` and `integerPowMod`
This fixes #26017.
* `integerRecipMod x 1` now returns `(# 1 | #)` for all x; previously it
incorrectly returned `(# | () #)`, indicating failure.
* `integerPowMod 0 e m` now returns `(# | () #)` for e<0 and m>1, indicating
failure; previously it incorrectly returned `(# 0 | #)`.
(cherry picked from commit 8ded23300367c6e032b3c5a635fd506b8915374b)
- - - - -
905715ad by Matthew Pickering at 2025-09-04T17:54:57+05:30
interpreter: Fix INTERP_STATS profiling code
The profiling code had slightly bitrotted since the last time it was
used. This just fixes things so that if you toggle the INTERP_STATS
macro then it just works and prints out the stats.
Fixes #25695
(cherry picked from commit 66c7f65676801367f440a6a644f87d71157d2f3f)
- - - - -
8033abd5 by Matthew Pickering at 2025-09-04T17:54:57+05:30
interpreter: Fix overflows and reentrancy in statistics calculation
1. Use unsigned long for counter, as they can easily overflow if you are
running a long benchmark.
2. Make interp_shutdown reentrant by copying the command frequency table
into an array.
Fixes #25756
(cherry picked from commit c4e112fccd10ca745771dd81d2c1eb340aa8dd86)
- - - - -
2759c597 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts: Tighten up invariants of PACK
(cherry picked from commit aa58fc5b9745a2201707de81a91960b213ea3258)
- - - - -
30cd1559 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts: Improve documentation of SLIDE bytecode instruction
(cherry picked from commit 0e084029def86e9e67b89317f44fd71c823e9bca)
- - - - -
f5ff86f2 by Ben Gamari at 2025-09-04T17:54:57+05:30
rts/Interpreter: Assert that TEST*_P discriminators are valid
(cherry picked from commit 9bf3663b9970851e7b5701d68147450272823197)
- - - - -
60906d43 by Ben Gamari at 2025-09-04T17:54:58+05:30
Revert "rts/Interpreter: Assert that TEST*_P discriminators are valid"
This assertion was based on the misconception that `GET_TAG` was
returning the pointer tag whereas it is actually returning the
constructor tag.
This reverts commit 9bf3663b9970851e7b5701d68147450272823197.
Fixes #25527.
(cherry picked from commit dd95940639fd198f97fb3f44e84494eaca721788)
- - - - -
d302744c by Matthew Pickering at 2025-09-04T17:54:58+05:30
interpreter: Fix underflow frame lookups
BCOs can be nested, resulting in nested BCO stack frames where the inner most
stack frame can refer to variables stored on earlier stack frames via the
PUSH_L instruction.
|---------|
| BCO_1 | -<-┐
|---------|
......... |
|---------| | PUSH_L <n>
| BCO_N | ->-┘
|---------|
Here BCO_N is syntactically nested within the code for BCO_1 and will result
in code that references the prior stack frame of BCO_1 for some of it's local
variables. If a stack overflow happens between the creation of the stack frame
for BCO_1 and BCO_N the RTS might move BCO_N to a new stack chunk while leaving
BCO_1 in place, invalidating a simple offset based reference to the outer stack
frames.
Therefore `ReadSpW` first performs a bounds check to ensure that accesses onto
the stack will succeed. If the target address would not be a valid location for
the current stack chunk then `slow_spw` function is called, which dereferences
the underflow frame to adjust the offset before performing the lookup.
┌->--x | CHK_1 |
| CHK_2 | | | |---------|
|---------| | └-> | BCO_1 |
| UD_FLOW | -- x |---------|
|---------| |
| ...... | |
|---------| | PUSH_L <n>
| BCO_ N | ->-┘
|---------|
Fixes #25750
(cherry picked from commit f4da90f11e3a3a634ec3edb6d70d96fe3515b726)
- - - - -
63480835 by Ben Gamari at 2025-09-04T17:54:58+05:30
base: Note strictness changes made in 4.16.0.0
Addresses #25886.
(cherry picked from commit 7722232c6f8f0b57db03d0439d77896d38191bf9)
- - - - -
aaff4d7c by Hécate Kleidukos at 2025-09-04T17:54:58+05:30
Expose all of Backtraces' internals for ghc-internal
Closes #26049
(cherry picked from commit 16014bf84afa0d009b6254b103033bceca42233a)
- - - - -
5e37fa3b by ARATA Mizuki at 2025-09-04T17:54:58+05:30
AArch64 NCG: Fix sub-word arithmetic right shift
As noted in Note [Signed arithmetic on AArch64], we should zero-extend sub-word values.
Fixes #26061
(cherry picked from commit 265d0024abc95be941f8e4769f24af128eedaa10)
- - - - -
76b9fcbd by ARATA Mizuki at 2025-09-04T17:54:58+05:30
x86 NCG: Fix code generation of bswap64 on i386
Co-authored-by: sheaf <sam.derbyshire(a)gmail.com>
Fix #25601
(cherry picked from commit bfa6b70f27dc2ce7fc890ec71103c40f66497c77)
- - - - -
ac4851da by Cheng Shao at 2025-09-04T17:54:58+05:30
testsuite: add T26120 marked as broken
(cherry picked from commit 44b8cee2d5c114b238898ce4ee7b44ecaa0bf491)
- - - - -
1abd3606 by Berk Özkütük at 2025-09-04T17:54:58+05:30
Consider `PromotedDataCon` in `tyConStupidTheta`
Haddock checks data declarations for the stupid theta so as not to
pretty-print them as empty contexts. Type data declarations end up as
`PromotedDataCon`s by the time Haddock performs this check, causing a
panic. This commit extends `tyConStupidTheta` so that it returns an
empty list for `PromotedDataCon`s. This decision was guided by the fact
that type data declarations never have data type contexts (see (R1) in
Note [Type data declarations]).
Fixes #25739.
(cherry picked from commit 8d33d048dbe159a045a4c304fa92318365a3dfe2)
- - - - -
ebbabfb1 by Cheng Shao at 2025-09-04T17:54:58+05:30
compiler: fix GHC.SysTools.Ar archive member size writing logic
This patch fixes a long-standing bug in `GHC.SysTools.Ar` that emits
the wrong archive member size in each archive header. It should encode
the exact length of the member payload, excluding any padding byte,
otherwise malformed archive that extracts a broken object with an
extra trailing byte could be created.
Apart from the in-tree `T26120` test, I've also created an out-of-tree
testsuite at https://github.com/TerrorJack/ghc-ar-quickcheck that
contains QuickCheck roundtrip tests for `GHC.SysTools.Ar`. With this
fix, simple roundtrip tests and `writeGNUAr`/GNU `ar` roundtrip test
passes. There might be more bugs lurking in here, but this patch is
still a critical bugfix already.
Fixes #26120 #22586.
Co-authored-by: Codex <codex(a)openai.com>
(cherry picked from commit 894a04f3a82dd39ecef71619e2032c4dfead556e)
- - - - -
cf0c68dd by Teo Camarasu at 2025-09-04T17:54:58+05:30
rts/nonmovingGC: remove n_free
We remove the nonmovingHeap.n_free variable.
We wanted this to track the length of nonmovingHeap.free.
But this isn't possible to do atomically.
When this isn't accurate we can get a segfault by going past the end of
the list.
Instead, we just count the length of the list when we grab it in
nonmovingPruneFreeSegment.
Resolves #26186
(cherry picked from commit 45efaf71d97355f76fe0db5af2fc5b4b67fddf47)
- - - - -
1518404f by Andreas Klebinger at 2025-09-04T17:54:58+05:30
Disable -fprof-late-overloaded-calls for join points.
Currently GHC considers cost centres as destructive to
join contexts. Or in other words this is not considered valid:
join f x = ...
in
... -> scc<tick> jmp
This makes the functionality of `-fprof-late-overloaded-calls` not feasible
for join points in general. We used to try to work around this by putting the
ticks on the rhs of the join point rather than around the jump. However beyond
the loss of accuracy this was broken for recursive join points as we ended up
with something like:
rec-join f x = scc<tick> ... jmp f x
Which similarly is not valid as the tick once again destroys the tail call.
One might think we could limit ourselves to non-recursive tail calls and do
something clever like:
join f x = scc<tick> ...
in ... jmp f x
And sometimes this works! But sometimes the full rhs would look something like:
join g x = ....
join f x = scc<tick> ... -> jmp g x
Which, would again no longer be valid. I believe in the long run we can make
cost centre ticks non-destructive to join points. Or we could keep track of
where we are/are not allowed to insert a cost centre. But in the short term I will
simply disable the annotation of join calls under this flag.
(cherry picked from commit 7da86e165612721c4e09f772a3fdaffc733e9293)
- - - - -
41829358 by Sebastian Graf at 2025-09-04T17:54:58+05:30
CprAnal: Detect recursive newtypes (#25944)
While `cprTransformDataConWork` handles recursive data con workers, it
did not detect the case when a newtype is responsible for the recursion.
This is now detected in the `Cast` case of `cprAnal`.
The same reproducer made it clear that `isRecDataCon` lacked congruent
handling for `AppTy` and `CastTy`, now fixed.
Furthermore, the new repro case T25944 triggered this bug via an
infinite loop in `cprFix`, caused by the infelicity in `isRecDataCon`.
While it should be much less likely to trigger such an infinite loop now
that `isRecDataCon` has been fixed, I made sure to abort the loop after
10 iterations and emitting a warning instead.
Fixes #25944.
(cherry picked from commit 4bc78496406f7469640faaa46e2f311c05760124)
- - - - -
36436e87 by Ben Gamari at 2025-09-04T17:54:58+05:30
configure: Allow override of CrossCompiling
As noted in #26236, the current inference logic is a bit simplistic. In
particular, there are many cases (e.g. building for a new libc) where
the target and host triples may differ yet we are still able to run the
produced artifacts as native code.
Closes #26236.
(cherry picked from commit 81577fe7c1913c53608bf03e48f84507be904620)
- - - - -
8384119d by Simon Peyton Jones at 2025-09-04T17:54:58+05:30
Take more care in zonkEqTypes on AppTy/AppTy
This patch fixes #26256.
See Note [zonkEqTypes and the PKTI] in GHC.Tc.Solver.Equality
(cherry picked from commit 18036d5205ac648bb245217519fed2fd931a9982)
- - - - -
fa1e584a by Andreas Klebinger at 2025-09-04T17:54:58+05:30
Make unexpected LLVM versions a warning rather than an error.
Typically a newer LLVM version *will* work so erroring out if
a user uses a newer LLVM version is too aggressive.
Fixes #25915
(cherry picked from commit 50842f83f467ff54dd22470559a7af79d2025c03)
- - - - -
3b41b6e2 by Teo Camarasu at 2025-09-04T17:54:58+05:30
rts: spin if we see a WHITEHOLE in messageBlackHole
When a BLACKHOLE gets cancelled in raiseAsync, we indirect to a THUNK.
GC can then shortcut this, replacing our BLACKHOLE with a fresh THUNK.
This THUNK is not guaranteed to have a valid indirectee field.
If at the same time, a message intended for the previous BLACKHOLE is
processed and concurrently we BLACKHOLE the THUNK, thus temporarily
turning it into a WHITEHOLE, we can get a segfault, since we look at the
undefined indirectee field of the THUNK
The fix is simple: spin if we see a WHITEHOLE, and it will soon be
replaced with a valid BLACKHOLE.
Resolves #26205
(cherry picked from commit 4021181ee0860aca2054883a531f3312361cc701)
- - - - -
124fd2fd by Teo Camarasu at 2025-09-04T17:54:58+05:30
rts: ensure MessageBlackHole.link is always a valid closure
We turn a MessageBlackHole into an StgInd in wakeBlockingQueue().
Therefore it's important that the link field, which becomes the
indirection field, always points to a valid closure.
It's unclear whether it's currently possible for the previous behaviour
to lead to a crash, but it's good to be consistent about this invariant nonetheless.
Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at>
(cherry picked from commit a8b2fbae6bcf20bc2f3fe58803096d2a9c5fc43d)
- - - - -
1f8f030e by Reed Mullanix at 2025-09-04T17:54:58+05:30
ghc-internal: Fix naturalAndNot for NB/NS case
When the first argument to `naturalAndNot` is larger than a `Word` and the second is `Word`-sized, `naturalAndNot` will truncate the
result:
```
>>> naturalAndNot ((2 ^ 65) .|. (2 ^ 3)) (2 ^ 3)
0
```
In contrast, `naturalAndNot` does not truncate when both arguments are larger than a `Word`, so this appears to be a bug.
Luckily, the fix is pretty easy: we just need to call `bigNatAndNotWord#` instead of truncating.
Fixes #26230
(cherry picked from commit a766286fe759251eceb304c54ba52841c2a51f86)
- - - - -
d0629aa6 by Ben Gamari at 2025-09-04T17:54:58+05:30
llvmGen: Fix built-in variable predicate
Previously the predicate to identify LLVM builtin global variables was
checking for `$llvm` rather than `@llvm` as it should.
(cherry picked from commit 6e67fa083a50684e1cfae546e07cab4d4250e871)
- - - - -
88 changed files:
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/Cmm/Config.hs
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Cmm/Sink.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/Core/LateCC/OverloadedCalls.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Driver/Config/Cmm.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/SysTools/Ar.hs
- compiler/GHC/Tc/Solver/Equality.hs
- configure.ac
- docs/users_guide/profiling.rst
- libraries/base/changelog.md
- libraries/ghc-bignum/changelog.md
- libraries/ghc-bignum/src/GHC/Num/Integer.hs
- libraries/ghc-bignum/src/GHC/Num/Natural.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- rts/Hash.c
- rts/Hash.h
- rts/Interpreter.c
- rts/Interpreter.h
- rts/Linker.c
- rts/LinkerInternals.h
- rts/Messages.c
- rts/PathUtils.c
- rts/PathUtils.h
- rts/RtsMain.c
- rts/StgMiscClosures.cmm
- rts/Updates.h
- rts/include/rts/storage/InfoTables.h
- rts/linker/Elf.c
- rts/linker/LoadNativeObjPosix.c
- rts/linker/MachO.c
- rts/linker/PEi386.c
- rts/linker/PEi386.h
- + rts/linker/ProddableBlocks.c
- + rts/linker/ProddableBlocks.h
- rts/rts.cabal
- rts/sm/NonMoving.c
- rts/sm/NonMoving.h
- rts/sm/NonMovingAllocate.c
- rts/sm/Sanity.c
- rts/sm/Storage.h
- + testsuite/tests/cmm/should_run/T25601.hs
- + testsuite/tests/cmm/should_run/T25601.stdout
- + testsuite/tests/cmm/should_run/T25601a.cmm
- testsuite/tests/cmm/should_run/all.T
- + testsuite/tests/codeGen/should_run/T26061.hs
- + testsuite/tests/codeGen/should_run/T26061.stdout
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/cpranal/sigs/T25944.hs
- + testsuite/tests/cpranal/sigs/T25944.stderr
- testsuite/tests/cpranal/sigs/all.T
- testsuite/tests/ffi/should_run/all.T
- + testsuite/tests/ghc-api/T26120.hs
- + testsuite/tests/ghc-api/T26120.stdout
- testsuite/tests/ghc-api/all.T
- + testsuite/tests/lib/integer/T26017.hs
- + testsuite/tests/lib/integer/T26017.stdout
- testsuite/tests/lib/integer/all.T
- testsuite/tests/lib/integer/integerRecipMod.hs
- testsuite/tests/lib/integer/integerRecipMod.stdout
- + testsuite/tests/numeric/should_run/T26230.hs
- + testsuite/tests/numeric/should_run/T26230.stdout
- testsuite/tests/numeric/should_run/all.T
- + testsuite/tests/partial-sigs/should_compile/T26256.hs
- + testsuite/tests/partial-sigs/should_compile/T26256.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- + testsuite/tests/rts/TestProddableBlockSet.c
- testsuite/tests/rts/all.T
- + testsuite/tests/typecheck/should_compile/T26256a.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/typecheck/should_run/T25998.hs
- + testsuite/tests/typecheck/should_run/T25998.stdout
- testsuite/tests/typecheck/should_run/all.T
- + utils/haddock/html-test/ref/Bug25739.html
- + utils/haddock/html-test/src/Bug25739.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9edb71d5f782b8860e674240b6de71…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9edb71d5f782b8860e674240b6de71…
You're receiving this email because of your account on gitlab.haskell.org.
1
0