GitLab

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

ef038aae

by cydparser at 2026-07-15T04:35:41-04:00

Reduce bytes allocated for `capabilities` in RTS (fixes #27487)

In rts/Capability.c, `capabilities` is an array of pointers, but it was allocated as if it were an
array of Capability's.

d377e83e

by Cheng Shao at 2026-07-15T04:36:27-04:00

rts: fix missing UNTAG in stg_readTVarIOzh

This patch fixes missing UNTAG on the current value closure read from
StgTVar. UNTAG is a no-op when it's stg_TREC_HEADER_info which is word
aligned; it may be a tagged closure, and reading info table from the
tagged address is an unaligned load which may cause issues on
platforms with strict alignment requirements.

Co-authored-by: Codex <codex@openai.com>

8ed03842

by Cheng Shao at 2026-07-15T04:36:27-04:00

rts: fix missing UNTAG in stg_control0zh_ll

This patch fixes missing UNTAG on the cont closure returned by
captureContinuationAndAbort. In case it's not NULL,
captureContinuationAndAbort returns a tagged StgContinuation closure,
in which case it must be untagged before accessing the
apply_mask_frame field.

In the past it worked out of luck: when apply_mask_frame was NULL then
mask_frame_offset is also 0 so the control flow didn't diverge to a
wrong path. Still, this is horribly wrong and will crash once
StgContinuation struct is refactored and fields are shuffled around.

Co-authored-by: Codex <codex@openai.com>

5aa7000a

by Cheng Shao at 2026-07-15T04:37:08-04:00

compiler: fix redundant AP thunk codegen when not using -ticky-ap-thunk

This patch fixes a double negation confusion in !7525 that results in
some redundant AP thunk code generation when not using
-ticky-ap-thunk. Now, we use `stgToCmmUseStdApThunk` to indicate
whether precomputed AP thunks in the RTS should be used, which
defaults to `True`, unless `-ticky-ap-thunk` is passed.
`-finfo-table-map` now also implies `-ticky-ap-thunk`, since when
doing IPE profiling we want the generated AP thunks to be unique.
Fixes #27502.

-------------------------
Metric Decrease:
    T3064
-------------------------

Co-authored-by: Codex <codex@openai.com>

d43a7b7a

by Brian McKenna at 2026-07-15T20:10:04+02:00

Strip ticks when desugaring bool guards

The special `considerAccessible` pattern was broken when compiling
with debug info. Compiling with debug info wraps expressions with
`SourceNote` ticks, which broke the internals of the
`desugarBoolGuard` function. Ticks are now ignored within this
function.

Fixes #27360

19e4b630

by Ben Gamari at 2026-07-15T18:28:04-04:00

base: Display ExceptionContext in WhileHandling's textual description

As originally-implemented the implementation for
`WhileHandling(displayExceptionAnnotation)` would display the
`ExceptionContext` of the exception which it carries (as this was the
behavior of `displayException`, in terms of which
`displayExceptionAnnotation` was implemented).

However, in 284ffab3 the definition of `SomeException(displayException)`
was changed to exclude the `ExceptionContext`. This means that
`WhileHandling(displayExceptionAnnotation)` fails to describe the
provenance of the exception which it captures, greatly limiting its
utility.

Return the implementation to its originally-specified behavior by
implementing `WhileHandling(displayExceptionAnnotation)` in terms of
`displayExceptionWithInfo`.

Fixes #27456.

22 changed files:

+ changelog.d/T27360
+ changelog.d/T27456
+ changelog.d/fix-use-std-ap-thunk
compiler/GHC/Driver/Config/StgToCmm.hs
compiler/GHC/Driver/Flags.hs
compiler/GHC/HsToCore/Pmc/Desugar.hs
compiler/GHC/StgToCmm/Bind.hs
compiler/GHC/StgToCmm/Config.hs
libraries/base/changelog.md
libraries/base/tests/T15349.stderr
libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
libraries/ghc-internal/tests/backtraces/T14532b.stdout
rts/Capability.c
rts/ContinuationOps.cmm
rts/PrimOps.cmm
testsuite/tests/codeGen/should_run/cgrun025.stderr
testsuite/tests/exceptions/T26759.stderr
testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
testsuite/tests/mdo/should_fail/mdofail006.stderr
+ testsuite/tests/pmcheck/should_compile/T27360.hs
testsuite/tests/pmcheck/should_compile/all.T
testsuite/tests/runghc/T7859.stderr-mingw32

Changes:

changelog.d/T27360

 +section: compiler
 +issues: #27360
 +mrs: !16161
 +synopsis:
 +  Recognise ``considerAccessible`` under ticks (``-g``, ``-finfo-table-map``, ``-fhpc`` etc)
 +description:
 +  The pattern-match checker now properly recognises ``considerAccessible`` even
 +  when it is surrounded by ticks (e.g. debug info ticks with ``-g``, with
 +  ``-finfo-table-map``, etc). This ensures it works as advertised, suppressing
 +  redundant pattern-match warnings, even when it occurs under a tick.

changelog.d/T27456

 +section: base
 +issues: #27456
 +mrs: !16275
 +synopsis:
 +  Show `ExceptionContext` in `displayExceptionAnnotation` implementation of `WhileHandling`
 +description:
 +  In the past ``displayException`` (in terms of which ``WhileHandling``\'s ``displayExceptionAnnotation` is implemented) was changed to hide ``ExceptionContext``. This regressed the behavior of ``displayExceptionAnnotation`` from that which was originally specified. Restore the intended behavior of showing the ``ExceptionContext`` of the carried exception.
++

changelog.d/fix-use-std-ap-thunk

 +section: codegen
 +synopsis: Fix redundant AP thunk codegen when not using -ticky-ap-thunk
 +issues: #27502
 +mrs: !16340

compiler/GHC/Driver/Config/StgToCmm.hs

@@ -87,7 +87,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
    , stgToCmmAvx           = isAvxEnabled                   dflags
    , stgToCmmAvx2          = isAvx2Enabled                  dflags
    , stgToCmmAvx512f       = isAvx512fEnabled               dflags
 -  , stgToCmmTickyAP       = gopt Opt_Ticky_AP dflags
 +  , stgToCmmUseStdApThunk = not $ gopt Opt_Ticky_AP dflags
    -- See Note [Saving foreign call target to local]
    , stgToCmmSaveFCallTargetToLocal = any (callerSaves platform) $ activeStgRegs platform
    } where profile  = targetProfile dflags

compiler/GHC/Driver/Flags.hs

@@ -379,6 +379,7 @@ impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)
                  ,(Opt_ByteCodeAndObjectCode, turnOn, Opt_WriteByteCode)
                  ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithStack)
                  ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithFallback)
 +                ,(Opt_InfoTableMap, turnOn, Opt_Ticky_AP)
                  ] ++ validHoleFitsImpliedGFlags
  -- | General flags that are switched on/off when other general flags are switched

