Simon Peyton Jones pushed to branch wip/T25992 at Glasgow Haskell Compiler / GHC
Commits:
8e5f3bd4 by Simon Peyton Jones at 2025-05-23T09:40:33+01:00
Further wibbles
- - - - -
4 changed files:
- compiler/GHC/Tc/Solver/Default.hs
- + testsuite/tests/typecheck/should_compile/T25992.hs
- + testsuite/tests/typecheck/should_compile/T25992.stderr
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
compiler/GHC/Tc/Solver/Default.hs
=====================================
@@ -247,11 +247,11 @@ tryUnsatisfiableGivens wc =
; solveAgainIf did_work final_wc }
where
go_wc (WC { wc_simple = wtds, wc_impl = impls, wc_errors = errs })
- = do impls' <- mapMaybeBagM go_impl impls
+ = do impls' <- mapBagM go_impl impls
return $ WC { wc_simple = wtds, wc_impl = impls', wc_errors = errs }
go_impl impl
| isSolvedStatus (ic_status impl)
- = return $ Just impl
+ = return impl
-- Is there a Given with type "Unsatisfiable msg"?
-- If so, use it to solve all other Wanteds.
| unsat_given:_ <- mapMaybe unsatisfiableEv_maybe (ic_given impl)
@@ -271,7 +271,7 @@ unsatisfiableEv_maybe v = (v,) <$> isUnsatisfiableCt_maybe (idType v)
-- | We have an implication with an 'Unsatisfiable' Given; use that Given to
-- solve all the other Wanted constraints, including those nested within
-- deeper implications.
-solveImplicationUsingUnsatGiven :: (EvVar, Type) -> Implication -> TcS (Maybe Implication)
+solveImplicationUsingUnsatGiven :: (EvVar, Type) -> Implication -> TcS Implication
solveImplicationUsingUnsatGiven
unsat_given@(given_ev,_)
impl@(Implic { ic_wanted = wtd, ic_tclvl = tclvl, ic_binds = ev_binds_var
@@ -279,7 +279,7 @@ solveImplicationUsingUnsatGiven
| isCoEvBindsVar ev_binds_var
-- We can't use Unsatisfiable evidence in kinds.
-- See Note [Coercion evidence only] in GHC.Tc.Types.Evidence.
- = return $ Just impl
+ = return impl
| otherwise
= do { wcs <- nestImplicTcS ev_binds_var tclvl $ go_wc wtd
; setImplicationStatus $
@@ -290,7 +290,7 @@ solveImplicationUsingUnsatGiven
go_wc :: WantedConstraints -> TcS WantedConstraints
go_wc wc@(WC { wc_simple = wtds, wc_impl = impls })
= do { mapBagM_ go_simple wtds
- ; impls <- mapMaybeBagM (solveImplicationUsingUnsatGiven unsat_given) impls
+ ; impls <- mapBagM (solveImplicationUsingUnsatGiven unsat_given) impls
; return $ wc { wc_simple = emptyBag, wc_impl = impls } }
go_simple :: Ct -> TcS ()
go_simple ct = case ctEvidence ct of
=====================================
testsuite/tests/typecheck/should_compile/T25992.hs
=====================================
@@ -0,0 +1,8 @@
+{-# OPTIONS_GHC -Wredundant-constraints #-}
+
+module T25992 where
+
+data P a = P
+
+instance Eq a => Semigroup (P a) where
+ P <> P = P
=====================================
testsuite/tests/typecheck/should_compile/T25992.stderr
=====================================
@@ -0,0 +1,3 @@
+ T25992.hs:7:10: error: [GHC-30606] [-Wredundant-constraints, Werror=redundant-constraints]
+ • Redundant constraint: Eq a
+ • In the instance declaration for ‘Semigroup (P a)’
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -941,3 +941,4 @@ test('T25597', normal, compile, [''])
test('T25960', normal, compile, [''])
test('T26020', normal, compile, [''])
test('T26020a', [extra_files(['T26020a_help.hs'])], multimod_compile, ['T26020a', '-v0'])
+test('T25992', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e5f3bd4c27578ad355bbdeeaf1283a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e5f3bd4c27578ad355bbdeeaf1283a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/top-level-bcos-tag] 2 commits: debugger/rts: Allow toggling step-in per thread
by Rodrigo Mesquita (＠alt-romes) 23 May '25
by Rodrigo Mesquita (＠alt-romes) 23 May '25
23 May '25
Rodrigo Mesquita pushed to branch wip/romes/top-level-bcos-tag at Glasgow Haskell Compiler / GHC
Commits:
b0249bf0 by Rodrigo Mesquita at 2025-05-23T09:04:51+01:00
debugger/rts: Allow toggling step-in per thread
The RTS global flag `rts_stop_next_breakpoint` globally sets the
interpreter to stop at the immediate next breakpoint.
With this commit, single step mode can additionally be set per thread in
the TSO flag (TSO_STOP_NEXT_BREAKPOINT).
Being able to toggle "stop at next breakpoint" per thread is an
important requirement for implementing "stepping out" of a function in a
multi-threaded context.
And, more generally, having a per-thread flag for single-stepping paves the
way for multi-threaded debugging.
That said, when we want to enable "single step" mode for the whole
interpreted program we still want to stop at the immediate next
breakpoint, whichever thread it belongs to.
That's why we also keep the global `rts_stop_next_breakpoint` flag, with
`rts_enableStopNextBreakpointAll` and `rts_disableStopNextBreakpointAll` helpers.
Preparation for #26042
- - - - -
8c40855b by Rodrigo Mesquita at 2025-05-23T09:16:43+01:00
rts: Case continuation BCOs
This commit introduces the `stg_CASE_CONT_BCO` info table, which is
identical to `stg_BCO` and shares the same closure type (== BCO).
It changes the bytecode generator to always use `stg_CASE_CONT_BCO_info`
when constructing case continuation BCOs, and remain using `stg_BCO`
otherwise.
This allows us to distinguish at runtime case continuation BCOs from
other BCOs. In particular, this is relevant because, unlike other BCOs,
the code of a case continuation BCO may refer to variables in its
parent's stack frame (ie non-local variables), and therefore its frame
position on the stack cannot be changed in isolation.
The full motivation and details are in Note [Case continuation BCOs].
Towards #26042
- - - - -
25 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/StgToByteCode.hs
- libraries/base/src/GHC/Exts.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
- libraries/ghc-heap/tests/parse_tso_flags.hs
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghci/GHCi/CreateBCO.hs
- + libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Interpreter.c
- rts/Interpreter.h
- rts/PrimOps.cmm
- rts/Printer.c
- rts/RtsSymbols.c
- rts/StgMiscClosures.cmm
- rts/include/rts/Constants.h
- rts/include/stg/MiscClosures.h
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -3872,12 +3872,13 @@ primop MkApUpd0_Op "mkApUpd0#" GenPrimOp
with
out_of_line = True
-primop NewBCOOp "newBCO#" GenPrimOp
- ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #)
- { @'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The
+primop NewBCOOp "newBCO2#" GenPrimOp
+ Int8# -> ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #)
+ { @'newBCO2#' is_case_cont instrs lits ptrs arity bitmap@ creates a new bytecode object. The
resulting object encodes a function of the given arity with the instructions
encoded in @instrs@, and a static reference table usage bitmap given by
- @bitmap@. }
+ @bitmap@. The @is_case_cont@ boolean indicates whether the BCO is a case
+ continuation (see Note [Case continuation BCOs]) }
with
effect = ReadWriteEffect
out_of_line = True
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -85,7 +85,7 @@ bcoFreeNames :: UnlinkedBCO -> UniqDSet Name
bcoFreeNames bco
= bco_refs bco `uniqDSetMinusUniqSet` mkNameSet [unlinkedBCOName bco]
where
- bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
+ bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs _)
= unionManyUniqDSets (
mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] :
mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] :
@@ -236,7 +236,8 @@ assembleBCO platform
, protoBCOInstrs = instrs
, protoBCOBitmap = bitmap
, protoBCOBitmapSize = bsize
- , protoBCOArity = arity }) = do
+ , protoBCOArity = arity
+ , protoBCOIsCaseCont = isCC }) = do
-- pass 1: collect up the offsets of the local labels.
let initial_offset = 0
@@ -266,7 +267,7 @@ assembleBCO platform
let !insns_arr = mkBCOByteArray $ final_isn_array
!bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap
- ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSmallArray final_lit_array) (fromSmallArray final_ptr_array)
+ ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSmallArray final_lit_array) (fromSmallArray final_ptr_array) isCC
-- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
-- objects, since they might get run too early. Disable this until
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -53,7 +53,8 @@ data ProtoBCO a
-- what the BCO came from, for debugging only
protoBCOExpr :: Either [CgStgAlt] CgStgRhs,
-- malloc'd pointers
- protoBCOFFIs :: [FFIInfo]
+ protoBCOFFIs :: [FFIInfo],
+ protoBCOIsCaseCont :: !Bool -- See Note [Case continuation BCOs]
}
-- | A local block label (e.g. identifying a case alternative).
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -59,7 +59,7 @@ linkBCO
-> UnlinkedBCO
-> IO ResolvedBCO
linkBCO interp pkgs_loaded le bco_ix
- (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do
+ (UnlinkedBCO _ arity insns bitmap lits0 ptrs0 isCC) = do
-- fromIntegral Word -> Word64 should be a no op if Word is Word64
-- otherwise it will result in a cast to longlong on 32bit systems.
(lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0)
@@ -69,7 +69,7 @@ linkBCO interp pkgs_loaded le bco_ix
insns
bitmap
(mkBCOByteArray lits')
- (addListToSS emptySS ptrs))
+ (addListToSS emptySS ptrs) isCC)
lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word
lookupLiteral interp pkgs_loaded le ptr = case ptr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -167,14 +167,108 @@ newtype ItblPtr = ItblPtr (RemotePtr Heap.StgInfoTable)
newtype AddrPtr = AddrPtr (RemotePtr ())
deriving (NFData)
+{-
+--------------------------------------------------------------------------------
+-- * Byte Code Objects (BCOs)
+--------------------------------------------------------------------------------
+
+Note [Case continuation BCOs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A stack with a BCO stack frame at the top looks like:
+
+ (an StgBCO)
+ | ... | +---> +---------[1]--+
+ +------------------+ | | info_tbl_ptr | ------+
+ | OTHER FRAME | | +--------------+ |
+ +------------------+ | | StgArrBytes* | <--- the byte code
+ | ... | | +--------------+ |
+ +------------------+ | | ... | |
+ | fvs1 | | |
+ +------------------+ | |
+ | ... | | (StgInfoTable) |
+ +------------------+ | +----------+ <---+
+ | args1 | | | ... |
+ +------------------+ | +----------+
+ | some StgBCO* | -----+ | type=BCO |
+ +------------------+ +----------+
+ Sp | stg_apply_interp | -----+ | ... |
+ +------------------+ |
+ |
+ | (StgInfoTable)
+ +----> +--------------+
+ | ... |
+ +--------------+
+ | type=RET_BCO |
+ +--------------+
+ | ... |
+
+
+The byte code for a BCO heap object makes use of arguments and free variables
+which can typically be found within the BCO stack frame. In the code, these
+variables are referenced via a statically known stack offset (tracked using
+`BCEnv` in `StgToByteCode`).
+
+However, in /case continuation/ BCOs, the code may additionally refer to free
+variables that are outside of that BCO's stack frame -- some free variables of a
+case continuation BCO may only be found in the stack frame of a parent BCO.
+
+Yet, references to these out-of-frame variables are also done in terms of stack
+offsets. Thus, they rely on the position of /another frame/ to be fixed. (See
+Note [PUSH_L underflow] for more information about references to previous
+frames and nested BCOs)
+
+This makes case continuation BCOs special: unlike normal BCOs, case cont BCO
+frames cannot be moved on the stack independently from their parent BCOs.
+
+In order to be able to distinguish them at runtime, the code generator will use
+distinct info table pointers for their closures, even though they will have the
+same structure on the heap (StgBCO). Specifically:
+
+ - Normal BCOs are always headed by the `stg_BCO_info` pointer.
+ - Case continuation BCOs are always headed by the `stg_CASE_CONT_BCO_info` pointer.
+
+A primary reason why we need to distinguish these two cases is to know where we
+can insert a debugger step-out frame (`stg_stop_after_ret_frame`). In
+particular, because case cont BCOs may refer to the parent frame, we must not
+insert step-out frames between a case cont BCO and its parent.
+
+As an example, consider the following, where `y` is free in the case alternatives:
+
+ f x y = case x of
+ True -> y - 1
+ False -> y + 1 :: Int
+
+While interpreting f, the args x and y will be on the stack as part of f's frame.
+In its body, a case continuation BCO is pushed (PUSH_ALTS) and then `x` is
+entered to be evaluated. Upon entering `x`, the stack would look something like:
+
+ <f arg 2>
+ <f arg 1>
+ ...
+ <Case continuation BCO Frame>
+
+We cannot insert a step out frame in between:
+
+
+ <f arg 2>
+ <f arg 1>
+ ...
+ <inserted step-out frame> <--- BAD! Breaks stack offsets in the case cont.
+ <Case continuation BCO Frame>
+
+Instead, we must traverse until the parent BCO and insert the step-out frame before it instead.
+-}
+
data UnlinkedBCO
= UnlinkedBCO {
unlinkedBCOName :: !Name,
unlinkedBCOArity :: {-# UNPACK #-} !Int,
- unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns
- unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap
+ unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns
+ unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap
unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs
- unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs
+ unlinkedBCOPtrs :: !(FlatBag BCOPtr), -- ptrs
+ unlinkedBCOIsCaseCont :: !Bool -- See Note [Case continuation BCOs]
}
instance NFData UnlinkedBCO where
@@ -227,10 +321,11 @@ seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_resty
instance Outputable UnlinkedBCO where
- ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
+ ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs pi)
= sep [text "BCO", ppr nm, text "with",
ppr (sizeFlatBag lits), text "lits",
- ppr (sizeFlatBag ptrs), text "ptrs" ]
+ ppr (sizeFlatBag ptrs), text "ptrs",
+ ppr pi, text "is_pos_indep"]
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -253,7 +253,11 @@ mkProtoBCO
-> Int -- ^ arity
-> WordOff -- ^ bitmap size
-> [StgWord] -- ^ bitmap
- -> Bool -- ^ True <=> is a return point, rather than a function
+ -> Bool -- ^ True <=> it's a case continuation, rather than a function
+ -- Used for
+ -- (A) Stack check collision and
+ -- (B) Mark the BCO wrt whether it contains non-local stack
+ -- references. See Note [Case continuation BCOs].
-> [FFIInfo]
-> ProtoBCO Name
mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
@@ -264,7 +268,8 @@ mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bit
protoBCOBitmapSize = fromIntegral bitmap_size,
protoBCOArity = arity,
protoBCOExpr = origin,
- protoBCOFFIs = ffis
+ protoBCOFFIs = ffis,
+ protoBCOIsCaseCont = is_ret
}
where
#if MIN_VERSION_rts(1,0,3)
@@ -353,6 +358,9 @@ schemeTopBind (id, rhs)
-- Park the resulting BCO in the monad. Also requires the
-- name of the variable to which this value was bound,
-- so as to give the resulting BCO a name.
+--
+-- The resulting ProtoBCO expects the free variables and the function arguments
+-- to be in the stack directly before it.
schemeR :: [Id] -- Free vars of the RHS, ordered as they
-- will appear in the thunk. Empty for
-- top-level things, which have no free vars.
@@ -391,6 +399,8 @@ schemeR_wrk fvs nm original_body (args, body)
-- them unlike constructor fields.
szsb_args = map (wordsToBytes platform . idSizeW platform) all_args
sum_szsb_args = sum szsb_args
+ -- Make a stack offset for each argument or free var -- they should
+ -- appear contiguous in the stack, in order.
p_init = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args))
-- make the arg bitmap
@@ -1401,7 +1411,7 @@ Note [unboxed tuple bytecodes and tuple_BCO]
tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
tupleBCO platform args_info args =
mkProtoBCO platform Nothing invented_name body_code (Left [])
- 0{-no arity-} bitmap_size bitmap False{-is alts-}
+ 0{-no arity-} bitmap_size bitmap False{-not alts-}
where
{-
The tuple BCO is never referred to by name, so we can get away
@@ -1422,7 +1432,7 @@ tupleBCO platform args_info args =
primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
primCallBCO platform args_info args =
mkProtoBCO platform Nothing invented_name body_code (Left [])
- 0{-no arity-} bitmap_size bitmap False{-is alts-}
+ 0{-no arity-} bitmap_size bitmap False{-not alts-}
where
{-
The primcall BCO is never referred to by name, so we can get away
=====================================
libraries/base/src/GHC/Exts.hs
=====================================
@@ -26,12 +26,12 @@ module GHC.Exts
-- ** Legacy interface for arrays of arrays
module GHC.Internal.ArrayArray,
-- * Primitive operations
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
+ {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 10.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
Prim.BCO,
{-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
Prim.mkApUpd0#,
{-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.newBCO#,
+ IExts.newBCO#,
module GHC.Prim,
module GHC.Prim.Ext,
-- ** Running 'RealWorld' state thread
@@ -119,7 +119,7 @@ module GHC.Exts
maxTupleSize
) where
-import GHC.Internal.Exts
+import GHC.Internal.Exts hiding ( newBCO# )
import GHC.Internal.ArrayArray
import GHC.Prim hiding
( coerce
@@ -132,7 +132,7 @@ import GHC.Prim hiding
, isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned#
-- deprecated
- , BCO, mkApUpd0#, newBCO#
+ , BCO, mkApUpd0#
-- Don't re-export vector FMA instructions
, fmaddFloatX4#
@@ -256,8 +256,10 @@ import GHC.Prim hiding
, minWord8X32#
, minWord8X64#
)
+import qualified GHC.Internal.Exts as IExts
+ ( newBCO# )
import qualified GHC.Prim as Prim
- ( BCO, mkApUpd0#, newBCO# )
+ ( BCO, mkApUpd0# )
import GHC.Prim.Ext
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -624,6 +624,7 @@ data TsoFlags
| TsoMarked
| TsoSqueezed
| TsoAllocLimit
+ | TsoStopNextBreakpoint
| TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug
deriving (Eq, Show, Generic, Ord)
=====================================
libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
=====================================
@@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset
| isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)
| isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)
| isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)
+#if __GLASGOW_HASKELL__ >= 913
+ | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
+#endif
parseTsoFlags 0 = []
parseTsoFlags w = [TsoFlagsUnknownValue w]
=====================================
libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
=====================================
@@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset
| isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)
| isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)
| isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)
+#if __GLASGOW_HASKELL__ >= 913
+ | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
+#endif
parseTsoFlags 0 = []
parseTsoFlags w = [TsoFlagsUnknownValue w]
=====================================
libraries/ghc-heap/tests/parse_tso_flags.hs
=====================================
@@ -13,5 +13,6 @@ main = do
assertEqual (parseTsoFlags 64) [TsoMarked]
assertEqual (parseTsoFlags 128) [TsoSqueezed]
assertEqual (parseTsoFlags 256) [TsoAllocLimit]
+ assertEqual (parseTsoFlags 512) [TsoStopNextBreakpoint]
assertEqual (parseTsoFlags 6) [TsoLocked, TsoBlockx]
=====================================
libraries/ghc-internal/src/GHC/Internal/Exts.hs
=====================================
@@ -163,6 +163,9 @@ module GHC.Internal.Exts
-- * The maximum tuple size
maxTupleSize,
+
+ -- * Interpreter
+ newBCO#
) where
import GHC.Internal.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# )
@@ -469,3 +472,18 @@ resizeSmallMutableArray# arr0 szNew a s0 =
-- accessible\" by word.
considerAccessible :: Bool
considerAccessible = True
+
+--------------------------------------------------------------------------------
+-- Interpreter
+
+{-|
+@'newBCO#' instrs lits ptrs arity bitmap@ creates a new bytecode object. The
+resulting object encodes a function of the given arity with the instructions
+encoded in @instrs@, and a static reference table usage bitmap given by
+@bitmap@.
+
+Note: Case continuation BCOs, with non-local stack references, must be
+constructed using @'newBCO2#' 1@ instead. See Note [Case continuation BCOs].
+-}
+newBCO# :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #)
+newBCO# b1 b2 a1 i1 b3 s = newBCO2# (intToInt8# 0#) b1 b2 a1 i1 b3 s
=====================================
libraries/ghci/GHCi/CreateBCO.hs
=====================================
@@ -87,11 +87,11 @@ linkBCO' arr ResolvedBCO{..} = do
literals_barr = barr (getBCOByteArray resolvedBCOLits)
PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs
+ let is_case_cont | resolvedBCOIsCaseCont = intToInt8# 1#
+ | otherwise = intToInt8# 0#
IO $ \s ->
case unsafeFreezeArray# marr s of { (# s, arr #) ->
- case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io ->
- io s
- }}
+ newBCO2# is_case_cont insns_barr literals_barr arr arity# bitmap_barr s }
-- we recursively link any sub-BCOs while making the ptrs array
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -0,0 +1,67 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+module GHCi.Debugger
+ (
+ -- * Single step mode
+ rts_enableStopNextBreakpoint
+ , rts_enableStopNextBreakpointAll
+ , rts_disableStopNextBreakpoint
+ , rts_disableStopNextBreakpointAll
+
+ -- * Stop on exception
+ , exceptionFlag
+
+ -- * Breakpoint Callback
+ , BreakpointCallback
+ , breakPointIOAction
+ ) where
+
+import Prelude -- See note [Why do we import Prelude here?]
+
+import GHC.Base (ThreadId#, Addr#, Int#)
+import Foreign.C (CInt)
+import Foreign (StablePtr, Ptr, Storable (..))
+import GHCi.RemoteTypes (HValue)
+
+--------------------------------------------------------------------------------
+-- Single step mode
+
+-- | Enables the single step mode for a specific thread, thus stopping only on
+-- breakpoints in that thread.
+foreign import ccall unsafe "rts_enableStopNextBreakpoint"
+ rts_enableStopNextBreakpoint :: ThreadId# -> IO ()
+
+-- | Disables per-thread single-step mode. Note: if global single-step is
+-- enabled we stop at all breakpoints regardless of the per-thread flag.
+foreign import ccall unsafe "rts_disableStopNextBreakpoint"
+ rts_disableStopNextBreakpoint :: ThreadId# -> IO ()
+
+-- | Enables the single step mode for all threads, thus stopping at any
+-- existing breakpoint.
+foreign import ccall unsafe "rts_enableStopNextBreakpointAll"
+ rts_enableStopNextBreakpointAll :: IO ()
+
+-- | Disables the single step mode for all threads
+foreign import ccall unsafe "rts_disableStopNextBreakpointAll"
+ rts_disableStopNextBreakpointAll :: IO ()
+
+--------------------------------------------------------------------------------
+
+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 unit id
+ -> Int# -- breakpoint info index
+ -> Bool -- exception?
+ -> HValue -- the AP_STACK, or exception
+ -> IO ()
+
+foreign import ccall "&rts_breakpoint_io_action"
+ breakPointIOAction :: Ptr (StablePtr BreakpointCallback)
+
=====================================
libraries/ghci/GHCi/ResolvedBCO.hs
=====================================
@@ -45,7 +45,8 @@ data ResolvedBCO
resolvedBCOBitmap :: BCOByteArray Word, -- ^ bitmap
resolvedBCOLits :: BCOByteArray Word,
-- ^ non-ptrs - subword sized entries still take up a full (host) word
- resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ^ ptrs
+ resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr), -- ^ ptrs
+ resolvedBCOIsCaseCont :: !Bool -- ^ See Note [Case continuation BCOs]
}
deriving (Generic, Show)
@@ -86,7 +87,8 @@ instance Binary ResolvedBCO where
put resolvedBCOBitmap
put resolvedBCOLits
put resolvedBCOPtrs
- get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get
+ put resolvedBCOIsCaseCont
+ get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get <*> get
-- See Note [BCOByteArray serialization]
instance (Binary a, Storable a, IArray UArray a) => Binary (BCOByteArray a) where
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,
- UnboxedTuples, LambdaCase #-}
+ UnboxedTuples, LambdaCase, UnliftedFFITypes #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-- |
@@ -20,6 +20,7 @@ import GHCi.InfoTable
#endif
import qualified GHC.InfoProv as InfoProv
+import GHCi.Debugger
import GHCi.FFI
import GHCi.Message
import GHCi.ObjLink
@@ -332,7 +333,7 @@ withBreakAction opts breakMVar statusMVar act
stablePtr <- newStablePtr onBreak
poke breakPointIOAction stablePtr
when (breakOnException opts) $ poke exceptionFlag 1
- when (singleStep opts) $ setStepFlag
+ when (singleStep opts) rts_enableStopNextBreakpointAll
return stablePtr
-- Breaking on exceptions is not enabled by default, since it
-- might be a bit surprising. The exception flag is turned off
@@ -363,7 +364,7 @@ withBreakAction opts breakMVar statusMVar act
resetBreakAction stablePtr = do
poke breakPointIOAction noBreakStablePtr
poke exceptionFlag 0
- resetStepFlag
+ rts_disableStopNextBreakpointAll
freeStablePtr stablePtr
resumeStmt
@@ -396,28 +397,6 @@ abandonStmt hvref = do
_ <- takeMVar resumeStatusMVar
return ()
-foreign import ccall "&rts_stop_next_breakpoint" stepFlag :: Ptr CInt
-foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
-
-setStepFlag :: IO ()
-setStepFlag = poke stepFlag 1
-resetStepFlag :: IO ()
-resetStepFlag = poke stepFlag 0
-
-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 unit id
- -> Int# -- breakpoint info index
- -> Bool -- exception?
- -> HValue -- the AP_STACK, or exception
- -> IO ()
-
-foreign import ccall "&rts_breakpoint_io_action"
- breakPointIOAction :: Ptr (StablePtr BreakpointCallback)
-
noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -60,6 +60,7 @@ library
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
exposed-modules:
GHCi.Run
+ GHCi.Debugger
GHCi.CreateBCO
GHCi.ObjLink
GHCi.Signals
=====================================
rts/Interpreter.c
=====================================
@@ -203,14 +203,14 @@ 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
+in code that references the prior stack frame of BCO_1 for some of its 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
@@ -243,9 +243,44 @@ allocate_NONUPD (Capability *cap, int n_words)
return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
-int rts_stop_next_breakpoint = 0;
int rts_stop_on_exception = 0;
+/* ---------------------------------------------------------------------------
+ * Enabling and disabling global single step mode
+ * ------------------------------------------------------------------------ */
+
+/* A global toggle for single-step mode.
+ * Unlike `TSO_STOP_NEXT_BREAKPOINT`, which sets single-step mode per-thread,
+ * `rts_stop_next_breakpoint` globally enables single-step mode. If enabled, we
+ * will stop at the immediate next breakpoint regardless of what thread it is in. */
+int rts_stop_next_breakpoint = 0;
+
+void rts_enableStopNextBreakpointAll(void)
+{
+ rts_stop_next_breakpoint = 1;
+}
+
+void rts_disableStopNextBreakpointAll(void)
+{
+ rts_stop_next_breakpoint = 0;
+}
+
+/* ---------------------------------------------------------------------------
+ * Enabling and disabling per-thread single step mode
+ * ------------------------------------------------------------------------ */
+
+void rts_enableStopNextBreakpoint(StgPtr tso)
+{
+ ((StgTSO *)tso)->flags |= TSO_STOP_NEXT_BREAKPOINT;
+}
+
+void rts_disableStopNextBreakpoint(StgPtr tso)
+{
+ ((StgTSO *)tso)->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
+}
+
+/* -------------------------------------------------------------------------- */
+
#if defined(INTERP_STATS)
#define N_CODES 128
@@ -508,14 +543,35 @@ interpretBCO (Capability* cap)
//
// We have a BCO application to perform. Stack looks like:
//
- // | .... |
- // +---------------+
- // | arg1 |
- // +---------------+
- // | BCO |
- // +---------------+
- // Sp | RET_BCO |
- // +---------------+
+ //
+ // (an StgBCO)
+ // +---> +---------[1]--+
+ // | | stg_BCO_info | ------+
+ // | +--------------+ |
+ // | | StgArrBytes* | <--- the byte code
+ // | ... | | +--------------+ |
+ // +------------------+ | | ... | |
+ // | fvs1 | | |
+ // +------------------+ | |
+ // | ... | | (StgInfoTable) |
+ // +------------------+ | +----------+ <---+
+ // | args1 | | | ... |
+ // +------------------+ | +----------+
+ // | some StgBCO* | -----+ | type=BCO |
+ // +------------------+ +----------+
+ // Sp | stg_apply_interp | -----+ | ... |
+ // +------------------+ |
+ // |
+ // | (StgInfoTable)
+ // +----> +--------------+
+ // | ... |
+ // +--------------+
+ // | type=RET_BCO |
+ // +--------------+
+ // | ... |
+ //
+ // [1] An StgBCO's info table pointer may also be stg_CASE_CONT_BCO_info.
+ // See Note [Case continuation BCOs].
//
else if (SpW(0) == (W_)&stg_apply_interp_info) {
obj = UNTAG_CLOSURE((StgClosure *)ReadSpW(1));
@@ -1250,7 +1306,7 @@ run_BCO:
int arg8_cc;
#endif
StgArrBytes *breakPoints;
- int returning_from_break;
+ int returning_from_break, stop_next_breakpoint;
// the io action to run at a breakpoint
StgClosure *ioAction;
@@ -1280,6 +1336,13 @@ run_BCO:
returning_from_break =
cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
+ // check whether this thread is set to stop at the immediate next
+ // breakpoint -- either by the global `rts_stop_next_breakpoint`
+ // flag, or by the local `TSO_STOP_NEXT_BREAKPOINT`
+ stop_next_breakpoint =
+ rts_stop_next_breakpoint ||
+ cap->r.rCurrentTSO->flags & TSO_STOP_NEXT_BREAKPOINT;
+
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
(CostCentre*)BCO_LIT(arg8_cc));
@@ -1291,20 +1354,20 @@ run_BCO:
{
breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
- // stop the current thread if either the
- // "rts_stop_next_breakpoint" flag is true OR if the
- // ignore count for this particular breakpoint is zero
+ // 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];
- if (rts_stop_next_breakpoint == false && ignore_count > 0)
+ if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
}
- else if (rts_stop_next_breakpoint == true || ignore_count == 0)
+ else if (stop_next_breakpoint == true || ignore_count == 0)
{
// make sure we don't automatically stop at the
// next breakpoint
- rts_stop_next_breakpoint = false;
+ rts_stop_next_breakpoint = 0;
+ cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
// allocate memory for a new AP_STACK, enough to
// store the top stack frame plus an
@@ -1477,7 +1540,7 @@ run_BCO:
// Here we make sure references we push are tagged.
// See Note [CBV Functions and the interpreter] in Info.hs
- //Safe some memory reads if we already have a tag.
+ //Save some memory reads if we already have a tag.
if(GET_CLOSURE_TAG(tagged_obj) == 0) {
StgClosure *obj = UNTAG_CLOSURE(tagged_obj);
switch ( get_itbl(obj)->type ) {
=====================================
rts/Interpreter.h
=====================================
@@ -11,3 +11,8 @@
RTS_PRIVATE Capability *interpretBCO (Capability* cap);
void interp_startup ( void );
void interp_shutdown ( void );
+
+void rts_enableStopNextBreakpointAll ( void );
+void rts_disableStopNextBreakpointAll ( void );
+void rts_enableStopNextBreakpoint ( StgPtr );
+void rts_disableStopNextBreakpoint ( StgPtr );
=====================================
rts/PrimOps.cmm
=====================================
@@ -55,6 +55,7 @@ import CLOSURE stg_AP_STACK_info;
import CLOSURE stg_AP_info;
import CLOSURE stg_ARR_WORDS_info;
import CLOSURE stg_BCO_info;
+import CLOSURE stg_CASE_CONT_BCO_info;
import CLOSURE stg_C_FINALIZER_LIST_info;
import CLOSURE stg_DEAD_WEAK_info;
import CLOSURE stg_END_STM_WATCH_QUEUE_closure;
@@ -2434,7 +2435,8 @@ stg_deRefStablePtrzh ( P_ sp )
Bytecode object primitives
------------------------------------------------------------------------- */
-stg_newBCOzh ( P_ instrs,
+stg_newBCO2zh ( CBool is_case_cont,
+ P_ instrs,
P_ literals,
P_ ptrs,
W_ arity,
@@ -2449,7 +2451,16 @@ stg_newBCOzh ( P_ instrs,
bco = Hp - bytes + WDS(1);
// No memory barrier necessary as this is a new allocation.
- SET_HDR(bco, stg_BCO_info, CCS_MAIN);
+ if (is_case_cont > 0) {
+ /* Uses stg_CASE_CONT_BCO_info to construct the BCO frame (rather than stg_BCO_info).
+ * Case continuations may contain non-local references to parent frames. The distinct info table
+ * tag allows the RTS to identify such non-local frames.
+ * See Note [Case continuation BCOs]
+ */
+ SET_HDR(bco, stg_CASE_CONT_BCO_info, CCS_MAIN);
+ } else {
+ SET_HDR(bco, stg_BCO_info, CCS_MAIN);
+ }
StgBCO_instrs(bco) = instrs;
StgBCO_literals(bco) = literals;
=====================================
rts/Printer.c
=====================================
@@ -690,6 +690,8 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
debugBelch("stg_ctoi_V_info" );
} else if (c == (StgWord)&stg_BCO_info) {
debugBelch("stg_BCO_info" );
+ } else if (c == (StgWord)&stg_CASE_CONT_BCO_info) {
+ debugBelch("stg_CASE_CONT_BCO_info" );
} else if (c == (StgWord)&stg_apply_interp_info) {
debugBelch("stg_apply_interp_info" );
} else if (c == (StgWord)&stg_ret_t_info) {
=====================================
rts/RtsSymbols.c
=====================================
@@ -639,7 +639,7 @@ extern char **environ;
SymI_HasDataProto(stg_copySmallMutableArrayzh) \
SymI_HasDataProto(stg_casSmallArrayzh) \
SymI_HasDataProto(stg_copyArray_barrier) \
- SymI_HasDataProto(stg_newBCOzh) \
+ SymI_HasDataProto(stg_newBCO2zh) \
SymI_HasDataProto(stg_newByteArrayzh) \
SymI_HasDataProto(stg_casIntArrayzh) \
SymI_HasDataProto(stg_casInt8Arrayzh) \
@@ -906,7 +906,8 @@ extern char **environ;
SymI_HasProto(revertCAFs) \
SymI_HasProto(RtsFlags) \
SymI_NeedsDataProto(rts_breakpoint_io_action) \
- SymI_NeedsDataProto(rts_stop_next_breakpoint) \
+ SymI_NeedsDataProto(rts_enableStopNextBreakpointAll) \
+ SymI_NeedsDataProto(rts_disableStopNextBreakpointAll) \
SymI_NeedsDataProto(rts_stop_on_exception) \
SymI_HasProto(stopTimer) \
SymI_HasProto(n_capabilities) \
=====================================
rts/StgMiscClosures.cmm
=====================================
@@ -464,6 +464,12 @@ INFO_TABLE_RET( stg_dead_thread, RET_SMALL,
/* ----------------------------------------------------------------------------
Entry code for a BCO
+
+ `stg_BCO` and `stg_CASE_CONT_BCO` distinguish between a BCO that refers to
+ non-local variables in its code (using a stack offset) and those that do not.
+ Only case-continuation BCOs should use non-local variables.
+ Otherwise, `stg_BCO` and `stg_CASE_CONT_BCO` behave the same.
+ See Note [Case continuation BCOs].
------------------------------------------------------------------------- */
INFO_TABLE_FUN( stg_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO )
@@ -478,6 +484,15 @@ INFO_TABLE_FUN( stg_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO )
jump stg_yield_to_interpreter [];
}
+INFO_TABLE_FUN( stg_CASE_CONT_BCO, 3, 0, BCO, "BCO", "BCO", 0, ARG_BCO )
+{
+ /* Exactly as for stg_BCO */
+ Sp_adj(-2);
+ Sp(1) = R1;
+ Sp(0) = stg_apply_interp_info;
+ jump stg_yield_to_interpreter [];
+}
+
/* ----------------------------------------------------------------------------
Info tables for indirections.
=====================================
rts/include/rts/Constants.h
=====================================
@@ -328,6 +328,12 @@
*/
#define TSO_ALLOC_LIMIT 256
+/*
+ * Enables step-in mode for this thread -- it will stop at the immediate next
+ * breakpoint found in this thread.
+ */
+#define TSO_STOP_NEXT_BREAKPOINT 512
+
/*
* The number of times we spin in a spin lock before yielding (see
* #3758). To tune this value, use the benchmark in #3758: run the
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -180,6 +180,7 @@ RTS_ENTRY(stg_BLOCKING_QUEUE_CLEAN);
RTS_ENTRY(stg_BLOCKING_QUEUE_DIRTY);
RTS_FUN(stg_BCO);
+RTS_FUN(stg_CASE_CONT_BCO);
RTS_ENTRY(stg_EVACUATED);
RTS_ENTRY(stg_WEAK);
RTS_ENTRY(stg_DEAD_WEAK);
@@ -577,7 +578,7 @@ RTS_FUN_DECL(stg_deRefWeakzh);
RTS_FUN_DECL(stg_runRWzh);
-RTS_FUN_DECL(stg_newBCOzh);
+RTS_FUN_DECL(stg_newBCO2zh);
RTS_FUN_DECL(stg_mkApUpd0zh);
RTS_FUN_DECL(stg_retryzh);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aef9228695b5aaeda7e0aa8a3b4418…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aef9228695b5aaeda7e0aa8a3b4418…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/spec_tyfams] Specialise: Improve specialisation by refactoring interestingDict
by Andreas Klebinger (＠AndreasK) 23 May '25
by Andreas Klebinger (＠AndreasK) 23 May '25
23 May '25
Andreas Klebinger pushed to branch wip/andreask/spec_tyfams at Glasgow Haskell Compiler / GHC
Commits:
fcb5f7ee by Andreas Klebinger at 2025-05-23T10:09:16+02:00
Specialise: Improve specialisation by refactoring interestingDict
This MR addresses #26051, which concerns missed type-class specialisation.
The main payload of the MR is to completely refactor the key function
`interestingDict` in GHC.Core.Opt.Specialise
The main change is that we now also look at the structure of the
dictionary we consider specializing on, rather than only the type.
See the big `Note [Interesting dictionary arguments]`
- - - - -
15 changed files:
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Utils/TcType.hs
- + testsuite/tests/perf/should_run/SpecTyFamRun.hs
- + testsuite/tests/perf/should_run/SpecTyFamRun.stdout
- + testsuite/tests/perf/should_run/SpecTyFam_Import.hs
- testsuite/tests/perf/should_run/all.T
- + testsuite/tests/simplCore/should_compile/T26051.hs
- + testsuite/tests/simplCore/should_compile/T26051.stderr
- + testsuite/tests/simplCore/should_compile/T26051_Import.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiWayIf #-}
+
{-
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
@@ -14,9 +16,9 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Core.Rules ( initRuleOpts )
import GHC.Core.Type hiding( substTy, substCo, extendTvSubst, zapSubst )
-import GHC.Core.Multiplicity
-import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith )
+import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith, exprIsConApp_maybe )
import GHC.Core.Predicate
+import GHC.Core.Class( classMethods )
import GHC.Core.Coercion( Coercion )
import GHC.Core.Opt.Monad
import qualified GHC.Core.Subst as Core
@@ -26,12 +28,12 @@ import GHC.Core.Make ( mkLitRubbish )
import GHC.Core.Unify ( tcMatchTy )
import GHC.Core.Rules
import GHC.Core.Utils ( exprIsTrivial, exprIsTopLevelBindable
- , mkCast, exprType
+ , mkCast, exprType, exprIsHNF
, stripTicksTop, mkInScopeSetBndrs )
import GHC.Core.FVs
import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList )
import GHC.Core.Opt.Arity( collectBindersPushingCo )
--- import GHC.Core.Ppr( pprIds )
+import GHC.Core.Ppr( pprIds )
import GHC.Builtin.Types ( unboxedUnitTy )
@@ -64,8 +66,11 @@ import GHC.Unit.Module.ModGuts
import GHC.Core.Unfold
import Data.List( partition )
--- import Data.List.NonEmpty ( NonEmpty (..) )
import GHC.Core.Subst (substTickish)
+import GHC.Core.TyCon (tyConClass_maybe)
+import GHC.Core.DataCon (dataConTyCon)
+
+import Control.Monad
{-
************************************************************************
@@ -1585,9 +1590,9 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- switch off specialisation for inline functions
= -- pprTrace "specCalls: some" (vcat
- -- [ text "function" <+> ppr fn
- -- , text "calls:" <+> ppr calls_for_me
- -- , text "subst" <+> ppr (se_subst env) ]) $
+ -- [ text "function" <+> ppr fn
+ -- , text "calls:" <+> ppr calls_for_me
+ -- , text "subst" <+> ppr (se_subst env) ]) $
foldlM spec_call ([], [], emptyUDs) calls_for_me
| otherwise -- No calls or RHS doesn't fit our preconceptions
@@ -1635,21 +1640,21 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
, rule_bndrs, rule_lhs_args
, spec_bndrs1, dx_binds, spec_args) <- specHeader env rhs_bndrs all_call_args
--- ; pprTrace "spec_call" (vcat
--- [ text "fun: " <+> ppr fn
--- , text "call info: " <+> ppr _ci
--- , text "useful: " <+> ppr useful
--- , text "rule_bndrs:" <+> ppr rule_bndrs
--- , text "lhs_args: " <+> ppr rule_lhs_args
--- , text "spec_bndrs1:" <+> ppr spec_bndrs1
--- , text "leftover_bndrs:" <+> pprIds leftover_bndrs
--- , text "spec_args: " <+> ppr spec_args
--- , text "dx_binds: " <+> ppr dx_binds
--- , text "rhs_bndrs" <+> ppr rhs_bndrs
--- , text "rhs_body" <+> ppr rhs_body
--- , text "rhs_env2: " <+> ppr (se_subst rhs_env2)
--- , ppr dx_binds ]) $
--- return ()
+ ; when False $ pprTrace "spec_call" (vcat
+ [ text "fun: " <+> ppr fn
+ , text "call info: " <+> ppr _ci
+ , text "useful: " <+> ppr useful
+ , text "rule_bndrs:" <+> ppr rule_bndrs
+ , text "lhs_args: " <+> ppr rule_lhs_args
+ , text "spec_bndrs1:" <+> ppr spec_bndrs1
+ , text "leftover_bndrs:" <+> pprIds leftover_bndrs
+ , text "spec_args: " <+> ppr spec_args
+ , text "dx_binds: " <+> ppr dx_binds
+ , text "rhs_bndrs" <+> ppr rhs_bndrs
+ , text "rhs_body" <+> ppr rhs_body
+ , text "rhs_env2: " <+> ppr (se_subst rhs_env2)
+ , ppr dx_binds ]) $
+ return ()
; let all_rules = rules_acc ++ existing_rules
-- all_rules: we look both in the rules_acc (generated by this invocation
@@ -3043,30 +3048,15 @@ mkCallUDs' env f args
-- For "invisibleFunArg", which are the type-class dictionaries,
-- we decide on a case by case basis if we want to specialise
-- on this argument; if so, SpecDict, if not UnspecArg
- mk_spec_arg arg (Anon pred af)
+ mk_spec_arg arg (Anon _pred af)
| isInvisibleFunArg af
- , interestingDict arg (scaledThing pred)
+ , interestingDict env arg
+ -- , interestingDict arg (scaledThing pred)
-- See Note [Interesting dictionary arguments]
= SpecDict arg
| otherwise = UnspecArg
-{-
-Note [Ticks on applications]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Ticks such as source location annotations can sometimes make their way
-onto applications (see e.g. #21697). So if we see something like
-
- App (Tick _ f) e
-
-we need to descend below the tick to find what the real function being
-applied is.
-
-The resulting RULE also has to be able to match this annotated use
-site, so we only look through ticks that RULE matching looks through
-(see Note [Tick annotations in RULE matching] in GHC.Core.Rules).
--}
-
wantCallsFor :: SpecEnv -> Id -> Bool
-- See Note [wantCallsFor]
wantCallsFor _env f
@@ -3086,8 +3076,60 @@ wantCallsFor _env f
WorkerLikeId {} -> True
RepPolyId {} -> True
-{- Note [wantCallsFor]
-~~~~~~~~~~~~~~~~~~~~~~
+interestingDict :: SpecEnv -> CoreExpr -> Bool
+-- This is a subtle and important function
+-- See Note [Interesting dictionary arguments]
+interestingDict env (Var v) -- See (ID3) and (ID5)
+ | Just rhs <- maybeUnfoldingTemplate (idUnfolding v)
+ -- might fail for loop breaker dicts but that seems fine.
+ = interestingDict env rhs
+
+interestingDict env arg -- Main Plan: use exprIsConApp_maybe
+ | Cast inner_arg _ <- arg -- See (ID5)
+ = if | isConstraintKind $ typeKind $ exprType inner_arg
+ -- If coercions were always homo-kinded, we'd know
+ -- that this would be the only case
+ -> interestingDict env inner_arg
+
+ -- Check for an implicit parameter at the top
+ | Just (cls,_) <- getClassPredTys_maybe arg_ty
+ , isIPClass cls -- See (ID4)
+ -> False
+
+ -- Otherwise we are unwrapping a unary type class
+ | otherwise
+ -> exprIsHNF arg -- See (ID7)
+
+ | Just (_, _, data_con, _tys, args) <- exprIsConApp_maybe in_scope_env arg
+ , Just cls <- tyConClass_maybe (dataConTyCon data_con)
+ , not_ip_like -- See (ID4)
+ = if null (classMethods cls) -- See (ID6)
+ then any (interestingDict env) args
+ else True
+
+ | otherwise
+ = not (exprIsTrivial arg) && not_ip_like -- See (ID8)
+ where
+ arg_ty = exprType arg
+ not_ip_like = not (couldBeIPLike arg_ty)
+ in_scope_env = ISE (substInScopeSet $ se_subst env) realIdUnfolding
+
+{- Note [Ticks on applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Ticks such as source location annotations can sometimes make their way
+onto applications (see e.g. #21697). So if we see something like
+
+ App (Tick _ f) e
+
+we need to descend below the tick to find what the real function being
+applied is.
+
+The resulting RULE also has to be able to match this annotated use
+site, so we only look through ticks that RULE matching looks through
+(see Note [Tick annotations in RULE matching] in GHC.Core.Rules).
+
+Note [wantCallsFor]
+~~~~~~~~~~~~~~~~~~~
`wantCallsFor env f` says whether the Specialiser should collect calls for
function `f`; other thing being equal, the fewer calls we collect the better. It
is False for things we can't specialise:
@@ -3113,44 +3155,91 @@ collect usage info for imported overloaded functions.
Note [Interesting dictionary arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In `mkCallUDs` we only use `SpecDict` for dictionaries of which
-`interestingDict` holds. Otherwise we use `UnspecArg`. Two reasons:
-
-* Consider this
- \a.\d:Eq a. let f = ... in ...(f d)...
- There really is not much point in specialising f wrt the dictionary d,
- because the code for the specialised f is not improved at all, because
- d is lambda-bound. We simply get junk specialisations.
-
-* Consider this (#25703):
- f :: (Eq a, Show b) => a -> b -> INt
- goo :: forall x. (Eq x) => x -> blah
- goo @x (d:Eq x) (arg:x) = ...(f @x @Int d $fShowInt)...
- If we built a `ci_key` with a (SpecDict d) for `d`, we would end up
- discarding the call at the `\d`. But if we use `UnspecArg` for that
- uninteresting `d`, we'll get a `ci_key` of
- f @x @Int UnspecArg (SpecDict $fShowInt)
- and /that/ can float out to f's definition and specialise nicely.
- Hooray. (NB: the call can float only if `-fpolymorphic-specialisation`
- is on; otherwise it'll be trapped by the `\@x -> ...`.)(
-
-What is "interesting"? (See `interestingDict`.) Just that it has *some*
-structure. But what about variables? We look in the variable's /unfolding/.
-And that means that we must be careful to ensure that dictionaries /have/
-unfoldings,
-
-* cloneBndrSM discards non-Stable unfoldings
-* specBind updates the unfolding after specialisation
- See Note [Update unfolding after specialisation]
-* bindAuxiliaryDict adds an unfolding for an aux dict
- see Note [Specialisation modulo dictionary selectors]
-* specCase adds unfoldings for the new bindings it creates
-
-We accidentally lost accurate tracking of local variables for a long
-time, because cloned variables didn't have unfoldings. But makes a
-massive difference in a few cases, eg #5113. For nofib as a
-whole it's only a small win: 2.2% improvement in allocation for ansi,
-1.2% for bspt, but mostly 0.0! Average 0.1% increase in binary size.
+Consider this
+ \a.\d:Eq a. let f = ... in ...(f d)...
+There really is not much point in specialising f wrt the dictionary d,
+because the code for the specialised f is not improved at all, because
+d is lambda-bound. We simply get junk specialisations.
+
+What is "interesting"? Our Main Plan is to use `exprIsConApp_maybe` to see
+if the argument is a dictionary constructor applied to some arguments, in which
+case we can clearly specialise. But there are wrinkles:
+
+(ID1) Note that we look at the argument /term/, not its /type/. Suppose the
+ argument is
+ (% d1, d2 %) |> co
+ where co :: (% Eq [a], Show [a] %) ~ F Int a, and `F` is a type family.
+ Then its type (F Int a) looks very un-informative, but the term is super
+ helpful. See #19747 (where missing this point caused a 70x slow down)
+ and #7785.
+
+(ID2) Note that the Main Plan works fine for an argument that is a DFun call,
+ e.g. $fOrdList $dOrdInt
+ because `exprIsConApp_maybe` cleverly deals with DFunId applications. Good!
+
+(ID3) For variables, we look in the variable's /unfolding/. And that means
+ that we must be careful to ensure that dictionaries /have/ unfoldings:
+ * cloneBndrSM discards non-Stable unfoldings
+ * specBind updates the unfolding after specialisation
+ See Note [Update unfolding after specialisation]
+ * bindAuxiliaryDict adds an unfolding for an aux dict
+ see Note [Specialisation modulo dictionary selectors]
+ * specCase adds unfoldings for the new bindings it creates
+
+ We accidentally lost accurate tracking of local variables for a long
+ time, because cloned variables didn't have unfoldings. But makes a
+ massive difference in a few cases, eg #5113. For nofib as a
+ whole it's only a small win: 2.2% improvement in allocation for ansi,
+ 1.2% for bspt, but mostly 0.0! Average 0.1% increase in binary size.
+
+(ID4) We must be very careful not to specialise on a "dictionary" that is, or contains
+ an implicit parameter, because implicit parameters are emphatically not singleton
+ types. See #25999:
+ useImplicit :: (?i :: Int) => Int
+ useImplicit = ?i + 1
+
+ foo = let ?i = 1 in (useImplicit, let ?i = 2 in useImplicit)
+ Both calls to `useImplicit` are at type `?i::Int`, but they pass different values.
+ We must not specialise on implicit parameters! Hence the call to `couldBeIPLike`.
+
+(ID5) Suppose the argument is (e |> co). Can we rely on `exprIsConApp_maybe` to deal
+ with the coercion. No! That only works if (co :: C t1 ~ C t2) with the same type
+ constructor at the top of both sides. But see the example in (ID1), where that
+ is not true. For thes same reason, we can't rely on `exprIsConApp_maybe` to look
+ through unfoldings (because there might be a cast inside), hence dealing with
+ expandable unfoldings in `interestingDict` directly.
+
+(ID6) The Main Plan says that it's worth specialising if the argument is an application
+ of a dictionary contructor. But what if the dictionary has no methods? Then we
+ gain nothing by specialising, unless the /superclasses/ are interesting. A case
+ in point is constraint tuples (% d1, .., dn %); a constraint N-tuple is a class
+ with N superclasses and no methods.
+
+(ID7) A unary (single-method) class is currently represented by (meth |> co). We
+ will unwrap the cast (see (ID5)) and then want to reply "yes" if the method
+ has any struture. We rather arbitrarily use `exprIsHNF` for this. (We plan a
+ new story for unary classes, see #23109, and this special case will become
+ irrelevant.)
+
+(ID8) Sadly, if `exprIsConApp_maybe` says Nothing, we still want to treat a
+ non-trivial argument as interesting. In T19695 we have this:
+ askParams :: Monad m => blah
+ mhelper :: MonadIO m => blah
+ mhelper (d:MonadIO m) = ...(askParams @m ($p1 d))....
+ where `$p1` is the superclass selector for `MonadIO`. Now, if `mhelper` is
+ specialised at `Handler` we'll get this call in the specialised `$smhelper`:
+ askParams @Handler ($p1 $fMonadIOHandler)
+ and we /definitely/ want to specialise that, even though the argument isn't
+ visibly a dictionary application. In fact the specialiser fires the superclass
+ selector rule (see Note [Fire rules in the specialiser]), so we get
+ askParams @Handler ($cp1MonadIO $fMonadIOIO)
+ but it /still/ doesn't look like a dictionary application.
+
+ Conclusion: we optimistically assume that any non-trivial argument is worth
+ specialising on.
+
+ So why do the `exprIsConApp_maybe` and `Cast` stuff? Because we want to look
+ under type-family casts (ID1) and constraint tuples (ID6).
Note [Update unfolding after specialisation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -3178,6 +3267,7 @@ Consider (#21848)
Now `f` turns into:
f @a @b (dd :: D a) (ds :: Show b) a b
+
= let dc :: D a = %p1 dd -- Superclass selection
in meth @a dc ....
meth @a dc ....
@@ -3193,27 +3283,6 @@ in the NonRec case of specBind. (This is too exotic to trouble with
the Rec case.)
-}
-interestingDict :: CoreExpr -> Type -> Bool
--- A dictionary argument is interesting if it has *some* structure,
--- see Note [Interesting dictionary arguments]
--- NB: "dictionary" arguments include constraints of all sorts,
--- including equality constraints; hence the Coercion case
--- To make this work, we need to ensure that dictionaries have
--- unfoldings in them.
-interestingDict arg arg_ty
- | not (typeDeterminesValue arg_ty) = False -- See Note [Type determines value]
- | otherwise = go arg
- where
- go (Var v) = hasSomeUnfolding (idUnfolding v)
- || isDataConWorkId v
- go (Type _) = False
- go (Coercion _) = False
- go (App fn (Type _)) = go fn
- go (App fn (Coercion _)) = go fn
- go (Tick _ a) = go a
- go (Cast e _) = go e
- go _ = True
-
thenUDs :: UsageDetails -> UsageDetails -> UsageDetails
thenUDs (MkUD {ud_binds = db1, ud_calls = calls1})
(MkUD {ud_binds = db2, ud_calls = calls2})
=====================================
compiler/GHC/Core/Predicate.hs
=====================================
@@ -24,7 +24,7 @@ module GHC.Core.Predicate (
classMethodTy, classMethodInstTy,
-- Implicit parameters
- isIPLikePred, mentionsIP, isIPTyCon, isIPClass,
+ couldBeIPLike, mightMentionIP, isIPTyCon, isIPClass,
isCallStackTy, isCallStackPred, isCallStackPredTy,
isExceptionContextPred, isExceptionContextTy,
isIPPred_maybe,
@@ -126,9 +126,12 @@ isDictTy ty = isClassPred pred
where
(_, pred) = splitInvisPiTys ty
+-- | Is the type *guaranteed* to determine the value?
+--
+-- Might say No even if the type does determine the value. (See the Note)
typeDeterminesValue :: Type -> Bool
-- See Note [Type determines value]
-typeDeterminesValue ty = isDictTy ty && not (isIPLikePred ty)
+typeDeterminesValue ty = isDictTy ty && not (couldBeIPLike ty)
getClassPredTys :: HasDebugCallStack => PredType -> (Class, [Type])
getClassPredTys ty = case getClassPredTys_maybe ty of
@@ -171,6 +174,10 @@ So we treat implicit params just like ordinary arguments for the
purposes of specialisation. Note that we still want to specialise
functions with implicit params if they have *other* dicts which are
class params; see #17930.
+
+It's also not always possible to infer that a type determines the value
+if type families are in play. See #19747 for one such example.
+
-}
-- --------------------- Equality predicates ---------------------------------
@@ -421,44 +428,44 @@ isCallStackTy ty
| otherwise
= False
--- --------------------- isIPLike and mentionsIP --------------------------
+-- --------------------- couldBeIPLike and mightMentionIP --------------------------
-- See Note [Local implicit parameters]
-isIPLikePred :: Type -> Bool
+couldBeIPLike :: Type -> Bool
-- Is `pred`, or any of its superclasses, an implicit parameter?
-- See Note [Local implicit parameters]
-isIPLikePred pred =
- mentions_ip_pred initIPRecTc (const True) (const True) pred
-
-mentionsIP :: (Type -> Bool) -- ^ predicate on the string
- -> (Type -> Bool) -- ^ predicate on the type
- -> Class
- -> [Type] -> Bool
--- ^ @'mentionsIP' str_cond ty_cond cls tys@ returns @True@ if:
+couldBeIPLike pred
+ = might_mention_ip1 initIPRecTc (const True) (const True) pred
+
+mightMentionIP :: (Type -> Bool) -- ^ predicate on the string
+ -> (Type -> Bool) -- ^ predicate on the type
+ -> Class
+ -> [Type] -> Bool
+-- ^ @'mightMentionIP' str_cond ty_cond cls tys@ returns @True@ if:
--
-- - @cls tys@ is of the form @IP str ty@, where @str_cond str@ and @ty_cond ty@
-- are both @True@,
-- - or any superclass of @cls tys@ has this property.
--
-- See Note [Local implicit parameters]
-mentionsIP = mentions_ip initIPRecTc
+mightMentionIP = might_mention_ip initIPRecTc
-mentions_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool
-mentions_ip rec_clss str_cond ty_cond cls tys
+might_mention_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool
+might_mention_ip rec_clss str_cond ty_cond cls tys
| Just (str_ty, ty) <- isIPPred_maybe cls tys
= str_cond str_ty && ty_cond ty
| otherwise
- = or [ mentions_ip_pred rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys)
+ = or [ might_mention_ip1 rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys)
| sc_sel_id <- classSCSelIds cls ]
-mentions_ip_pred :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool
-mentions_ip_pred rec_clss str_cond ty_cond ty
+might_mention_ip1 :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool
+might_mention_ip1 rec_clss str_cond ty_cond ty
| Just (cls, tys) <- getClassPredTys_maybe ty
, let tc = classTyCon cls
, Just rec_clss' <- if isTupleTyCon tc then Just rec_clss
else checkRecTc rec_clss tc
- = mentions_ip rec_clss' str_cond ty_cond cls tys
+ = might_mention_ip rec_clss' str_cond ty_cond cls tys
| otherwise
= False -- Includes things like (D []) where D is
-- a Constraint-ranged family; #7785
@@ -471,7 +478,7 @@ initIPRecTc = setRecTcMaxBound 1 initRecTc
See also wrinkle (SIP1) in Note [Shadowing of implicit parameters] in
GHC.Tc.Solver.Dict.
-The function isIPLikePred tells if this predicate, or any of its
+The function couldBeIPLike tells if this predicate, or any of its
superclasses, is an implicit parameter.
Why are implicit parameters special? Unlike normal classes, we can
@@ -479,7 +486,7 @@ have local instances for implicit parameters, in the form of
let ?x = True in ...
So in various places we must be careful not to assume that any value
of the right type will do; we must carefully look for the innermost binding.
-So isIPLikePred checks whether this is an implicit parameter, or has
+So couldBeIPLike checks whether this is an implicit parameter, or has
a superclass that is an implicit parameter.
Several wrinkles
@@ -520,16 +527,16 @@ Small worries (Sept 20):
think nothing does.
* I'm a little concerned about type variables; such a variable might
be instantiated to an implicit parameter. I don't think this
- matters in the cases for which isIPLikePred is used, and it's pretty
+ matters in the cases for which couldBeIPLike is used, and it's pretty
obscure anyway.
* The superclass hunt stops when it encounters the same class again,
but in principle we could have the same class, differently instantiated,
and the second time it could have an implicit parameter
I'm going to treat these as problems for another day. They are all exotic.
-Note [Using typesAreApart when calling mentionsIP]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We call 'mentionsIP' in two situations:
+Note [Using typesAreApart when calling mightMentionIP]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We call 'mightMentionIP' in two situations:
(1) to check that a predicate does not contain any implicit parameters
IP str ty, for a fixed literal str and any type ty,
=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -1914,7 +1914,7 @@ growThetaTyVars theta tcvs
| otherwise = transCloVarSet mk_next seed_tcvs
where
seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips
- (ips, non_ips) = partition isIPLikePred theta
+ (ips, non_ips) = partition couldBeIPLike theta
-- See Note [Inheriting implicit parameters]
mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -749,7 +749,7 @@ shortCutSolver dflags ev_w ev_i
-- programs should typecheck regardless of whether we take this step or
-- not. See Note [Shortcut solving]
- , not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627)
+ , not (couldBeIPLike (ctEvPred ev_w)) -- Not for implicit parameters (#18627)
, not (xopt LangExt.IncoherentInstances dflags)
-- If IncoherentInstances is on then we cannot rely on coherence of proofs
=====================================
compiler/GHC/Tc/Solver/InertSet.hs
=====================================
@@ -2040,10 +2040,10 @@ solveOneFromTheOther ct_i ct_w
is_wsc_orig_w = isWantedSuperclassOrigin orig_w
different_level_strategy -- Both Given
- | isIPLikePred pred = if lvl_w `strictlyDeeperThan` lvl_i then KeepWork else KeepInert
- | otherwise = if lvl_w `strictlyDeeperThan` lvl_i then KeepInert else KeepWork
+ | couldBeIPLike pred = if lvl_w `strictlyDeeperThan` lvl_i then KeepWork else KeepInert
+ | otherwise = if lvl_w `strictlyDeeperThan` lvl_i then KeepInert else KeepWork
-- See Note [Replacement vs keeping] part (1)
- -- For the isIPLikePred case see Note [Shadowing of implicit parameters]
+ -- For the couldBeIPLike case see Note [Shadowing of implicit parameters]
-- in GHC.Tc.Solver.Dict
same_level_strategy -- Both Given
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -401,8 +401,8 @@ updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev, di_tys = tys })
-- an implicit parameter (?str :: ty) for the given 'str' and any type 'ty'?
does_not_mention_ip_for :: Type -> DictCt -> Bool
does_not_mention_ip_for str_ty (DictCt { di_cls = cls, di_tys = tys })
- = not $ mentionsIP (not . typesAreApart str_ty) (const True) cls tys
- -- See Note [Using typesAreApart when calling mentionsIP]
+ = not $ mightMentionIP (not . typesAreApart str_ty) (const True) cls tys
+ -- See Note [Using typesAreApart when calling mightMentionIP]
-- in GHC.Core.Predicate
updInertIrreds :: IrredCt -> TcS ()
@@ -534,7 +534,7 @@ updSolvedDicts what dict_ct@(DictCt { di_cls = cls, di_tys = tys, di_ev = ev })
= do { is_callstack <- is_tyConTy isCallStackTy callStackTyConName
; is_exceptionCtx <- is_tyConTy isExceptionContextTy exceptionContextTyConName
; let contains_callstack_or_exceptionCtx =
- mentionsIP
+ mightMentionIP
(const True)
-- NB: the name of the call-stack IP is irrelevant
-- e.g (?foo :: CallStack) counts!
@@ -552,9 +552,9 @@ updSolvedDicts what dict_ct@(DictCt { di_cls = cls, di_tys = tys, di_ev = ev })
-- Return a predicate that decides whether a type is CallStack
-- or ExceptionContext, accounting for e.g. type family reduction, as
- -- per Note [Using typesAreApart when calling mentionsIP].
+ -- per Note [Using typesAreApart when calling mightMentionIP].
--
- -- See Note [Using isCallStackTy in mentionsIP].
+ -- See Note [Using isCallStackTy in mightMentionIP].
is_tyConTy :: (Type -> Bool) -> Name -> TcS (Type -> Bool)
is_tyConTy is_eq tc_name
= do { (mb_tc, _) <- wrapTcS $ TcM.tryTc $ TcM.tcLookupTyCon tc_name
@@ -582,14 +582,14 @@ in a different context!
See also Note [Shadowing of implicit parameters], which deals with a similar
problem with Given implicit parameter constraints.
-Note [Using isCallStackTy in mentionsIP]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Using isCallStackTy in mightMentionIP]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To implement Note [Don't add HasCallStack constraints to the solved set],
we need to check whether a constraint contains a HasCallStack or HasExceptionContext
constraint. We do this using the 'mentionsIP' function, but as per
-Note [Using typesAreApart when calling mentionsIP] we don't want to simply do:
+Note [Using typesAreApart when calling mightMentionIP] we don't want to simply do:
- mentionsIP
+ mightMentionIP
(const True) -- (ignore the implicit parameter string)
(isCallStackTy <||> isExceptionContextTy)
=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -155,7 +155,7 @@ module GHC.Tc.Utils.TcType (
mkTyConTy, mkTyVarTy, mkTyVarTys,
mkTyCoVarTy, mkTyCoVarTys,
- isClassPred, isEqPred, isIPLikePred, isEqClassPred,
+ isClassPred, isEqPred, couldBeIPLike, isEqClassPred,
isEqualityClass, mkClassPred,
tcSplitQuantPredTy, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy,
isRuntimeRepVar, isFixedRuntimeRepKind,
@@ -1819,7 +1819,7 @@ pickCapturedPreds
pickCapturedPreds qtvs theta
= filter captured theta
where
- captured pred = isIPLikePred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs)
+ captured pred = couldBeIPLike pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs)
-- Superclasses
=====================================
testsuite/tests/perf/should_run/SpecTyFamRun.hs
=====================================
@@ -0,0 +1,15 @@
+{-# OPTIONS_GHC -fspecialise-aggressively #-}
+{-# OPTIONS_GHC -fno-spec-constr #-}
+module Main(main) where
+
+import SpecTyFam_Import (specMe, MaybeShowNum)
+import GHC.Exts
+
+-- We want to see a specialization of `specMe` which doesn't take a dictionary at runtime.
+
+{-# NOINLINE foo #-}
+foo :: Int -> (String,Int)
+-- We want specMe to be specialized, but not inlined
+foo x = specMe True x
+
+main = print $ sum $ map (snd . foo) [1..1000 :: Int]
=====================================
testsuite/tests/perf/should_run/SpecTyFamRun.stdout
=====================================
@@ -0,0 +1 @@
+500500
=====================================
testsuite/tests/perf/should_run/SpecTyFam_Import.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE BangPatterns #-}
+
+module SpecTyFam_Import (specMe, MaybeShowNum) where
+
+import Data.Kind
+
+type family MaybeShowNum a n :: Constraint where
+ MaybeShowNum a n = (Show a, Num n)
+
+{-# INLINABLE specMe #-}
+specMe :: (Integral n, MaybeShowNum a n) => a -> n -> (String,n)
+specMe s !n = (show s, n+1 `div` 2)
=====================================
testsuite/tests/perf/should_run/all.T
=====================================
@@ -423,3 +423,12 @@ test('ByteCodeAsm',
],
compile_and_run,
['-package ghc'])
+
+# Check that $s$wspecMe doesn't have any dictionary args after specialization in addition to perf stats
+# See also #19747
+test('SpecTyFamRun', [ grep_errmsg(r'foo')
+ , extra_files(['SpecTyFam_Import.hs'])
+ , only_ways(['optasm'])
+ , collect_stats('bytes allocated', 5)],
+ multimod_compile_and_run,
+ ['SpecTyFamRun', '-O2'])
=====================================
testsuite/tests/simplCore/should_compile/T26051.hs
=====================================
@@ -0,0 +1,15 @@
+{-# OPTIONS_GHC -fspecialise-aggressively #-}
+{-# OPTIONS_GHC -fno-spec-constr #-}
+
+module T26051(main, foo) where
+
+import T26051_Import (specMe, MaybeShowNum)
+import GHC.Exts
+
+-- We want to see a specialization of `specMe` which doesn't take a dictionary at runtime.
+
+{-# OPAQUE foo #-}
+foo :: Int -> (String,Int)
+foo x = specMe True x
+
+main = print $ sum $ map (snd . foo) [1..1000 :: Int]
=====================================
testsuite/tests/simplCore/should_compile/T26051.stderr
=====================================
@@ -0,0 +1,78 @@
+[1 of 2] Compiling T26051_Import ( T26051_Import.hs, T26051_Import.o )
+
+==================== Specialise ====================
+Result size of Specialise = {terms: 31, types: 39, coercions: 8, joins: 0/1}
+
+-- RHS size: {terms: 30, types: 27, coercions: 8, joins: 0/1}
+specMe [InlPrag=INLINABLE] :: forall n a. (Integral n, MaybeShowNum a n) => a -> n -> (String, n)
+[LclIdX,
+ Arity=4,
+ Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 0 0 20] 260 10
+ Tmpl= \ (@n) (@a) ($dIntegral [Occ=Once1] :: Integral n) (irred :: MaybeShowNum a n) (eta [Occ=Once1] :: a) (eta [Occ=Once1] :: n) ->
+ let {
+ $dNum :: Num n
+ [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ $dNum = GHC.Internal.Classes.$p1CTuple2 @(Show a) @(Num n) (irred `cast` (Sub (T26051_Import.D:R:MaybeShowNum[0] <a>_N <n>_N) :: MaybeShowNum a n ~R# (Show a, Num n))) } in
+ case eta of n [Occ=Once1] { __DEFAULT -> (show @a (GHC.Internal.Classes.$p0CTuple2 @(Show a) @(Num n) (irred `cast` (Sub (T26051_Import.D:R:MaybeShowNum[0] <a>_N <n>_N) :: MaybeShowNum a n ~R# (Show a, Num n)))) eta, + @n $dNum n (div @n $dIntegral (fromInteger @n $dNum (GHC.Internal.Bignum.Integer.IS 1#)) (fromInteger @n $dNum (GHC.Internal.Bignum.Integer.IS 2#)))) }}]
+specMe
+ = \ (@n) (@a) ($dIntegral :: Integral n) (irred :: MaybeShowNum a n) (eta :: a) (eta :: n) ->
+ let {
+ $dNum :: Num n
+ [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+ $dNum = GHC.Internal.Classes.$p1CTuple2 @(Show a) @(Num n) (irred `cast` (Sub (T26051_Import.D:R:MaybeShowNum[0] <a>_N <n>_N) :: MaybeShowNum a n ~R# (Show a, Num n))) } in
+ case eta of n { __DEFAULT -> (show @a (GHC.Internal.Classes.$p0CTuple2 @(Show a) @(Num n) (irred `cast` (Sub (T26051_Import.D:R:MaybeShowNum[0] <a>_N <n>_N) :: MaybeShowNum a n ~R# (Show a, Num n)))) eta, + @n $dNum n (div @n $dIntegral (fromInteger @n $dNum (GHC.Internal.Bignum.Integer.IS 1#)) (fromInteger @n $dNum (GHC.Internal.Bignum.Integer.IS 2#)))) }
+
+
+
+[2 of 2] Compiling T26051 ( T26051.hs, T26051.o )
+
+==================== Specialise ====================
+Result size of Specialise = {terms: 84, types: 86, coercions: 13, joins: 0/1}
+
+Rec {
+-- RHS size: {terms: 3, types: 4, coercions: 0, joins: 0/0}
+$dCTuple2 :: (Show Bool, Num Int)
+[LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+$dCTuple2 = (GHC.Internal.Show.$fShowBool, GHC.Internal.Num.$fNumInt)
+
+-- RHS size: {terms: 19, types: 9, coercions: 0, joins: 0/1}
+$s$wspecMe [InlPrag=INLINABLE[2]] :: Bool -> Int -> (# String, Int #)
+[LclId, Arity=2]
+$s$wspecMe
+ = \ (eta [Occ=Once1] :: Bool) (eta1 [Occ=Once1] :: Int) ->
+ let {
+ $dNum :: Num Int
+ [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
+ $dNum = GHC.Internal.Num.$fNumInt } in
+ case eta1 of n1 [Occ=Once1] { __DEFAULT -> (# GHC.Internal.Show.$fShowBool_$cshow eta, GHC.Internal.Num.$fNumInt_$c+ n1 (GHC.Internal.Real.$fIntegralInt_$cdiv (GHC.Internal.Num.$fNumInt_$cfromInteger (GHC.Internal.Bignum.Integer.IS 1#)) (GHC.Internal.Num.$fNumInt_$cfromInteger (GHC.Internal.Bignum.Integer.IS 2#))) #) }
+
+-- RHS size: {terms: 12, types: 13, coercions: 5, joins: 0/0}
+$sspecMe [InlPrag=INLINABLE[2]] :: Bool -> Int -> (String, Int)
+[LclId,
+ Arity=2,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
+ Tmpl= \ (eta [Occ=Once1] :: Bool) (eta1 [Occ=Once1] :: Int) -> case T26051_Import.$wspecMe @Int @Bool GHC.Internal.Real.$fIntegralInt ($dCTuple2 `cast` (Sub (Sym (T26051_Import.D:R:MaybeShowNum[0] <Bool>_N <Int>_N)) :: (Show Bool, Num Int) ~R# MaybeShowNum Bool Int)) eta eta1 of { (# ww [Occ=Once1], ww1 [Occ=Once1] #) -> (ww, ww1) }}]
+$sspecMe = \ (eta [Occ=Once1] :: Bool) (eta1 [Occ=Once1] :: Int) -> case T26051_Import.$wspecMe @Int @Bool GHC.Internal.Real.$fIntegralInt ($dCTuple2 `cast` (Sub (Sym (T26051_Import.D:R:MaybeShowNum[0] <Bool>_N <Int>_N)) :: (Show Bool, Num Int) ~R# MaybeShowNum Bool Int)) eta eta1 of { (# ww [Occ=Once1], ww1 [Occ=Once1] #) -> (ww, ww1) }
+end Rec }
+
+-- RHS size: {terms: 6, types: 3, coercions: 5, joins: 0/0}
+foo [InlPrag=OPAQUE] :: Int -> (String, Int)
+[LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 50 0}]
+foo = \ (x :: Int) -> specMe @Int @Bool GHC.Internal.Real.$fIntegralInt ($dCTuple2 `cast` (Sub (Sym (T26051_Import.D:R:MaybeShowNum[0] <Bool>_N <Int>_N)) :: (Show Bool, Num Int) ~R# MaybeShowNum Bool Int)) GHC.Internal.Types.True x
+
+-- RHS size: {terms: 37, types: 26, coercions: 0, joins: 0/0}
+main :: State# RealWorld -> (# State# RealWorld, () #)
+[LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 301 0}]
+main = \ (eta [OS=OneShot] :: State# RealWorld) -> GHC.Internal.IO.Handle.Text.hPutStr2 GHC.Internal.IO.StdHandles.stdout (case GHC.Internal.Enum.eftIntFB @(Int -> Int) (GHC.Internal.Base.mapFB @Int @(Int -> Int) @Int (\ (ds :: Int) (ds1 [OS=OneShot] :: Int -> Int) (v [OS=OneShot] :: Int) -> case v of { I# ipv -> ds1 (case ds of { I# y -> GHC.Internal.Types.I# (+# ipv y) }) }) (\ (x :: Int) -> case foo x of { (_ [Occ=Dead], y) -> y })) (breakpoint @Int) 1# 1000# (GHC.Internal.Types.I# 0#) of { I# n -> GHC.Internal.Show.itos n (GHC.Internal.Types.[] @Char) }) GHC.Internal.Types.True eta
+
+-- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0}
+main :: IO ()
+[LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
+main = main `cast` (Sym (GHC.Internal.Types.N:IO <()>_R) :: (State# RealWorld -> (# State# RealWorld, () #)) ~R# IO ())
+
+
+------ Local rules for imported ids --------
+"SPEC/T26051 $wspecMe @Int @Bool" [2] forall ($dIntegral :: Integral Int) (irred :: MaybeShowNum Bool Int). T26051_Import.$wspecMe @Int @Bool $dIntegral irred = $s$wspecMe
+"SPEC/T26051 specMe @Int @Bool" [2] forall ($dIntegral :: Integral Int) (irred :: MaybeShowNum Bool Int). specMe @Int @Bool $dIntegral irred = $sspecMe
+
+
=====================================
testsuite/tests/simplCore/should_compile/T26051_Import.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ImplicitParams #-}
+
+module T26051_Import (specMe, MaybeShowNum) where
+
+import Data.Kind
+
+type family MaybeShowNum a n :: Constraint where
+ MaybeShowNum a n = (Show a, Num n)
+
+{-# INLINABLE specMe #-}
+specMe :: (Integral n, MaybeShowNum a n) => a -> n -> (String,n)
+specMe s !n = (show s, n+1 `div` 2)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -548,3 +548,9 @@ test('T25965', normal, compile, ['-O'])
test('T25703', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisation -ddump-rule-firings'])
test('T25703a', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisation -ddump-rule-firings'])
+# Check that $s$wspecMe doesn't have any dictionary args after specialization in addition to perf stats
+test('T26051', [ grep_errmsg(r'\$wspecMe')
+ , extra_files(['T26051_Import.hs'])
+ , only_ways(['optasm'])],
+ multimod_compile,
+ ['T26051', '-O2 -ddump-spec -dsuppress-uniques -dno-typeable-binds -dppr-cols=1000'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcb5f7ee80167bce784ec9cf1ed55c5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcb5f7ee80167bce784ec9cf1ed55c5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/per-thread-step-in] debugger/rts: Allow toggling step-in per thread
by Rodrigo Mesquita (＠alt-romes) 23 May '25
by Rodrigo Mesquita (＠alt-romes) 23 May '25
23 May '25
Rodrigo Mesquita pushed to branch wip/romes/per-thread-step-in at Glasgow Haskell Compiler / GHC
Commits:
b0249bf0 by Rodrigo Mesquita at 2025-05-23T09:04:51+01:00
debugger/rts: Allow toggling step-in per thread
The RTS global flag `rts_stop_next_breakpoint` globally sets the
interpreter to stop at the immediate next breakpoint.
With this commit, single step mode can additionally be set per thread in
the TSO flag (TSO_STOP_NEXT_BREAKPOINT).
Being able to toggle "stop at next breakpoint" per thread is an
important requirement for implementing "stepping out" of a function in a
multi-threaded context.
And, more generally, having a per-thread flag for single-stepping paves the
way for multi-threaded debugging.
That said, when we want to enable "single step" mode for the whole
interpreted program we still want to stop at the immediate next
breakpoint, whichever thread it belongs to.
That's why we also keep the global `rts_stop_next_breakpoint` flag, with
`rts_enableStopNextBreakpointAll` and `rts_disableStopNextBreakpointAll` helpers.
Preparation for #26042
- - - - -
11 changed files:
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
- libraries/ghc-heap/tests/parse_tso_flags.hs
- + libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Interpreter.c
- rts/Interpreter.h
- rts/RtsSymbols.c
- rts/include/rts/Constants.h
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -624,6 +624,7 @@ data TsoFlags
| TsoMarked
| TsoSqueezed
| TsoAllocLimit
+ | TsoStopNextBreakpoint
| TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug
deriving (Eq, Show, Generic, Ord)
=====================================
libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc
=====================================
@@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset
| isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)
| isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)
| isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)
+#if __GLASGOW_HASKELL__ >= 913
+ | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
+#endif
parseTsoFlags 0 = []
parseTsoFlags w = [TsoFlagsUnknownValue w]
=====================================
libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
=====================================
@@ -87,6 +87,9 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset
| isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)
| isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)
| isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)
+#if __GLASGOW_HASKELL__ >= 913
+ | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
+#endif
parseTsoFlags 0 = []
parseTsoFlags w = [TsoFlagsUnknownValue w]
=====================================
libraries/ghc-heap/tests/parse_tso_flags.hs
=====================================
@@ -13,5 +13,6 @@ main = do
assertEqual (parseTsoFlags 64) [TsoMarked]
assertEqual (parseTsoFlags 128) [TsoSqueezed]
assertEqual (parseTsoFlags 256) [TsoAllocLimit]
+ assertEqual (parseTsoFlags 512) [TsoStopNextBreakpoint]
assertEqual (parseTsoFlags 6) [TsoLocked, TsoBlockx]
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -0,0 +1,67 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+module GHCi.Debugger
+ (
+ -- * Single step mode
+ rts_enableStopNextBreakpoint
+ , rts_enableStopNextBreakpointAll
+ , rts_disableStopNextBreakpoint
+ , rts_disableStopNextBreakpointAll
+
+ -- * Stop on exception
+ , exceptionFlag
+
+ -- * Breakpoint Callback
+ , BreakpointCallback
+ , breakPointIOAction
+ ) where
+
+import Prelude -- See note [Why do we import Prelude here?]
+
+import GHC.Base (ThreadId#, Addr#, Int#)
+import Foreign.C (CInt)
+import Foreign (StablePtr, Ptr, Storable (..))
+import GHCi.RemoteTypes (HValue)
+
+--------------------------------------------------------------------------------
+-- Single step mode
+
+-- | Enables the single step mode for a specific thread, thus stopping only on
+-- breakpoints in that thread.
+foreign import ccall unsafe "rts_enableStopNextBreakpoint"
+ rts_enableStopNextBreakpoint :: ThreadId# -> IO ()
+
+-- | Disables per-thread single-step mode. Note: if global single-step is
+-- enabled we stop at all breakpoints regardless of the per-thread flag.
+foreign import ccall unsafe "rts_disableStopNextBreakpoint"
+ rts_disableStopNextBreakpoint :: ThreadId# -> IO ()
+
+-- | Enables the single step mode for all threads, thus stopping at any
+-- existing breakpoint.
+foreign import ccall unsafe "rts_enableStopNextBreakpointAll"
+ rts_enableStopNextBreakpointAll :: IO ()
+
+-- | Disables the single step mode for all threads
+foreign import ccall unsafe "rts_disableStopNextBreakpointAll"
+ rts_disableStopNextBreakpointAll :: IO ()
+
+--------------------------------------------------------------------------------
+
+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 unit id
+ -> Int# -- breakpoint info index
+ -> Bool -- exception?
+ -> HValue -- the AP_STACK, or exception
+ -> IO ()
+
+foreign import ccall "&rts_breakpoint_io_action"
+ breakPointIOAction :: Ptr (StablePtr BreakpointCallback)
+
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,
- UnboxedTuples, LambdaCase #-}
+ UnboxedTuples, LambdaCase, UnliftedFFITypes #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-- |
@@ -20,6 +20,7 @@ import GHCi.InfoTable
#endif
import qualified GHC.InfoProv as InfoProv
+import GHCi.Debugger
import GHCi.FFI
import GHCi.Message
import GHCi.ObjLink
@@ -332,7 +333,7 @@ withBreakAction opts breakMVar statusMVar act
stablePtr <- newStablePtr onBreak
poke breakPointIOAction stablePtr
when (breakOnException opts) $ poke exceptionFlag 1
- when (singleStep opts) $ setStepFlag
+ when (singleStep opts) rts_enableStopNextBreakpointAll
return stablePtr
-- Breaking on exceptions is not enabled by default, since it
-- might be a bit surprising. The exception flag is turned off
@@ -363,7 +364,7 @@ withBreakAction opts breakMVar statusMVar act
resetBreakAction stablePtr = do
poke breakPointIOAction noBreakStablePtr
poke exceptionFlag 0
- resetStepFlag
+ rts_disableStopNextBreakpointAll
freeStablePtr stablePtr
resumeStmt
@@ -396,28 +397,6 @@ abandonStmt hvref = do
_ <- takeMVar resumeStatusMVar
return ()
-foreign import ccall "&rts_stop_next_breakpoint" stepFlag :: Ptr CInt
-foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
-
-setStepFlag :: IO ()
-setStepFlag = poke stepFlag 1
-resetStepFlag :: IO ()
-resetStepFlag = poke stepFlag 0
-
-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 unit id
- -> Int# -- breakpoint info index
- -> Bool -- exception?
- -> HValue -- the AP_STACK, or exception
- -> IO ()
-
-foreign import ccall "&rts_breakpoint_io_action"
- breakPointIOAction :: Ptr (StablePtr BreakpointCallback)
-
noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -60,6 +60,7 @@ library
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
exposed-modules:
GHCi.Run
+ GHCi.Debugger
GHCi.CreateBCO
GHCi.ObjLink
GHCi.Signals
=====================================
rts/Interpreter.c
=====================================
@@ -243,9 +243,44 @@ allocate_NONUPD (Capability *cap, int n_words)
return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
-int rts_stop_next_breakpoint = 0;
int rts_stop_on_exception = 0;
+/* ---------------------------------------------------------------------------
+ * Enabling and disabling global single step mode
+ * ------------------------------------------------------------------------ */
+
+/* A global toggle for single-step mode.
+ * Unlike `TSO_STOP_NEXT_BREAKPOINT`, which sets single-step mode per-thread,
+ * `rts_stop_next_breakpoint` globally enables single-step mode. If enabled, we
+ * will stop at the immediate next breakpoint regardless of what thread it is in. */
+int rts_stop_next_breakpoint = 0;
+
+void rts_enableStopNextBreakpointAll(void)
+{
+ rts_stop_next_breakpoint = 1;
+}
+
+void rts_disableStopNextBreakpointAll(void)
+{
+ rts_stop_next_breakpoint = 0;
+}
+
+/* ---------------------------------------------------------------------------
+ * Enabling and disabling per-thread single step mode
+ * ------------------------------------------------------------------------ */
+
+void rts_enableStopNextBreakpoint(StgPtr tso)
+{
+ ((StgTSO *)tso)->flags |= TSO_STOP_NEXT_BREAKPOINT;
+}
+
+void rts_disableStopNextBreakpoint(StgPtr tso)
+{
+ ((StgTSO *)tso)->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
+}
+
+/* -------------------------------------------------------------------------- */
+
#if defined(INTERP_STATS)
#define N_CODES 128
@@ -1250,7 +1285,7 @@ run_BCO:
int arg8_cc;
#endif
StgArrBytes *breakPoints;
- int returning_from_break;
+ int returning_from_break, stop_next_breakpoint;
// the io action to run at a breakpoint
StgClosure *ioAction;
@@ -1280,6 +1315,13 @@ run_BCO:
returning_from_break =
cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
+ // check whether this thread is set to stop at the immediate next
+ // breakpoint -- either by the global `rts_stop_next_breakpoint`
+ // flag, or by the local `TSO_STOP_NEXT_BREAKPOINT`
+ stop_next_breakpoint =
+ rts_stop_next_breakpoint ||
+ cap->r.rCurrentTSO->flags & TSO_STOP_NEXT_BREAKPOINT;
+
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
(CostCentre*)BCO_LIT(arg8_cc));
@@ -1291,20 +1333,20 @@ run_BCO:
{
breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
- // stop the current thread if either the
- // "rts_stop_next_breakpoint" flag is true OR if the
- // ignore count for this particular breakpoint is zero
+ // 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];
- if (rts_stop_next_breakpoint == false && ignore_count > 0)
+ if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
}
- else if (rts_stop_next_breakpoint == true || ignore_count == 0)
+ else if (stop_next_breakpoint == true || ignore_count == 0)
{
// make sure we don't automatically stop at the
// next breakpoint
- rts_stop_next_breakpoint = false;
+ rts_stop_next_breakpoint = 0;
+ cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
// allocate memory for a new AP_STACK, enough to
// store the top stack frame plus an
=====================================
rts/Interpreter.h
=====================================
@@ -11,3 +11,8 @@
RTS_PRIVATE Capability *interpretBCO (Capability* cap);
void interp_startup ( void );
void interp_shutdown ( void );
+
+void rts_enableStopNextBreakpointAll ( void );
+void rts_disableStopNextBreakpointAll ( void );
+void rts_enableStopNextBreakpoint ( StgPtr );
+void rts_disableStopNextBreakpoint ( StgPtr );
=====================================
rts/RtsSymbols.c
=====================================
@@ -906,7 +906,8 @@ extern char **environ;
SymI_HasProto(revertCAFs) \
SymI_HasProto(RtsFlags) \
SymI_NeedsDataProto(rts_breakpoint_io_action) \
- SymI_NeedsDataProto(rts_stop_next_breakpoint) \
+ SymI_NeedsDataProto(rts_enableStopNextBreakpointAll) \
+ SymI_NeedsDataProto(rts_disableStopNextBreakpointAll) \
SymI_NeedsDataProto(rts_stop_on_exception) \
SymI_HasProto(stopTimer) \
SymI_HasProto(n_capabilities) \
=====================================
rts/include/rts/Constants.h
=====================================
@@ -328,6 +328,12 @@
*/
#define TSO_ALLOC_LIMIT 256
+/*
+ * Enables step-in mode for this thread -- it will stop at the immediate next
+ * breakpoint found in this thread.
+ */
+#define TSO_STOP_NEXT_BREAKPOINT 512
+
/*
* The number of times we spin in a spin lock before yielding (see
* #3758). To tune this value, use the benchmark in #3758: run the
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0249bf05a118b1295529f35f4fa7aa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0249bf05a118b1295529f35f4fa7aa…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 10 commits: rts/linker: Factor out ProddableBlocks machinery
by Marge Bot (＠marge-bot) 23 May '25
by Marge Bot (＠marge-bot) 23 May '25
23 May '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
3f4b823c by Ben Gamari at 2025-05-23T03:43:28-04:00
rts/linker: Factor out ProddableBlocks machinery
- - - - -
6e23fef2 by Ben Gamari at 2025-05-23T03:43:28-04:00
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.
- - - - -
ea74860c by Ben Gamari at 2025-05-23T03:43:28-04:00
testsuite: Add simple functional test for ProddableBlockSet
- - - - -
74c4db46 by Ben Gamari at 2025-05-23T03:43:28-04:00
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.
- - - - -
972d81d6 by Ben Gamari at 2025-05-23T03:43:28-04:00
rts/linker/PEi386: Clean up code style
- - - - -
8a1073a5 by Ben Gamari at 2025-05-23T03:43:28-04:00
rts/Hash: Factor out hashBuffer
This is a useful helper which can be used for non-strings as well.
- - - - -
44f509f2 by Ben Gamari at 2025-05-23T03:43:28-04:00
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.
- - - - -
bfb12783 by Ben Gamari at 2025-05-23T03:43:28-04:00
rts: Correctly mark const arguments
- - - - -
08469ff8 by Ben Gamari at 2025-05-23T03:43:28-04:00
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.
- - - - -
823d1ccf by Ben Gamari at 2025-05-23T03:43:28-04:00
rts/linker: Expand comment describing ProddableBlockSet
- - - - -
15 changed files:
- rts/Hash.c
- rts/Hash.h
- rts/Linker.c
- rts/LinkerInternals.h
- rts/PathUtils.c
- rts/PathUtils.h
- rts/linker/Elf.c
- rts/linker/MachO.c
- rts/linker/PEi386.c
- rts/linker/PEi386.h
- + rts/linker/ProddableBlocks.c
- + rts/linker/ProddableBlocks.h
- rts/rts.cabal
- + testsuite/tests/rts/TestProddableBlockSet.c
- testsuite/tests/rts/all.T
Changes:
=====================================
rts/Hash.c
=====================================
@@ -94,13 +94,13 @@ hashWord(const HashTable *table, StgWord key)
}
int
-hashStr(const HashTable *table, StgWord w)
+hashBuffer(const HashTable *table, const void *buf, size_t len)
{
- const char *key = (char*) w;
+ const char *key = (char*) buf;
#if WORD_SIZE_IN_BITS == 64
- StgWord h = XXH3_64bits_withSeed (key, strlen(key), 1048583);
+ StgWord h = XXH3_64bits_withSeed (key, len, 1048583);
#else
- StgWord h = XXH32 (key, strlen(key), 1048583);
+ StgWord h = XXH32 (key, len, 1048583);
#endif
/* Mod the size of the hash table (a power of 2) */
@@ -114,6 +114,13 @@ hashStr(const HashTable *table, StgWord w)
return bucket;
}
+int
+hashStr(const HashTable *table, StgWord w)
+{
+ const char *key = (char*) w;
+ return hashBuffer(table, key, strlen(key));
+}
+
STATIC_INLINE int
compareWord(StgWord key1, StgWord key2)
{
=====================================
rts/Hash.h
=====================================
@@ -69,6 +69,10 @@ void * removeStrHashTable ( StrHashTable *table, const char * key,
*/
typedef int HashFunction(const HashTable *table, StgWord key);
typedef int CompareFunction(StgWord key1, StgWord key2);
+
+// Helper for implementing hash functions
+int hashBuffer(const HashTable *table, const void *buf, size_t len);
+
int hashWord(const HashTable *table, StgWord key);
int hashStr(const HashTable *table, StgWord w);
void insertHashTable_ ( HashTable *table, StgWord key,
@@ -79,6 +83,7 @@ void * removeHashTable_ ( HashTable *table, StgWord key,
const void *data, HashFunction f,
CompareFunction cmp );
+
/* Freeing hash tables
*/
void freeHashTable ( HashTable *table, void (*freeDataFun)(void *) );
=====================================
rts/Linker.c
=====================================
@@ -1194,7 +1194,7 @@ void freeObjectCode (ObjectCode *oc)
stgFree(oc->sections);
}
- freeProddableBlocks(oc);
+ freeProddableBlocks(&oc->proddables);
freeSegments(oc);
/* Free symbol_extras. On x86_64 Windows, symbol_extras are allocated
@@ -1279,7 +1279,7 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize,
oc->sections = NULL;
oc->n_segments = 0;
oc->segments = NULL;
- oc->proddables = NULL;
+ initProddableBlockSet(&oc->proddables);
oc->foreign_exports = NULL;
#if defined(NEED_SYMBOL_EXTRAS)
oc->symbol_extras = NULL;
@@ -1834,50 +1834,6 @@ OStatus getObjectLoadStatus (pathchar *path)
return r;
}
-/* -----------------------------------------------------------------------------
- * Sanity checking. For each ObjectCode, maintain a list of address ranges
- * which may be prodded during relocation, and abort if we try and write
- * outside any of these.
- */
-void
-addProddableBlock ( ObjectCode* oc, void* start, int size )
-{
- ProddableBlock* pb
- = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
-
- IF_DEBUG(linker, debugBelch("addProddableBlock: %p %p %d\n", oc, start, size));
- ASSERT(size > 0);
- pb->start = start;
- pb->size = size;
- pb->next = oc->proddables;
- oc->proddables = pb;
-}
-
-void
-checkProddableBlock (ObjectCode *oc, void *addr, size_t size )
-{
- ProddableBlock* pb;
-
- for (pb = oc->proddables; pb != NULL; pb = pb->next) {
- char* s = (char*)(pb->start);
- char* e = s + pb->size;
- char* a = (char*)addr;
- if (a >= s && (a+size) <= e) return;
- }
- barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr);
-}
-
-void freeProddableBlocks (ObjectCode *oc)
-{
- ProddableBlock *pb, *next;
-
- for (pb = oc->proddables; pb != NULL; pb = next) {
- next = pb->next;
- stgFree(pb);
- }
- oc->proddables = NULL;
-}
-
/* -----------------------------------------------------------------------------
* Section management.
*/
=====================================
rts/LinkerInternals.h
=====================================
@@ -12,6 +12,7 @@
#include "RtsSymbols.h"
#include "Hash.h"
#include "linker/M32Alloc.h"
+#include "linker/ProddableBlocks.h"
#if RTS_LINKER_USE_MMAP
#include <sys/mman.h>
@@ -175,14 +176,6 @@ struct _Section {
struct SectionFormatInfo* info;
};
-typedef
- struct _ProddableBlock {
- void* start;
- int size;
- struct _ProddableBlock* next;
- }
- ProddableBlock;
-
typedef struct _Segment {
void *start; /* page aligned start address of a segment */
size_t size; /* page rounded size of a segment */
@@ -328,7 +321,7 @@ struct _ObjectCode {
/* SANITY CHECK ONLY: a list of the only memory regions which may
safely be prodded during relocation. Any attempt to prod
outside one of these is an error in the linker. */
- ProddableBlock* proddables;
+ ProddableBlockSet proddables;
#if defined(NEED_SYMBOL_EXTRAS)
SymbolExtra *symbol_extras;
@@ -434,10 +427,6 @@ void exitLinker( void );
void freeObjectCode (ObjectCode *oc);
SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo);
-void addProddableBlock ( ObjectCode* oc, void* start, int size );
-void checkProddableBlock (ObjectCode *oc, void *addr, size_t size );
-void freeProddableBlocks (ObjectCode *oc);
-
void addSection (Section *s, SectionKind kind, SectionAlloc alloc,
void* start, StgWord size, StgWord mapped_offset,
void* mapped_start, StgWord mapped_size);
=====================================
rts/PathUtils.c
=====================================
@@ -13,7 +13,7 @@
#include <wchar.h>
#endif
-pathchar* pathdup(pathchar *path)
+pathchar* pathdup(const pathchar *path)
{
pathchar *ret;
#if defined(mingw32_HOST_OS)
@@ -26,7 +26,7 @@ pathchar* pathdup(pathchar *path)
return ret;
}
-pathchar* pathdir(pathchar *path)
+pathchar* pathdir(const pathchar *path)
{
pathchar *ret;
#if defined(mingw32_HOST_OS)
@@ -40,7 +40,8 @@ pathchar* pathdir(pathchar *path)
stgFree(drive);
stgFree(dirName);
#else
- pathchar* dirName = dirname(path);
+ // N.B. cast is safe as we do not modify dirName
+ const pathchar* dirName = dirname((pathchar *) path);
size_t memberLen = pathlen(dirName);
ret = stgMallocBytes(pathsize * (memberLen + 2), "pathdir(path)");
strcpy(ret, dirName);
@@ -50,7 +51,7 @@ pathchar* pathdir(pathchar *path)
return ret;
}
-pathchar* mkPath(char* path)
+pathchar* mkPath(const char* path)
{
#if defined(mingw32_HOST_OS)
size_t required = mbstowcs(NULL, path, 0);
@@ -66,7 +67,7 @@ pathchar* mkPath(char* path)
#endif
}
-HsBool endsWithPath(pathchar* base, pathchar* str) {
+HsBool endsWithPath(const pathchar* base, const pathchar* str) {
int blen = pathlen(base);
int slen = pathlen(str);
return (blen >= slen) && (0 == pathcmp(base + blen - slen, str));
=====================================
rts/PathUtils.h
=====================================
@@ -37,9 +37,9 @@
#include "BeginPrivate.h"
-pathchar* pathdup(pathchar *path);
-pathchar* pathdir(pathchar *path);
-pathchar* mkPath(char* path);
-HsBool endsWithPath(pathchar* base, pathchar* str);
+pathchar* pathdup(const pathchar *path);
+pathchar* pathdir(const pathchar *path);
+pathchar* mkPath(const char* path);
+HsBool endsWithPath(const pathchar* base, const pathchar* str);
#include "EndPrivate.h"
=====================================
rts/linker/Elf.c
=====================================
@@ -924,7 +924,7 @@ ocGetNames_ELF ( ObjectCode* oc )
oc->sections[i].info->stubs = NULL;
#endif
- addProddableBlock(oc, start, size);
+ addProddableBlock(&oc->proddables, start, size);
} else {
addSection(&oc->sections[i], kind, alloc, oc->image+offset, size,
0, 0, 0);
@@ -1272,7 +1272,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
debugBelch("Reloc: P = %p S = %p A = %p type=%d\n",
(void*)P, (void*)S, (void*)A, reloc_type ));
#if defined(DEBUG)
- checkProddableBlock ( oc, pP, sizeof(Elf_Word) );
+ checkProddableBlock ( &oc->proddables, pP, sizeof(Elf_Word) );
#else
(void) pP; /* suppress unused varialbe warning in non-debug build */
#endif
@@ -1684,7 +1684,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
#if defined(DEBUG)
IF_DEBUG(linker_verbose,debugBelch("Reloc: P = %p S = %p A = %p\n",
(void*)P, (void*)S, (void*)A ));
- checkProddableBlock(oc, (void*)P, sizeof(Elf_Word));
+ checkProddableBlock(&oc->proddables, (void*)P, sizeof(Elf_Word));
#endif
#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
=====================================
rts/linker/MachO.c
=====================================
@@ -253,7 +253,7 @@ resolveImports(
return 0;
}
- checkProddableBlock(oc,
+ checkProddableBlock(&oc->proddables,
((void**)(oc->image + sect->offset)) + i,
sizeof(void *));
((void**)(oc->image + sect->offset))[i] = addr;
@@ -287,7 +287,7 @@ decodeAddend(ObjectCode * oc, Section * section, MachORelocationInfo * ri) {
/* the instruction. It is 32bit wide */
uint32_t * p = (uint32_t*)((uint8_t*)section->start + ri->r_address);
- checkProddableBlock(oc, (void*)p, 1 << ri->r_length);
+ checkProddableBlock(&oc->proddables, (void*)p, 1 << ri->r_length);
switch(ri->r_type) {
case ARM64_RELOC_UNSIGNED: {
@@ -364,7 +364,7 @@ encodeAddend(ObjectCode * oc, Section * section,
MachORelocationInfo * ri, int64_t addend) {
uint32_t * p = (uint32_t*)((uint8_t*)section->start + ri->r_address);
- checkProddableBlock(oc, (void*)p, 1 << ri->r_length);
+ checkProddableBlock(&oc->proddables, (void*)p, 1 << ri->r_length);
switch (ri->r_type) {
case ARM64_RELOC_UNSIGNED: {
@@ -788,7 +788,7 @@ relocateSection(ObjectCode* oc, int curSection)
default:
barf("Unknown size.");
}
- checkProddableBlock(oc,thingPtr,relocLenBytes);
+ checkProddableBlock(&oc->proddables,thingPtr,relocLenBytes);
/*
* With SIGNED_N the relocation is not at the end of the
@@ -1034,9 +1034,9 @@ relocateSection(ObjectCode* oc, int curSection)
*/
if (0 == reloc->r_extern) {
if (reloc->r_pcrel) {
- checkProddableBlock(oc, (void *)((char *)thing + baseValue), 1);
+ checkProddableBlock(&oc->proddables, (void *)((char *)thing + baseValue), 1);
} else {
- checkProddableBlock(oc, (void *)thing, 1);
+ checkProddableBlock(&oc->proddables, (void *)thing, 1);
}
}
@@ -1343,7 +1343,7 @@ ocGetNames_MachO(ObjectCode* oc)
secArray[sec_idx].info->stub_size = 0;
secArray[sec_idx].info->stubs = NULL;
#endif
- addProddableBlock(oc, start, section->size);
+ addProddableBlock(&oc->proddables, start, section->size);
}
curMem = (char*) secMem + section->size;
=====================================
rts/linker/PEi386.c
=====================================
@@ -378,7 +378,7 @@ static size_t makeSymbolExtra_PEi386(
#endif
static void addDLLHandle(
- pathchar* dll_name,
+ const pathchar* dll_name,
HINSTANCE instance);
static bool verifyCOFFHeader(
@@ -427,8 +427,52 @@ const int default_alignment = 8;
the pointer as a redirect. Essentially it's a DATA DLL reference. */
const void* __rts_iob_func = (void*)&__acrt_iob_func;
+/*
+ * Note [Avoiding repeated DLL loading]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * As LoadLibraryEx tends to be expensive and addDLL_PEi386 is called on every
+ * DLL-imported symbol, we use a hash-map to keep track of which DLLs have
+ * already been loaded. This hash-map is keyed on the dll_name passed to
+ * addDLL_PEi386 and is mapped to its HINSTANCE. This serves as a quick check
+ * to avoid repeated calls to LoadLibraryEx for the identical DLL. See #26009.
+ */
+
+typedef struct {
+ HashTable *hash;
+} LoadedDllCache;
+
+LoadedDllCache loaded_dll_cache;
+
+static void initLoadedDllCache(LoadedDllCache *cache) {
+ cache->hash = allocHashTable();
+}
+
+static int hash_path(const HashTable *table, StgWord w)
+{
+ const pathchar *key = (pathchar*) w;
+ return hashBuffer(table, key, sizeof(pathchar) * wcslen(key));
+}
+
+static int compare_path(StgWord key1, StgWord key2)
+{
+ return wcscmp((pathchar*) key1, (pathchar*) key2) == 0;
+}
+
+static void addLoadedDll(LoadedDllCache *cache, const pathchar *dll_name, HINSTANCE instance)
+{
+ insertHashTable_(cache->hash, (StgWord) dll_name, instance, hash_path);
+}
+
+static HINSTANCE isDllLoaded(const LoadedDllCache *cache, const pathchar *dll_name)
+{
+ void *result = lookupHashTable_(cache->hash, (StgWord) dll_name, hash_path, compare_path);
+ return (HINSTANCE) result;
+}
+
void initLinker_PEi386(void)
{
+ initLoadedDllCache(&loaded_dll_cache);
+
if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"),
symhash, "__image_base__",
GetModuleHandleW (NULL), HS_BOOL_TRUE,
@@ -440,10 +484,11 @@ void initLinker_PEi386(void)
addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL));
#endif
- /* Register the cleanup routine as an exit handler, this gives other exit handlers
- a chance to run which may need linker information. Exit handlers are ran in
- reverse registration order so this needs to be before the linker loads anything. */
- atexit (exitLinker_PEi386);
+ /* Register the cleanup routine as an exit handler, this gives other exit handlers
+ * a chance to run which may need linker information. Exit handlers are ran in
+ * reverse registration order so this needs to be before the linker loads anything.
+ */
+ atexit (exitLinker_PEi386);
}
void exitLinker_PEi386(void)
@@ -454,7 +499,7 @@ void exitLinker_PEi386(void)
static OpenedDLL* opened_dlls = NULL;
/* Adds a DLL instance to the list of DLLs in which to search for symbols. */
-static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
+static void addDLLHandle(const pathchar* dll_name, HINSTANCE instance) {
IF_DEBUG(linker, debugBelch("addDLLHandle(%" PATH_FMT ")...\n", dll_name));
/* At this point, we actually know what was loaded.
@@ -796,14 +841,19 @@ uint8_t* getSymShortName ( COFF_HEADER_INFO *info, COFF_symbol* sym )
}
const char *
-addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded )
+addDLL_PEi386( const pathchar *dll_name, HINSTANCE *loaded )
{
- /* ------------------- Win32 DLL loader ------------------- */
-
- pathchar* buf;
- HINSTANCE instance;
-
- IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name));
+ /* ------------------- Win32 DLL loader ------------------- */
+ IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name));
+
+ // See Note [Avoiding repeated DLL loading]
+ HINSTANCE instance = isDllLoaded(&loaded_dll_cache, dll_name);
+ if (instance) {
+ if (loaded) {
+ *loaded = instance;
+ }
+ return NULL;
+ }
/* The file name has no suffix (yet) so that we can try
both foo.dll and foo.drv
@@ -816,45 +866,32 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded )
extension. */
size_t bufsize = pathlen(dll_name) + 10;
- buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL");
+ pathchar *buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL");
/* These are ordered by probability of success and order we'd like them. */
const wchar_t *formats[] = { L"%ls.DLL", L"%ls.DRV", L"lib%ls.DLL", L"%ls" };
const DWORD flags[] = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 };
- int cFormat, cFlag;
- int flags_start = 1; /* Assume we don't support the new API. */
-
- /* Detect if newer API are available, if not, skip the first flags entry. */
- if (GetProcAddress((HMODULE)LoadLibraryW(L"Kernel32.DLL"), "AddDllDirectory")) {
- flags_start = 0;
- }
-
/* Iterate through the possible flags and formats. */
- for (cFlag = flags_start; cFlag < 2; cFlag++)
- {
- for (cFormat = 0; cFormat < 4; cFormat++)
- {
+ for (int cFlag = 0; cFlag < 2; cFlag++) {
+ for (int cFormat = 0; cFormat < 4; cFormat++) {
snwprintf(buf, bufsize, formats[cFormat], dll_name);
instance = LoadLibraryExW(buf, NULL, flags[cFlag]);
if (instance == NULL) {
- if (GetLastError() != ERROR_MOD_NOT_FOUND)
- {
+ if (GetLastError() != ERROR_MOD_NOT_FOUND) {
goto error;
}
- }
- else
- {
- break; /* We're done. DLL has been loaded. */
+ } else {
+ goto loaded; /* We're done. DLL has been loaded. */
}
}
}
- /* Check if we managed to load the DLL. */
- if (instance == NULL) {
- goto error;
- }
+ // We failed to load
+ goto error;
+loaded:
+ addLoadedDll(&loaded_dll_cache, dll_name, instance);
addDLLHandle(buf, instance);
if (loaded) {
*loaded = instance;
@@ -1658,7 +1695,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
}
addSection(section, kind, SECTION_NOMEM, start, sz, 0, 0, 0);
- addProddableBlock(oc, oc->sections[i].start, sz);
+ addProddableBlock(&oc->proddables, oc->sections[i].start, sz);
}
/* Copy exported symbols into the ObjectCode. */
@@ -1690,7 +1727,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
SECTIONKIND_RWDATA, SECTION_MALLOC,
bss, globalBssSize, 0, 0, 0);
IF_DEBUG(linker_verbose, debugBelch("bss @ %p %" FMT_Word "\n", bss, globalBssSize));
- addProddableBlock(oc, bss, globalBssSize);
+ addProddableBlock(&oc->proddables, bss, globalBssSize);
} else {
addSection(&oc->sections[oc->n_sections-1],
SECTIONKIND_OTHER, SECTION_NOMEM, NULL, 0, 0, 0, 0);
@@ -2067,13 +2104,13 @@ ocResolve_PEi386 ( ObjectCode* oc )
IF_DEBUG(linker_verbose, debugBelch("S=%zx\n", S));
/* All supported relocations write at least 4 bytes */
- checkProddableBlock(oc, pP, 4);
+ checkProddableBlock(&oc->proddables, pP, 4);
switch (reloc->Type) {
#if defined(x86_64_HOST_ARCH)
case 1: /* R_X86_64_64 (ELF constant 1) - IMAGE_REL_AMD64_ADDR64 (PE constant 1) */
{
uint64_t A;
- checkProddableBlock(oc, pP, 8);
+ checkProddableBlock(&oc->proddables, pP, 8);
A = *(uint64_t*)pP;
*(uint64_t *)pP = S + A;
break;
@@ -2114,7 +2151,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
{
/* mingw will emit this for a pc-rel 64 relocation */
uint64_t A;
- checkProddableBlock(oc, pP, 8);
+ checkProddableBlock(&oc->proddables, pP, 8);
A = *(uint64_t*)pP;
*(uint64_t *)pP = S + A - (intptr_t)pP;
break;
=====================================
rts/linker/PEi386.h
=====================================
@@ -45,7 +45,7 @@ typedef struct _COFF_HEADER_INFO {
void initLinker_PEi386( void );
void exitLinker_PEi386( void );
-const char * addDLL_PEi386( pathchar *dll_name, HINSTANCE *instance );
+const char * addDLL_PEi386( const pathchar *dll_name, HINSTANCE *instance );
void freePreloadObjectFile_PEi386( ObjectCode *oc );
bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f);
=====================================
rts/linker/ProddableBlocks.c
=====================================
@@ -0,0 +1,137 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2025
+ *
+ * RTS Object Linker
+ *
+ * ---------------------------------------------------------------------------*/
+
+
+/*
+ * Note [Proddable blocks]
+ * ~~~~~~~~~~~~~~~~~~~~~~~
+ * For each ObjectCode, we maintain a ProddableBlockSet representing the set of
+ * address ranges containing data belonging to the object. This set is
+ * represented here as an array of intervals sorted by start address. This
+ * allows us to efficiently query and insert via binary search. Array resizing
+ * is done according to an exponential growth schedule.
+ *
+ * While performing relocations we check against this set and and abort if we
+ * try and write outside any of these.
+ */
+
+#include "Rts.h"
+#include "RtsUtils.h"
+#include "linker/ProddableBlocks.h"
+
+#include <stdlib.h>
+#include <string.h>
+
+typedef struct _ProddableBlock {
+ uintptr_t start; // inclusive
+ uintptr_t end; // inclusive
+} ProddableBlock;
+
+void
+initProddableBlockSet ( ProddableBlockSet* set )
+{
+ set->data = NULL;
+ set->capacity = 0;
+ set->size = 0;
+}
+
+void
+freeProddableBlocks (ProddableBlockSet *set)
+{
+ stgFree(set->data);
+ set->data = NULL;
+ set->size = 0;
+ set->capacity = 0;
+}
+
+// Binary search for the first interval with start >= value. Returns index or
+// size if none.
+static size_t
+findLower(const ProddableBlockSet *set, uintptr_t value)
+{
+ size_t l = 0;
+ size_t r = set->size;
+ while (l < r) {
+ size_t mid = l + (r - l) / 2;
+ if (set->data[mid].start < value) {
+ l = mid + 1;
+ } else {
+ r = mid;
+ }
+ }
+ return l;
+}
+
+// Check whether a given value is a member of the set.
+bool
+containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end )
+{
+ size_t i = findLower(set, start+1);
+ return i > 0
+ && set->data[i-1].start <= start
+ && end <= set->data[i-1].end;
+}
+
+void
+checkProddableBlock (const ProddableBlockSet *set, void *addr, size_t size )
+{
+ if (! containsSpan(set, (uintptr_t) addr, (uintptr_t) addr+size)) {
+ barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr);
+ }
+}
+
+// Ensure capacity for at least new_capacity intervals
+static void
+ensureCapacity(ProddableBlockSet *set, size_t new_capacity) {
+ if (new_capacity > set->capacity) {
+ size_t cap = set->capacity ? set->capacity * 2 : 4;
+ if (cap < new_capacity) {
+ cap = new_capacity;
+ }
+ ProddableBlock *tmp = stgReallocBytes(set->data, cap * sizeof(ProddableBlock), "addProddableBlock");
+ set->data = tmp;
+ set->capacity = cap;
+ }
+}
+
+void
+addProddableBlock ( ProddableBlockSet* set, void* start_ptr, size_t size )
+{
+ const uintptr_t start = (uintptr_t) start_ptr;
+ const uintptr_t end = (uintptr_t) start + size;
+ size_t i = findLower(set, start);
+
+ // check previous interval if it is overlapping or adjacent
+ if (i > 0 && start <= set->data[i-1].end + 1) {
+ // merge with left interval
+ i--;
+ if (end > set->data[i].end) {
+ set->data[i].end = end;
+ }
+ } else {
+ // insert new interval
+ ensureCapacity(set, set->size + 1);
+ memmove(&set->data[i+1], &set->data[i], sizeof(ProddableBlock) * (set->size - i));
+ set->data[i].start = start;
+ set->data[i].end = end;
+ set->size++;
+ }
+
+ // coalesce overlaps on right
+ size_t j = i;
+ while (j < set->size && set->data[j].start <= set->data[i].end + 1) {
+ set->data[i].end = set->data[j].end;
+ j++;
+ }
+
+ if (j != i) {
+ memmove(&set->data[i+1], &set->data[j], sizeof(ProddableBlock) * (set->size - j));
+ set->size -= j - i - 1;
+ }
+}
+
=====================================
rts/linker/ProddableBlocks.h
=====================================
@@ -0,0 +1,38 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2025
+ *
+ * RTS Object Linker
+ *
+ * ---------------------------------------------------------------------------*/
+
+#pragma once
+
+#include <stdbool.h>
+#include <stddef.h>
+#include <stdint.h>
+
+// An interval set on uintptr_t.
+struct _ProddableBlock;
+
+typedef struct {
+ size_t size;
+ size_t capacity;
+ // sorted list of disjoint (start,end) pairs
+ struct _ProddableBlock *data;
+} ProddableBlockSet;
+
+void initProddableBlockSet ( ProddableBlockSet* set );
+
+// Insert an interval.
+void addProddableBlock ( ProddableBlockSet* set, void* start, size_t size );
+
+// Check that an address belongs to the set.
+void checkProddableBlock (const ProddableBlockSet *set, void *addr, size_t size );
+
+
+// Free a set.
+void freeProddableBlocks (ProddableBlockSet *set);
+
+// For testing.
+bool containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end );
=====================================
rts/rts.cabal
=====================================
@@ -491,6 +491,7 @@ library
linker/MachO.c
linker/macho/plt.c
linker/macho/plt_aarch64.c
+ linker/ProddableBlocks.c
linker/PEi386.c
linker/SymbolExtras.c
linker/elf_got.c
=====================================
testsuite/tests/rts/TestProddableBlockSet.c
=====================================
@@ -0,0 +1,33 @@
+#include <assert.h>
+#include <stdbool.h>
+#include <stdint.h>
+#include <stddef.h>
+
+// Excerpted from ProddableBlocks.h
+typedef struct {
+ size_t size;
+ size_t capacity;
+ // sorted list of disjoint (start,end) pairs
+ struct _ProddableBlock *data;
+} ProddableBlockSet;
+
+void initProddableBlockSet ( ProddableBlockSet* set );
+void addProddableBlock ( ProddableBlockSet* set, void* start, size_t size );
+bool containsSpan ( const ProddableBlockSet *set, uintptr_t start, uintptr_t end );
+
+int main () {
+ ProddableBlockSet set;
+ initProddableBlockSet(&set);
+ addProddableBlock(&set, (void*) 0x20, 0x10);
+ addProddableBlock(&set, (void*) 0x30, 0x10);
+ addProddableBlock(&set, (void*) 0x100, 0x10);
+
+ assert( containsSpan(&set, 0x20, 0x30));
+ assert( containsSpan(&set, 0x30, 0x29));
+ assert(!containsSpan(&set, 0x30, 0x49));
+ assert(!containsSpan(&set, 0x60, 0x70));
+ assert(!containsSpan(&set, 0x90, 0x110));
+ assert( containsSpan(&set, 0x100, 0x101));
+ return 0;
+}
+
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -641,3 +641,5 @@ test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_ru
# N.B. This will likely issue a warning on stderr but we merely care that the
# program doesn't crash.
test('T25560', [req_c_rts, ignore_stderr], compile_and_run, [''])
+
+test('TestProddableBlockSet', [req_c_rts], multimod_compile_and_run, ['TestProddableBlockSet.c', '-no-hs-main'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7722232c6f8f0b57db03d0439d7789…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7722232c6f8f0b57db03d0439d7789…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 3 commits: base: Forward port changelog language from 9.12
by Marge Bot (＠marge-bot) 23 May '25
by Marge Bot (＠marge-bot) 23 May '25
23 May '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
e650ec3e by Ben Gamari at 2025-05-23T03:42:46-04:00
base: Forward port changelog language from 9.12
- - - - -
94cd9ca4 by Ben Gamari at 2025-05-23T03:42:46-04:00
base: Fix RestructuredText-isms in changelog
- - - - -
7722232c by Ben Gamari at 2025-05-23T03:42:46-04:00
base: Note strictness changes made in 4.16.0.0
Addresses #25886.
- - - - -
1 changed file:
- libraries/base/changelog.md
Changes:
=====================================
libraries/base/changelog.md
=====================================
@@ -26,7 +26,8 @@
* Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)).
-## 4.21.0.0 *TBA*
+## 4.21.0.0 *December 2024*
+ * Shipped with GHC 9.12.1
* Change `SrcLoc` to be a strict and unboxed (finishing [CLC proposal #55](https://github.com/haskell/core-libraries-committee/issues/55))
* Introduce `Data.Bounded` module exporting the `Bounded` typeclass (finishing [CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208))
* Deprecate export of `Bounded` class from `Data.Enum` ([CLC proposal #208](https://github.com/haskell/core-libraries-committee/issues/208))
@@ -311,29 +312,29 @@
* Re-export the `IsList` typeclass from the new `GHC.IsList` module.
- * There's a new special function ``withDict`` in ``GHC.Exts``: ::
+ * There's a new special function `withDict` in `GHC.Exts`: ::
withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r
- where ``cls`` must be a class containing exactly one method, whose type
- must be ``meth``.
+ where `cls` must be a class containing exactly one method, whose type
+ must be `meth`.
- This function converts ``meth`` to a type class dictionary.
- It removes the need for ``unsafeCoerce`` in implementation of reflection
+ This function converts `meth` to a type class dictionary.
+ It removes the need for `unsafeCoerce` in implementation of reflection
libraries. It should be used with care, because it can introduce
incoherent instances.
- For example, the ``withTypeable`` function from the
- ``Type.Reflection`` module can now be defined as: ::
+ For example, the `withTypeable` function from the
+ `Type.Reflection` module can now be defined as: ::
withTypeable :: forall k (a :: k) rep (r :: TYPE rep). ()
=> TypeRep a -> (Typeable a => r) -> r
withTypeable rep k = withDict @(Typeable a) rep k
Note that the explicit type application is required, as the call to
- ``withDict`` would be ambiguous otherwise.
+ `withDict` would be ambiguous otherwise.
- This replaces the old ``GHC.Exts.magicDict``, which required
+ This replaces the old `GHC.Exts.magicDict`, which required
an intermediate data type and was less reliable.
* `Data.Word.Word64` and `Data.Int.Int64` are now always represented by
@@ -351,17 +352,17 @@
* Shipped with GHC 9.2.4
- * winio: make consoleReadNonBlocking not wait for any events at all.
+ * winio: make `consoleReadNonBlocking` not wait for any events at all.
- * winio: Add support to console handles to handleToHANDLE
+ * winio: Add support to console handles to `handleToHANDLE`
## 4.16.2.0 *May 2022*
* Shipped with GHC 9.2.2
- * Export GHC.Event.Internal on Windows (#21245)
+ * Export `GHC.Event.Internal` on Windows (#21245)
- # Documentation Fixes
+ * Documentation Fixes
## 4.16.1.0 *Feb 2022*
@@ -430,10 +431,17 @@
- Newtypes `And`, `Ior`, `Xor` and `Iff` which wrap their argument,
and whose `Semigroup` instances are defined using `(.&.)`, `(.|.)`, `xor`
- and ```\x y -> complement (x `xor` y)```, respectively.
+ and `\x y -> complement (x `xor` y)`, respectively.
- `oneBits :: FiniteBits a => a`, `oneBits = complement zeroBits`.
+ * Various folding operations in `GHC.List` are now implemented via strict
+ folds:
+ - `sum`
+ - `product`
+ - `maximum`
+ - `minimum`
+
## 4.15.0.0 *Feb 2021*
* Shipped with GHC 9.0.1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1212fbfaf7884077386b08a4fedc1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1212fbfaf7884077386b08a4fedc1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: Don't fail when ghcversion.h can't be found (#26018)
by Marge Bot (＠marge-bot) 23 May '25
by Marge Bot (＠marge-bot) 23 May '25
23 May '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
6d058a69 by Andrea Bedini at 2025-05-21T16:00:51-04:00
Don't fail when ghcversion.h can't be found (#26018)
If ghcversion.h can't be found, don't try to include it. This happens
when there is no rts package in the package db and when -ghcversion-file
argument isn't passed.
Co-authored-by: Syvlain Henry <sylvain(a)haskus.fr>
- - - - -
b1212fbf by Vladislav Zavialov at 2025-05-21T16:01:33-04:00
Implement -Wpattern-namespace-specifier (#25900)
In accordance with GHC Proposal #581 "Namespace-specified imports",
section 2.3 "Deprecate use of pattern in import/export lists", the
`pattern` namespace specifier is now deprecated.
Test cases: T25900 T25900_noext
- - - - -
bbe93023 by Ben Gamari at 2025-05-22T20:02:17-04:00
base: Forward port changelog language from 9.12
- - - - -
4f0ae34c by Ben Gamari at 2025-05-22T20:02:18-04:00
base: Fix RestructuredText-isms in changelog
- - - - -
e5b688c4 by Ben Gamari at 2025-05-22T20:02:18-04:00
base: Note strictness changes made in 4.16.0.0
Addresses #25886.
- - - - -
2e3550f8 by Ben Gamari at 2025-05-22T20:02:19-04:00
rts/linker: Factor out ProddableBlocks machinery
- - - - -
049419e6 by Ben Gamari at 2025-05-22T20:02:19-04:00
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.
- - - - -
25358735 by Ben Gamari at 2025-05-22T20:02:19-04:00
testsuite: Add simple functional test for ProddableBlockSet
- - - - -
e2a354fa by Ben Gamari at 2025-05-22T20:02:19-04:00
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.
- - - - -
db8fc3eb by Ben Gamari at 2025-05-22T20:02:19-04:00
rts/linker/PEi386: Clean up code style
- - - - -
0dcfea49 by Ben Gamari at 2025-05-22T20:02:19-04:00
rts/Hash: Factor out hashBuffer
This is a useful helper which can be used for non-strings as well.
- - - - -
23316721 by Ben Gamari at 2025-05-22T20:02:19-04:00
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.
- - - - -
d0b564d2 by Ben Gamari at 2025-05-22T20:02:19-04:00
rts: Correctly mark const arguments
- - - - -
b24af81e by Ben Gamari at 2025-05-22T20:02:19-04:00
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.
- - - - -
0fdcb69d by Ben Gamari at 2025-05-22T20:02:19-04:00
rts/linker: Expand comment describing ProddableBlockSet
- - - - -
76 changed files:
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/using-warnings.rst
- hadrian/src/Flavour.hs
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Type/Reflection.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- rts/Hash.c
- rts/Hash.h
- rts/Linker.c
- rts/LinkerInternals.h
- rts/PathUtils.c
- rts/PathUtils.h
- rts/linker/Elf.c
- rts/linker/MachO.c
- rts/linker/PEi386.c
- rts/linker/PEi386.h
- + rts/linker/ProddableBlocks.c
- + rts/linker/ProddableBlocks.h
- rts/rts.cabal
- testsuite/tests/callarity/unittest/CallArity1.hs
- testsuite/tests/driver/Makefile
- testsuite/tests/driver/all.T
- testsuite/tests/ghci/scripts/ghci024.stdout
- testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
- + testsuite/tests/parser/should_compile/T25900.hs
- + testsuite/tests/parser/should_compile/T25900.stderr
- + testsuite/tests/parser/should_compile/T25900_noext.hs
- + testsuite/tests/parser/should_compile/T25900_noext.stderr
- testsuite/tests/parser/should_compile/all.T
- testsuite/tests/patsyn/should_compile/ImpExp_Exp.hs
- testsuite/tests/patsyn/should_compile/T11959.hs
- testsuite/tests/patsyn/should_compile/T11959.stderr
- testsuite/tests/patsyn/should_compile/T11959Lib.hs
- testsuite/tests/patsyn/should_compile/T13350/boolean/Boolean.hs
- testsuite/tests/patsyn/should_compile/T22521.hs
- testsuite/tests/patsyn/should_compile/T9857.hs
- testsuite/tests/patsyn/should_compile/export.hs
- testsuite/tests/pmcheck/complete_sigs/T25115a.hs
- testsuite/tests/pmcheck/should_compile/T11822.hs
- testsuite/tests/polykinds/T14270.hs
- testsuite/tests/rename/should_compile/T12548.hs
- testsuite/tests/rename/should_fail/T25056.stderr
- testsuite/tests/rename/should_fail/T25056a.hs
- + testsuite/tests/rts/TestProddableBlockSet.c
- testsuite/tests/rts/all.T
- testsuite/tests/simplCore/should_compile/T15186.hs
- testsuite/tests/simplCore/should_compile/T15186A.hs
- testsuite/tests/typecheck/should_compile/TypeRepCon.hs
- testsuite/tests/warnings/should_compile/DataToTagWarnings.hs
- testsuite/tests/warnings/should_compile/T14794a.hs
- testsuite/tests/warnings/should_compile/T14794a.stderr
- testsuite/tests/warnings/should_compile/T14794b.hs
- testsuite/tests/warnings/should_compile/T14794b.stderr
- testsuite/tests/warnings/should_compile/T14794c.hs
- testsuite/tests/warnings/should_compile/T14794c.stderr
- testsuite/tests/warnings/should_compile/T14794d.hs
- testsuite/tests/warnings/should_compile/T14794d.stderr
- testsuite/tests/warnings/should_compile/T14794e.hs
- testsuite/tests/warnings/should_compile/T14794e.stderr
- testsuite/tests/warnings/should_compile/T14794f.hs
- testsuite/tests/warnings/should_compile/T14794f.stderr
- testsuite/tests/wcompat-warnings/Template.hs
- + testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f4a8ce3401c9d0acbe7e9087d9c844…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f4a8ce3401c9d0acbe7e9087d9c844…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26049] base: Expose Backtraces constructor and fields
by Ben Gamari (＠bgamari) 22 May '25
by Ben Gamari (＠bgamari) 22 May '25
22 May '25
Ben Gamari pushed to branch wip/T26049 at Glasgow Haskell Compiler / GHC
Commits:
b1b8a882 by Ben Gamari at 2025-05-22T18:22:31-04:00
base: Expose Backtraces constructor and fields
This was specified in the proposal (CLC #199) yet somehow didn't make it
into the implementation.
Fixes #26049.
- - - - -
7 changed files:
- libraries/base/changelog.md
- libraries/base/src/Control/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- 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
Changes:
=====================================
libraries/base/changelog.md
=====================================
@@ -22,6 +22,7 @@
* `GHC.TypeNats.Internal`
* `GHC.ExecutionStack.Internal`.
* Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
+ * Expose constructor and field of `Backtraces` from `Control.Exception.Backtrace`, as per [CLC #199](https://github.com/haskell/core-libraries-committee/issues/199#issuecomment-1954662391)
## 4.21.0.0 *TBA*
* Change `SrcLoc` to be a strict and unboxed (finishing [CLC proposal #55](https://github.com/haskell/core-libraries-committee/issues/55))
=====================================
libraries/base/src/Control/Exception/Backtrace.hs
=====================================
@@ -51,7 +51,7 @@ module Control.Exception.Backtrace
, getBacktraceMechanismState
, setBacktraceMechanismState
-- * Collecting backtraces
- , Backtraces
+ , Backtraces(..)
, displayBacktraces
, collectBacktraces
) where
=====================================
libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
=====================================
@@ -9,7 +9,7 @@ module GHC.Internal.Exception.Backtrace
, getBacktraceMechanismState
, setBacktraceMechanismState
-- * Collecting backtraces
- , Backtraces
+ , Backtraces(..)
, displayBacktraces
, collectBacktraces
) where
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = ...
+ data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = ...
+ data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = ...
+ data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = ...
+ data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1b8a8820ef22a3d18179696366cdbc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1b8a8820ef22a3d18179696366cdbc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/az/ghc-cpp] 142 commits: Allow the 'data' keyword in import/export lists (#25899)
by Alan Zimmerman (＠alanz) 22 May '25
by Alan Zimmerman (＠alanz) 22 May '25
22 May '25
Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC
Commits:
fd64667d by Vladislav Zavialov at 2025-05-20T03:25:08-04:00
Allow the 'data' keyword in import/export lists (#25899)
This patch introduces the 'data' namespace specifier in import and
export lists. The intended use is to import data constructors without
their parent type constructors, e.g.
import Data.Proxy as D (data Proxy)
type DP = D.Proxy -- promoted data constructor
Additionally, it is possible to use 'data' to explicitly qualify any
data constructors or terms, incl. operators and field selectors
import Prelude (Semigroup(data (<>)))
import Data.Function (data (&))
import Data.Monoid (data Dual, data getDual)
x = Dual "Hello" <> Dual "World" & getDual
The implementation mostly builds on top of the existing logic for the
'type' and 'pattern' namespace specifiers, plus there are a few tweaks
to how we generate suggestions in error messages.
- - - - -
acc86753 by Ben Gamari at 2025-05-20T03:25:51-04:00
compiler: Use field selectors when creating BCOs
This makes it easier to grep for these fields.
- - - - -
60a55fd7 by Ben Gamari at 2025-05-20T03:25:51-04:00
compiler: Clarify BCO size
Previously the semantics and size of StgBCO was a bit unclear.
Specifically, the `size` field was documented to contain the size of the
bitmap whereas it was actually the size of the closure *and* bitmap.
Additionally, it was not as clear as it could be that the bitmap was a
full StgLargeBitmap with its own `size` field.
- - - - -
ac9fb269 by Simon Peyton Jones at 2025-05-20T09:19:04-04:00
Track rewriter sets more accurately in constraint solving
This MR addresses #26003, by refactoring the arcane
intricacies of Note [Equalities with incompatible kinds].
NB: now retitled to
Note [Equalities with heterogeneous kinds].
and the main Note for this MR.
In particular:
* Abandon invariant (COERCION-HOLE) in Note [Unification preconditions] in
GHC.Tc.Utils.Unify.
* Abandon invariant (TyEq:CH)) in Note [Canonical equalities] in
GHC.Tc.Types.Constraint.
* Instead: add invariant (REWRITERS) to Note [Unification preconditions]:
unify only if the constraint has an empty rewriter set.
Implementation:
* In canEqCanLHSFinish_try_unification, skip trying unification if there is a
non-empty rewriter set.
* To do this, make sure the rewriter set is zonked; do so in selectNextWorkItem,
which also deals with prioritisation.
* When a coercion hole is filled, kick out inert equalities that have that hole
as a rewriter. It might now be unlocked and available to unify.
* Remove the ad-hoc `ch_hetero_kind` field of `CoercionHole`.
* In `selectNextWorkItem`, priorities equalities withan empty rewriter set.
* Defaulting: see (DE6) in Note [Defaulting equalities]
and Note [Limited defaulting in the ambiguity check]
* Concreteness checks: there is some extra faff to try to get decent
error messages when the FRR (representation-polymorphism) checks
fail. In partiular, add a "When unifying..." explanation when the
representation-polymorphism check arose from another constraint.
- - - - -
86406f48 by Cheng Shao at 2025-05-20T09:19:47-04:00
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.
- - - - -
7147370b by Cheng Shao at 2025-05-20T17:22:19-04:00
compiler: do not allocate strings in bytecode assembler
This patch refactors the compiler to avoid allocating iserv buffers
for BCONPtrStr at assemble-time. Now BCONPtrStr ByteStrings are
recorded as a part of CompiledByteCode, and actual allocation only
happens at link-time. This refactoring is necessary for adding
bytecode serialization functionality, as explained by the revised
comments in this commit.
- - - - -
a67db612 by Cheng Shao at 2025-05-20T17:22:19-04:00
compiler: make bc_strs serializable
This commit makes the bc_strs field in CompiledByteCode serializable;
similar to previous commit, we preserve the ByteString directly and
defer the actual allocation to link-time, as mentioned in updated
comment.
- - - - -
5faf34ef by Cheng Shao at 2025-05-20T17:22:19-04:00
compiler: make bc_itbls serializable
This commit makes bc_itbls in CompiledByteCode serializable. A
dedicated ConInfoTable datatype has been added in ghci which is the
recipe for dynamically making a datacon's info table, containing the
payload of the MkConInfoTable iserv message.
- - - - -
2abaf8c1 by Cheng Shao at 2025-05-20T17:22:19-04:00
compiler: remove FFIInfo bookkeeping in BCO
This commit removes the bc_ffis field from CompiledByteCode
completely, as well as all the related bookkeeping logic in
GHC.StgToByteCode. bc_ffis is actually *unused* in the rest of GHC
codebase! It is merely a list of FFIInfo, which is just a remote
pointer of the libffi ffi_cif struct; once we allocate the ffi_cif
struct and put its pointer in a CCALL instruction, we'll never free it
anyway. So there is no point of bookkeeping.
- - - - -
adb9e4d2 by Cheng Shao at 2025-05-20T17:22:19-04:00
compiler: make FFIInfo serializable in BCO
This commit makes all the FFIInfo needed in CCALL instructions
serializable. Previously, when doing STG to BCO lowering, we would
allocate a libffi ffi_cif struct and keep its remote pointer as
FFIInfo; but actually we can just keep the type signature as FFIInfo
and defer the actual allocation to link-time.
- - - - -
200f401b by Cheng Shao at 2025-05-20T17:22:19-04:00
ghci: remove redundant NewBreakModule message
This commit removes the redundant NewBreakModule message from ghci: it
just allocates two strings! This functionality can be implemented with
existing MallocStrings in one iserv call.
- - - - -
ddaadca6 by Cheng Shao at 2025-05-20T17:22:19-04:00
compiler: make breakpoint module name and unit id serializable
This commit makes breakpoint module name and unit id serializable, in
BRK_FUN instructions as well as ModBreaks. We can simply keep the
module name and unit ids, and defer the buffer allocation to link
time.
- - - - -
a0fde202 by Cheng Shao at 2025-05-20T17:22:19-04:00
compiler: remove unused newModule
This commit removes the now unused newModule function from GHC.
- - - - -
68c8f140 by Cheng Shao at 2025-05-20T17:22:19-04:00
compiler: add BCONPtrFS for interned top level string literals in BCO
This commit adds BCONPtrFS as a BCO non-pointer literal kind, which
has the same semantics of BCONPtrStr, except it contains a FastString
instead of a ByteString. By using BCONPtrFS to represent top level
string literals that are already FastString in the compilation
pipeline, we enjoy the FastString interning logic and avoid allocating
a bunch of redundant ByteStrings for the same FastStrings, especially
when we lower the BRK_FUN instruction.
- - - - -
f2b532bc by Peng Fan at 2025-05-20T17:23:15-04:00
hadrian: enable GHCi for loongarch64
- - - - -
8ded2330 by kwxm at 2025-05-20T17:24:07-04:00
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 | #)`.
- - - - -
c9abb87c by Andreas Klebinger at 2025-05-20T17:24:50-04:00
Specialise: Don't float out constraint components.
It was fairly complex to do so and it doesn't seem to improve anything.
Nofib allocations were unaffected as well.
See also Historical Note [Floating dictionaries out of cases]
- - - - -
202b201c by Andreas Klebinger at 2025-05-21T10:16:14-04:00
Interpreter: Add limited support for direct primop evaluation.
This commit adds support for a number of primops directly
to the interpreter. This avoids the indirection of going
through the primop wrapper for those primops speeding interpretation
of optimized code up massively.
Code involving IntSet runs about 25% faster with optimized core and these
changes. For core without breakpoints it's even more pronouced and I
saw reductions in runtime by up to 50%.
Running GHC itself in the interpreter was sped up by ~15% through this
change.
Additionally this comment does a few other related changes:
testsuite:
* Run foundation test in ghci and ghci-opt ways to test these
primops.
* Vastly expand the foundation test to cover all basic primops
by comparing result with the result of calling the wrapper.
Interpreter:
* When pushing arguments for interpreted primops extend each argument to
at least word with when pushing. This avoids some issues with big
endian. We can revisit this if it causes performance issues.
* Restructure the stack chunk check logic. There are now macros for
read accesses which might cross stack chunk boundries and macros which
omit the checks which are used when we statically know we access an
address in the current stack chunk.
- - - - -
67a177b4 by sheaf at 2025-05-21T10:17:04-04:00
QuickLook: do a shape test before unifying
This commit ensures we do a shape test before unifying. This ensures
we don't try to unify a TyVarTv with a non-tyvar, e.g.
alpha[tyv] := Int
On the way, we refactor simpleUnifyCheck:
1. Move the checkTopShape check into simpleUnifyCheck
2. Refactors simpleUnifyCheck to return a value of the new type
SimpleUnifyResult type. Now, simpleUnifyCheck returns "can unify",
"cannot unify" or "dunno" (with "cannot unify" being the new result
it can return). Now:
- touchabilityTest is included; it it fails we return "cannot unify"
- checkTopShape now returns "cannot unify" instead of "dunno" upon failure
3. Move the call to simpleUnifyCheck out of checkTouchableTyVarEq.
After that, checkTouchableTyVarEq becames a simple call to
checkTyEqRhs, so we inline it.
This allows the logic in canEqCanLHSFinish_try_unification to be simplified.
In particular, we now avoid calling 'checkTopShape' twice.
Two further changes suggested by Simon were also implemented:
- In canEqCanLHSFinish, if checkTyEqRhs returns PuFail with
'do_not_prevent_rewriting', we now **continue with this constraint**.
This allows us to use the constraint for rewriting.
- checkTyEqRhs now has a top-level check to avoid flattening a tyfam app
in a top-level equality of the form alpha ~ F tys, as this is
going around in circles. This simplifies the implementation without
any change in behaviour.
Fixes #25950
Fixes #26030
- - - - -
4020972c by sheaf at 2025-05-21T10:17:04-04:00
FixedRuntimeRepError: omit unhelpful explanation
This commit tweaks the FixedRuntimeRepError case of pprTcSolverReportMsg,
to avoid including an explanation which refers to a type variable that
appears nowhere else.
For example, the old error message could look like the following:
The pattern binding does not have a fixed runtime representation.
Its type is:
T :: TYPE R
Cannot unify ‘R’ with the type variable ‘c0’
because the former is not a concrete ‘RuntimeRep’.
With this commit, we now omit the last two lines, because the concrete
type variable (here 'c0') does not appear in the type displayed to the
user (here 'T :: TYPE R').
- - - - -
6d058a69 by Andrea Bedini at 2025-05-21T16:00:51-04:00
Don't fail when ghcversion.h can't be found (#26018)
If ghcversion.h can't be found, don't try to include it. This happens
when there is no rts package in the package db and when -ghcversion-file
argument isn't passed.
Co-authored-by: Syvlain Henry <sylvain(a)haskus.fr>
- - - - -
b1212fbf by Vladislav Zavialov at 2025-05-21T16:01:33-04:00
Implement -Wpattern-namespace-specifier (#25900)
In accordance with GHC Proposal #581 "Namespace-specified imports",
section 2.3 "Deprecate use of pattern in import/export lists", the
`pattern` namespace specifier is now deprecated.
Test cases: T25900 T25900_noext
- - - - -
5f9819f0 by Alan Zimmerman at 2025-05-22T22:12:55+01:00
GHC-CPP: first rough proof of concept
Processes
#define FOO
#ifdef FOO
x = 1
#endif
Into
[ITcppIgnored [L loc ITcppDefine]
,ITcppIgnored [L loc ITcppIfdef]
,ITvarid "x"
,ITequal
,ITinteger (IL {il_text = SourceText "1", il_neg = False, il_value = 1})
,ITcppIgnored [L loc ITcppEndif]
,ITeof]
In time, ITcppIgnored will be pushed into a comment
- - - - -
11176136 by Alan Zimmerman at 2025-05-22T22:12:55+01:00
Tidy up before re-visiting the continuation mechanic
- - - - -
47e76645 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Switch preprocessor to continuation passing style
Proof of concept, needs tidying up
- - - - -
d44302c4 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Small cleanup
- - - - -
db3471aa by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Get rid of some cruft
- - - - -
b4f1fc0c by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Starting to integrate.
Need to get the pragma recognised and set
- - - - -
bf3e28f1 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Make cppTokens extend to end of line, and process CPP comments
- - - - -
8226c652 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Remove unused ITcppDefined
- - - - -
477dfa48 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Allow spaces between # and keyword for preprocessor directive
- - - - -
68c9e3e3 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Process CPP continuation lines
They are emited as separate ITcppContinue tokens.
Perhaps the processing should be more like a comment, and keep on
going to the end.
BUT, the last line needs to be slurped as a whole.
- - - - -
4d22e538 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Accumulate CPP continuations, process when ready
Can be simplified further, we only need one CPP token
- - - - -
31df65b6 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Simplify Lexer interface. Only ITcpp
We transfer directive lines through it, then parse them from scratch
in the preprocessor.
- - - - -
759ab4b1 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Deal with directive on last line, with no trailing \n
- - - - -
ec94b890 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Start parsing and processing the directives
- - - - -
3a11de81 by Alan Zimmerman at 2025-05-22T22:12:56+01:00
Prepare for processing include files
- - - - -
72e3501a by Alan Zimmerman at 2025-05-22T22:14:17+01:00
Move PpState into PreProcess
And initParserState, initPragState too
- - - - -
ad21b20d by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Process nested include files
Also move PpState out of Lexer.x, so it is easy to evolve it in a ghci
session, loading utils/check-cpp/Main.hs
- - - - -
0ca0c855 by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Split into separate files
- - - - -
1c4356ce by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Starting on expression parser.
But it hangs. Time for Text.Parsec.Expr
- - - - -
cff5454d by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Start integrating the ghc-cpp work
From https://github.com/alanz/ghc-cpp
- - - - -
4f58197e by Alan Zimmerman at 2025-05-22T22:14:20+01:00
WIP
- - - - -
9d81e1ea by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Fixup after rebase
- - - - -
39af11a7 by Alan Zimmerman at 2025-05-22T22:14:20+01:00
WIP
- - - - -
df0745a3 by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Fixup after rebase, including all tests pass
- - - - -
703caf13 by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Change pragma usage to GHC_CPP from GhcCPP
- - - - -
a94f407e by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Some comments
- - - - -
6c85f782 by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Reformat
- - - - -
d5b5c55c by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Delete unused file
- - - - -
437d8ca4 by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Rename module Parse to ParsePP
- - - - -
13103f60 by Alan Zimmerman at 2025-05-22T22:14:20+01:00
Clarify naming in the parser
- - - - -
822515eb by Alan Zimmerman at 2025-05-22T22:14:50+01:00
WIP. Switching to alex/happy to be able to work in-tree
Since Parsec is not available
- - - - -
1b4dd725 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Layering is now correct
- GHC lexer, emits CPP tokens
- accumulated in Preprocessor state
- Lexed by CPP lexer, CPP command extracted, tokens concated with
spaces (to get rid of token pasting via comments)
- if directive lexed and parsed by CPP lexer/parser, and evaluated
- - - - -
95c785ff by Alan Zimmerman at 2025-05-22T22:14:50+01:00
First example working
Loading Example1.hs into ghci, getting the right results
```
{-# LANGUAGE GHC_CPP #-}
module Example1 where
y = 3
x =
"hello"
"bye now"
foo = putStrLn x
```
- - - - -
b51beccd by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Rebase, and all tests pass except whitespace for generated parser
- - - - -
a24f5f2f by Alan Zimmerman at 2025-05-22T22:14:50+01:00
More plumbing. Ready for testing tomorrow.
- - - - -
0a0b0708 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Proress. Renamed module State from Types
And at first blush it seems to handle preprocessor scopes properly.
- - - - -
4c69cb5b by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Insert basic GHC version macros into parser
__GLASGOW_HASKELL__
__GLASGOW_HASKELL_FULL_VERSION__
__GLASGOW_HASKELL_PATCHLEVEL1__
__GLASGOW_HASKELL_PATCHLEVEL2__
- - - - -
4b4d6995 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Re-sync check-cpp for easy ghci work
- - - - -
81d37032 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Get rid of warnings
- - - - -
f4e03a2a by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Rework macro processing, in check-cpp
Macros kept at the top level, looked up via name, multiple arity
versions per name can be stored
- - - - -
f2ae2b88 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
WIP. Can crack arguments for #define
Next step it to crack out args in an expansion
- - - - -
d7404efc by Alan Zimmerman at 2025-05-22T22:14:50+01:00
WIP on arg parsing.
- - - - -
01660582 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Progress. Still screwing up nested parens.
- - - - -
94895aeb by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Seems to work, but has redundant code
- - - - -
6c532dd1 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Remove redundant code
- - - - -
095587c5 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Reformat
- - - - -
9d704c28 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Expand args, single pass
Still need to repeat until fixpoint
- - - - -
055f2593 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Fixed point expansion
- - - - -
8a582858 by Alan Zimmerman at 2025-05-22T22:14:50+01:00
Sync the playground to compiler
- - - - -
7fcadd89 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Working on dumping the GHC_CPP result
But We need to keep the BufSpan in a comment
- - - - -
15ef23fe by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Keep BufSpan in queued comments in GHC.Parser.Lexer
- - - - -
7f10bb6a by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Getting close to being able to print the combined tokens
showing what is in and what is out
- - - - -
63d523a6 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
First implementation of dumpGhcCpp.
Example output
First dumps all macros in the state, then the source, showing which
lines are in and which are out
------------------------------
- |#define FOO(A,B) A + B
- |#define FOO(A,B,C) A + B + C
- |#if FOO(1,FOO(3,4)) == 8
- |-- a comment
|x = 1
- |#else
- |x = 5
- |#endif
- - - - -
2e6d0e63 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Clean up a bit
- - - - -
353758ab by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Add -ddump-ghc-cpp option and a test based on it
- - - - -
71ee0255 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Restore Lexer.x rules, we need them for continuation lines
- - - - -
87851fb1 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Lexer.x: trying to sort out the span for continuations
- We need to match on \n at the end of the line
- We cannot simply back up for it
- - - - -
09b9a4bd by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Inserts predefined macros. But does not dump properly
Because the cpp tokens have a trailing newline
- - - - -
1da1f2ba by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Remove unnecessary LExer rules
We *need* the ones that explicitly match to the end of the line.
- - - - -
261a46d8 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Generate correct span for ITcpp
Dump now works, except we do not render trailing `\` for continuation
lines. This is good enough for use in test output.
- - - - -
6c93fc2b by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Reduce duplication in lexer
- - - - -
8701de14 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Tweaks
- - - - -
a97fd0f3 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Insert min_version predefined macros into state
The mechanism now works. Still need to flesh out the full set.
- - - - -
236db9af by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Trying my alternative pragma syntax.
It works, but dumpGhcCpp is broken, I suspect from the ITcpp token
span update.
- - - - -
3ff850e5 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Pragma extraction now works, with both CPP and GHC_CPP
For the following
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 913
{-# LANGUAGE GHC_CPP #-}
#endif
We will enable GHC_CPP only
- - - - -
a8b19230 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Remove some tracing
- - - - -
198bdcd1 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Fix test exes for changes
- - - - -
b338bf64 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
For GHC_CPP tests, normalise config-time-based macros
- - - - -
234ff313 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
WIP
- - - - -
28a6e54e by Alan Zimmerman at 2025-05-22T22:14:51+01:00
WIP again. What is wrong?
- - - - -
9ba4a1b7 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Revert to dynflags for normal not pragma lexing
- - - - -
58140acc by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Working on getting check-exact to work properly
- - - - -
75d33a76 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Passes CppCommentPlacement test
- - - - -
c1a161c1 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Starting on exact printing with GHC_CPP
While overriding normal CPP
- - - - -
3ea98183 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Correctly store CPP ignored tokens as comments
By populating the lexeme string in it, based on the bufpos
- - - - -
667e4e28 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
WIP
- - - - -
e9367fbc by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Simplifying
- - - - -
5bbc1e18 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Update the active state logic
- - - - -
30876c4f by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Work the new logic into the mainline code
- - - - -
0461f7c8 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Process `defined` operator
- - - - -
46206cb4 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Manage lexer state while skipping tokens
There is very intricate layout-related state used when lexing. If a
CPP directive blanks out some tokens, store this state when the
blanking starts, and restore it when they are no longer being blanked.
- - - - -
536358bf by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Track the last token buffer index, for ITCppIgnored
We need to attach the source being skipped in an ITCppIgnored token.
We cannot simply use its BufSpan as an index into the underlying
StringBuffer as it counts unicode chars, not bytes.
So we update the lexer state to store the starting StringBuffer
location for the last token, and use the already-stored length to
extract the correct portion of the StringBuffer being parsed.
- - - - -
85368bcf by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Process the ! operator in GHC_CPP expressions
- - - - -
e08f6d1b by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Predefine a constant when GHC_CPP is being used.
- - - - -
9f672a34 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
WIP
- - - - -
30b7c3bf by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Skip lines directly in the lexer when required
- - - - -
5a0ee799 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Properly manage location when accepting tokens again
- - - - -
5ad81aa4 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Seems to be working now, for Example9
- - - - -
f6348314 by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Remove tracing
- - - - -
468a126a by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Fix parsing '*' in block comments
Instead of replacing them with '-'
- - - - -
97f6e21b by Alan Zimmerman at 2025-05-22T22:14:51+01:00
Keep the trailing backslash in a ITcpp token
- - - - -
98dddab4 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Deal with only enabling one section of a group.
A group is an instance of a conditional introduced by
#if/#ifdef/#ifndef,
and ending at the final #endif, including intermediate #elsif sections
- - - - -
541e71eb by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Replace remaining identifiers with 0 when evaluating
As per the spec
- - - - -
f186b1ee by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Snapshot before rebase
- - - - -
162b6b02 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Skip non-processed lines starting with #
- - - - -
d2bac260 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Export generateMacros so we can use it in ghc-exactprint
- - - - -
d9b1cd5d by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Fix rebase
- - - - -
a0b1a58e by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Expose initParserStateWithMacrosString
- - - - -
27b4a8f4 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Fix buggy lexer cppSkip
It was skipping all lines, not just ones prefixed by #
- - - - -
31fa91e0 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Fix evaluation of && to use the correct operator
- - - - -
54aa92fa by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Deal with closing #-} at the start of a line
- - - - -
16c77f58 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Add the MIN_VERSION_GLASGOW_HASKELL predefined macro
- - - - -
61b5a020 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Include MIN_VERSION_GLASGOW_HASKELL in GhcCpp01.stderr
- - - - -
46f153ba by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Use a strict map for macro defines
- - - - -
ac7432b5 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Process TIdentifierLParen
Which only matters at the start of #define
- - - - -
023b9f5d by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Do not provide TIdentifierLParen paren twice
- - - - -
eace047d by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Handle whitespace between identifier and '(' for directive only
- - - - -
41afd012 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Expose some Lexer bitmap manipulation helpers
- - - - -
24386ed0 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Deal with line pragmas as tokens
Blows up for dumpGhcCpp though
- - - - -
d6f4211b by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Allow strings delimited by a single quote too
- - - - -
86250e0b by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Allow leading whitespace on cpp directives
As per https://timsong-cpp.github.io/cppwp/n4140/cpp#1
- - - - -
d6601e32 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Implement GHC_CPP undef
- - - - -
97ea1aa6 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Sort out expansion of no-arg macros, in a context with args
And make the expansion bottom out, in the case of recursion
- - - - -
cb611082 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Fix GhcCpp01 test
The LINE pragma stuff works in ghc-exactprint when specifically
setting flag to emit ITline_pragma tokens
- - - - -
55b9208b by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Process comments in CPP directives
- - - - -
ad97286e by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Correctly lex pragmas with finel #-} on a newline
- - - - -
dc5605de by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Do not process CPP-style comments
- - - - -
707fa924 by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Allow cpp-style comments when GHC_CPP enabled
- - - - -
d42d7b4a by Alan Zimmerman at 2025-05-22T22:14:52+01:00
Return other pragmas as cpp ignored when GHC_CPP active
- - - - -
c2eb0e2d by Alan Zimmerman at 2025-05-22T23:21:45+01:00
Fix exactprinting default decl
- - - - -
274 changed files:
- compiler/GHC.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/Lexer.x
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Parser/Monad.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Config/Parser.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Parser.hs-boot
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- + compiler/GHC/Parser/PreProcess.hs
- + compiler/GHC/Parser/PreProcess/Eval.hs
- + compiler/GHC/Parser/PreProcess/Lexer.x
- + compiler/GHC/Parser/PreProcess/Macro.hs
- + compiler/GHC/Parser/PreProcess/ParsePP.hs
- + compiler/GHC/Parser/PreProcess/Parser.y
- + compiler/GHC/Parser/PreProcess/ParserM.hs
- + compiler/GHC/Parser/PreProcess/State.hs
- compiler/GHC/Parser/Utils.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Plugin.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/debugging.rst
- docs/users_guide/exts/explicit_namespaces.rst
- docs/users_guide/exts/pattern_synonyms.rst
- docs/users_guide/using-warnings.rst
- ghc/GHCi/UI.hs
- hadrian/src/Flavour.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Rules/SourceDist.hs
- hadrian/stack.yaml.lock
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Internal/Type/Reflection.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Interpreter.c
- rts/PrimOps.cmm
- rts/include/rts/Bytecodes.h
- rts/include/rts/storage/Closures.h
- rts/sm/Storage.h
- testsuite/tests/bytecode/T22376/all.T
- testsuite/tests/callarity/unittest/CallArity1.hs
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/dependent/should_fail/T11471.stderr
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/driver/Makefile
- testsuite/tests/driver/T4437.hs
- testsuite/tests/driver/all.T
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/ghc-api/T11579.hs
- + testsuite/tests/ghc-cpp/GhcCpp01.hs
- + testsuite/tests/ghc-cpp/GhcCpp01.stderr
- + testsuite/tests/ghc-cpp/all.T
- + testsuite/tests/ghci/all.T
- + testsuite/tests/ghci/ghci-mem-primops.hs
- + testsuite/tests/ghci/ghci-mem-primops.script
- + testsuite/tests/ghci/ghci-mem-primops.stdout
- testsuite/tests/ghci/scripts/ghci024.stdout
- testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
- testsuite/tests/indexed-types/should_fail/T8227.stderr
- testsuite/tests/indexed-types/should_fail/T9662.stderr
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- + 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/module/T21826.stderr
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/numeric/should_run/foundation.hs
- testsuite/tests/numeric/should_run/foundation.stdout
- + testsuite/tests/parser/should_compile/T25900.hs
- + testsuite/tests/parser/should_compile/T25900.stderr
- + testsuite/tests/parser/should_compile/T25900_noext.hs
- + testsuite/tests/parser/should_compile/T25900_noext.stderr
- testsuite/tests/parser/should_compile/all.T
- testsuite/tests/partial-sigs/should_fail/T14040a.stderr
- testsuite/tests/partial-sigs/should_fail/T14584.stderr
- testsuite/tests/patsyn/should_compile/ImpExp_Exp.hs
- testsuite/tests/patsyn/should_compile/T11959.hs
- testsuite/tests/patsyn/should_compile/T11959.stderr
- testsuite/tests/patsyn/should_compile/T11959Lib.hs
- testsuite/tests/patsyn/should_compile/T13350/boolean/Boolean.hs
- testsuite/tests/patsyn/should_compile/T22521.hs
- testsuite/tests/patsyn/should_compile/T9857.hs
- testsuite/tests/patsyn/should_compile/export.hs
- testsuite/tests/perf/should_run/ByteCodeAsm.hs
- testsuite/tests/pmcheck/complete_sigs/T25115a.hs
- testsuite/tests/pmcheck/should_compile/T11822.hs
- testsuite/tests/polykinds/T14172.stderr
- testsuite/tests/polykinds/T14270.hs
- testsuite/tests/polykinds/T14846.stderr
- + testsuite/tests/printer/CppCommentPlacement.hs
- testsuite/tests/rename/should_compile/T12548.hs
- testsuite/tests/rename/should_compile/T22581d.stdout
- + testsuite/tests/rename/should_compile/T25899a.hs
- + testsuite/tests/rename/should_compile/T25899b.hs
- + testsuite/tests/rename/should_compile/T25899c.hs
- + testsuite/tests/rename/should_compile/T25899c_helper.hs
- + testsuite/tests/rename/should_compile/T25899d.script
- + testsuite/tests/rename/should_compile/T25899d.stdout
- testsuite/tests/rename/should_compile/all.T
- testsuite/tests/rename/should_fail/T22581a.stderr
- testsuite/tests/rename/should_fail/T22581b.stderr
- testsuite/tests/rename/should_fail/T25056.stderr
- testsuite/tests/rename/should_fail/T25056a.hs
- + testsuite/tests/rename/should_fail/T25899e1.hs
- + testsuite/tests/rename/should_fail/T25899e1.stderr
- + testsuite/tests/rename/should_fail/T25899e2.hs
- + testsuite/tests/rename/should_fail/T25899e2.stderr
- + testsuite/tests/rename/should_fail/T25899e3.hs
- + testsuite/tests/rename/should_fail/T25899e3.stderr
- + testsuite/tests/rename/should_fail/T25899e_helper.hs
- + testsuite/tests/rename/should_fail/T25899f.hs
- + testsuite/tests/rename/should_fail/T25899f.stderr
- + testsuite/tests/rename/should_fail/T25899f_helper.hs
- testsuite/tests/rename/should_fail/all.T
- testsuite/tests/rep-poly/RepPolyArgument.stderr
- testsuite/tests/rep-poly/RepPolyBackpack1.stderr
- testsuite/tests/rep-poly/RepPolyBinder.stderr
- testsuite/tests/rep-poly/RepPolyDoBind.stderr
- testsuite/tests/rep-poly/RepPolyDoBody1.stderr
- testsuite/tests/rep-poly/RepPolyDoBody2.stderr
- testsuite/tests/rep-poly/RepPolyLeftSection2.stderr
- testsuite/tests/rep-poly/RepPolyMagic.stderr
- testsuite/tests/rep-poly/RepPolyMcBind.stderr
- testsuite/tests/rep-poly/RepPolyMcBody.stderr
- testsuite/tests/rep-poly/RepPolyMcGuard.stderr
- testsuite/tests/rep-poly/RepPolyNPlusK.stderr
- testsuite/tests/rep-poly/RepPolyPatBind.stderr
- testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
- testsuite/tests/rep-poly/RepPolyRightSection.stderr
- testsuite/tests/rep-poly/RepPolyRule1.stderr
- testsuite/tests/rep-poly/RepPolyTuple.stderr
- testsuite/tests/rep-poly/RepPolyTuple4.stderr
- testsuite/tests/rep-poly/RepPolyTupleSection.stderr
- testsuite/tests/rep-poly/RepPolyWrappedVar.stderr
- testsuite/tests/rep-poly/T11473.stderr
- testsuite/tests/rep-poly/T12709.stderr
- testsuite/tests/rep-poly/T12973.stderr
- testsuite/tests/rep-poly/T13233.stderr
- testsuite/tests/rep-poly/T13929.stderr
- testsuite/tests/rep-poly/T14561.stderr
- testsuite/tests/rep-poly/T14561b.stderr
- testsuite/tests/rep-poly/T17817.stderr
- testsuite/tests/rep-poly/T19615.stderr
- testsuite/tests/rep-poly/T19709b.stderr
- testsuite/tests/rep-poly/T21906.stderr
- testsuite/tests/rep-poly/T23903.stderr
- testsuite/tests/rep-poly/UnliftedNewtypesCoerceFail.stderr
- testsuite/tests/simplCore/should_compile/T15186.hs
- testsuite/tests/simplCore/should_compile/T15186A.hs
- testsuite/tests/simplCore/should_compile/simpl017.stderr
- testsuite/tests/typecheck/no_skolem_info/T14040.stderr
- testsuite/tests/typecheck/should_compile/T25266a.stderr
- + testsuite/tests/typecheck/should_compile/T26030.hs
- testsuite/tests/typecheck/should_compile/TypeRepCon.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T16204c.stderr
- + testsuite/tests/typecheck/should_fail/T25950.hs
- + testsuite/tests/typecheck/should_fail/T25950.stderr
- testsuite/tests/typecheck/should_fail/T7696.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/warnings/should_compile/DataToTagWarnings.hs
- testsuite/tests/warnings/should_compile/T14794a.hs
- testsuite/tests/warnings/should_compile/T14794a.stderr
- testsuite/tests/warnings/should_compile/T14794b.hs
- testsuite/tests/warnings/should_compile/T14794b.stderr
- testsuite/tests/warnings/should_compile/T14794c.hs
- testsuite/tests/warnings/should_compile/T14794c.stderr
- testsuite/tests/warnings/should_compile/T14794d.hs
- testsuite/tests/warnings/should_compile/T14794d.stderr
- testsuite/tests/warnings/should_compile/T14794e.hs
- testsuite/tests/warnings/should_compile/T14794e.stderr
- testsuite/tests/warnings/should_compile/T14794f.hs
- testsuite/tests/warnings/should_compile/T14794f.stderr
- testsuite/tests/wcompat-warnings/Template.hs
- + testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
- + utils/check-cpp/.ghci
- + utils/check-cpp/.gitignore
- + utils/check-cpp/Eval.hs
- + utils/check-cpp/Example1.hs
- + utils/check-cpp/Example10.hs
- + utils/check-cpp/Example11.hs
- + utils/check-cpp/Example12.hs
- + utils/check-cpp/Example13.hs
- + utils/check-cpp/Example2.hs
- + utils/check-cpp/Example3.hs
- + utils/check-cpp/Example4.hs
- + utils/check-cpp/Example5.hs
- + utils/check-cpp/Example6.hs
- + utils/check-cpp/Example7.hs
- + utils/check-cpp/Example8.hs
- + utils/check-cpp/Example9.hs
- + utils/check-cpp/Lexer.x
- + utils/check-cpp/Macro.hs
- + utils/check-cpp/Main.hs
- + utils/check-cpp/ParsePP.hs
- + utils/check-cpp/ParseSimulate.hs
- + utils/check-cpp/Parser.y
- + utils/check-cpp/ParserM.hs
- + utils/check-cpp/PreProcess.hs
- + utils/check-cpp/README.md
- + utils/check-cpp/State.hs
- + utils/check-cpp/run.sh
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Preprocess.hs
- utils/check-exact/Utils.hs
- utils/genprimopcode/Main.hs
- utils/genprimopcode/Syntax.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57c097dad0ebf79e229ccf7f04d2a9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57c097dad0ebf79e229ccf7f04d2a9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26049] base: Expose Backtraces constructor and fields
by Ben Gamari (＠bgamari) 22 May '25
by Ben Gamari (＠bgamari) 22 May '25
22 May '25
Ben Gamari pushed to branch wip/T26049 at Glasgow Haskell Compiler / GHC
Commits:
48838cbf by Ben Gamari at 2025-05-22T18:21:36-04:00
base: Expose Backtraces constructor and fields
This was specified in the proposal yet somehow didn't make it into the
implementation.
Fixes #26049.
- - - - -
7 changed files:
- libraries/base/changelog.md
- libraries/base/src/Control/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- 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
Changes:
=====================================
libraries/base/changelog.md
=====================================
@@ -22,6 +22,7 @@
* `GHC.TypeNats.Internal`
* `GHC.ExecutionStack.Internal`.
* Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
+ * Expose constructor and field of `Backtraces` from `Control.Exception.Backtrace`, as per [CLC #199](https://github.com/haskell/core-libraries-committee/issues/199#issuecomment-1954662391)
## 4.21.0.0 *TBA*
* Change `SrcLoc` to be a strict and unboxed (finishing [CLC proposal #55](https://github.com/haskell/core-libraries-committee/issues/55))
=====================================
libraries/base/src/Control/Exception/Backtrace.hs
=====================================
@@ -51,7 +51,7 @@ module Control.Exception.Backtrace
, getBacktraceMechanismState
, setBacktraceMechanismState
-- * Collecting backtraces
- , Backtraces
+ , Backtraces(..)
, displayBacktraces
, collectBacktraces
) where
=====================================
libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
=====================================
@@ -9,7 +9,7 @@ module GHC.Internal.Exception.Backtrace
, getBacktraceMechanismState
, setBacktraceMechanismState
-- * Collecting backtraces
- , Backtraces
+ , Backtraces(..)
, displayBacktraces
, collectBacktraces
) where
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = ...
+ data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = ...
+ data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = ...
+ data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = ...
+ data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48838cbf29747208570c5d114668adc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48838cbf29747208570c5d114668adc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0