compiler/GHC/HsToCore/Pmc/Desugar.hs

@@ -12,7 +12,8 @@ import GHC.Prelude
  import GHC.HsToCore.Pmc.Types
  import GHC.HsToCore.Pmc.Utils
 -import GHC.Core (Expr(Var,App))
 +import GHC.Core (CoreExpr, Expr(Var,App))
 +import GHC.Core.Utils (stripTicksTopE)
  import GHC.Data.FastString (unpackFS, lengthFS, mkFastStringShortText)
  import GHC.Driver.DynFlags
  import GHC.Hs
@@ -474,24 +475,28 @@ desugarLocalBinds _binds = return GdEnd
  -- | Desugar a pattern guard
  --   @pat <- e ==>  let x = e;  <guards for pat <- x>@
  desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM GrdDag
 -desugarBind p e = dsLExpr e >>= \case
 -  Var y
 -    | Nothing <- isDataConId_maybe y
 -    -- RHS is a variable, so that will allow us to omit the let
 -    -> desugarLPat y p
 -  rhs -> do
 -    (x, grds) <- desugarLPatV p
 -    pure (PmLet x rhs `consGrdDag` grds)
 +desugarBind p e =
 +  dsLExpr_stripTicks e >>= \case
 +    Var y
 +      | Nothing <- isDataConId_maybe y
 +      -- RHS is a variable, so that will allow us to omit the let
 +      -> desugarLPat y p
 +    rhs -> do
 +      (x, grds) <- desugarLPatV p
 +      pure (PmLet x rhs `consGrdDag` grds)
  -- | Desugar a boolean guard
  --   @e ==>  let x = e; True <- x@
  desugarBoolGuard :: LHsExpr GhcTc -> DsM GrdDag
  desugarBoolGuard e
 -  | isJust (isTrueLHsExpr e) = return GdEnd
 +  | isJust (isTrueLHsExpr e) -- NB: looks through ticks
      -- The formal thing to do would be to generate (True <- True)
      -- but it is trivial to solve so instead we give back an empty
      -- GrdDag for efficiency
 -  | otherwise = dsLExpr e >>= \case
 +  = return GdEnd
++
 +  | otherwise
 +  = dsLExpr_stripTicks e >>= \case
        Var y
          | Nothing <- isDataConId_maybe y
          -- Omit the let by matching on y
@@ -500,6 +505,19 @@ desugarBoolGuard e
          x <- mkPmId boolTy
          pure $ sequencePmGrds [PmLet x rhs, vanillaConGrd x trueDataCon []]
 +-- | Desugar an expression, stripping off top-level ticks from the resulting
 +-- Core expression.
 +--
 +-- This function is used instead of 'dsLExpr' when we are immediately going to
 +-- inspect the Core (as we do in e.g. 'desugarBoolGuard' or 'desugarBind') to
 +-- make sure we properly look through intervening ticks (fixing #27360).
 +--
 +-- It's not needed when all we do is stash the resulting 'CoreExpr' into a
 +-- 'GrdDag', as the rest of the machinery (such as 'GHC.HsToCore.Pmc.Solver.addCoreCt')
 +-- looks through ticks.
 +dsLExpr_stripTicks :: LHsExpr GhcTc -> DsM CoreExpr
 +dsLExpr_stripTicks e = stripTicksTopE (const True) <$> dsLExpr e
++
  {- Note [Field match order for RecCon]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  The order for RecCon field patterns actually determines evaluation order of

compiler/GHC/StgToCmm/Bind.hs

@@ -280,7 +280,7 @@ cgRhs id (StgRhsClosure fvs cc upd_flag args body _typ)
    = do
      profile <- getProfile
      check_tags <- stgToCmmDoTagCheck <$> getStgToCmmConfig
 -    use_std_ap_thunk <- stgToCmmTickyAP <$> getStgToCmmConfig
 +    use_std_ap_thunk <- stgToCmmUseStdApThunk <$> getStgToCmmConfig
      mkRhsClosure profile use_std_ap_thunk check_tags id cc (nonVoidIds (dVarSetElems fvs)) upd_flag args body
  ------------------------------------------------------------------------

compiler/GHC/StgToCmm/Config.hs

@@ -73,7 +73,7 @@ data StgToCmmConfig = StgToCmmConfig
    , stgToCmmAllowWordMul2Instr        :: !Bool   -- ^ Allowed to generate WordMul2 instruction
    , stgToCmmAllowFMAInstr             :: FMASign -> Bool -- ^ Allowed to generate FMA instruction
    , stgToCmmAllowIntWord64X2MinMax    :: !Bool   -- ^ Allowed to generate min/max instructions for Int64X2/Word64X2
 -  , stgToCmmTickyAP                   :: !Bool   -- ^ Disable use of precomputed standard thunks.
 +  , stgToCmmUseStdApThunk             :: !Bool   -- ^ Use precomputed standard AP thunks in the RTS.
    , stgToCmmSaveFCallTargetToLocal    :: !Bool   -- ^ Save a foreign call target to a Cmm local, see
                                                   -- Note [Saving foreign call target to local] for details
    ------------------------------ SIMD flags ------------------------------------

libraries/base/changelog.md

@@ -33,6 +33,7 @@
    * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376))
    * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369))
    * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383))
 +  * Show `ExceptionContext` in `displayExceptionAnnotation` implementation of `WhileHandling` ([GHC #27456](https://gitlab.haskell.org/ghc/ghc/-/issues/27456))
    * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387))
    * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371))
    * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397))

libraries/base/tests/T15349.stderr

 -T15349: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination:
 +T15349.exe: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination:
  <<loop>>
 -While handling thread blocked indefinitely in an MVar operation
 +While handling ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar:
 +  |
 +  | thread blocked indefinitely in an MVar operation
  HasCallStack backtrace:
 -  throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs:58:37 in ghc-internal:GHC.Internal.Control.Monad.ST.Imp
 +  throwIO, called at libraries\ghc-internal\src\GHC\Internal\Control\Monad\ST\Imp.hs:59:37 in ghc-internal:GHC.Internal.Control.Monad.ST.Imp

libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs

@@ -84,7 +84,7 @@ data WhileHandling = WhileHandling SomeException deriving Show
  instance ExceptionAnnotation WhileHandling where
    displayExceptionAnnotation (WhileHandling e) =
 -    "While handling " ++ case lines $ displayException e of
 +    "While handling " ++ case lines $ displayExceptionWithInfo e of
        [] -> ""
        (l1:ls) ->
          -- Indent lines forward.

libraries/ghc-internal/tests/backtraces/T14532b.stdout

@@ -2,7 +2,14 @@ ghc-internal:GHC.Internal.Exception.ErrorCall:
  Error in Exception Handler
 -While handling Main Error
 +While handling ghc-internal:GHC.Internal.Exception.ErrorCall:
 +  |
 +  | Main Error
 +  |
 +  | My custom Backtraces:
 +  | HasCallStack backtrace:
 +  |   throwIO, called at T14532b.hs:32:6 in main:Main
 +  |
  My custom Backtraces:
  HasCallStack backtrace:
@@ -13,7 +20,14 @@ ghc-internal:GHC.Internal.Exception.ErrorCall:
  Error in Exception Handler
 -While handling Main Error
 +While handling ghc-internal:GHC.Internal.Exception.ErrorCall:
 +  |
 +  | Main Error
 +  |
 +  | My custom Backtraces:
 +  | HasCallStack backtrace:
 +  |   error, called at T14532b.hs:41:6 in main:Main
 +  |
  My custom Backtraces:
  HasCallStack backtrace:

rts/Capability.c

@@ -413,7 +413,7 @@ void initCapabilities (void)
          max_n_capabilities = RtsFlags.ParFlags.nCapabilities;
+     }
 -    capabilities = stgMallocBytes(sizeof(Capability) * max_n_capabilities, "initCapabilities");
 +    capabilities = stgMallocBytes(sizeof(Capability *) * max_n_capabilities, "initCapabilities");
      n_capabilities = 0;
      moreCapabilities(0, RtsFlags.ParFlags.nCapabilities);
@@ -422,7 +422,7 @@ void initCapabilities (void)
  #else /* !THREADED_RTS */
      n_capabilities = 1;
 -    capabilities = stgMallocBytes(sizeof(Capability), "initCapabilities");
 +    capabilities = stgMallocBytes(sizeof(Capability *), "initCapabilities");
      capabilities[0] = &MainCapability;
      initCapability(&MainCapability, 0);

rts/ContinuationOps.cmm

@@ -108,7 +108,7 @@ stg_control0zh_ll // explicit stack
+   }
    W_ apply_mask_frame;
 -  apply_mask_frame = StgContinuation_apply_mask_frame(cont);
 +  apply_mask_frame = StgContinuation_apply_mask_frame(UNTAG(cont));
    // The stack has been updated, so it’s time to apply the input function,
    // passing the captured continuation and a RealWorld token as arguments.

rts/PrimOps.cmm

@@ -1565,7 +1565,10 @@ stg_readTVarIOzh ( P_ tvar /* :: TVar a */ )
  again:
      result = %acquire StgTVar_current_value(tvar);
 -    resultinfo = %INFO_PTR(result);
 +    // when result is stg_TREC_HEADER_info, it's word aligned so UNTAG
 +    // is no-op; if it's a tagged closure we must UNTAG it to avoid an
 +    // unaligned memory access
 +    resultinfo = %INFO_PTR(UNTAG(result));
      if (resultinfo == stg_TREC_HEADER_info) {
          goto again;
+     }

testsuite/tests/codeGen/should_run/cgrun025.stderr

 -"cgrun025"
 +"cgrun025.exe"
  ["cgrun025.hs"]
  GOT PATH
  {-# LANGUAGE ScopedTypeVariables #-}
@@ -27,11 +27,16 @@ main = do
      trace "hello, trace" $
        catch (getEnv "__WURBLE__" >> return ()) (\ (e :: SomeException) -> error "hello, error")
  hello, trace
 -cgrun025: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
 +cgrun025.exe: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
  hello, error
 -While handling __WURBLE__: getEnv: does not exist (no environment variable)
 +While handling ghc-internal:GHC.Internal.IO.Exception.IOException:
 +  |
 +  | __WURBLE__: getEnv: does not exist (no environment variable)
 +  |
 +  | HasCallStack backtrace:
 +  |   ioException, called at libraries\ghc-internal\src\GHC\Internal\System\Environment.hs:204:26 in ghc-internal:GHC.Internal.System.Environment
  HasCallStack backtrace:
    error, called at cgrun025.hs:25:75 in main:Main

testsuite/tests/exceptions/T26759.stderr

 -T26759: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
 +T26759.exe: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
  cleanup failure
 -While handling outer failure
 +While handling ghc-internal:GHC.Internal.Exception.ErrorCall:
 +  |
 +  | outer failure
 +  |
 +  | HasCallStack backtrace:
 +  |   throwIO, called at T26759.hs:6:21 in main:Main
  HasCallStack backtrace:
    throwIO, called at T26759.hs:7:22 in main:Main

testsuite/tests/ghc-e/should_fail/T18441fail7.stderr

 -<interactive>: Uncaught exception ghc-9.13-inplace:GHC.Utils.Panic.GhcException:
 +<interactive>: Uncaught exception ghc-10.1-inplace:GHC.Utils.Panic.GhcException:
  IO error:  "Abcde" does not exist
 -While handling IO error:  "Abcde" does not exist
 +While handling ghc-10.1-inplace:GHC.Utils.Panic.GhcException:
 +  |
 +  | IO error:  "Abcde" does not exist
  HasCallStack backtrace:
 -  throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.13-inplace:GHC.Utils.Error
 +  throwIO, called at compiler\GHC\Utils\Error.hs:499:19 in ghc-10.1-inplace:GHC.Utils.Error

testsuite/tests/mdo/should_fail/mdofail006.stderr

 -mdofail006: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.FixIOException:
 +mdofail006.exe: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.FixIOException:
  cyclic evaluation in fixIO
 -While handling thread blocked indefinitely in an MVar operation
 +While handling ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar:
 +  |
 +  | thread blocked indefinitely in an MVar operation
  HasCallStack backtrace:
 -  throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs:167:37 in ghc-internal:GHC.Internal.Control.Monad.Fix
 +  throwIO, called at libraries\ghc-internal\src\GHC\Internal\Control\Monad\Fix.hs:169:37 in ghc-internal:GHC.Internal.Control.Monad.Fix

testsuite/tests/pmcheck/should_compile/T27360.hs

 +module T27360 where
++
 +import GHC.Exts
++
 +f :: ()
 +f | False, considerAccessible = ()
 +  | otherwise = ()
++
 +g :: ()
 +g | False, True <- considerAccessible = ()
 +  | otherwise = ()

testsuite/tests/pmcheck/should_compile/all.T

@@ -182,3 +182,4 @@ test('T24845', [], compile, [overlapping_incomplete])
  test('T22652', [], compile, [overlapping_incomplete])
  test('T22652a', [], compile, [overlapping_incomplete])
  test('T24867', [], compile_fail, [overlapping_incomplete])
 +test('T27360', normal, compile, [overlapping_incomplete + '-g3'])

testsuite/tests/runghc/T7859.stderr-mingw32

@@ -2,7 +2,12 @@ runghc-9.13.20241015.exe: Uncaught exception ghc-internal:GHC.Internal.IO.Except
  defer-type-errors: rawSystem: does not exist (No such file or directory)
 -While handling rawSystem: does not exist (No such file or directory)
 +While handling ghc-internal:GHC.Internal.IO.Exception.IOException:
 +  |
 +  | rawSystem: does not exist (No such file or directory)
 +  |
 +  | HasCallStack backtrace:
 +  |   ioError, called at libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs:<line>:<column> in <package-id>:GHC.Internal.Foreign.C.Error
  HasCallStack backtrace:
    ioError, called at libraries\process\System\Process\Common.hs:239:16 in process-1.6.25.0-inplace:System.Process.Common